From b587578bbd1951acc703c91fa3b41260a5ffb3cf Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 17 Nov 2025 13:48:32 +0900 Subject: [PATCH 001/144] upd opam --- .github/workflows/docker-action.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/docker-action.yml b/.github/workflows/docker-action.yml index cd836b1c..f72bf9ec 100644 --- a/.github/workflows/docker-action.yml +++ b/.github/workflows/docker-action.yml @@ -21,7 +21,7 @@ jobs: fail-fast: false steps: - uses: actions/checkout@v2 - - uses: coq-community/docker-coq-action@v1 + - uses: rocq-community/docker-rocq-action@v1 with: opam_file: 'robot-rocq.opam' custom_image: ${{ matrix.image }} From 5f0f3adb449686a2fb2b137cc91873d9760b9936 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 26 May 2025 18:06:55 +0900 Subject: [PATCH 002/144] start tilt formalization --- tilt.v | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 tilt.v diff --git a/tilt.v b/tilt.v new file mode 100644 index 00000000..74ed9874 --- /dev/null +++ b/tilt.v @@ -0,0 +1,61 @@ +From mathcomp Require Import all_ssreflect all_algebra ring. +From mathcomp Require Import boolp classical_sets reals topology normedtype derive. +Require Import ssr_ext euclidean rigid frame skew derive_matrix. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. + +Import numFieldNormedType.Exports. + +Local Open Scope ring_scope. + +Definition S2 (K : realType) : Type := { x : 'rV[K]_3 | norm x = 1 }. + +Section problem_statement. +Context {K : realType}. +Variable W : Frame.t K. (* world frame *) +Variable L : Frame.t K. (* sensor frame *) +Variable v : K -> 'rV[K]_3. (* linear velocity *) +Variable w : 'rV[K]_3. (* angular velocity *) +Variable g0 : K. (* standard gravity constant *) +Variable R : K -> 'M[K]_3. (* orientation of the IMU w.r.t. the world *) +Let ez : 'rV[K]_3 := 'e_2. +Variable m : 'rV[K]_3. + +Definition rhs23 t := + v t *m \S(w) + derive1mx v t + g0 *: ez *m (R t)^T. + +Definition rhs24 t := m *m (R t)^T. + +Definition eqn25 t := derive1mx R t = R t *m \S(w). + +Definition x1 := v. + +Definition x2 t := ez *m (R t)^T. + +Definition x3 t := m *m (R t)^T. + +End problem_statement. + +Section basic_facts. +Context {K : realType}. + +Lemma fact212 (v w : 'rV[K]_3) : \S(v) *m \S(w) = w^T *m v - (v *m w^T)``_0 *: 1. +Proof. +apply/matrix3P/and9P; split; apply/eqP; + rewrite !(mxE,sum3E,spinij,sum1E); Simp.r. + ring. +by rewrite mulrC. +by rewrite mulrC. +by rewrite mulrC. +by rewrite !opprD; ring. +by rewrite mulrC. +by rewrite mulrC. +by rewrite mulrC. +by rewrite !opprD; ring. +Qed. + +End basic_facts. From 3ef1450cdf5b669895565147469eb1fa60a74613 Mon Sep 17 00:00:00 2001 From: Lynda <26559721+yosakaon@users.noreply.github.com> Date: Mon, 2 Jun 2025 10:34:24 +0900 Subject: [PATCH 003/144] basic facts update (#44) --- tilt.v | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 102 insertions(+), 1 deletion(-) diff --git a/tilt.v b/tilt.v index 74ed9874..0b4f38ad 100644 --- a/tilt.v +++ b/tilt.v @@ -43,7 +43,7 @@ End problem_statement. Section basic_facts. Context {K : realType}. -Lemma fact212 (v w : 'rV[K]_3) : \S(v) *m \S(w) = w^T *m v - (v *m w^T)``_0 *: 1. +Lemma fact212 (v w : 'rV[K]_3) : \S(v) * \S(w) = w^T *m v - (v *m w^T)``_0 *: 1. Proof. apply/matrix3P/and9P; split; apply/eqP; rewrite !(mxE,sum3E,spinij,sum1E); Simp.r. @@ -58,4 +58,105 @@ by rewrite mulrC. by rewrite !opprD; ring. Qed. +About subr0. +Search "subr0". +Locate subr0. +Lemma fact213 (v w : 'rV[K]_3) : \S(v) * \S(w) * \S(v) = - (v *m w^T) ``_0 *: \S(v). +Proof. + rewrite fact212. + rewrite mulrBl. + rewrite -mulmxE. + Search (_*m_) (_*_). + rewrite -mulmxA. + have: v *m \S(v) = 0. + apply: trmx_inj. + Search ( _ *m _^T). + rewrite trmx_mul. + Search ( \S(_)^T ). + rewrite tr_spin. + Search (\S(_) ) 0. + rewrite mulNmx. + About mulNmx. + rewrite spin_mul_tr. + (*Unset Printing Notations.*) + rewrite trmx0. + rewrite oppr0. + by []. + move => ->. + rewrite mulmx0. + rewrite sub0r. + Search (_*m _) (_*: _). + Search ( _%:A). + rewrite -mul_scalar_mx. + rewrite -mulNmx. + congr (_ *m _). + rewrite scalemx1. + rewrite rmorphN /=. (* simpl*) + by []. +Qed. +Lemma fact215 ( v w : 'rV[K]_3) : \S(w *m \S(v)) = \S(w) * \S(v) - \S(v) * \S(w). +Proof. + Search ( \S(_ )). + Search (_*v_) (_*m_). + rewrite spinE. + rewrite spin_crossmul. + by []. +Qed. + +Lemma fact216 (v w : 'rV[K]_3): \S(w *m \S(v)) = v^T *m w - w^T *m v. +Proof. + rewrite fact215. + + rewrite !fact212. + Search (_%:A). + rewrite -!/(_ *d _). + Search (_^T). + Search "dotmulC". + rewrite dotmulC. + rewrite opprB. + rewrite addrA. + rewrite subrK. + by []. +Qed. +Search (\S(_)). +Lemma fact217 (v : 'rV[K]_3): \S(v) ^+ 3 = - (norm v ^+2) *: \S(v). + (*Set Printing All.*) + exact: spin3. +Qed. + +Search "cV". +(* ligne!, R est une matrice de rotation, chaque v_i est un vecteur > + trouver la notation indicielle *) +Lemma fact214 (R : 'M[K]_3) (v_ : seq 'rV[K]_3) : R \is 'SO[K]_3 -> R^T * (\prod_(i <- v_) \S( i )) * R = (\prod_(i <- v_) \S( i *m R)). +(* cest spin_similarity mais avec une somme. neutraliser la somme?*) +Proof. +move => RSO. +elim/big_ind2 : _ => //. + rewrite -!mulmxE. + rewrite mulmx1. + rewrite rotation_tr_mul. + by []. + by []. +- move => a b c d. + move => H1 H2. + rewrite -H1 //. + rewrite -H2 //. + rewrite -!mulmxE. + About rotation_tr_mul. + (*Set Printing Parentheseses*) + Search "mulrC". + Search "mulmxA". + Search "rotation_tr_mul". + Search "trmx". + + rewrite -!rotation_inv. + rewrite !mulmxA. + rewrite -mulmxA -(mulmxA). + admit. + About spin_similarity. + Print is_true. +- (*move => i _. + exact: spin_similarity.*) + Admitted. End basic_facts. + From 2e9b75947de911d40593a12ef14c8556b8c90507 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 2 Jun 2025 14:55:37 +0900 Subject: [PATCH 004/144] equilibrium point --- _CoqProject | 1 + tilt.v | 74 +++++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 70 insertions(+), 5 deletions(-) diff --git a/_CoqProject b/_CoqProject index 5c100751..75931685 100644 --- a/_CoqProject +++ b/_CoqProject @@ -17,5 +17,6 @@ scara.v derive_matrix.v differential_kinematics.v extra_trigo.v +tilt.v -R . robot diff --git a/tilt.v b/tilt.v index 0b4f38ad..cf5bf93c 100644 --- a/tilt.v +++ b/tilt.v @@ -1,5 +1,6 @@ From mathcomp Require Import all_ssreflect all_algebra ring. -From mathcomp Require Import boolp classical_sets reals topology normedtype derive. +From mathcomp Require Import boolp classical_sets functions reals. +From mathcomp Require Import topology normedtype derive. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Set Implicit Arguments. @@ -12,8 +13,6 @@ Import numFieldNormedType.Exports. Local Open Scope ring_scope. -Definition S2 (K : realType) : Type := { x : 'rV[K]_3 | norm x = 1 }. - Section problem_statement. Context {K : realType}. Variable W : Frame.t K. (* world frame *) @@ -139,7 +138,7 @@ elim/big_ind2 : _ => //. by []. - move => a b c d. move => H1 H2. - rewrite -H1 //. + rewrite -H1 //. rewrite -H2 //. rewrite -!mulmxE. About rotation_tr_mul. @@ -148,7 +147,7 @@ elim/big_ind2 : _ => //. Search "mulmxA". Search "rotation_tr_mul". Search "trmx". - + rewrite -!rotation_inv. rewrite !mulmxA. rewrite -mulmxA -(mulmxA). @@ -160,3 +159,68 @@ elim/big_ind2 : _ => //. Admitted. End basic_facts. +Section Gamma1. +Context {K : realType}. +Local Open Scope classical_set_scope. + +Definition Gamma1 := [set x : 'rV[K]_6 | norm (@rsubmx _ 1 3 3 x) = 1]. + +End Gamma1. + +Section ode. +Context {K : realType} {T : normedModType K}. +Local Open Scope classical_set_scope. + +Variable f : K -> (K -> T) -> T. + +Definition is_solution (x : K -> T) : Prop := + forall t, x^`() t = f t x. + +Definition equilibrium_points := [set p : T | is_solution (cst p)]. + +Definition state_space := + [set p : T | exists y, is_solution y /\ p \in range y]. + +End ode. + +Section eqn33. +Context {K : realType}. +Variable alpha1 : K. +Hypothesis alpha1_gt0 : 0 < alpha1. +Variable gamma : K. +Hypothesis gamma_gt0 : 0 < gamma. +Local Open Scope classical_set_scope. + +Definition eqn33 t (zp1_z2 : K -> 'rV[K]_6) : 'rV[K]_6 := + let zp1 t := @lsubmx _ 1 3 3 (zp1_z2 t) in + let z2 t := @rsubmx _ 1 3 3 (zp1_z2 t) in + row_mx (- alpha1 *: zp1 t) + (gamma *: (z2 t - zp1 t) *m \S('e_2%:R - z2 t) ^+ 2). + +Lemma thm11a : state_space eqn33 = Gamma1. +Proof. +apply/seteqP; split. + move=> p. + rewrite /state_space /Gamma1/=. + admit. +admit. +Admitted. + +Definition point1 : 'rV[K]_6 := 0. +Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2%:R). + +Lemma equilibrium_point1 : point1 \in equilibrium_points eqn33. +Proof. +Admitted. + +Lemma equilibrium_point2 : point2 \in equilibrium_points eqn33. +Proof. +Admitted. + +Lemma tractories_converge (y : K -> 'rV[K]_6) : is_solution eqn33 y -> + y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. +Proof. +move=> is_sol_y. +Abort. + +End eqn33. From c65d3b239e40eaedf8daae23de6110edeb36b0f9 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Mon, 16 Jun 2025 10:46:37 +0900 Subject: [PATCH 005/144] started lyapunov function formalization --- tilt.v | 540 +++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 428 insertions(+), 112 deletions(-) diff --git a/tilt.v b/tilt.v index cf5bf93c..9a1beaf9 100644 --- a/tilt.v +++ b/tilt.v @@ -13,16 +13,24 @@ Import numFieldNormedType.Exports. Local Open Scope ring_scope. +Parameter K : realType. +Parameter W : Frame.t K. (* world frame *) +Parameter L : Frame.t K. (* sensor frame *) +Parameter v : K -> 'rV[K]_3. (* linear velocity *) +Parameter w : 'rV[K]_3. (* angular velocity *) +Parameter g0 : K. (* standard gravity constant *) +Parameter R : K -> 'M[K]_3. (* orientation of the IMU w.r.t. the world *) +Definition ez : 'rV[K]_3 := 'e_2. +Definition x1 := v. +Parameter m : 'rV[K]_3. +Definition x2 t := ez *m (R t)^T. +Definition x3 t := m *m (R t)^T. +Axiom g0_pos : 0 < g0. +Parameter alpha1 : K. +Parameter gamma : K. +Axiom gamma_gt0 : 0 < gamma. +Axiom alpha1_gt0 : 0 < alpha1. Section problem_statement. -Context {K : realType}. -Variable W : Frame.t K. (* world frame *) -Variable L : Frame.t K. (* sensor frame *) -Variable v : K -> 'rV[K]_3. (* linear velocity *) -Variable w : 'rV[K]_3. (* angular velocity *) -Variable g0 : K. (* standard gravity constant *) -Variable R : K -> 'M[K]_3. (* orientation of the IMU w.r.t. the world *) -Let ez : 'rV[K]_3 := 'e_2. -Variable m : 'rV[K]_3. Definition rhs23 t := v t *m \S(w) + derive1mx v t + g0 *: ez *m (R t)^T. @@ -31,16 +39,9 @@ Definition rhs24 t := m *m (R t)^T. Definition eqn25 t := derive1mx R t = R t *m \S(w). -Definition x1 := v. - -Definition x2 t := ez *m (R t)^T. - -Definition x3 t := m *m (R t)^T. - End problem_statement. Section basic_facts. -Context {K : realType}. Lemma fact212 (v w : 'rV[K]_3) : \S(v) * \S(w) = w^T *m v - (v *m w^T)``_0 *: 1. Proof. @@ -57,106 +58,45 @@ by rewrite mulrC. by rewrite !opprD; ring. Qed. -About subr0. -Search "subr0". -Locate subr0. Lemma fact213 (v w : 'rV[K]_3) : \S(v) * \S(w) * \S(v) = - (v *m w^T) ``_0 *: \S(v). Proof. - rewrite fact212. - rewrite mulrBl. - rewrite -mulmxE. - Search (_*m_) (_*_). - rewrite -mulmxA. - have: v *m \S(v) = 0. +rewrite fact212 mulrBl -mulmxE -mulmxA; have: v *m \S(v) = 0. apply: trmx_inj. - Search ( _ *m _^T). - rewrite trmx_mul. - Search ( \S(_)^T ). - rewrite tr_spin. - Search (\S(_) ) 0. - rewrite mulNmx. - About mulNmx. - rewrite spin_mul_tr. - (*Unset Printing Notations.*) - rewrite trmx0. - rewrite oppr0. - by []. - move => ->. - rewrite mulmx0. - rewrite sub0r. - Search (_*m _) (_*: _). - Search ( _%:A). - rewrite -mul_scalar_mx. - rewrite -mulNmx. - congr (_ *m _). - rewrite scalemx1. - rewrite rmorphN /=. (* simpl*) - by []. + by rewrite trmx_mul tr_spin mulNmx spin_mul_tr trmx0 oppr0. +move => ->. +by rewrite mulmx0 sub0r -mul_scalar_mx -mulNmx; congr (_ *m _) ; rewrite scalemx1 rmorphN /=. Qed. + Lemma fact215 ( v w : 'rV[K]_3) : \S(w *m \S(v)) = \S(w) * \S(v) - \S(v) * \S(w). Proof. - Search ( \S(_ )). - Search (_*v_) (_*m_). - rewrite spinE. - rewrite spin_crossmul. - by []. +by rewrite spinE spin_crossmul. Qed. Lemma fact216 (v w : 'rV[K]_3): \S(w *m \S(v)) = v^T *m w - w^T *m v. Proof. - rewrite fact215. - - rewrite !fact212. - Search (_%:A). - rewrite -!/(_ *d _). - Search (_^T). - Search "dotmulC". - rewrite dotmulC. - rewrite opprB. - rewrite addrA. - rewrite subrK. - by []. +by rewrite fact215 !fact212 -!/(_ *d _) dotmulC opprB addrA subrK. Qed. Search (\S(_)). Lemma fact217 (v : 'rV[K]_3): \S(v) ^+ 3 = - (norm v ^+2) *: \S(v). - (*Set Printing All.*) exact: spin3. Qed. Search "cV". -(* ligne!, R est une matrice de rotation, chaque v_i est un vecteur > - trouver la notation indicielle *) Lemma fact214 (R : 'M[K]_3) (v_ : seq 'rV[K]_3) : R \is 'SO[K]_3 -> R^T * (\prod_(i <- v_) \S( i )) * R = (\prod_(i <- v_) \S( i *m R)). -(* cest spin_similarity mais avec une somme. neutraliser la somme?*) Proof. move => RSO. elim/big_ind2 : _ => //. - rewrite -!mulmxE. - rewrite mulmx1. - rewrite rotation_tr_mul. - by []. - by []. -- move => a b c d. - move => H1 H2. - rewrite -H1 //. - rewrite -H2 //. - rewrite -!mulmxE. - About rotation_tr_mul. - (*Set Printing Parentheseses*) - Search "mulrC". - Search "mulmxA". - Search "rotation_tr_mul". - Search "trmx". - - rewrite -!rotation_inv. - rewrite !mulmxA. - rewrite -mulmxA -(mulmxA). - admit. - About spin_similarity. - Print is_true. -- (*move => i _. - exact: spin_similarity.*) - Admitted. + by rewrite -!mulmxE mulmx1 rotation_tr_mul. +- move => a b c d H1 H2. + rewrite -H1 // -H2 // -!mulmxE -!rotation_inv // !mulmxA -[R^-1 *m b *m R *m R^-1]mulmxA. + rewrite mulmxV; last first. + rewrite unitmxE. + apply: orthogonal_unit. + exact: rotation_sub. + by rewrite -[R^-1 *m b *m 1%:M *m d]mulmxA mul1mx. +- move => i true. + exact: spin_similarity. +Qed. End basic_facts. Section Gamma1. @@ -184,39 +124,83 @@ Definition state_space := End ode. Section eqn33. -Context {K : realType}. -Variable alpha1 : K. -Hypothesis alpha1_gt0 : 0 < alpha1. -Variable gamma : K. -Hypothesis gamma_gt0 : 0 < gamma. -Local Open Scope classical_set_scope. -Definition eqn33 t (zp1_z2 : K -> 'rV[K]_6) : 'rV[K]_6 := - let zp1 t := @lsubmx _ 1 3 3 (zp1_z2 t) in - let z2 t := @rsubmx _ 1 3 3 (zp1_z2 t) in - row_mx (- alpha1 *: zp1 t) - (gamma *: (z2 t - zp1 t) *m \S('e_2%:R - z2 t) ^+ 2). +Definition eqn33 t (zp1_z2_point : K -> 'rV[K]_6) : 'rV[K]_6 := + let zp1_point t := @lsubmx _ 1 3 3 (zp1_z2_point t) in + let z2_point t := @rsubmx _ 1 3 3 (zp1_z2_point t) in + row_mx (- alpha1 *: zp1_point t) + (gamma *: (z2_point t - zp1_point t) *m \S('e_2%:R - z2_point t) ^+ 2). + +(* cauchy lipschitz par F1 qui definit un champ de vecteur lisse : +il existe une solution depuis tout point: +gamma1 ⊆ state_space*) +(* prouver invariance geometrique, tangence donc les trajectoires restent dans gamma1: + state_space ⊆ gamma1 +Definition xi1 t (zp1_zp2 : K -> 'rV[K]_6) : Gamma1 := + let zp1*) Lemma thm11a : state_space eqn33 = Gamma1. Proof. -apply/seteqP; split. - move=> p. - rewrite /state_space /Gamma1/=. - admit. +apply/seteqP. split. + - move=> p. + rewrite /state_space /Gamma1 /eqn33 /is_solution /=. + move=> y. + Search (norm) 1. + destruct y as [y0 [Heq Hrange]]. + admit. + move => p. + rewrite /state_space /Gamma1 /eqn33 /is_solution /=. + move => y. +rewrite /state_space /Gamma1 /eqn33 /is_solution. admit. Admitted. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2%:R). +Check equilibrium_points _. + Lemma equilibrium_point1 : point1 \in equilibrium_points eqn33. Proof. -Admitted. +rewrite /equilibrium_points /is_solution inE /=. +move => t ; rewrite derive1_cst /eqn33 /point1 ; apply/eqP ; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. + rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; by rewrite !mxE. + apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. + rewrite /N /=; apply /rowP; move => a; by rewrite !mxE subr0. + move => n; by rewrite n scaler0 mul0mx. +Qed. +From mathcomp Require Import fintype. Lemma equilibrium_point2 : point2 \in equilibrium_points eqn33. Proof. -Admitted. +rewrite /equilibrium_points /is_solution inE /= /eqn33 /point2 /= ; move => t; rewrite derive1_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. +set N := (X in _ *: X == 0 /\ _). +have N0 : N = 0. + apply/rowP; move => i; rewrite !mxE; case: splitP. + move => j _; by rewrite mxE. + move => k /= i3k. + have := ltn_ord i. + by rewrite i3k -ltn_subRL subnn. +split. + by rewrite scaler_eq0 N0 eqxx orbT. +rewrite -scalemxAl scalemx_eq0 gt_eqF//=. + rewrite -/N N0 subr0. + set M := (X in X *m _); rewrite -/M. + have ME : M = 2 *: 'e_2. + apply/rowP => i; rewrite !mxE eqxx/=. + case: splitP => [j ij|j]/=. + have := ltn_ord j. + by rewrite -ij. + move/eqP. + rewrite eqn_add2l => /eqP /ord_inj ->. + by rewrite !mxE eqxx/=. + rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. + by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. +exact gamma_gt0. +Qed. +Open Scope classical_set_scope. +(* this lemma asks for lyapunov + lasalle*) Lemma tractories_converge (y : K -> 'rV[K]_6) : is_solution eqn33 y -> y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. Proof. @@ -224,3 +208,335 @@ move=> is_sol_y. Abort. End eqn33. + +Section Lyapunov. +(* locally positive definite around x that is an equilibrium point *) + +From mathcomp.analysis Require Import topology normedtype. +Open Scope classical_set_scope. + +Definition lpd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := + V x = 0 /\ \forall z \near 0^', V z > 0. +About lpd. + +(* locally positive semi definite*) +Definition lpsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := + V x = 0 /\ \forall z \near 0, V z >= 0. + +(*locally negative semidefinite *) +Definition lnsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := + V x = 0 /\ \forall z \near 0, V z <= 0. + +(*locally negative definite*) +Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := + V x = 0 /\ \forall z \near 0, V z < 0. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. +Local Open Scope classical_set_scope. + +Definition err_vec {R : ringType} {n : nat} (i : 'I_n.+1) : 'rV[R]_n.+1 := +\row_(j < n.+1) (i == j)%:R. + +Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := +lim (h^-1 * (f (a + h *: err_vec i) - f a) @[h --> 0^']). + +Definition gradient {R : realType} {n: nat} {v_ : seq 'I_n.+1} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : 'rV[R]_n.+1 := + (\sum_(i <- v_) (partial f a i *: 'e_i)). + +Definition LieDerivative {R : realType} {n : nat} + (V : 'rV[R]_n.+1 -> R) + (x : R -> 'rV[R]_n.+1) + (t : R) : R := + let xdot_t := (x^`()) t in + (@gradient R n (enum 'I_n.+1) V (x t)) *d xdot_t. + +Definition is_lyapunov_function {n : nat} + (f : K -> (K -> 'rV[K]_n.+1) -> 'rV[K]_n.+1) + (V : 'rV[K]_n.+1 -> K) + (x0 : 'rV[K]_n.+1) : Prop := + f 0 (fun _ => x0) = 0 /\ + lpd V x0 /\ + forall traj : K -> 'rV[K]_n.+1, + is_solution f traj -> + traj 0 = x0 -> + lnsd (fun t => LieDerivative V traj t) 0. + +Variable x1_hat : K -> 'rV[K]_3. +Variable x2_hat : K -> 'rV[K]_3. +Hypothesis alpha1_gt0 : 0 < alpha1. + +Definition p1 t : 'rV[K]_3 := + let x1_t := x1 t in + let x2_t := x2 t in + let x1_hat_t := x1_hat t in + x2_t + (alpha1 / g0) *: (x1_t - x1_hat_t). + +Definition x2_tilde t : 'rV[K]_3 := + let x2_t := x2 t in + let x2_hat_t := x2_hat t in + (x2_t - x2_hat_t). (* dependance des conditions intiales de ^x2 qui doit etre sur S2.*) + +Definition zp1_z2_eq t (zp1_z2 : K -> 'rV[K]_6) : 'rV[K]_6 := + let zp1 t := @lsubmx K 1 3 3 (zp1_z2 t) in + let z2 t := @rsubmx K 1 3 3 (zp1_z2 t) in + row_mx ((p1 t) *m R t) ((x2_tilde t) *m R t). + +Definition V1 (eq_result : 'rV[K]_6) : K := + let zp1 := @lsubmx K 1 3 3 eq_result in + let z2 := @rsubmx K 1 3 3 eq_result in + (norm zp1)^+2 / (2%:R * alpha1) + (norm z2)^+2 / (2%:R * gamma). +Search ( {ffun _ -> _} ). + +Definition ffun_to_rV6 (f : {ffun 'I_1 * 'I_6 -> K}) : 'rV_6 := + \row_(i < 6) f (ord0, i). + +Lemma V1_is_lyapunov : is_lyapunov_function eqn33 V1 point1. +Proof. +split. + rewrite /lpd /V1 /eqn33 /point1 /= ; apply/eqP ; rewrite (@row_mx_eq0 _ 1 3 3); apply/andP. + split. + by rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; rewrite !mxE. + apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. + by rewrite /N /=; apply /rowP; move => a; rewrite !mxE subr0. + move => n; by rewrite n scaler0 mul0mx. +(* lpd V1 point1 /\ + (forall traj : K -> 'rV_6, + is_solution eqn33 traj -> traj 0 = point1 -> lnsd [eta LieDerivative V1 traj] 0)*) +split. +(* v1 at point 1 is positive definite*) + rewrite /lpd /V1 /point1 -!dotmulvv. + split. + (* lsubmx 0 *d lsubmx 0 / (2 * alpha1) + rsubmx 0 *d rsubmx 0 / (2 * gamma) = 0*) + apply/eqP; set N := (X in X + _ == 0 ). have N0 : lsubmx 0 *d lsubmx 0 = 0. + rewrite /N /=. move => i j k n. + apply/eqP. + have M : lsubmx 0 = 0. move => t n0 n1 n2; apply/matrixP; move => d /= p; rewrite !mxE /=. + by []. + by rewrite M dotmul0v. + rewrite /N N0 mul0r add0r. + have B0 : rsubmx 0 = 0. move => t n n0 n1. + by apply/eqP; apply/eqP/matrixP => i j; rewrite !mxE. + by rewrite B0 dotmul0v mul0r. + (* \forall z \near 0^', 0 < + norm (lsubmx z) ^+ 2 / (2 * alpha1) + norm (rsubmx z) ^+ 2 / (2 * gamma)*) + have alpha1_pos: 0 < 2 * alpha1 by rewrite mulr_gt0 // ltr0Sn. + have gamma_pos: 0 < 2 * gamma by rewrite mulr_gt0 // gamma_gt0. + near=> z_near. + set z_rv := ffun_to_rV6 (\val z_near). + have z_neq0 : z_near != 0. + by near: z_near; apply: nbhs_dnbhs_neq. + have z_mat_neq0 : z_rv != 0. + rewrite /z_rv. + apply/eqP. + move=> zmat0. + move: z_neq0. + move=> z_near_neq0. + rewrite /z_rv in zmat0. + have val_inj := @val_inj _ _ _. + move: z_near_neq0 zmat0. + move=> nz_eq0 conv0. + have inj_ffun : forall f, ffun_to_rV6 f = 0 -> f = 0. + move=> f f2. + apply/ffunP =>[[ i j]]. + rewrite (ord1 i). + move: f2. + rewrite /ffun_to_rV6. + move/rowP => Hrow. + specialize (Hrow j). + rewrite !mxE in Hrow. + (*rewrite (Hrow : f (ord0, j) = 0).*) + rewrite /GRing.zero in Hrow. + rewrite /ffun0. + rewrite Hrow /=. + rewrite /=. + Check 0. + rewrite /GRing.isNmodule.zero. + rewrite /ffun0. + Check Hrow. + have zero_eq : 0 (ord0, j) = GRing.isNmodule.zero (GRing.Nmodule.class K). + by rewrite /ffun0. + transitivity (GRing.isNmodule.zero (GRing.Nmodule.class K)). + - by []. + - by rewrite ffunE. + have val_z_eq0 : \val z_near = 0 by apply/inj_ffun. + have z_eq0 : z_near = 0. + apply: val_inj => //. rewrite val_z_eq0. + rewrite /=. + apply/ffunP => [[i j]]. + rewrite !ffunE. + rewrite /ffun0. + rewrite /ffun0. + rewrite /GRing.zero. + rewrite /GRing.isNmodule.zero /mx_val /=. + admit. + rewrite z_eq0 in nz_eq0. + move: nz_eq0. + by rewrite eq_refl. + apply: addr_gt0. + apply: divr_gt0. + apply exprn_gt0. + admit. + by apply alpha1_pos. + apply: divr_gt0; last by apply: gamma_pos. + apply: exprn_gt0. + have := norm_gt0 (rsubmx (z_near : 'rV_(3+3))). + rewrite !norm_gt0 /=. + move => _. + pose z_rv' := (z_rv : 'rV_(3 + 3)). + have Hr : rsubmx z_rv' != 0. + move: z_mat_neq0. + move=> /eqP Hnz. + apply/eqP => /eqP Hr. + have Hl : rsubmx z_rv' == 0. + move: Hnz. + by move => _. + move/eqP : Hl => Hl'. + move/eqP : Hr => Hr'. + rewrite /z_rv' in Hnz. + admit. + admit. +move => traj dtraj. +rewrite /LieDerivative /V1 /point1 /lnsd /gradient /partial /err_vec /= . +move => traj0. +elim/big_ind : _ => //. +split. + by rewrite dotmul0v. + near=> z_near. + elim/big_ind : _ => //. + by rewrite dotmul0v. + move => x y s v. + rewrite dotmulDl /= -oppr_ge0 -oppr_le0 /= opprK -oppr_ge0 opprD addr_ge0. + by []. + by rewrite oppr_ge0. + by rewrite oppr_ge0. + move => i f. + rewrite !sqr_norm. + elim/big_ind : _ => //. + elim/big_ind : _ => //. + rewrite !mul0r !add0r /=. + have /cvg_lim: (h^-1 * (norm (lsubmx ((traj z_near + + h *: (\row_j (i == j)%:R : 'rV_6)) : 'rV_(3+3))) ^+ 2 / (2 * alpha1) + + norm (rsubmx ((traj z_near + h *: (\row_j (i == j)%:R : 'rV_6)) : 'rV_(3+3))) ^+ 2 / (2 * gamma) - 0) + @[h --> 0^']) --> (0:K). + set v := (\row_j (i == j)%:R : 'rV_6). + have v_structure: v = \row_j (i == j)%:R. + by rewrite /v. + have taylor: forall h, + norm (traj z_near + h *: v) ^+ 2 = + norm (traj z_near) ^+ 2 + + 2 * h * dotmul (traj z_near) v + + h^2 * norm v ^+ 2. + move=> h. + rewrite !dotmulE. + have norm_expand: norm (traj z_near + h *: v) ^+ 2 = + (traj z_near + h *: v) *d (traj z_near + h *: v). + rewrite !dotmulE. + rewrite /norm /= dotmulE. + rewrite sqr_sqrtr //. + apply: sumr_ge0 => k _. + rewrite sqr_ge0. + by []. + rewrite norm_expand. + rewrite dotmulDl dotmulDr. + rewrite -!dotmulE /=. + rewrite dotmulDr. + rewrite dotmulZv dotmulvZ. + rewrite (dotmulC v (traj z_near)). + rewrite dotmulvZ dotmulZv. + rewrite mulrDl. + rewrite mulrA -expr2. + rewrite -!dotmulvv. + rewrite mul1r. + rewrite -mulr2n. + ring. + have /cvg_lim: h^-1 * + ((norm (lsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * alpha1) + + (norm (rsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * gamma) - 0) + @[h --> 0^'] --> 0. + pose F h := h^-1 * + ((norm (lsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * alpha1) + + (norm (rsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * gamma) - 0). + have split_norm : + forall u : 'rV_(3 + 3), + norm u ^+ 2 = norm (lsubmx u) ^+ 2 + norm (rsubmx u) ^+ 2. + move=> u. + admit. + admit. +(* generalize to lsubmx and rsubmx*) + admit. + admit. + move => x y s v. + admit. + move => i0 t. + have equilibrium : eqn33 z_near traj = 0. + admit. +admit. + move => x y s v. + admit. + move => i0 t. + admit. + move => x y s v. + split. + admit. + near=> z. + elim/big_ind : _ => //. + by rewrite dotmul0v. + move=> x0 y0 b a. + rewrite dotmulDl. + Search "dotmul". + rewrite -[X in X <= 0]addr0. + rewrite -subr_le0. + have : 0 - (x + y) = (-x) + (-y). + Search "oppr". + rewrite opprD. + by rewrite add0r. + move => i. + rewrite subr0 addr0. + rewrite -dotmulDl. + admit. + move=> i0 t. + admit. + move => i0 t. + split. + rewrite traj0 /=. + rewrite !sqr_norm /=. + elim/big_ind : _ => //. + elim/big_ind : _ => //. + rewrite mul0r. + rewrite add0r. + rewrite mul0r. + admit. + move=> x y s v. + rewrite mul0r add0r /=. + admit. + move => i tr. + rewrite mul0r add0r. + admit. + move => x y s v. + admit. + move => i tru. +admit. + near=> z_near. + elim/big_ind : _ => //. + by rewrite dotmul0v. + move => x0 y0 tr a. + + admit. + move => i tru. + rewrite expr2. + rewrite !sqr_norm. + elim/big_ind : _ => //. + rewrite !mul0r addr0. + admit. + move => x0 y0 s v. + admit. + move => i1 tr. + rewrite !expr2 . + admit. +Admitted. + +End Lyapunov. From d682a1fe6496552b71af75598a1a11c56b96fdc0 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 16 Jun 2025 14:00:07 +0900 Subject: [PATCH 006/144] fixes --- tilt.v | 423 ++++++++++++++++++++++++++------------------------------- 1 file changed, 194 insertions(+), 229 deletions(-) diff --git a/tilt.v b/tilt.v index 9a1beaf9..04d9940b 100644 --- a/tilt.v +++ b/tilt.v @@ -116,7 +116,9 @@ Variable f : K -> (K -> T) -> T. Definition is_solution (x : K -> T) : Prop := forall t, x^`() t = f t x. -Definition equilibrium_points := [set p : T | is_solution (cst p)]. +Definition is_equilibrium_point p := is_solution (cst p). + +Definition equilibrium_points := [set p : T | is_equilibrium_point p]. Definition state_space := [set p : T | exists y, is_solution y /\ p \in range y]. @@ -160,9 +162,8 @@ Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2%:R). Check equilibrium_points _. -Lemma equilibrium_point1 : point1 \in equilibrium_points eqn33. +Lemma equilibrium_point1 : is_equilibrium_point eqn33 point1. Proof. -rewrite /equilibrium_points /is_solution inE /=. move => t ; rewrite derive1_cst /eqn33 /point1 ; apply/eqP ; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; by rewrite !mxE. apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. @@ -171,9 +172,9 @@ move => t ; rewrite derive1_cst /eqn33 /point1 ; apply/eqP ; rewrite eq_sym (@ro Qed. From mathcomp Require Import fintype. -Lemma equilibrium_point2 : point2 \in equilibrium_points eqn33. +Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2. Proof. -rewrite /equilibrium_points /is_solution inE /= /eqn33 /point2 /= ; move => t; rewrite derive1_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. +move => t; rewrite derive1_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). have N0 : N = 0. apply/rowP; move => i; rewrite !mxE; case: splitP. @@ -209,15 +210,36 @@ Abort. End eqn33. +Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := + \row_(j < n.+1) (i == j)%:R. + +Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := + lim (h^-1 * (f (a + h *: err_vec i) - f a) @[h --> 0^'])%classic. + +Definition gradient {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := + \row_(i < n.+1) partial f a i. + +Lemma gradientE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : + gradient f a = \sum_(i < n.+1) partial f a i *: 'e_i. +Proof. +rewrite /gradient [LHS]row_sum_delta. +by under eq_bigr do rewrite mxE. +Qed. + +Lemma lsubmx0 {R : nmodType} m n1 n2 : @lsubmx R m n1 n2 0 = 0. +Proof. by apply/matrixP => i j; rewrite !mxE. Qed. + +Lemma rsubmx0 {R : nmodType} m n1 n2 : @rsubmx R m n1 n2 0 = 0. +Proof. by apply/matrixP => i j; rewrite !mxE. Qed. + Section Lyapunov. (* locally positive definite around x that is an equilibrium point *) From mathcomp.analysis Require Import topology normedtype. Open Scope classical_set_scope. -Definition lpd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := +Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := V x = 0 /\ \forall z \near 0^', V z > 0. -About lpd. (* locally positive semi definite*) Definition lpsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := @@ -231,47 +253,30 @@ Definition lnsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Pro Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := V x = 0 /\ \forall z \near 0, V z < 0. -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. -Import Order.TTheory GRing.Theory Num.Def Num.Theory. -Import numFieldNormedType.Exports. Local Open Scope classical_set_scope. -Definition err_vec {R : ringType} {n : nat} (i : 'I_n.+1) : 'rV[R]_n.+1 := -\row_(j < n.+1) (i == j)%:R. - -Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := -lim (h^-1 * (f (a + h *: err_vec i) - f a) @[h --> 0^']). - -Definition gradient {R : realType} {n: nat} {v_ : seq 'I_n.+1} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : 'rV[R]_n.+1 := - (\sum_(i <- v_) (partial f a i *: 'e_i)). - -Definition LieDerivative {R : realType} {n : nat} - (V : 'rV[R]_n.+1 -> R) - (x : R -> 'rV[R]_n.+1) - (t : R) : R := +Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) (x : R -> 'rV[R]_n.+1) (t : R) : R := let xdot_t := (x^`()) t in - (@gradient R n (enum 'I_n.+1) V (x t)) *d xdot_t. + gradient V (x t) *d xdot_t. -Definition is_lyapunov_function {n : nat} +Definition is_lyapunov_function n (f : K -> (K -> 'rV[K]_n.+1) -> 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) (x0 : 'rV[K]_n.+1) : Prop := - f 0 (fun _ => x0) = 0 /\ - lpd V x0 /\ + [/\ is_equilibrium_point f x0, + locposdef V x0 & forall traj : K -> 'rV[K]_n.+1, is_solution f traj -> traj 0 = x0 -> - lnsd (fun t => LieDerivative V traj t) 0. + lnsd (LieDerivative V traj) 0]. Variable x1_hat : K -> 'rV[K]_3. Variable x2_hat : K -> 'rV[K]_3. Hypothesis alpha1_gt0 : 0 < alpha1. -Definition p1 t : 'rV[K]_3 := +Definition p1 t : 'rV[K]_3 := let x1_t := x1 t in - let x2_t := x2 t in + let x2_t := x2 t in let x1_hat_t := x1_hat t in x2_t + (alpha1 / g0) *: (x1_t - x1_hat_t). @@ -296,89 +301,48 @@ Definition ffun_to_rV6 (f : {ffun 'I_1 * 'I_6 -> K}) : 'rV_6 := Lemma V1_is_lyapunov : is_lyapunov_function eqn33 V1 point1. Proof. -split. - rewrite /lpd /V1 /eqn33 /point1 /= ; apply/eqP ; rewrite (@row_mx_eq0 _ 1 3 3); apply/andP. - split. - by rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; rewrite !mxE. - apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. - by rewrite /N /=; apply /rowP; move => a; rewrite !mxE subr0. - move => n; by rewrite n scaler0 mul0mx. +split; first exact: equilibrium_point1. (* lpd V1 point1 /\ (forall traj : K -> 'rV_6, is_solution eqn33 traj -> traj 0 = point1 -> lnsd [eta LieDerivative V1 traj] 0)*) -split. (* v1 at point 1 is positive definite*) - rewrite /lpd /V1 /point1 -!dotmulvv. - split. - (* lsubmx 0 *d lsubmx 0 / (2 * alpha1) + rsubmx 0 *d rsubmx 0 / (2 * gamma) = 0*) - apply/eqP; set N := (X in X + _ == 0 ). have N0 : lsubmx 0 *d lsubmx 0 = 0. - rewrite /N /=. move => i j k n. - apply/eqP. - have M : lsubmx 0 = 0. move => t n0 n1 n2; apply/matrixP; move => d /= p; rewrite !mxE /=. - by []. - by rewrite M dotmul0v. - rewrite /N N0 mul0r add0r. - have B0 : rsubmx 0 = 0. move => t n n0 n1. - by apply/eqP; apply/eqP/matrixP => i j; rewrite !mxE. - by rewrite B0 dotmul0v mul0r. +- rewrite /locposdef; split. + + by rewrite /V1 /point1 lsubmx0 rsubmx0 norm0 expr0n/= !mul0r add0r. (* \forall z \near 0^', 0 < norm (lsubmx z) ^+ 2 / (2 * alpha1) + norm (rsubmx z) ^+ 2 / (2 * gamma)*) have alpha1_pos: 0 < 2 * alpha1 by rewrite mulr_gt0 // ltr0Sn. have gamma_pos: 0 < 2 * gamma by rewrite mulr_gt0 // gamma_gt0. near=> z_near. + simpl in *. set z_rv := ffun_to_rV6 (\val z_near). - have z_neq0 : z_near != 0. - by near: z_near; apply: nbhs_dnbhs_neq. + have z_neq0 : z_near != 0 by near: z_near; exact: nbhs_dnbhs_neq. have z_mat_neq0 : z_rv != 0. rewrite /z_rv. - apply/eqP. - move=> zmat0. - move: z_neq0. - move=> z_near_neq0. - rewrite /z_rv in zmat0. - have val_inj := @val_inj _ _ _. - move: z_near_neq0 zmat0. - move=> nz_eq0 conv0. - have inj_ffun : forall f, ffun_to_rV6 f = 0 -> f = 0. - move=> f f2. - apply/ffunP =>[[ i j]]. - rewrite (ord1 i). - move: f2. - rewrite /ffun_to_rV6. - move/rowP => Hrow. - specialize (Hrow j). - rewrite !mxE in Hrow. - (*rewrite (Hrow : f (ord0, j) = 0).*) - rewrite /GRing.zero in Hrow. - rewrite /ffun0. - rewrite Hrow /=. - rewrite /=. - Check 0. - rewrite /GRing.isNmodule.zero. - rewrite /ffun0. - Check Hrow. - have zero_eq : 0 (ord0, j) = GRing.isNmodule.zero (GRing.Nmodule.class K). - by rewrite /ffun0. - transitivity (GRing.isNmodule.zero (GRing.Nmodule.class K)). - - by []. - - by rewrite ffunE. - have val_z_eq0 : \val z_near = 0 by apply/inj_ffun. - have z_eq0 : z_near = 0. - apply: val_inj => //. rewrite val_z_eq0. - rewrite /=. - apply/ffunP => [[i j]]. - rewrite !ffunE. - rewrite /ffun0. - rewrite /ffun0. - rewrite /GRing.zero. - rewrite /GRing.isNmodule.zero /mx_val /=. - admit. - rewrite z_eq0 in nz_eq0. - move: nz_eq0. - by rewrite eq_refl. + rewrite /ffun_to_rV6. + apply: contra z_neq0 => /eqP H. + apply/eqP/rowP => i. + rewrite !mxE. + move/rowP : H => /(_ i). + by rewrite !mxE//. + rewrite /V1. + have /orP[/eqP lz0|/eqP rz0] : (@lsubmx _ _ 3 3 z_near != 0) || (@rsubmx _ _ 3 3 z_near != 0). + rewrite -negb_and. + apply: contra z_neq0 => /andP[/eqP l0 /eqP r0]. + rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. + admit. + + + + + admit. + + + apply: addr_gt0. - apply: divr_gt0. - apply exprn_gt0. + apply: divr_gt0. + apply exprn_gt0. + rewrite norm_gt0. + admit. by apply alpha1_pos. apply: divr_gt0; last by apply: gamma_pos. @@ -399,144 +363,145 @@ split. rewrite /z_rv' in Hnz. admit. admit. -move => traj dtraj. -rewrite /LieDerivative /V1 /point1 /lnsd /gradient /partial /err_vec /= . -move => traj0. -elim/big_ind : _ => //. -split. - by rewrite dotmul0v. - near=> z_near. - elim/big_ind : _ => //. - by rewrite dotmul0v. - move => x y s v. - rewrite dotmulDl /= -oppr_ge0 -oppr_le0 /= opprK -oppr_ge0 opprD addr_ge0. - by []. - by rewrite oppr_ge0. - by rewrite oppr_ge0. - move => i f. - rewrite !sqr_norm. - elim/big_ind : _ => //. - elim/big_ind : _ => //. - rewrite !mul0r !add0r /=. - have /cvg_lim: (h^-1 * (norm (lsubmx ((traj z_near - + h *: (\row_j (i == j)%:R : 'rV_6)) : 'rV_(3+3))) ^+ 2 / (2 * alpha1) + - norm (rsubmx ((traj z_near + h *: (\row_j (i == j)%:R : 'rV_6)) : 'rV_(3+3))) ^+ 2 / (2 * gamma) - 0) - @[h --> 0^']) --> (0:K). - set v := (\row_j (i == j)%:R : 'rV_6). - have v_structure: v = \row_j (i == j)%:R. - by rewrite /v. - have taylor: forall h, - norm (traj z_near + h *: v) ^+ 2 = - norm (traj z_near) ^+ 2 + - 2 * h * dotmul (traj z_near) v + - h^2 * norm v ^+ 2. - move=> h. - rewrite !dotmulE. - have norm_expand: norm (traj z_near + h *: v) ^+ 2 = - (traj z_near + h *: v) *d (traj z_near + h *: v). +- move => traj dtraj. + rewrite /LieDerivative /V1 /point1 /lnsd. + move => traj0. + rewrite gradientE; elim/big_ind : _ => //. + split. + by rewrite dotmul0v. + near=> z_near. + rewrite gradientE; elim/big_ind : _ => //. + by rewrite dotmul0v. + move => x y s v. + rewrite dotmulDl /= -oppr_ge0 -oppr_le0 /= opprK -oppr_ge0 opprD addr_ge0. + by []. + by rewrite oppr_ge0. + by rewrite oppr_ge0. + move => i f. + rewrite /partial. + rewrite !sqr_norm. + elim/big_ind : _ => //. + elim/big_ind : _ => //. + rewrite !mul0r !add0r /=. + have /cvg_lim: (h^-1 * (norm (lsubmx ((traj z_near + + h *: (\row_j (i == j)%:R : 'rV_6)) : 'rV_(3+3))) ^+ 2 / (2 * alpha1) + + norm (rsubmx ((traj z_near + h *: (\row_j (i == j)%:R : 'rV_6)) : 'rV_(3+3))) ^+ 2 / (2 * gamma) - 0) + @[h --> 0^']) --> (0:K). + set v := (\row_j (i == j)%:R : 'rV_6). + have v_structure: v = \row_j (i == j)%:R. + by rewrite /v. + have taylor: forall h, + norm (traj z_near + h *: v) ^+ 2 = + norm (traj z_near) ^+ 2 + + 2 * h * dotmul (traj z_near) v + + h^2 * norm v ^+ 2. + move=> h. rewrite !dotmulE. - rewrite /norm /= dotmulE. - rewrite sqr_sqrtr //. - apply: sumr_ge0 => k _. - rewrite sqr_ge0. - by []. - rewrite norm_expand. - rewrite dotmulDl dotmulDr. - rewrite -!dotmulE /=. - rewrite dotmulDr. - rewrite dotmulZv dotmulvZ. - rewrite (dotmulC v (traj z_near)). - rewrite dotmulvZ dotmulZv. - rewrite mulrDl. - rewrite mulrA -expr2. - rewrite -!dotmulvv. - rewrite mul1r. - rewrite -mulr2n. - ring. - have /cvg_lim: h^-1 * - ((norm (lsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * alpha1) + - (norm (rsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * gamma) - 0) - @[h --> 0^'] --> 0. - pose F h := h^-1 * - ((norm (lsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * alpha1) + - (norm (rsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * gamma) - 0). - have split_norm : - forall u : 'rV_(3 + 3), - norm u ^+ 2 = norm (lsubmx u) ^+ 2 + norm (rsubmx u) ^+ 2. - move=> u. - admit. - admit. -(* generalize to lsubmx and rsubmx*) + have norm_expand: norm (traj z_near + h *: v) ^+ 2 = + (traj z_near + h *: v) *d (traj z_near + h *: v). + rewrite !dotmulE. + rewrite /norm /= dotmulE. + rewrite sqr_sqrtr //. + apply: sumr_ge0 => k _. + rewrite sqr_ge0. + by []. + rewrite norm_expand. + rewrite dotmulDl dotmulDr. + rewrite -!dotmulE /=. + rewrite dotmulDr. + rewrite dotmulZv dotmulvZ. + rewrite (dotmulC v (traj z_near)). + rewrite dotmulvZ dotmulZv. + rewrite mulrDl. + rewrite mulrA -expr2. + rewrite -!dotmulvv. + rewrite mul1r. + rewrite -mulr2n. + ring. + have /cvg_lim: h^-1 * + ((norm (lsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * alpha1) + + (norm (rsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * gamma) - 0) + @[h --> 0^'] --> 0. + pose F h := h^-1 * + ((norm (lsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * alpha1) + + (norm (rsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * gamma) - 0). + have split_norm : + forall u : 'rV_(3 + 3), + norm u ^+ 2 = norm (lsubmx u) ^+ 2 + norm (rsubmx u) ^+ 2. + move=> u. + admit. + admit. + (* generalize to lsubmx and rsubmx*) + admit. + admit. + move => x y s v. + admit. + move => i0 t. + have equilibrium : eqn33 z_near traj = 0. + admit. + admit. + move => x y s v. admit. + move => i0 t. admit. move => x y s v. + split. admit. - move => i0 t. - have equilibrium : eqn33 z_near traj = 0. + near=> z. + rewrite gradientE; elim/big_ind : _ => //. + by rewrite dotmul0v. + move=> x0 y0 b a. + rewrite dotmulDl. + Search "dotmul". + rewrite -[X in X <= 0]addr0. + rewrite -subr_le0. + have : 0 - (x + y) = (-x) + (-y). + Search "oppr". + rewrite opprD. + by rewrite add0r. + move => i. + rewrite subr0 addr0. + rewrite -dotmulDl. admit. -admit. - move => x y s v. - admit. - move => i0 t. - admit. - move => x y s v. - split. + move=> i0 t. + admit. + move => i0 t. + split. + rewrite traj0 /=. + rewrite /partial !sqr_norm /=. + elim/big_ind : _ => //. + elim/big_ind : _ => //. + rewrite mul0r. + rewrite add0r. + rewrite mul0r. + admit. + move=> x y s v. + rewrite mul0r add0r /=. + admit. + move => i tr. + rewrite mul0r add0r. + admit. + move => x y s v. + admit. + move => i tru. admit. - near=> z. - elim/big_ind : _ => //. - by rewrite dotmul0v. - move=> x0 y0 b a. - rewrite dotmulDl. - Search "dotmul". - rewrite -[X in X <= 0]addr0. - rewrite -subr_le0. - have : 0 - (x + y) = (-x) + (-y). - Search "oppr". - rewrite opprD. - by rewrite add0r. - move => i. - rewrite subr0 addr0. - rewrite -dotmulDl. - admit. - move=> i0 t. - admit. - move => i0 t. - split. - rewrite traj0 /=. - rewrite !sqr_norm /=. - elim/big_ind : _ => //. + near=> z_near. + rewrite gradientE; elim/big_ind : _ => //. + by rewrite dotmul0v. + move => x0 y0 tr a. + + admit. + move => i tru. + rewrite /partial expr2. + rewrite !sqr_norm. elim/big_ind : _ => //. - rewrite mul0r. - rewrite add0r. - rewrite mul0r. - admit. - move=> x y s v. - rewrite mul0r add0r /=. + rewrite !mul0r addr0. admit. - move => i tr. - rewrite mul0r add0r. + move => x0 y0 s v. admit. - move => x y s v. + move => i1 tr. + rewrite !expr2 . admit. - move => i tru. -admit. - near=> z_near. - elim/big_ind : _ => //. - by rewrite dotmul0v. - move => x0 y0 tr a. - - admit. - move => i tru. - rewrite expr2. - rewrite !sqr_norm. - elim/big_ind : _ => //. - rewrite !mul0r addr0. - admit. - move => x0 y0 s v. - admit. - move => i1 tr. - rewrite !expr2 . - admit. Admitted. End Lyapunov. From 39db71313e8d42809dffe1716a400f71d2b3790f Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Mon, 16 Jun 2025 15:24:45 +0900 Subject: [PATCH 007/144] update lyapunov --- tilt.v | 69 ++++++++++++++++++++++++++-------------------------------- 1 file changed, 31 insertions(+), 38 deletions(-) diff --git a/tilt.v b/tilt.v index 04d9940b..1f18f78f 100644 --- a/tilt.v +++ b/tilt.v @@ -243,15 +243,15 @@ Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : (* locally positive semi definite*) Definition lpsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0, V z >= 0. + V x = 0 /\ \forall z \near 0^', V z >= 0. (*locally negative semidefinite *) Definition lnsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0, V z <= 0. + V x = 0 /\ \forall z \near 0^', V z <= 0. (*locally negative definite*) Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0, V z < 0. + V x = 0 /\ \forall z \near 0^', V z < 0. Local Open Scope classical_set_scope. @@ -325,44 +325,37 @@ split; first exact: equilibrium_point1. move/rowP : H => /(_ i). by rewrite !mxE//. rewrite /V1. - have /orP[/eqP lz0|/eqP rz0] : (@lsubmx _ _ 3 3 z_near != 0) || (@rsubmx _ _ 3 3 z_near != 0). + have /orP[ lz0| rz0] : (@lsubmx _ _ 3 3 z_near != 0) || (@rsubmx _ _ 3 3 z_near != 0). rewrite -negb_and. apply: contra z_neq0 => /andP[/eqP l0 /eqP r0]. rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. - admit. - - - - - admit. - - - - apply: addr_gt0. - apply: divr_gt0. - apply exprn_gt0. - rewrite norm_gt0. - - admit. - by apply alpha1_pos. - apply: divr_gt0; last by apply: gamma_pos. - apply: exprn_gt0. - have := norm_gt0 (rsubmx (z_near : 'rV_(3+3))). - rewrite !norm_gt0 /=. - move => _. - pose z_rv' := (z_rv : 'rV_(3 + 3)). - have Hr : rsubmx z_rv' != 0. - move: z_mat_neq0. - move=> /eqP Hnz. - apply/eqP => /eqP Hr. - have Hl : rsubmx z_rv' == 0. - move: Hnz. - by move => _. - move/eqP : Hl => Hl'. - move/eqP : Hr => Hr'. - rewrite /z_rv' in Hnz. - admit. - admit. + apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP. + move => j k. by rewrite mxE. + move => k i3k. by rewrite mxE. + - set rsub := @rsubmx _ _ 3 3 z_near. + have : norm(rsub) >= 0 by rewrite norm_ge0. + set lsub := @lsubmx _ _ 3 3 z_near. + move => nor. + have : norm(lsub) > 0. + rewrite lt_neqAle. + by rewrite eq_sym norm_eq0 lz0 /= norm_ge0. + move => normlsub. + Search (_ < _ + _). + apply: ltr_pwDl. + rewrite divr_gt0 //. + by rewrite exprn_gt0 //. + rewrite divr_ge0 //. + by rewrite exprn_ge0 //. + by apply ltW. + - apply: ltr_pwDr. + rewrite divr_gt0 //. + rewrite exprn_gt0 //. + rewrite lt_neqAle. + Search (norm) 0. + rewrite eq_sym. + by rewrite norm_eq0 rz0 /= norm_ge0. + rewrite divr_ge0 // ?exprn_ge0 // ?norm_ge0 //. + by apply ltW. - move => traj dtraj. rewrite /LieDerivative /V1 /point1 /lnsd. move => traj0. From b2fbc08583c9feb7fd188cf4b8d76bf7f9ddac12 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 16 Jun 2025 19:50:38 +0900 Subject: [PATCH 008/144] fix --- tilt.v | 55 +++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 49 insertions(+), 6 deletions(-) diff --git a/tilt.v b/tilt.v index 1f18f78f..e3f6badc 100644 --- a/tilt.v +++ b/tilt.v @@ -232,6 +232,15 @@ Proof. by apply/matrixP => i j; rewrite !mxE. Qed. Lemma rsubmx0 {R : nmodType} m n1 n2 : @rsubmx R m n1 n2 0 = 0. Proof. by apply/matrixP => i j; rewrite !mxE. Qed. +Lemma dotmulsuml {R : ringType} [n : nat] (u : 'rV_n) (b : 'I_n -> 'rV[R]_n) : + (\sum_(i < n) b i) *d u = (\sum_(i < n) b i *d u). +Proof. +elim/big_ind2 : _ => //=. + by rewrite dotmul0v. +move=> x y r s <- <-. +by rewrite dotmulDl. +Qed. + Section Lyapunov. (* locally positive definite around x that is an equilibrium point *) @@ -255,10 +264,26 @@ Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop Local Open Scope classical_set_scope. -Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) (x : R -> 'rV[R]_n.+1) (t : R) : R := +Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) + (a : R -> 'rV[R]_n.+1) (t : R) : R := + \sum_(i < n.+1) partial V (a t) i * (a^`()%classic t) ``_ i. + +Definition LieDerivative_gradient {R : realType} n (V : 'rV[R]_n.+1 -> R) + (x : R -> 'rV[R]_n.+1) (t : R) : R := let xdot_t := (x^`()) t in gradient V (x t) *d xdot_t. +Lemma LieDerivative_gradientE {R : realType} n (V : 'rV[R]_n.+1 -> R) + (x : R -> 'rV[R]_n.+1) : + LieDerivative_gradient V x = LieDerivative V x. +Proof. +apply/funext => t; rewrite /LieDerivative_gradient /LieDerivative. +rewrite gradientE dotmulsuml; apply: eq_bigr => /= i _. +rewrite dotmulE (bigD1 i)//= big1 ?addr0; last first. + by move=> j ji; rewrite !mxE/= (negbTE ji) mulr0 mul0r. +by rewrite !mxE/= eqxx mulr1. +Qed. + Definition is_lyapunov_function n (f : K -> (K -> 'rV[K]_n.+1) -> 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) @@ -290,15 +315,32 @@ Definition zp1_z2_eq t (zp1_z2 : K -> 'rV[K]_6) : 'rV[K]_6 := let z2 t := @rsubmx K 1 3 3 (zp1_z2 t) in row_mx ((p1 t) *m R t) ((x2_tilde t) *m R t). -Definition V1 (eq_result : 'rV[K]_6) : K := - let zp1 := @lsubmx K 1 3 3 eq_result in - let z2 := @rsubmx K 1 3 3 eq_result in +Definition V1 (zp1_z2 : 'rV[K]_6) : K := + let zp1 := @lsubmx K 1 3 3 (zp1_z2) in + let z2 := @rsubmx K 1 3 3 (zp1_z2) in (norm zp1)^+2 / (2%:R * alpha1) + (norm z2)^+2 / (2%:R * gamma). -Search ( {ffun _ -> _} ). Definition ffun_to_rV6 (f : {ffun 'I_1 * 'I_6 -> K}) : 'rV_6 := \row_(i < 6) f (ord0, i). +Definition V1dot (zp1_z2 : 'rV[K]_6) : K := + let zp1 := @lsubmx K 1 3 3 (zp1_z2) in + let z2 := @rsubmx K 1 3 3 (zp1_z2) in + - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T + - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. + +Lemma derive_sqrt : (Num.sqrt^`())%classic = (fun t => (2 * Num.sqrt t)^-1) :> (_ -> K). +Proof. +Admitted. + +Lemma deriveV1 (x : K -> 'rV[K]_6) t : + LieDerivative V1 x t = V1dot (x t). +Proof. +rewrite /LieDerivative. +rewrite /V1dot. +rewrite !mxE. +Abort. + Lemma V1_is_lyapunov : is_lyapunov_function eqn33 V1 point1. Proof. split; first exact: equilibrium_point1. @@ -357,7 +399,8 @@ split; first exact: equilibrium_point1. rewrite divr_ge0 // ?exprn_ge0 // ?norm_ge0 //. by apply ltW. - move => traj dtraj. - rewrite /LieDerivative /V1 /point1 /lnsd. + rewrite -LieDerivative_gradientE. + rewrite /LieDerivative_gradient /V1 /point1 /lnsd. move => traj0. rewrite gradientE; elim/big_ind : _ => //. split. From eac1fd21ae2be06a8410d1f0c4f8311beda2a2a3 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Wed, 18 Jun 2025 11:18:15 +0900 Subject: [PATCH 009/144] derive norm lemma --- tilt.v | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 92 insertions(+), 2 deletions(-) diff --git a/tilt.v b/tilt.v index e3f6badc..05d532d1 100644 --- a/tilt.v +++ b/tilt.v @@ -333,12 +333,102 @@ Lemma derive_sqrt : (Num.sqrt^`())%classic = (fun t => (2 * Num.sqrt t)^-1) :> ( Proof. Admitted. +(* TODO derive1E funext*) +Local Open Scope classical_set_scope. + +Lemma derive_norm n (u : K^o -> 'rV[K^o]_n.+1) : +(1/2 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = +(fun t => (derive1mx u t *m (u t)^T)``_0) :>(K->K). +Proof. + +apply/funext => t. +rewrite [LHS]derive1E. +rewrite deriveMl ; last first. + admit. +Search "derive" (_^+ _). +Search (_^+2) (GRing.exp). +rewrite /=. +Search "derive" 1. +rewrite -derive1E. +rewrite (@derive1_comp _ (@norm _ _ \o u ) (@GRing.exp K ^~ 2) ) ; last 2 first. +admit. admit. +rewrite exp_derive1. +rewrite derive1_comp /=. +rewrite !derive_sqrt. +rewrite !expr1. +rewrite !(mulrA (1/2)). +rewrite div1r mulVf // ; last first. +rewrite pnatr_eq0 //. +rewrite !mul1r. +Search (norm). +rewrite !dotmulvv ; last first. +Search (Num.sqrt) (GRing.exp). +rewrite (sqrtr_sqr). +Search (`|_|) (norm). +rewrite normr_norm. +rewrite !mulrA /=. +Search "mulr". +have : norm (u t) / (2 * norm (u t)) = 1/2. +admit. +move => i. +rewrite i. +set X := (X in X^`()%classic). +About dotmulvv. +Search (_ *d _). +rewrite /X /=. +have : X t = norm(u t)^+2. +by rewrite /X dotmulvv. +move => dot. +rewrite /X in dot. +rewrite /X. +rewrite !derive1mx_dotmul. +Search (_ *m _^T). +rewrite dotmulP /=. +Search "derive1mx". +Search (_ + _) 2. +set y := derive1mx u t *d u t. +Search (_*d_). +have : y + u t *d derive1mx u t = 2 * y. +rewrite addrC /y /=. +Search (_*d _). +rewrite addrC. +Search (_ * 2). +rewrite addrC. +by rewrite mulrDl mul1r addrC dotmulC. +move => j. +rewrite j. +rewrite mulrC !mulrA. +rewrite -mulrA mulrC -mulrA mul1r /=. +rewrite mulrA /=. +Search ( _^-1 * _). +rewrite mulVf. rewrite mul1r. +rewrite /y. +Search (derive1mx). +rewrite !mxE eqxx mulr1n. +congr ( _ *d _). +by rewrite pnatr_eq0. +move => s j. +Search "derive_val". +Search "derivable" "fun". +Admitted. + Lemma deriveV1 (x : K -> 'rV[K]_6) t : LieDerivative V1 x t = V1dot (x t). Proof. -rewrite /LieDerivative. -rewrite /V1dot. +rewrite /LieDerivative /V1 /V1dot. +set zp1 := @lsubmx _ _ 3 3 _. +set z2 := @rsubmx _ _ 3 3 _. rewrite !mxE. +rewrite -!sumrN /=. +rewrite !addrA. +rewrite !derive1E. +Search (norm _ ^+2). +rewrite -mxtrace_tr_mul. +rewrite /partial. +Search (norm). +rewrite -!mxtrace_tr_mul. +Search ( \tr _). +rewrite trace_mx11 Abort. Lemma V1_is_lyapunov : is_lyapunov_function eqn33 V1 point1. From 3d4e48ab4f79bec4dfbb70777e56083ac7accfd4 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 18 Jun 2025 13:57:21 +0900 Subject: [PATCH 010/144] wip --- tilt.v | 144 +++++++++++++++++++++++---------------------------------- 1 file changed, 58 insertions(+), 86 deletions(-) diff --git a/tilt.v b/tilt.v index 05d532d1..490663a2 100644 --- a/tilt.v +++ b/tilt.v @@ -241,6 +241,62 @@ move=> x y r s <- <-. by rewrite dotmulDl. Qed. +Lemma derive_sqrt {K : realType} : + (Num.sqrt^`())%classic = (fun t => (2 * Num.sqrt t)^-1) :> (_ -> K). +Proof. +Admitted. + +Local Open Scope classical_set_scope. + +Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : + derive1mx M t = M^`()%classic t. +Proof. +apply/rowP => i. +rewrite /derive1mx !mxE. +rewrite /derive1. +Abort. + +Lemma derive_norm n (u : K^o -> 'rV[K^o]_n.+1) : + (forall t, norm (u t) != 0) -> + (1/2 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = + (fun t => (derive1mx u t *m (u t)^T)``_0) :> (K -> K). +Proof. +move=> u0; apply/funext => t. +rewrite [LHS]derive1E. +rewrite deriveMl/=; last first. + admit. +rewrite -derive1E. +rewrite (@derive1_comp _ (@norm _ _ \o u ) (@GRing.exp K ^~ 2) ) ; last 2 first. + admit. + admit. +rewrite exp_derive1. +rewrite derive1_comp /=; last 2 first. + admit. + admit. +rewrite !derive_sqrt. +rewrite !expr1. +rewrite !(mulrA (1/2)). +rewrite div1r mulVf //; last by rewrite pnatr_eq0. +rewrite !mul1r. +rewrite !dotmulvv. +rewrite sqrtr_sqr. +rewrite normr_norm. +rewrite !mulrA /=. +have -> : norm (u t) / (2 * norm (u t)) = 1/2. + by rewrite invfM// mulrCA divff ?mulr1 ?div1r. +set X := (X in X^`()%classic). +have dot : X t = norm(u t)^+2 by rewrite /X dotmulvv. +rewrite /X. +rewrite !derive1mx_dotmul; last 2 first. + admit. + admit. +rewrite dotmulP /=. +set y := derive1mx u t *d u t. +have -> : y + u t *d derive1mx u t = 2 * y. + by rewrite mulr_natl mulr2n dotmulC. +by rewrite div1r mulrA mulVf ?pnatr_eq0// mul1r mxE eqxx mulr1n. +Admitted. + Section Lyapunov. (* locally positive definite around x that is an equilibrium point *) @@ -329,91 +385,7 @@ Definition V1dot (zp1_z2 : 'rV[K]_6) : K := - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. -Lemma derive_sqrt : (Num.sqrt^`())%classic = (fun t => (2 * Num.sqrt t)^-1) :> (_ -> K). -Proof. -Admitted. - -(* TODO derive1E funext*) -Local Open Scope classical_set_scope. - -Lemma derive_norm n (u : K^o -> 'rV[K^o]_n.+1) : -(1/2 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = -(fun t => (derive1mx u t *m (u t)^T)``_0) :>(K->K). -Proof. - -apply/funext => t. -rewrite [LHS]derive1E. -rewrite deriveMl ; last first. - admit. -Search "derive" (_^+ _). -Search (_^+2) (GRing.exp). -rewrite /=. -Search "derive" 1. -rewrite -derive1E. -rewrite (@derive1_comp _ (@norm _ _ \o u ) (@GRing.exp K ^~ 2) ) ; last 2 first. -admit. admit. -rewrite exp_derive1. -rewrite derive1_comp /=. -rewrite !derive_sqrt. -rewrite !expr1. -rewrite !(mulrA (1/2)). -rewrite div1r mulVf // ; last first. -rewrite pnatr_eq0 //. -rewrite !mul1r. -Search (norm). -rewrite !dotmulvv ; last first. -Search (Num.sqrt) (GRing.exp). -rewrite (sqrtr_sqr). -Search (`|_|) (norm). -rewrite normr_norm. -rewrite !mulrA /=. -Search "mulr". -have : norm (u t) / (2 * norm (u t)) = 1/2. -admit. -move => i. -rewrite i. -set X := (X in X^`()%classic). -About dotmulvv. -Search (_ *d _). -rewrite /X /=. -have : X t = norm(u t)^+2. -by rewrite /X dotmulvv. -move => dot. -rewrite /X in dot. -rewrite /X. -rewrite !derive1mx_dotmul. -Search (_ *m _^T). -rewrite dotmulP /=. -Search "derive1mx". -Search (_ + _) 2. -set y := derive1mx u t *d u t. -Search (_*d_). -have : y + u t *d derive1mx u t = 2 * y. -rewrite addrC /y /=. -Search (_*d _). -rewrite addrC. -Search (_ * 2). -rewrite addrC. -by rewrite mulrDl mul1r addrC dotmulC. -move => j. -rewrite j. -rewrite mulrC !mulrA. -rewrite -mulrA mulrC -mulrA mul1r /=. -rewrite mulrA /=. -Search ( _^-1 * _). -rewrite mulVf. rewrite mul1r. -rewrite /y. -Search (derive1mx). -rewrite !mxE eqxx mulr1n. -congr ( _ *d _). -by rewrite pnatr_eq0. -move => s j. -Search "derive_val". -Search "derivable" "fun". -Admitted. - -Lemma deriveV1 (x : K -> 'rV[K]_6) t : - LieDerivative V1 x t = V1dot (x t). +Lemma deriveV1 (x : K -> 'rV[K]_6) t : LieDerivative V1 x t = V1dot (x t). Proof. rewrite /LieDerivative /V1 /V1dot. set zp1 := @lsubmx _ _ 3 3 _. @@ -428,7 +400,7 @@ rewrite /partial. Search (norm). rewrite -!mxtrace_tr_mul. Search ( \tr _). -rewrite trace_mx11 +(*rewrite trace_mx11*) Abort. Lemma V1_is_lyapunov : is_lyapunov_function eqn33 V1 point1. From a9020bb0302b72148066c71dc41a430601584ff6 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Thu, 19 Jun 2025 11:54:58 +0900 Subject: [PATCH 011/144] upd --- tilt.v | 119 ++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 85 insertions(+), 34 deletions(-) diff --git a/tilt.v b/tilt.v index 490663a2..0a59ec73 100644 --- a/tilt.v +++ b/tilt.v @@ -108,13 +108,14 @@ Definition Gamma1 := [set x : 'rV[K]_6 | norm (@rsubmx _ 1 3 3 x) = 1]. End Gamma1. Section ode. -Context {K : realType} {T : normedModType K}. +Context {K : realType}. +Let T := 'rV[K]_6. Local Open Scope classical_set_scope. Variable f : K -> (K -> T) -> T. Definition is_solution (x : K -> T) : Prop := - forall t, x^`() t = f t x. + forall t, derive1mx x t = f t x. Definition is_equilibrium_point p := is_solution (cst p). @@ -164,7 +165,7 @@ Check equilibrium_points _. Lemma equilibrium_point1 : is_equilibrium_point eqn33 point1. Proof. -move => t ; rewrite derive1_cst /eqn33 /point1 ; apply/eqP ; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. +move => t ; rewrite derive1mx_cst /eqn33 /point1 ; apply/eqP ; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; by rewrite !mxE. apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. rewrite /N /=; apply /rowP; move => a; by rewrite !mxE subr0. @@ -174,7 +175,7 @@ Qed. From mathcomp Require Import fintype. Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2. Proof. -move => t; rewrite derive1_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. +move => t; rewrite derive1mx_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). have N0 : N = 0. apply/rowP; move => i; rewrite !mxE; case: splitP. @@ -213,12 +214,64 @@ End eqn33. Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := \row_(j < n.+1) (i == j)%:R. +Locate derive1. Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := lim (h^-1 * (f (a + h *: err_vec i) - f a) @[h --> 0^'])%classic. Definition gradient {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := \row_(i < n.+1) partial f a i. +Definition gradientnew {R : realType} n (f : 'rV[R]_n.+1 -> R) := + jacobian (fun x => (f x)%:M). + +Lemma partialE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) (i : 'I_n.+1) : + partial f a i = ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x)%:M : 'rV[R]_1) a) 0%R 0%R. +Proof. +apply/cvg_lim => //. +apply/cvgrPdist_lt. +move => eps eps0. +near=> t. +Search (norm). +rewrite derivemxE /jacobian. +rewrite /= /partial /derive /= coorE /=. +Search ( 'e__). +rewrite derivemxE ; last first. admit. +Search ( 'e__). +rewrite /partial. +rewrite deriveE /= ; last first. admit. + + +Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : + derive1mx M t = M^`()%classic t. +Proof. +apply/rowP => i. +rewrite /derive1mx !mxE. +rewrite /derive1. +Admitted. + +Lemma gradientEE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : + gradient f a = (gradientnew f a)^T. +Proof. +rewrite /gradientnew. +apply/rowP => i. +rewrite /gradient mxE. +rewrite mxE /jacobian. +rewrite mxE. +rewrite -deriveE; last first. + admit. +Search ( 'e_i ). +Unset Printing Notations. + +rewrite /derive /= /partial. + +have := forall h, (h^-1 * (f (a + h *: err_vec i) - f a)) = +(h^-1 *: ((f (h *: 'e_i + a))%:M - (f a)%:M))``_0. +move => h. + +admit. +Search (_^T). +Admitted. + Lemma gradientE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : gradient f a = \sum_(i < n.+1) partial f a i *: 'e_i. Proof. @@ -240,22 +293,18 @@ elim/big_ind2 : _ => //=. move=> x y r s <- <-. by rewrite dotmulDl. Qed. +Search (Num.sqrt). -Lemma derive_sqrt {K : realType} : +Lemma derive_sqrt {K : realType} : (Num.sqrt^`())%classic = (fun t => (2 * Num.sqrt t)^-1) :> (_ -> K). Proof. +apply/funext => i. +rewrite derive1E /=. +Search (_^-1) (_*_). +rewrite invrM. Search (_^-1). Admitted. Local Open Scope classical_set_scope. - -Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : - derive1mx M t = M^`()%classic t. -Proof. -apply/rowP => i. -rewrite /derive1mx !mxE. -rewrite /derive1. -Abort. - Lemma derive_norm n (u : K^o -> 'rV[K^o]_n.+1) : (forall t, norm (u t) != 0) -> (1/2 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = @@ -322,14 +371,14 @@ Local Open Scope classical_set_scope. Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) (a : R -> 'rV[R]_n.+1) (t : R) : R := - \sum_(i < n.+1) partial V (a t) i * (a^`()%classic t) ``_ i. + \sum_(i < n.+1) (partial V (a t) i * (derive1mx a t) ``_ i). Definition LieDerivative_gradient {R : realType} n (V : 'rV[R]_n.+1 -> R) (x : R -> 'rV[R]_n.+1) (t : R) : R := - let xdot_t := (x^`()) t in - gradient V (x t) *d xdot_t. + let xdot_t := derive1mx x t in + (gradientnew V (x t) )^T *d xdot_t. -Lemma LieDerivative_gradientE {R : realType} n (V : 'rV[R]_n.+1 -> R) +(*Lemma LieDerivative_gradientE {R : realType} n (V : 'rV[R]_n.+1 -> R) (x : R -> 'rV[R]_n.+1) : LieDerivative_gradient V x = LieDerivative V x. Proof. @@ -339,8 +388,10 @@ rewrite dotmulE (bigD1 i)//= big1 ?addr0; last first. by move=> j ji; rewrite !mxE/= (negbTE ji) mulr0 mul0r. by rewrite !mxE/= eqxx mulr1. Qed. +*) +Check jacobian. -Definition is_lyapunov_function n +Definition is_lyapunov_function (n := 5) (f : K -> (K -> 'rV[K]_n.+1) -> 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) (x0 : 'rV[K]_n.+1) : Prop := @@ -374,7 +425,7 @@ Definition zp1_z2_eq t (zp1_z2 : K -> 'rV[K]_6) : 'rV[K]_6 := Definition V1 (zp1_z2 : 'rV[K]_6) : K := let zp1 := @lsubmx K 1 3 3 (zp1_z2) in let z2 := @rsubmx K 1 3 3 (zp1_z2) in - (norm zp1)^+2 / (2%:R * alpha1) + (norm z2)^+2 / (2%:R * gamma). + (norm (zp1))^+2 / (2%:R * alpha1) + (norm (z2))^+2 / (2%:R * gamma). Definition ffun_to_rV6 (f : {ffun 'I_1 * 'I_6 -> K}) : 'rV_6 := \row_(i < 6) f (ord0, i). @@ -385,22 +436,22 @@ Definition V1dot (zp1_z2 : 'rV[K]_6) : K := - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : LieDerivative V1 x t = V1dot (x t). +Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution eqn33 x -> LieDerivative_gradient V1 x t = V1dot (x t). Proof. -rewrite /LieDerivative /V1 /V1dot. -set zp1 := @lsubmx _ _ 3 3 _. -set z2 := @rsubmx _ _ 3 3 _. +move => eqn33x. +rewrite /V1dot. +set zp1 := fun r => @lsubmx K 1 3 3 (x r). +set z2 := fun r => @rsubmx K 1 3 3 (x r). +rewrite /LieDerivative_gradient /gradientnew /V1. +rewrite /jacobian /lin1_mx. rewrite !mxE. -rewrite -!sumrN /=. -rewrite !addrA. -rewrite !derive1E. -Search (norm _ ^+2). -rewrite -mxtrace_tr_mul. -rewrite /partial. -Search (norm). -rewrite -!mxtrace_tr_mul. -Search ( \tr _). -(*rewrite trace_mx11*) +Search "matrix". +transitivity (alpha1^-1 * ((derive1mx zp1 t) *d ((zp1 t))) + ((gamma^-1) * ((derive1mx z2 t) *d ((z2 t))))). +rewrite /derive1mx. +Search (_ * _) "matrix". +admit. + +rewrite /derive1mx. Abort. Lemma V1_is_lyapunov : is_lyapunov_function eqn33 V1 point1. From 96801a1bf1c73d1fe02e8da7a5e06e7c53523978 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 19 Jun 2025 13:59:44 +0900 Subject: [PATCH 012/144] wip --- tilt.v | 59 +++++++++++++++++++++++++++++++++------------------------- 1 file changed, 34 insertions(+), 25 deletions(-) diff --git a/tilt.v b/tilt.v index 0a59ec73..938a9ab8 100644 --- a/tilt.v +++ b/tilt.v @@ -224,22 +224,41 @@ Definition gradient {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := Definition gradientnew {R : realType} n (f : 'rV[R]_n.+1 -> R) := jacobian (fun x => (f x)%:M). -Lemma partialE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) (i : 'I_n.+1) : - partial f a i = ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x)%:M : 'rV[R]_1) a) 0%R 0%R. +Lemma deriveE' {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) + (i : 'I_n.+1) : + ('D_'e_i (fun x : 'rV_n.+1 => (f x)%:M : 'rV[R]_1) a) + = ('D_'e_i (fun x : 'rV_n.+1 => (f x)) a)%:M. Proof. -apply/cvg_lim => //. -apply/cvgrPdist_lt. -move => eps eps0. -near=> t. -Search (norm). -rewrite derivemxE /jacobian. -rewrite /= /partial /derive /= coorE /=. -Search ( 'e__). -rewrite derivemxE ; last first. admit. -Search ( 'e__). -rewrite /partial. -rewrite deriveE /= ; last first. admit. +rewrite /derive/=. +rewrite [X in (X @ _)%classic](_ : _ = scalar_mx \o (fun h => + (h^-1 *: ((f (h *: 'e_i + a)) - (f a))))); last first. + apply/funext => h. + rewrite /=. + admit. +apply/cvg_lim => //=. +apply: (@cvg_comp _ _ _ _ scalar_mx _ +(nbhs (lim ((h^-1 *: (f (h *: 'e_i + a) - f a)) @[h --> 0^']))%classic)). + admit. +Admitted. +Lemma partialE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) + (i : 'I_n.+1) : + partial f a i = + ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x)%:M : 'rV[R]_1) a) 0 0. +Proof. +rewrite deriveE'. +rewrite mxE eqxx mulr1n. +rewrite /partial /derive/=. +congr (lim (_ @[h --> 0^'])%classic) => //=. +apply/funext => h . +congr (_ *: _). +do 2 f_equal. +rewrite addrC. +f_equal. +congr (_ *: _). +apply/rowP => j. +by rewrite !mxE eqxx/= eq_sym. +Qed. Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : derive1mx M t = M^`()%classic t. @@ -259,17 +278,7 @@ rewrite mxE /jacobian. rewrite mxE. rewrite -deriveE; last first. admit. -Search ( 'e_i ). -Unset Printing Notations. - -rewrite /derive /= /partial. - -have := forall h, (h^-1 * (f (a + h *: err_vec i) - f a)) = -(h^-1 *: ((f (h *: 'e_i + a))%:M - (f a)%:M))``_0. -move => h. - -admit. -Search (_^T). +by rewrite partialE. Admitted. Lemma gradientE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : From 0d42bb75d8dba6b32df84c55edf5c957a9f697aa Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 20 Jun 2025 23:28:22 +0900 Subject: [PATCH 013/144] working on is lyapunov --- tilt.v | 387 +++++++++++++++++++++++++++------------------------------ 1 file changed, 186 insertions(+), 201 deletions(-) diff --git a/tilt.v b/tilt.v index 938a9ab8..f62840f6 100644 --- a/tilt.v +++ b/tilt.v @@ -210,45 +210,34 @@ move=> is_sol_y. Abort. End eqn33. +Section derive_help. Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := \row_(j < n.+1) (i == j)%:R. -Locate derive1. Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := lim (h^-1 * (f (a + h *: err_vec i) - f a) @[h --> 0^'])%classic. -Definition gradient {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := +Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := \row_(i < n.+1) partial f a i. -Definition gradientnew {R : realType} n (f : 'rV[R]_n.+1 -> R) := - jacobian (fun x => (f x)%:M). +Definition gradient_jacobian {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) := + jacobian (fun x => (f x)). -Lemma deriveE' {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) +Lemma deriveE' {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) (i : 'I_n.+1) : - ('D_'e_i (fun x : 'rV_n.+1 => (f x)%:M : 'rV[R]_1) a) - = ('D_'e_i (fun x : 'rV_n.+1 => (f x)) a)%:M. + ('D_'e_i (fun x : 'rV_n.+1 => (f x) : 'rV[R]_1) a) + = ('D_'e_i (fun x : 'rV_n.+1 => (f x)) a). Proof. -rewrite /derive/=. -rewrite [X in (X @ _)%classic](_ : _ = scalar_mx \o (fun h => - (h^-1 *: ((f (h *: 'e_i + a)) - (f a))))); last first. - apply/funext => h. - rewrite /=. - admit. -apply/cvg_lim => //=. -apply: (@cvg_comp _ _ _ _ scalar_mx _ -(nbhs (lim ((h^-1 *: (f (h *: 'e_i + a) - f a)) @[h --> 0^']))%classic)). - admit. -Admitted. +rewrite /derive/=. done. +Qed. -Lemma partialE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) +Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) (i : 'I_n.+1) : - partial f a i = - ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x)%:M : 'rV[R]_1) a) 0 0. + partial (fun x => (f x) 0 0) a i = + ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x) : 'rV[R]_1) a) 0 0. Proof. -rewrite deriveE'. -rewrite mxE eqxx mulr1n. -rewrite /partial /derive/=. +(*rewrite deriveE' mxE eqxx mulr1n /partial /derive/=. congr (lim (_ @[h --> 0^'])%classic) => //=. apply/funext => h . congr (_ *: _). @@ -257,34 +246,30 @@ rewrite addrC. f_equal. congr (_ *: _). apply/rowP => j. -by rewrite !mxE eqxx/= eq_sym. -Qed. +by rewrite !mxE eqxx/= eq_sym.*) +Admitted. Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : derive1mx M t = M^`()%classic t. Proof. apply/rowP => i. -rewrite /derive1mx !mxE. -rewrite /derive1. +rewrite /derive1mx !mxE /derive1. Admitted. -Lemma gradientEE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : - gradient f a = (gradientnew f a)^T. +Lemma gradientEE {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) : + gradient_partial (fun x => (f x) 0 0) a = (gradient_jacobian f a)^T. Proof. -rewrite /gradientnew. +rewrite /gradient_jacobian. apply/rowP => i. -rewrite /gradient mxE. -rewrite mxE /jacobian. -rewrite mxE. -rewrite -deriveE; last first. +rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. admit. -by rewrite partialE. +by rewrite partial_diff. Admitted. -Lemma gradientE {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : - gradient f a = \sum_(i < n.+1) partial f a i *: 'e_i. +Lemma gradient_sum {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : + gradient_partial f a = \sum_(i < n.+1) partial f a i *: 'e_i. Proof. -rewrite /gradient [LHS]row_sum_delta. +rewrite /gradient_partial [LHS]row_sum_delta. by under eq_bigr do rewrite mxE. Qed. @@ -354,7 +339,7 @@ have -> : y + u t *d derive1mx u t = 2 * y. by rewrite mulr_natl mulr2n dotmulC. by rewrite div1r mulrA mulVf ?pnatr_eq0// mul1r mxE eqxx mulr1n. Admitted. - +End derive_help. Section Lyapunov. (* locally positive definite around x that is an equilibrium point *) @@ -382,10 +367,10 @@ Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) (a : R -> 'rV[R]_n.+1) (t : R) : R := \sum_(i < n.+1) (partial V (a t) i * (derive1mx a t) ``_ i). -Definition LieDerivative_gradient {R : realType} n (V : 'rV[R]_n.+1 -> R) +Definition LieDerivative_gradient_jacobian {R : realType} n (V : 'rV[R]_n.+1 -> 'rV[R]_1) (x : R -> 'rV[R]_n.+1) (t : R) : R := let xdot_t := derive1mx x t in - (gradientnew V (x t) )^T *d xdot_t. + (gradient_jacobian V (x t) )^T *d xdot_t. (*Lemma LieDerivative_gradientE {R : realType} n (V : 'rV[R]_n.+1 -> R) (x : R -> 'rV[R]_n.+1) : @@ -398,22 +383,22 @@ rewrite dotmulE (bigD1 i)//= big1 ?addr0; last first. by rewrite !mxE/= eqxx mulr1. Qed. *) -Check jacobian. Definition is_lyapunov_function (n := 5) (f : K -> (K -> 'rV[K]_n.+1) -> 'rV[K]_n.+1) - (V : 'rV[K]_n.+1 -> K) + (V : 'rV[K]_n.+1 -> 'rV[K]_1) (x0 : 'rV[K]_n.+1) : Prop := [/\ is_equilibrium_point f x0, - locposdef V x0 & + locposdef (fun z => (V z) 0 0) x0 & forall traj : K -> 'rV[K]_n.+1, is_solution f traj -> traj 0 = x0 -> - lnsd (LieDerivative V traj) 0]. + lnsd (fun t => (LieDerivative_gradient_jacobian V traj t)) 0]. Variable x1_hat : K -> 'rV[K]_3. Variable x2_hat : K -> 'rV[K]_3. Hypothesis alpha1_gt0 : 0 < alpha1. +Hypothesis gamma_gt0 : 0 < gamma. Definition p1 t : 'rV[K]_3 := let x1_t := x1 t in @@ -431,10 +416,10 @@ Definition zp1_z2_eq t (zp1_z2 : K -> 'rV[K]_6) : 'rV[K]_6 := let z2 t := @rsubmx K 1 3 3 (zp1_z2 t) in row_mx ((p1 t) *m R t) ((x2_tilde t) *m R t). -Definition V1 (zp1_z2 : 'rV[K]_6) : K := +Definition V1 (zp1_z2 : 'rV[K]_6) : 'rV[K]_1 := let zp1 := @lsubmx K 1 3 3 (zp1_z2) in let z2 := @rsubmx K 1 3 3 (zp1_z2) in - (norm (zp1))^+2 / (2%:R * alpha1) + (norm (z2))^+2 / (2%:R * gamma). + ((norm (zp1))^+2 / (2%:R * alpha1) + (norm (z2))^+2 / (2%:R * gamma))%:M. Definition ffun_to_rV6 (f : {ffun 'I_1 * 'I_6 -> K}) : 'rV_6 := \row_(i < 6) f (ord0, i). @@ -445,22 +430,34 @@ Definition V1dot (zp1_z2 : 'rV[K]_6) : K := - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution eqn33 x -> LieDerivative_gradient V1 x t = V1dot (x t). +Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution eqn33 x -> LieDerivative_gradient_jacobian V1 x t = V1dot (x t). Proof. move => eqn33x. -rewrite /V1dot. -set zp1 := fun r => @lsubmx K 1 3 3 (x r). -set z2 := fun r => @rsubmx K 1 3 3 (x r). -rewrite /LieDerivative_gradient /gradientnew /V1. -rewrite /jacobian /lin1_mx. -rewrite !mxE. -Search "matrix". -transitivity (alpha1^-1 * ((derive1mx zp1 t) *d ((zp1 t))) + ((gamma^-1) * ((derive1mx z2 t) *d ((z2 t))))). -rewrite /derive1mx. -Search (_ * _) "matrix". -admit. - -rewrite /derive1mx. +pose zp1 := fun r => @lsubmx K 1 3 3 (x r). +pose z2 := fun r => @rsubmx K 1 3 3 (x r). +transitivity (alpha1^-1 * (('D_1 zp1 t) *d ((zp1 t))) + ((gamma^-1) * (('D_1 z2 t) *d ((z2 t))))). +rewrite/V1 /LieDerivative_gradient_jacobian. rewrite /gradient_jacobian. +rewrite derive1mxE' derive1E /=. +rewrite /dotmul. +rewrite -trmx_mul. +rewrite -derivemxE /=. +rewrite [x in ('D_ _ x _)^T] (_ : _ = (fun x0 : 'rV_6 => + (norm ( @lsubmx K 1 3 3 x0) ^+ 2 / (2 * alpha1))%:M) \+ (fun x0 => (norm (@lsubmx K 1 3 3 x0) ^+ 2 / (2 * gamma))%:M)). +rewrite deriveD /=. +rewrite mxE mxE. +congr (_+_). +rewrite [x in ('D_ _ x _) ](_ : _ = (1 / alpha1) * (1/2) \*: (fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1)). +rewrite deriveZ /=. +red in eqn33x. +(*rewrite derive_norm. +Search "derive". +transitivity ( \sum_(j < 6) + ('J (fun x0 : 'rV_6 => + (norm (lsubmx x0) ^+ 2 / (2 * alpha1) + norm (rsubmx x0) ^+ 2 / (2 * gamma))%:M) + (x t))^T 0 j * ('D_1 x t)^T j 0). +transitivity (alpha1^-1 * (('D_1 zp1 t) *d ((zp1 t))) + ((gamma^-1) * (('D_1 z2 t) *d ((z2 t))))). +rewrite /jacobian /=. rewrite !deriveE /=. +rewrite /zp1.*) Abort. Lemma V1_is_lyapunov : is_lyapunov_function eqn33 V1 point1. @@ -471,7 +468,7 @@ split; first exact: equilibrium_point1. is_solution eqn33 traj -> traj 0 = point1 -> lnsd [eta LieDerivative V1 traj] 0)*) (* v1 at point 1 is positive definite*) - rewrite /locposdef; split. - + by rewrite /V1 /point1 lsubmx0 rsubmx0 norm0 expr0n/= !mul0r add0r. + + by rewrite /V1 /point1 lsubmx0 rsubmx0 norm0 expr0n/= !mul0r add0r mxE /=. (* \forall z \near 0^', 0 < norm (lsubmx z) ^+ 2 / (2 * alpha1) + norm (rsubmx z) ^+ 2 / (2 * gamma)*) have alpha1_pos: 0 < 2 * alpha1 by rewrite mulr_gt0 // ltr0Sn. @@ -505,13 +502,15 @@ split; first exact: equilibrium_point1. by rewrite eq_sym norm_eq0 lz0 /= norm_ge0. move => normlsub. Search (_ < _ + _). + rewrite mxE /=. apply: ltr_pwDl. rewrite divr_gt0 //. by rewrite exprn_gt0 //. rewrite divr_ge0 //. by rewrite exprn_ge0 //. by apply ltW. - - apply: ltr_pwDr. + - rewrite mxE /=. + apply: ltr_pwDr. rewrite divr_gt0 //. rewrite exprn_gt0 //. rewrite lt_neqAle. @@ -520,146 +519,132 @@ split; first exact: equilibrium_point1. by rewrite norm_eq0 rz0 /= norm_ge0. rewrite divr_ge0 // ?exprn_ge0 // ?norm_ge0 //. by apply ltW. -- move => traj dtraj. - rewrite -LieDerivative_gradientE. - rewrite /LieDerivative_gradient /V1 /point1 /lnsd. - move => traj0. - rewrite gradientE; elim/big_ind : _ => //. +- move => traj dtraj traj0. + rewrite /lnsd /LieDerivative_gradient_jacobian. + rewrite traj0 /point1. split. - by rewrite dotmul0v. - near=> z_near. - rewrite gradientE; elim/big_ind : _ => //. - by rewrite dotmul0v. - move => x y s v. - rewrite dotmulDl /= -oppr_ge0 -oppr_le0 /= opprK -oppr_ge0 opprD addr_ge0. - by []. - by rewrite oppr_ge0. - by rewrite oppr_ge0. - move => i f. - rewrite /partial. - rewrite !sqr_norm. - elim/big_ind : _ => //. - elim/big_ind : _ => //. - rewrite !mul0r !add0r /=. - have /cvg_lim: (h^-1 * (norm (lsubmx ((traj z_near - + h *: (\row_j (i == j)%:R : 'rV_6)) : 'rV_(3+3))) ^+ 2 / (2 * alpha1) + - norm (rsubmx ((traj z_near + h *: (\row_j (i == j)%:R : 'rV_6)) : 'rV_(3+3))) ^+ 2 / (2 * gamma) - 0) - @[h --> 0^']) --> (0:K). - set v := (\row_j (i == j)%:R : 'rV_6). - have v_structure: v = \row_j (i == j)%:R. - by rewrite /v. - have taylor: forall h, - norm (traj z_near + h *: v) ^+ 2 = - norm (traj z_near) ^+ 2 + - 2 * h * dotmul (traj z_near) v + - h^2 * norm v ^+ 2. - move=> h. - rewrite !dotmulE. - have norm_expand: norm (traj z_near + h *: v) ^+ 2 = - (traj z_near + h *: v) *d (traj z_near + h *: v). - rewrite !dotmulE. - rewrite /norm /= dotmulE. - rewrite sqr_sqrtr //. - apply: sumr_ge0 => k _. - rewrite sqr_ge0. - by []. - rewrite norm_expand. - rewrite dotmulDl dotmulDr. - rewrite -!dotmulE /=. - rewrite dotmulDr. - rewrite dotmulZv dotmulvZ. - rewrite (dotmulC v (traj z_near)). - rewrite dotmulvZ dotmulZv. - rewrite mulrDl. - rewrite mulrA -expr2. - rewrite -!dotmulvv. - rewrite mul1r. - rewrite -mulr2n. - ring. - have /cvg_lim: h^-1 * - ((norm (lsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * alpha1) + - (norm (rsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * gamma) - 0) - @[h --> 0^'] --> 0. - pose F h := h^-1 * - ((norm (lsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * alpha1) + - (norm (rsubmx ((traj z_near + h *: v) : 'rV_(3 + 3))) ^+ 2) / (2 * gamma) - 0). - have split_norm : - forall u : 'rV_(3 + 3), - norm u ^+ 2 = norm (lsubmx u) ^+ 2 + norm (rsubmx u) ^+ 2. - move=> u. - admit. - admit. - (* generalize to lsubmx and rsubmx*) - admit. - admit. - move => x y s v. - admit. - move => i0 t. - have equilibrium : eqn33 z_near traj = 0. - admit. + Search (derive1mx). + rewrite derive1mxE' /gradient_jacobian /V1. + rewrite !derive1E. + rewrite /dotmul. rewrite -trmx_mul /= mxE. + rewrite /is_solution /derive1mx /eqn33 in dtraj. + set f_expr := (fun x : 'rV_5%R.+1 => + (norm ( @lsubmx K 1 3 3 x) ^+ 2 / (2 * alpha1) + norm ( @rsubmx K 1 3 3 x) ^+ 2 / (2 * gamma))%:M). + pose phi := fun t => f_expr (traj t). + rewrite /traj0. + have eq_point1: 'D_1 traj 0 = 0. + rewrite /dtraj /traj0. + have deriv_at_0: \matrix_(i, j) (fun x : K => traj x i j)^`() 0 = + row_mx (- alpha1 *: (@lsubmx K 1 3 3 (traj 0))) + (gamma *: ((@rsubmx K 1 3 3 (traj 0)) - (@lsubmx K 1 3 3 (traj 0))) *m + \S('e_2 - (@rsubmx K 1 3 3 (traj 0))) ^+ 2). + exact: dtraj. + have deriv_at_point1: 'D_1 traj 0 = + row_mx (- alpha1 *: @lsubmx K 1 3 3 (traj 0)) + (gamma *: (@rsubmx K 1 3 3 (traj 0) - @lsubmx K 1 3 3 (traj 0)) *m + \S('e_2 - @rsubmx K 1 3 3 (traj 0)) ^+ 2). + rewrite -deriv_at_0. + rewrite -derive1E /=. + apply/matrixP => i j. rewrite -derive1mxE. + rewrite derive1mxE /=. rewrite !mxE /=. admit. - move => x y s v. - admit. - move => i0 t. - admit. - move => x y s v. - split. - admit. - near=> z. - rewrite gradientE; elim/big_ind : _ => //. - by rewrite dotmul0v. - move=> x0 y0 b a. - rewrite dotmulDl. - Search "dotmul". - rewrite -[X in X <= 0]addr0. - rewrite -subr_le0. - have : 0 - (x + y) = (-x) + (-y). - Search "oppr". - rewrite opprD. - by rewrite add0r. - move => i. - rewrite subr0 addr0. - rewrite -dotmulDl. - admit. - move=> i0 t. - admit. - move => i0 t. - split. - rewrite traj0 /=. - rewrite /partial !sqr_norm /=. - elim/big_ind : _ => //. - elim/big_ind : _ => //. - rewrite mul0r. - rewrite add0r. - rewrite mul0r. - admit. - move=> x y s v. - rewrite mul0r add0r /=. - admit. - move => i tr. - rewrite mul0r add0r. - admit. - move => x y s v. - admit. - move => i tru. + have eq_zero: row_mx (- alpha1 *: @lsubmx K 1 3 3 point1) + (gamma *: (@rsubmx K 1 3 3 point1 - @lsubmx K 1 3 3 point1) *m + \S('e_2 - @rsubmx K 1 3 3 point1) ^+ 2) = 0. + have := equilibrium_point1 0. + rewrite /is_equilibrium_point /eqn33. + move => H. + rewrite /point1. apply/matrixP => i j. + rewrite !linear0 addr0. + rewrite addr0. rewrite scaler0 mul0mx. + by rewrite row_mx0. + have traj_deriv_zero: 'D_1 traj 0 = 0. + rewrite deriv_at_point1. + rewrite traj0. + by rewrite eq_zero. + by rewrite traj_deriv_zero. + rewrite eq_point1. + rewrite mul0mx /=. + by rewrite mxE. + near=> z. + rewrite derive1mxE'. + rewrite /gradient_jacobian /=. + Search (_*d_) (_*m_). + rewrite /dotmul /=. + Search (_^T). + rewrite /is_solution /derive1mx /eqn33 in dtraj. + rewrite -trmx_mul /=. rewrite mxE /=. + rewrite /V1 /=. rewrite -derivemxE /=. + rewrite [x in ('D_ _ x _)] (_ : _ = (fun x0 : 'rV_6 => + (norm ( @lsubmx K 1 3 3 x0) ^+ 2 / (2 * alpha1))%:M) \+ (fun x0 => (norm (@lsubmx K 1 3 3 x0) ^+ 2 / (2 * gamma))%:M)). + rewrite deriveD /=. + rewrite mxE. + rewrite [x in ('D_ _ x _) ](_ : _ = (1 / alpha1) * (1/2) \*: (fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1)). + rewrite !deriveZ /=. + under [in X in _ + X] eq_fun => x0. + rewrite [_ / (2 * gamma)]mulrC. + over. + rewrite /=. + rewrite [X in _ + X] + (_ : 'D_((traj^`())%classic z) (fun x0 : 'rV[K]_6 => ((2 * gamma)^-1 * norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1) (traj z) 0 0 = + (2 * gamma)^-1 *: 'D_((traj^`())%classic z) (fun x0 : 'rV[K]_6 => (norm (@rsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1) (traj z) 0 0). + pose f := fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0))%:M : 'rV[K]_1. + pose F := fun x0 : 'rV_6 => (f x0) ^+ 2. + set dF_l : 'rV[K]_1 := 'D_((traj^`())%classic z) + (fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M) (traj z). + rewrite !mxE. + set a := 1 / alpha1 * (1 / 2). + set b := (2 * gamma)^-1. + set dF_r : 'rV[K]_1 := 'D_((traj^`())%classic z) + (fun x0 : 'rV[K]_6 => (norm (@rsubmx K 1 3 3 x0) ^+ 2)%:M) (traj z). + have: dF_l``_0 = (2 *: (@lsubmx K 1 3 3 (traj z)) 0 0). admit. - near=> z_near. - rewrite gradientE; elim/big_ind : _ => //. - by rewrite dotmul0v. - move => x0 y0 tr a. - - admit. - move => i tru. - rewrite /partial expr2. - rewrite !sqr_norm. - elim/big_ind : _ => //. - rewrite !mul0r addr0. - admit. - move => x0 y0 s v. - admit. - move => i1 tr. - rewrite !expr2 . - admit. + have: dF_r``_0 = 2 * (@rsubmx K 1 3 3 (traj z)) 0 0. + admit. + move=> l r. + Set Printing Parentheses. + Search (_<=0) (0<=_). + rewrite l r. + rewrite /=. + rewrite -oppr_ge0 /=. + have ab_pos : 0 < a + b. + rewrite /a /b. + apply: addr_gt0. + apply: mulr_gt0. + apply: divr_gt0. + by []. + by apply alpha1_gt0. + by apply divr_gt0. + rewrite -div1r. + apply: divr_gt0. + by []. + apply: mulr_gt0. + by []. + by apply gamma_gt0. + have : (@lsubmx K 1 3 3 (traj z))``_0 = (dF_l``_0 / 2). + move: r. + move=> ->. + rewrite scaler_nat. + by field. + move=> Hlsubmx_eq. + + rewrite Hlsubmx_eq. + have Hrsubmx_eq : (@rsubmx K 1 3 3 (traj z))``_0 = (dF_r``_0) / 2. + move: l => Hl. by rewrite Hl; field. + + rewrite Hrsubmx_eq. + rewrite scalerA. + rewrite scalerA. + rewrite scalerA. + rewrite -div1r. + rewrite !opprD. + rewrite subr_ge0. + rewrite mulrA. + rewrite scalerA. + rewrite -subr_ge0. + have dF_l_pos : 0 <= dF_l``_0. + rewrite r. + Search (_ <= _ ^+ 2). Admitted. End Lyapunov. From 0e00a89e8ad4d1222abd0c8a878bf26dc0d89ef4 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Mon, 23 Jun 2025 11:26:58 +0900 Subject: [PATCH 014/144] upd --- tilt.v | 87 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 47 insertions(+), 40 deletions(-) diff --git a/tilt.v b/tilt.v index f62840f6..165ca1c3 100644 --- a/tilt.v +++ b/tilt.v @@ -598,53 +598,60 @@ split; first exact: equilibrium_point1. set dF_r : 'rV[K]_1 := 'D_((traj^`())%classic z) (fun x0 : 'rV[K]_6 => (norm (@rsubmx K 1 3 3 x0) ^+ 2)%:M) (traj z). have: dF_l``_0 = (2 *: (@lsubmx K 1 3 3 (traj z)) 0 0). + rewrite /dF_l. + set u := fun t => @lsubmx K 1 3 3 (traj t). + have Hnorm_neq0 : forall t, norm (u t) != 0. admit. + have Hderiv : + (((1 / 2) \*o (GRing.exp (R:=K))^~ 2 \o norm (n:=3)) \o u)^`() = + (fun t => (derive1mx u t *m (u t)^T) 0 0). + apply: derive_norm => t. + apply: Hnorm_neq0. have: dF_r``_0 = 2 * (@rsubmx K 1 3 3 (traj z)) 0 0. + set v := fun t => @rsubmx K 1 3 3 (traj t). + have Hvnorm_neq0 : forall t, norm (v t) != 0. admit. - move=> l r. - Set Printing Parentheses. - Search (_<=0) (0<=_). - rewrite l r. - rewrite /=. + have Hvderiv : + (((1 / 2) \*o (GRing.exp (R:=K))^~ 2 \o norm (n:=3)) \o v)^`() = + (fun t => (derive1mx v t *m (v t)^T) 0 0). + apply: derive_norm => t. + apply:Hvnorm_neq0. + have -> : dF_r``_0 = ((fun t => (derive1mx v t *m (v t)^T) 0 0) z). + rewrite /dF_r. rewrite -!derive1mxE'. + set g := fun (x0 : 'rV_6) => ((norm (@rsubmx K 1 3 3 x0)) ^+ 2)%:M. + have : ('D_(derive1mx traj z) g (traj z)) 0 0 + = (((fun t => norm (v t)) ^+ 2)^`() z). + admit. + move => etc. + rewrite /g. + rewrite etc. + Search "derive" (_^+_). + rewrite derive1E. + rewrite deriveX /=. + admit. + admit. + admit. + rewrite /v /derive1mx. + admit. + move => d. + rewrite /a /b /=. rewrite -oppr_ge0 /=. have ab_pos : 0 < a + b. - rewrite /a /b. - apply: addr_gt0. - apply: mulr_gt0. - apply: divr_gt0. - by []. - by apply alpha1_gt0. - by apply divr_gt0. - rewrite -div1r. - apply: divr_gt0. - by []. - apply: mulr_gt0. - by []. - by apply gamma_gt0. + rewrite /a /b. + apply: addr_gt0. + apply: mulr_gt0. + apply: divr_gt0. + by []. + by apply alpha1_gt0. + by apply divr_gt0. + rewrite -div1r. + apply: divr_gt0. + by []. + apply: mulr_gt0. + by []. + by apply gamma_gt0. have : (@lsubmx K 1 3 3 (traj z))``_0 = (dF_l``_0 / 2). - move: r. - move=> ->. - rewrite scaler_nat. - by field. - move=> Hlsubmx_eq. - - rewrite Hlsubmx_eq. have Hrsubmx_eq : (@rsubmx K 1 3 3 (traj z))``_0 = (dF_r``_0) / 2. - move: l => Hl. by rewrite Hl; field. - - rewrite Hrsubmx_eq. - rewrite scalerA. - rewrite scalerA. - rewrite scalerA. - rewrite -div1r. - rewrite !opprD. - rewrite subr_ge0. - rewrite mulrA. - rewrite scalerA. - rewrite -subr_ge0. - have dF_l_pos : 0 <= dF_l``_0. - rewrite r. - Search (_ <= _ ^+ 2). Admitted. End Lyapunov. From fbea85ef1b52b2767ef7a66356061db680d9bf47 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 23 Jun 2025 14:22:39 +0900 Subject: [PATCH 015/144] cleaning, wip --- derive_matrix.v | 4 +- tilt.v | 488 ++++++++++++++++++++++++------------------------ 2 files changed, 241 insertions(+), 251 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index b73157b5..66d7c0d7 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -59,12 +59,12 @@ Definition derivable_mx m n (M : R -> 'M[W]_(m, n)) t v := Definition derive1mx m n (M : R -> 'M[W]_(m, n)) := fun t => \matrix_(i < m, j < n) (derive1 (fun x => M x i j) t : W). -Lemma derive1mxE m n t (f : 'I_m -> 'I_n -> R -> W) : +Lemma derive1mx_matrix m n t (f : 'I_m -> 'I_n -> R -> W) : derive1mx (fun x => \matrix_(i, j) f i j x) t = \matrix_(i, j) (derive1 (f i j) t : W). Proof. rewrite /derive1mx; apply/matrixP => ? ?; rewrite !mxE; congr (derive1 _ t). -rewrite funeqE => ?; by rewrite mxE. +by rewrite funeqE => ?; rewrite mxE. Qed. Variables m n : nat. diff --git a/tilt.v b/tilt.v index 165ca1c3..4f336048 100644 --- a/tilt.v +++ b/tilt.v @@ -144,18 +144,16 @@ Definition xi1 t (zp1_zp2 : K -> 'rV[K]_6) : Gamma1 := Lemma thm11a : state_space eqn33 = Gamma1. Proof. -apply/seteqP. split. - - move=> p. - rewrite /state_space /Gamma1 /eqn33 /is_solution /=. - move=> y. - Search (norm) 1. - destruct y as [y0 [Heq Hrange]]. - admit. - move => p. - rewrite /state_space /Gamma1 /eqn33 /is_solution /=. - move => y. -rewrite /state_space /Gamma1 /eqn33 /is_solution. -admit. +apply/seteqP; split. +- move=> p. + rewrite /state_space /Gamma1 /eqn33 /is_solution /=. + move=> [y0 [Heq Hrange]]. + admit. +- move => p. + rewrite /state_space /Gamma1 /eqn33 /is_solution /=. + move => y. + rewrite /state_space /Gamma1 /eqn33 /is_solution. + admit. Admitted. Definition point1 : 'rV[K]_6 := 0. @@ -215,8 +213,15 @@ Section derive_help. Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := \row_(j < n.+1) (i == j)%:R. +Lemma err_vecE {R : ringType} n (i : 'I_n.+1) : + err_vec i = 'e_i :> 'rV[R]_n.+1. +Proof. +apply/rowP => j. +by rewrite !mxE eqxx /= eq_sym. +Qed. + Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := - lim (h^-1 * (f (a + h *: err_vec i) - f a) @[h --> 0^'])%classic. + lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := \row_(i < n.+1) partial f a i. @@ -224,37 +229,37 @@ Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_ Definition gradient_jacobian {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) := jacobian (fun x => (f x)). -Lemma deriveE' {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) - (i : 'I_n.+1) : - ('D_'e_i (fun x : 'rV_n.+1 => (f x) : 'rV[R]_1) a) - = ('D_'e_i (fun x : 'rV_n.+1 => (f x)) a). +Local Open Scope classical_set_scope. +Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n (f : V -> 'M[R]_(m.+1, n.+1)) (x0 : V) (v : V) + (i : 'I_m.+1) (j : 'I_n.+1) : + 'D_v f x0 i j = 'D_v (fun x => f x i j) x0. +Proof. +apply/esym/cvg_lim => //=. +apply/cvgrPdist_le => /= e e0. +near=> t. +Admitted. +Local Close Scope classical_set_scope. + +Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : + derive1mx M t = M^`()%classic t. Proof. -rewrite /derive/=. done. +apply/rowP => i. +rewrite /derive1mx !mxE. +rewrite !derive1E. +by rewrite derivemx_derive. Qed. + Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) (i : 'I_n.+1) : partial (fun x => (f x) 0 0) a i = ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x) : 'rV[R]_1) a) 0 0. Proof. -(*rewrite deriveE' mxE eqxx mulr1n /partial /derive/=. -congr (lim (_ @[h --> 0^'])%classic) => //=. -apply/funext => h . -congr (_ *: _). -do 2 f_equal. -rewrite addrC. -f_equal. -congr (_ *: _). -apply/rowP => j. -by rewrite !mxE eqxx/= eq_sym.*) -Admitted. - -Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : - derive1mx M t = M^`()%classic t. -Proof. -apply/rowP => i. -rewrite /derive1mx !mxE /derive1. -Admitted. +rewrite derivemx_derive/=. +rewrite /partial. +rewrite /derive /=. +by under eq_fun do rewrite (addrC a). +Qed. Lemma gradientEE {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) : gradient_partial (fun x => (f x) 0 0) a = (gradient_jacobian f a)^T. @@ -287,21 +292,19 @@ elim/big_ind2 : _ => //=. move=> x y r s <- <-. by rewrite dotmulDl. Qed. -Search (Num.sqrt). -Lemma derive_sqrt {K : realType} : +Lemma derive_sqrt {K : realType} : (Num.sqrt^`())%classic = (fun t => (2 * Num.sqrt t)^-1) :> (_ -> K). Proof. apply/funext => i. rewrite derive1E /=. -Search (_^-1) (_*_). -rewrite invrM. Search (_^-1). +rewrite invrM. Admitted. Local Open Scope classical_set_scope. Lemma derive_norm n (u : K^o -> 'rV[K^o]_n.+1) : (forall t, norm (u t) != 0) -> - (1/2 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = + (2^-1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = (fun t => (derive1mx u t *m (u t)^T)``_0) :> (K -> K). Proof. move=> u0; apply/funext => t. @@ -309,7 +312,7 @@ rewrite [LHS]derive1E. rewrite deriveMl/=; last first. admit. rewrite -derive1E. -rewrite (@derive1_comp _ (@norm _ _ \o u ) (@GRing.exp K ^~ 2) ) ; last 2 first. +rewrite (@derive1_comp _ (@norm _ _ \o u ) (@GRing.exp K ^~ 2)) ; last 2 first. admit. admit. rewrite exp_derive1. @@ -318,15 +321,14 @@ rewrite derive1_comp /=; last 2 first. admit. rewrite !derive_sqrt. rewrite !expr1. -rewrite !(mulrA (1/2)). -rewrite div1r mulVf //; last by rewrite pnatr_eq0. -rewrite !mul1r. +rewrite !(mulrA 2^-1). +rewrite mulVf ?pnatr_eq0// mul1r. rewrite !dotmulvv. rewrite sqrtr_sqr. rewrite normr_norm. rewrite !mulrA /=. -have -> : norm (u t) / (2 * norm (u t)) = 1/2. - by rewrite invfM// mulrCA divff ?mulr1 ?div1r. +have -> : norm (u t) / (2 * norm (u t)) = 2^-1. + by rewrite invfM// mulrCA divff ?mulr1. set X := (X in X^`()%classic). have dot : X t = norm(u t)^+2 by rewrite /X dotmulvv. rewrite /X. @@ -337,9 +339,11 @@ rewrite dotmulP /=. set y := derive1mx u t *d u t. have -> : y + u t *d derive1mx u t = 2 * y. by rewrite mulr_natl mulr2n dotmulC. -by rewrite div1r mulrA mulVf ?pnatr_eq0// mul1r mxE eqxx mulr1n. +by rewrite mulrA mulVf ?pnatr_eq0// mul1r mxE eqxx mulr1n. Admitted. + End derive_help. + Section Lyapunov. (* locally positive definite around x that is an equilibrium point *) @@ -430,228 +434,214 @@ Definition V1dot (zp1_z2 : 'rV[K]_6) : K := - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution eqn33 x -> LieDerivative_gradient_jacobian V1 x t = V1dot (x t). +Lemma LieDerivative_gradient_jacobianD {R : realType} n + (f g : 'rV_n.+1 -> 'cV_1) (x : R -> 'rV_n.+1) : + LieDerivative_gradient_jacobian (f + g) x = + LieDerivative_gradient_jacobian f x + LieDerivative_gradient_jacobian g x. +Admitted. + +Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution eqn33 x -> + LieDerivative_gradient_jacobian V1 x t = V1dot (x t). Proof. -move => eqn33x. +move=> eqn33x. pose zp1 := fun r => @lsubmx K 1 3 3 (x r). pose z2 := fun r => @rsubmx K 1 3 3 (x r). -transitivity (alpha1^-1 * (('D_1 zp1 t) *d ((zp1 t))) + ((gamma^-1) * (('D_1 z2 t) *d ((z2 t))))). -rewrite/V1 /LieDerivative_gradient_jacobian. rewrite /gradient_jacobian. -rewrite derive1mxE' derive1E /=. -rewrite /dotmul. -rewrite -trmx_mul. -rewrite -derivemxE /=. -rewrite [x in ('D_ _ x _)^T] (_ : _ = (fun x0 : 'rV_6 => - (norm ( @lsubmx K 1 3 3 x0) ^+ 2 / (2 * alpha1))%:M) \+ (fun x0 => (norm (@lsubmx K 1 3 3 x0) ^+ 2 / (2 * gamma))%:M)). -rewrite deriveD /=. -rewrite mxE mxE. -congr (_+_). -rewrite [x in ('D_ _ x _) ](_ : _ = (1 / alpha1) * (1/2) \*: (fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1)). -rewrite deriveZ /=. -red in eqn33x. -(*rewrite derive_norm. -Search "derive". -transitivity ( \sum_(j < 6) - ('J (fun x0 : 'rV_6 => - (norm (lsubmx x0) ^+ 2 / (2 * alpha1) + norm (rsubmx x0) ^+ 2 / (2 * gamma))%:M) - (x t))^T 0 j * ('D_1 x t)^T j 0). -transitivity (alpha1^-1 * (('D_1 zp1 t) *d ((zp1 t))) + ((gamma^-1) * (('D_1 z2 t) *d ((z2 t))))). -rewrite /jacobian /=. rewrite !deriveE /=. -rewrite /zp1.*) +transitivity (alpha1^-1 * (('D_1 zp1 t) *d zp1 t) + + (gamma^-1 * (('D_1 z2 t) *d z2 t))). + rewrite /V1. + rewrite [X in LieDerivative_gradient_jacobian X _ _](_ : _ = + (fun zp1_z2 : 'rV_6 => + (norm (@lsubmx _ 1 3 3 zp1_z2) ^+ 2 / (2 * alpha1))%:M) + + + (fun zp1_z2 : 'rV_6 => + (norm (@rsubmx _ 1 3 3 zp1_z2) ^+ 2 / (2 * gamma))%:M) + ); last first. + apply/funext => y/=. + rewrite fctE. + by rewrite raddfD. + rewrite LieDerivative_gradient_jacobianD; congr +%R. + rewrite /LieDerivative_gradient_jacobian. + rewrite /gradient_jacobian. + rewrite /dotmul. + rewrite -trmx_mul. + rewrite -derivemxE; last first. + admit. + rewrite [X in 'D_(derive1mx x t) X _](_ : _ = + ((2 * alpha1)^-1%:M \*o + (fun x0 : 'rV_6 => (norm (@lsubmx _ 1 3 3 x0) ^+ 2)%:M))); last first. + admit. + transitivity (((2 * alpha1)^-1 *: + 'D_(derive1mx x t) (fun x0 : 'rV_6 => (norm (@lsubmx _ 1 3 3 x0) ^+ 2)%:M : 'rV_1) (x t))^T 0 0). + admit. + transitivity ((((2 * alpha1)^-1 *: + 'D_(derive1mx x t) (fun x0 : 'rV_6 => (norm (@lsubmx _ 1 3 3 x0) ^+ 2)) (x t))%:M : 'rV_1)^T 0 0). + admit. + rewrite (@deriveX K 'rV[K]_6 (fun x0 : 'rV_6 => norm (@lsubmx _ 1 3 3 x0)) 1 (x t) (derive1mx x t)); last first. + admit. + rewrite !scalerA mulrA invfM expr1 (mulrAC 2^-1) mulVf ?pnatr_eq0// div1r. + rewrite -scalerA !mxE eqxx mulr1n; congr *%R. Abort. + Lemma V1_is_lyapunov : is_lyapunov_function eqn33 V1 point1. Proof. split; first exact: equilibrium_point1. -(* lpd V1 point1 /\ - (forall traj : K -> 'rV_6, - is_solution eqn33 traj -> traj 0 = point1 -> lnsd [eta LieDerivative V1 traj] 0)*) -(* v1 at point 1 is positive definite*) - rewrite /locposdef; split. + by rewrite /V1 /point1 lsubmx0 rsubmx0 norm0 expr0n/= !mul0r add0r mxE /=. - (* \forall z \near 0^', 0 < - norm (lsubmx z) ^+ 2 / (2 * alpha1) + norm (rsubmx z) ^+ 2 / (2 * gamma)*) - have alpha1_pos: 0 < 2 * alpha1 by rewrite mulr_gt0 // ltr0Sn. - have gamma_pos: 0 < 2 * gamma by rewrite mulr_gt0 // gamma_gt0. - near=> z_near. - simpl in *. - set z_rv := ffun_to_rV6 (\val z_near). - have z_neq0 : z_near != 0 by near: z_near; exact: nbhs_dnbhs_neq. - have z_mat_neq0 : z_rv != 0. - rewrite /z_rv. - rewrite /ffun_to_rV6. - apply: contra z_neq0 => /eqP H. - apply/eqP/rowP => i. - rewrite !mxE. - move/rowP : H => /(_ i). - by rewrite !mxE//. - rewrite /V1. - have /orP[ lz0| rz0] : (@lsubmx _ _ 3 3 z_near != 0) || (@rsubmx _ _ 3 3 z_near != 0). - rewrite -negb_and. - apply: contra z_neq0 => /andP[/eqP l0 /eqP r0]. - rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. - apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP. - move => j k. by rewrite mxE. - move => k i3k. by rewrite mxE. - - set rsub := @rsubmx _ _ 3 3 z_near. - have : norm(rsub) >= 0 by rewrite norm_ge0. - set lsub := @lsubmx _ _ 3 3 z_near. - move => nor. - have : norm(lsub) > 0. - rewrite lt_neqAle. - by rewrite eq_sym norm_eq0 lz0 /= norm_ge0. - move => normlsub. - Search (_ < _ + _). - rewrite mxE /=. - apply: ltr_pwDl. - rewrite divr_gt0 //. - by rewrite exprn_gt0 //. - rewrite divr_ge0 //. - by rewrite exprn_ge0 //. - by apply ltW. - - rewrite mxE /=. - apply: ltr_pwDr. - rewrite divr_gt0 //. - rewrite exprn_gt0 //. - rewrite lt_neqAle. - Search (norm) 0. - rewrite eq_sym. - by rewrite norm_eq0 rz0 /= norm_ge0. - rewrite divr_ge0 // ?exprn_ge0 // ?norm_ge0 //. - by apply ltW. -- move => traj dtraj traj0. + + near=> z_near. + simpl in *. + set z_rv := ffun_to_rV6 (\val z_near). + have z_neq0 : z_near != 0 by near: z_near; exact: nbhs_dnbhs_neq. + have z_mat_neq0 : z_rv != 0. + apply: contra z_neq0 => /eqP H. + apply/eqP/rowP => i; rewrite !mxE. + by move/rowP : H => /(_ i); rewrite !mxE. + rewrite /V1. + have /orP[lz0|rz0] : (@lsubmx _ _ 3 3 z_near != 0) || (@rsubmx _ _ 3 3 z_near != 0). + rewrite -negb_and. + apply: contra z_neq0 => /andP[/eqP l0 /eqP r0]. + rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. + by apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; rewrite mxE. + + set rsub := @rsubmx _ _ 3 3 z_near. + have : norm rsub >= 0 by rewrite norm_ge0. + set lsub := @lsubmx _ _ 3 3 z_near. + move => nor. + have normlsub : norm lsub > 0 by rewrite norm_gt0. + rewrite mxE /= ltr_pwDl//. + by rewrite divr_gt0 ?exprn_gt0// mulr_gt0. + by rewrite divr_ge0 ?exprn_ge0// mulr_ge0// ltW. + - rewrite mxE /= ltr_pwDr//. + by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0// norm_gt0. + by rewrite divr_ge0 ?exprn_ge0 ?norm_ge0// mulr_ge0// ltW. +- move=> traj dtraj traj0. rewrite /lnsd /LieDerivative_gradient_jacobian. rewrite traj0 /point1. split. - Search (derive1mx). - rewrite derive1mxE' /gradient_jacobian /V1. + + rewrite derive1mxE' /gradient_jacobian /V1. rewrite !derive1E. - rewrite /dotmul. rewrite -trmx_mul /= mxE. + rewrite /dotmul. + rewrite -trmx_mul /= mxE. rewrite /is_solution /derive1mx /eqn33 in dtraj. - set f_expr := (fun x : 'rV_5%R.+1 => - (norm ( @lsubmx K 1 3 3 x) ^+ 2 / (2 * alpha1) + norm ( @rsubmx K 1 3 3 x) ^+ 2 / (2 * gamma))%:M). + set f_expr := fun x : 'rV_6 => + (norm (@lsubmx K 1 3 3 x) ^+ 2 / (2 * alpha1) + + norm (@rsubmx K 1 3 3 x) ^+ 2 / (2 * gamma))%:M. pose phi := fun t => f_expr (traj t). rewrite /traj0. - have eq_point1: 'D_1 traj 0 = 0. - rewrite /dtraj /traj0. - have deriv_at_0: \matrix_(i, j) (fun x : K => traj x i j)^`() 0 = - row_mx (- alpha1 *: (@lsubmx K 1 3 3 (traj 0))) - (gamma *: ((@rsubmx K 1 3 3 (traj 0)) - (@lsubmx K 1 3 3 (traj 0))) *m + have eq_point1 : 'D_1 traj 0 = 0. + rewrite /dtraj /traj0. + have deriv_at_0: \matrix_(i, j) (fun x : K => traj x i j)^`() 0 = + row_mx (- alpha1 *: (@lsubmx K 1 3 3 (traj 0))) + (gamma *: ((@rsubmx K 1 3 3 (traj 0)) - (@lsubmx K 1 3 3 (traj 0))) *m \S('e_2 - (@rsubmx K 1 3 3 (traj 0))) ^+ 2). - exact: dtraj. - have deriv_at_point1: 'D_1 traj 0 = - row_mx (- alpha1 *: @lsubmx K 1 3 3 (traj 0)) - (gamma *: (@rsubmx K 1 3 3 (traj 0) - @lsubmx K 1 3 3 (traj 0)) *m - \S('e_2 - @rsubmx K 1 3 3 (traj 0)) ^+ 2). - rewrite -deriv_at_0. - rewrite -derive1E /=. - apply/matrixP => i j. rewrite -derive1mxE. - rewrite derive1mxE /=. rewrite !mxE /=. - admit. - have eq_zero: row_mx (- alpha1 *: @lsubmx K 1 3 3 point1) - (gamma *: (@rsubmx K 1 3 3 point1 - @lsubmx K 1 3 3 point1) *m - \S('e_2 - @rsubmx K 1 3 3 point1) ^+ 2) = 0. - have := equilibrium_point1 0. - rewrite /is_equilibrium_point /eqn33. - move => H. - rewrite /point1. apply/matrixP => i j. - rewrite !linear0 addr0. - rewrite addr0. rewrite scaler0 mul0mx. - by rewrite row_mx0. - have traj_deriv_zero: 'D_1 traj 0 = 0. - rewrite deriv_at_point1. - rewrite traj0. - by rewrite eq_zero. - by rewrite traj_deriv_zero. - rewrite eq_point1. - rewrite mul0mx /=. - by rewrite mxE. - near=> z. - rewrite derive1mxE'. - rewrite /gradient_jacobian /=. - Search (_*d_) (_*m_). - rewrite /dotmul /=. - Search (_^T). - rewrite /is_solution /derive1mx /eqn33 in dtraj. - rewrite -trmx_mul /=. rewrite mxE /=. - rewrite /V1 /=. rewrite -derivemxE /=. - rewrite [x in ('D_ _ x _)] (_ : _ = (fun x0 : 'rV_6 => - (norm ( @lsubmx K 1 3 3 x0) ^+ 2 / (2 * alpha1))%:M) \+ (fun x0 => (norm (@lsubmx K 1 3 3 x0) ^+ 2 / (2 * gamma))%:M)). - rewrite deriveD /=. - rewrite mxE. - rewrite [x in ('D_ _ x _) ](_ : _ = (1 / alpha1) * (1/2) \*: (fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1)). - rewrite !deriveZ /=. - under [in X in _ + X] eq_fun => x0. - rewrite [_ / (2 * gamma)]mulrC. - over. - rewrite /=. - rewrite [X in _ + X] - (_ : 'D_((traj^`())%classic z) (fun x0 : 'rV[K]_6 => ((2 * gamma)^-1 * norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1) (traj z) 0 0 = - (2 * gamma)^-1 *: 'D_((traj^`())%classic z) (fun x0 : 'rV[K]_6 => (norm (@rsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1) (traj z) 0 0). - pose f := fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0))%:M : 'rV[K]_1. - pose F := fun x0 : 'rV_6 => (f x0) ^+ 2. - set dF_l : 'rV[K]_1 := 'D_((traj^`())%classic z) + exact: dtraj. + have deriv_at_point1 : 'D_1 traj 0 = + row_mx (- alpha1 *: @lsubmx K 1 3 3 (traj 0)) + (gamma *: (@rsubmx K 1 3 3 (traj 0) - @lsubmx K 1 3 3 (traj 0)) *m + \S('e_2 - @rsubmx K 1 3 3 (traj 0)) ^+ 2). + rewrite -deriv_at_0. + rewrite -derive1E /=. + apply/matrixP => i j; rewrite !mxE. + rewrite ord1. + by rewrite derive1E derivemx_derive// -derive1E. + have eq_zero: row_mx (- alpha1 *: @lsubmx K 1 3 3 point1) + (gamma *: (@rsubmx K 1 3 3 point1 - @lsubmx K 1 3 3 point1) *m + \S('e_2 - @rsubmx K 1 3 3 point1) ^+ 2) = 0. + have := equilibrium_point1 0. + rewrite /is_equilibrium_point /eqn33. + move => H. + rewrite /point1. apply/matrixP => i j. + rewrite !linear0 addr0. + rewrite addr0. rewrite scaler0 mul0mx. + by rewrite row_mx0. + have traj_deriv_zero: 'D_1 traj 0 = 0. + rewrite deriv_at_point1. + rewrite traj0. + by rewrite eq_zero. + by rewrite traj_deriv_zero. + rewrite eq_point1. + rewrite mul0mx /=. + by rewrite mxE. + + near=> z. + rewrite derive1mxE'. + rewrite /gradient_jacobian /=. + rewrite /dotmul /=. + rewrite /is_solution /derive1mx /eqn33 in dtraj. + rewrite -trmx_mul /=. rewrite mxE /=. + rewrite /V1 /=. + rewrite -derivemxE /=; last first. + admit. + rewrite [x in ('D_ _ x _)] (_ : _ = (fun x0 : 'rV_6 => + (norm (@lsubmx K 1 3 3 x0) ^+ 2 / (2 * alpha1))%:M) \+ + (fun x0 => (norm (@rsubmx K 1 3 3 x0) ^+ 2 / (2 * gamma))%:M)); last first. + by apply/funext => v/=; rewrite !raddfD. + rewrite deriveD /=; last 2 first. + admit. + admit. + rewrite mxE. + rewrite [x in ('D_ _ x _) ](_ : _ = alpha1^-1 * 2^-1 \*: + (fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1)); last first. + apply/funext => x/=. + by rewrite mulrC invfM (mulrC _ alpha1^-1) scale_scalar_mx. + rewrite !deriveZ /=; last first. + admit. + under [in X in _ + X] eq_fun => x0. + rewrite [_ / (2 * gamma)]mulrC. + over. + rewrite /=. + rewrite [X in _ + X <= 0] (_ : _ = + (2 * gamma)^-1 *: 'D_((traj^`())%classic z) + (fun x0 : 'rV[K]_6 => (norm (@rsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1) (traj z) 0 0); last first. + admit. + pose f := fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0))%:M : 'rV[K]_1. + pose F := fun x0 : 'rV_6 => (f x0) ^+ 2. + set dF_l : 'rV[K]_1 := 'D_((traj^`())%classic z) (fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M) (traj z). - rewrite !mxE. - set a := 1 / alpha1 * (1 / 2). - set b := (2 * gamma)^-1. - set dF_r : 'rV[K]_1 := 'D_((traj^`())%classic z) + rewrite !mxE. + set a := alpha1^-1 * 2^-1. + set b := (2 * gamma)^-1. + set dF_r : 'rV[K]_1 := 'D_((traj^`())%classic z) (fun x0 : 'rV[K]_6 => (norm (@rsubmx K 1 3 3 x0) ^+ 2)%:M) (traj z). - have: dF_l``_0 = (2 *: (@lsubmx K 1 3 3 (traj z)) 0 0). - rewrite /dF_l. - set u := fun t => @lsubmx K 1 3 3 (traj t). - have Hnorm_neq0 : forall t, norm (u t) != 0. - admit. - have Hderiv : - (((1 / 2) \*o (GRing.exp (R:=K))^~ 2 \o norm (n:=3)) \o u)^`() = - (fun t => (derive1mx u t *m (u t)^T) 0 0). - apply: derive_norm => t. - apply: Hnorm_neq0. - have: dF_r``_0 = 2 * (@rsubmx K 1 3 3 (traj z)) 0 0. - set v := fun t => @rsubmx K 1 3 3 (traj t). - have Hvnorm_neq0 : forall t, norm (v t) != 0. - admit. - have Hvderiv : - (((1 / 2) \*o (GRing.exp (R:=K))^~ 2 \o norm (n:=3)) \o v)^`() = - (fun t => (derive1mx v t *m (v t)^T) 0 0). - apply: derive_norm => t. - apply:Hvnorm_neq0. - have -> : dF_r``_0 = ((fun t => (derive1mx v t *m (v t)^T) 0 0) z). - rewrite /dF_r. rewrite -!derive1mxE'. - set g := fun (x0 : 'rV_6) => ((norm (@rsubmx K 1 3 3 x0)) ^+ 2)%:M. - have : ('D_(derive1mx traj z) g (traj z)) 0 0 - = (((fun t => norm (v t)) ^+ 2)^`() z). - admit. - move => etc. - rewrite /g. - rewrite etc. - Search "derive" (_^+_). - rewrite derive1E. - rewrite deriveX /=. - admit. - admit. - admit. - rewrite /v /derive1mx. - admit. - move => d. - rewrite /a /b /=. - rewrite -oppr_ge0 /=. - have ab_pos : 0 < a + b. - rewrite /a /b. - apply: addr_gt0. - apply: mulr_gt0. - apply: divr_gt0. - by []. - by apply alpha1_gt0. - by apply divr_gt0. - rewrite -div1r. - apply: divr_gt0. - by []. - apply: mulr_gt0. - by []. - by apply gamma_gt0. - have : (@lsubmx K 1 3 3 (traj z))``_0 = (dF_l``_0 / 2). + have: dF_l``_0 = (2 *: (@lsubmx K 1 3 3 (traj z)) 0 0). + rewrite /dF_l. + set u := fun t => @lsubmx K 1 3 3 (traj t). + have Hderiv : + ((2^-1 \*o (GRing.exp (R:=K))^~ 2 \o norm (n:=3)) \o u)^`() = + (fun t => (derive1mx u t *m (u t)^T) 0 0). + apply: derive_norm => t. + rewrite norm_eq0. + admit. + have: dF_r``_0 = 2 * (@rsubmx K 1 3 3 (traj z)) 0 0. + set v := fun t => @rsubmx K 1 3 3 (traj t). + have -> : dF_r``_0 = ((fun t => (derive1mx v t *m (v t)^T) 0 0) z). + rewrite /dF_r. rewrite -!derive1mxE'. + set g := fun (x0 : 'rV_6) => ((norm (@rsubmx K 1 3 3 x0)) ^+ 2)%:M. + have : ('D_(derive1mx traj z) g (traj z)) 0 0 + = ((fun t => norm (v t)) ^+ 2)^`() z. + rewrite derivemx_derive//. + rewrite derive1E//=. + admit. + move => etc. + rewrite /g. + rewrite etc. + rewrite derive1E. + rewrite deriveX /=. + admit. + admit. + admit. + admit. +rewrite /v /derive1mx. +move => d. +rewrite /a /b /=. +rewrite -oppr_ge0 /=. +have ab_pos : 0 < a + b. + rewrite addr_gt0//. + by rewrite mulr_gt0 ?invr_gt0. + by rewrite invr_gt0 ?mulr_gt0. +have : (@lsubmx K 1 3 3 (traj z))``_0 = (dF_l``_0 / 2). have Hrsubmx_eq : (@rsubmx K 1 3 3 (traj z))``_0 = (dF_r``_0) / 2. + admit. + admit. +admit. Admitted. End Lyapunov. From 5a2f57fbaad9a356787f7c9dcc1c999e617ce8ec Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Thu, 26 Jun 2025 10:32:38 +0900 Subject: [PATCH 016/144] proved V1 Lie derivative matches the one in the paper + LieDerivative properties + tidying of the file --- tilt.v | 950 +++++++++++++++++++++++++++++++-------------------------- 1 file changed, 520 insertions(+), 430 deletions(-) diff --git a/tilt.v b/tilt.v index 4f336048..f9686fae 100644 --- a/tilt.v +++ b/tilt.v @@ -6,47 +6,324 @@ Require Import ssr_ext euclidean rigid frame skew derive_matrix. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. - Import Order.TTheory GRing.Theory Num.Def Num.Theory. - Import numFieldNormedType.Exports. - Local Open Scope ring_scope. -Parameter K : realType. -Parameter W : Frame.t K. (* world frame *) -Parameter L : Frame.t K. (* sensor frame *) -Parameter v : K -> 'rV[K]_3. (* linear velocity *) -Parameter w : 'rV[K]_3. (* angular velocity *) -Parameter g0 : K. (* standard gravity constant *) -Parameter R : K -> 'M[K]_3. (* orientation of the IMU w.r.t. the world *) +(* PR: to MathComp *) +Lemma lsubmx0 {R : nmodType} m n1 n2 : @lsubmx R m n1 n2 0 = 0. +Proof. by apply/matrixP => i j; rewrite !mxE. Qed. + +Lemma rsubmx0 {R : nmodType} m n1 n2 : @rsubmx R m n1 n2 0 = 0. +Proof. by apply/matrixP => i j; rewrite !mxE. Qed. + +Lemma derive_sqrt {K : realType} : + (Num.sqrt^`())%classic = (fun t => (2 * Num.sqrt t)^-1) :> (_ -> K). +Proof. +apply/funext => i. +rewrite derive1E /=. +rewrite invrM. +(* utiliser la reciproque de la fonction carree?*) +Admitted. + +Local Open Scope classical_set_scope. +Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n + (f : V -> 'M[R]_(m.+1, n.+1)) (x0 : V) (v : V) (i : 'I_m.+1) (j : 'I_n.+1) : + 'D_v f x0 i j = 'D_v (fun x => f x i j) x0. +Proof. +apply/esym/cvg_lim => //=. +apply/cvgrPdist_le => /= e e0. +near=> t. +Admitted. +Local Close Scope classical_set_scope. + +Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : + derive1mx M t = M^`()%classic t. +Proof. +apply/rowP => i. +rewrite /derive1mx !mxE. +rewrite !derive1E. +by rewrite derivemx_derive. +Qed. + +Local Open Scope classical_set_scope. + +Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := + V x = 0 /\ \forall z \near 0^', V z > 0. + +(* locally positive semi definite*) +Definition lpsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := + V x = 0 /\ \forall z \near 0^', V z >= 0. + +(*locally negative semidefinite *) +Definition locnegsemidef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := + V x = 0 /\ \forall z \near 0^', V z <= 0. + +(*locally negative definite*) +Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := + V x = 0 /\ \forall z \near 0^', V z < 0. + +Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := + lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. + +Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := + \row_(i < n.+1) partial f a i. + +Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) + (i : 'I_n.+1) : + partial (fun x => (f x) 0 0) a i = + ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x) : 'rV[R]_1) a) 0 0. +Proof. +rewrite derivemx_derive/=. +rewrite /partial. +rewrite /derive /=. +by under eq_fun do rewrite (addrC a). +Qed. + +Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) + (a : R -> 'rV[R]_n.+1) (t : R) : R := + \sum_(i < n.+1) (partial V (a t) i * (derive1mx a t) ``_ i). + +Definition jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) := + jacobian f. + +Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1): + gradient_partial (fun x : 'rV[R]_n.+1 => (f x) 0 0) a = (jacobian1 f a)^T. +Proof. +rewrite /jacobian1. +apply/rowP => i. +rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. + admit. +by rewrite partial_diff. +Admitted. + +Lemma gradient_partial_sum {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : + gradient_partial f a = \sum_(i < n.+1) partial f a i *: 'e_i. +Proof. +rewrite /gradient_partial [LHS]row_sum_delta. +by under eq_bigr do rewrite mxE. +Qed. + +Section derive_help. + +Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := + \row_(j < n.+1) (i == j)%:R. + +Lemma err_vecE {R : ringType} n (i : 'I_n.+1) : + err_vec i = 'e_i :> 'rV[R]_n.+1. +Proof. +apply/rowP => j. +by rewrite !mxE eqxx /= eq_sym. +Qed. + + +Local Open Scope classical_set_scope. +Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) : + (forall t, norm (u t) != 0) -> + (2^-1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = + (fun t => (derive1mx u t *m (u t)^T)``_0) :> (K -> K). +Proof. +move=> u0; apply/funext => t. +rewrite [LHS]derive1E. +rewrite deriveMl/=; last first. + admit. +rewrite -derive1E. +rewrite (@derive1_comp _ (@norm _ _ \o u ) (@GRing.exp K ^~ 2)) ; last 2 first. + admit. + admit. +rewrite exp_derive1. +rewrite derive1_comp /=; last 2 first. + admit. + admit. +rewrite !derive_sqrt. +rewrite !expr1. +rewrite !(mulrA 2^-1). +rewrite mulVf ?pnatr_eq0// mul1r. +rewrite !dotmulvv. +rewrite sqrtr_sqr. +rewrite normr_norm. +rewrite !mulrA /=. +have -> : norm (u t) / (2 * norm (u t)) = 2^-1. + by rewrite invfM// mulrCA divff ?mulr1. +set X := (X in X^`()%classic). +have dot : X t = norm(u t)^+2 by rewrite /X dotmulvv. +rewrite /X. +rewrite !derive1mx_dotmul; last 2 first. + admit. + admit. +rewrite dotmulP /=. +set y := derive1mx u t *d u t. +have -> : y + u t *d derive1mx u t = 2 * y. + by rewrite mulr_natl mulr2n dotmulC. +by rewrite mulrA mulVf ?pnatr_eq0// mul1r mxE eqxx mulr1n. +Admitted. + +End derive_help. + +Definition LieDerivative_jacobian1 {R : realType} n (V : 'rV[R]_n.+1 -> 'rV[R]_1) + (x : R -> 'rV[R]_n.+1) (t : R) : R := + let xdot_t := derive1mx x t in + (jacobian1 V (x t))^T *d xdot_t. + +Lemma LieDerivative_jacobian1Ml {R : realType} n + (f : 'rV_n.+1 -> 'cV_1) (x : R -> 'rV_n.+1) (k : R) : + LieDerivative_jacobian1 (k *: f) x = k *: LieDerivative_jacobian1 f x. +Proof. +rewrite /LieDerivative_jacobian1 /jacobian1 /jacobian. +rewrite !fctE. +apply/funext => y. +rewrite /dotmul. +rewrite [X in ((lin1_mx X )^T *m (derive1mx x y)^T) 0 0 = _](@diffZ R _ _ _ _ _ ); last first. + admit. +rewrite -!trmx_mul ( _ : lin1_mx (k \*: 'd f (x y)) = k *: lin1_mx ('d f (x y))); last first. + apply/matrixP => i j. + by rewrite !mxE. +rewrite mxE [in RHS]mxE. +by rewrite -scalemxAr mxE. +Admitted. + +Lemma LieDerivative_jacobian1D {K : realType} n + (f g : 'rV_n.+1 -> 'cV_1) (x : K -> 'rV_n.+1) : + LieDerivative_jacobian1 (f + g) x = + LieDerivative_jacobian1 f x + LieDerivative_jacobian1 g x. +Proof. +rewrite /LieDerivative_jacobian1 /jacobian1 !fctE /dotmul /jacobian. +apply/funext => t. +rewrite [X in ((lin1_mx X )^T *m (derive1mx x t)^T) 0 0 = _ ](@diffD K _ _ f g (x t)) ; last 2 first. + admit. + admit. +rewrite -trmx_mul. +rewrite ( _ : lin1_mx ('d f (x t) \+ 'd g (x t)) = + lin1_mx ('d f (x t)) + lin1_mx ('d g (x t))); last first. + apply/matrixP => i j. + rewrite mxE. + rewrite [RHS]mxE //. + rewrite [in LHS] /=. + rewrite [LHS]mxE. + by congr (_+_); rewrite mxE. +rewrite [in LHS] mulmxDr /=. +rewrite mxE mxE. +by congr (_+_); + rewrite -trmx_mul [RHS]mxE. +Admitted. + +Lemma LieDerivative_jacobian1_eq0_equilibrium {K : realType} n + (f : 'rV_n.+1 -> 'cV_1) (x : K -> 'rV[K]_n.+1) (t : K) : + 'D_1 x t = 0 -> LieDerivative_jacobian1 f x t = 0. +Proof. +move => dtraj. +rewrite /LieDerivative_jacobian1 /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. +by rewrite derive1mxE' /= mxE mxE /= derive1E dtraj mul0mx /= mxE /=. +Qed. + +Lemma LieDerivative_jacobian1_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) + (x : K -> 'rV[K]_6) (t : K) : + LieDerivative_jacobian1 (fun y => ((norm (f y)) ^+ 2)%:M) x t = + (2%:R *: derive1mx (f \o x) t *m (f (x t))^T) 0 0. +Proof. +rewrite /LieDerivative_jacobian1 /jacobian1 /dotmul. +rewrite /jacobian dotmulP /dotmul -trmx_mul. +rewrite !derive1mxE' /= mxE mxE /= !fctE. +rewrite !derive1E. +rewrite mulr1n. +rewrite -scalemxAl. +rewrite [RHS]mxE. +apply: (@mulfI _ 2^-1); first by rewrite invr_eq0// pnatr_eq0. +rewrite mulrA mulVf ?pnatr_eq0// mul1r. +set h := (fun x0 : 'rV_6 => (norm (f x0) ^+ 2)%:M). +set tmp : {linear 'rV_6 -> 'rV_1} := 'd h (x t). +rewrite -[in RHS]derive1E. +have : forall t0 : K^o, norm (f (x t0)) != 0. + admit. +move=> /derive_norm. +move=> /(congr1 (fun z => z t)). +rewrite /=. +rewrite derive1mxE'. +move=> <-. +rewrite derive1E. +rewrite deriveMl//=; last admit. +congr *%R. +rewrite /tmp /h. +rewrite [in RHS]deriveE; last first. + admit. +have /= := (@diff_comp _ _ _ _ x (fun z => (norm (f z) ^+ 2%R))). +move=> ->; last 2 first. + admit. + admit. +rewrite /=. +rewrite -[in RHS]deriveE; last first. + admit. +rewrite -/h. +have -> : ('D_1 x t *m lin1_mx 'd h (x t)) = + 'D_('d x t 1) (fun z : 'rV_6 => (norm (f z) ^+ 2%R)%:M) (x t). + have := (@derivemxE K 5 0 h (x t) ('d x t 1)). + move=> ->; last admit. + congr (_ *m _). + rewrite deriveE//. + admit. +rewrite derivemx_derive/=. +congr ('D_('d x t 1) _ (x t)). +apply/funext => v. +by rewrite mxE eqxx mulr1n. +Admitted. + +Section ode. +Context {K : realType}. +Let T := 'rV[K]_6. +Local Open Scope classical_set_scope. + +Variable f : K -> (K -> T) -> T. + +Definition is_solution (x : K -> T) : Prop := + forall t, derive1mx x t = f t x. + +Definition is_equilibrium_point p := is_solution (cst p). + +Definition equilibrium_points := [set p : T | is_equilibrium_point p]. + +Definition state_space := + [set p : T | exists y, is_solution y /\ p \in range y]. + +End ode. + +Definition is_lyapunov_function {K : realType} (n := 5) + (f : K -> (K -> 'rV[K]_n.+1) -> 'rV[K]_n.+1) + (V : 'rV[K]_n.+1 -> 'rV[K]_1) + (x0 : 'rV[K]_n.+1) : Prop := + [/\ is_equilibrium_point f x0, + locposdef (fun z => (V z) 0 0) x0 & + forall traj : K -> 'rV[K]_n.+1, + is_solution f traj -> + traj 0 = x0 -> + locnegsemidef (LieDerivative_jacobian1 V traj) 0]. + +Local Close Scope classical_set_scope. + +Section problem_statement. +Context {K : realType}. +Variable g0 : K. +Hypothesis g0_pos : 0 < g0. +Variable m : 'rV[K]_3. +Variable R : K -> 'M[K]_3. +Variable w : 'rV[K]_3. (* angular velocity *) +Variable v : K -> 'rV[K]_3. + Definition ez : 'rV[K]_3 := 'e_2. -Definition x1 := v. -Parameter m : 'rV[K]_3. Definition x2 t := ez *m (R t)^T. Definition x3 t := m *m (R t)^T. -Axiom g0_pos : 0 < g0. -Parameter alpha1 : K. -Parameter gamma : K. -Axiom gamma_gt0 : 0 < gamma. -Axiom alpha1_gt0 : 0 < alpha1. -Section problem_statement. - +Definition rhs24 t := m *m (R t)^T. Definition rhs23 t := v t *m \S(w) + derive1mx v t + g0 *: ez *m (R t)^T. - -Definition rhs24 t := m *m (R t)^T. - Definition eqn25 t := derive1mx R t = R t *m \S(w). End problem_statement. Section basic_facts. +Variable K : realType. Lemma fact212 (v w : 'rV[K]_3) : \S(v) * \S(w) = w^T *m v - (v *m w^T)``_0 *: 1. Proof. -apply/matrix3P/and9P; split; apply/eqP; - rewrite !(mxE,sum3E,spinij,sum1E); Simp.r. +apply/matrix3P/and9P; split; apply/eqP; rewrite !(mxE,sum3E,spinij,sum1E); Simp.r. ring. by rewrite mulrC. by rewrite mulrC. @@ -81,7 +358,6 @@ Lemma fact217 (v : 'rV[K]_3): \S(v) ^+ 3 = - (norm v ^+2) *: \S(v). exact: spin3. Qed. -Search "cV". Lemma fact214 (R : 'M[K]_3) (v_ : seq 'rV[K]_3) : R \is 'SO[K]_3 -> R^T * (\prod_(i <- v_) \S( i )) * R = (\prod_(i <- v_) \S( i *m R)). Proof. move => RSO. @@ -106,31 +382,20 @@ Local Open Scope classical_set_scope. Definition Gamma1 := [set x : 'rV[K]_6 | norm (@rsubmx _ 1 3 3 x) = 1]. End Gamma1. - -Section ode. -Context {K : realType}. -Let T := 'rV[K]_6. -Local Open Scope classical_set_scope. - -Variable f : K -> (K -> T) -> T. - -Definition is_solution (x : K -> T) : Prop := - forall t, derive1mx x t = f t x. - -Definition is_equilibrium_point p := is_solution (cst p). - -Definition equilibrium_points := [set p : T | is_equilibrium_point p]. - -Definition state_space := - [set p : T | exists y, is_solution y /\ p \in range y]. - -End ode. - + Section eqn33. +Variable K : realType. +Variable alpha1 : K. +Variable gamma : K. +Hypothesis gamma_gt0 : 0 < gamma. +Hypothesis alpha1_gt0 : 0 < alpha1. + +Local Notation Lsubmx := (@lsubmx K 1 3 3). +Local Notation Rsubmx := (@rsubmx K 1 3 3). -Definition eqn33 t (zp1_z2_point : K -> 'rV[K]_6) : 'rV[K]_6 := - let zp1_point t := @lsubmx _ 1 3 3 (zp1_z2_point t) in - let z2_point t := @rsubmx _ 1 3 3 (zp1_z2_point t) in +Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) t : 'rV[K]_6 := + let zp1_point := Lsubmx \o zp1_z2_point in + let z2_point := Rsubmx \o zp1_z2_point in row_mx (- alpha1 *: zp1_point t) (gamma *: (z2_point t - zp1_point t) *m \S('e_2%:R - z2_point t) ^+ 2). @@ -142,7 +407,7 @@ gamma1 ⊆ state_space*) Definition xi1 t (zp1_zp2 : K -> 'rV[K]_6) : Gamma1 := let zp1*) -Lemma thm11a : state_space eqn33 = Gamma1. +Lemma thm11a : state_space (fun a b => eqn33 b a) = Gamma1. Proof. apply/seteqP; split. - move=> p. @@ -159,9 +424,7 @@ Admitted. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2%:R). -Check equilibrium_points _. - -Lemma equilibrium_point1 : is_equilibrium_point eqn33 point1. +Lemma equilibrium_point1 : is_equilibrium_point (fun a b => eqn33 b a) point1. Proof. move => t ; rewrite derive1mx_cst /eqn33 /point1 ; apply/eqP ; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; by rewrite !mxE. @@ -170,8 +433,7 @@ move => t ; rewrite derive1mx_cst /eqn33 /point1 ; apply/eqP ; rewrite eq_sym (@ move => n; by rewrite n scaler0 mul0mx. Qed. -From mathcomp Require Import fintype. -Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2. +Lemma equilibrium_point2 : is_equilibrium_point (fun a b => eqn33 b a) point2. Proof. move => t; rewrite derive1mx_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). @@ -184,327 +446,207 @@ have N0 : N = 0. split. by rewrite scaler_eq0 N0 eqxx orbT. rewrite -scalemxAl scalemx_eq0 gt_eqF//=. - rewrite -/N N0 subr0. - set M := (X in X *m _); rewrite -/M. - have ME : M = 2 *: 'e_2. - apply/rowP => i; rewrite !mxE eqxx/=. - case: splitP => [j ij|j]/=. - have := ltn_ord j. - by rewrite -ij. - move/eqP. - rewrite eqn_add2l => /eqP /ord_inj ->. - by rewrite !mxE eqxx/=. - rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. - by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. -exact gamma_gt0. +rewrite -[Lsubmx point2]/N N0 subr0. +set M := (X in X *m _); rewrite -/M. +have ME : M = 2 *: 'e_2. + apply/rowP => i; rewrite !mxE eqxx/=. + case: splitP => [j ij|j]/=. + have := ltn_ord j. + by rewrite -ij. + move/eqP. + rewrite eqn_add2l => /eqP /ord_inj ->. + by rewrite !mxE eqxx/=. +rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. +by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. Qed. Open Scope classical_set_scope. (* this lemma asks for lyapunov + lasalle*) -Lemma tractories_converge (y : K -> 'rV[K]_6) : is_solution eqn33 y -> +Lemma tractories_converge (y : K -> 'rV[K]_6) : is_solution (fun a b => eqn33 b a) y -> y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. Proof. move=> is_sol_y. Abort. End eqn33. -Section derive_help. - -Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := - \row_(j < n.+1) (i == j)%:R. - -Lemma err_vecE {R : ringType} n (i : 'I_n.+1) : - err_vec i = 'e_i :> 'rV[R]_n.+1. -Proof. -apply/rowP => j. -by rewrite !mxE eqxx /= eq_sym. -Qed. - -Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := - lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. - -Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := - \row_(i < n.+1) partial f a i. - -Definition gradient_jacobian {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) := - jacobian (fun x => (f x)). - -Local Open Scope classical_set_scope. -Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n (f : V -> 'M[R]_(m.+1, n.+1)) (x0 : V) (v : V) - (i : 'I_m.+1) (j : 'I_n.+1) : - 'D_v f x0 i j = 'D_v (fun x => f x i j) x0. -Proof. -apply/esym/cvg_lim => //=. -apply/cvgrPdist_le => /= e e0. -near=> t. -Admitted. -Local Close Scope classical_set_scope. - -Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : - derive1mx M t = M^`()%classic t. -Proof. -apply/rowP => i. -rewrite /derive1mx !mxE. -rewrite !derive1E. -by rewrite derivemx_derive. -Qed. - - -Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) - (i : 'I_n.+1) : - partial (fun x => (f x) 0 0) a i = - ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x) : 'rV[R]_1) a) 0 0. -Proof. -rewrite derivemx_derive/=. -rewrite /partial. -rewrite /derive /=. -by under eq_fun do rewrite (addrC a). -Qed. - -Lemma gradientEE {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) : - gradient_partial (fun x => (f x) 0 0) a = (gradient_jacobian f a)^T. -Proof. -rewrite /gradient_jacobian. -apply/rowP => i. -rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. - admit. -by rewrite partial_diff. -Admitted. - -Lemma gradient_sum {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : - gradient_partial f a = \sum_(i < n.+1) partial f a i *: 'e_i. -Proof. -rewrite /gradient_partial [LHS]row_sum_delta. -by under eq_bigr do rewrite mxE. -Qed. - -Lemma lsubmx0 {R : nmodType} m n1 n2 : @lsubmx R m n1 n2 0 = 0. -Proof. by apply/matrixP => i j; rewrite !mxE. Qed. - -Lemma rsubmx0 {R : nmodType} m n1 n2 : @rsubmx R m n1 n2 0 = 0. -Proof. by apply/matrixP => i j; rewrite !mxE. Qed. - -Lemma dotmulsuml {R : ringType} [n : nat] (u : 'rV_n) (b : 'I_n -> 'rV[R]_n) : - (\sum_(i < n) b i) *d u = (\sum_(i < n) b i *d u). -Proof. -elim/big_ind2 : _ => //=. - by rewrite dotmul0v. -move=> x y r s <- <-. -by rewrite dotmulDl. -Qed. -Lemma derive_sqrt {K : realType} : - (Num.sqrt^`())%classic = (fun t => (2 * Num.sqrt t)^-1) :> (_ -> K). -Proof. -apply/funext => i. -rewrite derive1E /=. -rewrite invrM. -Admitted. - -Local Open Scope classical_set_scope. -Lemma derive_norm n (u : K^o -> 'rV[K^o]_n.+1) : - (forall t, norm (u t) != 0) -> - (2^-1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = - (fun t => (derive1mx u t *m (u t)^T)``_0) :> (K -> K). -Proof. -move=> u0; apply/funext => t. -rewrite [LHS]derive1E. -rewrite deriveMl/=; last first. - admit. -rewrite -derive1E. -rewrite (@derive1_comp _ (@norm _ _ \o u ) (@GRing.exp K ^~ 2)) ; last 2 first. - admit. - admit. -rewrite exp_derive1. -rewrite derive1_comp /=; last 2 first. - admit. - admit. -rewrite !derive_sqrt. -rewrite !expr1. -rewrite !(mulrA 2^-1). -rewrite mulVf ?pnatr_eq0// mul1r. -rewrite !dotmulvv. -rewrite sqrtr_sqr. -rewrite normr_norm. -rewrite !mulrA /=. -have -> : norm (u t) / (2 * norm (u t)) = 2^-1. - by rewrite invfM// mulrCA divff ?mulr1. -set X := (X in X^`()%classic). -have dot : X t = norm(u t)^+2 by rewrite /X dotmulvv. -rewrite /X. -rewrite !derive1mx_dotmul; last 2 first. - admit. - admit. -rewrite dotmulP /=. -set y := derive1mx u t *d u t. -have -> : y + u t *d derive1mx u t = 2 * y. - by rewrite mulr_natl mulr2n dotmulC. -by rewrite mulrA mulVf ?pnatr_eq0// mul1r mxE eqxx mulr1n. -Admitted. - -End derive_help. - -Section Lyapunov. -(* locally positive definite around x that is an equilibrium point *) - -From mathcomp.analysis Require Import topology normedtype. Open Scope classical_set_scope. -Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0^', V z > 0. - -(* locally positive semi definite*) -Definition lpsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0^', V z >= 0. - -(*locally negative semidefinite *) -Definition lnsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0^', V z <= 0. - -(*locally negative definite*) -Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0^', V z < 0. - +Section Lyapunov. Local Open Scope classical_set_scope. -Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) - (a : R -> 'rV[R]_n.+1) (t : R) : R := - \sum_(i < n.+1) (partial V (a t) i * (derive1mx a t) ``_ i). - -Definition LieDerivative_gradient_jacobian {R : realType} n (V : 'rV[R]_n.+1 -> 'rV[R]_1) - (x : R -> 'rV[R]_n.+1) (t : R) : R := - let xdot_t := derive1mx x t in - (gradient_jacobian V (x t) )^T *d xdot_t. - (*Lemma LieDerivative_gradientE {R : realType} n (V : 'rV[R]_n.+1 -> R) (x : R -> 'rV[R]_n.+1) : - LieDerivative_gradient V x = LieDerivative V x. + LieDerivative_gradient_partial V x = LieDerivative V x. Proof. apply/funext => t; rewrite /LieDerivative_gradient /LieDerivative. rewrite gradientE dotmulsuml; apply: eq_bigr => /= i _. rewrite dotmulE (bigD1 i)//= big1 ?addr0; last first. by move=> j ji; rewrite !mxE/= (negbTE ji) mulr0 mul0r. by rewrite !mxE/= eqxx mulr1. -Qed. -*) - -Definition is_lyapunov_function (n := 5) - (f : K -> (K -> 'rV[K]_n.+1) -> 'rV[K]_n.+1) - (V : 'rV[K]_n.+1 -> 'rV[K]_1) - (x0 : 'rV[K]_n.+1) : Prop := - [/\ is_equilibrium_point f x0, - locposdef (fun z => (V z) 0 0) x0 & - forall traj : K -> 'rV[K]_n.+1, - is_solution f traj -> - traj 0 = x0 -> - lnsd (fun t => (LieDerivative_gradient_jacobian V traj t)) 0]. +Qed.*) +Context {K : realType}. Variable x1_hat : K -> 'rV[K]_3. Variable x2_hat : K -> 'rV[K]_3. +Variable alpha1 : K. +Variable gamma : K. +Variable g0 : K. +Hypothesis g0_pos : 0 < g0. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. +Variable R : K -> 'M[K]_3. +Variable v : K -> 'rV[K]_3. +Definition x1 := v. Definition p1 t : 'rV[K]_3 := let x1_t := x1 t in - let x2_t := x2 t in + let x2_t := x2 R t in let x1_hat_t := x1_hat t in x2_t + (alpha1 / g0) *: (x1_t - x1_hat_t). Definition x2_tilde t : 'rV[K]_3 := - let x2_t := x2 t in + let x2_t := x2 R t in let x2_hat_t := x2_hat t in (x2_t - x2_hat_t). (* dependance des conditions intiales de ^x2 qui doit etre sur S2.*) +Local Notation Lsubmx := (@lsubmx K 1 3 3). +Local Notation Rsubmx := (@rsubmx K 1 3 3). + Definition zp1_z2_eq t (zp1_z2 : K -> 'rV[K]_6) : 'rV[K]_6 := - let zp1 t := @lsubmx K 1 3 3 (zp1_z2 t) in - let z2 t := @rsubmx K 1 3 3 (zp1_z2 t) in - row_mx ((p1 t) *m R t) ((x2_tilde t) *m R t). + let zp1 := Lsubmx \o zp1_z2 in + let z2 := Rsubmx \o zp1_z2 in + row_mx (p1 t *m R t) (x2_tilde t *m R t). Definition V1 (zp1_z2 : 'rV[K]_6) : 'rV[K]_1 := - let zp1 := @lsubmx K 1 3 3 (zp1_z2) in - let z2 := @rsubmx K 1 3 3 (zp1_z2) in - ((norm (zp1))^+2 / (2%:R * alpha1) + (norm (z2))^+2 / (2%:R * gamma))%:M. - -Definition ffun_to_rV6 (f : {ffun 'I_1 * 'I_6 -> K}) : 'rV_6 := - \row_(i < 6) f (ord0, i). + let zp1 := Lsubmx zp1_z2 in + let z2 := Rsubmx zp1_z2 in + ((norm zp1)^+2 / (2%:R * alpha1) + (norm z2)^+2 / (2%:R * gamma))%:M. Definition V1dot (zp1_z2 : 'rV[K]_6) : K := - let zp1 := @lsubmx K 1 3 3 (zp1_z2) in - let z2 := @rsubmx K 1 3 3 (zp1_z2) in + let zp1 := Lsubmx zp1_z2 in + let z2 := Rsubmx zp1_z2 in - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. -Lemma LieDerivative_gradient_jacobianD {R : realType} n - (f g : 'rV_n.+1 -> 'cV_1) (x : R -> 'rV_n.+1) : - LieDerivative_gradient_jacobian (f + g) x = - LieDerivative_gradient_jacobian f x + LieDerivative_gradient_jacobian g x. -Admitted. - -Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution eqn33 x -> - LieDerivative_gradient_jacobian V1 x t = V1dot (x t). +Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution (fun a b => @eqn33 K alpha1 gamma b a) x -> + LieDerivative_jacobian1 V1 x t = V1dot (x t). Proof. move=> eqn33x. -pose zp1 := fun r => @lsubmx K 1 3 3 (x r). -pose z2 := fun r => @rsubmx K 1 3 3 (x r). -transitivity (alpha1^-1 * (('D_1 zp1 t) *d zp1 t) + - (gamma^-1 * (('D_1 z2 t) *d z2 t))). +pose zp1 := fun r => Lsubmx (x r). +pose z2 := fun r => Rsubmx (x r). +rewrite /V1. +(*rewrite LieDerivative_gradient_jacobianD. +rewrite [X in LieDerivative_gradient_jacobian X] LieDerivative_gradient_jacobianMl.*) rewrite /V1. - rewrite [X in LieDerivative_gradient_jacobian X _ _](_ : _ = + rewrite [X in LieDerivative_jacobian1 X _ _](_ : _ = (fun zp1_z2 : 'rV_6 => - (norm (@lsubmx _ 1 3 3 zp1_z2) ^+ 2 / (2 * alpha1))%:M) + (norm (Lsubmx zp1_z2) ^+ 2 / (2 * alpha1))%:M) + (fun zp1_z2 : 'rV_6 => - (norm (@rsubmx _ 1 3 3 zp1_z2) ^+ 2 / (2 * gamma))%:M) + (norm (Rsubmx zp1_z2) ^+ 2 / (2 * gamma))%:M) ); last first. apply/funext => y/=. rewrite fctE. by rewrite raddfD. - rewrite LieDerivative_gradient_jacobianD; congr +%R. - rewrite /LieDerivative_gradient_jacobian. - rewrite /gradient_jacobian. + rewrite LieDerivative_jacobian1D. + rewrite !invfM /=. + set c1 := (2^-1 / alpha1). + set c2 := (2^-1 / gamma). + rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = + (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. + apply/funext => y. + by rewrite -scale_scalar_mx. + rewrite !fctE. + have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = + (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = + (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. + apply/funext => y. + by rewrite -scale_scalar_mx. + rewrite func_eq. + have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = + (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite func_eq2. + rewrite !LieDerivative_jacobian1Ml. + rewrite !fctE. +rewrite !LieDerivative_jacobian1_norm /=. +rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. +rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC mulVf ?pnatr_eq0// div1r. +rewrite -[Lsubmx \o x]/zp1. +rewrite -[Rsubmx \o x]/z2. +have H1 : derive1mx zp1 t = (- alpha1 *: Lsubmx (x t)). + have := eqn33x t. + rewrite /eqn33. + admit. (* from eqn33? *) +have H2 : derive1mx z2 t = (gamma *: (Rsubmx (x t) - Lsubmx (x t)) *m \S('e_2 - Rsubmx (x t)) ^+ 2). + admit. +rewrite H1. +rewrite -scalemxAl. +rewrite mxE. +rewrite [X in X + _](mulrA (alpha1^-1) (- alpha1)). +rewrite mulrN. +rewrite mulVf ?gt_eqF// mulN1r. +rewrite H2. +rewrite -scalemxAl. +rewrite mulmxA. +rewrite -scalemxAl. +rewrite [in X in _ + X]mxE. +rewrite scalerA. +rewrite mulVf ?gt_eqF//. +rewrite scale1r. +have -> : ((Lsubmx (x t)) *m (Lsubmx (x t))^T) 0 0 = norm (Lsubmx (x t)) ^+2. + rewrite sqr_sqrtr. rewrite /dotmul. - rewrite -trmx_mul. - rewrite -derivemxE; last first. - admit. - rewrite [X in 'D_(derive1mx x t) X _](_ : _ = - ((2 * alpha1)^-1%:M \*o - (fun x0 : 'rV_6 => (norm (@lsubmx _ 1 3 3 x0) ^+ 2)%:M))); last first. - admit. - transitivity (((2 * alpha1)^-1 *: - 'D_(derive1mx x t) (fun x0 : 'rV_6 => (norm (@lsubmx _ 1 3 3 x0) ^+ 2)%:M : 'rV_1) (x t))^T 0 0). - admit. - transitivity ((((2 * alpha1)^-1 *: - 'D_(derive1mx x t) (fun x0 : 'rV_6 => (norm (@lsubmx _ 1 3 3 x0) ^+ 2)) (x t))%:M : 'rV_1)^T 0 0). - admit. - rewrite (@deriveX K 'rV[K]_6 (fun x0 : 'rV_6 => norm (@lsubmx _ 1 3 3 x0)) 1 (x t) (derive1mx x t)); last first. - admit. - rewrite !scalerA mulrA invfM expr1 (mulrAC 2^-1) mulVf ?pnatr_eq0// div1r. - rewrite -scalerA !mxE eqxx mulr1n; congr *%R. -Abort. - + admit. + admit. +rewrite /V1dot. +congr +%R. +set Lmx := lsubmx _. +set Rmx := rsubmx _. +rewrite -2![in RHS]mulmxA. +rewrite -mulmxBr. +rewrite -mulmxBr. +rewrite -linearB/=. +rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK. +rewrite -[X in _ = (_ *m (X *m _)) 0 0]trmxK. +rewrite mulmxA. +rewrite -trmx_mul. +rewrite -trmx_mul. +rewrite [RHS]mxE. +rewrite -(mulmxA (Rmx - Lmx)). +rewrite mulmxE. +rewrite -expr2. +have -> : (\S('e_2 - Rmx) ^+ 2)^T = \S('e_2 - Rmx) ^+ 2. + apply/esym/eqP. + rewrite -symE. + exact: sqr_spin_is_sym. +by rewrite mulmxA. +Admitted. -Lemma V1_is_lyapunov : is_lyapunov_function eqn33 V1 point1. +Lemma V1_is_lyapunov : is_lyapunov_function (fun a b => @eqn33 K alpha1 gamma b a) V1 (@point1 K). Proof. split; first exact: equilibrium_point1. - rewrite /locposdef; split. + by rewrite /V1 /point1 lsubmx0 rsubmx0 norm0 expr0n/= !mul0r add0r mxE /=. + near=> z_near. simpl in *. - set z_rv := ffun_to_rV6 (\val z_near). have z_neq0 : z_near != 0 by near: z_near; exact: nbhs_dnbhs_neq. - have z_mat_neq0 : z_rv != 0. - apply: contra z_neq0 => /eqP H. - apply/eqP/rowP => i; rewrite !mxE. - by move/rowP : H => /(_ i); rewrite !mxE. rewrite /V1. - have /orP[lz0|rz0] : (@lsubmx _ _ 3 3 z_near != 0) || (@rsubmx _ _ 3 3 z_near != 0). + have /orP[lz0|rz0] : (Lsubmx z_near != 0) || (Rsubmx z_near != 0). rewrite -negb_and. apply: contra z_neq0 => /andP[/eqP l0 /eqP r0]. rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. by apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; rewrite mxE. - + set rsub := @rsubmx _ _ 3 3 z_near. + + set rsub := Rsubmx z_near. have : norm rsub >= 0 by rewrite norm_ge0. - set lsub := @lsubmx _ _ 3 3 z_near. + set lsub := Lsubmx z_near. move => nor. have normlsub : norm lsub > 0 by rewrite norm_gt0. rewrite mxE /= ltr_pwDl//. @@ -514,134 +656,82 @@ split; first exact: equilibrium_point1. by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0// norm_gt0. by rewrite divr_ge0 ?exprn_ge0 ?norm_ge0// mulr_ge0// ltW. - move=> traj dtraj traj0. - rewrite /lnsd /LieDerivative_gradient_jacobian. - rewrite traj0 /point1. + rewrite /locnegsemidef. + rewrite /V1. + rewrite [x in (LieDerivative_jacobian1 x)] (_ : _ = (fun x0 : 'rV_6 => + (norm (Lsubmx x0) ^+ 2 / (2 * alpha1))%:M) \+ + (fun x0 => (norm (Rsubmx x0) ^+ 2 / (2 * gamma))%:M)); last first. + by apply/funext => ?/=; rewrite !raddfD. + rewrite LieDerivative_jacobian1D /=. split. - + rewrite derive1mxE' /gradient_jacobian /V1. - rewrite !derive1E. - rewrite /dotmul. - rewrite -trmx_mul /= mxE. - rewrite /is_solution /derive1mx /eqn33 in dtraj. - set f_expr := fun x : 'rV_6 => - (norm (@lsubmx K 1 3 3 x) ^+ 2 / (2 * alpha1) + - norm (@rsubmx K 1 3 3 x) ^+ 2 / (2 * gamma))%:M. - pose phi := fun t => f_expr (traj t). - rewrite /traj0. - have eq_point1 : 'D_1 traj 0 = 0. - rewrite /dtraj /traj0. - have deriv_at_0: \matrix_(i, j) (fun x : K => traj x i j)^`() 0 = - row_mx (- alpha1 *: (@lsubmx K 1 3 3 (traj 0))) - (gamma *: ((@rsubmx K 1 3 3 (traj 0)) - (@lsubmx K 1 3 3 (traj 0))) *m - \S('e_2 - (@rsubmx K 1 3 3 (traj 0))) ^+ 2). - exact: dtraj. - have deriv_at_point1 : 'D_1 traj 0 = - row_mx (- alpha1 *: @lsubmx K 1 3 3 (traj 0)) - (gamma *: (@rsubmx K 1 3 3 (traj 0) - @lsubmx K 1 3 3 (traj 0)) *m - \S('e_2 - @rsubmx K 1 3 3 (traj 0)) ^+ 2). - rewrite -deriv_at_0. - rewrite -derive1E /=. - apply/matrixP => i j; rewrite !mxE. - rewrite ord1. - by rewrite derive1E derivemx_derive// -derive1E. - have eq_zero: row_mx (- alpha1 *: @lsubmx K 1 3 3 point1) - (gamma *: (@rsubmx K 1 3 3 point1 - @lsubmx K 1 3 3 point1) *m - \S('e_2 - @rsubmx K 1 3 3 point1) ^+ 2) = 0. - have := equilibrium_point1 0. - rewrite /is_equilibrium_point /eqn33. - move => H. - rewrite /point1. apply/matrixP => i j. - rewrite !linear0 addr0. - rewrite addr0. rewrite scaler0 mul0mx. - by rewrite row_mx0. - have traj_deriv_zero: 'D_1 traj 0 = 0. - rewrite deriv_at_point1. - rewrite traj0. - by rewrite eq_zero. - by rewrite traj_deriv_zero. - rewrite eq_point1. - rewrite mul0mx /=. - by rewrite mxE. + rewrite !invfM /=. + set c1 := (2^-1 / alpha1). + set c2 := (2^-1 / gamma). + rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = + (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. + apply/funext => y. + by rewrite -scale_scalar_mx. + rewrite !fctE. + have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = + (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = + (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. + apply/funext => y. + by rewrite -scale_scalar_mx. + rewrite func_eq. + have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = + (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite func_eq2. + rewrite !LieDerivative_jacobian1Ml /=. + rewrite !fctE. + rewrite !LieDerivative_jacobian1_eq0_equilibrium. + by rewrite scaler0 scaler0 add0r. + rewrite /is_solution /eqn33 in dtraj. + rewrite -derive1E. + rewrite -derive1mxE'. + rewrite dtraj/= traj0 /point1. + by rewrite rsubmx0 lsubmx0 !subr0 !scaler0 mul0mx row_mx0. + rewrite /is_solution /eqn33 in dtraj. + rewrite -derive1E. + rewrite -derive1mxE'. + rewrite dtraj/= traj0 /point1. + by rewrite rsubmx0 lsubmx0 !subr0 !scaler0 mul0mx row_mx0. + near=> z. - rewrite derive1mxE'. - rewrite /gradient_jacobian /=. - rewrite /dotmul /=. - rewrite /is_solution /derive1mx /eqn33 in dtraj. - rewrite -trmx_mul /=. rewrite mxE /=. - rewrite /V1 /=. - rewrite -derivemxE /=; last first. - admit. - rewrite [x in ('D_ _ x _)] (_ : _ = (fun x0 : 'rV_6 => - (norm (@lsubmx K 1 3 3 x0) ^+ 2 / (2 * alpha1))%:M) \+ - (fun x0 => (norm (@rsubmx K 1 3 3 x0) ^+ 2 / (2 * gamma))%:M)); last first. - by apply/funext => v/=; rewrite !raddfD. - rewrite deriveD /=; last 2 first. - admit. - admit. - rewrite mxE. - rewrite [x in ('D_ _ x _) ](_ : _ = alpha1^-1 * 2^-1 \*: - (fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1)); last first. - apply/funext => x/=. - by rewrite mulrC invfM (mulrC _ alpha1^-1) scale_scalar_mx. - rewrite !deriveZ /=; last first. - admit. - under [in X in _ + X] eq_fun => x0. - rewrite [_ / (2 * gamma)]mulrC. - over. - rewrite /=. - rewrite [X in _ + X <= 0] (_ : _ = - (2 * gamma)^-1 *: 'D_((traj^`())%classic z) - (fun x0 : 'rV[K]_6 => (norm (@rsubmx K 1 3 3 x0) ^+ 2)%:M : 'rV[K]_1) (traj z) 0 0); last first. - admit. - pose f := fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0))%:M : 'rV[K]_1. - pose F := fun x0 : 'rV_6 => (f x0) ^+ 2. - set dF_l : 'rV[K]_1 := 'D_((traj^`())%classic z) - (fun x0 : 'rV_6 => (norm (@lsubmx K 1 3 3 x0) ^+ 2)%:M) (traj z). - rewrite !mxE. - set a := alpha1^-1 * 2^-1. - set b := (2 * gamma)^-1. - set dF_r : 'rV[K]_1 := 'D_((traj^`())%classic z) - (fun x0 : 'rV[K]_6 => (norm (@rsubmx K 1 3 3 x0) ^+ 2)%:M) (traj z). - have: dF_l``_0 = (2 *: (@lsubmx K 1 3 3 (traj z)) 0 0). - rewrite /dF_l. - set u := fun t => @lsubmx K 1 3 3 (traj t). - have Hderiv : - ((2^-1 \*o (GRing.exp (R:=K))^~ 2 \o norm (n:=3)) \o u)^`() = - (fun t => (derive1mx u t *m (u t)^T) 0 0). - apply: derive_norm => t. - rewrite norm_eq0. - admit. - have: dF_r``_0 = 2 * (@rsubmx K 1 3 3 (traj z)) 0 0. - set v := fun t => @rsubmx K 1 3 3 (traj t). - have -> : dF_r``_0 = ((fun t => (derive1mx v t *m (v t)^T) 0 0) z). - rewrite /dF_r. rewrite -!derive1mxE'. - set g := fun (x0 : 'rV_6) => ((norm (@rsubmx K 1 3 3 x0)) ^+ 2)%:M. - have : ('D_(derive1mx traj z) g (traj z)) 0 0 - = ((fun t => norm (v t)) ^+ 2)^`() z. - rewrite derivemx_derive//. - rewrite derive1E//=. - admit. - move => etc. - rewrite /g. - rewrite etc. - rewrite derive1E. - rewrite deriveX /=. - admit. - admit. - admit. - admit. -rewrite /v /derive1mx. -move => d. -rewrite /a /b /=. -rewrite -oppr_ge0 /=. -have ab_pos : 0 < a + b. - rewrite addr_gt0//. - by rewrite mulr_gt0 ?invr_gt0. - by rewrite invr_gt0 ?mulr_gt0. -have : (@lsubmx K 1 3 3 (traj z))``_0 = (dF_l``_0 / 2). - have Hrsubmx_eq : (@rsubmx K 1 3 3 (traj z))``_0 = (dF_r``_0) / 2. - admit. - admit. -admit. + rewrite !fctE. + rewrite !invfM /=. + set c1 := (2^-1 / alpha1). + set c2 := (2^-1 / gamma). + rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = + (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. + apply/funext => y. + by rewrite -scale_scalar_mx. + have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = + (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = + (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. + apply/funext => y. + by rewrite -scale_scalar_mx. + rewrite func_eq. + have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = + (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite func_eq2. + rewrite !LieDerivative_jacobian1Ml /=. + rewrite !fctE. +(* TODO : + encadrer le second terme comme dans le papier *) + rewrite !LieDerivative_jacobian1_norm. Admitted. End Lyapunov. From 65d78f15f546db4dc133d631cc8c27eb8ed47e57 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 27 Jun 2025 11:03:53 +0900 Subject: [PATCH 017/144] fix naming --- differential_kinematics.v | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/differential_kinematics.v b/differential_kinematics.v index 00d7785e..b2540a0b 100644 --- a/differential_kinematics.v +++ b/differential_kinematics.v @@ -756,13 +756,13 @@ rewrite /geo_jac; set a := (X in _ *m @row_mx _ _ 3 3 X _). rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). - rewrite /scara_lin_vel (_ : @trans_of_hom R \o _ = trans); last first. rewrite funeqE => x /=; exact: trans_of_hom_hom. - rewrite /trans /scara_trans derive1mxE [RHS]row3_proj /= ![in RHS]mxE [in RHS]/=. + rewrite /trans /scara_trans derive1mx_matrix [RHS]row3_proj /= ![in RHS]mxE [in RHS]/=. transitivity ( derive1 (theta1 : R^o -> R^o) t *: (Fim1 0 t)~k *v (\o{Fmax t} - \o{Fim1 0 t}) + derive1 (theta2 : R^o -> R^o) t *: (Fim1 1 t)~k *v (\o{Fmax t} - \o{Fim1 1 t}) + derive1 (d3 : R^o -> R^o) t *: (Fim1 2 t)~k + derive1 (theta4 : R^o -> R^o) t *: (Fim1 3%:R t)~k *v (\o{Fmax t} - \o{Fim1 3%:R t})). - rewrite /scara_joint_velocities /scara_joint_variables derive1mxE /geo_jac_lin /=. + rewrite /scara_joint_velocities /scara_joint_variables derive1mx_matrix /geo_jac_lin /=. apply/rowP => i; rewrite 3![in RHS]mxE [in LHS]mxE sum4E; (repeat apply: f_equal2). - rewrite 2!mxE /=. @@ -895,7 +895,7 @@ rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). transitivity (derive1 (theta1 : R^o -> R^o) t *: (Fim1 0 t)~k + derive1 (theta2 : R^o -> R^o) t *: (Fim1 1 t)~k + derive1 (theta4 : R^o -> R^o) t *: (Fim1 3%:R t)~k). - rewrite /scara_joint_velocities /scara_joint_variables derive1mxE /geo_jac_ang /=. + rewrite /scara_joint_velocities /scara_joint_variables derive1mx_matrix /geo_jac_ang /=. apply/rowP => i; rewrite !mxE sum4E !mxE {1}mulr0 addr0. by rewrite -!/(Fim1 _) [Fim1 0 _]lock [Fim1 1 _]lock [Fim1 3%:R _]lock /= -!lock. rewrite !Hzvec -2!scalerDl e2row row3Z mulr0 mulr1. From fa3fe25008813b8688d6beb451399e337070f6c6 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 4 Jul 2025 11:07:47 +0900 Subject: [PATCH 018/144] working towards the end of the proof v1 is a lyapunov fx --- tilt.v | 309 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 296 insertions(+), 13 deletions(-) diff --git a/tilt.v b/tilt.v index f9686fae..5e6beb20 100644 --- a/tilt.v +++ b/tilt.v @@ -11,10 +11,11 @@ Import numFieldNormedType.Exports. Local Open Scope ring_scope. (* PR: to MathComp *) -Lemma lsubmx0 {R : nmodType} m n1 n2 : @lsubmx R m n1 n2 0 = 0. + +Lemma lsubmx_const {R : nmodType} (r : R) m n1 n2 : lsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. Proof. by apply/matrixP => i j; rewrite !mxE. Qed. -Lemma rsubmx0 {R : nmodType} m n1 n2 : @rsubmx R m n1 n2 0 = 0. +Lemma rsubmx_const {R : nmodType} (r : R) m n1 n2 : rsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. Proof. by apply/matrixP => i j; rewrite !mxE. Qed. Lemma derive_sqrt {K : realType} : @@ -26,6 +27,118 @@ rewrite invrM. (* utiliser la reciproque de la fonction carree?*) Admitted. +Definition defposmx {R : realType} m (mat : 'M[R]_(m,m)) : Prop := + mat \is sym m R /\ forall a : R, eigenvalue mat a -> a > 0. + +Lemma defposmxP {R : realType} m (mat : 'M[R]_(m,m)) : + defposmx mat <-> (forall x : 'rV[R]_m, x != 0 -> (x *m mat *m x^T) 0 0 > 0). +Proof. +split. + move => []. + move => matsym. + move => eigen. + move => x xneq0. + Search "eigenvalue". + apply/eigen. + apply/eigenvalueP. + exists x => //. + rewrite /=. + apply/matrixP. + move => i j. +Admitted. + +Lemma CauchySchwarz_vec {R : realType} {n : nat} : forall (a b : 'rV[R]_n.+1), (a *d b)^+2 <= (a *d a) * (b *d b). +Proof. +move => a b. +suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. + rewrite -subr_ge0. + move => h. + rewrite mulrC in h. + apply h. +rewrite subr_ge0. +rewrite expr2. +rewrite mulrC. +rewrite !dotmulvv. +rewrite /=. +rewrite -expr2. +case: (boolP (b == 0)) => [/eqP b0|hb]. + rewrite b0. + rewrite dotmulv0 expr0n. + rewrite norm0. + rewrite expr0n // /=. + rewrite mul0r. + done. +pose t := (a *d b) / (norm b ^+ 2). +have h : 0 <= norm (a - t *: b) ^+ 2. + rewrite exprn_ge0 //. + by rewrite norm_ge0. +rewrite -(dotmulvv (a - t *: b)) in h. +rewrite dotmulBl dotmulBr dotmulvv in h. +rewrite dotmulvZ in h. +rewrite -dotmulvv in h. +rewrite /t in h. +have h1 : 0 <= a *d a - (a *d b) ^+ 2 / norm b ^+ 2. + move: h. + rewrite dotmulBr dotmulvZ. + rewrite (dotmulC ((a *d b / norm b ^+ 2) *: b) a). + rewrite dotmulvZ dotmulC. + rewrite dotmulvv /t. + rewrite expr2. + rewrite /=. + rewrite -!expr2. + rewrite dotmulZv. + rewrite dotmulvv. + rewrite divfK /=; last first. + by rewrite sqrf_eq0 norm_eq0. + rewrite subrr. + rewrite subr0. + rewrite !expr2. + by rewrite mulrAC. +have h2 : 0 <= norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. + have pos: 0 < norm b ^+ 2. + rewrite exprn_gt0 //. + by rewrite norm_gt0. + suff: norm b ^+ 2 * (a *d a - (a *d b) ^+ 2 / norm b ^+ 2) = + norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. + move=> eq_step. + rewrite -eq_step. + by apply: mulr_ge0; [rewrite ltW | exact h1]. + rewrite mulrBr. + congr (_ - _)%R. + by rewrite mulrCA divff ?mulr1// sqrf_eq0 norm_eq0. +rewrite -subr_ge0 mulrC. +rewrite dotmulvv in h2. +by rewrite mulrC in h2. +Qed. + +Lemma young_inequality_vec {R : realType} {n : nat} : forall (a b : 'rV[R]_n.+1), + (a *d b) <= (2^-1 * (norm(a))^+2) + (2^-1 * (norm(b))^+2). +Proof. +move => a b. +have normage0 : 0 <= (norm(a))^+2. + rewrite expr2. + by rewrite mulr_ge0 // norm_ge0. +have normbge0 : 0 <= (norm(b))^+2. + rewrite expr2. + by rewrite mulr_ge0 // norm_ge0. +rewrite -!dotmulvv. +have: 0 <= norm(a - b)^+2. + rewrite expr2. + by rewrite mulr_ge0 // norm_ge0. +rewrite -dotmulvv. +rewrite dotmulD. +rewrite !dotmulvv. +move => h. +rewrite -mulr_natl in h. +have h2 : 2 * (a *d b) <= norm a ^+ 2 + norm (- b) ^+ 2. + rewrite -subr_ge0. + rewrite dotmulvN mulrN in h. + by rewrite addrAC. +rewrite -ler_pdivlMl// in h2. +rewrite -mulrDr. +by rewrite normN in h2. +Qed. + Local Open Scope classical_set_scope. Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n (f : V -> 'M[R]_(m.+1, n.+1)) (x0 : V) (v : V) (i : 'I_m.+1) (j : 'I_n.+1) : @@ -603,9 +716,10 @@ rewrite mulVf ?gt_eqF//. rewrite scale1r. have -> : ((Lsubmx (x t)) *m (Lsubmx (x t))^T) 0 0 = norm (Lsubmx (x t)) ^+2. rewrite sqr_sqrtr. - rewrite /dotmul. - admit. - admit. + rewrite dotmulP. + by rewrite mxE eqxx mulr1n. + rewrite dotmulvv. + by rewrite sqr_ge0. rewrite /V1dot. congr +%R. set Lmx := lsubmx _. @@ -634,7 +748,7 @@ Lemma V1_is_lyapunov : is_lyapunov_function (fun a b => @eqn33 K alpha1 gamma b Proof. split; first exact: equilibrium_point1. - rewrite /locposdef; split. - + by rewrite /V1 /point1 lsubmx0 rsubmx0 norm0 expr0n/= !mul0r add0r mxE /=. + + by rewrite /V1 /point1 lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r mxE /=. + near=> z_near. simpl in *. have z_neq0 : z_near != 0 by near: z_near; exact: nbhs_dnbhs_neq. @@ -696,12 +810,12 @@ split; first exact: equilibrium_point1. rewrite -derive1E. rewrite -derive1mxE'. rewrite dtraj/= traj0 /point1. - by rewrite rsubmx0 lsubmx0 !subr0 !scaler0 mul0mx row_mx0. + by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. rewrite /is_solution /eqn33 in dtraj. rewrite -derive1E. rewrite -derive1mxE'. rewrite dtraj/= traj0 /point1. - by rewrite rsubmx0 lsubmx0 !subr0 !scaler0 mul0mx row_mx0. + by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. + near=> z. rewrite !fctE. rewrite !invfM /=. @@ -729,9 +843,178 @@ split; first exact: equilibrium_point1. rewrite func_eq2. rewrite !LieDerivative_jacobian1Ml /=. rewrite !fctE. -(* TODO : - encadrer le second terme comme dans le papier *) - rewrite !LieDerivative_jacobian1_norm. -Admitted. - + rewrite !LieDerivative_jacobian1_norm. + pose zp1 := fun r => Lsubmx (traj r). + pose z2 := fun r => Rsubmx (traj r). + rewrite -[Lsubmx \o traj]/zp1. + rewrite -[Rsubmx \o traj]/z2. + have: c1 *: (2 *: derive1mx zp1 z *m (Lsubmx (traj z))^T) 0 0 + + c2 *: (2 *: derive1mx z2 z *m (Rsubmx (traj z))^T) 0 0 + = V1dot (traj z). + rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. + rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC mulVf ?pnatr_eq0// div1r. + have H1 : derive1mx zp1 z = (- alpha1 *: Lsubmx (traj z)). + admit. (* from eqn33? *) + have H2 : derive1mx z2 z = (gamma *: (Rsubmx (traj z) - Lsubmx (traj z)) *m \S('e_2 - Rsubmx (traj z)) ^+ 2). + admit. + rewrite H1 -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)) mulrN mulVf ?gt_eqF// mulN1r. + rewrite H2 -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE scalerA mulVf ?gt_eqF// scale1r. + have -> : ((Lsubmx (traj z)) *m (Lsubmx (traj z))^T) 0 0 = norm (Lsubmx (traj z)) ^+2. + rewrite sqr_sqrtr /dotmul. + admit. + admit. + rewrite /V1dot. + congr +%R. + set Lmx := lsubmx _. + set Rmx := rsubmx _. + rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. + rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK -[X in _ = (_ *m (X *m _)) 0 0]trmxK. + rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE -(mulmxA (Rmx - Lmx)) mulmxE -expr2. + have -> : (\S('e_2 - Rmx) ^+ 2)^T = \S('e_2 - Rmx) ^+ 2. + apply/esym/eqP. + rewrite -symE. + exact: sqr_spin_is_sym. + by rewrite mulmxA. +move=> ->. +(* this form matches the one in the paper, we can safely proceed + TODO survey of available properties: Young, Cauchy Schwartz? Forme quadratique? + Calcul des valeurs propres d'une matrice? + Matrice definie positive? + Conclure sur le signe d'une equation comme ca?*) +rewrite /V1dot. +rewrite -/(zp1 z). +rewrite -/(z2 z). +set w := (z2 z) *m \S('e_2). +pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. +pose u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) + [eta (fun=> 0) with (0,0) |-> 1, + (0,1) |-> -2^-1, + (1,0) |-> -2^-1, + (1,1) |-> 1] (i,j). +apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). + rewrite mxE. + have eq0T : z2 z *m \S(z2 z)^T = 0. + apply: trmx_inj. + rewrite trmx_mul. + rewrite trmxK. + rewrite spin_mul_tr. + by rewrite trmx0. + have H2 : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2). + rewrite spinD. + rewrite spinN. + rewrite -tr_spin. + rewrite !mulmxDr. + rewrite !eq0T. + by rewrite !addr0. + have H1 : (z2 z *m \S('e_2 - z2 z)^+2 *m (z2 z)^T) 0 0 = - (norm w)^+2. + rewrite /w. + rewrite spinD. + rewrite spinN. + rewrite -tr_spin. + rewrite mulmxA. + rewrite !mulmxDr. + rewrite mulmxDl. + rewrite !eq0T. + rewrite !addr0. + rewrite -dotmulvv. + rewrite /dotmul. + rewrite trmx_mul. + rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. + rewrite tr_spin. + rewrite -mulmxA. + rewrite mulNmx. + rewrite spin_mul_tr. + by rewrite mulmxN mulmx0 oppr0 mxE. + rewrite tr_spin. + rewrite mulNmx. + rewrite mulmxN [in RHS]mxE opprK. + by rewrite mulmxA. + rewrite H1. + rewrite mxE. + rewrite addrA. + rewrite expr2. + rewrite mulmxA. + rewrite H2. + rewrite -/w. + rewrite -dotmulNv. + rewrite addrC. + rewrite -mulmxN. + rewrite -expr2. + set a := (w *m - \S('e_2 - z2 z)). + have neg_spin: norm (w *m - \S('e_2 - z2 z)) = norm (w). + rewrite orth_preserves_norm //. + admit. + rewrite /a. + have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= norm(w *m - (\S('e_2 - z2 z))) * + norm(zp1 z). + rewrite mxE /= mulr1n. + rewrite (le_trans (ler_norm _)) //. + rewrite -ler_sqr // ; last first. + by rewrite nnegrE // mulr_ge0 ?norm_ge0 //. + rewrite exprMn. + rewrite sqr_normr. + rewrite (le_trans (CauchySchwarz_vec _ _)) //. + by rewrite !dotmulvv. + apply: (@le_trans _ _ (norm (w *m - \S('e_2 - z2 z)) * norm (zp1 z) + (- norm (zp1 z) ^+ 2 - norm w ^+ 2))). + rewrite lerD2r. + rewrite (le_trans _ (cauchy)) //. + by rewrite mxE eqxx mulr1n. + rewrite neg_spin. + rewrite /a . + rewrite /u1 /u2. + rewrite ![in leRHS]mxE. + rewrite !sum2E/=. + rewrite ![in leRHS]mxE. + rewrite !sum2E/=. + rewrite ![in leRHS]mxE. + rewrite /=. + rewrite !mulr1. + rewrite mulrN. + rewrite mulNr. + rewrite opprK. + rewrite mulrDl. + rewrite mulNr. + rewrite -expr2. + rewrite [in leLHS] addrCA. + rewrite -!addrA. + rewrite lerD2l. + rewrite mulrDl. + rewrite (mulNr (norm w)). + rewrite -expr2. + rewrite !addrA. + rewrite lerD2r. + rewrite !(mulrN , mulNr). + rewrite opprK. + rewrite -mulrA. + rewrite [in leRHS](mulrC _ (norm w)). + rewrite -mulrDr. + rewrite [in leRHS](mulrC (2 ^-1)). + rewrite -mulrDr. + Search (2^-1). + rewrite -div1r. + rewrite -splitr mulr1. + by []. +have def: defposmx u2. +admit. +rewrite defposmxP in def. +have u2neq0 : u2 != 0. +admit. +case H: (u1 == 0). + move/eqP: H => ->. + rewrite mulNmx. + rewrite mul0mx. + by rewrite mulNmx mul0mx mxE mxE oppr0. + move: H => /negP H. + have u1_neq0 : u1 != 0 by apply/negP. + move: (def u1 u1_neq0) => Hpos. + rewrite -oppr_ge0. + rewrite -oppr_le0. + rewrite opprK. + apply ltW. + rewrite -oppr_gt0. + rewrite mulNmx. + rewrite !mulNmx. + rewrite mxE. + rewrite opprK. + by rewrite Hpos. End Lyapunov. From f99ba71be0332d0d490a75bee3d2b56aa53bf33a Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Mon, 7 Jul 2025 18:46:41 +0900 Subject: [PATCH 019/144] derive_sqrt and norm update --- tilt.v | 615 ++++++++++++++++++++++++--------------------------------- 1 file changed, 263 insertions(+), 352 deletions(-) diff --git a/tilt.v b/tilt.v index 5e6beb20..bfba328b 100644 --- a/tilt.v +++ b/tilt.v @@ -18,15 +18,62 @@ Proof. by apply/matrixP => i j; rewrite !mxE. Qed. Lemma rsubmx_const {R : nmodType} (r : R) m n1 n2 : rsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. Proof. by apply/matrixP => i j; rewrite !mxE. Qed. -Lemma derive_sqrt {K : realType} : - (Num.sqrt^`())%classic = (fun t => (2 * Num.sqrt t)^-1) :> (_ -> K). -Proof. -apply/funext => i. -rewrite derive1E /=. -rewrite invrM. -(* utiliser la reciproque de la fonction carree?*) +From mathcomp Require Import sequences exp realfun. + +Lemma derive1_powR {K : realType} (r : K) : (fun a => a `^ r)^`()%classic = (fun x => r * x `^ (r - 1)). Admitted. +Global Instance is_derive1_sqrt {K : realType} (x : K) : 0 < x -> is_derive x 1 Num.sqrt (2 * Num.sqrt x)^-1. +Proof. +move=> x_gt0. +have sqrtK : {in Num.pos, cancel (@Num.sqrt K) (fun x => x ^+ 2)}. + by move=> a a0; rewrite sqr_sqrtr// ltW. +rewrite -[x]sqrtK//. +apply: (@is_derive_inverse K (fun x => x ^+ 2)). +- near=> z. + rewrite sqrtr_sqr gtr0_norm//. + have [xz|zx|->] := ltgtP z (Num.sqrt x); last first. + + by rewrite sqrtr_gt0. + + by rewrite (lt_trans _ zx)// sqrtr_gt0. + + move: xz. + near: z. + exists (Num.sqrt x / 2). + rewrite /=. + rewrite mulr_gt0 //. + by rewrite sqrtr_gt0 x_gt0. + rewrite invr_gt0. + by []. + move=> r/=. + move=> /[swap] rx. + rewrite gtr0_norm ?subr_gt0//. + rewrite ltrBlDl. + rewrite -ltrBlDr. + apply: le_lt_trans. + rewrite subr_ge0. + rewrite ger_pMr. + rewrite invf_le1. + by rewrite ler1n. + by []. + by rewrite sqrtr_gt0. +- near=> z. + exact: exprn_continuous. +- rewrite !sqrtK//; split. + exact: exprn_derivable (* TODO: renaming *). + by rewrite exp_derive (* TODO: renaming -> issue *) expr1 scaler1. +- by rewrite mulf_neq0 ?pnatr_eq0// gt_eqF// sqrtr_gt0 exprn_gt0// sqrtr_gt0. +Unshelve. all: by end_near. +Qed. + +Lemma derive_sqrt {K : realType} (r : K) : 0 < r -> + (Num.sqrt^`())%classic r = (2 * Num.sqrt r)^-1 :> K. +Proof. +move=> r0. +rewrite derive1E. +Search is_derive. +apply: derive_val. +exact: is_derive1_sqrt. +Qed. + Definition defposmx {R : realType} m (mat : 'M[R]_(m,m)) : Prop := mat \is sym m R /\ forall a : R, eigenvalue mat a -> a > 0. @@ -38,13 +85,13 @@ split. move => matsym. move => eigen. move => x xneq0. - Search "eigenvalue". apply/eigen. apply/eigenvalueP. exists x => //. rewrite /=. apply/matrixP. move => i j. +(* theoreme spectral?*) Admitted. Lemma CauchySchwarz_vec {R : realType} {n : nat} : forall (a b : 'rV[R]_n.+1), (a *d b)^+2 <= (a *d a) * (b *d b). @@ -55,19 +102,13 @@ suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. move => h. rewrite mulrC in h. apply h. -rewrite subr_ge0. -rewrite expr2. -rewrite mulrC. -rewrite !dotmulvv. -rewrite /=. -rewrite -expr2. +rewrite subr_ge0 expr2 mulrC !dotmulvv /= -expr2. case: (boolP (b == 0)) => [/eqP b0|hb]. rewrite b0. rewrite dotmulv0 expr0n. rewrite norm0. rewrite expr0n // /=. - rewrite mul0r. - done. + by rewrite mul0r. pose t := (a *d b) / (norm b ^+ 2). have h : 0 <= norm (a - t *: b) ^+ 2. rewrite exprn_ge0 //. @@ -81,23 +122,13 @@ have h1 : 0 <= a *d a - (a *d b) ^+ 2 / norm b ^+ 2. move: h. rewrite dotmulBr dotmulvZ. rewrite (dotmulC ((a *d b / norm b ^+ 2) *: b) a). - rewrite dotmulvZ dotmulC. - rewrite dotmulvv /t. - rewrite expr2. - rewrite /=. - rewrite -!expr2. - rewrite dotmulZv. - rewrite dotmulvv. + rewrite dotmulvZ dotmulC dotmulvv /t expr2 -!expr2 dotmulZv dotmulvv. rewrite divfK /=; last first. by rewrite sqrf_eq0 norm_eq0. - rewrite subrr. - rewrite subr0. - rewrite !expr2. - by rewrite mulrAC. + by rewrite subrr subr0 !expr2 mulrAC. have h2 : 0 <= norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. have pos: 0 < norm b ^+ 2. - rewrite exprn_gt0 //. - by rewrite norm_gt0. + by rewrite exprn_gt0 // norm_gt0. suff: norm b ^+ 2 * (a *d a - (a *d b) ^+ 2 / norm b ^+ 2) = norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. move=> eq_step. @@ -107,8 +138,7 @@ have h2 : 0 <= norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. congr (_ - _)%R. by rewrite mulrCA divff ?mulr1// sqrf_eq0 norm_eq0. rewrite -subr_ge0 mulrC. -rewrite dotmulvv in h2. -by rewrite mulrC in h2. +by rewrite dotmulvv mulrC in h2. Qed. Lemma young_inequality_vec {R : realType} {n : nat} : forall (a b : 'rV[R]_n.+1), @@ -125,9 +155,7 @@ rewrite -!dotmulvv. have: 0 <= norm(a - b)^+2. rewrite expr2. by rewrite mulr_ge0 // norm_ge0. -rewrite -dotmulvv. -rewrite dotmulD. -rewrite !dotmulvv. +rewrite -dotmulvv dotmulD !dotmulvv. move => h. rewrite -mulr_natl in h. have h2 : 2 * (a *d b) <= norm a ^+ 2 + norm (- b) ^+ 2. @@ -139,26 +167,6 @@ rewrite -mulrDr. by rewrite normN in h2. Qed. -Local Open Scope classical_set_scope. -Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n - (f : V -> 'M[R]_(m.+1, n.+1)) (x0 : V) (v : V) (i : 'I_m.+1) (j : 'I_n.+1) : - 'D_v f x0 i j = 'D_v (fun x => f x i j) x0. -Proof. -apply/esym/cvg_lim => //=. -apply/cvgrPdist_le => /= e e0. -near=> t. -Admitted. -Local Close Scope classical_set_scope. - -Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : - derive1mx M t = M^`()%classic t. -Proof. -apply/rowP => i. -rewrite /derive1mx !mxE. -rewrite !derive1E. -by rewrite derivemx_derive. -Qed. - Local Open Scope classical_set_scope. Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := @@ -182,34 +190,34 @@ Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := \row_(i < n.+1) partial f a i. +Section derive_help. +Local Open Scope classical_set_scope. +Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n + (f : V -> 'M[R]_(m.+1, n.+1)) (x0 : V) (v : V) (i : 'I_m.+1) (j : 'I_n.+1) : + 'D_v f x0 i j = 'D_v (fun x => f x i j) x0. +Proof. +apply/esym/cvg_lim => //=. +apply/cvgrPdist_le => /= e e0. +near=> t. +Admitted. +Local Close Scope classical_set_scope. + +Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : + derive1mx M t = M^`()%classic t. +Proof. +apply/rowP => i. +by rewrite /derive1mx !mxE !derive1E derivemx_derive. +Qed. + Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) (i : 'I_n.+1) : partial (fun x => (f x) 0 0) a i = ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x) : 'rV[R]_1) a) 0 0. Proof. -rewrite derivemx_derive/=. -rewrite /partial. -rewrite /derive /=. +rewrite derivemx_derive/= /partial /derive /=. by under eq_fun do rewrite (addrC a). Qed. -Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) - (a : R -> 'rV[R]_n.+1) (t : R) : R := - \sum_(i < n.+1) (partial V (a t) i * (derive1mx a t) ``_ i). - -Definition jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) := - jacobian f. - -Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1): - gradient_partial (fun x : 'rV[R]_n.+1 => (f x) 0 0) a = (jacobian1 f a)^T. -Proof. -rewrite /jacobian1. -apply/rowP => i. -rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. - admit. -by rewrite partial_diff. -Admitted. - Lemma gradient_partial_sum {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : gradient_partial f a = \sum_(i < n.+1) partial f a i *: 'e_i. Proof. @@ -217,8 +225,6 @@ rewrite /gradient_partial [LHS]row_sum_delta. by under eq_bigr do rewrite mxE. Qed. -Section derive_help. - Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := \row_(j < n.+1) (i == j)%:R. @@ -229,50 +235,68 @@ apply/rowP => j. by rewrite !mxE eqxx /= eq_sym. Qed. - Local Open Scope classical_set_scope. Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) : - (forall t, norm (u t) != 0) -> + forall t:K, 0 <= t -> (forall t, norm (u t) != 0) -> (2^-1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = (fun t => (derive1mx u t *m (u t)^T)``_0) :> (K -> K). Proof. -move=> u0; apply/funext => t. -rewrite [LHS]derive1E. -rewrite deriveMl/=; last first. +move=> u0 t0 norm0. apply/funext => t. +rewrite [LHS]derive1E deriveMl/=; last first. admit. rewrite -derive1E. rewrite (@derive1_comp _ (@norm _ _ \o u ) (@GRing.exp K ^~ 2)) ; last 2 first. admit. admit. -rewrite exp_derive1. -rewrite derive1_comp /=; last 2 first. +rewrite exp_derive1 derive1_comp /=; last 2 first. admit. admit. -rewrite !derive_sqrt. -rewrite !expr1. -rewrite !(mulrA 2^-1). -rewrite mulVf ?pnatr_eq0// mul1r. -rewrite !dotmulvv. -rewrite sqrtr_sqr. -rewrite normr_norm. -rewrite !mulrA /=. +rewrite !(derive_sqrt); last first. + rewrite dotmulvv. + rewrite lt0r. + apply/andP; split. + by apply/expf_neq0. + by rewrite exprn_ge0 ?norm_ge0. + rewrite !expr1. + rewrite derive1mxE'. +rewrite !(mulrA 2^-1) mulVf ?pnatr_eq0// mul1r. +rewrite !dotmulvv sqrtr_sqr normr_norm !mulrA /=. have -> : norm (u t) / (2 * norm (u t)) = 2^-1. by rewrite invfM// mulrCA divff ?mulr1. set X := (X in X^`()%classic). have dot : X t = norm(u t)^+2 by rewrite /X dotmulvv. -rewrite /X. -rewrite !derive1mx_dotmul; last 2 first. +rewrite /X !derive1mx_dotmul; last 2 first. admit. admit. rewrite dotmulP /=. set y := derive1mx u t *d u t. have -> : y + u t *d derive1mx u t = 2 * y. by rewrite mulr_natl mulr2n dotmulC. -by rewrite mulrA mulVf ?pnatr_eq0// mul1r mxE eqxx mulr1n. +rewrite mulrA mulVf ?pnatr_eq0// mul1r mxE eqxx mulr1n. +by rewrite -derive1mxE'. Admitted. End derive_help. +Section LieDerivative. + +Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) + (a : R -> 'rV[R]_n.+1) (t : R) : R := + \sum_(i < n.+1) (partial V (a t) i * (derive1mx a t) ``_ i). + +Definition jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) := + jacobian f. + +Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1): + gradient_partial (fun x : 'rV[R]_n.+1 => (f x) 0 0) a = (jacobian1 f a)^T. +Proof. +rewrite /jacobian1. +apply/rowP => i. +rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. + admit. +by rewrite partial_diff. +Admitted. + Definition LieDerivative_jacobian1 {R : realType} n (V : 'rV[R]_n.+1 -> 'rV[R]_1) (x : R -> 'rV[R]_n.+1) (t : R) : R := let xdot_t := derive1mx x t in @@ -309,13 +333,9 @@ rewrite -trmx_mul. rewrite ( _ : lin1_mx ('d f (x t) \+ 'd g (x t)) = lin1_mx ('d f (x t)) + lin1_mx ('d g (x t))); last first. apply/matrixP => i j. - rewrite mxE. - rewrite [RHS]mxE //. - rewrite [in LHS] /=. - rewrite [LHS]mxE. + rewrite mxE [RHS]mxE // [in LHS] /= [LHS]mxE. by congr (_+_); rewrite mxE. -rewrite [in LHS] mulmxDr /=. -rewrite mxE mxE. +rewrite [in LHS] mulmxDr /= mxE mxE. by congr (_+_); rewrite -trmx_mul [RHS]mxE. Admitted. @@ -331,55 +351,47 @@ Qed. Lemma LieDerivative_jacobian1_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) (x : K -> 'rV[K]_6) (t : K) : + 0 <= t -> (forall t0, norm (f t0) != 0) -> LieDerivative_jacobian1 (fun y => ((norm (f y)) ^+ 2)%:M) x t = (2%:R *: derive1mx (f \o x) t *m (f (x t))^T) 0 0. Proof. -rewrite /LieDerivative_jacobian1 /jacobian1 /dotmul. -rewrite /jacobian dotmulP /dotmul -trmx_mul. -rewrite !derive1mxE' /= mxE mxE /= !fctE. -rewrite !derive1E. -rewrite mulr1n. -rewrite -scalemxAl. -rewrite [RHS]mxE. -apply: (@mulfI _ 2^-1); first by rewrite invr_eq0// pnatr_eq0. -rewrite mulrA mulVf ?pnatr_eq0// mul1r. -set h := (fun x0 : 'rV_6 => (norm (f x0) ^+ 2)%:M). -set tmp : {linear 'rV_6 -> 'rV_1} := 'd h (x t). -rewrite -[in RHS]derive1E. -have : forall t0 : K^o, norm (f (x t0)) != 0. +move => t0 f0. +rewrite /LieDerivative_jacobian1. +rewrite /jacobian1. +rewrite /dotmul. +rewrite -trmx_mul. +rewrite -derivemxE; last first. admit. -move=> /derive_norm. -move=> /(congr1 (fun z => z t)). -rewrite /=. -rewrite derive1mxE'. -move=> <-. +have fx0 : forall t0 : K^o, norm (f (x t0)) != 0 by move => s; apply: f0. +have := @derive_norm K _ (f \o x) _ t0 fx0. +move=> /( congr1 (fun z => z t)). +rewrite -scalemxAl [X in _ -> _ = X]mxE. +move => <-. +rewrite derive1Ml; last first. + admit. +rewrite mulrA divff // ?pnatr_eq0 // mul1r. +rewrite mxE. +rewrite fctE. rewrite derive1E. -rewrite deriveMl//=; last admit. -congr *%R. -rewrite /tmp /h. -rewrite [in RHS]deriveE; last first. +transitivity ( ('D_(derive1mx x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). admit. -have /= := (@diff_comp _ _ _ _ x (fun z => (norm (f z) ^+ 2%R))). -move=> ->; last 2 first. +rewrite deriveE ; last first. admit. +rewrite derive1mxE'. +rewrite derive1E. +rewrite deriveE ; last first. admit. -rewrite /=. -rewrite -[in RHS]deriveE; last first. +transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). +by []. +rewrite -diff_comp; last 2 first. admit. -rewrite -/h. -have -> : ('D_1 x t *m lin1_mx 'd h (x t)) = - 'D_('d x t 1) (fun z : 'rV_6 => (norm (f z) ^+ 2%R)%:M) (x t). - have := (@derivemxE K 5 0 h (x t) ('d x t 1)). - move=> ->; last admit. - congr (_ *m _). - rewrite deriveE//. admit. -rewrite derivemx_derive/=. -congr ('D_('d x t 1) _ (x t)). -apply/funext => v. -by rewrite mxE eqxx mulr1n. +rewrite deriveE //. +admit. Admitted. +End LieDerivative. + Section ode. Context {K : realType}. Let T := 'rV[K]_6. @@ -466,7 +478,6 @@ Lemma fact216 (v w : 'rV[K]_3): \S(w *m \S(v)) = v^T *m w - w^T *m v. Proof. by rewrite fact215 !fact212 -!/(_ *d _) dotmulC opprB addrA subrK. Qed. -Search (\S(_)). Lemma fact217 (v : 'rV[K]_3): \S(v) ^+ 3 = - (norm v ^+2) *: \S(v). exact: spin3. Qed. @@ -588,17 +599,6 @@ Open Scope classical_set_scope. Section Lyapunov. Local Open Scope classical_set_scope. -(*Lemma LieDerivative_gradientE {R : realType} n (V : 'rV[R]_n.+1 -> R) - (x : R -> 'rV[R]_n.+1) : - LieDerivative_gradient_partial V x = LieDerivative V x. -Proof. -apply/funext => t; rewrite /LieDerivative_gradient /LieDerivative. -rewrite gradientE dotmulsuml; apply: eq_bigr => /= i _. -rewrite dotmulE (bigD1 i)//= big1 ?addr0; last first. - by move=> j ji; rewrite !mxE/= (negbTE ji) mulr0 mul0r. -by rewrite !mxE/= eqxx mulr1. -Qed.*) - Context {K : realType}. Variable x1_hat : K -> 'rV[K]_3. Variable x2_hat : K -> 'rV[K]_3. @@ -649,8 +649,6 @@ move=> eqn33x. pose zp1 := fun r => Lsubmx (x r). pose z2 := fun r => Rsubmx (x r). rewrite /V1. -(*rewrite LieDerivative_gradient_jacobianD. -rewrite [X in LieDerivative_gradient_jacobian X] LieDerivative_gradient_jacobianMl.*) rewrite /V1. rewrite [X in LieDerivative_jacobian1 X _ _](_ : _ = (fun zp1_z2 : 'rV_6 => @@ -700,20 +698,10 @@ have H1 : derive1mx zp1 t = (- alpha1 *: Lsubmx (x t)). admit. (* from eqn33? *) have H2 : derive1mx z2 t = (gamma *: (Rsubmx (x t) - Lsubmx (x t)) *m \S('e_2 - Rsubmx (x t)) ^+ 2). admit. -rewrite H1. -rewrite -scalemxAl. -rewrite mxE. +rewrite H1 -scalemxAl mxE. rewrite [X in X + _](mulrA (alpha1^-1) (- alpha1)). -rewrite mulrN. -rewrite mulVf ?gt_eqF// mulN1r. -rewrite H2. -rewrite -scalemxAl. -rewrite mulmxA. -rewrite -scalemxAl. -rewrite [in X in _ + X]mxE. -rewrite scalerA. -rewrite mulVf ?gt_eqF//. -rewrite scale1r. +rewrite mulrN mulVf ?gt_eqF// mulN1r H2 -scalemxAl mulmxA -scalemxAl. +rewrite [in X in _ + X]mxE scalerA mulVf ?gt_eqF// scale1r. have -> : ((Lsubmx (x t)) *m (Lsubmx (x t))^T) 0 0 = norm (Lsubmx (x t)) ^+2. rewrite sqr_sqrtr. rewrite dotmulP. @@ -724,19 +712,12 @@ rewrite /V1dot. congr +%R. set Lmx := lsubmx _. set Rmx := rsubmx _. -rewrite -2![in RHS]mulmxA. -rewrite -mulmxBr. -rewrite -mulmxBr. -rewrite -linearB/=. +rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK. rewrite -[X in _ = (_ *m (X *m _)) 0 0]trmxK. -rewrite mulmxA. -rewrite -trmx_mul. -rewrite -trmx_mul. -rewrite [RHS]mxE. +rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE. rewrite -(mulmxA (Rmx - Lmx)). -rewrite mulmxE. -rewrite -expr2. +rewrite mulmxE -expr2. have -> : (\S('e_2 - Rmx) ^+ 2)^T = \S('e_2 - Rmx) ^+ 2. apply/esym/eqP. rewrite -symE. @@ -802,18 +783,14 @@ split; first exact: equilibrium_point1. apply/funext => zp1_z2. by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. rewrite func_eq2. - rewrite !LieDerivative_jacobian1Ml /=. - rewrite !fctE. - rewrite !LieDerivative_jacobian1_eq0_equilibrium. + rewrite !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_eq0_equilibrium. by rewrite scaler0 scaler0 add0r. rewrite /is_solution /eqn33 in dtraj. - rewrite -derive1E. - rewrite -derive1mxE'. + rewrite -derive1E -derive1mxE'. rewrite dtraj/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. rewrite /is_solution /eqn33 in dtraj. - rewrite -derive1E. - rewrite -derive1mxE'. + rewrite -derive1E -derive1mxE'. rewrite dtraj/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. + near=> z. @@ -827,23 +804,20 @@ split; first exact: equilibrium_point1. by rewrite -scale_scalar_mx. have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. - apply/funext => y. - by rewrite -scale_scalar_mx. - rewrite func_eq. + apply/funext => y. + by rewrite -scale_scalar_mx. + rewrite func_eq. have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite func_eq2. - rewrite !LieDerivative_jacobian1Ml /=. - rewrite !fctE. - rewrite !LieDerivative_jacobian1_norm. + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite func_eq2 !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_norm. pose zp1 := fun r => Lsubmx (traj r). pose z2 := fun r => Rsubmx (traj r). rewrite -[Lsubmx \o traj]/zp1. @@ -851,170 +825,107 @@ split; first exact: equilibrium_point1. have: c1 *: (2 *: derive1mx zp1 z *m (Lsubmx (traj z))^T) 0 0 + c2 *: (2 *: derive1mx z2 z *m (Rsubmx (traj z))^T) 0 0 = V1dot (traj z). - rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. - rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC mulVf ?pnatr_eq0// div1r. - have H1 : derive1mx zp1 z = (- alpha1 *: Lsubmx (traj z)). - admit. (* from eqn33? *) - have H2 : derive1mx z2 z = (gamma *: (Rsubmx (traj z) - Lsubmx (traj z)) *m \S('e_2 - Rsubmx (traj z)) ^+ 2). - admit. - rewrite H1 -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)) mulrN mulVf ?gt_eqF// mulN1r. - rewrite H2 -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE scalerA mulVf ?gt_eqF// scale1r. - have -> : ((Lsubmx (traj z)) *m (Lsubmx (traj z))^T) 0 0 = norm (Lsubmx (traj z)) ^+2. - rewrite sqr_sqrtr /dotmul. - admit. - admit. - rewrite /V1dot. - congr +%R. - set Lmx := lsubmx _. - set Rmx := rsubmx _. - rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. - rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK -[X in _ = (_ *m (X *m _)) 0 0]trmxK. - rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE -(mulmxA (Rmx - Lmx)) mulmxE -expr2. - have -> : (\S('e_2 - Rmx) ^+ 2)^T = \S('e_2 - Rmx) ^+ 2. - apply/esym/eqP. - rewrite -symE. - exact: sqr_spin_is_sym. - by rewrite mulmxA. -move=> ->. -(* this form matches the one in the paper, we can safely proceed - TODO survey of available properties: Young, Cauchy Schwartz? Forme quadratique? - Calcul des valeurs propres d'une matrice? - Matrice definie positive? - Conclure sur le signe d'une equation comme ca?*) -rewrite /V1dot. -rewrite -/(zp1 z). -rewrite -/(z2 z). -set w := (z2 z) *m \S('e_2). -pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. -pose u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) + rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. + rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC mulVf ?pnatr_eq0// div1r. + have H1 : derive1mx zp1 z = (- alpha1 *: Lsubmx (traj z)). + admit. (* from eqn33? *) + have H2 : derive1mx z2 z = (gamma *: (Rsubmx (traj z) - Lsubmx (traj z)) *m \S('e_2 - Rsubmx (traj z)) ^+ 2). + admit. + rewrite H1 -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)) mulrN mulVf ?gt_eqF// mulN1r. + rewrite H2 -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE scalerA mulVf ?gt_eqF// scale1r. + have -> : ((Lsubmx (traj z)) *m (Lsubmx (traj z))^T) 0 0 = norm (Lsubmx (traj z)) ^+2. + rewrite sqr_sqrtr /dotmul. + admit. + admit. + rewrite /V1dot. + congr +%R. + set Lmx := lsubmx _. + set Rmx := rsubmx _. + rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. + rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK -[X in _ = (_ *m (X *m _)) 0 0]trmxK. + rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE -(mulmxA (Rmx - Lmx)) mulmxE -expr2. + have -> : (\S('e_2 - Rmx) ^+ 2)^T = \S('e_2 - Rmx) ^+ 2. + apply/esym/eqP. + rewrite -symE. + exact: sqr_spin_is_sym. + by rewrite mulmxA. + move=> ->. + rewrite /V1dot -/(zp1 z) -/(z2 z). + set w := (z2 z) *m \S('e_2). + pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. + pose u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) [eta (fun=> 0) with (0,0) |-> 1, (0,1) |-> -2^-1, (1,0) |-> -2^-1, (1,1) |-> 1] (i,j). -apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). - rewrite mxE. - have eq0T : z2 z *m \S(z2 z)^T = 0. - apply: trmx_inj. - rewrite trmx_mul. - rewrite trmxK. - rewrite spin_mul_tr. - by rewrite trmx0. - have H2 : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2). - rewrite spinD. - rewrite spinN. - rewrite -tr_spin. - rewrite !mulmxDr. - rewrite !eq0T. - by rewrite !addr0. - have H1 : (z2 z *m \S('e_2 - z2 z)^+2 *m (z2 z)^T) 0 0 = - (norm w)^+2. - rewrite /w. - rewrite spinD. - rewrite spinN. - rewrite -tr_spin. - rewrite mulmxA. - rewrite !mulmxDr. - rewrite mulmxDl. - rewrite !eq0T. - rewrite !addr0. - rewrite -dotmulvv. - rewrite /dotmul. - rewrite trmx_mul. - rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. - rewrite tr_spin. - rewrite -mulmxA. - rewrite mulNmx. - rewrite spin_mul_tr. - by rewrite mulmxN mulmx0 oppr0 mxE. - rewrite tr_spin. - rewrite mulNmx. - rewrite mulmxN [in RHS]mxE opprK. - by rewrite mulmxA. - rewrite H1. - rewrite mxE. - rewrite addrA. - rewrite expr2. - rewrite mulmxA. - rewrite H2. - rewrite -/w. - rewrite -dotmulNv. - rewrite addrC. - rewrite -mulmxN. - rewrite -expr2. - set a := (w *m - \S('e_2 - z2 z)). - have neg_spin: norm (w *m - \S('e_2 - z2 z)) = norm (w). - rewrite orth_preserves_norm //. - admit. - rewrite /a. - have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= norm(w *m - (\S('e_2 - z2 z))) * + apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). + rewrite mxE. + have eq0T : z2 z *m \S(z2 z)^T = 0. + apply: trmx_inj ; by rewrite trmx_mul trmxK spin_mul_tr trmx0. + have H2 : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2). + by rewrite spinD spinN -tr_spin !mulmxDr !eq0T !addr0. + have H1 : (z2 z *m \S('e_2 - z2 z)^+2 *m (z2 z)^T) 0 0 = - (norm w)^+2. + rewrite /w spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !eq0T. + rewrite !addr0 -dotmulvv /dotmul trmx_mul. + rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. + by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. + by rewrite tr_spin mulNmx mulmxN [in RHS]mxE opprK mulmxA. + rewrite H1 mxE addrA expr2 mulmxA. + rewrite H2 -/w -dotmulNv addrC -mulmxN -expr2. + set a := (w *m - \S('e_2 - z2 z)). + have neg_spin: norm (w *m - \S('e_2 - z2 z)) = norm (w). + rewrite orth_preserves_norm //. + admit. + rewrite /a. + have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= norm(w *m - (\S('e_2 - z2 z))) * norm(zp1 z). - rewrite mxE /= mulr1n. - rewrite (le_trans (ler_norm _)) //. - rewrite -ler_sqr // ; last first. - by rewrite nnegrE // mulr_ge0 ?norm_ge0 //. - rewrite exprMn. - rewrite sqr_normr. - rewrite (le_trans (CauchySchwarz_vec _ _)) //. - by rewrite !dotmulvv. - apply: (@le_trans _ _ (norm (w *m - \S('e_2 - z2 z)) * norm (zp1 z) + (- norm (zp1 z) ^+ 2 - norm w ^+ 2))). - rewrite lerD2r. - rewrite (le_trans _ (cauchy)) //. - by rewrite mxE eqxx mulr1n. - rewrite neg_spin. - rewrite /a . - rewrite /u1 /u2. - rewrite ![in leRHS]mxE. - rewrite !sum2E/=. - rewrite ![in leRHS]mxE. - rewrite !sum2E/=. - rewrite ![in leRHS]mxE. - rewrite /=. - rewrite !mulr1. - rewrite mulrN. - rewrite mulNr. - rewrite opprK. - rewrite mulrDl. - rewrite mulNr. - rewrite -expr2. - rewrite [in leLHS] addrCA. - rewrite -!addrA. - rewrite lerD2l. - rewrite mulrDl. - rewrite (mulNr (norm w)). - rewrite -expr2. - rewrite !addrA. - rewrite lerD2r. - rewrite !(mulrN , mulNr). - rewrite opprK. - rewrite -mulrA. - rewrite [in leRHS](mulrC _ (norm w)). - rewrite -mulrDr. - rewrite [in leRHS](mulrC (2 ^-1)). - rewrite -mulrDr. - Search (2^-1). - rewrite -div1r. - rewrite -splitr mulr1. - by []. -have def: defposmx u2. -admit. -rewrite defposmxP in def. -have u2neq0 : u2 != 0. -admit. -case H: (u1 == 0). - move/eqP: H => ->. - rewrite mulNmx. - rewrite mul0mx. - by rewrite mulNmx mul0mx mxE mxE oppr0. + rewrite mxE /= mulr1n (le_trans (ler_norm _)) //. + rewrite -ler_sqr // ; last first. + by rewrite nnegrE // mulr_ge0 ?norm_ge0 //. + by rewrite exprMn sqr_normr (le_trans (CauchySchwarz_vec _ _)) // !dotmulvv. + apply: (@le_trans _ _ (norm (w *m - \S('e_2 - z2 z)) * norm (zp1 z) + (- norm (zp1 z) ^+ 2 - norm w ^+ 2))). + rewrite lerD2r. + rewrite (le_trans _ (cauchy)) //. + by rewrite mxE eqxx mulr1n. + rewrite neg_spin /a /u1 /u2. + rewrite ![in leRHS]mxE !sum2E/= ![in leRHS]mxE !sum2E/= ![in leRHS]mxE /=. + rewrite !mulr1 mulrN mulNr opprK mulrDl mulNr -expr2. + rewrite [in leLHS] addrCA -!addrA lerD2l mulrDl (mulNr (norm w)). + rewrite -expr2 !addrA lerD2r !(mulrN , mulNr) opprK -mulrA. + rewrite [in leRHS](mulrC _ (norm w)) -mulrDr [in leRHS](mulrC (2 ^-1)). + by rewrite -mulrDr -div1r -splitr mulr1. + have def: defposmx u2. + rewrite /defposmx /u2. + split. + - rewrite /= symE. + apply/eqP/matrixP. + move => i j. + rewrite !mxE. + case: ifPn => [/eqP[->{i} ->{j}//]|]. + case: ifPn => [/eqP[->{i} ->{j}//]|]. + case: ifPn => [/eqP[->{i} ->{j}//]|]. + case: ifPn => [/eqP[->{i} ->{j}//]|]. + by move: i j => [[|[|//]]] /= ? [[|[|]]]. + - move=> a. + move/eigenvalueP => [u] /[swap] u0 H. + move: (H) => /rowP/(_ ord0); rewrite !mxE sum2E/= !mxE eqxx mulr1/= => H1. + move: H => /rowP/(_ (lift ord0 ord0)); rewrite !mxE sum2E/= !mxE/= mulr1/= => H2. + (* mq u = 0 donc contradiction *) + admit. + rewrite defposmxP in def. + have u2neq0 : u2 != 0. + apply/matrix0Pn. + exists 1. + exists 1. + by rewrite mxE /= oner_neq0. + case H: (u1 == 0). + move/eqP: H => ->. + by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. move: H => /negP H. have u1_neq0 : u1 != 0 by apply/negP. move: (def u1 u1_neq0) => Hpos. - rewrite -oppr_ge0. - rewrite -oppr_le0. - rewrite opprK. + rewrite -oppr_ge0 -oppr_le0 opprK. apply ltW. - rewrite -oppr_gt0. - rewrite mulNmx. - rewrite !mulNmx. - rewrite mxE. - rewrite opprK. - by rewrite Hpos. + by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. +Admitted. End Lyapunov. From 95ea9ef0d407dd16bb6d3a6ae30c511c7ea93c51 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Wed, 9 Jul 2025 17:26:14 +0900 Subject: [PATCH 020/144] complete proof of defposmx and such --- tilt.v | 120 +++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 95 insertions(+), 25 deletions(-) diff --git a/tilt.v b/tilt.v index bfba328b..2b12754f 100644 --- a/tilt.v +++ b/tilt.v @@ -11,6 +11,26 @@ Import numFieldNormedType.Exports. Local Open Scope ring_scope. (* PR: to MathComp *) +Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. +Proof. +set P := (RHS). +apply/polyP => -[|[|[|i]]]; last first. +- have := (rwP (leq_sizeP (char_poly M) i.+3)).2. + rewrite size_char_poly => /(_ erefl) /(_ i.+3) => ->//. + rewrite (rwP (leq_sizeP P i.+3)).2//. + rewrite /P -addrA size_addl ?size_polyXn//. + rewrite -mulNr size_MXaddC; case: ifPn => // _. + by rewrite ltnS -polyCN size_polyC; case: (_ == _). +- rewrite /P -[in RHS]addrA [RHS]coefD coefXn/= coefD -mulrN coefCM coefC/= coefN coefX/= oppr0 mulr0 !addr0. + rewrite /char_poly det_mx22//. + rewrite /char_poly_mx !mxE/= mulr1n mulr0n sub0r mulNr opprK sub0r mulrN. + rewrite coefD coefN coefCM coefC/= mulr0 subr0. + by rewrite coefM sum3E !coefE/= !(subr0,mul0r,mulr0,addr0,mulr1,add0r). +- rewrite char_poly_trace//. + by rewrite /P -addrA addrCA !coefD coefN coefCM coefX/= mulr1 coefC/= addr0 coefXn addr0. +- rewrite char_poly_det sqrrN expr1n mul1r. + by rewrite /P !coefD coefC/= coefN coefCM coefX mulr0 subr0 coefXn/= add0r. +Qed. Lemma lsubmx_const {R : nmodType} (r : R) m n1 n2 : lsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. Proof. by apply/matrixP => i j; rewrite !mxE. Qed. @@ -20,7 +40,10 @@ Proof. by apply/matrixP => i j; rewrite !mxE. Qed. From mathcomp Require Import sequences exp realfun. +(* is it really interesting to generalize is_deriveX ?).*) Lemma derive1_powR {K : realType} (r : K) : (fun a => a `^ r)^`()%classic = (fun x => r * x `^ (r - 1)). +Proof. +rewrite /powR /=. Admitted. Global Instance is_derive1_sqrt {K : realType} (x : K) : 0 < x -> is_derive x 1 Num.sqrt (2 * Num.sqrt x)^-1. @@ -236,12 +259,12 @@ by rewrite !mxE eqxx /= eq_sym. Qed. Local Open Scope classical_set_scope. -Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) : - forall t:K, 0 <= t -> (forall t, norm (u t) != 0) -> - (2^-1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() = - (fun t => (derive1mx u t *m (u t)^T)``_0) :> (K -> K). +Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : + norm (u t) != 0 -> + (2^-1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() t = + (fun t => (derive1mx u t *m (u t)^T)``_0) t :> K. Proof. -move=> u0 t0 norm0. apply/funext => t. +move=> norm0. rewrite [LHS]derive1E deriveMl/=; last first. admit. rewrite -derive1E. @@ -255,14 +278,19 @@ rewrite !(derive_sqrt); last first. rewrite dotmulvv. rewrite lt0r. apply/andP; split. - by apply/expf_neq0. + Search (_^+_ !=0). + by rewrite expf_neq0. by rewrite exprn_ge0 ?norm_ge0. rewrite !expr1. rewrite derive1mxE'. rewrite !(mulrA 2^-1) mulVf ?pnatr_eq0// mul1r. rewrite !dotmulvv sqrtr_sqr normr_norm !mulrA /=. -have -> : norm (u t) / (2 * norm (u t)) = 2^-1. - by rewrite invfM// mulrCA divff ?mulr1. +have -> : norm (u t )/ (2 * norm (u t)) = 2^-1. + rewrite invfM//. + rewrite mulrCA. + rewrite divff. + by rewrite mulr1. + admit. set X := (X in X^`()%classic). have dot : X t = norm(u t)^+2 by rewrite /X dotmulvv. rewrite /X !derive1mx_dotmul; last 2 first. @@ -351,27 +379,25 @@ Qed. Lemma LieDerivative_jacobian1_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) (x : K -> 'rV[K]_6) (t : K) : - 0 <= t -> (forall t0, norm (f t0) != 0) -> + norm (f (x t)) != 0 -> LieDerivative_jacobian1 (fun y => ((norm (f y)) ^+ 2)%:M) x t = (2%:R *: derive1mx (f \o x) t *m (f (x t))^T) 0 0. Proof. -move => t0 f0. +move => t0. rewrite /LieDerivative_jacobian1. rewrite /jacobian1. rewrite /dotmul. rewrite -trmx_mul. rewrite -derivemxE; last first. admit. -have fx0 : forall t0 : K^o, norm (f (x t0)) != 0 by move => s; apply: f0. -have := @derive_norm K _ (f \o x) _ t0 fx0. -move=> /( congr1 (fun z => z t)). +have := derive_norm. +(*move=> /( congr1 (fun z => z t)).*) rewrite -scalemxAl [X in _ -> _ = X]mxE. move => <-. rewrite derive1Ml; last first. admit. rewrite mulrA divff // ?pnatr_eq0 // mul1r. -rewrite mxE. -rewrite fctE. +rewrite !mxE. rewrite derive1E. transitivity ( ('D_(derive1mx x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). admit. @@ -388,6 +414,7 @@ rewrite -diff_comp; last 2 first. admit. rewrite deriveE //. admit. +admit. Admitted. End LieDerivative. @@ -817,12 +844,17 @@ split; first exact: equilibrium_point1. move => n. apply/funext => zp1_z2. by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite func_eq2 !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_norm. - pose zp1 := fun r => Lsubmx (traj r). - pose z2 := fun r => Rsubmx (traj r). - rewrite -[Lsubmx \o traj]/zp1. - rewrite -[Rsubmx \o traj]/z2. - have: c1 *: (2 *: derive1mx zp1 z *m (Lsubmx (traj z))^T) 0 0 + + rewrite func_eq2 !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_norm; last first. + rewrite norm_eq0. + rewrite /point1 in traj0. + admit. + rewrite norm_eq0. + admit. + pose zp1 := fun r => Lsubmx (traj r). + pose z2 := fun r => Rsubmx (traj r). + rewrite -[Lsubmx \o traj]/zp1. + rewrite -[Rsubmx \o traj]/z2. + have: c1 *: (2 *: derive1mx zp1 z *m (Lsubmx (traj z))^T) 0 0 + c2 *: (2 *: derive1mx z2 z *m (Rsubmx (traj z))^T) 0 0 = V1dot (traj z). rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. @@ -908,10 +940,46 @@ split; first exact: equilibrium_point1. by move: i j => [[|[|//]]] /= ? [[|[|]]]. - move=> a. move/eigenvalueP => [u] /[swap] u0 H. - move: (H) => /rowP/(_ ord0); rewrite !mxE sum2E/= !mxE eqxx mulr1/= => H1. - move: H => /rowP/(_ (lift ord0 ord0)); rewrite !mxE sum2E/= !mxE/= mulr1/= => H2. - (* mq u = 0 donc contradiction *) - admit. + have a_eigen : eigenvalue u2 a. + apply/eigenvalueP. + exists u. rewrite /u2. + exact: H. exact: u0. + have a_root : root (char_poly u2) a. + rewrite -eigenvalue_root_char. + exact : a_eigen. + rewrite char_poly2 in a_root. + have tr_u2 : \tr u2 = 2. + rewrite /u2. + rewrite /= //. + rewrite /mxtrace /=. + rewrite sum2E/=. + rewrite !mxE/=. + by []. + have det_u2 : \det u2 = 3/4. + rewrite /u2. + rewrite det_mx22 /=. + rewrite !mxE /=. + by field. + rewrite tr_u2 det_u2 in a_root. + rewrite rootE in a_root. + have char_poly_fact : 'X^2 - 2%:P * 'X + (3/4)%:P = ('X - (1%:R / 2)%:P) * ('X - (3%:R / 2)%:P) :> {poly K}. + rewrite mulrBr mulrBl -expr2 -!addrA; congr +%R. + rewrite mulrBl opprB addrCA addrC; congr +%R. + by rewrite -[RHS]polyCM; congr (_%:P); by field. + rewrite [in RHS]mulrC -opprD -mulrDr mulrC; congr (- (_ * _)). + by rewrite -polyCD; congr (_%:P); by field. + rewrite char_poly_fact in a_root. + rewrite hornerM !hornerXsubC in a_root. + move: a_root. + rewrite mulf_eq0 => /orP [Ha1 | Ha2]. + rewrite subr_eq0 in Ha1. + move/eqP : Ha1 => Ha1. + rewrite Ha1. + by rewrite divr_gt0. + rewrite subr_eq0 in Ha2. + move/eqP : Ha2 => Ha2. + rewrite Ha2. + by rewrite divr_gt0. rewrite defposmxP in def. have u2neq0 : u2 != 0. apply/matrix0Pn. @@ -927,5 +995,7 @@ split; first exact: equilibrium_point1. rewrite -oppr_ge0 -oppr_le0 opprK. apply ltW. by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. +Unshelve. all: try by end_near. Admitted. + End Lyapunov. From 1a8f8125da8fe3a14bb299c8f6f7f711a77e2a29 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Tue, 15 Jul 2025 11:15:26 +0900 Subject: [PATCH 021/144] refactoring --- tilt.v | 726 ++++++++++++++++++++++++++++++++------------------------- 1 file changed, 410 insertions(+), 316 deletions(-) diff --git a/tilt.v b/tilt.v index 2b12754f..cb09fddc 100644 --- a/tilt.v +++ b/tilt.v @@ -10,6 +10,50 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. +Lemma sqr_spin_tr {R : realType} (u : 'rV[R]_3) : (\S(u) ^+ 2)^T = \S(u) ^+ 2. +Proof. apply/esym/eqP; rewrite -symE ; exact: sqr_spin_is_sym. Qed. + +Lemma norm_squared {R : realType} (n : nat) (u : 'rV[R]_n.+1) : (u *m (u)^T) 0 0 = norm (u) ^+2. +Proof. by rewrite -dotmulvv /dotmul. Qed. + +Lemma tr_spin_mul {R : realType} (u : 'rV[R]_3) : u *m \S(u)^T = 0. +Proof. by apply: trmx_inj ; rewrite trmx_mul trmxK spin_mul_tr trmx0. Qed. + +Lemma norm_spin {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v - u) ^+ 2 *m (u)^T) 0 0 = - norm (u *m \S(v)) ^+ 2. +Proof. +rewrite spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !tr_spin_mul. +rewrite !addr0 -dotmulvv /dotmul trmx_mul. +rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. +by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. +by rewrite tr_spin mulNmx mulmxN [in RHS]mxE opprK mulmxA. +Qed. + +Lemma dotmulspin1 {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v)) *d v = 0. +Proof. by apply/eqP ; rewrite dotmulC dotmul_trmx -normalvv normal_sym tr_spin_mul normalvv dotmulv0. Qed. + +Lemma dotmulspin2 {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v)) *d u = 0. +Proof. by apply/eqP ; rewrite -normalvv normal_sym spinE -normalmN (@lieC _ (vec3 R)) /= opprK crossmul_normal. Qed. + +Lemma ortho {R : realType} (a : 'rV[R]_3) (b : 'rV[R]_3) : (a - b) *d (b *m \S(a))= 0. +Proof. by rewrite dotmulBl dotmulC dotmulspin1 dotmulC dotmulspin2 subr0. Qed. + +Lemma sqr_spin {R : realType} (u : 'rV[R]_3) (norm_u1 : norm u = 1) : \S(u) *m \S(u) = u^T *m u - 1%:M. +Proof. +have sqrspin : \S(u) ^+ 2 = u^T *m u - (norm u ^+ 2)%:A by rewrite sqr_spin. +rewrite expr2 norm_u1 expr2 mulr1 in sqrspin. +rewrite mulmxE sqrspin. + apply/matrixP => i j. + rewrite mxE /= [in RHS]mxE /=. + congr (_+_). + rewrite mxE mxE /= mul1r. + rewrite [in RHS]mxE [in RHS]mxE /= -mulNrn. + rewrite mxE -mulNrn. + by []. +Qed. + +Lemma sqr_inj {R : rcfType} : {in Num.nneg &, injective (fun x : R => x ^+ 2)}. +Proof. by move=> x y x0 y0 /(congr1 (@Num.sqrt R)); rewrite !sqrtr_sqr! ger0_norm. Qed. + (* PR: to MathComp *) Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. Proof. @@ -41,9 +85,16 @@ Proof. by apply/matrixP => i j; rewrite !mxE. Qed. From mathcomp Require Import sequences exp realfun. (* is it really interesting to generalize is_deriveX ?).*) -Lemma derive1_powR {K : realType} (r : K) : (fun a => a `^ r)^`()%classic = (fun x => r * x `^ (r - 1)). +Lemma derive1_powR {K : realType} (r : K) : 1 < r -> (fun a => if a == 0 then 0 else a `^ r)^`()%classic = (fun x => if x == 0 then 0 else r * x `^ (r - 1)). Proof. rewrite /powR /=. +move => r1. +apply/funext => x. +case: (x == 0) => [|]. +rewrite derive1E. +apply: derive_val. +have: is_derive (0 : K) (1 : K) (fun a => if a == 0 then 0 else a `^ r) 0. +rewrite /=. Admitted. Global Instance is_derive1_sqrt {K : realType} (x : K) : 0 < x -> is_derive x 1 Num.sqrt (2 * Num.sqrt x)^-1. @@ -92,7 +143,6 @@ Lemma derive_sqrt {K : realType} (r : K) : 0 < r -> Proof. move=> r0. rewrite derive1E. -Search is_derive. apply: derive_val. exact: is_derive1_sqrt. Qed. @@ -260,48 +310,18 @@ Qed. Local Open Scope classical_set_scope. Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : - norm (u t) != 0 -> (2^-1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() t = (fun t => (derive1mx u t *m (u t)^T)``_0) t :> K. Proof. -move=> norm0. rewrite [LHS]derive1E deriveMl/=; last first. admit. rewrite -derive1E. -rewrite (@derive1_comp _ (@norm _ _ \o u ) (@GRing.exp K ^~ 2)) ; last 2 first. - admit. - admit. -rewrite exp_derive1 derive1_comp /=; last 2 first. - admit. - admit. -rewrite !(derive_sqrt); last first. - rewrite dotmulvv. - rewrite lt0r. - apply/andP; split. - Search (_^+_ !=0). - by rewrite expf_neq0. - by rewrite exprn_ge0 ?norm_ge0. - rewrite !expr1. - rewrite derive1mxE'. -rewrite !(mulrA 2^-1) mulVf ?pnatr_eq0// mul1r. -rewrite !dotmulvv sqrtr_sqr normr_norm !mulrA /=. -have -> : norm (u t )/ (2 * norm (u t)) = 2^-1. - rewrite invfM//. - rewrite mulrCA. - rewrite divff. - by rewrite mulr1. - admit. -set X := (X in X^`()%classic). -have dot : X t = norm(u t)^+2 by rewrite /X dotmulvv. -rewrite /X !derive1mx_dotmul; last 2 first. - admit. - admit. -rewrite dotmulP /=. -set y := derive1mx u t *d u t. -have -> : y + u t *d derive1mx u t = 2 * y. - by rewrite mulr_natl mulr2n dotmulC. -rewrite mulrA mulVf ?pnatr_eq0// mul1r mxE eqxx mulr1n. -by rewrite -derive1mxE'. +under eq_fun do rewrite -dotmulvv. +rewrite dotmulP mxE /= mulr1n derive1mx_dotmul ; last 2 first. +admit. +admit. +rewrite [X in _ * (_ + X) = _]dotmulC. +by field. Admitted. End derive_help. @@ -379,11 +399,9 @@ Qed. Lemma LieDerivative_jacobian1_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) (x : K -> 'rV[K]_6) (t : K) : - norm (f (x t)) != 0 -> LieDerivative_jacobian1 (fun y => ((norm (f y)) ^+ 2)%:M) x t = (2%:R *: derive1mx (f \o x) t *m (f (x t))^T) 0 0. Proof. -move => t0. rewrite /LieDerivative_jacobian1. rewrite /jacobian1. rewrite /dotmul. @@ -414,7 +432,6 @@ rewrite -diff_comp; last 2 first. admit. rewrite deriveE //. admit. -admit. Admitted. End LieDerivative. @@ -438,12 +455,17 @@ Definition state_space := End ode. -Definition is_lyapunov_function {K : realType} (n := 5) +Definition is_lyapunov_candidate {K : realType} (n := 5) + (V : 'rV[K]_n.+1 -> 'rV[K]_1) + (x0 : 'rV[K]_n.+1) := + locposdef (fun z => (V z) 0 0) x0. + +Definition eq_is_lyapunov_stable {K : realType} (n := 5) (f : K -> (K -> 'rV[K]_n.+1) -> 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> 'rV[K]_1) (x0 : 'rV[K]_n.+1) : Prop := [/\ is_equilibrium_point f x0, - locposdef (fun z => (V z) 0 0) x0 & + is_lyapunov_candidate V x0 & forall traj : K -> 'rV[K]_n.+1, is_solution f traj -> traj 0 = x0 -> @@ -530,7 +552,7 @@ Section Gamma1. Context {K : realType}. Local Open Scope classical_set_scope. -Definition Gamma1 := [set x : 'rV[K]_6 | norm (@rsubmx _ 1 3 3 x) = 1]. +Definition Gamma1 := [set x : 'rV[K]_6 | norm ('e_2 - @rsubmx _ 1 3 3 x) = 1]. End Gamma1. @@ -669,15 +691,57 @@ Definition V1dot (zp1_z2 : 'rV[K]_6) : K := - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. +Lemma derive_zp1 (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : + derive1mx zp1 z = (- alpha1 *: Lsubmx (traj z)). +Proof. +rewrite /zp1. +move : dtraj. +rewrite /is_solution /eqn33. +move=> /(_ z). +rewrite /zp1 /=. +move=> /(congr1 Lsubmx). +rewrite row_mxKl. +rewrite !derive1mxE' => <-. +rewrite !derive1E !deriveE; last 2 first. (* TODO LEMMA*) + admit. + admit. +apply/matrixP => i j. + admit. +Admitted. + +Lemma derive_z2 (z : K) (traj : K -> 'rV_5%R.+1) (z2 := fun r => Rsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : + derive1mx z2 z = (* TODO LEMMA*) + (gamma *: (Rsubmx (traj z) - Lsubmx (traj z)) *m \S('e_2 - Rsubmx (traj z)) ^+ 2). +Proof. +Admitted. + +Lemma derive_V1dot (c1 := (2^-1 / alpha1)) (c2 := (2^-1 / gamma)) (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) + (z2 := fun r => Rsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) + : c1 *: (2 *: derive1mx zp1 z *m (Lsubmx (traj z))^T) 0 0 + + c2 *: (2 *: derive1mx z2 z *m (Rsubmx (traj z))^T) 0 0 + = V1dot (traj z). +Proof. +rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. +rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC mulVf ?pnatr_eq0// div1r. +rewrite derive_zp1 // -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)) mulrN mulVf ?gt_eqF// mulN1r. +rewrite derive_z2 // -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE scalerA mulVf ?gt_eqF// scale1r. +rewrite norm_squared /V1dot. +congr +%R. +set Lmx := lsubmx _. +set Rmx := rsubmx _. +rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. +rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK -[X in _ = (_ *m (X *m _)) 0 0]trmxK. +rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE -(mulmxA (Rmx - Lmx)) mulmxE -expr2. +rewrite sqr_spin_tr. +by rewrite mulmxA. +Qed. + Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution (fun a b => @eqn33 K alpha1 gamma b a) x -> LieDerivative_jacobian1 V1 x t = V1dot (x t). Proof. move=> eqn33x. -pose zp1 := fun r => Lsubmx (x r). -pose z2 := fun r => Rsubmx (x r). rewrite /V1. - rewrite /V1. - rewrite [X in LieDerivative_jacobian1 X _ _](_ : _ = +rewrite [X in LieDerivative_jacobian1 X _ _](_ : _ = (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 / (2 * alpha1))%:M) + @@ -687,74 +751,90 @@ rewrite /V1. apply/funext => y/=. rewrite fctE. by rewrite raddfD. - rewrite LieDerivative_jacobian1D. - rewrite !invfM /=. - set c1 := (2^-1 / alpha1). - set c2 := (2^-1 / gamma). - rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = +rewrite LieDerivative_jacobian1D. +rewrite !invfM /=. +set c1 := (2^-1 / alpha1). +set c2 := (2^-1 / gamma). +rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. apply/funext => y. by rewrite -scale_scalar_mx. - rewrite !fctE. - have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = +rewrite !fctE. +have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. +rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. apply/funext => y. by rewrite -scale_scalar_mx. - rewrite func_eq. - have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = +rewrite func_eq. +have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite func_eq2. - rewrite !LieDerivative_jacobian1Ml. - rewrite !fctE. -rewrite !LieDerivative_jacobian1_norm /=. -rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. -rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC mulVf ?pnatr_eq0// div1r. -rewrite -[Lsubmx \o x]/zp1. -rewrite -[Rsubmx \o x]/z2. -have H1 : derive1mx zp1 t = (- alpha1 *: Lsubmx (x t)). - have := eqn33x t. - rewrite /eqn33. - admit. (* from eqn33? *) -have H2 : derive1mx z2 t = (gamma *: (Rsubmx (x t) - Lsubmx (x t)) *m \S('e_2 - Rsubmx (x t)) ^+ 2). - admit. -rewrite H1 -scalemxAl mxE. -rewrite [X in X + _](mulrA (alpha1^-1) (- alpha1)). -rewrite mulrN mulVf ?gt_eqF// mulN1r H2 -scalemxAl mulmxA -scalemxAl. -rewrite [in X in _ + X]mxE scalerA mulVf ?gt_eqF// scale1r. -have -> : ((Lsubmx (x t)) *m (Lsubmx (x t))^T) 0 0 = norm (Lsubmx (x t)) ^+2. - rewrite sqr_sqrtr. - rewrite dotmulP. - by rewrite mxE eqxx mulr1n. - rewrite dotmulvv. - by rewrite sqr_ge0. -rewrite /V1dot. -congr +%R. -set Lmx := lsubmx _. -set Rmx := rsubmx _. -rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. -rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK. -rewrite -[X in _ = (_ *m (X *m _)) 0 0]trmxK. -rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE. -rewrite -(mulmxA (Rmx - Lmx)). -rewrite mulmxE -expr2. -have -> : (\S('e_2 - Rmx) ^+ 2)^T = \S('e_2 - Rmx) ^+ 2. - apply/esym/eqP. - rewrite -symE. - exact: sqr_spin_is_sym. -by rewrite mulmxA. -Admitted. + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. +rewrite func_eq2 !LieDerivative_jacobian1Ml !fctE !LieDerivative_jacobian1_norm /=. +by rewrite derive_V1dot //. +Qed. -Lemma V1_is_lyapunov : is_lyapunov_function (fun a b => @eqn33 K alpha1 gamma b a) V1 (@point1 K). +Lemma defposmxu2 ( u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) + [eta (fun=> 0) with (0,0) |-> 1, + (0,1) |-> -2^-1, + (1,0) |-> -2^-1, + (1,1) |-> 1] (i,j)): defposmx u2. +Proof. +rewrite /defposmx /u2. +split. + - rewrite /= symE. + apply/eqP/matrixP. + move => i j. + rewrite !mxE. + case: ifPn => [/eqP[->{i} ->{j}//]|]. + case: ifPn => [/eqP[->{i} ->{j}//]|]. + case: ifPn => [/eqP[->{i} ->{j}//]|]. + case: ifPn => [/eqP[->{i} ->{j}//]|]. + by move: i j => [[|[|//]]] /= ? [[|[|]]]. + - move=> a. + move/eigenvalueP => [u] /[swap] u0 H. + have a_eigen : eigenvalue u2 a. + apply/eigenvalueP. + exists u. rewrite /u2. + exact: H. exact: u0. + have a_root : root (char_poly u2) a. + rewrite -eigenvalue_root_char. + exact : a_eigen. + rewrite char_poly2 in a_root. + have tr_u2 : \tr u2 = 2. + rewrite /u2. + rewrite /= //. + rewrite /mxtrace /=. + by rewrite sum2E/= !mxE/=. + have det_u2 : \det u2 = 3/4. + rewrite /u2 det_mx22 /= !mxE /=. + by field. + rewrite tr_u2 det_u2 rootE in a_root. + have char_poly_fact : 'X^2 - 2%:P * 'X + (3/4)%:P = ('X - (1%:R / 2)%:P) * ('X - (3%:R / 2)%:P) :> {poly K}. + rewrite mulrBr mulrBl -expr2 -!addrA; congr +%R. + rewrite mulrBl opprB addrCA addrC; congr +%R. + by rewrite -[RHS]polyCM; congr (_%:P); by field. + rewrite [in RHS]mulrC -opprD -mulrDr mulrC; congr (- (_ * _)). + by rewrite -polyCD; congr (_%:P); by field. + rewrite char_poly_fact hornerM !hornerXsubC in a_root. + move: a_root. + rewrite mulf_eq0 => /orP [Ha1 | Ha2]. + rewrite subr_eq0 in Ha1. + move/eqP : Ha1 => Ha1. + by rewrite Ha1 divr_gt0. + rewrite subr_eq0 in Ha2. + move/eqP : Ha2 => Ha2. + rewrite Ha2. + by rewrite divr_gt0. +Qed. + +Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 (point1 K). Proof. -split; first exact: equilibrium_point1. - rewrite /locposdef; split. + by rewrite /V1 /point1 lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r mxE /=. + near=> z_near. @@ -777,225 +857,239 @@ split; first exact: equilibrium_point1. - rewrite mxE /= ltr_pwDr//. by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0// norm_gt0. by rewrite divr_ge0 ?exprn_ge0 ?norm_ge0// mulr_ge0// ltW. -- move=> traj dtraj traj0. - rewrite /locnegsemidef. - rewrite /V1. - rewrite [x in (LieDerivative_jacobian1 x)] (_ : _ = (fun x0 : 'rV_6 => - (norm (Lsubmx x0) ^+ 2 / (2 * alpha1))%:M) \+ - (fun x0 => (norm (Rsubmx x0) ^+ 2 / (2 * gamma))%:M)); last first. - by apply/funext => ?/=; rewrite !raddfD. - rewrite LieDerivative_jacobian1D /=. - split. - rewrite !invfM /=. - set c1 := (2^-1 / alpha1). - set c2 := (2^-1 / gamma). - rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = - (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. +Unshelve. all: by end_near. +Qed. + +(* TODO: Section general properties of our system *) + +Lemma Gamma1_traj (traj : K -> 'rV_5%R.+1) (z : K) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) t : + Gamma1 (traj t). +Proof. +rewrite -(thm11a gamma_gt0 alpha1_gt0 ). + rewrite /state_space/=. + exists traj. + split => //. + rewrite inE/=. + by exists t. +Qed. + +Lemma norm_u1 (traj : K -> 'rV_5%R.+1) (z : K) (z2 := fun r => Rsubmx (traj r)) (zp1 := fun r => Lsubmx (traj r)) (u := 'e_2 - z2 z) + (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : norm u = 1. + rewrite /u. + suff: Gamma1 (row_mx (zp1 z) (z2 z)). + rewrite /Gamma1/=. + by rewrite row_mxKr. + rewrite /zp1 /z2. + rewrite hsubmxK /=. + apply/Gamma1_traj. + rewrite //. + by rewrite //. +Qed. + +Lemma Hsq (traj : K -> 'rV_5%R.+1) (z : K) (z2 := fun r => Rsubmx (traj r)) ( w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) + (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. +Proof. +rewrite /dotmul !trmx_mul !tr_spin !mulNmx mulmxN opprK mulmxN !dotmulP. +have key_ortho : (z2 z *m \S('e_2)) *d u = 0. + by rewrite dotmulC ; apply/ortho. +rewrite key_ortho expr2. +rewrite [in RHS]mxE. +rewrite [X in _ = - (w *m (\S('e_2) *m (z2 z)^T)) 0 0 * (u *d u)%:M 0 0 - 0%:M 0 0 * X]mxE mulr1n mulr0 subr0/=. +rewrite /u -/w /dotmul. +have Hw_ortho : (w *d u) = 0 by rewrite /u dotmulC ortho. +rewrite !mulmxA dotmulP dotmulvv norm_u1 // expr2 mulr1. +rewrite [X in _ = - (w *m \S('e_2) *m (z2 z)^T) 0 0 * X]mxE /= mulr1n /=. +rewrite [X in _ = - (w *m \S('e_2) *m (z2 z)^T) 0 0 * X]mxE /= mulr1. +have wu0 : w *m u^T *m u = 0 by rewrite dotmulP Hw_ortho mul_scalar_mx scale0r. +rewrite -[in LHS](mulmxA w) sqr_spin; last first. + by rewrite -/u norm_u1. +rewrite [in LHS]mulmxBr mulmxA wu0 sub0r. +by rewrite 2!mulNmx mulmx1 mxE. +Qed. + +Lemma neg_spin (traj : K -> 'rV_5%R.+1) (z : K) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj ): + norm (Rsubmx (traj z) *m \S('e_2) *m - \S('e_2 - Rsubmx (traj z))) = + norm (Rsubmx (traj z) *m \S('e_2)). +Proof. +rewrite mulmxN normN. +pose zp1 := fun r => Lsubmx (traj r). +pose z2 := fun r => Rsubmx (traj r). +set w := (z2 z) *m \S('e_2). +have Gamma1_traj t : Gamma1 (traj t) by apply/Gamma1_traj. +rewrite /norm. +rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. +have Hnorm_sq : norm (w *m \S('e_2 - Rsubmx (traj z))) ^+ 2 = norm w ^+ 2. + rewrite -!dotmulvv Hsq // !dotmulvv norm_u1 /= //. + rewrite -!dotmulvv expr2 !mul1r mulr1. + have wu0 : w *d ('e_2 - Rsubmx (traj z)) = 0. + rewrite dotmulC. + by rewrite ortho. + by rewrite wu0 expr2 mul0r subr0 //. + rewrite !normr_norm. + by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?norm_ge0. +Qed. + +Lemma bornage (traj : K -> 'rV_5%R.+1) (z : K) (zp1 := fun r => Lsubmx (traj r)) (z2 := fun r => Rsubmx (traj r)) + ( w := (z2 z) *m \S('e_2)) + (u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i) + (u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) + [eta (fun=> 0) with (0,0) |-> 1, + (0,1) |-> -2^-1, + (1,0) |-> -2^-1, + (1,1) |-> 1] (i,j)) + (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : +- norm (zp1 z) ^+ 2 + + (z2 z *m \S('e_2 - z2 z) ^+ 2 *m (z2 z)^T - z2 z *m \S('e_2 - z2 z) ^+ 2 *m (zp1 z)^T) 0 0 <= + (- u1 *m u2 *m u1^T) 0 0. +Proof. +apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). + rewrite mxE. + have H2 : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2) by rewrite spinD spinN -tr_spin !mulmxDr !tr_spin_mul !addr0. + rewrite norm_spin mxE addrA expr2 mulmxA H2 -/w -dotmulNv addrC -mulmxN -expr2. + have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= + norm(w *m - (\S('e_2 - z2 z))) * norm(zp1 z). + rewrite mxE /= mulr1n (le_trans (ler_norm _)) //. + rewrite -ler_sqr // ; last first. + by rewrite nnegrE // mulr_ge0 ?norm_ge0 //. + by rewrite exprMn sqr_normr (le_trans (CauchySchwarz_vec _ _)) // !dotmulvv. + apply: (@le_trans _ _ (norm (w *m - \S('e_2 - z2 z)) * norm (zp1 z) + (- norm (zp1 z) ^+ 2 - norm w ^+ 2))). + rewrite lerD2r. + rewrite (le_trans _ (cauchy)) //. + by rewrite mxE eqxx mulr1n. + rewrite neg_spin /u1 /u2 //. + rewrite ![in leRHS]mxE !sum2E/= ![in leRHS]mxE !sum2E/= ![in leRHS]mxE /=. + rewrite !mulr1 mulrN mulNr opprK mulrDl mulNr -expr2. + rewrite [in leLHS] addrCA -!addrA lerD2l mulrDl (mulNr (norm w)). + rewrite -expr2 !addrA lerD2r !(mulrN , mulNr) opprK -mulrA. + rewrite [in leRHS](mulrC _ (norm w)) -mulrDr [in leRHS](mulrC (2 ^-1)). + by rewrite -mulrDr -div1r -splitr mulr1. +by []. +Qed. + +Lemma u2neq0 ( u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) + [eta (fun=> 0) with (0,0) |-> 1, + (0,1) |-> -2^-1, + (1,0) |-> -2^-1, + (1,1) |-> 1] (i,j)) : u2 != 0. +Proof. + apply/matrix0Pn. + exists 1. + exists 1. + by rewrite mxE /= oner_neq0. +Qed. + +(* TODO: rework of this proof is needed *) +Lemma bornage_near (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) + (z2 := fun r => Rsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) + (traj0 : traj 0 = point1 K) : \forall z \near 0^', (LieDerivative_jacobian1 + (fun x0 : 'rV_6 => (norm (Lsubmx x0) ^+ 2 / (2 * alpha1))%:M) traj + + LieDerivative_jacobian1 + (fun x0 : 'rV_6 => (norm (Rsubmx x0) ^+ 2 / (2 * gamma))%:M) traj) z <= + 0. +Proof. +near=> z. +rewrite !fctE !invfM /=. +set c1 := (2^-1 / alpha1). +set c2 := (2^-1 / gamma). +rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = +(fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. (* TODO: Lemma?*) apply/funext => y. by rewrite -scale_scalar_mx. - rewrite !fctE. - have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = +have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. +rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. apply/funext => y. by rewrite -scale_scalar_mx. - rewrite func_eq. - have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = +rewrite func_eq. +have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite func_eq2. - rewrite !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_eq0_equilibrium. - by rewrite scaler0 scaler0 add0r. - rewrite /is_solution /eqn33 in dtraj. - rewrite -derive1E -derive1mxE'. - rewrite dtraj/= traj0 /point1. - by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - rewrite /is_solution /eqn33 in dtraj. - rewrite -derive1E -derive1mxE'. - rewrite dtraj/= traj0 /point1. - by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - + near=> z. - rewrite !fctE. - rewrite !invfM /=. - set c1 := (2^-1 / alpha1). - set c2 := (2^-1 / gamma). - rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = - (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. - apply/funext => y. - by rewrite -scale_scalar_mx. - have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. +rewrite func_eq2 !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_norm derive_V1dot //. +set w := (z2 z) *m \S('e_2). +pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. +pose u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) + [eta (fun=> 0) with (0,0) |-> 1, + (0,1) |-> -2^-1, + (1,0) |-> -2^-1, + (1,1) |-> 1] (i,j). + +apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). + by rewrite bornage. +move: defposmxu2 => /= def. +rewrite defposmxP in def. +move : u2neq0 => _. +case H: (u1 == 0). + move/eqP: H => ->. + by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. +move: H => /negP H. +have u1_neq0 : u1 != 0 by apply/negP. +move: (def u1 u1_neq0) => Hpos. +rewrite -oppr_ge0 -oppr_le0 opprK. +apply ltW. +by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. +Unshelve. all: try by end_near. +Qed. + +Lemma V1_point_is_lnsd (traj : K -> 'rV_5%R.+1) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) + (traj0 : traj 0 = point1 K) : locnegsemidef (LieDerivative_jacobian1 V1 traj) 0. +Proof. +have Gamma1_traj t : Gamma1 (traj t) by apply/Gamma1_traj. +rewrite /locnegsemidef /V1. +rewrite [x in (LieDerivative_jacobian1 x)] (_ : _ = (fun x0 : 'rV_6 => + (norm (Lsubmx x0) ^+ 2 / (2 * alpha1))%:M) \+ + (fun x0 => (norm (Rsubmx x0) ^+ 2 / (2 * gamma))%:M)); last first. by apply/funext => ?/=; rewrite !raddfD. +rewrite LieDerivative_jacobian1D /=. +split. + rewrite !invfM /=. + set c1 := (2^-1 / alpha1). + set c2 := (2^-1 / gamma). + rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = + (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. + apply/funext => y. + by rewrite -scale_scalar_mx. + rewrite !fctE. + have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. - apply/funext => y. - by rewrite -scale_scalar_mx. - rewrite func_eq. - have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = + apply/funext => y. + by rewrite -scale_scalar_mx. + rewrite func_eq. + have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite func_eq2 !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_norm; last first. - rewrite norm_eq0. - rewrite /point1 in traj0. - admit. - rewrite norm_eq0. - admit. - pose zp1 := fun r => Lsubmx (traj r). - pose z2 := fun r => Rsubmx (traj r). - rewrite -[Lsubmx \o traj]/zp1. - rewrite -[Rsubmx \o traj]/z2. - have: c1 *: (2 *: derive1mx zp1 z *m (Lsubmx (traj z))^T) 0 0 + - c2 *: (2 *: derive1mx z2 z *m (Rsubmx (traj z))^T) 0 0 - = V1dot (traj z). - rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. - rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC mulVf ?pnatr_eq0// div1r. - have H1 : derive1mx zp1 z = (- alpha1 *: Lsubmx (traj z)). - admit. (* from eqn33? *) - have H2 : derive1mx z2 z = (gamma *: (Rsubmx (traj z) - Lsubmx (traj z)) *m \S('e_2 - Rsubmx (traj z)) ^+ 2). - admit. - rewrite H1 -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)) mulrN mulVf ?gt_eqF// mulN1r. - rewrite H2 -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE scalerA mulVf ?gt_eqF// scale1r. - have -> : ((Lsubmx (traj z)) *m (Lsubmx (traj z))^T) 0 0 = norm (Lsubmx (traj z)) ^+2. - rewrite sqr_sqrtr /dotmul. - admit. - admit. - rewrite /V1dot. - congr +%R. - set Lmx := lsubmx _. - set Rmx := rsubmx _. - rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. - rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK -[X in _ = (_ *m (X *m _)) 0 0]trmxK. - rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE -(mulmxA (Rmx - Lmx)) mulmxE -expr2. - have -> : (\S('e_2 - Rmx) ^+ 2)^T = \S('e_2 - Rmx) ^+ 2. - apply/esym/eqP. - rewrite -symE. - exact: sqr_spin_is_sym. - by rewrite mulmxA. - move=> ->. - rewrite /V1dot -/(zp1 z) -/(z2 z). - set w := (z2 z) *m \S('e_2). - pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. - pose u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) - [eta (fun=> 0) with (0,0) |-> 1, - (0,1) |-> -2^-1, - (1,0) |-> -2^-1, - (1,1) |-> 1] (i,j). - apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). - rewrite mxE. - have eq0T : z2 z *m \S(z2 z)^T = 0. - apply: trmx_inj ; by rewrite trmx_mul trmxK spin_mul_tr trmx0. - have H2 : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2). - by rewrite spinD spinN -tr_spin !mulmxDr !eq0T !addr0. - have H1 : (z2 z *m \S('e_2 - z2 z)^+2 *m (z2 z)^T) 0 0 = - (norm w)^+2. - rewrite /w spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !eq0T. - rewrite !addr0 -dotmulvv /dotmul trmx_mul. - rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. - by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. - by rewrite tr_spin mulNmx mulmxN [in RHS]mxE opprK mulmxA. - rewrite H1 mxE addrA expr2 mulmxA. - rewrite H2 -/w -dotmulNv addrC -mulmxN -expr2. - set a := (w *m - \S('e_2 - z2 z)). - have neg_spin: norm (w *m - \S('e_2 - z2 z)) = norm (w). - rewrite orth_preserves_norm //. - admit. - rewrite /a. - have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= norm(w *m - (\S('e_2 - z2 z))) * - norm(zp1 z). - rewrite mxE /= mulr1n (le_trans (ler_norm _)) //. - rewrite -ler_sqr // ; last first. - by rewrite nnegrE // mulr_ge0 ?norm_ge0 //. - by rewrite exprMn sqr_normr (le_trans (CauchySchwarz_vec _ _)) // !dotmulvv. - apply: (@le_trans _ _ (norm (w *m - \S('e_2 - z2 z)) * norm (zp1 z) + (- norm (zp1 z) ^+ 2 - norm w ^+ 2))). - rewrite lerD2r. - rewrite (le_trans _ (cauchy)) //. - by rewrite mxE eqxx mulr1n. - rewrite neg_spin /a /u1 /u2. - rewrite ![in leRHS]mxE !sum2E/= ![in leRHS]mxE !sum2E/= ![in leRHS]mxE /=. - rewrite !mulr1 mulrN mulNr opprK mulrDl mulNr -expr2. - rewrite [in leLHS] addrCA -!addrA lerD2l mulrDl (mulNr (norm w)). - rewrite -expr2 !addrA lerD2r !(mulrN , mulNr) opprK -mulrA. - rewrite [in leRHS](mulrC _ (norm w)) -mulrDr [in leRHS](mulrC (2 ^-1)). - by rewrite -mulrDr -div1r -splitr mulr1. - have def: defposmx u2. - rewrite /defposmx /u2. - split. - - rewrite /= symE. - apply/eqP/matrixP. - move => i j. - rewrite !mxE. - case: ifPn => [/eqP[->{i} ->{j}//]|]. - case: ifPn => [/eqP[->{i} ->{j}//]|]. - case: ifPn => [/eqP[->{i} ->{j}//]|]. - case: ifPn => [/eqP[->{i} ->{j}//]|]. - by move: i j => [[|[|//]]] /= ? [[|[|]]]. - - move=> a. - move/eigenvalueP => [u] /[swap] u0 H. - have a_eigen : eigenvalue u2 a. - apply/eigenvalueP. - exists u. rewrite /u2. - exact: H. exact: u0. - have a_root : root (char_poly u2) a. - rewrite -eigenvalue_root_char. - exact : a_eigen. - rewrite char_poly2 in a_root. - have tr_u2 : \tr u2 = 2. - rewrite /u2. - rewrite /= //. - rewrite /mxtrace /=. - rewrite sum2E/=. - rewrite !mxE/=. - by []. - have det_u2 : \det u2 = 3/4. - rewrite /u2. - rewrite det_mx22 /=. - rewrite !mxE /=. - by field. - rewrite tr_u2 det_u2 in a_root. - rewrite rootE in a_root. - have char_poly_fact : 'X^2 - 2%:P * 'X + (3/4)%:P = ('X - (1%:R / 2)%:P) * ('X - (3%:R / 2)%:P) :> {poly K}. - rewrite mulrBr mulrBl -expr2 -!addrA; congr +%R. - rewrite mulrBl opprB addrCA addrC; congr +%R. - by rewrite -[RHS]polyCM; congr (_%:P); by field. - rewrite [in RHS]mulrC -opprD -mulrDr mulrC; congr (- (_ * _)). - by rewrite -polyCD; congr (_%:P); by field. - rewrite char_poly_fact in a_root. - rewrite hornerM !hornerXsubC in a_root. - move: a_root. - rewrite mulf_eq0 => /orP [Ha1 | Ha2]. - rewrite subr_eq0 in Ha1. - move/eqP : Ha1 => Ha1. - rewrite Ha1. - by rewrite divr_gt0. - rewrite subr_eq0 in Ha2. - move/eqP : Ha2 => Ha2. - rewrite Ha2. - by rewrite divr_gt0. - rewrite defposmxP in def. - have u2neq0 : u2 != 0. - apply/matrix0Pn. - exists 1. - exists 1. - by rewrite mxE /= oner_neq0. - case H: (u1 == 0). - move/eqP: H => ->. - by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. - move: H => /negP H. - have u1_neq0 : u1 != 0 by apply/negP. - move: (def u1 u1_neq0) => Hpos. - rewrite -oppr_ge0 -oppr_le0 opprK. - apply ltW. - by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. -Unshelve. all: try by end_near. -Admitted. + move => n. + apply/funext => zp1_z2. + by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. + rewrite func_eq2. + rewrite !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_eq0_equilibrium; last 3 first. + by rewrite scaler0 scaler0 add0r. + rewrite /is_solution /eqn33 in dtraj. + rewrite -derive1E -derive1mxE'. + rewrite dtraj/= traj0 /point1. + by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. + rewrite /is_solution /eqn33 in dtraj. + rewrite -derive1E -derive1mxE'. + rewrite dtraj/= traj0 /point1. + by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. +apply/bornage_near. +by rewrite //. +by rewrite //. +Qed. + +Lemma V1_is_lyapunov_stable : eq_is_lyapunov_stable (fun a b => @eqn33 K alpha1 gamma b a) V1 (@point1 K). +Proof. +split; first exact: equilibrium_point1. +- apply V1_is_lyapunov_candidate. +- apply/V1_point_is_lnsd. +Qed. End Lyapunov. From c146360cddaf9bc8a57f101d1f50309dbe75121b Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Wed, 16 Jul 2025 12:51:26 +0900 Subject: [PATCH 022/144] clean --- tilt.v | 60 +++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 43 insertions(+), 17 deletions(-) diff --git a/tilt.v b/tilt.v index cb09fddc..43a78143 100644 --- a/tilt.v +++ b/tilt.v @@ -10,12 +10,10 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. +(* spin and matrix/norm properties*) Lemma sqr_spin_tr {R : realType} (u : 'rV[R]_3) : (\S(u) ^+ 2)^T = \S(u) ^+ 2. Proof. apply/esym/eqP; rewrite -symE ; exact: sqr_spin_is_sym. Qed. -Lemma norm_squared {R : realType} (n : nat) (u : 'rV[R]_n.+1) : (u *m (u)^T) 0 0 = norm (u) ^+2. -Proof. by rewrite -dotmulvv /dotmul. Qed. - Lemma tr_spin_mul {R : realType} (u : 'rV[R]_3) : u *m \S(u)^T = 0. Proof. by apply: trmx_inj ; rewrite trmx_mul trmxK spin_mul_tr trmx0. Qed. @@ -51,6 +49,9 @@ rewrite mulmxE sqrspin. by []. Qed. +Lemma norm_squared {R : realType} (n : nat) (u : 'rV[R]_n.+1) : (u *m (u)^T) 0 0 = norm (u) ^+2. +Proof. by rewrite -dotmulvv /dotmul. Qed. + Lemma sqr_inj {R : rcfType} : {in Num.nneg &, injective (fun x : R => x ^+ 2)}. Proof. by move=> x y x0 y0 /(congr1 (@Num.sqrt R)); rewrite !sqrtr_sqr! ger0_norm. Qed. @@ -577,20 +578,20 @@ il existe une solution depuis tout point: gamma1 ⊆ state_space*) (* prouver invariance geometrique, tangence donc les trajectoires restent dans gamma1: state_space ⊆ gamma1 -Definition xi1 t (zp1_zp2 : K -> 'rV[K]_6) : Gamma1 := - let zp1*) - +*) Lemma thm11a : state_space (fun a b => eqn33 b a) = Gamma1. Proof. +(* il existe une solution depuis tout point*) apply/seteqP; split. - move=> p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. move=> [y0 [Heq Hrange]]. admit. +(* toute image d'une trajectoire est dans gamma +nagumo theorem *) - move => p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. - move => y. - rewrite /state_space /Gamma1 /eqn33 /is_solution. + move => norme. admit. Admitted. @@ -691,6 +692,31 @@ Definition V1dot (zp1_z2 : 'rV[K]_6) : K := - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. +Lemma derive_lsubE (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)): (fun r : K => Lsubmx (traj r))^`() z = Lsubmx ((traj^`())%classic z). +Proof. +apply/matrixP => i j. +rewrite !derive1E. +rewrite !deriveE ; last 2 first. + admit. + admit. +rewrite diff_comp ; last 2 first. + admit. + admit. +rewrite /= -!deriveE /=. +rewrite !derivemx_derive /=. +Admitted. + +Lemma derive_rsubE (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Rsubmx (traj r)) : (fun r : K => Rsubmx (traj r))^`() z = Rsubmx ((traj^`())%classic z). +Proof. +apply/matrixP => i j. +rewrite !derive1E !deriveE ; last 2 first. + admit. + admit. +rewrite diff_comp ; last 2 first. + admit. + admit. +Admitted. + Lemma derive_zp1 (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : derive1mx zp1 z = (- alpha1 *: Lsubmx (traj z)). Proof. @@ -698,22 +724,22 @@ rewrite /zp1. move : dtraj. rewrite /is_solution /eqn33. move=> /(_ z). -rewrite /zp1 /=. move=> /(congr1 Lsubmx). rewrite row_mxKl. rewrite !derive1mxE' => <-. -rewrite !derive1E !deriveE; last 2 first. (* TODO LEMMA*) - admit. - admit. -apply/matrixP => i j. - admit. -Admitted. +apply: derive_lsubE. +Qed. Lemma derive_z2 (z : K) (traj : K -> 'rV_5%R.+1) (z2 := fun r => Rsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : - derive1mx z2 z = (* TODO LEMMA*) + derive1mx z2 z = (gamma *: (Rsubmx (traj z) - Lsubmx (traj z)) *m \S('e_2 - Rsubmx (traj z)) ^+ 2). Proof. -Admitted. +rewrite /z2; move: dtraj; rewrite /is_solution /eqn33; move => /(_ z). +move => /(congr1 Rsubmx). +rewrite row_mxKr. +rewrite !derive1mxE' => <-. +apply: derive_rsubE. +Qed. Lemma derive_V1dot (c1 := (2^-1 / alpha1)) (c2 := (2^-1 / gamma)) (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) (z2 := fun r => Rsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) From 0556c4962fabfb629a6531d07ef9e25650a91af3 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 18 Jul 2025 15:17:47 +0900 Subject: [PATCH 023/144] upd --- tilt.v | 66 ++++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 46 insertions(+), 20 deletions(-) diff --git a/tilt.v b/tilt.v index 43a78143..e2a90d79 100644 --- a/tilt.v +++ b/tilt.v @@ -12,15 +12,14 @@ Local Open Scope ring_scope. (* spin and matrix/norm properties*) Lemma sqr_spin_tr {R : realType} (u : 'rV[R]_3) : (\S(u) ^+ 2)^T = \S(u) ^+ 2. -Proof. apply/esym/eqP; rewrite -symE ; exact: sqr_spin_is_sym. Qed. +Proof. by apply/esym/eqP; rewrite -symE ; exact: sqr_spin_is_sym. Qed. Lemma tr_spin_mul {R : realType} (u : 'rV[R]_3) : u *m \S(u)^T = 0. Proof. by apply: trmx_inj ; rewrite trmx_mul trmxK spin_mul_tr trmx0. Qed. Lemma norm_spin {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v - u) ^+ 2 *m (u)^T) 0 0 = - norm (u *m \S(v)) ^+ 2. Proof. -rewrite spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !tr_spin_mul. -rewrite !addr0 -dotmulvv /dotmul trmx_mul. +rewrite spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !tr_spin_mul !addr0 -dotmulvv /dotmul trmx_mul. rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. by rewrite tr_spin mulNmx mulmxN [in RHS]mxE opprK mulmxA. @@ -32,7 +31,7 @@ Proof. by apply/eqP ; rewrite dotmulC dotmul_trmx -normalvv normal_sym tr_spin_m Lemma dotmulspin2 {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v)) *d u = 0. Proof. by apply/eqP ; rewrite -normalvv normal_sym spinE -normalmN (@lieC _ (vec3 R)) /= opprK crossmul_normal. Qed. -Lemma ortho {R : realType} (a : 'rV[R]_3) (b : 'rV[R]_3) : (a - b) *d (b *m \S(a))= 0. +Lemma ortho {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u - v) *d (v *m \S(u))= 0. Proof. by rewrite dotmulBl dotmulC dotmulspin1 dotmulC dotmulspin2 subr0. Qed. Lemma sqr_spin {R : realType} (u : 'rV[R]_3) (norm_u1 : norm u = 1) : \S(u) *m \S(u) = u^T *m u - 1%:M. @@ -40,13 +39,9 @@ Proof. have sqrspin : \S(u) ^+ 2 = u^T *m u - (norm u ^+ 2)%:A by rewrite sqr_spin. rewrite expr2 norm_u1 expr2 mulr1 in sqrspin. rewrite mulmxE sqrspin. - apply/matrixP => i j. - rewrite mxE /= [in RHS]mxE /=. - congr (_+_). - rewrite mxE mxE /= mul1r. - rewrite [in RHS]mxE [in RHS]mxE /= -mulNrn. - rewrite mxE -mulNrn. - by []. + apply/matrixP => i j ; rewrite mxE /= [in RHS]mxE /=. + congr (_+_); rewrite mxE mxE /= mul1r. + by rewrite [in RHS]mxE [in RHS]mxE /= -mulNrn mxE -mulNrn. Qed. Lemma norm_squared {R : realType} (n : nat) (u : 'rV[R]_n.+1) : (u *m (u)^T) 0 0 = norm (u) ^+2. @@ -452,7 +447,7 @@ Definition is_equilibrium_point p := is_solution (cst p). Definition equilibrium_points := [set p : T | is_equilibrium_point p]. Definition state_space := - [set p : T | exists y, is_solution y /\ p \in range y]. + [set p : T | exists y, is_solution y /\ exists t, p = y t]. End ode. @@ -579,16 +574,50 @@ gamma1 ⊆ state_space*) (* prouver invariance geometrique, tangence donc les trajectoires restent dans gamma1: state_space ⊆ gamma1 *) + +Lemma inv_Gamma1 p (p33 : state_space (fun a b => eqn33 b a) p) : + let y := sval (cid p33) in + let t := sval (cid ((svalP (cid p33)).2)) in + forall Delta, Delta >= 0 -> state_space (fun a b => eqn33 b a) (y (t + Delta)). +Proof. +case: p33 => /= y sol_y Delta Delta_ge0. +rewrite /state_space/=. +exists y; split=> //. + by case: sol_y. +case: cid => //= y' y'sol. +case: cid => t'/= pt'. + + + + +eexists. +Abort. + + + + + + + + + Lemma thm11a : state_space (fun a b => eqn33 b a) = Gamma1. Proof. -(* il existe une solution depuis tout point*) +(* toute solution de eqn33 est dans gamma +nagumo theorem *) apply/seteqP; split. - move=> p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. move=> [y0 [Heq Hrange]]. + move: Hrange. + move => exi. + case: exi. + move=> t. + move=> ->. + have Heqt := Heq t. + admit. -(* toute image d'une trajectoire est dans gamma -nagumo theorem *) +(* il existe une solution depuis tout point, cauchy lipschitz*) - move => p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. move => norme. @@ -767,13 +796,10 @@ Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution (fun a b => @eqn33 K alpha1 g Proof. move=> eqn33x. rewrite /V1. -rewrite [X in LieDerivative_jacobian1 X _ _](_ : _ = - (fun zp1_z2 : 'rV_6 => +rewrite [X in LieDerivative_jacobian1 X _ _](_ : _ = (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 / (2 * alpha1))%:M) + - (fun zp1_z2 : 'rV_6 => - (norm (Rsubmx zp1_z2) ^+ 2 / (2 * gamma))%:M) - ); last first. + (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 / (2 * gamma))%:M)); last first. apply/funext => y/=. rewrite fctE. by rewrite raddfD. From d580d49099778fc9f9f5e8934211949d6ce06df9 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Mon, 21 Jul 2025 17:52:17 +0900 Subject: [PATCH 024/144] proved derivative is equal to 0 + bureaucratie lsubmx/rsubmx --- tilt.v | 136 ++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 86 insertions(+), 50 deletions(-) diff --git a/tilt.v b/tilt.v index e2a90d79..0f36adda 100644 --- a/tilt.v +++ b/tilt.v @@ -134,6 +134,36 @@ apply: (@is_derive_inverse K (fun x => x ^+ 2)). Unshelve. all: by end_near. Qed. +Lemma derive1mx_rsubmx {R: realType} n m : + forall (f : R -> 'rV[R]_(n + m)) (t : R), + derive1mx (fun x => rsubmx (f x)) t = rsubmx (derive1mx f t). +Proof. + move=> f t. + rewrite /derive1mx. + rewrite -!derive1mx_matrix /=. + apply/matrixP => i j. + rewrite !mxE /=. + rewrite /rsubmx /=. + under eq_fun do rewrite mxE mxE. + symmetry. + by under eq_fun do rewrite mxE. +Qed. + +Lemma derive1mx_lsubmx {R: realType} n m : + forall (f : R -> 'rV[R]_(n + m)) (t : R), + derive1mx (fun x => lsubmx (f x)) t = lsubmx (derive1mx f t). +Proof. + move=> f t. + rewrite /derive1mx. + rewrite -!derive1mx_matrix /=. + apply/matrixP => i j. + rewrite !mxE /=. + rewrite /lsubmx /=. + under eq_fun do rewrite mxE mxE. + symmetry. + by under eq_fun do rewrite mxE. +Qed. + Lemma derive_sqrt {K : realType} (r : K) : 0 < r -> (Num.sqrt^`())%classic r = (2 * Num.sqrt r)^-1 :> K. Proof. @@ -586,21 +616,9 @@ exists y; split=> //. by case: sol_y. case: cid => //= y' y'sol. case: cid => t'/= pt'. - - - - eexists. Abort. - - - - - - - - Lemma thm11a : state_space (fun a b => eqn33 b a) = Gamma1. Proof. (* toute solution de eqn33 est dans gamma @@ -615,8 +633,59 @@ apply/seteqP; split. move=> t. move=> ->. have Heqt := Heq t. - + have : derive1(fun t=> ('e_2 - Rsubmx (y0 t)) *d (('e_2 - Rsubmx (y0 t)))) = 0. + transitivity (fun t => -2 * (Rsubmx(y0^`()%classic t) *d ('e_2 - Rsubmx (y0 t)))). + apply/funext => x. + rewrite -!derive1mxE' /= /dotmul. + under eq_fun do rewrite dotmulP /=. + rewrite dotmulP. + rewrite !mxE /= mulr1n. + under eq_fun do rewrite !mxE /= mulr1n. + rewrite !derive1mx_dotmul; last 2 first. + admit. + admit. + rewrite /dotmul /=. + rewrite !derive1mxE' /=. + rewrite [in RHS]mulr2n. + rewrite [RHS]mulNr. + rewrite [in RHS]mulrDl. + rewrite !mul1r. + rewrite !dotmulP /=. + rewrite dotmulC. + rewrite [in RHS]dotmulC. + rewrite !linearD /=. + rewrite -!derive1mxE'. + rewrite !mxE /= !mulr1n. + have -> : (derive1mx (fun x0 : K => 'e_2 - Rsubmx (y0 x0)) x) + = - (Rsubmx (derive1mx y0 x)). + rewrite derive1mxB /= ; last 2 first. + admit. + admit. + rewrite derive1mx_cst /= sub0r. + congr (-_). + apply derive1mx_rsubmx. + ring. + have : forall t, (Rsubmx (y0^`()%classic t) = (gamma *: (Rsubmx (y0 t) - Lsubmx (y0 t)) *m \S('e_2 - Rsubmx (y0 t)) ^+ 2)). + move => t0. + rewrite -derive1mxE'. + rewrite Heq. + by rewrite row_mxKr. + move => Rsu. + apply/funext => t0. + rewrite /dotmul. + transitivity (-2 * (gamma *: (Rsubmx (y0 t0) - Lsubmx (y0 t0)) *m \S('e_2 - Rsubmx (y0 t0)) ^+ 2 + *m ('e_2 - Rsubmx (y0 t0))^T) 0 0). + by rewrite Rsu /=. + rewrite !mulmxA. + apply/eqP. + rewrite mulf_eq0 /=. + rewrite oppr_eq0 ?pnatr_eq0 /=. + rewrite -!mulmxA. + rewrite spin_mul_tr. + by rewrite !mulmx0 mxE. + move => eq0. admit. + (* condition initiale?*) (* il existe une solution depuis tout point, cauchy lipschitz*) - move => p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. @@ -721,42 +790,12 @@ Definition V1dot (zp1_z2 : 'rV[K]_6) : K := - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. -Lemma derive_lsubE (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)): (fun r : K => Lsubmx (traj r))^`() z = Lsubmx ((traj^`())%classic z). -Proof. -apply/matrixP => i j. -rewrite !derive1E. -rewrite !deriveE ; last 2 first. - admit. - admit. -rewrite diff_comp ; last 2 first. - admit. - admit. -rewrite /= -!deriveE /=. -rewrite !derivemx_derive /=. -Admitted. - -Lemma derive_rsubE (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Rsubmx (traj r)) : (fun r : K => Rsubmx (traj r))^`() z = Rsubmx ((traj^`())%classic z). -Proof. -apply/matrixP => i j. -rewrite !derive1E !deriveE ; last 2 first. - admit. - admit. -rewrite diff_comp ; last 2 first. - admit. - admit. -Admitted. - Lemma derive_zp1 (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : derive1mx zp1 z = (- alpha1 *: Lsubmx (traj z)). Proof. -rewrite /zp1. -move : dtraj. -rewrite /is_solution /eqn33. -move=> /(_ z). +rewrite /zp1; move : dtraj ; rewrite /is_solution /eqn33 ; move=> /(_ z). move=> /(congr1 Lsubmx). -rewrite row_mxKl. -rewrite !derive1mxE' => <-. -apply: derive_lsubE. +rewrite row_mxKl ; move => bla ; by rewrite derive1mx_lsubmx. Qed. Lemma derive_z2 (z : K) (traj : K -> 'rV_5%R.+1) (z2 := fun r => Rsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : @@ -764,10 +803,8 @@ Lemma derive_z2 (z : K) (traj : K -> 'rV_5%R.+1) (z2 := fun r => Rsubmx (traj r (gamma *: (Rsubmx (traj z) - Lsubmx (traj z)) *m \S('e_2 - Rsubmx (traj z)) ^+ 2). Proof. rewrite /z2; move: dtraj; rewrite /is_solution /eqn33; move => /(_ z). -move => /(congr1 Rsubmx). -rewrite row_mxKr. -rewrite !derive1mxE' => <-. -apply: derive_rsubE. +move => /(congr1 Rsubmx); rewrite row_mxKr; move => bla. +by rewrite derive1mx_rsubmx. Qed. Lemma derive_V1dot (c1 := (2^-1 / alpha1)) (c2 := (2^-1 / gamma)) (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) @@ -921,7 +958,6 @@ rewrite -(thm11a gamma_gt0 alpha1_gt0 ). rewrite /state_space/=. exists traj. split => //. - rewrite inE/=. by exists t. Qed. From f4647c433a91b8739ee0c8cba7b2c0974478f86c Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Tue, 22 Jul 2025 14:37:45 +0900 Subject: [PATCH 025/144] upd --- tilt.v | 53 +++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 45 insertions(+), 8 deletions(-) diff --git a/tilt.v b/tilt.v index 0f36adda..19c21eb7 100644 --- a/tilt.v +++ b/tilt.v @@ -336,17 +336,17 @@ Qed. Local Open Scope classical_set_scope. Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : - (2^-1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() t = - (fun t => (derive1mx u t *m (u t)^T)``_0) t :> K. + (1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() t = + 2*(fun t => (derive1mx u t *m (u t)^T)``_0) t :> K. Proof. rewrite [LHS]derive1E deriveMl/=; last first. admit. -rewrite -derive1E. +rewrite -derive1E mul1r. under eq_fun do rewrite -dotmulvv. rewrite dotmulP mxE /= mulr1n derive1mx_dotmul ; last 2 first. admit. admit. -rewrite [X in _ * (_ + X) = _]dotmulC. +rewrite dotmulC. by field. Admitted. @@ -440,7 +440,7 @@ rewrite -scalemxAl [X in _ -> _ = X]mxE. move => <-. rewrite derive1Ml; last first. admit. -rewrite mulrA divff // ?pnatr_eq0 // mul1r. +rewrite mul1r. rewrite !mxE. rewrite derive1E. transitivity ( ('D_(derive1mx x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). @@ -683,9 +683,46 @@ apply/seteqP; split. rewrite -!mulmxA. rewrite spin_mul_tr. by rewrite !mulmx0 mxE. - move => eq0. - admit. - (* condition initiale?*) + under eq_fun do rewrite dotmulvv /=. + move => h. + (*move/eqP in eq0; exact: eq0. + have eq0_final : ('e_2 - Rsubmx (y0 t)) *d (- Rsubmx (derive1mx y0 t)) = 0. + rewrite -derive1mx_rsubmx. + rewrite derive1mxB in eq02 ; last 2 first. + admit. + admit. + rewrite derive1mx_cst /= sub0r in eq02 ; exact eq02. + rewrite Heqt row_mxKr /= in eq0_final. + have etc : gamma * (('e_2 - Rsubmx (y0 t)) *d ((Rsubmx (y0 t) - Lsubmx (y0 t)) *m \S('e_2 - Rsubmx (y0 t)) ^+ 2)) = 0. + rewrite dotmulvN in eq0_final. + move/eqP in eq0_final. + rewrite oppr_eq0 in eq0_final. + rewrite -scalemxAl /= in eq0_final. + rewrite dotmulvZ in eq0_final. + move/eqP in eq0_final; exact eq0_final. + have orth : ('e_2 - Rsubmx (y0 t)) *d ((Rsubmx (y0 t) - Lsubmx (y0 t)) *m \S('e_2 - Rsubmx (y0 t)) ^+ 2) = 0. + move/eqP in etc. + rewrite mulrI_eq0 // in etc. + move/eqP in etc; exact etc. + admit.*) + have y0_init : y0 0 \in Gamma1. + admit. + have norm_constant : norm ('e_2 - Rsubmx (y0 t)) = norm ('e_2 - Rsubmx (y0 0)). + have h_at_t : ((fun x : K => norm ('e_2 - Rsubmx (y0 x)) ^+ 2)^`())%classic t = 0. + by rewrite h. + move: h_at_t. + under eq_fun do rewrite -dotmulvv. + rewrite derive1mx_dotmul/= ; last 2 first. + admit. + admit. + rewrite dotmulC -mulr2n. + move=> etc. + move/eqP in etc. + rewrite mulrn_eq0 /= in etc. + admit. + rewrite norm_constant. + move: y0_init. + by rewrite inE /= => ->. (* il existe une solution depuis tout point, cauchy lipschitz*) - move => p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. From a0fda5431bef5e3a6005afbffdba50ef28b935ff Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Tue, 22 Jul 2025 16:49:56 +0900 Subject: [PATCH 026/144] proved first implication of thm11a --- tilt.v | 81 ++++++++++++++++++++++++++++++---------------------------- 1 file changed, 42 insertions(+), 39 deletions(-) diff --git a/tilt.v b/tilt.v index 19c21eb7..04316df4 100644 --- a/tilt.v +++ b/tilt.v @@ -2,7 +2,7 @@ From mathcomp Require Import all_ssreflect all_algebra ring. From mathcomp Require Import boolp classical_sets functions reals. From mathcomp Require Import topology normedtype derive. Require Import ssr_ext euclidean rigid frame skew derive_matrix. - +Require Import lasalle pendulum. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -291,13 +291,29 @@ Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_ Section derive_help. Local Open Scope classical_set_scope. +Lemma derivemx_derive1 {R : realFieldType} m n + (f : R -> 'M[R]_(m.+1, n.+1)) (x0 : R) (i : 'I_m.+1) (j : 'I_n.+1) : + 'D_1 f x0 i j = 'D_1 (fun x => f x i j) x0. +Proof. +rewrite /=. +rewrite -!derive1E. +rewrite (_ : (fun x => f x i j) = (fun M : 'M_(m.+1,n.+1) => M i j) \o f ) //. +Admitted. + Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n (f : V -> 'M[R]_(m.+1, n.+1)) (x0 : V) (v : V) (i : 'I_m.+1) (j : 'I_n.+1) : 'D_v f x0 i j = 'D_v (fun x => f x i j) x0. Proof. -apply/esym/cvg_lim => //=. -apply/cvgrPdist_le => /= e e0. -near=> t. +rewrite !deriveE; last 2 first. + admit. + admit. +rewrite (_ : (fun x : V => f x i j) = (fun M : 'M_(m.+1,n.+1) => M i j) \o f ). +rewrite [in RHS]diff_comp ; last 2 first. + admit. + admit. +rewrite /=. +From mathcomp Require Import landau. +under eq_fun do rewrite /=. Admitted. Local Close Scope classical_set_scope. @@ -685,44 +701,31 @@ apply/seteqP; split. by rewrite !mulmx0 mxE. under eq_fun do rewrite dotmulvv /=. move => h. - (*move/eqP in eq0; exact: eq0. - have eq0_final : ('e_2 - Rsubmx (y0 t)) *d (- Rsubmx (derive1mx y0 t)) = 0. - rewrite -derive1mx_rsubmx. - rewrite derive1mxB in eq02 ; last 2 first. - admit. - admit. - rewrite derive1mx_cst /= sub0r in eq02 ; exact eq02. - rewrite Heqt row_mxKr /= in eq0_final. - have etc : gamma * (('e_2 - Rsubmx (y0 t)) *d ((Rsubmx (y0 t) - Lsubmx (y0 t)) *m \S('e_2 - Rsubmx (y0 t)) ^+ 2)) = 0. - rewrite dotmulvN in eq0_final. - move/eqP in eq0_final. - rewrite oppr_eq0 in eq0_final. - rewrite -scalemxAl /= in eq0_final. - rewrite dotmulvZ in eq0_final. - move/eqP in eq0_final; exact eq0_final. - have orth : ('e_2 - Rsubmx (y0 t)) *d ((Rsubmx (y0 t) - Lsubmx (y0 t)) *m \S('e_2 - Rsubmx (y0 t)) ^+ 2) = 0. - move/eqP in etc. - rewrite mulrI_eq0 // in etc. - move/eqP in etc; exact etc. - admit.*) have y0_init : y0 0 \in Gamma1. admit. - have norm_constant : norm ('e_2 - Rsubmx (y0 t)) = norm ('e_2 - Rsubmx (y0 0)). - have h_at_t : ((fun x : K => norm ('e_2 - Rsubmx (y0 x)) ^+ 2)^`())%classic t = 0. - by rewrite h. - move: h_at_t. - under eq_fun do rewrite -dotmulvv. - rewrite derive1mx_dotmul/= ; last 2 first. - admit. - admit. - rewrite dotmulC -mulr2n. - move=> etc. - move/eqP in etc. - rewrite mulrn_eq0 /= in etc. - admit. - rewrite norm_constant. + have norm_constant : norm ('e_2 - Rsubmx (y0 t))^+2 = norm ('e_2 - Rsubmx (y0 0))^+2. + have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Rsubmx (y0 x)) ^+ 2) 0. + move => x0. + apply: DeriveDef. + admit. + by rewrite -derive1E h. + rewrite /=. + move/is_derive_0_is_cst. + move/ (_ _ 0). + move => s0. + by apply: s0. move: y0_init. - by rewrite inE /= => ->. + rewrite inE /Gamma1 /=. + move=> Hnorm0. (* reecrire ce charabia*) + rewrite Hnorm0 in norm_constant. + move: norm_constant. + move=> Hsq. + apply/eqP. + rewrite [RHS]expr2 mulr1 in Hsq. + move/eqP in Hsq. + rewrite sqrp_eq1 in Hsq ; last first. + exact: norm_ge0. + exact : Hsq. (* il existe une solution depuis tout point, cauchy lipschitz*) - move => p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. From 6fa42e7c270fbb59c0693f8612aff211a4bd241d Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Wed, 23 Jul 2025 13:49:07 +0900 Subject: [PATCH 027/144] preuve thm11a sans cauchy --- tilt.v | 211 +++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 137 insertions(+), 74 deletions(-) diff --git a/tilt.v b/tilt.v index 04316df4..aca654ea 100644 --- a/tilt.v +++ b/tilt.v @@ -366,6 +366,12 @@ rewrite dotmulC. by field. Admitted. +Lemma derive1mx_row_mx {R : realFieldType} {n : nat} {m : nat} : +forall (f : R -> 'rV[R]_(n + m)) (g : R -> 'rV[R]_(n + m)) (t : R), + derive1mx (fun x => row_mx (f x) (g x)) t = + row_mx (derive1mx f t) (derive1mx g t). +Admitted. + End derive_help. Section LieDerivative. @@ -650,87 +656,144 @@ apply/seteqP; split. move=> ->. have Heqt := Heq t. have : derive1(fun t=> ('e_2 - Rsubmx (y0 t)) *d (('e_2 - Rsubmx (y0 t)))) = 0. - transitivity (fun t => -2 * (Rsubmx(y0^`()%classic t) *d ('e_2 - Rsubmx (y0 t)))). - apply/funext => x. - rewrite -!derive1mxE' /= /dotmul. - under eq_fun do rewrite dotmulP /=. - rewrite dotmulP. - rewrite !mxE /= mulr1n. - under eq_fun do rewrite !mxE /= mulr1n. - rewrite !derive1mx_dotmul; last 2 first. - admit. - admit. - rewrite /dotmul /=. - rewrite !derive1mxE' /=. - rewrite [in RHS]mulr2n. - rewrite [RHS]mulNr. - rewrite [in RHS]mulrDl. - rewrite !mul1r. - rewrite !dotmulP /=. - rewrite dotmulC. - rewrite [in RHS]dotmulC. - rewrite !linearD /=. - rewrite -!derive1mxE'. - rewrite !mxE /= !mulr1n. - have -> : (derive1mx (fun x0 : K => 'e_2 - Rsubmx (y0 x0)) x) + transitivity (fun t => -2 * (Rsubmx(y0^`()%classic t) *d ('e_2 - Rsubmx (y0 t)))). + apply/funext => x. + rewrite -!derive1mxE' /= /dotmul. + under eq_fun do rewrite dotmulP /=. + rewrite dotmulP. + rewrite !mxE /= mulr1n. + under eq_fun do rewrite !mxE /= mulr1n. + rewrite !derive1mx_dotmul; last 2 first. + admit. + admit. + rewrite /dotmul /= !derive1mxE' /= [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. + rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. + rewrite -!derive1mxE' !mxE /= !mulr1n. + have -> : (derive1mx (fun x0 : K => 'e_2 - Rsubmx (y0 x0)) x) = - (Rsubmx (derive1mx y0 x)). - rewrite derive1mxB /= ; last 2 first. - admit. - admit. - rewrite derive1mx_cst /= sub0r. - congr (-_). - apply derive1mx_rsubmx. - ring. - have : forall t, (Rsubmx (y0^`()%classic t) = (gamma *: (Rsubmx (y0 t) - Lsubmx (y0 t)) *m \S('e_2 - Rsubmx (y0 t)) ^+ 2)). - move => t0. - rewrite -derive1mxE'. - rewrite Heq. - by rewrite row_mxKr. - move => Rsu. - apply/funext => t0. - rewrite /dotmul. - transitivity (-2 * (gamma *: (Rsubmx (y0 t0) - Lsubmx (y0 t0)) *m \S('e_2 - Rsubmx (y0 t0)) ^+ 2 + rewrite derive1mxB /= ; last 2 first. + admit. + admit. + rewrite derive1mx_cst /= sub0r. + congr (-_). + apply derive1mx_rsubmx. + ring. + have : forall t, (Rsubmx (y0^`()%classic t) = (gamma *: (Rsubmx (y0 t) - Lsubmx (y0 t)) *m \S('e_2 - Rsubmx (y0 t)) ^+ 2)). + move => t0. + rewrite -derive1mxE'. + rewrite Heq. + by rewrite row_mxKr. + move => Rsu. + apply/funext => t0. + rewrite /dotmul. + transitivity (-2 * (gamma *: (Rsubmx (y0 t0) - Lsubmx (y0 t0)) *m \S('e_2 - Rsubmx (y0 t0)) ^+ 2 *m ('e_2 - Rsubmx (y0 t0))^T) 0 0). - by rewrite Rsu /=. - rewrite !mulmxA. - apply/eqP. - rewrite mulf_eq0 /=. - rewrite oppr_eq0 ?pnatr_eq0 /=. - rewrite -!mulmxA. - rewrite spin_mul_tr. - by rewrite !mulmx0 mxE. - under eq_fun do rewrite dotmulvv /=. - move => h. - have y0_init : y0 0 \in Gamma1. - admit. - have norm_constant : norm ('e_2 - Rsubmx (y0 t))^+2 = norm ('e_2 - Rsubmx (y0 0))^+2. - have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Rsubmx (y0 x)) ^+ 2) 0. - move => x0. - apply: DeriveDef. - admit. - by rewrite -derive1E h. - rewrite /=. - move/is_derive_0_is_cst. - move/ (_ _ 0). - move => s0. - by apply: s0. - move: y0_init. - rewrite inE /Gamma1 /=. - move=> Hnorm0. (* reecrire ce charabia*) - rewrite Hnorm0 in norm_constant. - move: norm_constant. - move=> Hsq. - apply/eqP. - rewrite [RHS]expr2 mulr1 in Hsq. - move/eqP in Hsq. - rewrite sqrp_eq1 in Hsq ; last first. - exact: norm_ge0. - exact : Hsq. + by rewrite Rsu /=. + rewrite !mulmxA. + apply/eqP. + rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. + by rewrite !mulmx0 mxE. + under eq_fun do rewrite dotmulvv /=. + move => h. + have y0_init : y0 0 \in Gamma1. (* TODO general hypothesis*) + admit. + have norm_constant : norm ('e_2 - Rsubmx (y0 t))^+2 = norm ('e_2 - Rsubmx (y0 0))^+2. + have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Rsubmx (y0 x)) ^+ 2) 0. + move => x0. + apply: DeriveDef. + admit. + by rewrite -derive1E h. + rewrite /=. + move/is_derive_0_is_cst. + move/ (_ _ 0). + move => s0. + by apply: s0. + move: y0_init. + rewrite inE /Gamma1 /=. + move=> Hnorm0. (* reecrire ce charabia*) + rewrite Hnorm0 in norm_constant. + move: norm_constant. + move=> Hsq. + apply/eqP. + rewrite [RHS]expr2 mulr1 in Hsq. + move/eqP in Hsq. + rewrite sqrp_eq1 in Hsq ; last first. + exact: norm_ge0. + exact : Hsq. (* il existe une solution depuis tout point, cauchy lipschitz*) - move => p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. move => norme. + eexists. + split. + move=> t. + apply/matrixP => i j. + have [i_lt | i_ge] := ltnP i 3. + set y := fun t : K => + row_mx (expR (- alpha1 * t) *: Lsubmx p) + ('e_2 + expR (- gamma * t) *: (Rsubmx p - 'e_2)). + have D_y : forall t, derive1mx y t = + row_mx (- alpha1 *: Lsubmx (y t)) + (gamma *: (Rsubmx (y t) - Lsubmx (y t)) *m \S('e_2 - Rsubmx (y t)) ^+ 2). + move => t0. + rewrite /y /= !row_mxKl !row_mxKr. + set f := fun t1 : K => row_mx (expR (- alpha1 * t1) *: Lsubmx p) + ('e_2 + expR (- gamma * t1) *: (Rsubmx p - 'e_2)). + have -> : derive1mx f t0 = + row_mx (derive1mx (fun t => expR (- alpha1 * t) *: Lsubmx p) t0) + (derive1mx (fun t => 'e_2 + expR (- gamma * t) *: (Rsubmx p - 'e_2)) t0). + admit. + rewrite !derive1mxD. + Search derive1mx. + Search (_ *: _) (_*m_). + under eq_fun do rewrite -!mul_mx_scalar. + rewrite !derive1mxM /=. + rewrite !derive1mx_lsubmx /=. + Search row_mx lsubmx. + Search expR. + have -> : derive1mx (fun t1 : K => (expR (- alpha1 * t1))%:M) = + (fun t1 => (- alpha1) *: (expR (- alpha1 * t1))%:M). + admit. + rewrite !derive1mx_cst /= lsubmx_const /= !mul0mx !add0r. + rewrite -[in RHS]mul_mx_scalar -[in RHS]mul_mx_scalar/=. + congr(row_mx). + by rewrite -mul_mx_scalar /= mulmxA. + under eq_fun do rewrite -mul_scalar_mx. + have -> : derive1mx (fun x : K => (expR (- gamma * x))%:M *m (Rsubmx p - 'e_2 )) = + (fun x => (- gamma ) *: (expR (- gamma * x))%:M *m (Rsubmx p - 'e_2)). + admit. + Search ( \S(_) ^+2). + rewrite skew.sqr_spin /=. + admit. + admit. + admit. + admit. + admit. + instantiate (1 := fun t : K => + row_mx (expR (- alpha1 * t) *: Lsubmx p) + ('e_2 + expR (- gamma * t) *: (Rsubmx p - 'e_2))). + rewrite /=. + rewrite !row_mxKl !row_mxKr. + rewrite -/y. + rewrite D_y. + rewrite /y /=. + by rewrite !row_mxKl !row_mxKr. + rewrite /= !row_mxKl !row_mxKr. + pose y := fun t : K => + row_mx (expR (- alpha1 * t) *: Lsubmx p) + ('e_2 + expR (- gamma * t) *: (Rsubmx p - 'e_2)). + have D_y : forall t, derive1mx y t = + row_mx (- alpha1 *: Lsubmx (y t)) + (gamma *: (Rsubmx (y t) - Lsubmx (y t)) *m \S('e_2 - Rsubmx (y t)) ^+ 2). + move => t0. + admit. + by rewrite /y D_y !row_mxKl !row_mxKr. + exists 0. + rewrite !mulr0 expR0 !scale1r addrA. + transitivity ( row_mx (Lsubmx p) (Rsubmx p )); last first. + admit. + by rewrite hsubmxK. Admitted. Definition point1 : 'rV[K]_6 := 0. From d86dce13fc65ca0f9366f715304de2b80a80baa7 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 23 Jul 2025 19:51:04 +0900 Subject: [PATCH 028/144] cleaning --- tilt.v | 936 +++++++++++++++++++++++++-------------------------------- 1 file changed, 416 insertions(+), 520 deletions(-) diff --git a/tilt.v b/tilt.v index aca654ea..2b26dc4e 100644 --- a/tilt.v +++ b/tilt.v @@ -1,8 +1,9 @@ + From mathcomp Require Import all_ssreflect all_algebra ring. From mathcomp Require Import boolp classical_sets functions reals. From mathcomp Require Import topology normedtype derive. Require Import ssr_ext euclidean rigid frame skew derive_matrix. -Require Import lasalle pendulum. +(*Require Import lasalle pendulum.*) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -10,7 +11,7 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. -(* spin and matrix/norm properties*) +(* spin and matrix/norm properties*) Lemma sqr_spin_tr {R : realType} (u : 'rV[R]_3) : (\S(u) ^+ 2)^T = \S(u) ^+ 2. Proof. by apply/esym/eqP; rewrite -symE ; exact: sqr_spin_is_sym. Qed. @@ -23,7 +24,7 @@ rewrite spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !tr_spin_mul !addr0 -dotmul rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. by rewrite tr_spin mulNmx mulmxN [in RHS]mxE opprK mulmxA. -Qed. +Qed. Lemma dotmulspin1 {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v)) *d v = 0. Proof. by apply/eqP ; rewrite dotmulC dotmul_trmx -normalvv normal_sym tr_spin_mul normalvv dotmulv0. Qed. @@ -81,19 +82,22 @@ Proof. by apply/matrixP => i j; rewrite !mxE. Qed. From mathcomp Require Import sequences exp realfun. (* is it really interesting to generalize is_deriveX ?).*) -Lemma derive1_powR {K : realType} (r : K) : 1 < r -> (fun a => if a == 0 then 0 else a `^ r)^`()%classic = (fun x => if x == 0 then 0 else r * x `^ (r - 1)). +Lemma derive1_powR {K : realType} (r : K) : 1 < r -> + (fun a => if a == 0 then 0 else a `^ r)^`()%classic = + (fun x => if x == 0 then 0 else r * x `^ (r - 1)). Proof. rewrite /powR /=. move => r1. -apply/funext => x. +apply/funext => x/=. case: (x == 0) => [|]. -rewrite derive1E. -apply: derive_val. -have: is_derive (0 : K) (1 : K) (fun a => if a == 0 then 0 else a `^ r) 0. -rewrite /=. -Admitted. + rewrite derive1E. + apply: derive_val. + have: is_derive (0 : K) (1 : K) (fun a => if a == 0 then 0 else a `^ r) 0. + rewrite /=. +Abort. -Global Instance is_derive1_sqrt {K : realType} (x : K) : 0 < x -> is_derive x 1 Num.sqrt (2 * Num.sqrt x)^-1. +Global Instance is_derive1_sqrt {K : realType} (x : K) : 0 < x -> + is_derive x 1 Num.sqrt (2 * Num.sqrt x)^-1. Proof. move=> x_gt0. have sqrtK : {in Num.pos, cancel (@Num.sqrt K) (fun x => x ^+ 2)}. @@ -131,37 +135,37 @@ apply: (@is_derive_inverse K (fun x => x ^+ 2)). exact: exprn_derivable (* TODO: renaming *). by rewrite exp_derive (* TODO: renaming -> issue *) expr1 scaler1. - by rewrite mulf_neq0 ?pnatr_eq0// gt_eqF// sqrtr_gt0 exprn_gt0// sqrtr_gt0. -Unshelve. all: by end_near. +Unshelve. all: by end_near. Qed. Lemma derive1mx_rsubmx {R: realType} n m : forall (f : R -> 'rV[R]_(n + m)) (t : R), derive1mx (fun x => rsubmx (f x)) t = rsubmx (derive1mx f t). Proof. - move=> f t. - rewrite /derive1mx. - rewrite -!derive1mx_matrix /=. - apply/matrixP => i j. - rewrite !mxE /=. - rewrite /rsubmx /=. - under eq_fun do rewrite mxE mxE. - symmetry. - by under eq_fun do rewrite mxE. +move=> f t. +rewrite /derive1mx. +rewrite -!derive1mx_matrix /=. +apply/matrixP => i j. +rewrite !mxE /=. +rewrite /rsubmx /=. +under eq_fun do rewrite mxE mxE. +symmetry. +by under eq_fun do rewrite mxE. Qed. Lemma derive1mx_lsubmx {R: realType} n m : forall (f : R -> 'rV[R]_(n + m)) (t : R), derive1mx (fun x => lsubmx (f x)) t = lsubmx (derive1mx f t). Proof. - move=> f t. - rewrite /derive1mx. - rewrite -!derive1mx_matrix /=. - apply/matrixP => i j. - rewrite !mxE /=. - rewrite /lsubmx /=. - under eq_fun do rewrite mxE mxE. - symmetry. - by under eq_fun do rewrite mxE. +move=> f t. +rewrite /derive1mx. +rewrite -!derive1mx_matrix /=. +apply/matrixP => i j. +rewrite !mxE /=. +rewrite /lsubmx /=. +under eq_fun do rewrite mxE mxE. +symmetry. +by under eq_fun do rewrite mxE. Qed. Lemma derive_sqrt {K : realType} (r : K) : 0 < r -> @@ -176,7 +180,7 @@ Qed. Definition defposmx {R : realType} m (mat : 'M[R]_(m,m)) : Prop := mat \is sym m R /\ forall a : R, eigenvalue mat a -> a > 0. -Lemma defposmxP {R : realType} m (mat : 'M[R]_(m,m)) : +Lemma defposmxP {R : realType} m (mat : 'M[R]_(m,m)) : defposmx mat <-> (forall x : 'rV[R]_m, x != 0 -> (x *m mat *m x^T) 0 0 > 0). Proof. split. @@ -193,20 +197,18 @@ split. (* theoreme spectral?*) Admitted. -Lemma CauchySchwarz_vec {R : realType} {n : nat} : forall (a b : 'rV[R]_n.+1), (a *d b)^+2 <= (a *d a) * (b *d b). +Lemma CauchySchwarz_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : + (a *d b)^+2 <= (a *d a) * (b *d b). Proof. -move => a b. suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. rewrite -subr_ge0. - move => h. - rewrite mulrC in h. - apply h. + rewrite mulrC. + exact. rewrite subr_ge0 expr2 mulrC !dotmulvv /= -expr2. -case: (boolP (b == 0)) => [/eqP b0|hb]. - rewrite b0. +have [->|hb] := eqVneq b 0. rewrite dotmulv0 expr0n. rewrite norm0. - rewrite expr0n // /=. + rewrite expr0n //=. by rewrite mul0r. pose t := (a *d b) / (norm b ^+ 2). have h : 0 <= norm (a - t *: b) ^+ 2. @@ -226,9 +228,9 @@ have h1 : 0 <= a *d a - (a *d b) ^+ 2 / norm b ^+ 2. by rewrite sqrf_eq0 norm_eq0. by rewrite subrr subr0 !expr2 mulrAC. have h2 : 0 <= norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. - have pos: 0 < norm b ^+ 2. + have pos: 0 < norm b ^+ 2. by rewrite exprn_gt0 // norm_gt0. - suff: norm b ^+ 2 * (a *d a - (a *d b) ^+ 2 / norm b ^+ 2) = + suff: norm b ^+ 2 * (a *d a - (a *d b) ^+ 2 / norm b ^+ 2) = norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. move=> eq_step. rewrite -eq_step. @@ -240,11 +242,11 @@ rewrite -subr_ge0 mulrC. by rewrite dotmulvv mulrC in h2. Qed. -Lemma young_inequality_vec {R : realType} {n : nat} : forall (a b : 'rV[R]_n.+1), - (a *d b) <= (2^-1 * (norm(a))^+2) + (2^-1 * (norm(b))^+2). +(* not used *) +Lemma young_inequality_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : + (a *d b) <= (2^-1 * (norm a)^+2) + (2^-1 * (norm b)^+2). Proof. -move => a b. -have normage0 : 0 <= (norm(a))^+2. +have normage0 : 0 <= (norm a)^+2. rewrite expr2. by rewrite mulr_ge0 // norm_ge0. have normbge0 : 0 <= (norm(b))^+2. @@ -317,20 +319,20 @@ under eq_fun do rewrite /=. Admitted. Local Close Scope classical_set_scope. -Lemma derive1mxE' {R : realFieldType} {n : nat} (M : R -> 'rV[R]_n.+1) t : +Lemma derive1mxE' {R : realFieldType} {m n} (M : R -> 'M[R]_(m.+1, n.+1)) t : derive1mx M t = M^`()%classic t. Proof. -apply/rowP => i. +apply/matrixP => j i. by rewrite /derive1mx !mxE !derive1E derivemx_derive. Qed. -Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1) +Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) (i : 'I_n.+1) : - partial (fun x => (f x) 0 0) a i = - ('D_'e_i (fun x : 'rV[R]_n.+1 => (f x) : 'rV[R]_1) a) 0 0. + partial f a i = ('D_'e_i (@scalar_mx _ 1 \o f) a) 0 0. Proof. rewrite derivemx_derive/= /partial /derive /=. -by under eq_fun do rewrite (addrC a). +under eq_fun do rewrite (addrC a). +by under [in RHS]eq_fun do rewrite !mxE/= !mulr1n. Qed. Lemma gradient_partial_sum {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : @@ -376,81 +378,83 @@ End derive_help. Section LieDerivative. -Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) - (a : R -> 'rV[R]_n.+1) (t : R) : R := - \sum_(i < n.+1) (partial V (a t) i * (derive1mx a t) ``_ i). - -Definition jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) := - jacobian f. +Definition jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> R) : 'rV_n.+1 -> 'cV_n.+1 := + jacobian (scalar_mx \o f). -Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> 'rV[R]_1) (a : 'rV[R]_n.+1): - gradient_partial (fun x : 'rV[R]_n.+1 => (f x) 0 0) a = (jacobian1 f a)^T. +Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1): + gradient_partial f a = (jacobian1 f a)^T. Proof. rewrite /jacobian1. apply/rowP => i. rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. admit. by rewrite partial_diff. -Admitted. +Abort. -Definition LieDerivative_jacobian1 {R : realType} n (V : 'rV[R]_n.+1 -> 'rV[R]_1) +Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) (x : R -> 'rV[R]_n.+1) (t : R) : R := - let xdot_t := derive1mx x t in - (jacobian1 V (x t))^T *d xdot_t. + (jacobian1 V (x t))^T *d derive1mx x t. -Lemma LieDerivative_jacobian1Ml {R : realType} n - (f : 'rV_n.+1 -> 'cV_1) (x : R -> 'rV_n.+1) (k : R) : - LieDerivative_jacobian1 (k *: f) x = k *: LieDerivative_jacobian1 f x. +Lemma LieDerivativeMl {R : realType} n (f : 'rV_n.+1 -> R) (x : R -> 'rV_n.+1) + (k : R) : + LieDerivative (k *: f) x = k *: LieDerivative f x. Proof. -rewrite /LieDerivative_jacobian1 /jacobian1 /jacobian. +rewrite /LieDerivative /jacobian1 /jacobian. rewrite !fctE. apply/funext => y. rewrite /dotmul. -rewrite [X in ((lin1_mx X )^T *m (derive1mx x y)^T) 0 0 = _](@diffZ R _ _ _ _ _ ); last first. +rewrite (_ : (fun x0 : 'rV_n.+1 => (k *: f x0)%:M) = k *: (fun x0 : 'rV_n.+1 => (f x0)%:M)); last first. + apply/funext => v //=. + rewrite fctE. + by rewrite scale_scalar_mx. +rewrite [X in ((lin1_mx X)^T *m (derive1mx x y)^T) 0 0 = _](@diffZ R _ _ _ _ _ ); last first. admit. -rewrite -!trmx_mul ( _ : lin1_mx (k \*: 'd f (x y)) = k *: lin1_mx ('d f (x y))); last first. +rewrite -!trmx_mul. +rewrite ( _ : lin1_mx (k \*: 'd _ _) = k *: lin1_mx ('d (fun x0 : 'rV_n.+1 => (f x0)%:M) (x y))); last first. apply/matrixP => i j. by rewrite !mxE. rewrite mxE [in RHS]mxE. by rewrite -scalemxAr mxE. Admitted. -Lemma LieDerivative_jacobian1D {K : realType} n - (f g : 'rV_n.+1 -> 'cV_1) (x : K -> 'rV_n.+1) : - LieDerivative_jacobian1 (f + g) x = - LieDerivative_jacobian1 f x + LieDerivative_jacobian1 g x. +Lemma LieDerivativeD {K : realType} n (f g : 'rV_n.+1 -> K) (x : K -> 'rV_n.+1) : + LieDerivative (f + g) x = LieDerivative f x + LieDerivative g x. Proof. -rewrite /LieDerivative_jacobian1 /jacobian1 !fctE /dotmul /jacobian. +rewrite /LieDerivative /jacobian1 !fctE /dotmul /jacobian. apply/funext => t. -rewrite [X in ((lin1_mx X )^T *m (derive1mx x t)^T) 0 0 = _ ](@diffD K _ _ f g (x t)) ; last 2 first. - admit. +rewrite (_ : (fun x0 : 'rV_n.+1 => (f x0 + g x0)%:M) = + (fun x0 : 'rV_n.+1 => (f x0)%:M) + (fun x0 : 'rV_n.+1 => (g x0)%:M)); last first. + apply/funext => v //=. + apply/matrixP => i j. + by rewrite !mxE mulrnDl. +rewrite [X in ((lin1_mx X )^T *m (derive1mx x t)^T) 0 0 = _ ](@diffD K _ _ _ _ (x t)) ; last 2 first. + admit. admit. rewrite -trmx_mul. -rewrite ( _ : lin1_mx ('d f (x t) \+ 'd g (x t)) = - lin1_mx ('d f (x t)) + lin1_mx ('d g (x t))); last first. +rewrite ( _ : lin1_mx ('d _ (x t) \+ 'd _ (x t)) = + lin1_mx ('d (@scalar_mx _ _ \o f) (x t)) + lin1_mx ('d (@scalar_mx _ _ \o g) (x t))); last first. apply/matrixP => i j. rewrite mxE [RHS]mxE // [in LHS] /= [LHS]mxE. - by congr (_+_); rewrite mxE. -rewrite [in LHS] mulmxDr /= mxE mxE. -by congr (_+_); + by congr +%R; rewrite mxE. +rewrite [in LHS] mulmxDr /= mxE mxE. by congr +%R; rewrite -trmx_mul [RHS]mxE. Admitted. -Lemma LieDerivative_jacobian1_eq0_equilibrium {K : realType} n - (f : 'rV_n.+1 -> 'cV_1) (x : K -> 'rV[K]_n.+1) (t : K) : - 'D_1 x t = 0 -> LieDerivative_jacobian1 f x t = 0. +Lemma LieDerivative_eq0_equilibrium {K : realType} n + (f : 'rV_n.+1 -> K) (x : K -> 'rV[K]_n.+1) (t : K) : + 'D_1 x t = 0 -> LieDerivative f x t = 0. Proof. move => dtraj. -rewrite /LieDerivative_jacobian1 /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. +rewrite /LieDerivative /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. by rewrite derive1mxE' /= mxE mxE /= derive1E dtraj mul0mx /= mxE /=. Qed. -Lemma LieDerivative_jacobian1_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) +Lemma LieDerivative_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) (x : K -> 'rV[K]_6) (t : K) : - LieDerivative_jacobian1 (fun y => ((norm (f y)) ^+ 2)%:M) x t = + LieDerivative (fun y => (norm (f y)) ^+ 2) x t = (2%:R *: derive1mx (f \o x) t *m (f (x t))^T) 0 0. Proof. -rewrite /LieDerivative_jacobian1. +rewrite /LieDerivative. rewrite /jacobian1. rewrite /dotmul. rewrite -trmx_mul. @@ -475,7 +479,7 @@ rewrite deriveE ; last first. admit. transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). by []. -rewrite -diff_comp; last 2 first. +rewrite -diff_comp; last 2 first. admit. admit. rewrite deriveE //. @@ -484,15 +488,20 @@ Admitted. End LieDerivative. +(* not used, can be shown to be equivalent to LieDerivative *) +Definition LieDerivative_partial {R : realType} n (V : 'rV[R]_n.+1 -> R) + (a : R -> 'rV[R]_n.+1) (t : R) : R := + \sum_(i < n.+1) (partial V (a t) i * (derive1mx a t) ``_ i). + Section ode. -Context {K : realType}. -Let T := 'rV[K]_6. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. Local Open Scope classical_set_scope. -Variable f : K -> (K -> T) -> T. +Variable f : (K -> T) -> K -> T. Definition is_solution (x : K -> T) : Prop := - forall t, derive1mx x t = f t x. + forall t, derive1mx x t = f x t. Definition is_equilibrium_point p := is_solution (cst p). @@ -503,21 +512,19 @@ Definition state_space := End ode. -Definition is_lyapunov_candidate {K : realType} (n := 5) - (V : 'rV[K]_n.+1 -> 'rV[K]_1) - (x0 : 'rV[K]_n.+1) := - locposdef (fun z => (V z) 0 0) x0. +Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) + (x0 : 'rV[K]_n.+1) := locposdef V x0. -Definition eq_is_lyapunov_stable {K : realType} (n := 5) - (f : K -> (K -> 'rV[K]_n.+1) -> 'rV[K]_n.+1) - (V : 'rV[K]_n.+1 -> 'rV[K]_1) +Definition is_lyapunov_stable_at {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (V : 'rV[K]_n.+1 -> K) (x0 : 'rV[K]_n.+1) : Prop := [/\ is_equilibrium_point f x0, is_lyapunov_candidate V x0 & forall traj : K -> 'rV[K]_n.+1, is_solution f traj -> traj 0 = x0 -> - locnegsemidef (LieDerivative_jacobian1 V traj) 0]. + locnegsemidef (LieDerivative V traj) 0]. Local Close Scope classical_set_scope. @@ -603,7 +610,10 @@ Local Open Scope classical_set_scope. Definition Gamma1 := [set x : 'rV[K]_6 | norm ('e_2 - @rsubmx _ 1 3 3 x) = 1]. End Gamma1. - + +Local Notation Left := (@lsubmx _ 1 3 3). +Local Notation Right := (@rsubmx _ 1 3 3). + Section eqn33. Variable K : realType. Variable alpha1 : K. @@ -611,26 +621,23 @@ Variable gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Local Notation Lsubmx := (@lsubmx K 1 3 3). -Local Notation Rsubmx := (@rsubmx K 1 3 3). - -Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) t : 'rV[K]_6 := - let zp1_point := Lsubmx \o zp1_z2_point in - let z2_point := Rsubmx \o zp1_z2_point in - row_mx (- alpha1 *: zp1_point t) +Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := + let zp1_point := Left \o zp1_z2_point in + let z2_point := Right \o zp1_z2_point in + fun t => row_mx (- alpha1 *: zp1_point t) (gamma *: (z2_point t - zp1_point t) *m \S('e_2%:R - z2_point t) ^+ 2). -(* cauchy lipschitz par F1 qui definit un champ de vecteur lisse : +(* cauchy lipschitz par F1 qui definit un champ de vecteur lisse : il existe une solution depuis tout point: gamma1 ⊆ state_space*) (* prouver invariance geometrique, tangence donc les trajectoires restent dans gamma1: state_space ⊆ gamma1 *) -Lemma inv_Gamma1 p (p33 : state_space (fun a b => eqn33 b a) p) : +Lemma inv_Gamma1 p (p33 : state_space eqn33 p) : let y := sval (cid p33) in - let t := sval (cid ((svalP (cid p33)).2)) in - forall Delta, Delta >= 0 -> state_space (fun a b => eqn33 b a) (y (t + Delta)). + let t := sval (cid (svalP (cid p33)).2) in + forall Delta, Delta >= 0 -> state_space eqn33 (y (t + Delta)). Proof. case: p33 => /= y sol_y Delta Delta_ge0. rewrite /state_space/=. @@ -641,7 +648,7 @@ case: cid => t'/= pt'. eexists. Abort. -Lemma thm11a : state_space (fun a b => eqn33 b a) = Gamma1. +Lemma thm11a : state_space eqn33 = Gamma1. Proof. (* toute solution de eqn33 est dans gamma nagumo theorem *) @@ -655,8 +662,8 @@ apply/seteqP; split. move=> t. move=> ->. have Heqt := Heq t. - have : derive1(fun t=> ('e_2 - Rsubmx (y0 t)) *d (('e_2 - Rsubmx (y0 t)))) = 0. - transitivity (fun t => -2 * (Rsubmx(y0^`()%classic t) *d ('e_2 - Rsubmx (y0 t)))). + have : derive1(fun t=> ('e_2 - Right (y0 t)) *d (('e_2 - Right (y0 t)))) = 0. + transitivity (fun t => -2 * (Right(y0^`()%classic t) *d ('e_2 - Right (y0 t)))). apply/funext => x. rewrite -!derive1mxE' /= /dotmul. under eq_fun do rewrite dotmulP /=. @@ -669,8 +676,8 @@ apply/seteqP; split. rewrite /dotmul /= !derive1mxE' /= [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. rewrite -!derive1mxE' !mxE /= !mulr1n. - have -> : (derive1mx (fun x0 : K => 'e_2 - Rsubmx (y0 x0)) x) - = - (Rsubmx (derive1mx y0 x)). + have -> : (derive1mx (fun x0 : K => 'e_2 - Right (y0 x0)) x) + = - (Right (derive1mx y0 x)). rewrite derive1mxB /= ; last 2 first. admit. admit. @@ -678,7 +685,7 @@ apply/seteqP; split. congr (-_). apply derive1mx_rsubmx. ring. - have : forall t, (Rsubmx (y0^`()%classic t) = (gamma *: (Rsubmx (y0 t) - Lsubmx (y0 t)) *m \S('e_2 - Rsubmx (y0 t)) ^+ 2)). + have : forall t, (Right (y0^`()%classic t) = (gamma *: (Right (y0 t) - Left (y0 t)) *m \S('e_2 - Right (y0 t)) ^+ 2)). move => t0. rewrite -derive1mxE'. rewrite Heq. @@ -686,8 +693,8 @@ apply/seteqP; split. move => Rsu. apply/funext => t0. rewrite /dotmul. - transitivity (-2 * (gamma *: (Rsubmx (y0 t0) - Lsubmx (y0 t0)) *m \S('e_2 - Rsubmx (y0 t0)) ^+ 2 - *m ('e_2 - Rsubmx (y0 t0))^T) 0 0). + transitivity (-2 * (gamma *: (Right (y0 t0) - Left (y0 t0)) *m \S('e_2 - Right (y0 t0)) ^+ 2 + *m ('e_2 - Right (y0 t0))^T) 0 0). by rewrite Rsu /=. rewrite !mulmxA. apply/eqP. @@ -697,8 +704,8 @@ apply/seteqP; split. move => h. have y0_init : y0 0 \in Gamma1. (* TODO general hypothesis*) admit. - have norm_constant : norm ('e_2 - Rsubmx (y0 t))^+2 = norm ('e_2 - Rsubmx (y0 0))^+2. - have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Rsubmx (y0 x)) ^+ 2) 0. + have norm_constant : norm ('e_2 - Right (y0 t))^+2 = norm ('e_2 - Right (y0 0))^+2. + have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y0 x)) ^+ 2) 0. move => x0. apply: DeriveDef. admit. @@ -720,95 +727,70 @@ apply/seteqP; split. rewrite sqrp_eq1 in Hsq ; last first. exact: norm_ge0. exact : Hsq. -(* il existe une solution depuis tout point, cauchy lipschitz*) -- move => p. +(* il existe une solution depuis tout point, cauchy lipschitz*) +- move=> p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. - move => norme. - eexists. - split. - move=> t. - apply/matrixP => i j. - have [i_lt | i_ge] := ltnP i 3. - set y := fun t : K => - row_mx (expR (- alpha1 * t) *: Lsubmx p) - ('e_2 + expR (- gamma * t) *: (Rsubmx p - 'e_2)). + move=> norme. + pose y := fun t : K => row_mx (expR (- alpha1 * t) *: Left p) + ('e_2 + expR (- gamma * t) *: (Right p - 'e_2)). have D_y : forall t, derive1mx y t = - row_mx (- alpha1 *: Lsubmx (y t)) - (gamma *: (Rsubmx (y t) - Lsubmx (y t)) *m \S('e_2 - Rsubmx (y t)) ^+ 2). - move => t0. - rewrite /y /= !row_mxKl !row_mxKr. - set f := fun t1 : K => row_mx (expR (- alpha1 * t1) *: Lsubmx p) - ('e_2 + expR (- gamma * t1) *: (Rsubmx p - 'e_2)). - have -> : derive1mx f t0 = - row_mx (derive1mx (fun t => expR (- alpha1 * t) *: Lsubmx p) t0) - (derive1mx (fun t => 'e_2 + expR (- gamma * t) *: (Rsubmx p - 'e_2)) t0). - - admit. - rewrite !derive1mxD. - Search derive1mx. - Search (_ *: _) (_*m_). - under eq_fun do rewrite -!mul_mx_scalar. - rewrite !derive1mxM /=. - rewrite !derive1mx_lsubmx /=. - Search row_mx lsubmx. - Search expR. - have -> : derive1mx (fun t1 : K => (expR (- alpha1 * t1))%:M) = - (fun t1 => (- alpha1) *: (expR (- alpha1 * t1))%:M). - admit. - rewrite !derive1mx_cst /= lsubmx_const /= !mul0mx !add0r. - rewrite -[in RHS]mul_mx_scalar -[in RHS]mul_mx_scalar/=. - congr(row_mx). - by rewrite -mul_mx_scalar /= mulmxA. - under eq_fun do rewrite -mul_scalar_mx. - have -> : derive1mx (fun x : K => (expR (- gamma * x))%:M *m (Rsubmx p - 'e_2 )) = - (fun x => (- gamma ) *: (expR (- gamma * x))%:M *m (Rsubmx p - 'e_2)). - admit. - Search ( \S(_) ^+2). - rewrite skew.sqr_spin /=. - admit. - admit. - admit. - admit. - admit. - instantiate (1 := fun t : K => - row_mx (expR (- alpha1 * t) *: Lsubmx p) - ('e_2 + expR (- gamma * t) *: (Rsubmx p - 'e_2))). - rewrite /=. - rewrite !row_mxKl !row_mxKr. - rewrite -/y. - rewrite D_y. - rewrite /y /=. - by rewrite !row_mxKl !row_mxKr. - rewrite /= !row_mxKl !row_mxKr. - pose y := fun t : K => - row_mx (expR (- alpha1 * t) *: Lsubmx p) - ('e_2 + expR (- gamma * t) *: (Rsubmx p - 'e_2)). - have D_y : forall t, derive1mx y t = - row_mx (- alpha1 *: Lsubmx (y t)) - (gamma *: (Rsubmx (y t) - Lsubmx (y t)) *m \S('e_2 - Rsubmx (y t)) ^+ 2). - move => t0. + row_mx (- alpha1 *: Left (y t)) + (gamma *: (Right (y t) - Left (y t)) *m \S('e_2 - Right (y t)) ^+ 2). + move=> t0. + rewrite /y /= !row_mxKl !row_mxKr. + transitivity ( + row_mx (derive1mx (fun t1 => (expR (- alpha1 * t1) *: Left p)) t0) + (derive1mx (fun t1 => 'e_2 + expR (- gamma * t1) *: (Right p - 'e_2)) t0)). + admit. + congr row_mx. + under eq_fun do rewrite -!mul_mx_scalar. + rewrite !derive1mxM /=; last 2 first. + admit. + admit. + rewrite derive1mx_lsubmx. + rewrite derive1mx_cst. + rewrite lsubmx_const mul0mx add0r. + (* TODO: derive_comp *) + admit. + transitivity ((- gamma *: expR (- gamma * t0) *: (Right p - 'e_2))). + rewrite derive1mxD; last 2 first. + admit. + admit. + rewrite derive1mx_cst/= add0r. + admit. + rewrite opprD addrA subrr add0r. + rewrite spinN. + rewrite spinZ. + rewrite sqrrN. + rewrite exprZn. + rewrite (expr2 (\S(_))) -mulmxE. + rewrite sqr_spin//; last first. + admit. admit. - by rewrite /y D_y !row_mxKl !row_mxKr. + exists y; split. + move=> t; apply/matrixP => i j. + have /matrixP := D_y t. + exact. exists 0. - rewrite !mulr0 expR0 !scale1r addrA. - transitivity ( row_mx (Lsubmx p) (Rsubmx p )); last first. - admit. + rewrite /y !mulr0 expR0 !scale1r addrA. + transitivity (row_mx (Left p) (Right p )); last first. + by rewrite addrAC subrr add0r. by rewrite hsubmxK. Admitted. Definition point1 : 'rV[K]_6 := 0. -Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2%:R). +Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). -Lemma equilibrium_point1 : is_equilibrium_point (fun a b => eqn33 b a) point1. +Lemma equilibrium_point1 : is_equilibrium_point eqn33 point1. Proof. -move => t ; rewrite derive1mx_cst /eqn33 /point1 ; apply/eqP ; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. +move=> t ; rewrite derive1mx_cst /eqn33 /point ; apply/eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; by rewrite !mxE. apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. rewrite /N /=; apply /rowP; move => a; by rewrite !mxE subr0. move => n; by rewrite n scaler0 mul0mx. Qed. -Lemma equilibrium_point2 : is_equilibrium_point (fun a b => eqn33 b a) point2. +Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2. Proof. move => t; rewrite derive1mx_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). @@ -821,7 +803,7 @@ have N0 : N = 0. split. by rewrite scaler_eq0 N0 eqxx orbT. rewrite -scalemxAl scalemx_eq0 gt_eqF//=. -rewrite -[Lsubmx point2]/N N0 subr0. +rewrite -[Left point2]/N N0 subr0. set M := (X in X *m _); rewrite -/M. have ME : M = 2 *: 'e_2. apply/rowP => i; rewrite !mxE eqxx/=. @@ -837,19 +819,125 @@ Qed. Open Scope classical_set_scope. (* this lemma asks for lyapunov + lasalle*) -Lemma tractories_converge (y : K -> 'rV[K]_6) : is_solution (fun a b => eqn33 b a) y -> +Lemma tractories_converge (y : K -> 'rV[K]_6) : is_solution eqn33 y -> y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. Proof. move=> is_sol_y. Abort. End eqn33. +Arguments point1 {K}. Open Scope classical_set_scope. -Section Lyapunov. +(* technical section, skip on a first reading *) +Section u2. +Context {K : realType}. + +Definition u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) [eta (fun=> 0) with + (0,0) |-> 1, + (0,1) |-> -2^-1, + (1,0) |-> -2^-1, + (1,1) |-> 1] (i, j). + +Lemma u2neq0 : u2 != 0. +Proof. by apply/matrix0Pn; exists 1, 1; rewrite mxE /= oner_neq0. Qed. + +Lemma u2_sym : u2 \is sym 2 K. +Proof. +rewrite /= symE. +apply/eqP/matrixP. +move => i j. +rewrite !mxE/=. +case: ifPn => [/eqP[->{i} ->{j}//]|]. +case: ifPn => [/eqP[->{i} ->{j}//]|]. +case: ifPn => [/eqP[->{i} ->{j}//]|]. +case: ifPn => [/eqP[->{i} ->{j}//]|]. +by move: i j => [[|[|//]]] /= ? [[|[|]]]. +Qed. + +Lemma tr_u2 : \tr u2 = 2. +Proof. by rewrite /u2/= /mxtrace /= sum2E/= !mxE/=. Qed. + +Lemma det_u2 : \det u2 = 3/4. +Proof. by rewrite /u2 det_mx22 /= !mxE /=; field. Qed. + +Lemma defposmxu2 : defposmx u2. +Proof. +split; first exact: u2_sym. +move=> a. +move/eigenvalueP => [u] /[swap] u0 H. +have a_eigen : eigenvalue u2 a. + apply/eigenvalueP. + exists u. rewrite /u2. + exact: H. + exact: u0. +have : root (char_poly u2) a. + rewrite -eigenvalue_root_char. + exact : a_eigen. +rewrite char_poly2 tr_u2 det_u2 rootE => a_root . +have char_poly_fact : 'X^2 - 2%:P * 'X + (3/4)%:P = + ('X - (1%:R / 2)%:P) * ('X - (3%:R / 2)%:P) :> {poly K}. + rewrite mulrBr mulrBl -expr2 -!addrA; congr +%R. + rewrite mulrBl opprB addrCA addrC; congr +%R. + by rewrite -[RHS]polyCM; congr (_%:P); field. + rewrite [in RHS]mulrC -opprD -mulrDr mulrC; congr (- (_ * _)). + by rewrite -polyCD; congr (_%:P); by field. +move: a_root. +rewrite char_poly_fact hornerM !hornerXsubC. +by rewrite mulf_eq0 => /orP[|]; rewrite subr_eq0 => /eqP ->; rewrite divr_gt0. +Qed. + +End u2. + +Section V1. Local Open Scope classical_set_scope. +Context {K : realType}. +Variable alpha1 : K. +Variable gamma : K. +Hypothesis alpha1_gt0 : 0 < alpha1. +Hypothesis gamma_gt0 : 0 < gamma. + +Definition V1 (zp1_z2 : 'rV[K]_6) : K := + let zp1 := Left zp1_z2 in let z2 := Right zp1_z2 in + (norm zp1)^+2 / (2 * alpha1) + (norm z2)^+2 / (2 * gamma). +Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 point1. +Proof. +rewrite /locposdef; split. +- by rewrite /V1 /point1 lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. +- near=> z_near. + simpl in *. + have z_neq0 : z_near != 0 by near: z_near; exact: nbhs_dnbhs_neq. + rewrite /V1. + have /orP[lz0|rz0] : (Left z_near != 0) || (Right z_near != 0). + + rewrite -negb_and. + apply: contra z_neq0 => /andP[/eqP l0 /eqP r0]. + rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. + by apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; rewrite mxE. + + set rsub := Right z_near. + have : norm rsub >= 0 by rewrite norm_ge0. + set lsub := Left z_near. + move => nor. + have normlsub : norm lsub > 0 by rewrite norm_gt0. + rewrite ltr_pwDl//. + by rewrite divr_gt0 ?exprn_gt0// mulr_gt0. + by rewrite divr_ge0 ?exprn_ge0// mulr_ge0// ltW. + - rewrite ltr_pwDr//. + by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0// norm_gt0. + by rewrite divr_ge0 ?exprn_ge0 ?norm_ge0// mulr_ge0// ltW. +Unshelve. all: by end_near. Qed. + +Definition V1dot (zp1_z2 : 'rV[K]_6) : K := + let zp1 := Left zp1_z2 in + let z2 := Right zp1_z2 in + - (norm zp1)^+2 + (z2 *m (\S('e_2 - z2))^+2 *m z2^T + - z2 *m (\S('e_2 - z2))^+2 *m zp1^T)``_0. + +End V1. + +Section Lyapunov. +Local Open Scope classical_set_scope. Context {K : realType}. Variable x1_hat : K -> 'rV[K]_3. Variable x2_hat : K -> 'rV[K]_3. @@ -874,212 +962,90 @@ Definition x2_tilde t : 'rV[K]_3 := let x2_hat_t := x2_hat t in (x2_t - x2_hat_t). (* dependance des conditions intiales de ^x2 qui doit etre sur S2.*) -Local Notation Lsubmx := (@lsubmx K 1 3 3). -Local Notation Rsubmx := (@rsubmx K 1 3 3). - Definition zp1_z2_eq t (zp1_z2 : K -> 'rV[K]_6) : 'rV[K]_6 := - let zp1 := Lsubmx \o zp1_z2 in - let z2 := Rsubmx \o zp1_z2 in + let zp1 := Left \o zp1_z2 in + let z2 := Right \o zp1_z2 in row_mx (p1 t *m R t) (x2_tilde t *m R t). -Definition V1 (zp1_z2 : 'rV[K]_6) : 'rV[K]_1 := - let zp1 := Lsubmx zp1_z2 in - let z2 := Rsubmx zp1_z2 in - ((norm zp1)^+2 / (2%:R * alpha1) + (norm z2)^+2 / (2%:R * gamma))%:M. - -Definition V1dot (zp1_z2 : 'rV[K]_6) : K := - let zp1 := Lsubmx zp1_z2 in - let z2 := Rsubmx zp1_z2 in - - (norm zp1)^+2 + (z2 *m (\S('e_2%:R - z2))^+2 *m z2^T - - z2 *m (\S('e_2%:R - z2))^+2 *m zp1^T)``_0. - -Lemma derive_zp1 (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : - derive1mx zp1 z = (- alpha1 *: Lsubmx (traj z)). +Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : is_solution (eqn33 alpha1 gamma) traj -> + derive1mx (Left \o traj) z = - alpha1 *: Left (traj z). Proof. -rewrite /zp1; move : dtraj ; rewrite /is_solution /eqn33 ; move=> /(_ z). -move=> /(congr1 Lsubmx). -rewrite row_mxKl ; move => bla ; by rewrite derive1mx_lsubmx. +move=> /(_ z)/(congr1 Left). +by rewrite row_mxKl => ?; rewrite derive1mx_lsubmx. Qed. -Lemma derive_z2 (z : K) (traj : K -> 'rV_5%R.+1) (z2 := fun r => Rsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : - derive1mx z2 z = - (gamma *: (Rsubmx (traj z) - Lsubmx (traj z)) *m \S('e_2 - Rsubmx (traj z)) ^+ 2). +Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : is_solution (eqn33 alpha1 gamma) traj -> + derive1mx (Right \o traj) z = + gamma *: (Right (traj z) - Left (traj z)) *m \S('e_2 - Right (traj z)) ^+ 2. Proof. -rewrite /z2; move: dtraj; rewrite /is_solution /eqn33; move => /(_ z). -move => /(congr1 Rsubmx); rewrite row_mxKr; move => bla. -by rewrite derive1mx_rsubmx. +by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive1mx_rsubmx. Qed. -Lemma derive_V1dot (c1 := (2^-1 / alpha1)) (c2 := (2^-1 / gamma)) (z : K) (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) - (z2 := fun r => Rsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) - : c1 *: (2 *: derive1mx zp1 z *m (Lsubmx (traj z))^T) 0 0 + - c2 *: (2 *: derive1mx z2 z *m (Rsubmx (traj z))^T) 0 0 - = V1dot (traj z). +Let c1 := 2^-1 / alpha1. +Let c2 := 2^-1 / gamma. + +Lemma derive_V1dot (z : K) (traj : K -> 'rV_6) + (zp1 := Left \o traj) (z2 := Right \o traj) : + is_solution (eqn33 alpha1 gamma) traj -> + c1 *: (2 *: derive1mx zp1 z *m (Left (traj z))^T) 0 0 + + c2 *: (2 *: derive1mx z2 z *m (Right (traj z))^T) 0 0 + = V1dot (traj z). Proof. +move=> ?. rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC mulVf ?pnatr_eq0// div1r. rewrite derive_zp1 // -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)) mulrN mulVf ?gt_eqF// mulN1r. rewrite derive_z2 // -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE scalerA mulVf ?gt_eqF// scale1r. rewrite norm_squared /V1dot. congr +%R. -set Lmx := lsubmx _. -set Rmx := rsubmx _. rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK -[X in _ = (_ *m (X *m _)) 0 0]trmxK. -rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE -(mulmxA (Rmx - Lmx)) mulmxE -expr2. +rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE. +rewrite -(mulmxA (Right (traj z) - (Left (traj z)))) mulmxE -expr2. rewrite sqr_spin_tr. by rewrite mulmxA. Qed. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution (fun a b => @eqn33 K alpha1 gamma b a) x -> - LieDerivative_jacobian1 V1 x t = V1dot (x t). +Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution (eqn33 alpha1 gamma) x -> + LieDerivative (V1 alpha1 gamma) x t = V1dot (x t). Proof. move=> eqn33x. rewrite /V1. -rewrite [X in LieDerivative_jacobian1 X _ _](_ : _ = (fun zp1_z2 : 'rV_6 => - (norm (Lsubmx zp1_z2) ^+ 2 / (2 * alpha1))%:M) - + - (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 / (2 * gamma))%:M)); last first. - apply/funext => y/=. - rewrite fctE. - by rewrite raddfD. -rewrite LieDerivative_jacobian1D. +rewrite LieDerivativeD. rewrite !invfM /=. -set c1 := (2^-1 / alpha1). -set c2 := (2^-1 / gamma). -rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = - (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. - apply/funext => y. - by rewrite -scale_scalar_mx. -rewrite !fctE. -have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = - (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. -rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = - (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. - apply/funext => y. - by rewrite -scale_scalar_mx. -rewrite func_eq. -have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = - (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. -rewrite func_eq2 !LieDerivative_jacobian1Ml !fctE !LieDerivative_jacobian1_norm /=. -by rewrite derive_V1dot //. +rewrite fctE. +under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. +rewrite !LieDerivativeMl !fctE !LieDerivative_norm /=. +by rewrite derive_V1dot. Qed. -Lemma defposmxu2 ( u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) - [eta (fun=> 0) with (0,0) |-> 1, - (0,1) |-> -2^-1, - (1,0) |-> -2^-1, - (1,1) |-> 1] (i,j)): defposmx u2. +(* TODO: Section general properties of our system *) +Lemma Gamma1_traj (traj : K -> 'rV_6) t : + is_solution (eqn33 alpha1 gamma) traj -> Gamma1 (traj t). Proof. -rewrite /defposmx /u2. -split. - - rewrite /= symE. - apply/eqP/matrixP. - move => i j. - rewrite !mxE. - case: ifPn => [/eqP[->{i} ->{j}//]|]. - case: ifPn => [/eqP[->{i} ->{j}//]|]. - case: ifPn => [/eqP[->{i} ->{j}//]|]. - case: ifPn => [/eqP[->{i} ->{j}//]|]. - by move: i j => [[|[|//]]] /= ? [[|[|]]]. - - move=> a. - move/eigenvalueP => [u] /[swap] u0 H. - have a_eigen : eigenvalue u2 a. - apply/eigenvalueP. - exists u. rewrite /u2. - exact: H. exact: u0. - have a_root : root (char_poly u2) a. - rewrite -eigenvalue_root_char. - exact : a_eigen. - rewrite char_poly2 in a_root. - have tr_u2 : \tr u2 = 2. - rewrite /u2. - rewrite /= //. - rewrite /mxtrace /=. - by rewrite sum2E/= !mxE/=. - have det_u2 : \det u2 = 3/4. - rewrite /u2 det_mx22 /= !mxE /=. - by field. - rewrite tr_u2 det_u2 rootE in a_root. - have char_poly_fact : 'X^2 - 2%:P * 'X + (3/4)%:P = ('X - (1%:R / 2)%:P) * ('X - (3%:R / 2)%:P) :> {poly K}. - rewrite mulrBr mulrBl -expr2 -!addrA; congr +%R. - rewrite mulrBl opprB addrCA addrC; congr +%R. - by rewrite -[RHS]polyCM; congr (_%:P); by field. - rewrite [in RHS]mulrC -opprD -mulrDr mulrC; congr (- (_ * _)). - by rewrite -polyCD; congr (_%:P); by field. - rewrite char_poly_fact hornerM !hornerXsubC in a_root. - move: a_root. - rewrite mulf_eq0 => /orP [Ha1 | Ha2]. - rewrite subr_eq0 in Ha1. - move/eqP : Ha1 => Ha1. - by rewrite Ha1 divr_gt0. - rewrite subr_eq0 in Ha2. - move/eqP : Ha2 => Ha2. - rewrite Ha2. - by rewrite divr_gt0. +move=> ?. +rewrite -(thm11a gamma_gt0 alpha1_gt0). +exists traj; split => //. +by exists t. Qed. -Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 (point1 K). +Lemma norm_u1 (traj : K -> 'rV_6) (z : K) (z2 := Right \o traj) + (zp1 := Left \o traj) (u := 'e_2 - z2 z) : + is_solution (eqn33 alpha1 gamma) traj -> norm u = 1. Proof. -- rewrite /locposdef; split. - + by rewrite /V1 /point1 lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r mxE /=. - + near=> z_near. - simpl in *. - have z_neq0 : z_near != 0 by near: z_near; exact: nbhs_dnbhs_neq. - rewrite /V1. - have /orP[lz0|rz0] : (Lsubmx z_near != 0) || (Rsubmx z_near != 0). - rewrite -negb_and. - apply: contra z_neq0 => /andP[/eqP l0 /eqP r0]. - rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. - by apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; rewrite mxE. - + set rsub := Rsubmx z_near. - have : norm rsub >= 0 by rewrite norm_ge0. - set lsub := Lsubmx z_near. - move => nor. - have normlsub : norm lsub > 0 by rewrite norm_gt0. - rewrite mxE /= ltr_pwDl//. - by rewrite divr_gt0 ?exprn_gt0// mulr_gt0. - by rewrite divr_ge0 ?exprn_ge0// mulr_ge0// ltW. - - rewrite mxE /= ltr_pwDr//. - by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0// norm_gt0. - by rewrite divr_ge0 ?exprn_ge0 ?norm_ge0// mulr_ge0// ltW. -Unshelve. all: by end_near. +move=> dtraj. +suff: Gamma1 (row_mx (zp1 z) (z2 z)) by rewrite /Gamma1/= row_mxKr. +rewrite /zp1 /z2 hsubmxK /=. +exact/Gamma1_traj. Qed. -(* TODO: Section general properties of our system *) - -Lemma Gamma1_traj (traj : K -> 'rV_5%R.+1) (z : K) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) t : - Gamma1 (traj t). -Proof. -rewrite -(thm11a gamma_gt0 alpha1_gt0 ). - rewrite /state_space/=. - exists traj. - split => //. - by exists t. -Qed. - -Lemma norm_u1 (traj : K -> 'rV_5%R.+1) (z : K) (z2 := fun r => Rsubmx (traj r)) (zp1 := fun r => Lsubmx (traj r)) (u := 'e_2 - z2 z) - (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : norm u = 1. - rewrite /u. - suff: Gamma1 (row_mx (zp1 z) (z2 z)). - rewrite /Gamma1/=. - by rewrite row_mxKr. - rewrite /zp1 /z2. - rewrite hsubmxK /=. - apply/Gamma1_traj. - rewrite //. - by rewrite //. -Qed. - -Lemma Hsq (traj : K -> 'rV_5%R.+1) (z : K) (z2 := fun r => Rsubmx (traj r)) ( w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) - (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. +Lemma Hsq (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) + (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : + is_solution (eqn33 alpha1 gamma) traj -> + (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. +move=> dtraj. rewrite /dotmul !trmx_mul !tr_spin !mulNmx mulmxN opprK mulmxN !dotmulP. have key_ortho : (z2 z *m \S('e_2)) *d u = 0. by rewrite dotmulC ; apply/ortho. @@ -1098,21 +1064,23 @@ rewrite [in LHS]mulmxBr mulmxA wu0 sub0r. by rewrite 2!mulNmx mulmx1 mxE. Qed. -Lemma neg_spin (traj : K -> 'rV_5%R.+1) (z : K) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj ): - norm (Rsubmx (traj z) *m \S('e_2) *m - \S('e_2 - Rsubmx (traj z))) = - norm (Rsubmx (traj z) *m \S('e_2)). +Lemma neg_spin (traj : K -> 'rV_6) (z : K) : + is_solution (eqn33 alpha1 gamma) traj -> + norm (Right (traj z) *m \S('e_2) *m - \S('e_2 - Right (traj z))) = + norm (Right (traj z) *m \S('e_2)). Proof. +move=> dtraj. rewrite mulmxN normN. -pose zp1 := fun r => Lsubmx (traj r). -pose z2 := fun r => Rsubmx (traj r). +pose zp1 := fun r => Left (traj r). +pose z2 := fun r => Right (traj r). set w := (z2 z) *m \S('e_2). have Gamma1_traj t : Gamma1 (traj t) by apply/Gamma1_traj. rewrite /norm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. -have Hnorm_sq : norm (w *m \S('e_2 - Rsubmx (traj z))) ^+ 2 = norm w ^+ 2. +have Hnorm_sq : norm (w *m \S('e_2 - Right (traj z))) ^+ 2 = norm w ^+ 2. rewrite -!dotmulvv Hsq // !dotmulvv norm_u1 /= //. rewrite -!dotmulvv expr2 !mul1r mulr1. - have wu0 : w *d ('e_2 - Rsubmx (traj z)) = 0. + have wu0 : w *d ('e_2 - Right (traj z)) = 0. rewrite dotmulC. by rewrite ortho. by rewrite wu0 expr2 mul0r subr0 //. @@ -1120,167 +1088,95 @@ have Hnorm_sq : norm (w *m \S('e_2 - Rsubmx (traj z))) ^+ 2 = norm w ^+ 2. by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?norm_ge0. Qed. -Lemma bornage (traj : K -> 'rV_5%R.+1) (z : K) (zp1 := fun r => Lsubmx (traj r)) (z2 := fun r => Rsubmx (traj r)) - ( w := (z2 z) *m \S('e_2)) - (u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i) - (u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) - [eta (fun=> 0) with (0,0) |-> 1, - (0,1) |-> -2^-1, - (1,0) |-> -2^-1, - (1,1) |-> 1] (i,j)) - (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) : -- norm (zp1 z) ^+ 2 + - (z2 z *m \S('e_2 - z2 z) ^+ 2 *m (z2 z)^T - z2 z *m \S('e_2 - z2 z) ^+ 2 *m (zp1 z)^T) 0 0 <= - (- u1 *m u2 *m u1^T) 0 0. +Lemma V1dot_ub (traj : K -> 'rV_6) (z : K) (zp1 := Left \o traj) (z2 := Right \o traj) + (w := z2 z *m \S('e_2)) + (u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i) : + is_solution (eqn33 alpha1 gamma) traj -> + V1dot (traj z) <= (- u1 *m u2 *m u1^T) 0 0. Proof. -apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). - rewrite mxE. - have H2 : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2) by rewrite spinD spinN -tr_spin !mulmxDr !tr_spin_mul !addr0. - rewrite norm_spin mxE addrA expr2 mulmxA H2 -/w -dotmulNv addrC -mulmxN -expr2. - have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= - norm(w *m - (\S('e_2 - z2 z))) * norm(zp1 z). - rewrite mxE /= mulr1n (le_trans (ler_norm _)) //. - rewrite -ler_sqr // ; last first. - by rewrite nnegrE // mulr_ge0 ?norm_ge0 //. +move=> dtrak. +rewrite mxE. +rewrite /V1dot. +rewrite mxE norm_spin mxE addrA expr2 mulmxA. +have -> : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2). + by rewrite spinD spinN -tr_spin !mulmxDr !tr_spin_mul !addr0. +rewrite -/w -dotmulNv addrC -mulmxN -expr2. +have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= + norm(w *m - (\S('e_2 - z2 z))) * norm(zp1 z). + rewrite mxE /= mulr1n (le_trans (ler_norm _)) //. + rewrite -ler_sqr // ; last first. + by rewrite nnegrE // mulr_ge0 ?norm_ge0. by rewrite exprMn sqr_normr (le_trans (CauchySchwarz_vec _ _)) // !dotmulvv. - apply: (@le_trans _ _ (norm (w *m - \S('e_2 - z2 z)) * norm (zp1 z) + (- norm (zp1 z) ^+ 2 - norm w ^+ 2))). - rewrite lerD2r. - rewrite (le_trans _ (cauchy)) //. - by rewrite mxE eqxx mulr1n. - rewrite neg_spin /u1 /u2 //. - rewrite ![in leRHS]mxE !sum2E/= ![in leRHS]mxE !sum2E/= ![in leRHS]mxE /=. - rewrite !mulr1 mulrN mulNr opprK mulrDl mulNr -expr2. - rewrite [in leLHS] addrCA -!addrA lerD2l mulrDl (mulNr (norm w)). - rewrite -expr2 !addrA lerD2r !(mulrN , mulNr) opprK -mulrA. - rewrite [in leRHS](mulrC _ (norm w)) -mulrDr [in leRHS](mulrC (2 ^-1)). - by rewrite -mulrDr -div1r -splitr mulr1. -by []. -Qed. - -Lemma u2neq0 ( u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) - [eta (fun=> 0) with (0,0) |-> 1, - (0,1) |-> -2^-1, - (1,0) |-> -2^-1, - (1,1) |-> 1] (i,j)) : u2 != 0. -Proof. - apply/matrix0Pn. - exists 1. - exists 1. - by rewrite mxE /= oner_neq0. +apply: (@le_trans _ _ (norm (w *m - \S('e_2 - z2 z)) * norm (zp1 z) + (- norm (zp1 z) ^+ 2 - norm w ^+ 2))). + rewrite lerD2r. + rewrite (le_trans _ (cauchy)) //. + by rewrite mxE eqxx mulr1n. +rewrite neg_spin /u1 /u2 //. +rewrite !sum2E/= ![in leRHS]mxE !sum2E/= ![in leRHS]mxE /=. +rewrite !mulr1 mulrN mulNr opprK mulrDl mulNr -expr2. +rewrite [in leLHS] addrCA -!addrA lerD2l mulrDl (mulNr (norm w)). +rewrite -expr2 !addrA lerD2r !(mulrN , mulNr) opprK -mulrA. +rewrite [in leRHS](mulrC _ (norm w)) -mulrDr [in leRHS](mulrC (2 ^-1)). +by rewrite -mulrDr -div1r -splitr mulr1. Qed. -(* TODO: rework of this proof is needed *) -Lemma bornage_near (traj : K -> 'rV_5%R.+1) (zp1 := fun r => Lsubmx (traj r)) - (z2 := fun r => Rsubmx (traj r)) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) - (traj0 : traj 0 = point1 K) : \forall z \near 0^', (LieDerivative_jacobian1 - (fun x0 : 'rV_6 => (norm (Lsubmx x0) ^+ 2 / (2 * alpha1))%:M) traj + - LieDerivative_jacobian1 - (fun x0 : 'rV_6 => (norm (Rsubmx x0) ^+ 2 / (2 * gamma))%:M) traj) z <= - 0. +(* TODO: rework of this proof is needed *) +Lemma near0_le0 (traj : K -> 'rV_6) : + is_solution (eqn33 alpha1 gamma) traj -> + traj 0 = point1 -> + \forall z \near 0^', + (LieDerivative (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) traj + + LieDerivative (fun x => norm (Right x) ^+ 2 / (2 * gamma)) traj) z <= 0. Proof. -near=> z. +move=> dtraj traj0. +near=> z. rewrite !fctE !invfM /=. -set c1 := (2^-1 / alpha1). -set c2 := (2^-1 / gamma). -rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = -(fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. (* TODO: Lemma?*) - apply/funext => y. - by rewrite -scale_scalar_mx. -have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = - (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. -rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = - (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. - apply/funext => y. - by rewrite -scale_scalar_mx. -rewrite func_eq. -have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = - (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. -rewrite func_eq2 !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_norm derive_V1dot //. +under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. +rewrite !LieDerivativeMl /= !fctE !LieDerivative_norm derive_V1dot //. +pose zp1 := Left \o traj. +pose z2 := Right \o traj. set w := (z2 z) *m \S('e_2). pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. -pose u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) - [eta (fun=> 0) with (0,0) |-> 1, - (0,1) |-> -2^-1, - (1,0) |-> -2^-1, - (1,1) |-> 1] (i,j). - -apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). - by rewrite bornage. -move: defposmxu2 => /= def. -rewrite defposmxP in def. -move : u2neq0 => _. -case H: (u1 == 0). - move/eqP: H => ->. +apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). + by rewrite V1dot_ub. +have := @defposmxu2 K. +rewrite defposmxP => def. +have [->|H] := eqVneq u1 0. by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. -move: H => /negP H. -have u1_neq0 : u1 != 0 by apply/negP. -move: (def u1 u1_neq0) => Hpos. -rewrite -oppr_ge0 -oppr_le0 opprK. -apply ltW. +have Hpos := def u1 H. +rewrite -oppr_ge0 -oppr_le0 opprK ltW//. by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. -Unshelve. all: try by end_near. -Qed. +Unshelve. all: try by end_near. Qed. -Lemma V1_point_is_lnsd (traj : K -> 'rV_5%R.+1) (dtraj : is_solution (fun a : K => (eqn33 alpha1 gamma)^~ a) traj) - (traj0 : traj 0 = point1 K) : locnegsemidef (LieDerivative_jacobian1 V1 traj) 0. +Lemma V1_point_is_lnsd (traj : K -> 'rV_6) : + is_solution (eqn33 alpha1 gamma) traj -> + traj 0 = point1 -> + locnegsemidef (LieDerivative (V1 alpha1 gamma) traj) 0. Proof. +move=> dtraj traj0. have Gamma1_traj t : Gamma1 (traj t) by apply/Gamma1_traj. rewrite /locnegsemidef /V1. -rewrite [x in (LieDerivative_jacobian1 x)] (_ : _ = (fun x0 : 'rV_6 => - (norm (Lsubmx x0) ^+ 2 / (2 * alpha1))%:M) \+ - (fun x0 => (norm (Rsubmx x0) ^+ 2 / (2 * gamma))%:M)); last first. by apply/funext => ?/=; rewrite !raddfD. -rewrite LieDerivative_jacobian1D /=. -split. - rewrite !invfM /=. - set c1 := (2^-1 / alpha1). - set c2 := (2^-1 / gamma). - rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 * c1)%:M) = - (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M)) ; last first. - apply/funext => y. - by rewrite -scale_scalar_mx. - rewrite !fctE. - have func_eq: (fun zp1_z2 : 'rV_6 => (norm (Lsubmx zp1_z2) ^+ 2 *: c1)%:M) = - (fun zp1_z2 : 'rV_6 => c1 *: (norm (Lsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite (_ : (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 * c2)%:M) = - (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M)) ; last first. - apply/funext => y. - by rewrite -scale_scalar_mx. - rewrite func_eq. - have func_eq2: (fun zp1_z2 : 'rV_6 => (norm (Rsubmx zp1_z2) ^+ 2 *: c2)%:M) = - (fun zp1_z2 : 'rV_6 => c2 *: (norm (Rsubmx zp1_z2) ^+ 2)%:M). - move => n. - apply/funext => zp1_z2. - by rewrite scalar_mxM -!mul_scalar_mx scalar_mxC. - rewrite func_eq2. - rewrite !LieDerivative_jacobian1Ml /= !fctE !LieDerivative_jacobian1_eq0_equilibrium; last 3 first. - by rewrite scaler0 scaler0 add0r. - rewrite /is_solution /eqn33 in dtraj. - rewrite -derive1E -derive1mxE'. - rewrite dtraj/= traj0 /point1. - by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - rewrite /is_solution /eqn33 in dtraj. - rewrite -derive1E -derive1mxE'. - rewrite dtraj/= traj0 /point1. - by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. -apply/bornage_near. -by rewrite //. -by rewrite //. +rewrite LieDerivativeD /=. +split; last exact/near0_le0. +rewrite !invfM /=. +rewrite !fctE. +under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. +rewrite !LieDerivativeMl /= !fctE !LieDerivative_eq0_equilibrium; last 2 first. + rewrite -derive1E -derive1mxE' [LHS]dtraj /eqn33/= traj0 /point1. + by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. + rewrite -derive1E -derive1mxE' [LHS]dtraj /eqn33/= traj0 /point1. + by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. +by rewrite scaler0 scaler0 add0r. Qed. -Lemma V1_is_lyapunov_stable : eq_is_lyapunov_stable (fun a b => @eqn33 K alpha1 gamma b a) V1 (@point1 K). +Lemma V1_is_lyapunov_stable : + is_lyapunov_stable_at (eqn33 alpha1 gamma) (V1 alpha1 gamma) point1. Proof. split; first exact: equilibrium_point1. -- apply V1_is_lyapunov_candidate. -- apply/V1_point_is_lnsd. +- exact: V1_is_lyapunov_candidate. +- exact: V1_point_is_lnsd. Qed. End Lyapunov. From b298be3536572dd203b2a23f3c5a9ae6c93fc85b Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Mon, 28 Jul 2025 15:14:29 +0900 Subject: [PATCH 029/144] tentative d'enonce --- tilt.v | 174 +++++++++++++++++++++++++++++++-------------------------- 1 file changed, 96 insertions(+), 78 deletions(-) diff --git a/tilt.v b/tilt.v index 2b26dc4e..223b7b6e 100644 --- a/tilt.v +++ b/tilt.v @@ -1,9 +1,8 @@ - From mathcomp Require Import all_ssreflect all_algebra ring. From mathcomp Require Import boolp classical_sets functions reals. From mathcomp Require Import topology normedtype derive. Require Import ssr_ext euclidean rigid frame skew derive_matrix. -(*Require Import lasalle pendulum.*) +Require Import lasalle pendulum. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -300,22 +299,23 @@ Proof. rewrite /=. rewrite -!derive1E. rewrite (_ : (fun x => f x i j) = (fun M : 'M_(m.+1,n.+1) => M i j) \o f ) //. +rewrite fctE. Admitted. Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n (f : V -> 'M[R]_(m.+1, n.+1)) (x0 : V) (v : V) (i : 'I_m.+1) (j : 'I_n.+1) : 'D_v f x0 i j = 'D_v (fun x => f x i j) x0. Proof. -rewrite !deriveE; last 2 first. - admit. - admit. -rewrite (_ : (fun x : V => f x i j) = (fun M : 'M_(m.+1,n.+1) => M i j) \o f ). -rewrite [in RHS]diff_comp ; last 2 first. - admit. - admit. -rewrite /=. -From mathcomp Require Import landau. -under eq_fun do rewrite /=. +rewrite /derive /=. +set g := fun h => h^-1 *: (f (h *: v + x0) - f x0). +have Hfunc : forall x, g x i j = x^-1 *: (f (x *: v + x0) i j - f x0 i j). + move=> x. + rewrite /g mxE. + rewrite mxE. + by rewrite mxE. +under eq_fun do rewrite -Hfunc. +symmetry. +Search lim ( 'M_(_,_)). Admitted. Local Close Scope classical_set_scope. @@ -614,12 +614,29 @@ End Gamma1. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). +(* definition du probleme *) +Record equa_diff (K : realType) := { + equa_f : 'rV[K]_6 -> 'rV[K]_6 ; (* autonomous *) + equa_S0 : set 'rV[K]_6 ; (* intended to be invariant *) + equa_fk : exists k, k.-lipschitz_equa_S0 equa_f ; + (* hypothesis for existence and uniqueness of a solution *) + equa_t0 : K ; (* initial time *) +}. + +Definition is_invariant_solution_equa_diff + {K : realType} (e : equa_diff K) (y : K -> 'rV[K]_6) := + is_solution (fun y t => equa_f e (y t)) y /\ + (y (equa_t0 e) \in equa_S0 e -> + (forall t, t > 0 -> y (equa_t0 e + t) \in equa_S0 e)). + Section eqn33. Variable K : realType. Variable alpha1 : K. Variable gamma : K. +Variable y0 : K -> 'rV[K]_6. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. +Hypothesis y0init: y0 0 \in Gamma1. Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := let zp1_point := Left \o zp1_z2_point in @@ -627,6 +644,41 @@ Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := fun t => row_mx (- alpha1 *: zp1_point t) (gamma *: (z2_point t - zp1_point t) *m \S('e_2%:R - z2_point t) ^+ 2). +Definition eqn33' (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := + let zp1_point := Left zp1_z2_point in + let z2_point := Right zp1_z2_point in + row_mx (- alpha1 *: zp1_point) + (gamma *: (z2_point - zp1_point) *m \S('e_2%:R - z2_point) ^+ 2). + +Lemma eqn33E y t : eqn33 y t = eqn33' (y t). Proof. by []. Qed. + +Lemma eqn33'_lipschitz : exists k, k.-lipschitz_setT eqn33'. +Proof. +near (pinfty_nbhs K) => k. +exists k => -[/= x y] _. +rewrite /eqn33'. +set fx := row_mx (- alpha1 *: Left x) + (gamma *: (Right x - Left x) *m \S('e_2 - Right x) ^+ 2). +set fy := row_mx (- alpha1 *: Left y) + (gamma *: (Right y - Left y) *m \S('e_2 - Right y) ^+ 2). +rewrite /Num.norm/=. +rewrite !mx_normrE. +apply: bigmax_le => /=. + admit. +move=> -[a b] _. +rewrite /=. +rewrite [leRHS](_ : _ = \big[maxr/0]_ij (maxr alpha1 gamma * `|(x - y) ij.1 ij.2|)); last first. + admit. +rewrite (le_trans (@ler_peMl _ (maxr alpha1 gamma) _ _ _))//. + admit. +apply: le_trans; last first. + exact: (@le_bigmax _ _ _ 0 (fun ij => maxr alpha1 gamma * `|(x - y) ij.1 ij.2|) (a, b)). +rewrite /=. +apply: (@le_trans _ _ (`|(maxr alpha1 gamma *: fx - maxr alpha1 gamma *: fy) a b|)). + admit. +apply: (@le_trans _ _ (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: y a b|)); last first. +Admitted. + (* cauchy lipschitz par F1 qui definit un champ de vecteur lisse : il existe une solution depuis tout point: gamma1 ⊆ state_space*) @@ -641,7 +693,7 @@ Lemma inv_Gamma1 p (p33 : state_space eqn33 p) : Proof. case: p33 => /= y sol_y Delta Delta_ge0. rewrite /state_space/=. -exists y; split=> //. +exists y; split. by case: sol_y. case: cid => //= y' y'sol. case: cid => t'/= pt'. @@ -654,16 +706,13 @@ Proof. nagumo theorem *) apply/seteqP; split. - move=> p. - rewrite /state_space /Gamma1 /eqn33 /is_solution /=. - move=> [y0 [Heq Hrange]]. - move: Hrange. - move => exi. - case: exi. + move=> [y [Heq]]. + case. move=> t. move=> ->. have Heqt := Heq t. - have : derive1(fun t=> ('e_2 - Right (y0 t)) *d (('e_2 - Right (y0 t)))) = 0. - transitivity (fun t => -2 * (Right(y0^`()%classic t) *d ('e_2 - Right (y0 t)))). + have : derive1(fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. + transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). apply/funext => x. rewrite -!derive1mxE' /= /dotmul. under eq_fun do rewrite dotmulP /=. @@ -676,8 +725,8 @@ apply/seteqP; split. rewrite /dotmul /= !derive1mxE' /= [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. rewrite -!derive1mxE' !mxE /= !mulr1n. - have -> : (derive1mx (fun x0 : K => 'e_2 - Right (y0 x0)) x) - = - (Right (derive1mx y0 x)). + have -> : (derive1mx (fun x0 : K => 'e_2 - Right (y x0)) x) + = - (Right (derive1mx y x)). rewrite derive1mxB /= ; last 2 first. admit. admit. @@ -685,7 +734,7 @@ apply/seteqP; split. congr (-_). apply derive1mx_rsubmx. ring. - have : forall t, (Right (y0^`()%classic t) = (gamma *: (Right (y0 t) - Left (y0 t)) *m \S('e_2 - Right (y0 t)) ^+ 2)). + have : forall t, (Right (y^`()%classic t) = (gamma *: (Right (y t) - Left (y t)) *m \S('e_2 - Right (y t)) ^+ 2)). move => t0. rewrite -derive1mxE'. rewrite Heq. @@ -693,19 +742,17 @@ apply/seteqP; split. move => Rsu. apply/funext => t0. rewrite /dotmul. - transitivity (-2 * (gamma *: (Right (y0 t0) - Left (y0 t0)) *m \S('e_2 - Right (y0 t0)) ^+ 2 - *m ('e_2 - Right (y0 t0))^T) 0 0). + transitivity (-2 * (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2 + *m ('e_2 - Right (y t0))^T) 0 0). by rewrite Rsu /=. rewrite !mulmxA. apply/eqP. rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. by rewrite !mulmx0 mxE. - under eq_fun do rewrite dotmulvv /=. + under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0*) move => h. - have y0_init : y0 0 \in Gamma1. (* TODO general hypothesis*) - admit. - have norm_constant : norm ('e_2 - Right (y0 t))^+2 = norm ('e_2 - Right (y0 0))^+2. - have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y0 x)) ^+ 2) 0. + have norm_constant : norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. + have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. move => x0. apply: DeriveDef. admit. @@ -715,9 +762,11 @@ apply/seteqP; split. move/ (_ _ 0). move => s0. by apply: s0. - move: y0_init. + move: y0init. rewrite inE /Gamma1 /=. move=> Hnorm0. (* reecrire ce charabia*) + replace y with y0. (* vient de l'unicite des solutions de l'EDO. cauchy lipschitz ... *) + replace y with y0 in norm_constant. rewrite Hnorm0 in norm_constant. move: norm_constant. move=> Hsq. @@ -727,55 +776,21 @@ apply/seteqP; split. rewrite sqrp_eq1 in Hsq ; last first. exact: norm_ge0. exact : Hsq. -(* il existe une solution depuis tout point, cauchy lipschitz*) + admit. + admit. - move=> p. rewrite /state_space /Gamma1 /eqn33 /is_solution /=. move=> norme. - pose y := fun t : K => row_mx (expR (- alpha1 * t) *: Left p) - ('e_2 + expR (- gamma * t) *: (Right p - 'e_2)). - have D_y : forall t, derive1mx y t = - row_mx (- alpha1 *: Left (y t)) - (gamma *: (Right (y t) - Left (y t)) *m \S('e_2 - Right (y t)) ^+ 2). - move=> t0. - rewrite /y /= !row_mxKl !row_mxKr. - transitivity ( - row_mx (derive1mx (fun t1 => (expR (- alpha1 * t1) *: Left p)) t0) - (derive1mx (fun t1 => 'e_2 + expR (- gamma * t1) *: (Right p - 'e_2)) t0)). - admit. - congr row_mx. - under eq_fun do rewrite -!mul_mx_scalar. - rewrite !derive1mxM /=; last 2 first. - admit. - admit. - rewrite derive1mx_lsubmx. - rewrite derive1mx_cst. - rewrite lsubmx_const mul0mx add0r. - (* TODO: derive_comp *) - admit. - transitivity ((- gamma *: expR (- gamma * t0) *: (Right p - 'e_2))). - rewrite derive1mxD; last 2 first. - admit. - admit. - rewrite derive1mx_cst/= add0r. - admit. - rewrite opprD addrA subrr add0r. - rewrite spinN. - rewrite spinZ. - rewrite sqrrN. - rewrite exprZn. - rewrite (expr2 (\S(_))) -mulmxE. - rewrite sqr_spin//; last first. - admit. - admit. - exists y; split. - move=> t; apply/matrixP => i j. - have /matrixP := D_y t. - exact. exists 0. - rewrite /y !mulr0 expR0 !scale1r addrA. - transitivity (row_mx (Left p) (Right p )); last first. - by rewrite addrAC subrr add0r. - by rewrite hsubmxK. + split. + move => t. + rewrite derive1mx_cst /=. + rewrite !lsubmx_const !rsubmx_const /= !scalerBr /=. + by rewrite !scaler0 subr0 mul0mx row_mx0 /=. + have init : p = 0 0. (* most likely a false hypothesis*) + admit. + exists 0. + apply init. Admitted. Definition point1 : 'rV[K]_6 := 0. @@ -950,6 +965,9 @@ Hypothesis gamma_gt0 : 0 < gamma. Variable R : K -> 'M[K]_3. Variable v : K -> 'rV[K]_3. Definition x1 := v. +Variable y0 : K -> 'rV[K]_6. +Hypothesis y0init: y0 0 \in Gamma1. +Hypothesis y0sol : is_solution (eqn33 alpha1 gamma) y0. Definition p1 t : 'rV[K]_3 := let x1_t := x1 t in @@ -1024,8 +1042,8 @@ Qed. Lemma Gamma1_traj (traj : K -> 'rV_6) t : is_solution (eqn33 alpha1 gamma) traj -> Gamma1 (traj t). Proof. -move=> ?. -rewrite -(thm11a gamma_gt0 alpha1_gt0). +move=> iss. +rewrite -(thm11a gamma_gt0 alpha1_gt0 y0init ). exists traj; split => //. by exists t. Qed. From 6c8ab8caf04cbb7e815c6a4bda8c94a4c4db529a Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 28 Jul 2025 15:48:47 +0900 Subject: [PATCH 030/144] split file - pointwise differentiability --- _CoqProject | 3 + derive_matrix.v | 483 ++++++++++++++++------- differential_kinematics.v | 148 +++---- euclidean.v | 5 +- tilt.v | 802 ++++++++++++++------------------------ tilt_analysis.v | 72 ++++ tilt_mathcomp.v | 46 +++ tilt_robot.v | 144 +++++++ 8 files changed, 988 insertions(+), 715 deletions(-) create mode 100644 tilt_analysis.v create mode 100644 tilt_mathcomp.v create mode 100644 tilt_robot.v diff --git a/_CoqProject b/_CoqProject index 75931685..eea696ab 100644 --- a/_CoqProject +++ b/_CoqProject @@ -17,6 +17,9 @@ scara.v derive_matrix.v differential_kinematics.v extra_trigo.v +tilt_mathcomp.v +tilt_analysis.v +tilt_robot.v tilt.v -R . robot diff --git a/derive_matrix.v b/derive_matrix.v index 66d7c0d7..1caf6e9f 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -5,7 +5,7 @@ From mathcomp Require Import interval_inference. From mathcomp Require Import realalg complex fingroup perm. From mathcomp Require Import sesquilinear. From mathcomp Require Import boolp reals classical_sets. -From mathcomp Require Import topology normedtype landau derive. +From mathcomp Require Import topology normedtype landau derive trigo. From mathcomp Require Import functions. Require Import ssr_ext euclidean rigid skew. @@ -13,7 +13,7 @@ Require Import ssr_ext euclidean rigid skew. (* Derivatives of time-varying matrices *) (* *) (* derive1mx M(t) == the derivative matrix of M(t) *) -(* ang_vel_mx M == angular velocity matrix of M(t) 　　　　　　　　　　　　 *) +(* ang_vel_mx M == angular velocity matrix of M(t) *) (* *) (******************************************************************************) @@ -36,119 +36,283 @@ Lemma mxE_funeqE (R : realFieldType) (V W : normedModType R) (fun x => f x i j). Proof. by rewrite funeqE => ?; rewrite mxE. Qed. -Section Derive_lemmasVW. -Variables (R : numFieldType) (V W : normedModType R). -Implicit Types f g : V -> W. +Section derive_funmx. +Local Open Scope classical_set_scope. +Variable R : realFieldType. +Context {m n : nat}. -(* TODO: Fixme in MCA *) -Lemma derive_cst (k : W) (x v : V) : 'D_v (cst k) x = 0. -Proof. by rewrite derive_val. Qed. - -End Derive_lemmasVW. - -Lemma derive1_cst {R : numFieldType} (V : normedModType R) (k : V) t : ((cst k)^`() t)%classic = 0. -Proof. by rewrite derive1E derive_cst. Qed. +Lemma derive_funmxE (M : R -> 'M[R]_(m.+1, n.+1)) (t : R) v : + derivable M t v -> + 'D_v M t = \matrix_(i < m.+1, j < n.+1) 'D_v (fun t => M t i j) t. +Proof. +move=> /cvg_ex[/= l Hl]; apply/cvg_lim => //=. +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : (Hl) => /(_ (e / 2)). +rewrite divr_gt0// => /(_ isT)[d /= d0 dle]. +near=> x. +rewrite [in leLHS]/Num.Def.normr/= mx_normrE. +apply/(bigmax_le _ (ltW e0)) => -[/= i j] _. +rewrite [in leLHS]mxE/= [X in _ + X]mxE -[X in X - _](subrK (l i j)). +rewrite -(addrA (_ - _)) (le_trans (ler_normD _ _))// (splitr e) lerD//. +- rewrite mxE. + suff : (h^-1 *: (M (h *: v + t) i j - M t i j)) @[h --> 0^'] --> l i j. + move/cvg_lim => /=; rewrite /derive /= => ->//. + by rewrite subrr normr0 divr_ge0// ltW. + apply/cvgrPdist_le => /= r r0. + move/cvgrPdist_le : Hl => /(_ r r0)[/= s s0] sr. + near=> y. + have : `|l - y^-1 *: (M (y *: v + t) - M t)| <= r. + rewrite sr//=; last by near: y; exact: nbhs_dnbhs_neq. + by rewrite sub0r normrN; near: y; exact: dnbhs0_lt. + apply: le_trans. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE. + by under eq_bigr do rewrite !mxE; exact: (le_bigmax _ _ (i, j)). +- rewrite mxE. + have : `|l - x^-1 *: (M (x *: v + t) - M t)| <= e / 2. + apply: dle => //=; last by near: x; exact: nbhs_dnbhs_neq. + by rewrite sub0r normrN; near: x; exact: dnbhs0_lt. + apply: le_trans. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE/=. + under eq_bigr do rewrite !mxE. + apply: le_trans; last exact: le_bigmax. + by rewrite !mxE. +Unshelve. all: by end_near. Qed. + +End derive_funmx. + +Lemma norm_trmx (R : realFieldType) m n + (M : 'M[R]_(m.+1, n.+1)) : `|M^T| = `|M|. +Proof. +rewrite /Num.Def.normr/= !mx_normrE. +under eq_bigr do rewrite mxE. +apply/eqP; rewrite eq_le; apply/andP; split. +- apply: bigmax_le => //=. + apply: le_trans; last first. + apply: le_bigmax => /=. + exact: (ord0, ord0). + by []. + move=> i _. + apply/bigmax_geP; right => /=. + by exists (i.2, i.1). +- apply: bigmax_le => //=. + apply: le_trans; last first. + apply: le_bigmax => /=. + exact: (ord0, ord0). + by []. + move=> i _. + apply/bigmax_geP; right => /=. + by exists (i.2, i.1). +Qed. Section derive_mx. Variable (R : realFieldType) (V W : normedModType R). -Definition derivable_mx m n (M : R -> 'M[W]_(m, n)) t v := +Definition derivable_mx m n (M : R -> 'M[R]_(m.+1, n.+1)) t v := forall i j, derivable (fun x : R^o => (M x) i j) t v. -Definition derive1mx m n (M : R -> 'M[W]_(m, n)) := fun t => - \matrix_(i < m, j < n) (derive1 (fun x => M x i j) t : W). - -Lemma derive1mx_matrix m n t (f : 'I_m -> 'I_n -> R -> W) : - derive1mx (fun x => \matrix_(i, j) f i j x) t = - \matrix_(i, j) (derive1 (f i j) t : W). +Lemma derivable_mxP m n (M : R -> 'M[R]_(m.+1, n.+1)) t v : + derivable_mx M t v <-> derivable M t v. Proof. -rewrite /derive1mx; apply/matrixP => ? ?; rewrite !mxE; congr (derive1 _ t). -by rewrite funeqE => ?; rewrite mxE. -Qed. +split; rewrite /derivable_mx /derivable. + move=> H. + apply/cvg_ex => /=. + pose l := \matrix_(i < m.+1, j < n.+1) sval (cid ((cvg_ex _).1 (H i j))). + exists l. + apply/cvgrPdist_le => /= e e0. + near=> x. + rewrite /Num.Def.normr/= mx_normrE. + apply: (bigmax_le _ (ltW e0)) => /= i _. + rewrite !mxE/=. + move: i. + near: x. + apply: filter_forall => /= i. + pose r_of_i := fun i => (@cvgrPdist_le _ _ _ _ (dnbhs_filter 0) _ _).1 + (svalP (cid ((cvg_ex _).1 (H i.1 i.2)))) _ e0. + have := r_of_i i. + done. +move=> /cvg_ex[/= l Hl] i j. +apply/cvg_ex; exists (l i j). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0] H. +near=> x. +apply: le_trans; last first. + apply: (H x). + rewrite /ball_/=. + rewrite sub0r normrN. + near: x. + exact: dnbhs0_lt. + near: x. + exact: nbhs_dnbhs_neq. +rewrite [leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last exact: le_bigmax. +by rewrite /= !mxE. +Unshelve. all: by end_near. Qed. Variables m n : nat. -Implicit Types M N : R -> 'M[W]_(m, n). +Implicit Types M N : R -> 'M[R]_(m.+1, n.+1). -Lemma derivable_mxD M N t : derivable_mx M t 1 -> derivable_mx N t 1 -> - derivable_mx (fun x => M x + N x) t 1. +Lemma derivable_mxD M N t : derivable M t 1 -> derivable N t 1 -> + derivable (fun x => M x + N x) t 1. Proof. -move=> Hf Hg a b. evar (f1 : R -> W). evar (f2 : R -> W). -rewrite (_ : (fun x => _) = f1 + f2); last first. - rewrite funeqE => x; rewrite -[RHS]/(f1 x + f2 x) mxE /f1 /f2; reflexivity. -rewrite {}/f1 {}/f2; exact: derivableD. +move=> Hf Hg. +by apply: derivableD. Qed. -Lemma derivable_mxN M t : derivable_mx M t 1 -> - derivable_mx (fun x => - M x) t 1. +Lemma derivable_mxN M t : derivable M t 1 -> + derivable (fun x => - M x) t 1. Proof. -move=> HM a b. -rewrite (_ : (fun x => _) = (fun x => - (M x a b))); first exact: derivableN. -by rewrite funeqE => ?; rewrite mxE. +move=> HM. +exact: derivableN. Qed. -Lemma derivable_mxB M N t : derivable_mx M t 1 -> derivable_mx N t 1 -> - derivable_mx (fun x => M x - N x) t 1. -Proof. move=> Hf Hg; apply derivable_mxD => //; exact: derivable_mxN. Qed. +Lemma derivable_mxB M N t : derivable M t 1 -> derivable N t 1 -> + derivable (fun x => M x - N x) t 1. +Proof. +move=> Hf Hg. +by apply: derivableB. +Qed. Lemma trmx_derivable M t v : - derivable_mx M t v = derivable_mx (fun x => (M x)^T) t v. + derivable M t v = derivable (fun x => (M x)^T) t v. Proof. -rewrite propeqE; split => [H j i|H i j]. -by rewrite (_ : (fun _ => _) = (fun x => M x i j)) // funeqE => z; rewrite mxE. -by rewrite (_ : (fun _ => _) = (fun x => (M x)^T j i)) // funeqE => z; rewrite mxE. -Qed. +rewrite propeqE; split; rewrite /derivable/=. +- move=> /cvg_ex[/= l Hl]. + apply/cvg_ex => /=; exists l^T. + apply/cvgrPdist_le => /= e e0. + move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0 re]. + near=> x. + rewrite [leLHS](_ : _ = `|l - x^-1 *: ((M (x *: v + t)) - (M t))|); last first. + rewrite -[RHS]norm_trmx. + rewrite [in RHS]linearD/=. + rewrite [in RHS]linearN/=. + congr (`| _ - _ |). + rewrite [RHS]linearZ/=. + by rewrite [in RHS]linearB. + apply: re => /=. + rewrite sub0r normrN. + near: x. + by apply: dnbhs0_lt. + near: x. + by apply: nbhs_dnbhs_neq. +- move=> /cvg_ex[/= l Hl]. + apply/cvg_ex => /=; exists l^T. + apply/cvgrPdist_le => /= e e0. + move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0 re]. + near=> x. + rewrite [leLHS](_ : _ = `|l - x^-1 *: ((M (x *: v + t))^T - (M t)^T)|); last first. + rewrite -[RHS]norm_trmx. + rewrite [in RHS]linearD/=. + rewrite [in RHS]linearN/=. + congr (`| _ - _ |). + rewrite [RHS]linearZ/=. + rewrite [in RHS]linearB. + by rewrite /= !trmxK. + apply: re => /=. + rewrite sub0r normrN. + near: x. + by apply: dnbhs0_lt. + near: x. + by apply: nbhs_dnbhs_neq. +Unshelve. all: by end_near. Qed. Lemma derivable_mx_row M t i : - derivable_mx M t 1 -> derivable_mx (row i \o M) t 1. + derivable M t 1 -> derivable (row i \o M) t 1. Proof. -move=> H a b. -by rewrite (_ : (fun _ => _) = (fun x => (M x) i b)) // funeqE => z; rewrite mxE. -Qed. +rewrite /derivable => /cvg_ex[/= l Hl]. +apply/cvg_ex => /=. +exists (row i l). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0)[r /= r0 re]. +near=> x. +apply: le_trans; last first. + apply: (re x). + rewrite /ball_ /= sub0r normrN. + near: x. + by apply: dnbhs0_lt. + near: x. + by apply: nbhs_dnbhs_neq. +rewrite /Num.Def.normr/= !mx_normrE. +apply/bigmax_leP => /=. +split. + apply: le_trans; last first. + apply: le_bigmax => /=. + exact: (ord0, ord0). + by []. +move=> j _. +rewrite !mxE. +under eq_bigr do rewrite !mxE. +apply: le_trans; last first. + apply: le_bigmax. + exact: (i, j.2). +by rewrite /=. +Unshelve. all: by end_near. Qed. Lemma derivable_mx_col M t i : - derivable_mx M t 1 -> derivable_mx (trmx \o col i \o M) t 1. + derivable M t 1 -> derivable (col i \o M) t 1. Proof. -move=> H a b. -by rewrite (_ : (fun _ => _) = (fun x => (M x) b i)) // funeqE => z; rewrite 2!mxE. -Qed. - -Lemma derivable_mx_cst (P : 'M[W]_(m, n)) t : derivable_mx (cst P) t 1. -Proof. move=> a b; by rewrite (_ : (fun x : R => _) = cst (P a b)). Qed. - - -Lemma derive1mx_cst (P : 'M[W]_(m, n)) : derive1mx (cst P) = cst 0. +rewrite /derivable => /cvg_ex[/= l Hl]. +apply/cvg_ex => /=. +exists (col i l). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0)[r /= r0 re]. +near=> x. +apply: le_trans; last first. + apply: (re x). + rewrite /ball_ /= sub0r normrN. + near: x. + by apply: dnbhs0_lt. + near: x. + by apply: nbhs_dnbhs_neq. +rewrite /Num.Def.normr/= !mx_normrE. +apply/bigmax_leP => /=. +split. + apply: le_trans; last first. + apply: le_bigmax => /=. + exact: (ord0, ord0). + by []. +move=> j _. +rewrite !mxE. +under eq_bigr do rewrite !mxE. +apply: le_trans; last first. + apply: le_bigmax. + exact: (j.1, i). +by rewrite /=. +Unshelve. all: by end_near. Qed. + +Lemma derive1mx_cst (P : 'M[R]_(m.+1, n.+1)) : (cst P)^`()%classic = cst 0. Proof. -rewrite /derive1mx funeqE => t; apply/matrixP => i j; rewrite !mxE. -by rewrite (_ : (fun x : R => _) = cst (P i j)) // derive1_cst. +apply/funext => ?. +by rewrite derive1_cst. Qed. -Lemma derive1mx_tr M t : derive1mx (trmx \o M) t = (derive1mx M t)^T. +Lemma derive1mx_tr M t : derivable M t 1 -> 'D_1 (trmx \o M) t = ('D_1 M t)^T. Proof. -apply/matrixP => i j; rewrite !mxE. -by rewrite (_ : (fun _ => _) = (fun t => M t j i)) // funeqE => ?; rewrite mxE. +move=> Mt1. +rewrite !derive_funmxE//=. + apply/matrixP => i j; rewrite !mxE. + by rewrite (_ : (fun _ => _) = (fun t => M t j i)) // funeqE => ?; rewrite mxE. +by rewrite -trmx_derivable. Qed. -Lemma derive1mxD M N t : derivable_mx M t 1 -> derivable_mx N t 1 -> - derive1mx (M + N) t = derive1mx M t + derive1mx N t. +Lemma derive1mxD M N t : derivable M t 1 -> derivable N t 1 -> + 'D_1 (M + N) t = 'D_1 M t + 'D_1 N t. Proof. -move=> Hf Hg; apply/matrixP => a b; rewrite /derive1mx !mxE. -rewrite (_ : (fun _ => _) = (fun x => M x a b) \+ fun x => N x a b); last first. - by rewrite funeqE => ?; rewrite mxE. -by rewrite derive1E deriveD 2?{1}derive1E. +move=> Hf Hg. +by rewrite deriveD//. Qed. -Lemma derive1mxN M t : derivable_mx M t 1 -> derive1mx (- M) t = - derive1mx M t. +Lemma derive1mxN M t : derivable M t 1 -> 'D_1 (- M) t = - 'D_1 M t. Proof. -move=> Hf; apply/matrixP => a b. -rewrite !mxE [in RHS]derive1E -deriveN; last by []. -by rewrite -derive1E; f_equal; rewrite funeqE => x; rewrite mxE. +move=> Mt1. +by rewrite deriveN. Qed. -Lemma derive1mxB M N t : derivable_mx M t 1 -> derivable_mx N t 1 -> - derive1mx (M - N) t = derive1mx M t - derive1mx N t. +Lemma derive1mxB M N t : derivable M t 1 -> derivable N t 1 -> + 'D_1 (M - N) t = 'D_1 M t - 'D_1 N t. Proof. -by move=> Hf Hg; rewrite derive1mxD ?derive1mxN; last by exact: derivable_mxN. +move=> Mt1 Nt1. +by rewrite deriveB. Qed. End derive_mx. @@ -157,10 +321,11 @@ Section derive_mx_R. Variables (R : realFieldType) (m n k : nat). -Lemma derivable_mxM (f : R -> 'M[R^o]_(m, k)) (g : R -> 'M[R^o]_(k, n)) t : - derivable_mx f t 1 -> derivable_mx g t 1 -> derivable_mx (fun x => f x *m g x) t 1. +Lemma derivable_mxM (f : R -> 'M[R^o]_(m.+1, k.+1)) (g : R -> 'M[R^o]_(k.+1, n.+1)) t : + derivable f t 1 -> derivable g t 1 -> derivable (fun x => f x *m g x) t 1. Proof. -move=> Hf Hg a b. evar (f1 : 'I_k -> R^o -> R^o). +move=> /derivable_mxP Hf /derivable_mxP Hg. +apply/derivable_mxP => a b. evar (f1 : 'I_k.+1 -> R^o -> R^o). rewrite (_ : (fun x => _) = (\sum_i f1 i)); last first. rewrite funeqE => t'; rewrite mxE fct_sumE; apply: eq_bigr => k0 _. rewrite /f1; reflexivity. @@ -177,21 +342,44 @@ Section derive_mx_SE. Variables (R : rcfType) (M : R -> 'M[R^o]_4). -Lemma derivable_rot_of_hom : (forall t, derivable_mx M t 1) -> - forall x, derivable_mx (@rot_of_hom _ \o M) x 1. + +Lemma SE_derivable : (forall t, M t \is 'SE3[R]) -> + forall t, derivable M t 1. Proof. -move=> H x i j. +move=> ME/= t. +apply/derivable_mxP. +move=> [[|[|[|[|//]]]]] Hi [[|[|[|[|//]]]]] Hj. +- have : (fun t => M t (Ordinal Hi) (Ordinal Hj)) = 0. + apply/funext => x. + have := ME x. +Admitted. + +Lemma derivable_rot_of_hom : (forall t, derivable M t 1) -> + forall x, derivable (@rot_of_hom _ \o M) x 1. +Proof. +move=> H x. +apply/derivable_mxP => i j. +rewrite /rot_of_hom. rewrite (_ : (fun _ => _) = (fun y => (M y) (lshift 1 i) (lshift 1 j))); last first. - rewrite funeqE => y; by rewrite !mxE. -exact: H. + by rewrite funeqE => y; rewrite !mxE. +rewrite /= in H. +have /derivable_mxP := H x. +exact. Qed. +Local Open Scope classical_set_scope. + Lemma derive1mx_SE : (forall t, M t \in 'SE3[R]) -> - forall t, derive1mx M t = block_mx - (derive1mx (@rot_of_hom R^o \o M) t) 0 - (derive1mx (@trans_of_hom R^o \o M) t) 0. + forall t, 'D_1 M t = block_mx + ('D_1 (@rot_of_hom R^o \o M) t) 0 + ('D_1 (@trans_of_hom R^o \o M) t) 0. Proof. move=> MSE t. +rewrite !derive_funmxE//; last 3 first. + admit. + apply: derivable_rot_of_hom => /= x. + exact: SE_derivable. + exact: SE_derivable. rewrite block_mxEh. rewrite {1}(_ : M = (fun x => hom (rot_of_hom (M x)) (trans_of_hom (M x)))); last first. rewrite funeqE => x; by rewrite -(SE3E (MSE x)). @@ -200,21 +388,22 @@ rewrite 2!mxE; case: splitP => [j0 jj0|j0 jj0]. rewrite (_ : j = lshift 1 j0); last exact/val_inj. rewrite mxE; case: splitP => [i1 ii1|i1 ii1]. rewrite (_ : i = lshift 1 i1); last exact/val_inj. - rewrite mxE; congr (derive1 _ t); rewrite funeqE => x. + rewrite mxE; congr ('D_1 _ t); rewrite funeqE => x. by rewrite /hom (block_mxEul _ _ _ _ i1 j0). rewrite (_ : i = rshift 3 i1); last exact/val_inj. - rewrite mxE; congr (derive1 _ t); rewrite funeqE => x. + rewrite mxE; congr ('D_1 _ t); rewrite funeqE => x. by rewrite /hom (block_mxEdl (rot_of_hom (M x))). rewrite (_ : j = rshift 3 j0) ?mxE; last exact/val_inj. rewrite (ord1 j0). case: (@splitP 3 1 i) => [i0 ii0|i0 ii0]. rewrite (_ : i = lshift 1 i0); last exact/val_inj. - rewrite (_ : (fun _ => _) = (fun=> 0)) ?derive1_cst ?mxE //. - rewrite funeqE => x; by rewrite /hom (block_mxEur (rot_of_hom (M x))) mxE. + rewrite (_ : (fun _ => _) = (fun=> 0)). + by rewrite derive_cst mxE. + by rewrite funeqE => x; rewrite /hom (block_mxEur (rot_of_hom (M x))) mxE. rewrite (_ : i = rshift 3 i0); last exact/val_inj. -rewrite (_ : (fun _ => _) = (fun=> 1)) ?derive1_cst // (ord1 i0) ?mxE //. +rewrite (_ : (fun _ => _) = (fun=> 1)) ?derive_cst // (ord1 i0) ?mxE //. by rewrite funeqE => x; rewrite /hom (block_mxEdr (rot_of_hom (M x))) mxE. -Qed. +Admitted. End derive_mx_SE. @@ -234,15 +423,15 @@ case: fintype.splitP => /= [j Hj|[] [] //= ? ni]; rewrite mxE /=. rewrite mulr1n; congr (_ ``_ _); apply val_inj; by rewrite /= ni addn0. Qed. -Lemma derivable_row_belast (R : realFieldType) n (u : R -> 'rV[R^o]_n.+1) (t : R) (v : R): +Lemma derivable_row_belast (R : realFieldType) n (u : R -> 'rV[R^o]_n.+2) (t : R) (v : R): derivable_mx u t v -> derivable_mx (fun x => row_belast (u x)) t v. Proof. -move=> H i j; move: (H ord0 (widen_ord (leqnSn n) j)) => {H}. +move=> H i j; move: (H ord0 (widen_ord (leqnSn n.+1) j)) => {H}. set f := fun _ => _. set g := fun _ => _. by rewrite (_ : f = g) // funeqE => x; rewrite /f /g mxE. Qed. -Lemma dotmul_belast {R : realFieldType} n (u : 'rV[R]_n.+1) (v1 : 'rV[R]_n) v2 H : +Lemma dotmul_belast {R : realFieldType} n (u : 'rV[R]_n.+2) (v1 : 'rV[R]_n.+1) v2 H : u *d castmx (erefl 1%nat, H) (row_mx v1 v2) = u *d castmx (erefl 1%nat, H) (row_mx v1 0%:M) + u *d castmx (erefl 1%nat, H) (row_mx 0 v2). @@ -251,13 +440,13 @@ rewrite -dotmulDr; congr dotmul; apply/matrixP => i j; rewrite !(castmxE,mxE) /= case: fintype.splitP => [k /= jk|[] [] // ? /= jn]; by rewrite !(mxE,addr0,add0r,mul0rn). Qed. -Lemma derive1mx_dotmul_belast (R : realFieldType) n (u v : R^o -> 'rV[R^o]_n.+1) t : +Lemma derive1mx_dotmul_belast (R : realFieldType) n (u v : R^o -> 'rV[R^o]_n.+2) t : let u' x := row_belast (u x) in let v' x := row_belast (v x) in - u' t *d derive1mx v' t + (u t)``_ord_max *: derive (fun x => (v x)``_ord_max) t 1 = - u t *d derive1mx v t. + u' t *d 'D_1 v' t + (u t)``_ord_max *: derive (fun x => (v x)``_ord_max) t 1 = + u t *d 'D_1 v t. Proof. move=> u' v'. -rewrite (row_belast_last (derive1mx v t)) ?addn1 // => ?. +rewrite (row_belast_last ('D_1 v t)) ?addn1 // => /= ?. rewrite dotmul_belast; congr (_ + _). rewrite 2!dotmulE [in RHS]big_ord_recr /=. rewrite castmxE mxE /=; case: fintype.splitP => [j /= /eqP/negPn|j _]. @@ -265,9 +454,15 @@ rewrite dotmul_belast; congr (_ + _). rewrite !mxE (_ : _ == _); last by apply/eqP/val_inj => /=; move: j => [[] ?]. rewrite mulr0 addr0; apply/eq_bigr => i _; rewrite castmxE !mxE; congr (_ * _). case: fintype.splitP => [k /= ik|[] [] //= ?]; rewrite !mxE. + rewrite derive_funmxE//; last first. + admit. + rewrite /= !mxE/=. + rewrite derive_funmxE//; last first. + admit. + rewrite /= !mxE/=. f_equal. - rewrite funeqE => x; rewrite /v' !mxE; congr ((v _) _ _); by apply/val_inj. - rewrite addn0 => /eqP/negPn; by rewrite (ltn_eqF (ltn_ord i)). + by rewrite funeqE => x; rewrite /v' !mxE; congr ((v _) _ _); by apply/val_inj. + by rewrite addn0 => /eqP/negPn; rewrite (ltn_eqF (ltn_ord i)). apply/esym. rewrite dotmulE big_ord_recr /= (eq_bigr (fun=> 0)); last first. move=> i _. @@ -277,34 +472,47 @@ rewrite dotmulE big_ord_recr /= (eq_bigr (fun=> 0)); last first. rewrite sumr_const mul0rn add0r castmxE /=; congr (_ * _); rewrite !mxE. case: fintype.splitP => [j /= /eqP/negPn | [] [] //= ? Hn]. by rewrite (gtn_eqF (ltn_ord j)). -by rewrite mxE derive1E (_ : _ == _). -Qed. +rewrite mxE/= mulr1n. +rewrite derive_funmxE//; last first. + admit. +by rewrite mxE//. +Admitted. End row_belast. (* TODO: could be derived from more generic lemmas about bilinearity in derive.v? *) Section product_rules. -Lemma derive1mx_dotmul (R : realFieldType) n (u v : R^o -> 'rV[R^o]_n) (t : R^o) : - derivable_mx u t 1 -> derivable_mx v t 1 -> - derive1 (fun x => u x *d v x : R^o) t = - derive1mx u t *d v t + u t *d derive1mx v t. +Lemma derive1mx_dotmul (R : realFieldType) n (u v : R^o -> 'rV[R^o]_n.+1) (t : R^o) : + derivable u t 1 -> derivable v t 1 -> + 'D_1 (fun x => u x *d v x : R^o) t = + 'D_1 u t *d v t + u t *d 'D_1 v t. Proof. -move=> U V. +move=> /derivable_mxP U /derivable_mxP V. evar (f : R -> R); rewrite (_ : (fun x : R => u x *d v x : R^o) = f); last first. rewrite funeqE => x /=; exact: dotmulE. -rewrite derive1E {}/f. +rewrite {}/f. set f := fun i : 'I__ => fun x => ((u x) ``_ i * (v x) ``_ i). rewrite (_ : (fun _ : R => _) = \sum_(k < _) f k); last first. by rewrite funeqE => x; rewrite /f /= fct_sumE. rewrite derive_sum; last by move=> ?; exact: derivableM (U _ _) (V _ _). rewrite {}/f. elim: n u v => [|n IH] u v in U V *. - rewrite big_ord0 (_ : v t = 0) ?dotmulv0 ?add0r; last by apply/rowP => [[]]. - rewrite (_ : u t = 0) ?dotmul0v //; by apply/rowP => [[]]. + rewrite big_ord_recl/= big_ord0 addr0. + rewrite /dotmul !mxE !sum1E !mxE. + rewrite deriveM//=. + rewrite addrC. + rewrite mulrC//. + rewrite derive_funmxE//; last first. + exact/derivable_mxP. + rewrite !mxE. + rewrite derive_funmxE//; last first. + exact/derivable_mxP. + rewrite !mxE. + done. rewrite [LHS]big_ord_recr /=. set u' := fun x => row_belast (u x). set v' := fun x => row_belast (v x). -transitivity (derive1mx u' t *d v' t + u' t *d derive1mx v' t + +transitivity ('D_1 u' t *d v' t + u' t *d 'D_1 v' t + derive (fun x => (u x)``_ord_max * (v x)``_ord_max) t 1). rewrite -(IH _ _ (derivable_row_belast U) (derivable_row_belast V)). apply: f_equal2; last by []. @@ -315,43 +523,47 @@ rewrite -(addrA (_ + _)) [in RHS]addrC derive1mx_dotmul_belast; congr (_ + _). by rewrite [in RHS]dotmulC -derive1mx_dotmul_belast addrC dotmulC. Qed. -Lemma derive1mxM (R : realFieldType) n m p (M : R -> 'M[R^o]_(n, m)) - (N : R^o -> 'M[R^o]_(m, p)) (t : R^o) : - derivable_mx M t 1 -> derivable_mx N t 1 -> - derive1mx (fun t => M t *m N t) t = - derive1mx M t *m N t + M t *m (derive1mx N t). +Lemma derive1mxM (R : realFieldType) n m p (M : R -> 'M[R^o]_(n.+1, m.+1)) + (N : R^o -> 'M[R^o]_(m.+1, p.+1)) (t : R^o) : + derivable M t 1 -> derivable N t 1 -> + 'D_1 (fun t => M t *m N t) t = + 'D_1 M t *m N t + M t *m ('D_1 N t). Proof. -move=> HM HN; apply/matrixP => i j; rewrite ![in LHS]mxE. +move=> HM HN; apply/matrixP => i j. +rewrite derive_funmxE; last admit. +rewrite ![in LHS]mxE. rewrite (_ : (fun x => _) = fun x => \sum_k (M x) i k * (N x) k j); last first. by rewrite funeqE => x; rewrite !mxE. rewrite (_ : (fun x => _) = fun x => (row i (M x)) *d (col j (N x))^T); last first. rewrite funeqE => z; rewrite dotmulE; apply eq_bigr => k _. by rewrite 3!mxE. -rewrite (derive1mx_dotmul (derivable_mx_row HM) (derivable_mx_col HN)). -by rewrite [in RHS]mxE; congr (_ + _); rewrite [in RHS]mxE dotmulE; +rewrite (derive1mx_dotmul (derivable_mx_row HM)); last first. + rewrite /=. + (* derivable_mx_col HN*) admit. +(*by rewrite [in RHS]mxE; congr (_ + _); rewrite [in RHS]mxE dotmulE; apply/eq_bigr => /= k _; rewrite !mxE; apply: f_equal2; try by congr (@derive1 _ R^o _ t); rewrite funeqE => z; rewrite !mxE. -Qed. +Qed.*) Admitted. Lemma derive1mx_crossmul (R : realFieldType) (u v : R -> 'rV[R^o]_3) t : - derivable_mx u t 1 -> derivable_mx v t 1 -> - derive1mx (fun x => (u x *v v x) : 'rV[R^o]_3) t = - derive1mx u t *v v t + u t *v derive1mx v t. + derivable u t 1 -> derivable v t 1 -> + 'D_1 (fun x => (u x *v v x) : 'rV[R^o]_3) t = + 'D_1 u t *v v t + u t *v 'D_1 v t. Proof. move=> U V. evar (f : R -> 'rV[R]_3); rewrite (_ : (fun x : R => _) = f); last first. rewrite funeqE => x; exact: crossmulE. -rewrite {}/f {1}/derive1mx; apply/rowP => i; rewrite mxE derive1E. -rewrite (mxE_funeqE (fun x : R^o => _)) /= mxE 2!crossmulE !{1}[in RHS]mxE /=. +rewrite {}/f; apply/rowP => i; rewrite mxE. +(*rewrite (mxE_funeqE (fun x : R^o => _)) /= mxE 2!crossmulE !{1}[in RHS]mxE /=. case: ifPn => [/eqP _|/ifnot0P/orP[]/eqP -> /=]; rewrite ?derive1E (deriveD (derivableM (U _ _) (V _ _)) (derivableN (derivableM (U _ _) (V _ _)))); rewrite (deriveN (derivableM (U _ _) (V _ _))) 2!(deriveM (U _ _) (V _ _)); rewrite addrCA -!addrA; congr (_ + (_ + _)); by [ rewrite mulrC | rewrite opprD addrC; congr (_ + _); rewrite mulrC ]. -Qed. +Qed.*) Admitted. End product_rules. @@ -390,22 +602,23 @@ Section derivative_of_a_rotation_matrix. Variables (R : realFieldType) (M : R -> 'M[R^o]_3). -Definition ang_vel_mx t : 'M_3 := (M t)^T * derive1mx M t. +Definition ang_vel_mx t : 'M_3 := (M t)^T * 'D_1 M t. -Definition body_ang_vel_mx t : 'M_3 := derive1mx M t *m (M t)^T. +Definition body_ang_vel_mx t : 'M_3 := 'D_1 M t *m (M t)^T. (* angular velocity (a free vector) *) Definition ang_vel t := unspin (ang_vel_mx t). Hypothesis MO : forall t, M t \is 'O[ R ]_3. -Hypothesis derivable_M : forall t, derivable_mx M t 1. +Hypothesis derivable_M : forall t, derivable M t 1. Lemma ang_vel_mx_is_so t : ang_vel_mx t \is 'so[ R ]_3. Proof. have : (fun t => (M t)^T * M t) = cst 1. rewrite funeqE => x; by rewrite -orthogonal_inv // mulVr // orthogonal_unit. -move/(congr1 (fun f => derive1mx f t)); rewrite derive1mx_cst -[cst 0 _]/(0). -rewrite derive1mxM // -?trmx_derivable // derive1mx_tr. +move/(congr1 (fun f => 'D_1 f t)). +rewrite derive_cst. +rewrite derive1mxM // -?trmx_derivable // derive1mx_tr//. move=> /eqP; rewrite addr_eq0 => /eqP H. by rewrite antiE /ang_vel_mx trmx_mul trmxK H opprK. Qed. @@ -414,7 +627,7 @@ Lemma ang_vel_mxE t : ang_vel_mx t = \S( ang_vel t). Proof. by rewrite /ang_vel unspinK // ang_vel_mx_is_so. Qed. (* [sciavicco] eqn 3.7 *) -Lemma derive1mx_ang_vel t : derive1mx M t = M t * ang_vel_mx t. +Lemma derive1mx_ang_vel t : 'D_1 M t = M t * ang_vel_mx t. Proof. move: (ang_vel_mx_is_so t); rewrite antiE -subr_eq0 opprK => /eqP. rewrite {1 2}/ang_vel_mx trmx_mul trmxK => /(congr1 (fun x => (M t) * x)). @@ -428,12 +641,12 @@ Qed. Lemma derive1mx_rot (p' : 'rV[R^o]_3 (* constant vector *)) : let p := fun t => p' *m M t in - forall t, derive1mx p t = ang_vel t *v p t. + forall t, 'D_1 p t = ang_vel t *v p t. Proof. move=> p t; rewrite /p derive1mxM; last first. exact: derivable_M. rewrite /derivable_mx => i j; exact: ex_derive. -rewrite derive1mx_cst mul0mx add0r derive1mx_ang_vel mulmxA. +rewrite derive_cst mul0mx add0r derive1mx_ang_vel mulmxA. by rewrite -{1}(unspinK (ang_vel_mx_is_so t)) spinE. Qed. diff --git a/differential_kinematics.v b/differential_kinematics.v index b2540a0b..de78fd1e 100644 --- a/differential_kinematics.v +++ b/differential_kinematics.v @@ -90,11 +90,11 @@ Lemma derive1mx_BoundFramed_add (R : realFieldType) (F : tframe R^o) (Q : R -> bvec F) (Z : R -> fvec F) t : derivable_mx (fun x => BoundVect.endp (Q x)) t 1 -> derivable_mx (fun x => FramedVect.v (Z x)) t 1 -> - derive1mx (fun x => BoundVect.endp (Q x \+b Z x)) t = - derive1mx (fun x => BoundVect.endp (Q x)) t + - derive1mx (fun x => FramedVect.v (Z x)) t. + 'D_1 (fun x => BoundVect.endp (Q x \+b Z x)) t = + 'D_1 (fun x => BoundVect.endp (Q x)) t + + 'D_1 (fun x => FramedVect.v (Z x)) t. Proof. -move=> H H'. +move=> /derivable_mxP H /derivable_mxP H'. rewrite (_ : (fun x : R => _) = (fun x : R => BoundVect.endp (Q x) + (FramedVect.v (Z x)))); last by rewrite funeqE. rewrite derive1mxD. @@ -176,7 +176,7 @@ Qed. Lemma derivable_mx_FromTo_tr (R : realFieldType) (F : tframe R^o) (G : R -> rframe F) t : - derivable_mx (fun x => F _R^ (G x)) t 1 = derivable_mx (fun x => F _R^ (G x)) t 1. + derivable (fun x => F _R^ (G x)) t 1 = derivable (fun x => F _R^ (G x)) t 1. Proof. by rewrite trmx_derivable. Qed. End derivable_FromTo. @@ -220,79 +220,78 @@ Qed. Lemma derivable_mx_Q t : derivable_mx (fun x => BoundVect.endp (Q x)) t 1. Proof. -rewrite /Q /=; apply derivable_mxD. - move=> a b. +move=> a b. move: (@derivable_F1o t a b). - rewrite (_ : (fun x => \o{F1 x} a b) = +(* rewrite (_ : (fun x => \o{F1 x} a b) = (fun x => BoundVect.endp (RFrame.o (F1 x)) a b)) // funeqE => x. destruct (F1 x) => /=; by rewrite e. apply derivable_mxM; last exact: derivable_mx_FromTo. rewrite (_ : (fun x => _) = (fun _ => BoundVect.endp (Q1 0))); last first. rewrite funeqE => x; by rewrite Q1_fixed_in_F1. move=> a b; exact: ex_derive. -Qed. +Qed.*) Admitted. Let Rot := fun t => (F1 t) _R^ F. (* generalization of B.4 *) Lemma velocity_composition_rule (t : R) : - derive1mx (fun x => BoundVect.endp (P x)) t = - derive1mx (fun x => BoundVect.endp (Q x)) t + - derive1mx P1 t *m Rot t (* rate of change of the coordinates P1 expressed in the frame F *) + + 'D_1 (fun x => BoundVect.endp (P x)) t = + 'D_1 (fun x => BoundVect.endp (Q x)) t + + 'D_1 (fun x => P1 x : 'M__) t *m Rot t (* rate of change of the coordinates P1 expressed in the frame F *) + ang_vel Rot t *v FramedVect.v (P t \-b Q t). Proof. rewrite {1}(_ : P = fun t => Q t \+b rmap F (P1 t \-b Q1 t)); last first. by rewrite funeqE => t'; rewrite eqnB3. rewrite (derive1mx_BoundFramed_add (@derivable_mx_Q t)); last first. - apply derivable_mxM; last exact: derivable_mx_FromTo. +(* apply derivable_mxM; last exact: derivable_mx_FromTo. rewrite (_ : (fun x => _) = (fun x => FramedVect.v (FramedVect_of_Bound (P1 x)) - FramedVect.v (FramedVect_of_Bound (Q1 0)))); last first. rewrite funeqE => x; by rewrite /= Q1_fixed_in_F1. apply: derivable_mxB => /=. exact: derivable_mxP1. - move=> a b; exact: ex_derive. + move=> a b; exact: ex_derive.*) admit. rewrite -addrA; congr (_ + _). rewrite [in LHS]/rmap [in LHS]/= derive1mxM; last 2 first. rewrite {1}(_ : (fun x => _) = (fun x => BoundVect.endp (P1 x) - BoundVect.endp (Q1 0))); last first. by rewrite funeqE => ?; rewrite Q1_fixed_in_F1. apply: derivable_mxB. - exact: derivable_mxP1. - move=> a b; exact: ex_derive. - exact: derivable_mx_FromTo. + (*exact: derivable_mxP1.*) admit. + move=> a b; exact: ex_derive. + (* exact: derivable_mx_FromTo.*) admit. rewrite derive1mxB; last 2 first. - exact: derivable_mxP1. + (*exact: derivable_mxP1.*) admit. rewrite (_ : (fun x => _) = cst (BoundVect.endp (Q1 0))); last first. by rewrite funeqE => x; rewrite Q1_fixed_in_F1. - exact: derivable_mx_cst. + exact: derivable_cst. congr (_*m _ + _). rewrite [in X in _ + X = _](_ : (fun x => _) = cst (BoundVect.endp (Q1 0))); last first. by rewrite funeqE => x; rewrite Q1_fixed_in_F1. - by rewrite derive1mx_cst subr0. + (*by rewrite derive1mx_cst subr0.*) admit. rewrite -spinE unspinK; last first. rewrite ang_vel_mx_is_so; first by []. - move=> t'; by rewrite FromTo_is_O. - move=> t'; exact: derivable_mx_FromTo. + by move=> t'; by rewrite FromTo_is_O. + (*move=> t'; exact: derivable_mx_FromTo.*) admit. rewrite /ang_vel_mx mulmxA; congr (_ *m _). rewrite /P /Q /= opprD addrACA subrr add0r mulmxBl -!mulmxA. by rewrite orthogonal_mul_tr ?FromTo_is_O // !mulmx1. -Qed. +Admitted. Hypothesis P1_fixed_in_F1 : forall t, BoundVect.endp (P1 t) = BoundVect.endp (P1 0). (* eqn B.4 *) Lemma velocity_composition_rule_spec (t : R) : - derive1mx (fun x => BoundVect.endp (P x)) t = - derive1mx (fun x => BoundVect.endp (Q x)) t + + 'D_1 (fun x => BoundVect.endp (P x)) t = + 'D_1 (fun x => BoundVect.endp (Q x)) t + ang_vel Rot t *v (FramedVect.v (P t \-b Q t)). Proof. rewrite velocity_composition_rule; congr (_ + _). -suff -> : derive1mx P1 t = 0 by rewrite mul0mx addr0. +suff -> : 'D_1 (fun x => P1 x : 'M__) t = 0 by rewrite mul0mx addr0. apply/matrixP => a b; rewrite !mxE. -rewrite (_ : (fun x => _) = cst (P1 0 a b)); last first. +(*rewrite (_ : (fun x => _) = cst (P1 0 a b)); last first. rewrite funeqE => x /=; by rewrite /boundvectendp (P1_fixed_in_F1 x). by rewrite derive1_cst. -Qed. +Qed.*) Admitted. End kinematics. @@ -309,16 +308,16 @@ Hypothesis derivable_F1o : forall t, derivable_mx (@TFrame.o R^o \o F1) t 1. Definition p0 := motion p1. Lemma eqn312 t : - derive1mx (fun x => BoundVect.endp (motion p1 x)) t = - derive1mx (fun x => BoundVect.endp (motion (fun=> bvec0 (F1 x)) t)) t + - derive1mx p1 t *m (F1 t) _R^ F + + 'D_1 (fun x => BoundVect.endp (motion p1 x)) t = + 'D_1 (fun x => BoundVect.endp (motion (fun=> bvec0 (F1 x)) t)) t + + 'D_1 (fun x => p1 x : 'M__) t *m (F1 t) _R^ F + ang_vel (fun t => (F1 t) _R^ F) t *v (p1 t *m (F1 t) _R^ F). Proof. rewrite (@velocity_composition_rule _ F _ derivable_F1 derivable_F1o p1 derivable_mx_p1 (fun t => bvec0 (F1 t)) (@BoundVect0_fixed _ _ _ F1)). -congr (_ + _ *v _). +(*congr (_ + _ *v _). by rewrite /= mul0mx addr0 addrAC subrr add0r. -Qed. +Qed.*) Admitted. End derivative_of_a_rotation_matrix_contd. @@ -333,12 +332,12 @@ Variables (R : realType) (M : R -> 'M[R^o]_4). Hypothesis derivableM : forall t, derivable_mx M t 1. Hypothesis MSE : forall t, M t \in 'SE3[R]. -Definition spatial_velocity t : 'M_4 := (M t)^-1 * derive1mx M t. +Definition spatial_velocity t : 'M_4 := (M t)^-1 * 'D_1 M t. Definition spatial_lin_vel := let r : R -> 'M[R^o]_3 := @rot_of_hom _ \o M in let p : R -> 'rV[R^o]_3:= @trans_of_hom _ \o M in - fun t => - p t *m (r t)^T *m derive1mx r t + derive1mx p t. + fun t => - p t *m (r t)^T *m 'D_1 r t + 'D_1 p t. Lemma spatial_velocityE t : let r : R -> 'M[R^o]_3 := @rot_of_hom _ \o M in @@ -346,14 +345,14 @@ Lemma spatial_velocityE t : Proof. move=> r. rewrite /spatial_velocity. -transitivity (inv_hom (M t) * derive1mx M t) => //. +transitivity (inv_hom (M t) * 'D_1 M t) => //. by rewrite inv_homE. rewrite /inv_hom. rewrite /hom. rewrite derive1mx_SE //. rewrite (_ : rot_of_hom (M t) = r t) // -/r. rewrite -mulmxE. -rewrite (mulmx_block (r t)^T _ _ _ (derive1mx r t)). +rewrite (mulmx_block (r t)^T _ _ _ ('D_1 r t)). rewrite !(mul0mx,add0r,mul1mx,mulmx0,trmx0,addr0,mulmx1). by rewrite mulmxE -/(ang_vel_mx r t). Qed. @@ -364,8 +363,8 @@ rewrite spatial_velocityE. set r := @rot_of_hom _. rewrite qualifE block_mxKul block_mxKur block_mxKdr 2!eqxx 2!andbT. rewrite ang_vel_mx_is_so // => t0. by rewrite rotation_sub // rot_of_hom_is_SO. -exact: derivable_rot_of_hom. -Qed. +apply: derivable_rot_of_hom => //=. +Admitted. Lemma spatial_velocity_is_twist x : let r : R -> 'M[R^o]_3 := @rot_of_hom _ \o M in @@ -376,8 +375,8 @@ rewrite spatial_velocityE. rewrite /wedge lin_tcoorE ang_tcoorE unspinK //. rewrite ang_vel_mx_is_so // => t0. by rewrite rotation_sub // rot_of_hom_is_SO. -exact: derivable_rot_of_hom. -Qed. +apply: derivable_rot_of_hom => //=. +Admitted. End spatial_velocity. @@ -387,38 +386,38 @@ Variables (R : realType) (M : R -> 'M[R^o]_4). Hypothesis derivableM : forall t, derivable_mx M t 1. Hypothesis MSE : forall t, M t \in 'SE3[R]. -Definition body_velocity t : 'M_4 := derive1mx M t * (M t)^-1. +Definition body_velocity t : 'M_4 := 'D_1 M t * (M t)^-1. Definition body_lin_vel := let r : R -> 'M[R^o]_3 := @rot_of_hom _ \o M in let p : R -> 'rV[R^o]_3:= @trans_of_hom _ \o M in - fun t => derive1mx p t *m (r t)^T. + fun t => 'D_1 p t *m (r t)^T. Lemma body_ang_vel_is_so t : body_ang_vel_mx (@rot_of_hom _ \o M) t \is 'so[R]_3. Proof. rewrite /body_ang_vel_mx. have : forall t, (@rot_of_hom R^o \o M) t \is 'O[R]_3. move=> t0; by rewrite rotation_sub // rot_of_hom_is_SO. -move/ang_vel_mx_is_so => /(_ (derivable_rot_of_hom derivableM))/(_ t). +(*move/ang_vel_mx_is_so => /(_ (derivable_rot_of_hom derivableM))/(_ t). rewrite /ang_vel_mx. move/(conj_so (((rot_of_hom (T:=R) \o M) t)^T)). rewrite !mulmxA !trmxK orthogonal_mul_tr ?rotation_sub // ?rot_of_hom_is_SO //. by rewrite mul1mx. -Qed. +Qed.*) Admitted. Lemma body_velocityE t : let r : R -> 'M[R^o]_3 := @rot_of_hom _ \o M in body_velocity t = block_mx (body_ang_vel_mx r t) 0 (body_lin_vel t) 0. Proof. move=> r. rewrite /body_velocity. -transitivity (derive1mx M t * inv_hom (M t)). +transitivity ('D_1 M t * inv_hom (M t)). by rewrite inv_homE. rewrite /inv_hom. rewrite /hom. rewrite derive1mx_SE //. rewrite (_ : rot_of_hom (M t) = r t) // -/r. rewrite -mulmxE. -rewrite (mulmx_block (derive1mx r t) _ _ _ (r t)^T). +rewrite (mulmx_block ('D_1 r t) _ _ _ (r t)^T). rewrite !(mul0mx,add0r,mul1mx,mulmx0,trmx0,addr0,mulmx1). by rewrite -/(body_ang_vel_mx _) -/(body_lin_vel _). Qed. @@ -483,14 +482,14 @@ Proof. by rewrite /= -mulmxA FromTo_comp FromToI mulmx1. Qed. (* lin. vel. of Link i as a function of the translational and rotational velocities of Link i-1 *) -Lemma eqn314 t : derive1mx o2 t = derive1mx o1 t + - FramedVect.v (rmap F `[derive1mx r12 t $ F1 t]) +Lemma eqn314 t : 'D_1 (fun x => o2 x : 'M__) t = 'D_1 (fun x => o1 x : 'M__) t + + FramedVect.v (rmap F `['D_1 (fun x => r12 x : 'M__) t $ F1 t]) (* velocity of the origin of Frame i w.r.t. the origin of Frame i-1 *) + w1 t *v (\o{F2 t} - \o{F1 t}). Proof. rewrite -eqn314_helper. move: (@eqn312 _ F _ derivable_F1 _ derivable_r12 derivable_F1o t). -have -> : derive1mx (fun x => BoundVect.endp (motion r12 x)) t = derive1mx o2 t. +have -> : 'D_1 (fun x => BoundVect.endp (motion r12 x)) t = 'D_1 (fun x => o2 x : 'M__) t. rewrite (_ : (fun x => BoundVect.endp (motion r12 x)) = o2) //. rewrite funeqE => t' /=; rewrite -mulmxA FromTo_comp FromToI mulmx1. rewrite addrCA RFrame_o subrr addr0. @@ -510,30 +509,36 @@ Lemma eqn316 t : w2 t = w1 t + w12 t *m ((F1 t) _R^ F). Proof. have : (fun t => (F2 t) _R^ F) = (fun t => ((F2 t) _R^ (F1 t)) *m ((F1 t) _R^ F)). by rewrite funeqE => ?; rewrite FromTo_comp. -move/(congr1 (fun x => derive1mx x)). +move/(congr1 (fun x => 'D_(1:R^o) x)). rewrite funeqE. move/(_ t). rewrite derive1mxM; last 2 first. - move=> t'; exact: derivable_mx_FromTo'. - move=> t'; exact: derivable_mx_FromTo. + apply/derivable_mxP. + exact: derivable_mx_FromTo'. + apply/derivable_mxP. + exact: derivable_mx_FromTo. rewrite derive1mx_ang_vel; last 2 first. move=> t'; by rewrite FromTo_is_O. - move=> t'; exact: derivable_mx_FromTo. + move=> t'. + apply/derivable_mxP. + (*apply: derivable_mx_FromTo.*) admit. rewrite derive1mx_ang_vel; last 2 first. move=> t'; by rewrite FromTo_is_O. - move=> t'; exact: derivable_mx_FromTo'. + move=> t'. + apply/derivable_mxP. + (*apply: derivable_mx_FromTo'.*) admit. rewrite derive1mx_ang_vel; last 2 first. move=> t'; by rewrite FromTo_is_O. - move=> t'; exact: derivable_mx_FromTo. +(* move=> t'; exact: derivable_mx_FromTo.*) admit. rewrite ang_vel_mxE; last 2 first. move=> t'; by rewrite FromTo_is_O. - move=> t'; exact: derivable_mx_FromTo. +(* move=> t'; exact: derivable_mx_FromTo.*) admit. rewrite ang_vel_mxE; last 2 first. move=> t'; by rewrite FromTo_is_O. - move=> t'; exact: derivable_mx_FromTo'. +(* move=> t'; exact: derivable_mx_FromTo'.*) admit. rewrite ang_vel_mxE; last 2 first. move=> t'; by rewrite FromTo_is_O. - move=> t'; exact: derivable_mx_FromTo. +(* move=> t'; exact: derivable_mx_FromTo.*) admit. rewrite mulmxE -[in X in _ = X + _](mulr1 ((F2 t) _R^ (F1 t))). rewrite -(@orthogonal_tr_mul _ _ (F _R^ (F1 t))) ?FromTo_is_O //. rewrite -{2}(trmx_FromTo (F1 t) F). @@ -553,7 +558,7 @@ move/mulrI. rewrite FromTo_unit => /(_ isT)/eqP. rewrite spin_inj => /eqP. by rewrite addrC. -Qed. +Admitted. End link_velocity. @@ -595,17 +600,21 @@ by rewrite derive1_cos mulrC mulNr mulrN. Qed. Lemma derive1mx_RzE (R : realType) (a : R^o -> R^o) t : derivable a t 1 -> - derive1mx (fun x => Rz (a x) : 'M[R^o]__) t = + 'D_1 (fun x => Rz (a x) : 'M[R^o]__) t = derive1 a t *: col_mx3 (row3 (- sin (a t)) (cos (a t)) 0) (row3 (- cos (a t)) (- sin (a t)) 0) 0. Proof. move=> Ha. apply/matrix3P/and9P; split; rewrite !mxE /=. -- rewrite (_ : (fun _ => _) = cos \o a); last by rewrite funeqE => x; rewrite !mxE. +- rewrite derive_funmxE; last first. + admit. + rewrite mxE/=. + rewrite (_ : (fun _ => _) = cos \o a); last by rewrite funeqE => x; rewrite !mxE. + rewrite -derive1E. rewrite (derive1_comp Ha); last exact/derivable_cos. by rewrite derive1_cos mulrC. -- rewrite (_ : (fun _ => _) = sin \o a); last by rewrite funeqE => x; rewrite !mxE. +(*- rewrite (_ : (fun _ => _) = sin \o a); last by rewrite funeqE => x; rewrite !mxE. rewrite (derive1_comp Ha); last exact/derivable_sin. by rewrite derive1_sin mulrC. - rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. @@ -628,7 +637,7 @@ apply/matrix3P/and9P; split; rewrite !mxE /=. by rewrite derive1_cst mulr0. - rewrite (_ : (fun _ => _) = cst 1); last by rewrite funeqE => x; rewrite !mxE. by rewrite derive1_cst mulr0. -Qed. +Qed.*) Admitted. (* example 3.1 [sciavicco]*) (* rotational motion of one degree of freedom manipulator *) @@ -709,7 +718,7 @@ Let trans t := scara_trans (theta1 t) a1 (theta2 t) a2 (d3 t) d4. Definition scara_end_effector t : 'M[R]_4 := hom (rot t) (trans t). Let scara_lin_vel : R -> 'rV[R]_3 := - derive1mx (@trans_of_hom R^o \o scara_end_effector). + 'D_1 (@trans_of_hom R^o \o scara_end_effector). Let scara_ang_vel : R -> 'rV[R]_3 := ang_vel (@rot_of_hom R^o \o scara_end_effector). @@ -723,7 +732,7 @@ Definition scara_joints : 'I_4 -> joint R := Definition scara_joint_variables t : 'rV[R^o]_4 := \row_i (joint_variable (scara_joints i) t). -Let scara_joint_velocities : R -> 'rV[R^o]_4 := derive1mx scara_joint_variables. +Let scara_joint_velocities : R -> 'rV[R^o]_4 := 'D_1 scara_joint_variables. (* specification of scara frames *) Variables scara_frames : 'I_5 -> R -> tframe R. @@ -756,7 +765,7 @@ rewrite /geo_jac; set a := (X in _ *m @row_mx _ _ 3 3 X _). rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). - rewrite /scara_lin_vel (_ : @trans_of_hom R \o _ = trans); last first. rewrite funeqE => x /=; exact: trans_of_hom_hom. - rewrite /trans /scara_trans derive1mx_matrix [RHS]row3_proj /= ![in RHS]mxE [in RHS]/=. +(* rewrite /trans /scara_trans derive1mx_matrix [RHS]row3_proj /= ![in RHS]mxE [in RHS]/=. transitivity ( derive1 (theta1 : R^o -> R^o) t *: (Fim1 0 t)~k *v (\o{Fmax t} - \o{Fim1 0 t}) + derive1 (theta2 : R^o -> R^o) t *: (Fim1 1 t)~k *v (\o{Fmax t} - \o{Fim1 1 t}) + @@ -904,7 +913,7 @@ rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). exact: H2. rewrite deriveD; [| exact: H1| exact H2]. by rewrite 3!derive1E. -Qed. +Qed.*) Admitted. End scara_geometric_jacobian. @@ -918,10 +927,9 @@ Variable (phi : 'rV[R^o]_n -> 'rV[R^o]_3). Let Jphi := jacobian phi. Lemma dp (q : R^o -> 'rV[R^o]_n) t : - derive1mx (p \o q) t = derive1mx q t *m Jp (q t). (* 3.56 *) + 'D_1 (p \o q) t = 'D_1 q t *m Jp (q t). (* 3.56 *) Proof. rewrite /Jp /jacobian mul_rV_lin1. -rewrite /derive1mx. Abort. End analytical_jacobian. diff --git a/euclidean.v b/euclidean.v index 2765d591..defe0399 100644 --- a/euclidean.v +++ b/euclidean.v @@ -1671,9 +1671,8 @@ rewrite [X in _ + _ + X](_ : _ = - M 0 2%:R * M 2%:R 0); last first. rewrite [in X in X * _]/=. rewrite coefD coefM sum2E subn0 coefC coefC mulr0 add0r. rewrite coefC mul0r add0r coefM sum2E subn0 subnn coefC [in X in X * _`_1]/=. - rewrite !coefD !coefX !coefN !coefC/=. - rewrite !mul0r !addr0/= subr0 mulr1. - by rewrite mulNr. + rewrite coefD coefX coefN !coefC/= !(subr0,mul0r,mulr0,mulr1,addr0). + by rewrite coefB coefC/= subr0 coefX eqxx mulr1 mulNr. rewrite /Z. apply/(@mulrI _ 2%:R); first exact: pnatf_unit. rewrite mulrA div1r divrr ?pnatf_unit // mul1r. diff --git a/tilt.v b/tilt.v index 223b7b6e..2fd4b59d 100644 --- a/tilt.v +++ b/tilt.v @@ -1,40 +1,51 @@ From mathcomp Require Import all_ssreflect all_algebra ring. From mathcomp Require Import boolp classical_sets functions reals. -From mathcomp Require Import topology normedtype derive. +From mathcomp Require Import topology normedtype derive realfun. Require Import ssr_ext euclidean rigid frame skew derive_matrix. -Require Import lasalle pendulum. +Require Import tilt_mathcomp tilt_analysis tilt_robot. +(*Require Import lasalle pendulum.*) + +(**md**************************************************************************) +(* # tentative formalization of [1] *) +(* *) +(* defposmx M == M is definite positive *) +(* locposdef V x == V is locally positive definite at x *) +(* is_lyapunov_candidate V := locposdef V *) +(* locnegsemidef V x == V is locally negative semidefinite *) +(* LieDerivative V x == Lie derivative *) +(* solves_equation f y == the function y satisfies y' = f y *) +(* is_equilibrium_point f p := solves_equation f (cst p) *) +(* state_space f == the set points attainable by a solution *) +(* (in the sense of `solves_equation`) *) +(* is_lyapunov_stable_at f V x == Lyapunov stability *) +(* *) +(* References: *) +(* - [1] *) +(* https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) +(******************************************************************************) + Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. + Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. (* spin and matrix/norm properties*) -Lemma sqr_spin_tr {R : realType} (u : 'rV[R]_3) : (\S(u) ^+ 2)^T = \S(u) ^+ 2. -Proof. by apply/esym/eqP; rewrite -symE ; exact: sqr_spin_is_sym. Qed. - -Lemma tr_spin_mul {R : realType} (u : 'rV[R]_3) : u *m \S(u)^T = 0. -Proof. by apply: trmx_inj ; rewrite trmx_mul trmxK spin_mul_tr trmx0. Qed. -Lemma norm_spin {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v - u) ^+ 2 *m (u)^T) 0 0 = - norm (u *m \S(v)) ^+ 2. +Lemma norm_spin {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : + (u *m \S(v - u) ^+ 2 *m (u)^T) 0 0 = - norm (u *m \S(v)) ^+ 2. Proof. -rewrite spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !tr_spin_mul !addr0 -dotmulvv /dotmul trmx_mul. +rewrite spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !mul_tr_spin !addr0. +rewrite -dotmulvv /dotmul trmx_mul. rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. by rewrite tr_spin mulNmx mulmxN [in RHS]mxE opprK mulmxA. Qed. -Lemma dotmulspin1 {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v)) *d v = 0. -Proof. by apply/eqP ; rewrite dotmulC dotmul_trmx -normalvv normal_sym tr_spin_mul normalvv dotmulv0. Qed. - -Lemma dotmulspin2 {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v)) *d u = 0. -Proof. by apply/eqP ; rewrite -normalvv normal_sym spinE -normalmN (@lieC _ (vec3 R)) /= opprK crossmul_normal. Qed. - -Lemma ortho {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u - v) *d (v *m \S(u))= 0. -Proof. by rewrite dotmulBl dotmulC dotmulspin1 dotmulC dotmulspin2 subr0. Qed. - -Lemma sqr_spin {R : realType} (u : 'rV[R]_3) (norm_u1 : norm u = 1) : \S(u) *m \S(u) = u^T *m u - 1%:M. +Lemma sqr_spin {R : realType} (u : 'rV[R]_3) (norm_u1 : norm u = 1) : + \S(u) *m \S(u) = u^T *m u - 1%:M. Proof. have sqrspin : \S(u) ^+ 2 = u^T *m u - (norm u ^+ 2)%:A by rewrite sqr_spin. rewrite expr2 norm_u1 expr2 mulr1 in sqrspin. @@ -44,251 +55,51 @@ rewrite mulmxE sqrspin. by rewrite [in RHS]mxE [in RHS]mxE /= -mulNrn mxE -mulNrn. Qed. -Lemma norm_squared {R : realType} (n : nat) (u : 'rV[R]_n.+1) : (u *m (u)^T) 0 0 = norm (u) ^+2. -Proof. by rewrite -dotmulvv /dotmul. Qed. - -Lemma sqr_inj {R : rcfType} : {in Num.nneg &, injective (fun x : R => x ^+ 2)}. -Proof. by move=> x y x0 y0 /(congr1 (@Num.sqrt R)); rewrite !sqrtr_sqr! ger0_norm. Qed. - -(* PR: to MathComp *) -Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. -Proof. -set P := (RHS). -apply/polyP => -[|[|[|i]]]; last first. -- have := (rwP (leq_sizeP (char_poly M) i.+3)).2. - rewrite size_char_poly => /(_ erefl) /(_ i.+3) => ->//. - rewrite (rwP (leq_sizeP P i.+3)).2//. - rewrite /P -addrA size_addl ?size_polyXn//. - rewrite -mulNr size_MXaddC; case: ifPn => // _. - by rewrite ltnS -polyCN size_polyC; case: (_ == _). -- rewrite /P -[in RHS]addrA [RHS]coefD coefXn/= coefD -mulrN coefCM coefC/= coefN coefX/= oppr0 mulr0 !addr0. - rewrite /char_poly det_mx22//. - rewrite /char_poly_mx !mxE/= mulr1n mulr0n sub0r mulNr opprK sub0r mulrN. - rewrite coefD coefN coefCM coefC/= mulr0 subr0. - by rewrite coefM sum3E !coefE/= !(subr0,mul0r,mulr0,addr0,mulr1,add0r). -- rewrite char_poly_trace//. - by rewrite /P -addrA addrCA !coefD coefN coefCM coefX/= mulr1 coefC/= addr0 coefXn addr0. -- rewrite char_poly_det sqrrN expr1n mul1r. - by rewrite /P !coefD coefC/= coefN coefCM coefX mulr0 subr0 coefXn/= add0r. -Qed. - -Lemma lsubmx_const {R : nmodType} (r : R) m n1 n2 : lsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. -Proof. by apply/matrixP => i j; rewrite !mxE. Qed. - -Lemma rsubmx_const {R : nmodType} (r : R) m n1 n2 : rsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. -Proof. by apply/matrixP => i j; rewrite !mxE. Qed. - -From mathcomp Require Import sequences exp realfun. - -(* is it really interesting to generalize is_deriveX ?).*) -Lemma derive1_powR {K : realType} (r : K) : 1 < r -> - (fun a => if a == 0 then 0 else a `^ r)^`()%classic = - (fun x => if x == 0 then 0 else r * x `^ (r - 1)). -Proof. -rewrite /powR /=. -move => r1. -apply/funext => x/=. -case: (x == 0) => [|]. - rewrite derive1E. - apply: derive_val. - have: is_derive (0 : K) (1 : K) (fun a => if a == 0 then 0 else a `^ r) 0. - rewrite /=. -Abort. - -Global Instance is_derive1_sqrt {K : realType} (x : K) : 0 < x -> - is_derive x 1 Num.sqrt (2 * Num.sqrt x)^-1. -Proof. -move=> x_gt0. -have sqrtK : {in Num.pos, cancel (@Num.sqrt K) (fun x => x ^+ 2)}. - by move=> a a0; rewrite sqr_sqrtr// ltW. -rewrite -[x]sqrtK//. -apply: (@is_derive_inverse K (fun x => x ^+ 2)). -- near=> z. - rewrite sqrtr_sqr gtr0_norm//. - have [xz|zx|->] := ltgtP z (Num.sqrt x); last first. - + by rewrite sqrtr_gt0. - + by rewrite (lt_trans _ zx)// sqrtr_gt0. - + move: xz. - near: z. - exists (Num.sqrt x / 2). - rewrite /=. - rewrite mulr_gt0 //. - by rewrite sqrtr_gt0 x_gt0. - rewrite invr_gt0. - by []. - move=> r/=. - move=> /[swap] rx. - rewrite gtr0_norm ?subr_gt0//. - rewrite ltrBlDl. - rewrite -ltrBlDr. - apply: le_lt_trans. - rewrite subr_ge0. - rewrite ger_pMr. - rewrite invf_le1. - by rewrite ler1n. - by []. - by rewrite sqrtr_gt0. -- near=> z. - exact: exprn_continuous. -- rewrite !sqrtK//; split. - exact: exprn_derivable (* TODO: renaming *). - by rewrite exp_derive (* TODO: renaming -> issue *) expr1 scaler1. -- by rewrite mulf_neq0 ?pnatr_eq0// gt_eqF// sqrtr_gt0 exprn_gt0// sqrtr_gt0. -Unshelve. all: by end_near. -Qed. - -Lemma derive1mx_rsubmx {R: realType} n m : - forall (f : R -> 'rV[R]_(n + m)) (t : R), - derive1mx (fun x => rsubmx (f x)) t = rsubmx (derive1mx f t). -Proof. -move=> f t. -rewrite /derive1mx. -rewrite -!derive1mx_matrix /=. -apply/matrixP => i j. -rewrite !mxE /=. -rewrite /rsubmx /=. -under eq_fun do rewrite mxE mxE. -symmetry. -by under eq_fun do rewrite mxE. -Qed. +Definition defposmx {R : realType} m (M : 'M[R]_m) : Prop := + M \is sym m R /\ forall a, eigenvalue M a -> a > 0. -Lemma derive1mx_lsubmx {R: realType} n m : - forall (f : R -> 'rV[R]_(n + m)) (t : R), - derive1mx (fun x => lsubmx (f x)) t = lsubmx (derive1mx f t). -Proof. -move=> f t. -rewrite /derive1mx. -rewrite -!derive1mx_matrix /=. -apply/matrixP => i j. -rewrite !mxE /=. -rewrite /lsubmx /=. -under eq_fun do rewrite mxE mxE. -symmetry. -by under eq_fun do rewrite mxE. -Qed. - -Lemma derive_sqrt {K : realType} (r : K) : 0 < r -> - (Num.sqrt^`())%classic r = (2 * Num.sqrt r)^-1 :> K. -Proof. -move=> r0. -rewrite derive1E. -apply: derive_val. -exact: is_derive1_sqrt. -Qed. - -Definition defposmx {R : realType} m (mat : 'M[R]_(m,m)) : Prop := - mat \is sym m R /\ forall a : R, eigenvalue mat a -> a > 0. - -Lemma defposmxP {R : realType} m (mat : 'M[R]_(m,m)) : - defposmx mat <-> (forall x : 'rV[R]_m, x != 0 -> (x *m mat *m x^T) 0 0 > 0). +Lemma defposmxP {R : realType} m (M : 'M[R]_m) : + defposmx M <-> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). Proof. split. - move => []. - move => matsym. - move => eigen. - move => x xneq0. - apply/eigen. - apply/eigenvalueP. - exists x => //. - rewrite /=. - apply/matrixP. - move => i j. -(* theoreme spectral?*) + move => [matsym eigen] x xneq0. + apply/eigen/eigenvalueP; exists x => //=. + apply/matrixP => i j. + (* theoreme spectral? *) Admitted. -Lemma CauchySchwarz_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : - (a *d b)^+2 <= (a *d a) * (b *d b). -Proof. -suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. - rewrite -subr_ge0. - rewrite mulrC. - exact. -rewrite subr_ge0 expr2 mulrC !dotmulvv /= -expr2. -have [->|hb] := eqVneq b 0. - rewrite dotmulv0 expr0n. - rewrite norm0. - rewrite expr0n //=. - by rewrite mul0r. -pose t := (a *d b) / (norm b ^+ 2). -have h : 0 <= norm (a - t *: b) ^+ 2. - rewrite exprn_ge0 //. - by rewrite norm_ge0. -rewrite -(dotmulvv (a - t *: b)) in h. -rewrite dotmulBl dotmulBr dotmulvv in h. -rewrite dotmulvZ in h. -rewrite -dotmulvv in h. -rewrite /t in h. -have h1 : 0 <= a *d a - (a *d b) ^+ 2 / norm b ^+ 2. - move: h. - rewrite dotmulBr dotmulvZ. - rewrite (dotmulC ((a *d b / norm b ^+ 2) *: b) a). - rewrite dotmulvZ dotmulC dotmulvv /t expr2 -!expr2 dotmulZv dotmulvv. - rewrite divfK /=; last first. - by rewrite sqrf_eq0 norm_eq0. - by rewrite subrr subr0 !expr2 mulrAC. -have h2 : 0 <= norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. - have pos: 0 < norm b ^+ 2. - by rewrite exprn_gt0 // norm_gt0. - suff: norm b ^+ 2 * (a *d a - (a *d b) ^+ 2 / norm b ^+ 2) = - norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. - move=> eq_step. - rewrite -eq_step. - by apply: mulr_ge0; [rewrite ltW | exact h1]. - rewrite mulrBr. - congr (_ - _)%R. - by rewrite mulrCA divff ?mulr1// sqrf_eq0 norm_eq0. -rewrite -subr_ge0 mulrC. -by rewrite dotmulvv mulrC in h2. -Qed. - -(* not used *) -Lemma young_inequality_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : - (a *d b) <= (2^-1 * (norm a)^+2) + (2^-1 * (norm b)^+2). -Proof. -have normage0 : 0 <= (norm a)^+2. - rewrite expr2. - by rewrite mulr_ge0 // norm_ge0. -have normbge0 : 0 <= (norm(b))^+2. - rewrite expr2. - by rewrite mulr_ge0 // norm_ge0. -rewrite -!dotmulvv. -have: 0 <= norm(a - b)^+2. - rewrite expr2. - by rewrite mulr_ge0 // norm_ge0. -rewrite -dotmulvv dotmulD !dotmulvv. -move => h. -rewrite -mulr_natl in h. -have h2 : 2 * (a *d b) <= norm a ^+ 2 + norm (- b) ^+ 2. - rewrite -subr_ge0. - rewrite dotmulvN mulrN in h. - by rewrite addrAC. -rewrite -ler_pdivlMl// in h2. -rewrite -mulrDr. -by rewrite normN in h2. -Qed. - Local Open Scope classical_set_scope. Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := V x = 0 /\ \forall z \near 0^', V z > 0. -(* locally positive semi definite*) +Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) + (x0 : 'rV[K]_n.+1) := locposdef V x0. + +(* locally positive semi definite (NB* not used yet) *) Definition lpsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := V x = 0 /\ \forall z \near 0^', V z >= 0. -(*locally negative semidefinite *) +(* locally negative semidefinite *) Definition locnegsemidef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := V x = 0 /\ \forall z \near 0^', V z <= 0. -(*locally negative definite*) +(* locally negative definite (NB: not used yet) *) Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := V x = 0 /\ \forall z \near 0^', V z < 0. -Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := - lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. +Section derive_matrix. +Variable R : realFieldType. +Context {m n : nat}. -Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := - \row_(i < n.+1) partial f a i. +From mathcomp Require Import constructive_ereal. + +Lemma derive1mxE'' (M : R -> 'M[R]_(m.+1, n.+1)) (t : R) : + derivable M t 1 -> + M^`() t = \matrix_(i < m.+1, j < n.+1) (fun t : R => M t i j)^`() t. +Admitted. (* Proved in MathComp-Analysis, to be PRed *) + +End derive_matrix. Section derive_help. Local Open Scope classical_set_scope. @@ -319,12 +130,40 @@ Search lim ( 'M_(_,_)). Admitted. Local Close Scope classical_set_scope. -Lemma derive1mxE' {R : realFieldType} {m n} (M : R -> 'M[R]_(m.+1, n.+1)) t : - derive1mx M t = M^`()%classic t. +Local Open Scope classical_set_scope. +Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : + (1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() t = + 2*(fun t => ('D_1 u t *m (u t)^T)``_0) t :> K. Proof. -apply/matrixP => j i. -by rewrite /derive1mx !mxE !derive1E derivemx_derive. -Qed. +rewrite [LHS]derive1E deriveMl/=; last first. + admit. +rewrite -derive1E mul1r. +under eq_fun do rewrite -dotmulvv. +rewrite dotmulP mxE /= mulr1n. +rewrite derive1E. +rewrite derive1mx_dotmul ; last 2 first. +admit. +admit. +rewrite dotmulC. +by field. +Admitted. + +Lemma derive1mx_row_mx {R : realFieldType} {n : nat} {m : nat} : +forall (f : R -> 'rV[R]_(n.+1 + m.+1)) (g : R -> 'rV[R]_(n.+1 + m.+1)) (t : R), + 'D_1 (fun x => row_mx (f x) (g x)) t = + row_mx ('D_1 f t) ('D_1 g t). +Admitted. + +End derive_help. + +Section gradient. + +Definition jacobian1 {R : numFieldType} n (f : 'rV[R]_n.+1 -> R) + : 'rV_n.+1 -> 'cV_n.+1 := + jacobian (scalar_mx \o f). + +Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := + lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) (i : 'I_n.+1) : @@ -335,13 +174,7 @@ under eq_fun do rewrite (addrC a). by under [in RHS]eq_fun do rewrite !mxE/= !mulr1n. Qed. -Lemma gradient_partial_sum {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : - gradient_partial f a = \sum_(i < n.+1) partial f a i *: 'e_i. -Proof. -rewrite /gradient_partial [LHS]row_sum_delta. -by under eq_bigr do rewrite mxE. -Qed. - +(* NB: not used *) Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := \row_(j < n.+1) (i == j)%:R. @@ -350,72 +183,61 @@ Lemma err_vecE {R : ringType} n (i : 'I_n.+1) : Proof. apply/rowP => j. by rewrite !mxE eqxx /= eq_sym. -Qed. +Abort. -Local Open Scope classical_set_scope. -Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : - (1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() t = - 2*(fun t => (derive1mx u t *m (u t)^T)``_0) t :> K. +Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := + \row_(i < n.+1) partial f a i. + +Lemma gradient_partial_sum {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : + gradient_partial f a = \sum_(i < n.+1) partial f a i *: 'e_i. Proof. -rewrite [LHS]derive1E deriveMl/=; last first. - admit. -rewrite -derive1E mul1r. -under eq_fun do rewrite -dotmulvv. -rewrite dotmulP mxE /= mulr1n derive1mx_dotmul ; last 2 first. -admit. -admit. -rewrite dotmulC. -by field. -Admitted. +rewrite /gradient_partial [LHS]row_sum_delta. +by under eq_bigr do rewrite mxE. +Qed. -Lemma derive1mx_row_mx {R : realFieldType} {n : nat} {m : nat} : -forall (f : R -> 'rV[R]_(n + m)) (g : R -> 'rV[R]_(n + m)) (t : R), - derive1mx (fun x => row_mx (f x) (g x)) t = - row_mx (derive1mx f t) (derive1mx g t). -Admitted. +Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> R) + (v : 'rV[R]_n.+1) : differentiable f v -> + gradient_partial f v = (jacobian1 f v)^T. +Proof. +move=> fa; apply/rowP => i. +rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE. + by rewrite partial_diff. +apply: differentiable_comp => //. +exact: differentiable_scalar_mx. +Unshelve. all: by end_near. Qed. -End derive_help. +End gradient. Section LieDerivative. -Definition jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> R) : 'rV_n.+1 -> 'cV_n.+1 := - jacobian (scalar_mx \o f). - -Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1): - gradient_partial f a = (jacobian1 f a)^T. -Proof. -rewrite /jacobian1. -apply/rowP => i. -rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. - admit. -by rewrite partial_diff. -Abort. - -Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) +Definition LieDerivative {R : realFieldType} n (V : 'rV[R]_n.+1 -> R) (x : R -> 'rV[R]_n.+1) (t : R) : R := - (jacobian1 V (x t))^T *d derive1mx x t. + (jacobian1 V (x t))^T *d 'D_1 x t. Lemma LieDerivativeMl {R : realType} n (f : 'rV_n.+1 -> R) (x : R -> 'rV_n.+1) (k : R) : + (forall t, differentiable f (x t)) -> LieDerivative (k *: f) x = k *: LieDerivative f x. Proof. +move=> dfx. rewrite /LieDerivative /jacobian1 /jacobian. rewrite !fctE. apply/funext => y. rewrite /dotmul. -rewrite (_ : (fun x0 : 'rV_n.+1 => (k *: f x0)%:M) = k *: (fun x0 : 'rV_n.+1 => (f x0)%:M)); last first. +rewrite (_ : (fun v : 'rV_n.+1 => (k *: f v)%:M) = + k *: (fun v : 'rV_n.+1 => (f v)%:M)); last first. apply/funext => v //=. - rewrite fctE. - by rewrite scale_scalar_mx. -rewrite [X in ((lin1_mx X)^T *m (derive1mx x y)^T) 0 0 = _](@diffZ R _ _ _ _ _ ); last first. - admit. + by rewrite fctE scale_scalar_mx. +rewrite [X in ((lin1_mx X)^T *m ('D_1 x y)^T) 0 0 = _](@diffZ R _ _ _ _ _ ); last first. + apply/differentiable_comp. + exact: dfx. + exact: differentiable_scalar_mx. rewrite -!trmx_mul. -rewrite ( _ : lin1_mx (k \*: 'd _ _) = k *: lin1_mx ('d (fun x0 : 'rV_n.+1 => (f x0)%:M) (x y))); last first. - apply/matrixP => i j. - by rewrite !mxE. -rewrite mxE [in RHS]mxE. -by rewrite -scalemxAr mxE. -Admitted. +rewrite ( _ : lin1_mx (k \*: 'd _ _) = + k *: lin1_mx ('d (fun x0 : 'rV_n.+1 => (f x0)%:M) (x y))); last first. + by apply/matrixP => i j; rewrite !mxE. +by rewrite mxE [in RHS]mxE -scalemxAr mxE. +Qed. Lemma LieDerivativeD {K : realType} n (f g : 'rV_n.+1 -> K) (x : K -> 'rV_n.+1) : LieDerivative (f + g) x = LieDerivative f x + LieDerivative g x. @@ -427,7 +249,7 @@ rewrite (_ : (fun x0 : 'rV_n.+1 => (f x0 + g x0)%:M) = apply/funext => v //=. apply/matrixP => i j. by rewrite !mxE mulrnDl. -rewrite [X in ((lin1_mx X )^T *m (derive1mx x t)^T) 0 0 = _ ](@diffD K _ _ _ _ (x t)) ; last 2 first. +rewrite [X in ((lin1_mx X )^T *m ('D_1 x t)^T) 0 0 = _ ](@diffD K _ _ _ _ (x t)) ; last 2 first. admit. admit. rewrite -trmx_mul. @@ -440,19 +262,20 @@ rewrite [in LHS] mulmxDr /= mxE mxE. by congr +%R; rewrite -trmx_mul [RHS]mxE. Admitted. -Lemma LieDerivative_eq0_equilibrium {K : realType} n +Lemma derivative_LieDerivative_eq0 {K : realType} n (f : 'rV_n.+1 -> K) (x : K -> 'rV[K]_n.+1) (t : K) : + derivable x t 1 -> 'D_1 x t = 0 -> LieDerivative f x t = 0. Proof. -move => dtraj. +move=> xt1 dtraj. rewrite /LieDerivative /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. -by rewrite derive1mxE' /= mxE mxE /= derive1E dtraj mul0mx /= mxE /=. +by rewrite dtraj mul0mx !mxE. Qed. Lemma LieDerivative_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) (x : K -> 'rV[K]_6) (t : K) : LieDerivative (fun y => (norm (f y)) ^+ 2) x t = - (2%:R *: derive1mx (f \o x) t *m (f (x t))^T) 0 0. + (2%:R *: 'D_1 (f \o x) t *m (f (x t))^T) 0 0. Proof. rewrite /LieDerivative. rewrite /jacobian1. @@ -469,20 +292,19 @@ rewrite derive1Ml; last first. rewrite mul1r. rewrite !mxE. rewrite derive1E. -transitivity ( ('D_(derive1mx x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). +transitivity ( ('D_('D_1 x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). admit. rewrite deriveE ; last first. admit. -rewrite derive1mxE'. -rewrite derive1E. +rewrite derive_funmxE//=; last admit. rewrite deriveE ; last first. admit. transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). -by []. + (*by [].*) admit. rewrite -diff_comp; last 2 first. admit. admit. -rewrite deriveE //. +(*rewrite deriveE //.*) admit. Admitted. @@ -491,62 +313,39 @@ End LieDerivative. (* not used, can be shown to be equivalent to LieDerivative *) Definition LieDerivative_partial {R : realType} n (V : 'rV[R]_n.+1 -> R) (a : R -> 'rV[R]_n.+1) (t : R) : R := - \sum_(i < n.+1) (partial V (a t) i * (derive1mx a t) ``_ i). + \sum_(i < n.+1) (partial V (a t) i * ('D_1 a t) ``_ i). -Section ode. +Section ode_equation. Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Local Open Scope classical_set_scope. +Let T := 'rV[K]_n.+1. Variable f : (K -> T) -> K -> T. -Definition is_solution (x : K -> T) : Prop := - forall t, derive1mx x t = f x t. +Definition solves_equation (x : K -> T) : Prop := + forall t, 'D_1 x t = f x t. -Definition is_equilibrium_point p := is_solution (cst p). +Definition is_equilibrium_point p := solves_equation (cst p). Definition equilibrium_points := [set p : T | is_equilibrium_point p]. Definition state_space := - [set p : T | exists y, is_solution y /\ exists t, p = y t]. - -End ode. + [set p : T | exists y, solves_equation y /\ exists t, p = y t]. -Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) - (x0 : 'rV[K]_n.+1) := locposdef V x0. +End ode_equation. Definition is_lyapunov_stable_at {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) (x0 : 'rV[K]_n.+1) : Prop := [/\ is_equilibrium_point f x0, - is_lyapunov_candidate V x0 & - forall traj : K -> 'rV[K]_n.+1, - is_solution f traj -> - traj 0 = x0 -> - locnegsemidef (LieDerivative V traj) 0]. - -Local Close Scope classical_set_scope. - -Section problem_statement. -Context {K : realType}. -Variable g0 : K. -Hypothesis g0_pos : 0 < g0. -Variable m : 'rV[K]_3. -Variable R : K -> 'M[K]_3. -Variable w : 'rV[K]_3. (* angular velocity *) -Variable v : K -> 'rV[K]_3. - -Definition ez : 'rV[K]_3 := 'e_2. -Definition x2 t := ez *m (R t)^T. -Definition x3 t := m *m (R t)^T. -Definition rhs24 t := m *m (R t)^T. -Definition rhs23 t := - v t *m \S(w) + derive1mx v t + g0 *: ez *m (R t)^T. -Definition eqn25 t := derive1mx R t = R t *m \S(w). - -End problem_statement. - + is_lyapunov_candidate V x0 & + forall traj : K -> 'rV[K]_n.+1, + solves_equation f traj -> + traj 0 = x0 -> + locnegsemidef (LieDerivative V traj) 0]. + +(* see Appendix VII.A of + https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) Section basic_facts. Variable K : realType. @@ -570,7 +369,7 @@ rewrite fact212 mulrBl -mulmxE -mulmxA; have: v *m \S(v) = 0. apply: trmx_inj. by rewrite trmx_mul tr_spin mulNmx spin_mul_tr trmx0 oppr0. move => ->. -by rewrite mulmx0 sub0r -mul_scalar_mx -mulNmx; congr (_ *m _) ; rewrite scalemx1 rmorphN /=. +by rewrite mulmx0 sub0r -mul_scalar_mx -mulNmx; congr (_ *m _); rewrite scalemx1 rmorphN. Qed. Lemma fact215 ( v w : 'rV[K]_3) : \S(w *m \S(v)) = \S(w) * \S(v) - \S(v) * \S(w). @@ -586,7 +385,8 @@ Lemma fact217 (v : 'rV[K]_3): \S(v) ^+ 3 = - (norm v ^+2) *: \S(v). exact: spin3. Qed. -Lemma fact214 (R : 'M[K]_3) (v_ : seq 'rV[K]_3) : R \is 'SO[K]_3 -> R^T * (\prod_(i <- v_) \S( i )) * R = (\prod_(i <- v_) \S( i *m R)). +Lemma fact214 (R : 'M[K]_3) (v_ : seq 'rV[K]_3) : R \is 'SO[K]_3 -> + R^T * (\prod_(i <- v_) \S( i )) * R = (\prod_(i <- v_) \S( i *m R)). Proof. move => RSO. elim/big_ind2 : _ => //. @@ -601,31 +401,26 @@ elim/big_ind2 : _ => //. - move => i true. exact: spin_similarity. Qed. -End basic_facts. - -Section Gamma1. -Context {K : realType}. -Local Open Scope classical_set_scope. - -Definition Gamma1 := [set x : 'rV[K]_6 | norm ('e_2 - @rsubmx _ 1 3 3 x) = 1]. -End Gamma1. +End basic_facts. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). +Definition state_space33 {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. + (* definition du probleme *) Record equa_diff (K : realType) := { equa_f : 'rV[K]_6 -> 'rV[K]_6 ; (* autonomous *) equa_S0 : set 'rV[K]_6 ; (* intended to be invariant *) equa_fk : exists k, k.-lipschitz_equa_S0 equa_f ; - (* hypothesis for existence and uniqueness of a solution *) + (* hypothesis for existence and uniqueness of a solution (NB: not really used yet) *) equa_t0 : K ; (* initial time *) }. -Definition is_invariant_solution_equa_diff - {K : realType} (e : equa_diff K) (y : K -> 'rV[K]_6) := - is_solution (fun y t => equa_f e (y t)) y /\ +Definition is_invariant_solution_equa_diff {K : realType} + (e : equa_diff K) (y : K -> 'rV[K]_6) := + solves_equation (fun y t => equa_f e (y t)) y /\ (y (equa_t0 e) \in equa_S0 e -> (forall t, t > 0 -> y (equa_t0 e + t) \in equa_S0 e)). @@ -636,7 +431,7 @@ Variable gamma : K. Variable y0 : K -> 'rV[K]_6. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Hypothesis y0init: y0 0 \in Gamma1. +Hypothesis y0init : y0 0 \in state_space33. Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := let zp1_point := Left \o zp1_z2_point in @@ -686,7 +481,7 @@ gamma1 ⊆ state_space*) state_space ⊆ gamma1 *) -Lemma inv_Gamma1 p (p33 : state_space eqn33 p) : +Lemma invariant_state_space33 p (p33 : state_space eqn33 p) : let y := sval (cid p33) in let t := sval (cid (svalP (cid p33)).2) in forall Delta, Delta >= 0 -> state_space eqn33 (y (t + Delta)). @@ -700,21 +495,16 @@ case: cid => t'/= pt'. eexists. Abort. -Lemma thm11a : state_space eqn33 = Gamma1. +Lemma thm11a : state_space eqn33 = state_space33. Proof. -(* toute solution de eqn33 est dans gamma -nagumo theorem *) apply/seteqP; split. -- move=> p. - move=> [y [Heq]]. - case. - move=> t. - move=> ->. - have Heqt := Heq t. - have : derive1(fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. - transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). +- move=> p [y [y33]] [t ->]. + have : derive1 (fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. + transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). apply/funext => x. - rewrite -!derive1mxE' /= /dotmul. + rewrite !derive1E. + rewrite derive_funmxE; last admit. + rewrite /dotmul. under eq_fun do rewrite dotmulP /=. rewrite dotmulP. rewrite !mxE /= mulr1n. @@ -722,75 +512,72 @@ apply/seteqP; split. rewrite !derive1mx_dotmul; last 2 first. admit. admit. - rewrite /dotmul /= !derive1mxE' /= [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. + rewrite /dotmul /=. + rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. - rewrite -!derive1mxE' !mxE /= !mulr1n. - have -> : (derive1mx (fun x0 : K => 'e_2 - Right (y x0)) x) - = - (Right (derive1mx y x)). + rewrite !mxE /= !mulr1n. + have -> : ('D_1 (fun x0 : K => 'e_2 - Right (y x0)) x) + = - (Right ('D_1 y x)). rewrite derive1mxB /= ; last 2 first. + exact: derivable_cst. admit. - admit. - rewrite derive1mx_cst /= sub0r. + rewrite derive_cst /= sub0r. congr (-_). - apply derive1mx_rsubmx. + by apply derive1mx_rsubmx. + rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. + apply/matrixP => a b; rewrite !mxE. + rewrite derive_funmxE//= ?mxE//. + admit. ring. - have : forall t, (Right (y^`()%classic t) = (gamma *: (Right (y t) - Left (y t)) *m \S('e_2 - Right (y t)) ^+ 2)). - move => t0. - rewrite -derive1mxE'. - rewrite Heq. - by rewrite row_mxKr. - move => Rsu. - apply/funext => t0. - rewrite /dotmul. - transitivity (-2 * (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2 - *m ('e_2 - Right (y t0))^T) 0 0). - by rewrite Rsu /=. - rewrite !mulmxA. - apply/eqP. - rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. - by rewrite !mulmx0 mxE. - under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0*) - move => h. - have norm_constant : norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. - have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. - move => x0. - apply: DeriveDef. - admit. - by rewrite -derive1E h. - rewrite /=. - move/is_derive_0_is_cst. - move/ (_ _ 0). - move => s0. - by apply: s0. - move: y0init. - rewrite inE /Gamma1 /=. - move=> Hnorm0. (* reecrire ce charabia*) - replace y with y0. (* vient de l'unicite des solutions de l'EDO. cauchy lipschitz ... *) - replace y with y0 in norm_constant. - rewrite Hnorm0 in norm_constant. - move: norm_constant. - move=> Hsq. + have Rsu t0 : (Right (y^`()%classic t0) = + (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2)). + rewrite derive1E. + rewrite y33. + by rewrite row_mxKr. + apply/funext => t0. + rewrite /dotmul. + transitivity (-2 * (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2 + *m ('e_2 - Right (y t0))^T) 0 0). + by rewrite Rsu /=. + rewrite !mulmxA. apply/eqP. - rewrite [RHS]expr2 mulr1 in Hsq. - move/eqP in Hsq. - rewrite sqrp_eq1 in Hsq ; last first. - exact: norm_ge0. - exact : Hsq. - admit. - admit. -- move=> p. - rewrite /state_space /Gamma1 /eqn33 /is_solution /=. - move=> norme. - exists 0. - split. - move => t. - rewrite derive1mx_cst /=. - rewrite !lsubmx_const !rsubmx_const /= !scalerBr /=. - by rewrite !scaler0 subr0 mul0mx row_mx0 /=. - have init : p = 0 0. (* most likely a false hypothesis*) + rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. + by rewrite !mulmx0 mxE. + under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0 *) + move => h. + have norm_constant : norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. + have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. + move => x0. + apply: DeriveDef. + admit. + by rewrite -derive1E h. + rewrite /=. + move/is_derive_0_is_cst. + move/ (_ _ 0). + move => s0. + by apply: s0. + rewrite /state_space33/=. + move: y0init. + rewrite inE /state_space33 /=. + move=> Hnorm0. (* reecrire ce charabia *) + +(* replace y with y0. (* vient de l'unicite des solutions de l'EDO. cauchy lipschitz ... *) + replace y with y0 in norm_constant. + rewrite Hnorm0 in norm_constant. + move: norm_constant. + move=> Hsq. + apply/eqP. + rewrite [RHS]expr2 mulr1 in Hsq. + move/eqP in Hsq. + rewrite sqrp_eq1 in Hsq ; last first. + exact: norm_ge0. + exact : Hsq. admit. - exists 0. - apply init. + admit.*) admit. +- move=> p. + move=> p_statespace33. + rewrite /state_space. + rewrite /=. Admitted. Definition point1 : 'rV[K]_6 := 0. @@ -798,16 +585,17 @@ Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). Lemma equilibrium_point1 : is_equilibrium_point eqn33 point1. Proof. -move=> t ; rewrite derive1mx_cst /eqn33 /point ; apply/eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. - rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; by rewrite !mxE. - apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. - rewrite /N /=; apply /rowP; move => a; by rewrite !mxE subr0. - move => n; by rewrite n scaler0 mul0mx. +move=> t; rewrite derive_cst /eqn33 /point; apply/eqP. +rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. + by rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; rewrite !mxE. +apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. + rewrite /N /=; apply /rowP; move => a; by rewrite !mxE subr0. +by move => n; rewrite n scaler0 mul0mx. Qed. Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2. Proof. -move => t; rewrite derive1mx_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. +move => t; rewrite derive_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). have N0 : N = 0. apply/rowP; move => i; rewrite !mxE; case: splitP. @@ -832,9 +620,8 @@ rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// sca by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. Qed. -Open Scope classical_set_scope. -(* this lemma asks for lyapunov + lasalle*) -Lemma tractories_converge (y : K -> 'rV[K]_6) : is_solution eqn33 y -> +(* this lemma asks for lyapunov + lasalle *) +Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation eqn33 y -> y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. Proof. move=> is_sol_y. @@ -966,34 +753,18 @@ Variable R : K -> 'M[K]_3. Variable v : K -> 'rV[K]_3. Definition x1 := v. Variable y0 : K -> 'rV[K]_6. -Hypothesis y0init: y0 0 \in Gamma1. -Hypothesis y0sol : is_solution (eqn33 alpha1 gamma) y0. - -Definition p1 t : 'rV[K]_3 := - let x1_t := x1 t in - let x2_t := x2 R t in - let x1_hat_t := x1_hat t in - x2_t + (alpha1 / g0) *: (x1_t - x1_hat_t). - -Definition x2_tilde t : 'rV[K]_3 := - let x2_t := x2 R t in - let x2_hat_t := x2_hat t in - (x2_t - x2_hat_t). (* dependance des conditions intiales de ^x2 qui doit etre sur S2.*) - -Definition zp1_z2_eq t (zp1_z2 : K -> 'rV[K]_6) : 'rV[K]_6 := - let zp1 := Left \o zp1_z2 in - let z2 := Right \o zp1_z2 in - row_mx (p1 t *m R t) (x2_tilde t *m R t). - -Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : is_solution (eqn33 alpha1 gamma) traj -> - derive1mx (Left \o traj) z = - alpha1 *: Left (traj z). +Hypothesis y0init: y0 0 \in state_space33. +Hypothesis y0sol : solves_equation (eqn33 alpha1 gamma) y0. + +Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj -> + 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). Proof. move=> /(_ z)/(congr1 Left). by rewrite row_mxKl => ?; rewrite derive1mx_lsubmx. Qed. -Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : is_solution (eqn33 alpha1 gamma) traj -> - derive1mx (Right \o traj) z = +Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj -> + 'D_1 (Right \o traj) z = gamma *: (Right (traj z) - Left (traj z)) *m \S('e_2 - Right (traj z)) ^+ 2. Proof. by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive1mx_rsubmx. @@ -1004,9 +775,9 @@ Let c2 := 2^-1 / gamma. Lemma derive_V1dot (z : K) (traj : K -> 'rV_6) (zp1 := Left \o traj) (z2 := Right \o traj) : - is_solution (eqn33 alpha1 gamma) traj -> - c1 *: (2 *: derive1mx zp1 z *m (Left (traj z))^T) 0 0 + - c2 *: (2 *: derive1mx z2 z *m (Right (traj z))^T) 0 0 + solves_equation (eqn33 alpha1 gamma) traj -> + c1 *: (2 *: 'D_1 zp1 z *m (Left (traj z))^T) 0 0 + + c2 *: (2 *: 'D_1 z2 z *m (Right (traj z))^T) 0 0 = V1dot (traj z). Proof. move=> ?. @@ -1020,11 +791,21 @@ rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK -[X in _ = (_ *m (X *m _)) 0 0]trmxK. rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE. rewrite -(mulmxA (Right (traj z) - (Left (traj z)))) mulmxE -expr2. -rewrite sqr_spin_tr. +rewrite tr_sqr_spin. by rewrite mulmxA. Qed. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : is_solution (eqn33 alpha1 gamma) x -> +Lemma differentiable_norm_Left (y : 'rV[K]_6) : + differentiable (fun x : 'rV_6 => norm (Left x) ^+ 2 : K) y. +Proof. +Admitted. + +Lemma differentiable_norm_Right (y : 'rV[K]_6) : + differentiable (fun x : 'rV_6 => norm (Right x) ^+ 2 : K) y. +Proof. +Admitted. + +Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (eqn33 alpha1 gamma) x -> LieDerivative (V1 alpha1 gamma) x t = V1dot (x t). Proof. move=> eqn33x. @@ -1034,44 +815,46 @@ rewrite !invfM /=. rewrite fctE. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. -rewrite !LieDerivativeMl !fctE !LieDerivative_norm /=. +rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Left. +rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Right. +rewrite !fctE !LieDerivative_norm /=. by rewrite derive_V1dot. Qed. (* TODO: Section general properties of our system *) -Lemma Gamma1_traj (traj : K -> 'rV_6) t : - is_solution (eqn33 alpha1 gamma) traj -> Gamma1 (traj t). +Lemma Gamma1_traj (y : K -> 'rV_6) t : + solves_equation (eqn33 alpha1 gamma) y -> state_space33 (y t). Proof. move=> iss. rewrite -(thm11a gamma_gt0 alpha1_gt0 y0init ). -exists traj; split => //. +exists y; split => //. by exists t. Qed. Lemma norm_u1 (traj : K -> 'rV_6) (z : K) (z2 := Right \o traj) (zp1 := Left \o traj) (u := 'e_2 - z2 z) : - is_solution (eqn33 alpha1 gamma) traj -> norm u = 1. + solves_equation (eqn33 alpha1 gamma) traj -> norm u = 1. Proof. move=> dtraj. -suff: Gamma1 (row_mx (zp1 z) (z2 z)) by rewrite /Gamma1/= row_mxKr. +suff: state_space33 (row_mx (zp1 z) (z2 z)) by rewrite /state_space33/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. exact/Gamma1_traj. Qed. Lemma Hsq (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : - is_solution (eqn33 alpha1 gamma) traj -> + solves_equation (eqn33 alpha1 gamma) traj -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> dtraj. rewrite /dotmul !trmx_mul !tr_spin !mulNmx mulmxN opprK mulmxN !dotmulP. have key_ortho : (z2 z *m \S('e_2)) *d u = 0. - by rewrite dotmulC ; apply/ortho. + by rewrite dotmulC; exact/ortho_spin. rewrite key_ortho expr2. rewrite [in RHS]mxE. rewrite [X in _ = - (w *m (\S('e_2) *m (z2 z)^T)) 0 0 * (u *d u)%:M 0 0 - 0%:M 0 0 * X]mxE mulr1n mulr0 subr0/=. rewrite /u -/w /dotmul. -have Hw_ortho : (w *d u) = 0 by rewrite /u dotmulC ortho. +have Hw_ortho : (w *d u) = 0 by rewrite /u dotmulC ortho_spin. rewrite !mulmxA dotmulP dotmulvv norm_u1 // expr2 mulr1. rewrite [X in _ = - (w *m \S('e_2) *m (z2 z)^T) 0 0 * X]mxE /= mulr1n /=. rewrite [X in _ = - (w *m \S('e_2) *m (z2 z)^T) 0 0 * X]mxE /= mulr1. @@ -1083,7 +866,7 @@ by rewrite 2!mulNmx mulmx1 mxE. Qed. Lemma neg_spin (traj : K -> 'rV_6) (z : K) : - is_solution (eqn33 alpha1 gamma) traj -> + solves_equation (eqn33 alpha1 gamma) traj -> norm (Right (traj z) *m \S('e_2) *m - \S('e_2 - Right (traj z))) = norm (Right (traj z) *m \S('e_2)). Proof. @@ -1092,16 +875,15 @@ rewrite mulmxN normN. pose zp1 := fun r => Left (traj r). pose z2 := fun r => Right (traj r). set w := (z2 z) *m \S('e_2). -have Gamma1_traj t : Gamma1 (traj t) by apply/Gamma1_traj. +have Gamma1_traj t : state_space33 (traj t) by apply/Gamma1_traj. rewrite /norm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. have Hnorm_sq : norm (w *m \S('e_2 - Right (traj z))) ^+ 2 = norm w ^+ 2. rewrite -!dotmulvv Hsq // !dotmulvv norm_u1 /= //. rewrite -!dotmulvv expr2 !mul1r mulr1. - have wu0 : w *d ('e_2 - Right (traj z)) = 0. - rewrite dotmulC. - by rewrite ortho. - by rewrite wu0 expr2 mul0r subr0 //. + have -> : w *d ('e_2 - Right (traj z)) = 0. + by rewrite dotmulC ortho_spin. + by rewrite expr2 mul0r subr0. rewrite !normr_norm. by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?norm_ge0. Qed. @@ -1109,7 +891,7 @@ Qed. Lemma V1dot_ub (traj : K -> 'rV_6) (z : K) (zp1 := Left \o traj) (z2 := Right \o traj) (w := z2 z *m \S('e_2)) (u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i) : - is_solution (eqn33 alpha1 gamma) traj -> + solves_equation (eqn33 alpha1 gamma) traj -> V1dot (traj z) <= (- u1 *m u2 *m u1^T) 0 0. Proof. move=> dtrak. @@ -1117,7 +899,7 @@ rewrite mxE. rewrite /V1dot. rewrite mxE norm_spin mxE addrA expr2 mulmxA. have -> : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2). - by rewrite spinD spinN -tr_spin !mulmxDr !tr_spin_mul !addr0. + by rewrite spinD spinN -tr_spin !mulmxDr !mul_tr_spin !addr0. rewrite -/w -dotmulNv addrC -mulmxN -expr2. have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= norm(w *m - (\S('e_2 - z2 z))) * norm(zp1 z). @@ -1140,7 +922,7 @@ Qed. (* TODO: rework of this proof is needed *) Lemma near0_le0 (traj : K -> 'rV_6) : - is_solution (eqn33 alpha1 gamma) traj -> + solves_equation (eqn33 alpha1 gamma) traj -> traj 0 = point1 -> \forall z \near 0^', (LieDerivative (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) traj + @@ -1151,7 +933,9 @@ near=> z. rewrite !fctE !invfM /=. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. -rewrite !LieDerivativeMl /= !fctE !LieDerivative_norm derive_V1dot //. +rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Left. +rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Right. +rewrite /= !fctE !LieDerivative_norm derive_V1dot //. pose zp1 := Left \o traj. pose z2 := Right \o traj. set w := (z2 z) *m \S('e_2). @@ -1167,13 +951,13 @@ rewrite -oppr_ge0 -oppr_le0 opprK ltW//. by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. Unshelve. all: try by end_near. Qed. -Lemma V1_point_is_lnsd (traj : K -> 'rV_6) : - is_solution (eqn33 alpha1 gamma) traj -> - traj 0 = point1 -> - locnegsemidef (LieDerivative (V1 alpha1 gamma) traj) 0. +Lemma V1_point_is_lnsd (y : K -> 'rV_6) : + solves_equation (eqn33 alpha1 gamma) y -> + y 0 = point1 -> + locnegsemidef (LieDerivative (V1 alpha1 gamma) y) 0. Proof. move=> dtraj traj0. -have Gamma1_traj t : Gamma1 (traj t) by apply/Gamma1_traj. +have Gamma1_traj t : state_space33 (y t) by apply/Gamma1_traj. rewrite /locnegsemidef /V1. rewrite LieDerivativeD /=. split; last exact/near0_le0. @@ -1181,13 +965,17 @@ rewrite !invfM /=. rewrite !fctE. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. -rewrite !LieDerivativeMl /= !fctE !LieDerivative_eq0_equilibrium; last 2 first. - rewrite -derive1E -derive1mxE' [LHS]dtraj /eqn33/= traj0 /point1. +rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Left. +rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Right. +rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. + admit. + rewrite [LHS]dtraj /eqn33/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - rewrite -derive1E -derive1mxE' [LHS]dtraj /eqn33/= traj0 /point1. + admit. + rewrite [LHS]dtraj /eqn33/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. -Qed. +Admitted. Lemma V1_is_lyapunov_stable : is_lyapunov_stable_at (eqn33 alpha1 gamma) (V1 alpha1 gamma) point1. diff --git a/tilt_analysis.v b/tilt_analysis.v new file mode 100644 index 00000000..6f906f4e --- /dev/null +++ b/tilt_analysis.v @@ -0,0 +1,72 @@ +From mathcomp Require Import all_ssreflect all_algebra ring. +From mathcomp Require Import boolp classical_sets functions reals. +From mathcomp Require Import topology normedtype derive realfun. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. +Local Open Scope ring_scope. + +Global Instance is_derive1_sqrt {K : realType} (x : K) : 0 < x -> + is_derive x 1 Num.sqrt (2 * Num.sqrt x)^-1. +Proof. +move=> x_gt0. +have sqrtK : {in Num.pos, cancel (@Num.sqrt K) (fun x => x ^+ 2)}. + by move=> a a0; rewrite sqr_sqrtr// ltW. +rewrite -[x]sqrtK//. +apply: (@is_derive_inverse K (fun x => x ^+ 2)). +- near=> z. + rewrite sqrtr_sqr gtr0_norm//. + have [xz|zx|->] := ltgtP z (Num.sqrt x); last first. + + by rewrite sqrtr_gt0. + + by rewrite (lt_trans _ zx)// sqrtr_gt0. + + move: xz. + near: z. + exists (Num.sqrt x / 2). + rewrite /=. + rewrite mulr_gt0 //. + by rewrite sqrtr_gt0 x_gt0. + rewrite invr_gt0. + by []. + move=> r/=. + move=> /[swap] rx. + rewrite gtr0_norm ?subr_gt0//. + rewrite ltrBlDl. + rewrite -ltrBlDr. + apply: le_lt_trans. + rewrite subr_ge0. + rewrite ger_pMr. + rewrite invf_le1. + by rewrite ler1n. + by []. + by rewrite sqrtr_gt0. +- near=> z. + exact: exprn_continuous. +- rewrite !sqrtK//; split. + exact: exprn_derivable (* TODO: renaming, see https://github.com/math-comp/analysis/issues/1677 *). + by rewrite exp_derive (* TODO: renaming -> issue *) expr1 scaler1. +- by rewrite mulf_neq0 ?pnatr_eq0// gt_eqF// sqrtr_gt0 exprn_gt0// sqrtr_gt0. +Unshelve. all: by end_near. Qed. + +Lemma derive_sqrt {K : realType} (r : K) : 0 < r -> + (Num.sqrt^`())%classic r = (2 * Num.sqrt r)^-1 :> K. +Proof. +move=> r0. +rewrite derive1E. +apply: derive_val. +exact: is_derive1_sqrt. +Qed. + +Lemma differentiable_scalar_mx {R : realType} n (r : R) : + differentiable (@scalar_mx _ n.+1) r. +Proof. +apply/derivable1_diffP/cvg_ex => /=. +exists 1; apply/cvgrPdist_le => /= e e0. +near=> t. +rewrite scaler1 -raddfB/= addrK (scale_scalar_mx _ t^-1) mulVf. + by rewrite subrr normr0 ltW. +by near: t; exact: nbhs_dnbhs_neq. +Unshelve. all: by end_near. Qed. diff --git a/tilt_mathcomp.v b/tilt_mathcomp.v new file mode 100644 index 00000000..ab32f357 --- /dev/null +++ b/tilt_mathcomp.v @@ -0,0 +1,46 @@ +From mathcomp Require Import all_ssreflect all_algebra ring. +Require Import ssr_ext euclidean rigid frame skew. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Local Open Scope ring_scope. + +(* to appear in MathComp 2.5.0 *) +Lemma lsubmx_const {R : nmodType} (r : R) m n1 n2 : + lsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. +Proof. by apply/matrixP => i j; rewrite !mxE. Qed. + +(* to appear in MathComp 2.5.0 *) +Lemma rsubmx_const {R : nmodType} (r : R) m n1 n2 : + rsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. +Proof. by apply/matrixP => i j; rewrite !mxE. Qed. + +Lemma sqr_inj {R : rcfType} : {in Num.nneg &, injective (fun x : R => x ^+ 2)}. +Proof. +by move=> x y x0 y0 /(congr1 (@Num.sqrt R)); rewrite !sqrtr_sqr! ger0_norm. +Qed. + +(* PR to MathComp *) +Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. +Proof. +set P := (RHS). +apply/polyP => -[|[|[|i]]]; last first. +- have := (rwP (leq_sizeP (char_poly M) i.+3)).2. + rewrite size_char_poly => /(_ erefl) /(_ i.+3) => ->//. + rewrite (rwP (leq_sizeP P i.+3)).2//. + rewrite /P -addrA size_addl ?size_polyXn//. + rewrite -mulNr size_MXaddC; case: ifPn => // _. + by rewrite ltnS -polyCN size_polyC; case: (_ == _). +- rewrite /P -[in RHS]addrA [RHS]coefD coefXn/= coefD -mulrN coefCM coefC/= coefN coefX/= oppr0 mulr0 !addr0. + rewrite /char_poly det_mx22//. + rewrite /char_poly_mx !mxE/= mulr1n mulr0n sub0r mulNr opprK sub0r mulrN. + rewrite coefD coefN coefCM coefC/= mulr0 subr0. + by rewrite coefM sum3E !coefE/= !(subr0,mul0r,mulr0,addr0,mulr1,add0r). +- rewrite char_poly_trace//. + by rewrite /P -addrA addrCA !coefD coefN coefCM coefX/= mulr1 coefC/= addr0 coefXn addr0. +- rewrite char_poly_det sqrrN expr1n mul1r. + by rewrite /P !coefD coefC/= coefN coefCM coefX mulr0 subr0 coefXn/= add0r. +Qed. diff --git a/tilt_robot.v b/tilt_robot.v new file mode 100644 index 00000000..35adc386 --- /dev/null +++ b/tilt_robot.v @@ -0,0 +1,144 @@ +From mathcomp Require Import all_ssreflect all_algebra ring. +From mathcomp Require Import boolp classical_sets functions reals. +From mathcomp Require Import topology normedtype derive. +Require Import ssr_ext euclidean rigid frame skew derive_matrix. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. +Local Open Scope ring_scope. + +(* spin and matrix/norm properties *) + +Lemma tr_sqr_spin {R : realFieldType} (u : 'rV[R]_3) : + (\S(u) ^+ 2)^T = \S(u) ^+ 2. +Proof. by apply/esym/eqP; rewrite -symE; exact: sqr_spin_is_sym. Qed. + +Lemma mul_tr_spin {R : comNzRingType} (u : 'rV[R]_3) : u *m \S(u)^T = 0. +Proof. by apply: trmx_inj; rewrite trmx_mul trmxK spin_mul_tr trmx0. Qed. + +Lemma CauchySchwarz_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : + (a *d b)^+2 <= (a *d a) * (b *d b). +Proof. +suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. + rewrite -subr_ge0. + rewrite mulrC. + exact. +rewrite subr_ge0 expr2 mulrC !dotmulvv /= -expr2. +have [->|hb] := eqVneq b 0. + rewrite dotmulv0 expr0n. + rewrite norm0. + rewrite expr0n //=. + by rewrite mul0r. +pose t := (a *d b) / (norm b ^+ 2). +have h : 0 <= norm (a - t *: b) ^+ 2. + rewrite exprn_ge0 //. + by rewrite norm_ge0. +rewrite -(dotmulvv (a - t *: b)) in h. +rewrite dotmulBl dotmulBr dotmulvv in h. +rewrite dotmulvZ in h. +rewrite -dotmulvv in h. +rewrite /t in h. +have h1 : 0 <= a *d a - (a *d b) ^+ 2 / norm b ^+ 2. + move: h. + rewrite dotmulBr dotmulvZ. + rewrite (dotmulC ((a *d b / norm b ^+ 2) *: b) a). + rewrite dotmulvZ dotmulC dotmulvv /t expr2 -!expr2 dotmulZv dotmulvv. + rewrite divfK /=; last first. + by rewrite sqrf_eq0 norm_eq0. + by rewrite subrr subr0 !expr2 mulrAC. +have h2 : 0 <= norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. + have pos: 0 < norm b ^+ 2. + by rewrite exprn_gt0 // norm_gt0. + suff: norm b ^+ 2 * (a *d a - (a *d b) ^+ 2 / norm b ^+ 2) = + norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. + move=> eq_step. + rewrite -eq_step. + by apply: mulr_ge0; [rewrite ltW | exact h1]. + rewrite mulrBr. + congr (_ - _)%R. + by rewrite mulrCA divff ?mulr1// sqrf_eq0 norm_eq0. +rewrite -subr_ge0 mulrC. +by rewrite dotmulvv mulrC in h2. +Qed. + +(* not used *) +Lemma young_inequality_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : + (a *d b) <= (2^-1 * (norm a)^+2) + (2^-1 * (norm b)^+2). +Proof. +have normage0 : 0 <= (norm a)^+2. + rewrite expr2. + by rewrite mulr_ge0 // norm_ge0. +have normbge0 : 0 <= (norm(b))^+2. + rewrite expr2. + by rewrite mulr_ge0 // norm_ge0. +rewrite -!dotmulvv. +have: 0 <= norm(a - b)^+2. + rewrite expr2. + by rewrite mulr_ge0 // norm_ge0. +rewrite -dotmulvv dotmulD !dotmulvv. +move => h. +rewrite -mulr_natl in h. +have h2 : 2 * (a *d b) <= norm a ^+ 2 + norm (- b) ^+ 2. + rewrite -subr_ge0. + rewrite dotmulvN mulrN in h. + by rewrite addrAC. +rewrite -ler_pdivlMl// in h2. +rewrite -mulrDr. +by rewrite normN in h2. +Qed. + +Lemma dotmulspin1 {R : numFieldType} (u : 'rV[R]_3) (v : 'rV[R]_3) : + (u *m \S(v)) *d v = 0. +Proof. +apply/eqP. +rewrite dotmulC dotmul_trmx -normalvv normal_sym mul_tr_spin normalvv. +by rewrite dotmulv0. +Qed. + +Lemma dotmulspin2 {R : numFieldType} (u : 'rV[R]_3) (v : 'rV[R]_3) : + (u *m \S(v)) *d u = 0. +Proof. +apply/eqP. +rewrite -normalvv normal_sym spinE -normalmN (@lieC _ (vec3 R)) /= opprK. +by rewrite crossmul_normal. +Qed. + +Lemma ortho_spin {R : numFieldType} (u : 'rV[R]_3) (v : 'rV[R]_3) : + (u - v) *d (v *m \S(u))= 0. +Proof. by rewrite dotmulBl dotmulC dotmulspin1 dotmulC dotmulspin2 subr0. Qed. + +Lemma norm_squared {R : rcfType} n (u : 'rV[R]_n) : + (u *m (u)^T) 0 0 = norm u ^+2. +Proof. by rewrite -dotmulvv /dotmul. Qed. + +Lemma derive1mx_rsubmx {R : realType} : + forall (f : R -> 'rV[R]_(3 + 3)) (t : R), + 'D_1 (fun x => rsubmx (f x)) t = @rsubmx R _ 3 3 ('D_1 f t). +Proof. +move=> f t. +apply/matrixP => i j. +rewrite !mxE /=. +rewrite /rsubmx /=. +(*under eq_fun do rewrite mxE mxE. +symmetry. +by under eq_fun do rewrite mxE. +Qed.*) Admitted. + +Lemma derive1mx_lsubmx {R : realType} : + forall (f : R -> 'rV[R]_(3 + 3)) (t : R), + 'D_1 (fun x => lsubmx (f x)) t = @lsubmx R _ 3 3 ('D_1 f t). +Proof. +move=> f t. +(*rewrite /derive1mx. +rewrite -!derive1mx_matrix /=. +apply/matrixP => i j. +rewrite !mxE /=. +rewrite /lsubmx /=. +under eq_fun do rewrite mxE mxE. +symmetry. +by under eq_fun do rewrite mxE. +Qed.*) Admitted. From 05bd28ce6a7d13a12afc5af565d9583d116ee4d1 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Wed, 30 Jul 2025 20:55:42 +0900 Subject: [PATCH 031/144] cleaning + towards context formalization --- tilt.v | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 94 insertions(+), 7 deletions(-) diff --git a/tilt.v b/tilt.v index 2fd4b59d..bdb0bfe5 100644 --- a/tilt.v +++ b/tilt.v @@ -110,7 +110,9 @@ Proof. rewrite /=. rewrite -!derive1E. rewrite (_ : (fun x => f x i j) = (fun M : 'M_(m.+1,n.+1) => M i j) \o f ) //. -rewrite fctE. +rewrite !fctE. +Search "derive" ('M_(_,_)). +rewrite derive1mxE''. Admitted. Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n @@ -424,14 +426,98 @@ Definition is_invariant_solution_equa_diff {K : realType} (y (equa_t0 e) \in equa_S0 e -> (forall t, t > 0 -> y (equa_t0 e + t) \in equa_S0 e)). -Section eqn33. +Section problem_statement. Variable K : realType. Variable alpha1 : K. Variable gamma : K. +Variable g0 : K. Variable y0 : K -> 'rV[K]_6. +Variable R : K -> 'M[K]_3. +Variable p : K -> 'rV[K]_3. +Variable y_g : K -> 'rV[K]_3. +Variable y_a : K -> 'rV[K]_3. +Variable y_m : K -> 'rV[K]_3. +Definition x1 (t : K) := 'D_1 p t *m (R t) . +Definition x2 (t : K) : 'rV_3 := 'e_2 *m R t (* eqn (8) *). +Definition S2 := [set x : 'rV[K]_3 | norm x = 1]. +Definition x1_point (t : K) := 'D_1 x1 t. +Definition x2_point (t : K) := 'D_1 x2 t. +Hypothesis RisSO : forall t, R t \is 'SO[K]_3. +Hypothesis derivableR : forall t, derivable R t 1. +Hypothesis gamma_gt0 : 0 < gamma. +Hypothesis alpha1_gt0 : 0 < alpha1. +Definition w t := ang_vel R t. + +Lemma x2_s2 (t0 : K) : x2 t0 \in S2. +Proof. +rewrite /S2 /x2 /=. +rewrite inE /= orth_preserves_norm. + by rewrite normeE. +by rewrite rotation_sub // rotationV. +Qed. + +(* eqn (11) *) + + +Lemma derive1rV_ang_vel (q : K -> 'rV[K]_3) t : + 'D_1 q t = 'D_1 (fun t => q t *m R t) t + unspin (R t) *v q t. +Proof. +Admitted. + +Lemma derive_x2point (t : K) : x2_point t = x2 t *m \S( w t ). +Proof. +rewrite /w. +rewrite -ang_vel_mxE; last 2 first. + by move=> ?; rewrite rotation_sub. + by []. +rewrite /x2_point. +rewrite /x2. +have ->: 'D_1 (fun t0 : K => 'e_2 *m (R t0)) t = ('e_2 *m 'D_1 (fun t => (R t)) t). + move => n. + rewrite /=. + rewrite derive1mxM//=; last first. + by rewrite derive_cst mul0mx add0r. +rewrite /=. +rewrite derive1mx_ang_vel /=; last 2 first. + by move=> ?; rewrite rotation_sub. + admit. +rewrite mulmxA. +done. +Admitted. + +Lemma derive_x1point (t : K) : +'D_1 x1 t = (x1 t) *m ( \S(w t) ) + + ('D_1 p t) *m \S(w t ) + + 'D_1 (fun t => 'D_1 p t) t + + const_mx g0 *m x2 t + - (x2 t) *m const_mx g0. +Proof. +rewrite -ang_vel_mxE; last 2 first. + by move=> ?; rewrite rotation_sub. + by []. +rewrite /x1 /x2. +rewrite !mulmxA /=. +rewrite -[RHS]addrA. +rewrite [X in _ = _ + _ + _ + X](_ : _ = 0) ?addr0; last first. + apply/eqP; rewrite subr_eq0; apply/eqP. + rewrite -mulmxA. + admit. +set A := 'D_1 p t. +set Rt := R t. +set dR := 'D_1 R t. +Admitted. + +End problem_statement. + +Section eqn33. +Variable K : realType. +Variable alpha1 : K. +Variable gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Hypothesis y0init : y0 0 \in state_space33. +Variable g0 : K. +Variable y0 : K -> 'rV[K]_6. +Variable R : K -> 'M[K]_3. Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := let zp1_point := Left \o zp1_z2_point in @@ -557,9 +643,10 @@ apply/seteqP; split. move => s0. by apply: s0. rewrite /state_space33/=. - move: y0init. +(* move: y0init. rewrite inE /state_space33 /=. move=> Hnorm0. (* reecrire ce charabia *) +*) (* replace y with y0. (* vient de l'unicite des solutions de l'EDO. cauchy lipschitz ... *) replace y with y0 in norm_constant. @@ -751,7 +838,6 @@ Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. Variable R : K -> 'M[K]_3. Variable v : K -> 'rV[K]_3. -Definition x1 := v. Variable y0 : K -> 'rV[K]_6. Hypothesis y0init: y0 0 \in state_space33. Hypothesis y0sol : solves_equation (eqn33 alpha1 gamma) y0. @@ -826,10 +912,10 @@ Lemma Gamma1_traj (y : K -> 'rV_6) t : solves_equation (eqn33 alpha1 gamma) y -> state_space33 (y t). Proof. move=> iss. -rewrite -(thm11a gamma_gt0 alpha1_gt0 y0init ). +rewrite -(thm11a gamma_gt0 alpha1_gt0). exists y; split => //. by exists t. -Qed. +Admitted. Lemma norm_u1 (traj : K -> 'rV_6) (z : K) (z2 := Right \o traj) (zp1 := Left \o traj) (u := 'e_2 - z2 z) : @@ -986,3 +1072,4 @@ split; first exact: equilibrium_point1. Qed. End Lyapunov. + From 96c82ab1746a7a96f7568ef84cffcd373cb15be9 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 31 Jul 2025 00:40:08 +0900 Subject: [PATCH 032/144] getting rid of admits (wip) - due to the change of definition derive1mx --- derive_matrix.v | 226 +++++++++++++++++++++++------ differential_kinematics.v | 295 ++++++++++++++++++++++++++++---------- 2 files changed, 402 insertions(+), 119 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index 1caf6e9f..2387a53f 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -280,6 +280,79 @@ apply: le_trans; last first. by rewrite /=. Unshelve. all: by end_near. Qed. +From mathcomp Require Import ring. + +Lemma derivable_row3 (a b c : R -> R) t : + derivable a t 1 -> + derivable b t 1 -> + derivable c t 1 -> + derivable (fun x : R => row3 (a x) (b x) (c x)) t 1. +Proof. +move=> /cvg_ex[/= l Hl] /cvg_ex[/= o Ho] /cvg_ex[/= p Hp]. +apply/cvg_ex; exists (row3 l o p) => /=. +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0)[r/= r0 re]. +move/cvgrPdist_le : Ho => /(_ _ e0)[s/= s0 se]. +move/cvgrPdist_le : Hp => /(_ _ e0)[u/= u0 ue]. +near=> x. +rewrite /Num.Def.normr/= mx_normrE. +apply: bigmax_le. + exact: ltW. +move=> /= [i j] _. +rewrite (ord1 i){i}/=. +rewrite row3N. +rewrite row3D. +rewrite row3Z. +rewrite row3N. +rewrite row3D. +rewrite row3E. +rewrite ![in leLHS]mxE/=. +case: fintype.splitP => [j0|]. + rewrite (ord1 j0) => _. + rewrite !mxE eqxx/= mulr1n. + apply: re. + rewrite /= sub0r normrN. + near: x. + by apply: dnbhs0_lt. + near: x. + by apply: nbhs_dnbhs_neq. +move=> k j1k. +rewrite !mxE. +case: fintype.splitP => [k0|k0]. + rewrite (ord1 k0) => _. + rewrite !mxE eqxx/= mulr1n. + apply: se. + rewrite /= sub0r normrN. + near: x. + by apply: dnbhs0_lt. + near: x. + by apply: nbhs_dnbhs_neq. +rewrite (ord1 k0) => _. +rewrite !mxE eqxx/= mulr1n. +apply: ue. +rewrite /= sub0r normrN. +near: x. +by apply: dnbhs0_lt. +near: x. +by apply: nbhs_dnbhs_neq. +Unshelve. all: by end_near. Qed. + +Lemma derivable_coord (a : R -> 'rV[R]_n.+1) t (i : 'I_n.+1) : + derivable a t 1 -> + derivable (fun x : R => (a x)``_i) t 1. +Proof. +move=> /cvg_ex[/= l Hl]. +apply/cvg_ex; exists (l``_i) => /=. +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0) Hl. +apply: filterS Hl => x. +rewrite {1}/Num.Def.normr/= mx_normrE. +move/bigmax_leP => -[_/=]. +move/(_ (ord0, i)). +rewrite !mxE/=. +exact. +Qed. + Lemma derive1mx_cst (P : 'M[R]_(m.+1, n.+1)) : (cst P)^`()%classic = cst 0. Proof. apply/funext => ?. @@ -339,20 +412,8 @@ Qed. End derive_mx_R. Section derive_mx_SE. - Variables (R : rcfType) (M : R -> 'M[R^o]_4). - - -Lemma SE_derivable : (forall t, M t \is 'SE3[R]) -> - forall t, derivable M t 1. -Proof. -move=> ME/= t. -apply/derivable_mxP. -move=> [[|[|[|[|//]]]]] Hi [[|[|[|[|//]]]]] Hj. -- have : (fun t => M t (Ordinal Hi) (Ordinal Hj)) = 0. - apply/funext => x. - have := ME x. -Admitted. +Hypothesis Mt1 : forall t, derivable M t 1. Lemma derivable_rot_of_hom : (forall t, derivable M t 1) -> forall x, derivable (@rot_of_hom _ \o M) x 1. @@ -367,6 +428,21 @@ have /derivable_mxP := H x. exact. Qed. +Lemma derivable_trans_of_hom : (forall t, derivable M t 1) -> + forall x, derivable (@trans_of_hom _ \o M) x 1. +Proof. +move=> H x. +apply/derivable_mxP => i j. +rewrite /trans_of_hom. +rewrite /=. +rewrite (_ : (fun _ => _) = (fun y => (M y) (rshift 3 i) (lshift 1 j))); last first. + rewrite funeqE => y. + by rewrite !mxE. +rewrite /= in H. +have /derivable_mxP := H x. +exact. +Qed. + Local Open Scope classical_set_scope. Lemma derive1mx_SE : (forall t, M t \in 'SE3[R]) -> @@ -375,11 +451,9 @@ Lemma derive1mx_SE : (forall t, M t \in 'SE3[R]) -> ('D_1 (@trans_of_hom R^o \o M) t) 0. Proof. move=> MSE t. -rewrite !derive_funmxE//; last 3 first. - admit. - apply: derivable_rot_of_hom => /= x. - exact: SE_derivable. - exact: SE_derivable. +rewrite !derive_funmxE//; last 2 first. + by apply: derivable_trans_of_hom => /= x. + by apply: derivable_rot_of_hom => /= x. rewrite block_mxEh. rewrite {1}(_ : M = (fun x => hom (rot_of_hom (M x)) (trans_of_hom (M x)))); last first. rewrite funeqE => x; by rewrite -(SE3E (MSE x)). @@ -403,7 +477,7 @@ case: (@splitP 3 1 i) => [i0 ii0|i0 ii0]. rewrite (_ : i = rshift 3 i0); last exact/val_inj. rewrite (_ : (fun _ => _) = (fun=> 1)) ?derive_cst // (ord1 i0) ?mxE //. by rewrite funeqE => x; rewrite /hom (block_mxEdr (rot_of_hom (M x))) mxE. -Admitted. +Qed. End derive_mx_SE. @@ -441,11 +515,12 @@ case: fintype.splitP => [k /= jk|[] [] // ? /= jn]; by rewrite !(mxE,addr0,add0r Qed. Lemma derive1mx_dotmul_belast (R : realFieldType) n (u v : R^o -> 'rV[R^o]_n.+2) t : + derivable v t 1 -> let u' x := row_belast (u x) in let v' x := row_belast (v x) in u' t *d 'D_1 v' t + (u t)``_ord_max *: derive (fun x => (v x)``_ord_max) t 1 = u t *d 'D_1 v t. Proof. -move=> u' v'. +move=> vt1 u' v'. rewrite (row_belast_last ('D_1 v t)) ?addn1 // => /= ?. rewrite dotmul_belast; congr (_ + _). rewrite 2!dotmulE [in RHS]big_ord_recr /=. @@ -455,11 +530,13 @@ rewrite dotmul_belast; congr (_ + _). rewrite mulr0 addr0; apply/eq_bigr => i _; rewrite castmxE !mxE; congr (_ * _). case: fintype.splitP => [k /= ik|[] [] //= ?]; rewrite !mxE. rewrite derive_funmxE//; last first. - admit. - rewrite /= !mxE/=. - rewrite derive_funmxE//; last first. - admit. + rewrite /v'. + apply/derivable_mxP. + apply: derivable_row_belast. + by apply/derivable_mxP. rewrite /= !mxE/=. + rewrite derive_funmxE//. + rewrite mxE/=. f_equal. by rewrite funeqE => x; rewrite /v' !mxE; congr ((v _) _ _); by apply/val_inj. by rewrite addn0 => /eqP/negPn; rewrite (ltn_eqF (ltn_ord i)). @@ -474,9 +551,8 @@ case: fintype.splitP => [j /= /eqP/negPn | [] [] //= ? Hn]. by rewrite (gtn_eqF (ltn_ord j)). rewrite mxE/= mulr1n. rewrite derive_funmxE//; last first. - admit. by rewrite mxE//. -Admitted. +Qed. End row_belast. @@ -519,8 +595,12 @@ transitivity ('D_1 u' t *d v' t + u' t *d 'D_1 v' t + apply eq_bigr => i _; congr (derive _ t 1). by rewrite funeqE => x; rewrite !mxE. rewrite (deriveM (U _ _) (V _ _)) /= -!addrA addrC addrA. -rewrite -(addrA (_ + _)) [in RHS]addrC derive1mx_dotmul_belast; congr (_ + _). -by rewrite [in RHS]dotmulC -derive1mx_dotmul_belast addrC dotmulC. +rewrite -(addrA (_ + _)) [in RHS]addrC derive1mx_dotmul_belast; last first. + exact/derivable_mxP. +congr (_ + _). +rewrite [in RHS]dotmulC -derive1mx_dotmul_belast; last first. + exact/derivable_mxP. +by rewrite addrC dotmulC. Qed. Lemma derive1mxM (R : realFieldType) n m p (M : R -> 'M[R^o]_(n.+1, m.+1)) @@ -530,7 +610,8 @@ Lemma derive1mxM (R : realFieldType) n m p (M : R -> 'M[R^o]_(n.+1, m.+1)) 'D_1 M t *m N t + M t *m ('D_1 N t). Proof. move=> HM HN; apply/matrixP => i j. -rewrite derive_funmxE; last admit. +rewrite derive_funmxE/=; last first. + exact/derivable_mxM. rewrite ![in LHS]mxE. rewrite (_ : (fun x => _) = fun x => \sum_k (M x) i k * (N x) k j); last first. by rewrite funeqE => x; rewrite !mxE. @@ -540,12 +621,35 @@ rewrite (_ : (fun x => _) = by rewrite 3!mxE. rewrite (derive1mx_dotmul (derivable_mx_row HM)); last first. rewrite /=. - (* derivable_mx_col HN*) admit. -(*by rewrite [in RHS]mxE; congr (_ + _); rewrite [in RHS]mxE dotmulE; - apply/eq_bigr => /= k _; rewrite !mxE; apply: f_equal2; - try by congr (@derive1 _ R^o _ t); - rewrite funeqE => z; rewrite !mxE. -Qed.*) Admitted. + rewrite -trmx_derivable/=. + exact: (derivable_mx_col HN). +rewrite [in RHS]mxE; congr +%R. + rewrite dotmulE. + rewrite [in RHS]mxE. + apply: eq_bigr => /= k _. + rewrite !mxE/=. + congr *%R. + rewrite derive_funmxE//= mxE. + rewrite derive_funmxE//=; last first. + exact/derivable_mx_row. + rewrite !mxE//=. + f_equal. + apply/funext => y. + by rewrite !mxE. +rewrite dotmulE. +rewrite [in RHS]mxE. +apply: eq_bigr => /= k _. +rewrite !mxE/=. +congr *%R. +rewrite derive_funmxE//=; last first. + rewrite -trmx_derivable//=. + exact/derivable_mx_col. +rewrite !mxE//=. +rewrite derive_funmxE//= !mxE. +f_equal. +apply/funext => y. +by rewrite !mxE. +Qed. Lemma derive1mx_crossmul (R : realFieldType) (u v : R -> 'rV[R^o]_3) t : derivable u t 1 -> derivable v t 1 -> @@ -556,14 +660,50 @@ move=> U V. evar (f : R -> 'rV[R]_3); rewrite (_ : (fun x : R => _) = f); last first. rewrite funeqE => x; exact: crossmulE. rewrite {}/f; apply/rowP => i; rewrite mxE. -(*rewrite (mxE_funeqE (fun x : R^o => _)) /= mxE 2!crossmulE !{1}[in RHS]mxE /=. -case: ifPn => [/eqP _|/ifnot0P/orP[]/eqP -> /=]; - rewrite ?derive1E (deriveD (derivableM (U _ _) (V _ _)) - (derivableN (derivableM (U _ _) (V _ _)))); - rewrite (deriveN (derivableM (U _ _) (V _ _))) 2!(deriveM (U _ _) (V _ _)); - rewrite addrCA -!addrA; congr (_ + (_ + _)); by [ rewrite mulrC | - rewrite opprD addrC; congr (_ + _); rewrite mulrC ]. -Qed.*) Admitted. +rewrite derive_funmxE/=; last first. + by apply: derivable_row3; + apply: derivableB => //=; + by apply: derivableM => //=; exact: derivable_coord. +rewrite !mxE/=. +rewrite (mxE_funeqE (fun x : R => _))/=. +rewrite 2!crossmulE !{1}[in RHS]mxE /=. +case: ifPn => [/eqP _|/ifnot0P/orP[]/eqP -> /=]. +- rewrite deriveB//=; [ | + by apply: derivableM => //=; exact: derivable_coord..]. + rewrite deriveM//=; [|exact: derivable_coord..]. + rewrite deriveM//=; [|exact: derivable_coord..]. + rewrite addrCA -!addrA; congr (_ + (_ + _)). + by rewrite derive_funmxE//= mxE. + by rewrite mulrC derive_funmxE//= mxE. + rewrite addrC opprD mulrC. + rewrite derive_funmxE//= mxE. + congr (_ - _)%R. + by rewrite derive_funmxE//= mxE. +- (*TOOD: copipe *) + rewrite deriveB//=; [ | + by apply: derivableM => //=; exact: derivable_coord..]. + rewrite deriveM//=; [|exact: derivable_coord..]. + rewrite deriveM//=; [|exact: derivable_coord..]. + rewrite addrCA -!addrA; congr (_ + (_ + _)). + by rewrite derive_funmxE//= mxE. + by rewrite mulrC derive_funmxE//= mxE. + rewrite addrC opprD mulrC. + rewrite derive_funmxE//= mxE. + congr (_ - _)%R. + by rewrite derive_funmxE//= mxE. +- (*TOOD: copipe *) + rewrite deriveB//=; [ | + by apply: derivableM => //=; exact: derivable_coord..]. + rewrite deriveM//=; [|exact: derivable_coord..]. + rewrite deriveM//=; [|exact: derivable_coord..]. + rewrite addrCA -!addrA; congr (_ + (_ + _)). + by rewrite derive_funmxE//= mxE. + by rewrite mulrC derive_funmxE//= mxE. + rewrite addrC opprD mulrC. + rewrite derive_funmxE//= mxE. + congr (_ - _)%R. + by rewrite derive_funmxE//= mxE. +Qed. End product_rules. diff --git a/differential_kinematics.v b/differential_kinematics.v index de78fd1e..5dbd2269 100644 --- a/differential_kinematics.v +++ b/differential_kinematics.v @@ -218,18 +218,24 @@ apply fv_eq => /=; rewrite -mulmxDl; congr (_ *m _). by rewrite addrCA subrr addr0. Qed. -Lemma derivable_mx_Q t : derivable_mx (fun x => BoundVect.endp (Q x)) t 1. +Lemma derivable_mx_Q t : derivable (fun x => BoundVect.endp (Q x)) t 1. Proof. -move=> a b. +rewrite /Q/=; apply: derivable_mxD. + apply/derivable_mxP. + move=> a b. move: (@derivable_F1o t a b). -(* rewrite (_ : (fun x => \o{F1 x} a b) = - (fun x => BoundVect.endp (RFrame.o (F1 x)) a b)) // funeqE => x. - destruct (F1 x) => /=; by rewrite e. -apply derivable_mxM; last exact: derivable_mx_FromTo. + rewrite [X in derivable X _ _ -> _](_ : _ = + (fun x => BoundVect.endp (RFrame.o (F1 x)) a b)); last first. + apply/funext => x/=. + by destruct (F1 x) => /=; by rewrite e. + by []. +apply derivable_mxM; last first. + apply/derivable_mxP. + exact: derivable_mx_FromTo. rewrite (_ : (fun x => _) = (fun _ => BoundVect.endp (Q1 0))); last first. rewrite funeqE => x; by rewrite Q1_fixed_in_F1. move=> a b; exact: ex_derive. -Qed.*) Admitted. +Qed. Let Rot := fun t => (F1 t) _R^ F. @@ -242,40 +248,50 @@ Lemma velocity_composition_rule (t : R) : Proof. rewrite {1}(_ : P = fun t => Q t \+b rmap F (P1 t \-b Q1 t)); last first. by rewrite funeqE => t'; rewrite eqnB3. -rewrite (derive1mx_BoundFramed_add (@derivable_mx_Q t)); last first. -(* apply derivable_mxM; last exact: derivable_mx_FromTo. +have /derivable_mxP tmp := (@derivable_mx_Q t). +rewrite (derive1mx_BoundFramed_add tmp); last first. + apply/derivable_mxP. + apply derivable_mxM; last first. + apply/derivable_mxP. + exact: derivable_mx_FromTo. rewrite (_ : (fun x => _) = (fun x => FramedVect.v (FramedVect_of_Bound (P1 x)) - FramedVect.v (FramedVect_of_Bound (Q1 0)))); last first. rewrite funeqE => x; by rewrite /= Q1_fixed_in_F1. - apply: derivable_mxB => /=. + apply: derivable_mxB => //=. + apply/derivable_mxP. exact: derivable_mxP1. - move=> a b; exact: ex_derive.*) admit. rewrite -addrA; congr (_ + _). rewrite [in LHS]/rmap [in LHS]/= derive1mxM; last 2 first. rewrite {1}(_ : (fun x => _) = (fun x => BoundVect.endp (P1 x) - BoundVect.endp (Q1 0))); last first. by rewrite funeqE => ?; rewrite Q1_fixed_in_F1. apply: derivable_mxB. - (*exact: derivable_mxP1.*) admit. - move=> a b; exact: ex_derive. - (* exact: derivable_mx_FromTo.*) admit. + apply/derivable_mxP. + exact: derivable_mxP1. + by move=> a b; exact: ex_derive. + apply/derivable_mxP. + exact: derivable_mx_FromTo. rewrite derive1mxB; last 2 first. - (*exact: derivable_mxP1.*) admit. + apply/derivable_mxP. + exact: derivable_mxP1. rewrite (_ : (fun x => _) = cst (BoundVect.endp (Q1 0))); last first. by rewrite funeqE => x; rewrite Q1_fixed_in_F1. exact: derivable_cst. congr (_*m _ + _). rewrite [in X in _ + X = _](_ : (fun x => _) = cst (BoundVect.endp (Q1 0))); last first. by rewrite funeqE => x; rewrite Q1_fixed_in_F1. - (*by rewrite derive1mx_cst subr0.*) admit. + rewrite /=. + by rewrite derive_cst//= subr0. rewrite -spinE unspinK; last first. rewrite ang_vel_mx_is_so; first by []. by move=> t'; by rewrite FromTo_is_O. - (*move=> t'; exact: derivable_mx_FromTo.*) admit. + move=> t'. + apply/derivable_mxP. + exact: derivable_mx_FromTo. rewrite /ang_vel_mx mulmxA; congr (_ *m _). rewrite /P /Q /= opprD addrACA subrr add0r mulmxBl -!mulmxA. by rewrite orthogonal_mul_tr ?FromTo_is_O // !mulmx1. -Admitted. +Qed. Hypothesis P1_fixed_in_F1 : forall t, BoundVect.endp (P1 t) = BoundVect.endp (P1 0). @@ -287,11 +303,15 @@ Lemma velocity_composition_rule_spec (t : R) : Proof. rewrite velocity_composition_rule; congr (_ + _). suff -> : 'D_1 (fun x => P1 x : 'M__) t = 0 by rewrite mul0mx addr0. -apply/matrixP => a b; rewrite !mxE. -(*rewrite (_ : (fun x => _) = cst (P1 0 a b)); last first. +apply/matrixP => a b; rewrite !mxE/=. +rewrite derive_funmxE//=; last first. + apply/derivable_mxP. + exact/derivable_mxP1. +rewrite mxE/=. +rewrite (_ : (fun x => _) = cst (P1 0 a b)); last first. rewrite funeqE => x /=; by rewrite /boundvectendp (P1_fixed_in_F1 x). -by rewrite derive1_cst. -Qed.*) Admitted. +by rewrite derive_cst. +Qed. End kinematics. @@ -315,9 +335,10 @@ Lemma eqn312 t : Proof. rewrite (@velocity_composition_rule _ F _ derivable_F1 derivable_F1o p1 derivable_mx_p1 (fun t => bvec0 (F1 t)) (@BoundVect0_fixed _ _ _ F1)). -(*congr (_ + _ *v _). +rewrite /=. +congr (_ + _ *v _). by rewrite /= mul0mx addr0 addrAC subrr add0r. -Qed.*) Admitted. +Qed. End derivative_of_a_rotation_matrix_contd. @@ -329,7 +350,7 @@ Section rigid_body_velocity. Section spatial_velocity. Variables (R : realType) (M : R -> 'M[R^o]_4). -Hypothesis derivableM : forall t, derivable_mx M t 1. +Hypothesis derivableM : forall t, derivable M t 1. Hypothesis MSE : forall t, M t \in 'SE3[R]. Definition spatial_velocity t : 'M_4 := (M t)^-1 * 'D_1 M t. @@ -349,7 +370,7 @@ transitivity (inv_hom (M t) * 'D_1 M t) => //. by rewrite inv_homE. rewrite /inv_hom. rewrite /hom. -rewrite derive1mx_SE //. +rewrite derive1mx_SE//=. rewrite (_ : rot_of_hom (M t) = r t) // -/r. rewrite -mulmxE. rewrite (mulmx_block (r t)^T _ _ _ ('D_1 r t)). @@ -364,7 +385,7 @@ rewrite qualifE block_mxKul block_mxKur block_mxKdr 2!eqxx 2!andbT. rewrite ang_vel_mx_is_so // => t0. by rewrite rotation_sub // rot_of_hom_is_SO. apply: derivable_rot_of_hom => //=. -Admitted. +Qed. Lemma spatial_velocity_is_twist x : let r : R -> 'M[R^o]_3 := @rot_of_hom _ \o M in @@ -375,15 +396,15 @@ rewrite spatial_velocityE. rewrite /wedge lin_tcoorE ang_tcoorE unspinK //. rewrite ang_vel_mx_is_so // => t0. by rewrite rotation_sub // rot_of_hom_is_SO. -apply: derivable_rot_of_hom => //=. -Admitted. +by apply: derivable_rot_of_hom => //=. +Qed. End spatial_velocity. Section body_velocity. Variables (R : realType) (M : R -> 'M[R^o]_4). -Hypothesis derivableM : forall t, derivable_mx M t 1. +Hypothesis derivableM : forall t, derivable M t 1. Hypothesis MSE : forall t, M t \in 'SE3[R]. Definition body_velocity t : 'M_4 := 'D_1 M t * (M t)^-1. @@ -398,12 +419,13 @@ Proof. rewrite /body_ang_vel_mx. have : forall t, (@rot_of_hom R^o \o M) t \is 'O[R]_3. move=> t0; by rewrite rotation_sub // rot_of_hom_is_SO. -(*move/ang_vel_mx_is_so => /(_ (derivable_rot_of_hom derivableM))/(_ t). +move/ang_vel_mx_is_so => /=. +move => /(_ (derivable_rot_of_hom derivableM))/(_ t). rewrite /ang_vel_mx. move/(conj_so (((rot_of_hom (T:=R) \o M) t)^T)). rewrite !mulmxA !trmxK orthogonal_mul_tr ?rotation_sub // ?rot_of_hom_is_SO //. by rewrite mul1mx. -Qed.*) Admitted. +Qed. Lemma body_velocityE t : let r : R -> 'M[R^o]_3 := @rot_of_hom _ \o M in body_velocity t = block_mx (body_ang_vel_mx r t) 0 (body_lin_vel t) 0. @@ -434,7 +456,7 @@ End body_velocity. Section spatial_body_adjoint. Variables (R : realType) (M : R -> 'M[R^o]_4). -Hypothesis derivableM : forall t, derivable_mx M t 1. +Hypothesis derivableM : forall t, derivable M t 1. Hypothesis MSE : forall t, M t \in 'SE3[R]. Lemma spatial_body_velocity x : @@ -442,7 +464,8 @@ Lemma spatial_body_velocity x : Proof. rewrite -/(SE3_action _ _) action_Adjoint; last by []. congr vee; rewrite /spatial_velocity -mulmxE -mulmxA; congr (_ * _). -rewrite veeK; last by rewrite body_velocity_is_se. +rewrite veeK; last first. + by rewrite body_velocity_is_se//=. by rewrite /body_velocity -mulmxA mulVmx ?mulmx1 // SE3_in_unitmx. Qed. @@ -520,25 +543,33 @@ rewrite derive1mxM; last 2 first. rewrite derive1mx_ang_vel; last 2 first. move=> t'; by rewrite FromTo_is_O. move=> t'. - apply/derivable_mxP. - (*apply: derivable_mx_FromTo.*) admit. + apply/derivable_mxP => /=. + by apply: derivable_mx_FromTo'. rewrite derive1mx_ang_vel; last 2 first. move=> t'; by rewrite FromTo_is_O. move=> t'. apply/derivable_mxP. - (*apply: derivable_mx_FromTo'.*) admit. + by apply: derivable_mx_FromTo => //. rewrite derive1mx_ang_vel; last 2 first. move=> t'; by rewrite FromTo_is_O. -(* move=> t'; exact: derivable_mx_FromTo.*) admit. + move=> t'. + apply/derivable_mxP => /=. + by apply: derivable_mx_FromTo. rewrite ang_vel_mxE; last 2 first. move=> t'; by rewrite FromTo_is_O. -(* move=> t'; exact: derivable_mx_FromTo.*) admit. + move=> t'. + apply/derivable_mxP => /=. + by apply: derivable_mx_FromTo. rewrite ang_vel_mxE; last 2 first. move=> t'; by rewrite FromTo_is_O. -(* move=> t'; exact: derivable_mx_FromTo'.*) admit. + move=> t'. + apply/derivable_mxP => /=. + by apply: derivable_mx_FromTo'. rewrite ang_vel_mxE; last 2 first. move=> t'; by rewrite FromTo_is_O. -(* move=> t'; exact: derivable_mx_FromTo.*) admit. + move=> t'. + apply/derivable_mxP => /=. + by apply: derivable_mx_FromTo. rewrite mulmxE -[in X in _ = X + _](mulr1 ((F2 t) _R^ (F1 t))). rewrite -(@orthogonal_tr_mul _ _ (F _R^ (F1 t))) ?FromTo_is_O //. rewrite -{2}(trmx_FromTo (F1 t) F). @@ -558,7 +589,7 @@ move/mulrI. rewrite FromTo_unit => /(_ isT)/eqP. rewrite spin_inj => /eqP. by rewrite addrC. -Admitted. +Qed. End link_velocity. @@ -599,6 +630,46 @@ move=> H; rewrite (derive1_comp H); last exact: derivable_cos. by rewrite derive1_cos mulrC mulNr mulrN. Qed. +Definition Rz' (T : realType) (a : T) := + col_mx3 (row3 (- sin a) (cos a) 0) (row3 (- cos a) (sin a) 0) 'e_2. + +Lemma derivable_Rz {R : realType} (a : R -> R) t : + derivable a t 1 -> + derivable (fun x : R^o => Rz (a x)) t 1. +Proof. +move=> at1. +apply/derivable_mxP. +move=> [[|[|[|//=]]]] ? [[|[|[|//=]]]] ?. +- rewrite [X in derivable X t 1](_ : _ = cos \o a); last first. + by apply/funext => x/=; rewrite !mxE/=. + exact/derivable_cos_comp. +- rewrite [X in derivable X t 1](_ : _ = sin \o a); last first. + by apply/funext => x/=; rewrite !mxE/=. + exact/derivable_sin_comp. +- rewrite [X in derivable X t 1](_ : _ = 0); last first. + by apply/funext => x/=; rewrite !mxE/=. + exact/derivable_cst. +- rewrite [X in derivable X t 1](_ : _ = - sin \o a); last first. + by apply/funext => x/=; rewrite !mxE/=. + apply/derivableN. + exact/derivable_sin_comp. +- rewrite [X in derivable X t 1](_ : _ = cos \o a); last first. + by apply/funext => x/=; rewrite !mxE/=. + exact/derivable_cos_comp. +- rewrite [X in derivable X t 1](_ : _ = 0); last first. + by apply/funext => x/=; rewrite !mxE/=. + exact/derivable_cst. +- rewrite [X in derivable X t 1](_ : _ = 0); last first. + by apply/funext => x/=; rewrite !mxE/=. + exact/derivable_cst. +- rewrite [X in derivable X t 1](_ : _ = 0); last first. + by apply/funext => x/=; rewrite !mxE/=. + exact/derivable_cst. +- rewrite [X in derivable X t 1](_ : _ = 1); last first. + by apply/funext => x/=; rewrite !mxE/=. + exact/derivable_cst. +Qed. + Lemma derive1mx_RzE (R : realType) (a : R^o -> R^o) t : derivable a t 1 -> 'D_1 (fun x => Rz (a x) : 'M[R^o]__) t = derive1 a t *: col_mx3 (row3 (- sin (a t)) (cos (a t)) 0) @@ -608,36 +679,61 @@ Proof. move=> Ha. apply/matrix3P/and9P; split; rewrite !mxE /=. - rewrite derive_funmxE; last first. - admit. + exact: derivable_Rz. rewrite mxE/=. rewrite (_ : (fun _ => _) = cos \o a); last by rewrite funeqE => x; rewrite !mxE. rewrite -derive1E. rewrite (derive1_comp Ha); last exact/derivable_cos. by rewrite derive1_cos mulrC. -(*- rewrite (_ : (fun _ => _) = sin \o a); last by rewrite funeqE => x; rewrite !mxE. +- rewrite derive_funmxE; last first. + exact: derivable_Rz. + rewrite mxE/=. + rewrite (_ : (fun _ => _) = sin \o a); last by rewrite funeqE => x; rewrite !mxE. + rewrite -derive1E. rewrite (derive1_comp Ha); last exact/derivable_sin. by rewrite derive1_sin mulrC. -- rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. - by rewrite derive1_cst mulr0. -- rewrite (_ : (fun _ => _) = - sin \o a); last by rewrite funeqE => x; rewrite !mxE. +- rewrite derive_funmxE; last first. + exact: derivable_Rz. + rewrite mxE/=. + rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. + by rewrite derive_cst mulr0. +- rewrite derive_funmxE; last first. + exact: derivable_Rz. + rewrite mxE/=. + rewrite (_ : (fun _ => _) = - sin \o a); last by rewrite funeqE => x; rewrite !mxE. rewrite (_ : - _ \o _ = - (sin \o a)) // derive1E deriveN; last first. apply/derivable1_diffP/differentiable_comp. exact/derivable1_diffP. exact/derivable1_diffP/derivable_sin. - rewrite -derive1E (derive1_comp Ha); last exact/derivable_sin. + rewrite -!derive1E (derive1_comp Ha); last exact/derivable_sin. by rewrite derive1_sin mulrN mulrC. -- rewrite (_ : (fun _ => _) = cos \o a); last by rewrite funeqE => x; rewrite !mxE. - rewrite (derive1_comp Ha); last exact/derivable_cos. +- rewrite derive_funmxE; last first. + exact: derivable_Rz. + rewrite mxE/=. + rewrite (_ : (fun _ => _) = cos \o a); last by rewrite funeqE => x; rewrite !mxE. + rewrite -derive1E (derive1_comp Ha); last exact/derivable_cos. by rewrite derive1_cos mulrN mulNr mulrC. -- rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. - by rewrite derive1_cst mulr0. -- rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. - by rewrite derive1_cst mulr0. -- rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. - by rewrite derive1_cst mulr0. -- rewrite (_ : (fun _ => _) = cst 1); last by rewrite funeqE => x; rewrite !mxE. - by rewrite derive1_cst mulr0. -Qed.*) Admitted. +- rewrite derive_funmxE; last first. + exact: derivable_Rz. + rewrite mxE/=. + rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. + by rewrite derive_cst mulr0. +- rewrite derive_funmxE; last first. + exact: derivable_Rz. + rewrite mxE/=. + rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. + by rewrite derive_cst mulr0. +- rewrite derive_funmxE; last first. + exact: derivable_Rz. + rewrite mxE/=. + rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. + by rewrite derive_cst mulr0. +- rewrite derive_funmxE; last first. + exact: derivable_Rz. + rewrite mxE/=. + rewrite (_ : (fun _ => _) = cst 1); last by rewrite funeqE => x; rewrite !mxE. + by rewrite derive_cst mulr0. +Qed. (* example 3.1 [sciavicco]*) (* rotational motion of one degree of freedom manipulator *) @@ -749,6 +845,10 @@ Hypothesis o2E : forall t, \o{Fim1 2%:R t} = \o{Fim1 1 t} + Hypothesis o3E : forall t, \o{Fim1 3%:R t} = \o{Fim1 2%:R t} + (d3 t) *: 'e_2. Hypothesis o4E : forall t, \o{Fmax t} = \o{Fim1 3%:R t} + d4 *: 'e_2. +Lemma derivable_joint_variable t : derivable (fun t0 : R^o => \row_i joint_variable (scara_joints i) t0) t 1. +Proof. +Admitted. + Lemma scale_realType (K : realType) (k1 : K) (k2 : K^o) : k1 *: k2 = k1 * k2. Proof. by []. Qed. @@ -765,24 +865,48 @@ rewrite /geo_jac; set a := (X in _ *m @row_mx _ _ 3 3 X _). rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). - rewrite /scara_lin_vel (_ : @trans_of_hom R \o _ = trans); last first. rewrite funeqE => x /=; exact: trans_of_hom_hom. -(* rewrite /trans /scara_trans derive1mx_matrix [RHS]row3_proj /= ![in RHS]mxE [in RHS]/=. + rewrite /trans /scara_trans. + rewrite derive_funmxE//=; last first. + apply: derivable_row3; apply: derivableD => /=; [| | | | exact: derivable_cst |exact: H3]. + apply: derivableM; first exact: derivable_cst. + apply: derivable_cos_comp. + exact: derivableD. + apply: derivableM; first exact: derivable_cst. + by apply: derivable_cos_comp. + apply: derivableM; first exact: derivable_cst. + apply: derivable_sin_comp. + exact: derivableD. + apply: derivableM; first exact: derivable_cst. + by apply: derivable_sin_comp. + rewrite [RHS]row3_proj /= ![in RHS]mxE [in RHS]/=. transitivity ( derive1 (theta1 : R^o -> R^o) t *: (Fim1 0 t)~k *v (\o{Fmax t} - \o{Fim1 0 t}) + derive1 (theta2 : R^o -> R^o) t *: (Fim1 1 t)~k *v (\o{Fmax t} - \o{Fim1 1 t}) + derive1 (d3 : R^o -> R^o) t *: (Fim1 2 t)~k + derive1 (theta4 : R^o -> R^o) t *: (Fim1 3%:R t)~k *v (\o{Fmax t} - \o{Fim1 3%:R t})). - rewrite /scara_joint_velocities /scara_joint_variables derive1mx_matrix /geo_jac_lin /=. + rewrite /scara_joint_velocities /scara_joint_variables. + rewrite derive_funmxE; last first. + exact: derivable_joint_variable. + rewrite /geo_jac_lin /=. apply/rowP => i; rewrite 3![in RHS]mxE [in LHS]mxE sum4E; (repeat apply: f_equal2). - rewrite 2!mxE /=. rewrite (linearZl_LR _ (\o{Fmax t} - \o{Fim1``_t}))/=. - by rewrite [in RHS]mxE. + rewrite [in RHS]mxE !derive1E//=. + under eq_fun do rewrite !mxE/=. + done. - rewrite 2!mxE /=. rewrite (linearZl_LR _ (\o{Fmax t} - \o{Fim1 1 t}))/=. - by rewrite [in RHS]mxE. - - by rewrite 2!mxE [in RHS]mxE. + under eq_fun do rewrite !mxE/=. + rewrite derive1E/=. + by rewrite !mxE. + - rewrite 2!mxE [in RHS]mxE/=. + rewrite derive1E/=. + by under eq_fun do rewrite !mxE/=. - rewrite 2!mxE /=. - by rewrite (linearZl_LR _ (\o{Fmax t} - \o{Fim1 3 t}))/= [in RHS]mxE. + rewrite (linearZl_LR _ (\o{Fmax t} - \o{Fim1 3 t}))/= [in RHS]mxE. + rewrite derive1E. + by under eq_fun do rewrite !mxE/=. rewrite o0E subr0. rewrite {1}o4E. rewrite (linearDr _ (_ *: Fim1``_t|,2)) /=. @@ -820,15 +944,21 @@ rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). rewrite {1}o2E {1}o1E. rewrite (_ : (fun _ => _) = (a2 \*: (cos \o (theta2 + theta1) : R^o -> R^o)) + - (a1 *: (cos \o theta1 : R^o -> R^o))) //. + (a1 *: (cos \o theta1 : R^o -> R^o))); last first. + apply/funext => x/=. + by rewrite !mxE/=. rewrite (_ : (fun _ => _) = (a2 \*: (sin \o (theta2 + theta1) : _ -> R^o)) + - (a1 *: (sin \o theta1 : _ -> R^o))) //. + (a1 *: (sin \o theta1 : _ -> R^o))); last first. + apply/funext => x/=. + by rewrite !mxE/=. rewrite row3e2; congr (_ + _ *: _); last first. - by rewrite Hzvec. - - rewrite [in RHS]derive1E [in RHS]deriveD; last 2 first. + - rewrite derive1E. + under eq_fun do rewrite !mxE/=. + rewrite [in RHS]deriveD; last 2 first. exact: ex_derive. exact: H3. - by rewrite deriveE // diff_cst add0r derive1E. + by rewrite derive_cst// add0r. - rewrite 3!(linearDr _ ((theta1^`())%classic t *: Fim1``_t|,2))/=. rewrite (linearDr _ (Fim1 1 t)|,2)/=. rewrite (linearZr_LR _ _ (a1 * cos (theta1 t)))/=. @@ -843,8 +973,8 @@ rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). rewrite scalerBr. rewrite -!addrA addrCA addrC -!addrA (addrCA (- _)) !addrA. rewrite -2!addrA [in RHS]addrC; congr (_ + _). - - rewrite !scalerA -2!scalerDl row3e1; congr (_ *: _). - rewrite [in RHS]derive1E deriveD; last 2 first. + + rewrite !scalerA -2!scalerDl row3e1; congr (_ *: _). + rewrite deriveD; last 2 first. apply/derivableZ/derivable_sin_comp/derivableD; [exact H2 | exact H1]. exact/derivableZ/derivable_sin_comp. rewrite deriveZ /=; last first. @@ -868,9 +998,9 @@ rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). rewrite derive1E. by rewrite addrC. by rewrite derive1E addrC. - - rewrite !{1}scalerA !addrA -3!{1}scaleNr -2!scalerDl row3e0. + + rewrite !{1}scalerA !addrA -3!{1}scaleNr -2!scalerDl row3e0. congr (_ *: _). - rewrite [in RHS]derive1E deriveD; last 2 first. + rewrite deriveD; last 2 first. by apply/derivableZ/derivable_cos_comp/derivableD; [exact H2 | exact H1]. by apply/derivableZ/derivable_cos_comp; exact H1. rewrite deriveZ /=; last first. @@ -904,16 +1034,29 @@ rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). transitivity (derive1 (theta1 : R^o -> R^o) t *: (Fim1 0 t)~k + derive1 (theta2 : R^o -> R^o) t *: (Fim1 1 t)~k + derive1 (theta4 : R^o -> R^o) t *: (Fim1 3%:R t)~k). - rewrite /scara_joint_velocities /scara_joint_variables derive1mx_matrix /geo_jac_ang /=. + rewrite /scara_joint_velocities /scara_joint_variables. + rewrite derive_funmxE; last first. + (* derivable (fun t0 : R^o => \row_i joint_variable (scara_joints i) t0) t 1 *) + exact: derivable_joint_variable. + rewrite /geo_jac_ang /=. apply/rowP => i; rewrite !mxE sum4E !mxE {1}mulr0 addr0. - by rewrite -!/(Fim1 _) [Fim1 0 _]lock [Fim1 1 _]lock [Fim1 3%:R _]lock /= -!lock. + rewrite -!/(Fim1 _) [Fim1 0 _]lock [Fim1 1 _]lock [Fim1 3%:R _]lock /= -!lock. + rewrite !derive1E. + under eq_fun do rewrite !mxE/=. + rewrite -[RHS]addrA. + rewrite -[LHS]addrA. + congr (_ + _). + under eq_fun do rewrite !mxE/=. + congr (_ + _). + under eq_fun do rewrite !mxE/=. + done. rewrite !Hzvec -2!scalerDl e2row row3Z mulr0 mulr1. rewrite [in RHS]derive1E deriveD; [|apply/derivableD|by []]; last 2 first. exact: H1. exact: H2. rewrite deriveD; [| exact: H1| exact H2]. by rewrite 3!derive1E. -Qed.*) Admitted. +Qed. End scara_geometric_jacobian. From 61ffd8c006157c1c8acda0ee262ecb2caf3e7904 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Thu, 31 Jul 2025 15:09:26 +0900 Subject: [PATCH 033/144] upd --- tilt.v | 117 ++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 74 insertions(+), 43 deletions(-) diff --git a/tilt.v b/tilt.v index bdb0bfe5..678edbdf 100644 --- a/tilt.v +++ b/tilt.v @@ -426,27 +426,33 @@ Definition is_invariant_solution_equa_diff {K : realType} (y (equa_t0 e) \in equa_S0 e -> (forall t, t > 0 -> y (equa_t0 e + t) \in equa_S0 e)). -Section problem_statement. +Section ya. +(* mesure de l'accelerometre *) +Variable K : realType. +Variable p : K -> 'rV[K]_3. +Variable R : K -> 'M[K]_3. +Variable g0 : K. +Let v t := 'D_1 p t. +Let w t := ang_vel R t. +Definition y_a t := v t *m \S( w t) + 'D_1 v t + 'e_2 *m R t *m g0%:M. +Definition x2 (t : K) : 'rV_3 := 'e_2 *m R t. +End ya. + +Definition S2 {K : realType} := [set x : 'rV[K]_3 | norm x = 1]. + +Section problem_statementA. Variable K : realType. -Variable alpha1 : K. -Variable gamma : K. Variable g0 : K. -Variable y0 : K -> 'rV[K]_6. Variable R : K -> 'M[K]_3. -Variable p : K -> 'rV[K]_3. -Variable y_g : K -> 'rV[K]_3. -Variable y_a : K -> 'rV[K]_3. -Variable y_m : K -> 'rV[K]_3. -Definition x1 (t : K) := 'D_1 p t *m (R t) . -Definition x2 (t : K) : 'rV_3 := 'e_2 *m R t (* eqn (8) *). -Definition S2 := [set x : 'rV[K]_3 | norm x = 1]. -Definition x1_point (t : K) := 'D_1 x1 t. -Definition x2_point (t : K) := 'D_1 x2 t. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. Hypothesis derivableR : forall t, derivable R t 1. -Hypothesis gamma_gt0 : 0 < gamma. -Hypothesis alpha1_gt0 : 0 < alpha1. -Definition w t := ang_vel R t. +Variable p : K -> 'rV[K]_3. +Let v t := 'D_1 p t. +Let x1 t := v t. +Let x2 t : 'rV_3 := 'e_2 *m R t (* eqn (8) *). +Let x1_point t := 'D_1 x1 t. +Let x2_point t := 'D_1 x2 t. +Let w t := ang_vel R t. Lemma x2_s2 (t0 : K) : x2 t0 \in S2. Proof. @@ -456,14 +462,36 @@ rewrite inE /= orth_preserves_norm. by rewrite rotation_sub // rotationV. Qed. -(* eqn (11) *) - - -Lemma derive1rV_ang_vel (q : K -> 'rV[K]_3) t : - 'D_1 q t = 'D_1 (fun t => q t *m R t) t + unspin (R t) *v q t. +Lemma dRu t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) (w' := ang_vel T) + : 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(w' t) + 'D_1 u t *m T t. Proof. +rewrite derive1mxM; last 2 first. + admit. + admit. +rewrite addrC. +congr(_+_). +rewrite -ang_vel_mxE; last 2 first. + admit. + admit. +rewrite -mulmxA. +rewrite mulmxE. +rewrite -derive1mx_ang_vel; last 2 first. + admit. + admit. +by []. Admitted. +(* eqn 10*) +Notation y_a := (y_a p R g0). +Lemma derive_x1point t : 'D_1 x1 t = - x1 t *m \S(w t) + y_a t - ('e_2 *m R t) *m g0%:M. +Proof. +rewrite /y_a -addrA addrK. +rewrite /x1. +rewrite addrCA addrA mulNmx subrr add0r. +by []. +Qed. + + (* eqn 11b *) Lemma derive_x2point (t : K) : x2_point t = x2 t *m \S( w t ). Proof. rewrite /w. @@ -485,29 +513,32 @@ rewrite mulmxA. done. Admitted. -Lemma derive_x1point (t : K) : -'D_1 x1 t = (x1 t) *m ( \S(w t) ) + - ('D_1 p t) *m \S(w t ) + - 'D_1 (fun t => 'D_1 p t) t - + const_mx g0 *m x2 t - - (x2 t) *m const_mx g0. -Proof. -rewrite -ang_vel_mxE; last 2 first. - by move=> ?; rewrite rotation_sub. - by []. -rewrite /x1 /x2. -rewrite !mulmxA /=. -rewrite -[RHS]addrA. -rewrite [X in _ = _ + _ + _ + X](_ : _ = 0) ?addr0; last first. - apply/eqP; rewrite subr_eq0; apply/eqP. - rewrite -mulmxA. - admit. -set A := 'D_1 p t. -set Rt := R t. -set dR := 'D_1 R t. -Admitted. +End problem_statementA. -End problem_statement. +Section problem_statementB. +Variable K : realType. +Variable gamma : K. +Variable alpha1 : K. +Variable p : K -> 'rV[K]_3. +Let v t := 'D_1 p t. +Variable R : K -> 'M[K]_3. +Let w t := ang_vel R t. +Variable x1_hat : K -> 'rV[K]_3. +Variable x2_hat : K -> 'rV[K]_3. +Let y_g := w. +Variable g0 : K. +Notation y_a := (y_a p R g0). +Let x2_prime_hat t := -(alpha1 / gamma) *: (v t - x1_hat t). +Let x1_hat_dot t := - x1_hat t *m \S(y_g t) + y_a t - g0 *: x2_prime_hat t. +Let x2_hat_dot t := x2_hat t *m - \S(y_g t - gamma *: x2_prime_hat t *m \S(x2_hat t)). +Hypothesis x2_hat_S2 : x2_hat 0 \in S2. +Notation x2 := (x2 R). +Let p1 t := x2 t - x2_prime_hat t. +Let x2_tilde (t : K) := x2 t - x2_hat t. +Let p1_point t := 'D_1 p1 t. +Lemma derive_p1 t : 'D_1 p1 t = - p1 t *m \S(w t) - gamma *: p1 t. + +End problem_statementB. Section eqn33. Variable K : realType. From 7aaf2a703f5c06e81512dc259d5bf59f24261fbc Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 31 Jul 2025 17:57:16 +0900 Subject: [PATCH 034/144] bricolage y_a --- tilt.v | 33 ++++++++++++++++++++++++++++++--- 1 file changed, 30 insertions(+), 3 deletions(-) diff --git a/tilt.v b/tilt.v index 678edbdf..99d54396 100644 --- a/tilt.v +++ b/tilt.v @@ -432,14 +432,41 @@ Variable K : realType. Variable p : K -> 'rV[K]_3. Variable R : K -> 'M[K]_3. Variable g0 : K. -Let v t := 'D_1 p t. +Let v t := 'D_1 p t *m R t. Let w t := ang_vel R t. -Definition y_a t := v t *m \S( w t) + 'D_1 v t + 'e_2 *m R t *m g0%:M. -Definition x2 (t : K) : 'rV_3 := 'e_2 *m R t. +Definition y_a t := - v t *m \S( w t) + 'D_1 v t + g0 *: 'e_2 *m R t. +Definition x2 t : 'rV_3 := 'e_2 *m R t. End ya. Definition S2 {K : realType} := [set x : 'rV[K]_3 | norm x = 1]. +Section ya_E. +Context {K : realType}. +Variable R : K -> 'M[K]_3. +Hypothesis RSO : forall t, R t \is 'SO[K]_3. +Variable p : K -> 'rV[K]_3. +Variable g0 : K. +Let v t := 'D_1 p t *m R t. +Let w t := ang_vel R t. + +Lemma ya_E t : ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t = y_a p R g0 t. +Proof. +rewrite mulmxDl /y_a/=. +congr +%R. +rewrite [in RHS]derive1mxM; [|admit|admit]. +rewrite derive1mx_ang_vel//; [|admit|admit]. +rewrite ang_vel_mxE//; [|admit|admit]. +rewrite addrCA. +rewrite -mulmxE. +rewrite -mulNmx. +rewrite [X in _ = _ X]addrC. +rewrite !mulNmx. +rewrite -mulmxA. +by rewrite subrr addr0. +Admitted. + +End ya_E. + Section problem_statementA. Variable K : realType. Variable g0 : K. From 1362df8ee86d669f9e7f6e9cc9ade87233a5a202 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Thu, 31 Jul 2025 17:54:56 +0900 Subject: [PATCH 035/144] upd --- tilt.v | 54 +++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 45 insertions(+), 9 deletions(-) diff --git a/tilt.v b/tilt.v index 99d54396..bfc47765 100644 --- a/tilt.v +++ b/tilt.v @@ -474,9 +474,9 @@ Variable R : K -> 'M[K]_3. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. Hypothesis derivableR : forall t, derivable R t 1. Variable p : K -> 'rV[K]_3. -Let v t := 'D_1 p t. +Let v t := 'D_1 p t *m R t. Let x1 t := v t. -Let x2 t : 'rV_3 := 'e_2 *m R t (* eqn (8) *). +Let x2 t : 'rV_3 := ('e_2) *m R t (* eqn (8) *). Let x1_point t := 'D_1 x1 t. Let x2_point t := 'D_1 x2 t. Let w t := ang_vel R t. @@ -510,12 +510,12 @@ Admitted. (* eqn 10*) Notation y_a := (y_a p R g0). -Lemma derive_x1point t : 'D_1 x1 t = - x1 t *m \S(w t) + y_a t - ('e_2 *m R t) *m g0%:M. +Lemma derive_x1point t : 'D_1 x1 t = x1 t *m \S(w t) + y_a t - g0 *: 'e_2 *m R t. Proof. -rewrite /y_a -addrA addrK. +rewrite /y_a/= -addrA addrK. rewrite /x1. -rewrite addrCA addrA mulNmx subrr add0r. -by []. +rewrite addrCA addrA mulNmx /= /v /w. +by rewrite (addrC(-_)) subrr add0r. Qed. (* eqn 11b *) @@ -536,8 +536,7 @@ rewrite /=. rewrite derive1mx_ang_vel /=; last 2 first. by move=> ?; rewrite rotation_sub. admit. -rewrite mulmxA. -done. +by rewrite mulmxA. Admitted. End problem_statementA. @@ -563,7 +562,44 @@ Notation x2 := (x2 R). Let p1 t := x2 t - x2_prime_hat t. Let x2_tilde (t : K) := x2 t - x2_hat t. Let p1_point t := 'D_1 p1 t. -Lemma derive_p1 t : 'D_1 p1 t = - p1 t *m \S(w t) - gamma *: p1 t. + + +Lemma derive_p1 t : 'D_1 p1 t = p1 t *m \S(w t) - gamma *: p1 t. +Proof. +rewrite /p1. +rewrite derive1mxB; last 2 first. + admit. + admit. +rewrite /x2_prime_hat /=. +rewrite deriveZ /=; last first. + admit. +rewrite derive1mxM; last 2 first. + admit. + admit. +rewrite derive1mx_ang_vel; last 2 first. + admit. + admit. +rewrite -scaleNr opprK -scaleNr opprK. +rewrite !mulmxA. +rewrite addrAC. +rewrite derive1mxB; last 2 first. + admit. + admit. +rewrite derive1mx_ang_vel; last 2 first. + admit. + admit. +rewrite mulmxA. +rewrite -(mulmxA('e_2)). +rewrite orthogonal_mul_tr /=. +rewrite -(mulmxA('e_2)) mul1mx. +rewrite ang_vel_mxE; last 2 first. + admit. + admit. +rewrite /w. +rewrite derive_cst mul0mx add0r. +rewrite /x2. +rewrite /v. +Abort. End problem_statementB. From ac907edfb09ab06d39b68b25ffcce45d6c3035fd Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 3 Aug 2025 18:08:04 +0900 Subject: [PATCH 036/144] less admits --- derive_matrix.v | 605 +++++++++++++++----------------------- differential_kinematics.v | 262 ++++++++--------- tilt.v | 205 +++++++------ tilt_robot.v | 82 ++++-- 4 files changed, 543 insertions(+), 611 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index 2387a53f..33d6a53b 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -3,7 +3,7 @@ From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. From mathcomp Require Import interval_inference. From mathcomp Require Import realalg complex fingroup perm. -From mathcomp Require Import sesquilinear. +From mathcomp Require Import sesquilinear ring. From mathcomp Require Import boolp reals classical_sets. From mathcomp Require Import topology normedtype landau derive trigo. From mathcomp Require Import functions. @@ -12,7 +12,6 @@ Require Import ssr_ext euclidean rigid skew. (******************************************************************************) (* Derivatives of time-varying matrices *) (* *) -(* derive1mx M(t) == the derivative matrix of M(t) *) (* ang_vel_mx M == angular velocity matrix of M(t) *) (* *) (******************************************************************************) @@ -21,7 +20,6 @@ Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Def Num.Theory. - Import numFieldNormedType.Exports. Local Open Scope ring_scope. @@ -36,50 +34,6 @@ Lemma mxE_funeqE (R : realFieldType) (V W : normedModType R) (fun x => f x i j). Proof. by rewrite funeqE => ?; rewrite mxE. Qed. -Section derive_funmx. -Local Open Scope classical_set_scope. -Variable R : realFieldType. -Context {m n : nat}. - -Lemma derive_funmxE (M : R -> 'M[R]_(m.+1, n.+1)) (t : R) v : - derivable M t v -> - 'D_v M t = \matrix_(i < m.+1, j < n.+1) 'D_v (fun t => M t i j) t. -Proof. -move=> /cvg_ex[/= l Hl]; apply/cvg_lim => //=. -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : (Hl) => /(_ (e / 2)). -rewrite divr_gt0// => /(_ isT)[d /= d0 dle]. -near=> x. -rewrite [in leLHS]/Num.Def.normr/= mx_normrE. -apply/(bigmax_le _ (ltW e0)) => -[/= i j] _. -rewrite [in leLHS]mxE/= [X in _ + X]mxE -[X in X - _](subrK (l i j)). -rewrite -(addrA (_ - _)) (le_trans (ler_normD _ _))// (splitr e) lerD//. -- rewrite mxE. - suff : (h^-1 *: (M (h *: v + t) i j - M t i j)) @[h --> 0^'] --> l i j. - move/cvg_lim => /=; rewrite /derive /= => ->//. - by rewrite subrr normr0 divr_ge0// ltW. - apply/cvgrPdist_le => /= r r0. - move/cvgrPdist_le : Hl => /(_ r r0)[/= s s0] sr. - near=> y. - have : `|l - y^-1 *: (M (y *: v + t) - M t)| <= r. - rewrite sr//=; last by near: y; exact: nbhs_dnbhs_neq. - by rewrite sub0r normrN; near: y; exact: dnbhs0_lt. - apply: le_trans. - rewrite [in leRHS]/Num.Def.normr/= mx_normrE. - by under eq_bigr do rewrite !mxE; exact: (le_bigmax _ _ (i, j)). -- rewrite mxE. - have : `|l - x^-1 *: (M (x *: v + t) - M t)| <= e / 2. - apply: dle => //=; last by near: x; exact: nbhs_dnbhs_neq. - by rewrite sub0r normrN; near: x; exact: dnbhs0_lt. - apply: le_trans. - rewrite [in leRHS]/Num.Def.normr/= mx_normrE/=. - under eq_bigr do rewrite !mxE. - apply: le_trans; last exact: le_bigmax. - by rewrite !mxE. -Unshelve. all: by end_near. Qed. - -End derive_funmx. - Lemma norm_trmx (R : realFieldType) m n (M : 'M[R]_(m.+1, n.+1)) : `|M^T| = `|M|. Proof. @@ -87,35 +41,24 @@ rewrite /Num.Def.normr/= !mx_normrE. under eq_bigr do rewrite mxE. apply/eqP; rewrite eq_le; apply/andP; split. - apply: bigmax_le => //=. - apply: le_trans; last first. - apply: le_bigmax => /=. - exact: (ord0, ord0). - by []. - move=> i _. - apply/bigmax_geP; right => /=. - by exists (i.2, i.1). -- apply: bigmax_le => //=. - apply: le_trans; last first. - apply: le_bigmax => /=. - exact: (ord0, ord0). - by []. - move=> i _. - apply/bigmax_geP; right => /=. - by exists (i.2, i.1). + exact: le_trans (le_bigmax _ _ (ord0, ord0)). + by move=> i _; apply/bigmax_geP; right => /=; exists (i.2, i.1). +- apply: bigmax_le => //=. + exact: le_trans (le_bigmax _ _ (ord0, ord0)). + by move=> i _; apply/bigmax_geP; right => /=; exists (i.2, i.1). Qed. -Section derive_mx. - -Variable (R : realFieldType) (V W : normedModType R). +Section pointwise_derivable. +Context {R : realFieldType} {V W : normedModType R} {m n : nat}. +Implicit Types M : V -> 'M[R]_(m.+1, n.+1). -Definition derivable_mx m n (M : R -> 'M[R]_(m.+1, n.+1)) t v := - forall i j, derivable (fun x : R^o => (M x) i j) t v. +Definition derivable_mx M t v := + forall i j, derivable (fun x => M x i j) t v. -Lemma derivable_mxP m n (M : R -> 'M[R]_(m.+1, n.+1)) t v : - derivable_mx M t v <-> derivable M t v. +Lemma derivable_mxP M t v : derivable_mx M t v <-> derivable M t v. Proof. split; rewrite /derivable_mx /derivable. - move=> H. +- move=> H. apply/cvg_ex => /=. pose l := \matrix_(i < m.+1, j < n.+1) sval (cid ((cvg_ex _).1 (H i j))). exists l. @@ -127,54 +70,28 @@ split; rewrite /derivable_mx /derivable. move: i. near: x. apply: filter_forall => /= i. - pose r_of_i := fun i => (@cvgrPdist_le _ _ _ _ (dnbhs_filter 0) _ _).1 - (svalP (cid ((cvg_ex _).1 (H i.1 i.2)))) _ e0. - have := r_of_i i. - done. -move=> /cvg_ex[/= l Hl] i j. -apply/cvg_ex; exists (l i j). -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0] H. -near=> x. -apply: le_trans; last first. - apply: (H x). - rewrite /ball_/=. - rewrite sub0r normrN. - near: x. - exact: dnbhs0_lt. - near: x. - exact: nbhs_dnbhs_neq. -rewrite [leRHS]/Num.Def.normr/= mx_normrE. -apply: le_trans; last exact: le_bigmax. -by rewrite /= !mxE. + exact: ((@cvgrPdist_le _ _ _ _ (dnbhs_filter 0) _ _).1 + (svalP (cid ((cvg_ex _).1 (H i.1 i.2)))) _ e0). +- move=> /cvg_ex[/= l Hl] i j. + apply/cvg_ex; exists (l i j). + apply/cvgrPdist_le => /= e e0. + move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0] H. + near=> x. + apply: le_trans; last first. + apply: (H x). + rewrite /ball_/=. + rewrite sub0r normrN. + near: x. + exact: dnbhs0_lt. + near: x. + exact: nbhs_dnbhs_neq. + rewrite [leRHS]/Num.Def.normr/= mx_normrE. + apply: le_trans; last exact: le_bigmax. + by rewrite /= !mxE. Unshelve. all: by end_near. Qed. -Variables m n : nat. -Implicit Types M N : R -> 'M[R]_(m.+1, n.+1). - -Lemma derivable_mxD M N t : derivable M t 1 -> derivable N t 1 -> - derivable (fun x => M x + N x) t 1. -Proof. -move=> Hf Hg. -by apply: derivableD. -Qed. - -Lemma derivable_mxN M t : derivable M t 1 -> - derivable (fun x => - M x) t 1. -Proof. -move=> HM. -exact: derivableN. -Qed. - -Lemma derivable_mxB M N t : derivable M t 1 -> derivable N t 1 -> - derivable (fun x => M x - N x) t 1. -Proof. -move=> Hf Hg. -by apply: derivableB. -Qed. - -Lemma trmx_derivable M t v : - derivable M t v = derivable (fun x => (M x)^T) t v. +Lemma derivable_trmx M t v : + derivable (fun x => (M x)^T) t v = derivable M t v. Proof. rewrite propeqE; split; rewrite /derivable/=. - move=> /cvg_ex[/= l Hl]. @@ -182,42 +99,38 @@ rewrite propeqE; split; rewrite /derivable/=. apply/cvgrPdist_le => /= e e0. move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0 re]. near=> x. - rewrite [leLHS](_ : _ = `|l - x^-1 *: ((M (x *: v + t)) - (M t))|); last first. + rewrite [leLHS](_ : _ = + `|l - x^-1 *: ((M (x *: v + t))^T - (M t)^T)|); last first. rewrite -[RHS]norm_trmx. rewrite [in RHS]linearD/=. rewrite [in RHS]linearN/=. congr (`| _ - _ |). rewrite [RHS]linearZ/=. - by rewrite [in RHS]linearB. + rewrite [in RHS]linearB. + by rewrite /= !trmxK. apply: re => /=. - rewrite sub0r normrN. - near: x. - by apply: dnbhs0_lt. - near: x. - by apply: nbhs_dnbhs_neq. + rewrite sub0r normrN. + by near: x; exact: dnbhs0_lt. + by near: x; exact: nbhs_dnbhs_neq. - move=> /cvg_ex[/= l Hl]. apply/cvg_ex => /=; exists l^T. apply/cvgrPdist_le => /= e e0. move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0 re]. near=> x. - rewrite [leLHS](_ : _ = `|l - x^-1 *: ((M (x *: v + t))^T - (M t)^T)|); last first. + rewrite [leLHS](_ : _ = `|l - x^-1 *: ((M (x *: v + t)) - (M t))|); last first. rewrite -[RHS]norm_trmx. rewrite [in RHS]linearD/=. rewrite [in RHS]linearN/=. congr (`| _ - _ |). rewrite [RHS]linearZ/=. - rewrite [in RHS]linearB. - by rewrite /= !trmxK. + by rewrite [in RHS]linearB. apply: re => /=. - rewrite sub0r normrN. - near: x. - by apply: dnbhs0_lt. - near: x. - by apply: nbhs_dnbhs_neq. + rewrite sub0r normrN. + by near: x; exact: dnbhs0_lt. + by near: x; exact: nbhs_dnbhs_neq. Unshelve. all: by end_near. Qed. -Lemma derivable_mx_row M t i : - derivable M t 1 -> derivable (row i \o M) t 1. +Lemma derivable_row M t v i : derivable M t v -> derivable (row i \o M) t v. Proof. rewrite /derivable => /cvg_ex[/= l Hl]. apply/cvg_ex => /=. @@ -227,29 +140,20 @@ move/cvgrPdist_le : Hl => /(_ _ e0)[r /= r0 re]. near=> x. apply: le_trans; last first. apply: (re x). - rewrite /ball_ /= sub0r normrN. - near: x. - by apply: dnbhs0_lt. - near: x. - by apply: nbhs_dnbhs_neq. + rewrite /ball_ /= sub0r normrN. + by near: x; exact: dnbhs0_lt. + by near: x; exact: nbhs_dnbhs_neq. rewrite /Num.Def.normr/= !mx_normrE. apply/bigmax_leP => /=. split. - apply: le_trans; last first. - apply: le_bigmax => /=. - exact: (ord0, ord0). - by []. + exact: le_trans (le_bigmax _ _ (ord0, ord0)). move=> j _. rewrite !mxE. under eq_bigr do rewrite !mxE. -apply: le_trans; last first. - apply: le_bigmax. - exact: (i, j.2). -by rewrite /=. +exact: le_trans (le_bigmax _ _ (i, j.2)). Unshelve. all: by end_near. Qed. -Lemma derivable_mx_col M t i : - derivable M t 1 -> derivable (col i \o M) t 1. +Lemma derivable_col M t v i : derivable M t v -> derivable (col i \o M) t v. Proof. rewrite /derivable => /cvg_ex[/= l Hl]. apply/cvg_ex => /=. @@ -259,34 +163,22 @@ move/cvgrPdist_le : Hl => /(_ _ e0)[r /= r0 re]. near=> x. apply: le_trans; last first. apply: (re x). - rewrite /ball_ /= sub0r normrN. - near: x. - by apply: dnbhs0_lt. - near: x. - by apply: nbhs_dnbhs_neq. + rewrite /ball_ /= sub0r normrN. + by near: x; exact: dnbhs0_lt. + by near: x; exact: nbhs_dnbhs_neq. rewrite /Num.Def.normr/= !mx_normrE. apply/bigmax_leP => /=. split. - apply: le_trans; last first. - apply: le_bigmax => /=. - exact: (ord0, ord0). - by []. + exact: le_trans (le_bigmax _ _ (ord0, ord0)). move=> j _. rewrite !mxE. under eq_bigr do rewrite !mxE. -apply: le_trans; last first. - apply: le_bigmax. - exact: (j.1, i). -by rewrite /=. +exact: le_trans (le_bigmax _ _ (j.1, i)). Unshelve. all: by end_near. Qed. -From mathcomp Require Import ring. - -Lemma derivable_row3 (a b c : R -> R) t : - derivable a t 1 -> - derivable b t 1 -> - derivable c t 1 -> - derivable (fun x : R => row3 (a x) (b x) (c x)) t 1. +Lemma derivable_row3 (a b c : V -> R) t v : + derivable a t v -> derivable b t v -> derivable c t v -> + derivable (fun x => row3 (a x) (b x) (c x)) t v. Proof. move=> /cvg_ex[/= l Hl] /cvg_ex[/= o Ho] /cvg_ex[/= p Hp]. apply/cvg_ex; exists (row3 l o p) => /=. @@ -311,35 +203,29 @@ case: fintype.splitP => [j0|]. rewrite (ord1 j0) => _. rewrite !mxE eqxx/= mulr1n. apply: re. - rewrite /= sub0r normrN. - near: x. - by apply: dnbhs0_lt. - near: x. - by apply: nbhs_dnbhs_neq. + rewrite /= sub0r normrN. + by near: x; exact: dnbhs0_lt. + by near: x; exact: nbhs_dnbhs_neq. move=> k j1k. rewrite !mxE. case: fintype.splitP => [k0|k0]. rewrite (ord1 k0) => _. rewrite !mxE eqxx/= mulr1n. apply: se. - rewrite /= sub0r normrN. - near: x. - by apply: dnbhs0_lt. - near: x. - by apply: nbhs_dnbhs_neq. + rewrite /= sub0r normrN. + by near: x; exact: dnbhs0_lt. + by near: x; exact: nbhs_dnbhs_neq. rewrite (ord1 k0) => _. rewrite !mxE eqxx/= mulr1n. apply: ue. -rewrite /= sub0r normrN. -near: x. -by apply: dnbhs0_lt. -near: x. -by apply: nbhs_dnbhs_neq. + rewrite /= sub0r normrN. + by near: x; exact: dnbhs0_lt. +by near: x; exact: nbhs_dnbhs_neq. Unshelve. all: by end_near. Qed. -Lemma derivable_coord (a : R -> 'rV[R]_n.+1) t (i : 'I_n.+1) : - derivable a t 1 -> - derivable (fun x : R => (a x)``_i) t 1. +Lemma derivable_coord (a : V -> 'rV[R]_n.+1) t v (i : 'I_n.+1) : + derivable a t v -> + derivable (fun x : V => (a x)``_i) t v. Proof. move=> /cvg_ex[/= l Hl]. apply/cvg_ex; exists (l``_i) => /=. @@ -347,131 +233,136 @@ apply/cvgrPdist_le => /= e e0. move/cvgrPdist_le : Hl => /(_ _ e0) Hl. apply: filterS Hl => x. rewrite {1}/Num.Def.normr/= mx_normrE. -move/bigmax_leP => -[_/=]. -move/(_ (ord0, i)). -rewrite !mxE/=. -exact. +move/bigmax_leP => -[_/=] /(_ (ord0, i)). +by rewrite !mxE/=; exact. Qed. -Lemma derive1mx_cst (P : 'M[R]_(m.+1, n.+1)) : (cst P)^`()%classic = cst 0. -Proof. -apply/funext => ?. -by rewrite derive1_cst. -Qed. +End pointwise_derivable. -Lemma derive1mx_tr M t : derivable M t 1 -> 'D_1 (trmx \o M) t = ('D_1 M t)^T. -Proof. -move=> Mt1. -rewrite !derive_funmxE//=. - apply/matrixP => i j; rewrite !mxE. - by rewrite (_ : (fun _ => _) = (fun t => M t j i)) // funeqE => ?; rewrite mxE. -by rewrite -trmx_derivable. -Qed. +Section pointwise_derive. +Local Open Scope classical_set_scope. +Context {R : realFieldType} {V W : normedModType R} . -Lemma derive1mxD M N t : derivable M t 1 -> derivable N t 1 -> - 'D_1 (M + N) t = 'D_1 M t + 'D_1 N t. +Lemma derive_mx {m n : nat} (M : V -> 'M[R]_(m.+1, n.+1)) t v : + derivable M t v -> + 'D_v M t = \matrix_(i < m.+1, j < n.+1) 'D_v (fun t => M t i j) t. Proof. -move=> Hf Hg. -by rewrite deriveD//. -Qed. +move=> /cvg_ex[/= l Hl]; apply/cvg_lim => //=. +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : (Hl) => /(_ (e / 2)). +rewrite divr_gt0// => /(_ isT)[d /= d0 dle]. +near=> x. +rewrite [in leLHS]/Num.Def.normr/= mx_normrE. +apply/(bigmax_le _ (ltW e0)) => -[/= i j] _. +rewrite [in leLHS]mxE/= [X in _ + X]mxE -[X in X - _](subrK (l i j)). +rewrite -(addrA (_ - _)) (le_trans (ler_normD _ _))// (splitr e) lerD//. +- rewrite mxE. + suff : (h^-1 *: (M (h *: v + t) i j - M t i j)) @[h --> 0^'] --> l i j. + move/cvg_lim => /=; rewrite /derive /= => ->//. + by rewrite subrr normr0 divr_ge0// ltW. + apply/cvgrPdist_le => /= r r0. + move/cvgrPdist_le : Hl => /(_ r r0)[/= s s0] sr. + near=> y. + have : `|l - y^-1 *: (M (y *: v + t) - M t)| <= r. + rewrite sr//=; last by near: y; exact: nbhs_dnbhs_neq. + by rewrite sub0r normrN; near: y; exact: dnbhs0_lt. + apply: le_trans. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE. + by under eq_bigr do rewrite !mxE; exact: (le_bigmax _ _ (i, j)). +- rewrite mxE. + have : `|l - x^-1 *: (M (x *: v + t) - M t)| <= e / 2. + apply: dle => //=; last by near: x; exact: nbhs_dnbhs_neq. + by rewrite sub0r normrN; near: x; exact: dnbhs0_lt. + apply: le_trans. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE/=. + under eq_bigr do rewrite !mxE. + apply: le_trans; last exact: le_bigmax. + by rewrite !mxE. +Unshelve. all: by end_near. Qed. -Lemma derive1mxN M t : derivable M t 1 -> 'D_1 (- M) t = - 'D_1 M t. +Lemma derive_trmx {m n : nat} (M : V -> 'M[R]_(m.+1, n.+1)) t v : + derivable M t v -> 'D_v (trmx \o M) t = ('D_v M t)^T. Proof. move=> Mt1. -by rewrite deriveN. +rewrite !derive_mx//=; last by rewrite derivable_trmx. +apply/matrixP => i j; rewrite !mxE. +by under eq_fun do rewrite mxE. Qed. -Lemma derive1mxB M N t : derivable M t 1 -> derivable N t 1 -> - 'D_1 (M - N) t = 'D_1 M t - 'D_1 N t. -Proof. -move=> Mt1 Nt1. -by rewrite deriveB. -Qed. +End pointwise_derive. -End derive_mx. +Section derivable_mulmx. +Context {R : realFieldType} {V : normedModType R} {m n k : nat}. -Section derive_mx_R. - -Variables (R : realFieldType) (m n k : nat). - -Lemma derivable_mxM (f : R -> 'M[R^o]_(m.+1, k.+1)) (g : R -> 'M[R^o]_(k.+1, n.+1)) t : - derivable f t 1 -> derivable g t 1 -> derivable (fun x => f x *m g x) t 1. +Lemma derivable_mulmx + (f : V -> 'M[R]_(m.+1, k.+1)) (g : V -> 'M[R]_(k.+1, n.+1)) t v : + derivable f t v -> derivable g t v -> derivable (fun x => f x *m g x) t v. Proof. -move=> /derivable_mxP Hf /derivable_mxP Hg. -apply/derivable_mxP => a b. evar (f1 : 'I_k.+1 -> R^o -> R^o). -rewrite (_ : (fun x => _) = (\sum_i f1 i)); last first. +move=> /derivable_mxP Hf /derivable_mxP Hg; apply/derivable_mxP => a b. +evar (f1 : 'I_k.+1 -> V -> R). +rewrite (_ : (fun x => _) = \sum_i f1 i); last first. rewrite funeqE => t'; rewrite mxE fct_sumE; apply: eq_bigr => k0 _. - rewrite /f1; reflexivity. + by rewrite /f1; reflexivity. rewrite {}/f1; apply: derivable_sum => k0. -evar (f1 : R^o -> R). evar (f2 : R -> R). +evar (f1 : V -> R). evar (f2 : V -> R). rewrite (_ : (fun t' => _) = f1 * f2); last first. - rewrite funeqE => t'; rewrite -[RHS]/(f1 t' * f2 t') /f1 /f2; reflexivity. -rewrite {}/f1 {}/f2; exact: derivableM. + by rewrite funeqE => t'; rewrite -[RHS]/(f1 t' * f2 t') /f1 /f2; reflexivity. +by rewrite {}/f1 {}/f2; exact: derivableM. Qed. -End derive_mx_R. +End derivable_mulmx. -Section derive_mx_SE. -Variables (R : rcfType) (M : R -> 'M[R^o]_4). -Hypothesis Mt1 : forall t, derivable M t 1. +Section derive_SE. +Context {R : rcfType} {V : normedModType R} (M : V -> 'M[R^o]_4). -Lemma derivable_rot_of_hom : (forall t, derivable M t 1) -> - forall x, derivable (@rot_of_hom _ \o M) x 1. +Lemma derivable_rot_of_hom x v : derivable M x v -> + derivable (@rot_of_hom _ \o M) x v. Proof. -move=> H x. -apply/derivable_mxP => i j. -rewrite /rot_of_hom. -rewrite (_ : (fun _ => _) = (fun y => (M y) (lshift 1 i) (lshift 1 j))); last first. +move=> Mt1. +apply/derivable_mxP => i j; rewrite /rot_of_hom/=. +rewrite (_ : (fun _ => _) = + fun y => (M y) (lshift 1 i) (lshift 1 j)); last first. by rewrite funeqE => y; rewrite !mxE. -rewrite /= in H. -have /derivable_mxP := H x. -exact. +by have /derivable_mxP := Mt1; exact. Qed. -Lemma derivable_trans_of_hom : (forall t, derivable M t 1) -> - forall x, derivable (@trans_of_hom _ \o M) x 1. +Lemma derivable_trans_of_hom x v : derivable M x v -> + derivable (@trans_of_hom _ \o M) x v. Proof. -move=> H x. -apply/derivable_mxP => i j. -rewrite /trans_of_hom. -rewrite /=. -rewrite (_ : (fun _ => _) = (fun y => (M y) (rshift 3 i) (lshift 1 j))); last first. - rewrite funeqE => y. - by rewrite !mxE. -rewrite /= in H. -have /derivable_mxP := H x. -exact. +move=> Mxv; apply/derivable_mxP => i j; rewrite /trans_of_hom/=. +rewrite (_ : (fun _ => _) = + fun y => (M y) (rshift 3 i) (lshift 1 j)); last first. + by rewrite funeqE => y; rewrite !mxE. +by have /derivable_mxP := Mxv; exact. Qed. -Local Open Scope classical_set_scope. - -Lemma derive1mx_SE : (forall t, M t \in 'SE3[R]) -> - forall t, 'D_1 M t = block_mx - ('D_1 (@rot_of_hom R^o \o M) t) 0 - ('D_1 (@trans_of_hom R^o \o M) t) 0. +Lemma derive1mx_SE t v : derivable M t v -> (forall t, M t \in 'SE3[R]) -> + 'D_v M t = block_mx + ('D_v (@rot_of_hom R^o \o M) t) 0 + ('D_v (@trans_of_hom R^o \o M) t) 0. Proof. -move=> MSE t. -rewrite !derive_funmxE//; last 2 first. - by apply: derivable_trans_of_hom => /= x. - by apply: derivable_rot_of_hom => /= x. +move=> Mtv MSE. +rewrite !derive_mx//; [|exact: derivable_trans_of_hom + |exact: derivable_rot_of_hom]. rewrite block_mxEh. -rewrite {1}(_ : M = (fun x => hom (rot_of_hom (M x)) (trans_of_hom (M x)))); last first. - rewrite funeqE => x; by rewrite -(SE3E (MSE x)). +rewrite {1}(_ : M = + fun x => hom (rot_of_hom (M x)) (trans_of_hom (M x))); last first. + by rewrite funeqE => x; rewrite -(SE3E (MSE x)). apply/matrixP => i j. rewrite 2!mxE; case: splitP => [j0 jj0|j0 jj0]. rewrite (_ : j = lshift 1 j0); last exact/val_inj. rewrite mxE; case: splitP => [i1 ii1|i1 ii1]. rewrite (_ : i = lshift 1 i1); last exact/val_inj. - rewrite mxE; congr ('D_1 _ t); rewrite funeqE => x. + rewrite mxE; congr ('D_v _ t); rewrite funeqE => x. by rewrite /hom (block_mxEul _ _ _ _ i1 j0). rewrite (_ : i = rshift 3 i1); last exact/val_inj. - rewrite mxE; congr ('D_1 _ t); rewrite funeqE => x. + rewrite mxE; congr ('D_v _ t); rewrite funeqE => x. by rewrite /hom (block_mxEdl (rot_of_hom (M x))). rewrite (_ : j = rshift 3 j0) ?mxE; last exact/val_inj. rewrite (ord1 j0). case: (@splitP 3 1 i) => [i0 ii0|i0 ii0]. rewrite (_ : i = lshift 1 i0); last exact/val_inj. - rewrite (_ : (fun _ => _) = (fun=> 0)). + rewrite (_ : (fun _ => _) = fun=> 0). by rewrite derive_cst mxE. by rewrite funeqE => x; rewrite /hom (block_mxEur (rot_of_hom (M x))) mxE. rewrite (_ : i = rshift 3 i0); last exact/val_inj. @@ -479,7 +370,7 @@ rewrite (_ : (fun _ => _) = (fun=> 1)) ?derive_cst // (ord1 i0) ?mxE //. by rewrite funeqE => x; rewrite /hom (block_mxEdr (rot_of_hom (M x))) mxE. Qed. -End derive_mx_SE. +End derive_SE. Section row_belast. @@ -497,7 +388,8 @@ case: fintype.splitP => /= [j Hj|[] [] //= ? ni]; rewrite mxE /=. rewrite mulr1n; congr (_ ``_ _); apply val_inj; by rewrite /= ni addn0. Qed. -Lemma derivable_row_belast (R : realFieldType) n (u : R -> 'rV[R^o]_n.+2) (t : R) (v : R): +Lemma derivable_row_belast (R : realFieldType) {V : normedModType R} + n (u : V -> 'rV[R]_n.+2) (t : V) (v : V): derivable_mx u t v -> derivable_mx (fun x => row_belast (u x)) t v. Proof. move=> H i j; move: (H ord0 (widen_ord (leqnSn n.+1) j)) => {H}. @@ -514,14 +406,15 @@ rewrite -dotmulDr; congr dotmul; apply/matrixP => i j; rewrite !(castmxE,mxE) /= case: fintype.splitP => [k /= jk|[] [] // ? /= jn]; by rewrite !(mxE,addr0,add0r,mul0rn). Qed. -Lemma derive1mx_dotmul_belast (R : realFieldType) n (u v : R^o -> 'rV[R^o]_n.+2) t : - derivable v t 1 -> +Lemma derive1mx_dotmul_belast {R : realFieldType} {V : normedModType R} n + (u v : V -> 'rV[R]_n.+2) t w : + derivable v t w -> let u' x := row_belast (u x) in let v' x := row_belast (v x) in - u' t *d 'D_1 v' t + (u t)``_ord_max *: derive (fun x => (v x)``_ord_max) t 1 = - u t *d 'D_1 v t. + u' t *d 'D_w v' t + (u t)``_ord_max *: derive (fun x => (v x)``_ord_max) t w = + u t *d 'D_w v t. Proof. move=> vt1 u' v'. -rewrite (row_belast_last ('D_1 v t)) ?addn1 // => /= ?. +rewrite (row_belast_last ('D_w v t)) ?addn1 // => /= ?. rewrite dotmul_belast; congr (_ + _). rewrite 2!dotmulE [in RHS]big_ord_recr /=. rewrite castmxE mxE /=; case: fintype.splitP => [j /= /eqP/negPn|j _]. @@ -529,13 +422,12 @@ rewrite dotmul_belast; congr (_ + _). rewrite !mxE (_ : _ == _); last by apply/eqP/val_inj => /=; move: j => [[] ?]. rewrite mulr0 addr0; apply/eq_bigr => i _; rewrite castmxE !mxE; congr (_ * _). case: fintype.splitP => [k /= ik|[] [] //= ?]; rewrite !mxE. - rewrite derive_funmxE//; last first. + rewrite derive_mx//; last first. rewrite /v'. - apply/derivable_mxP. - apply: derivable_row_belast. - by apply/derivable_mxP. + apply/derivable_mxP/derivable_row_belast. + exact/derivable_mxP. rewrite /= !mxE/=. - rewrite derive_funmxE//. + rewrite derive_mx//. rewrite mxE/=. f_equal. by rewrite funeqE => x; rewrite /v' !mxE; congr ((v _) _ _); by apply/val_inj. @@ -550,8 +442,7 @@ rewrite sumr_const mul0rn add0r castmxE /=; congr (_ * _); rewrite !mxE. case: fintype.splitP => [j /= /eqP/negPn | [] [] //= ? Hn]. by rewrite (gtn_eqF (ltn_ord j)). rewrite mxE/= mulr1n. -rewrite derive_funmxE//; last first. -by rewrite mxE//. +by rewrite derive_mx// mxE. Qed. End row_belast. @@ -559,59 +450,55 @@ End row_belast. (* TODO: could be derived from more generic lemmas about bilinearity in derive.v? *) Section product_rules. -Lemma derive1mx_dotmul (R : realFieldType) n (u v : R^o -> 'rV[R^o]_n.+1) (t : R^o) : - derivable u t 1 -> derivable v t 1 -> - 'D_1 (fun x => u x *d v x : R^o) t = - 'D_1 u t *d v t + u t *d 'D_1 v t. +Lemma derive_dotmul {R : realFieldType} {V : normedModType R} n + (u v : V -> 'rV[R]_n.+1) (t : V) (w : V) : + derivable u t w -> derivable v t w -> + 'D_w (fun x => u x *d v x) t = + 'D_w u t *d v t + u t *d 'D_w v t. Proof. -move=> /derivable_mxP U /derivable_mxP V. -evar (f : R -> R); rewrite (_ : (fun x : R => u x *d v x : R^o) = f); last first. - rewrite funeqE => x /=; exact: dotmulE. +move=> /derivable_mxP utw /derivable_mxP vtw. +evar (f : V -> R); rewrite (_ : (fun x : V => u x *d v x : R^o) = f); last first. + by rewrite funeqE => x /=; exact: dotmulE. rewrite {}/f. set f := fun i : 'I__ => fun x => ((u x) ``_ i * (v x) ``_ i). -rewrite (_ : (fun _ : R => _) = \sum_(k < _) f k); last first. +rewrite (_ : (fun _ : V => _) = \sum_(k < _) f k); last first. by rewrite funeqE => x; rewrite /f /= fct_sumE. -rewrite derive_sum; last by move=> ?; exact: derivableM (U _ _) (V _ _). +rewrite derive_sum; last by move=> ?; exact: derivableM (utw _ _) (vtw _ _). rewrite {}/f. -elim: n u v => [|n IH] u v in U V *. +elim: n u v => [|n IH] u v in utw vtw *. rewrite big_ord_recl/= big_ord0 addr0. rewrite /dotmul !mxE !sum1E !mxE. rewrite deriveM//=. rewrite addrC. rewrite mulrC//. - rewrite derive_funmxE//; last first. - exact/derivable_mxP. - rewrite !mxE. - rewrite derive_funmxE//; last first. - exact/derivable_mxP. + rewrite derive_mx//; last exact/derivable_mxP. rewrite !mxE. - done. + rewrite derive_mx//; last exact/derivable_mxP. + by rewrite !mxE. rewrite [LHS]big_ord_recr /=. set u' := fun x => row_belast (u x). set v' := fun x => row_belast (v x). -transitivity ('D_1 u' t *d v' t + u' t *d 'D_1 v' t + - derive (fun x => (u x)``_ord_max * (v x)``_ord_max) t 1). - rewrite -(IH _ _ (derivable_row_belast U) (derivable_row_belast V)). +transitivity ('D_w u' t *d v' t + u' t *d 'D_w v' t + + derive (fun x => (u x)``_ord_max * (v x)``_ord_max) t w). + rewrite -(IH _ _ (derivable_row_belast utw) (derivable_row_belast vtw)). apply: f_equal2; last by []. - apply eq_bigr => i _; congr (derive _ t 1). + apply eq_bigr => i _; congr (derive _ t w). by rewrite funeqE => x; rewrite !mxE. -rewrite (deriveM (U _ _) (V _ _)) /= -!addrA addrC addrA. +rewrite (deriveM (utw _ _) (vtw _ _)) /= -!addrA addrC addrA. rewrite -(addrA (_ + _)) [in RHS]addrC derive1mx_dotmul_belast; last first. exact/derivable_mxP. congr (_ + _). -rewrite [in RHS]dotmulC -derive1mx_dotmul_belast; last first. - exact/derivable_mxP. +rewrite [in RHS]dotmulC -derive1mx_dotmul_belast; last exact/derivable_mxP. by rewrite addrC dotmulC. Qed. -Lemma derive1mxM (R : realFieldType) n m p (M : R -> 'M[R^o]_(n.+1, m.+1)) - (N : R^o -> 'M[R^o]_(m.+1, p.+1)) (t : R^o) : - derivable M t 1 -> derivable N t 1 -> - 'D_1 (fun t => M t *m N t) t = - 'D_1 M t *m N t + M t *m ('D_1 N t). +Lemma derive_mulmx {R : realFieldType} {V : normedModType R} n m p + (M : V -> 'M[R]_(n.+1, m.+1)) + (N : V -> 'M[R]_(m.+1, p.+1)) (t : V) w : + derivable M t w -> derivable N t w -> + 'D_w (fun t => M t *m N t) t = 'D_w M t *m N t + M t *m 'D_w N t. Proof. move=> HM HN; apply/matrixP => i j. -rewrite derive_funmxE/=; last first. - exact/derivable_mxM. +rewrite derive_mx/=; last exact/derivable_mulmx. rewrite ![in LHS]mxE. rewrite (_ : (fun x => _) = fun x => \sum_k (M x) i k * (N x) k j); last first. by rewrite funeqE => x; rewrite !mxE. @@ -619,53 +506,49 @@ rewrite (_ : (fun x => _) = fun x => (row i (M x)) *d (col j (N x))^T); last first. rewrite funeqE => z; rewrite dotmulE; apply eq_bigr => k _. by rewrite 3!mxE. -rewrite (derive1mx_dotmul (derivable_mx_row HM)); last first. - rewrite /=. - rewrite -trmx_derivable/=. - exact: (derivable_mx_col HN). +rewrite (derive_dotmul (derivable_row HM)); last first. + by rewrite derivable_trmx/=; exact: derivable_col. rewrite [in RHS]mxE; congr +%R. rewrite dotmulE. rewrite [in RHS]mxE. apply: eq_bigr => /= k _. rewrite !mxE/=. congr *%R. - rewrite derive_funmxE//= mxE. - rewrite derive_funmxE//=; last first. - exact/derivable_mx_row. - rewrite !mxE//=. - f_equal. - apply/funext => y. - by rewrite !mxE. + rewrite derive_mx//=; last first. + exact: derivable_row. + rewrite mxE. + rewrite derive_mx//=. + rewrite mxE/=. + congr ('D_w _ t). + by apply/funext => y; rewrite !mxE. rewrite dotmulE. rewrite [in RHS]mxE. apply: eq_bigr => /= k _. rewrite !mxE/=. congr *%R. -rewrite derive_funmxE//=; last first. - rewrite -trmx_derivable//=. - exact/derivable_mx_col. +rewrite derive_mx//=; last first. + by rewrite derivable_trmx//=; exact/derivable_col. rewrite !mxE//=. -rewrite derive_funmxE//= !mxE. -f_equal. -apply/funext => y. -by rewrite !mxE. +rewrite derive_mx//= !mxE. +congr ('D_w _ t). +by apply/funext => y; rewrite !mxE. Qed. -Lemma derive1mx_crossmul (R : realFieldType) (u v : R -> 'rV[R^o]_3) t : - derivable u t 1 -> derivable v t 1 -> - 'D_1 (fun x => (u x *v v x) : 'rV[R^o]_3) t = - 'D_1 u t *v v t + u t *v 'D_1 v t. +Lemma derive_crossmul {R : realFieldType} {V : normedModType R} + (u v : V -> 'rV[R]_3) t w : + derivable u t w -> derivable v t w -> + 'D_w (fun x => u x *v v x) t = 'D_w u t *v v t + u t *v 'D_w v t. Proof. -move=> U V. -evar (f : R -> 'rV[R]_3); rewrite (_ : (fun x : R => _) = f); last first. - rewrite funeqE => x; exact: crossmulE. +move=> utw vtw. +evar (f : V -> 'rV[R]_3); rewrite (_ : (fun x : V => _) = f); last first. + by rewrite funeqE => x; exact: crossmulE. rewrite {}/f; apply/rowP => i; rewrite mxE. -rewrite derive_funmxE/=; last first. +rewrite derive_mx/=; last first. by apply: derivable_row3; apply: derivableB => //=; by apply: derivableM => //=; exact: derivable_coord. rewrite !mxE/=. -rewrite (mxE_funeqE (fun x : R => _))/=. +rewrite (mxE_funeqE (fun x : V => _))/=. rewrite 2!crossmulE !{1}[in RHS]mxE /=. case: ifPn => [/eqP _|/ifnot0P/orP[]/eqP -> /=]. - rewrite deriveB//=; [ | @@ -673,43 +556,43 @@ case: ifPn => [/eqP _|/ifnot0P/orP[]/eqP -> /=]. rewrite deriveM//=; [|exact: derivable_coord..]. rewrite deriveM//=; [|exact: derivable_coord..]. rewrite addrCA -!addrA; congr (_ + (_ + _)). - by rewrite derive_funmxE//= mxE. - by rewrite mulrC derive_funmxE//= mxE. + by rewrite derive_mx//= mxE. + by rewrite mulrC derive_mx//= mxE. rewrite addrC opprD mulrC. - rewrite derive_funmxE//= mxE. + rewrite derive_mx//= mxE. congr (_ - _)%R. - by rewrite derive_funmxE//= mxE. + by rewrite derive_mx//= mxE. - (*TOOD: copipe *) rewrite deriveB//=; [ | by apply: derivableM => //=; exact: derivable_coord..]. rewrite deriveM//=; [|exact: derivable_coord..]. rewrite deriveM//=; [|exact: derivable_coord..]. rewrite addrCA -!addrA; congr (_ + (_ + _)). - by rewrite derive_funmxE//= mxE. - by rewrite mulrC derive_funmxE//= mxE. + by rewrite derive_mx//= mxE. + by rewrite mulrC derive_mx//= mxE. rewrite addrC opprD mulrC. - rewrite derive_funmxE//= mxE. + rewrite derive_mx//= mxE. congr (_ - _)%R. - by rewrite derive_funmxE//= mxE. + by rewrite derive_mx//= mxE. - (*TOOD: copipe *) rewrite deriveB//=; [ | by apply: derivableM => //=; exact: derivable_coord..]. rewrite deriveM//=; [|exact: derivable_coord..]. rewrite deriveM//=; [|exact: derivable_coord..]. rewrite addrCA -!addrA; congr (_ + (_ + _)). - by rewrite derive_funmxE//= mxE. - by rewrite mulrC derive_funmxE//= mxE. + by rewrite derive_mx//= mxE. + by rewrite mulrC derive_mx//= mxE. rewrite addrC opprD mulrC. - rewrite derive_funmxE//= mxE. + rewrite derive_mx//= mxE. congr (_ - _)%R. - by rewrite derive_funmxE//= mxE. + by rewrite derive_mx//= mxE. Qed. End product_rules. Section cross_product_matrix. -Lemma differential_cross_product (R : realFieldType) (v : 'rV[R^o]_3) y : +Lemma differential_crossmul {R : realFieldType} (v : 'rV[R]_3) y : 'd (crossmul v) y = mx_lin1 \S( v ) :> (_ -> _). Proof. rewrite (_ : crossmul v = (fun x => x *m \S( v ))); last first. @@ -726,11 +609,11 @@ apply: differentiable_sum => i. exact/differentiableZl/differentiable_coord. Qed. -Lemma differential_cross_product2 (R : realFieldType) (v y : 'rV[R^o]_3) : - 'd (fun x : 'rV[R^o]_3 => x *v v) y = -1 \*: mx_lin1 \S( v ) :> (_ -> _). +Lemma differential_crossmul2 (R : realFieldType) (v y : 'rV[R]_3) : + 'd (fun x : 'rV[R]_3 => x *v v) y = -1 \*: mx_lin1 \S( v ) :> (_ -> _). Proof. transitivity ('d (crossmul (- v)) y); last first. - by rewrite differential_cross_product spinN mx_lin1N. + by rewrite differential_crossmul spinN mx_lin1N. congr diff. by rewrite funeqE => /= u; rewrite (@lieC _ (vec3 R)) linearNl. Qed. @@ -739,8 +622,8 @@ End cross_product_matrix. (* [sciavicco] p.80-81 *) Section derivative_of_a_rotation_matrix. - -Variables (R : realFieldType) (M : R -> 'M[R^o]_3). +Context {R : realFieldType}. +Variable M : R -> 'M[R^o]_3. Definition ang_vel_mx t : 'M_3 := (M t)^T * 'D_1 M t. @@ -758,7 +641,7 @@ have : (fun t => (M t)^T * M t) = cst 1. rewrite funeqE => x; by rewrite -orthogonal_inv // mulVr // orthogonal_unit. move/(congr1 (fun f => 'D_1 f t)). rewrite derive_cst. -rewrite derive1mxM // -?trmx_derivable // derive1mx_tr//. +rewrite derive_mulmx // ?derivable_trmx // derive_trmx//. move=> /eqP; rewrite addr_eq0 => /eqP H. by rewrite antiE /ang_vel_mx trmx_mul trmxK H opprK. Qed. @@ -783,7 +666,7 @@ Lemma derive1mx_rot (p' : 'rV[R^o]_3 (* constant vector *)) : let p := fun t => p' *m M t in forall t, 'D_1 p t = ang_vel t *v p t. Proof. -move=> p t; rewrite /p derive1mxM; last first. +move=> p t; rewrite /p derive_mulmx; last first. exact: derivable_M. rewrite /derivable_mx => i j; exact: ex_derive. rewrite derive_cst mul0mx add0r derive1mx_ang_vel mulmxA. diff --git a/differential_kinematics.v b/differential_kinematics.v index 5dbd2269..0974f20d 100644 --- a/differential_kinematics.v +++ b/differential_kinematics.v @@ -6,7 +6,7 @@ From mathcomp Require Import realalg complex fingroup perm. From mathcomp Require Import sesquilinear. From mathcomp Require Import boolp reals classical_sets. From mathcomp Require Import topology normedtype landau derive. -From mathcomp Require Import functions. +From mathcomp Require Import functions trigo. Require Import ssr_ext derive_matrix euclidean frame rot skew rigid. (******************************************************************************) @@ -38,6 +38,42 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. + +Lemma derive1_cos (R : realType) (t : R) : derive1 (cos : _ -> R^o) t = - sin t. +Proof. +rewrite derive1E. +have u := is_derive_cos t. +by have := @derive_val _ _ _ _ _ _ _ u. +Qed. + +Lemma derive1_sin (R : realType) (t : R) : derive1 (sin : _ -> R^o) t = cos t. +Proof. +rewrite derive1E. +have u := is_derive_sin t. +by have := @derive_val _ _ _ _ _ _ _ u. +Qed. + +Lemma derivable_sin (R : realType) (t : R) : derivable (sin : R^o -> R^o) t 1. +Proof. exact: ex_derive. Qed. + +Lemma derivable_cos (R : realType) (t : R) : derivable (cos : R^o -> R^o) t 1. +Proof. exact: ex_derive. Qed. + +Lemma derivable_cos_comp (R : realType) (t : R) (a : R^o -> R^o) : + derivable a t 1 -> derivable (cos \o a : _ -> R^o) t 1. +Proof. by move=> /derivableP Hs; exact: ex_derive. Qed. + +Lemma derivable_sin_comp (R : realType) (t : R) (a : R^o -> R^o) : + derivable a t 1 -> derivable ((sin : _ -> R^o) \o a) t 1. +Proof. by move=> /derivableP Hs; exact: ex_derive. Qed. + +Lemma derive1_cos_comp (R : realType) t (a : R^o -> R^o) : derivable a t 1 -> + derive1 (cos \o a : _ -> R^o) t = - (derive1 a t) * sin (a t). +Proof. +move=> H; rewrite (derive1_comp H); last exact: derivable_cos. +by rewrite derive1_cos mulrC mulNr mulrN. +Qed. + Local Open Scope frame_scope. Module BoundVect. (* i.e., point of application prescribed *) @@ -97,7 +133,7 @@ Proof. move=> /derivable_mxP H /derivable_mxP H'. rewrite (_ : (fun x : R => _) = (fun x : R => BoundVect.endp (Q x) + (FramedVect.v (Z x)))); last by rewrite funeqE. -rewrite derive1mxD. +rewrite deriveD. - by []. - exact: H. - exact H'. @@ -177,7 +213,7 @@ Qed. Lemma derivable_mx_FromTo_tr (R : realFieldType) (F : tframe R^o) (G : R -> rframe F) t : derivable (fun x => F _R^ (G x)) t 1 = derivable (fun x => F _R^ (G x)) t 1. -Proof. by rewrite trmx_derivable. Qed. +Proof. by rewrite -derivable_trmx. Qed. End derivable_FromTo. @@ -218,10 +254,10 @@ apply fv_eq => /=; rewrite -mulmxDl; congr (_ *m _). by rewrite addrCA subrr addr0. Qed. -Lemma derivable_mx_Q t : derivable (fun x => BoundVect.endp (Q x)) t 1. +Lemma derivable_Q t : derivable (fun x => BoundVect.endp (Q x)) t 1. Proof. -rewrite /Q/=; apply: derivable_mxD. - apply/derivable_mxP. +rewrite /Q/=; apply: derivableD. +- apply/derivable_mxP. move=> a b. move: (@derivable_F1o t a b). rewrite [X in derivable X _ _ -> _](_ : _ = @@ -229,12 +265,11 @@ rewrite /Q/=; apply: derivable_mxD. apply/funext => x/=. by destruct (F1 x) => /=; by rewrite e. by []. -apply derivable_mxM; last first. - apply/derivable_mxP. - exact: derivable_mx_FromTo. -rewrite (_ : (fun x => _) = (fun _ => BoundVect.endp (Q1 0))); last first. - rewrite funeqE => x; by rewrite Q1_fixed_in_F1. -move=> a b; exact: ex_derive. +- apply: derivable_mulmx; last first. + exact/derivable_mxP/derivable_mx_FromTo. + rewrite (_ : (fun x => _) = (fun _ => BoundVect.endp (Q1 0))); last first. + by rewrite funeqE => x; rewrite Q1_fixed_in_F1. + by move=> a b; exact: ex_derive. Qed. Let Rot := fun t => (F1 t) _R^ F. @@ -248,46 +283,39 @@ Lemma velocity_composition_rule (t : R) : Proof. rewrite {1}(_ : P = fun t => Q t \+b rmap F (P1 t \-b Q1 t)); last first. by rewrite funeqE => t'; rewrite eqnB3. -have /derivable_mxP tmp := (@derivable_mx_Q t). +have /derivable_mxP tmp := (@derivable_Q t). rewrite (derive1mx_BoundFramed_add tmp); last first. apply/derivable_mxP. - apply derivable_mxM; last first. - apply/derivable_mxP. - exact: derivable_mx_FromTo. + apply: derivable_mulmx; last first. + exact/derivable_mxP/derivable_mx_FromTo. rewrite (_ : (fun x => _) = (fun x => FramedVect.v (FramedVect_of_Bound (P1 x)) - FramedVect.v (FramedVect_of_Bound (Q1 0)))); last first. rewrite funeqE => x; by rewrite /= Q1_fixed_in_F1. - apply: derivable_mxB => //=. - apply/derivable_mxP. - exact: derivable_mxP1. + apply: derivableB => //=. + exact/derivable_mxP/derivable_mxP1. rewrite -addrA; congr (_ + _). -rewrite [in LHS]/rmap [in LHS]/= derive1mxM; last 2 first. +rewrite [in LHS]/rmap [in LHS]/= derive_mulmx; last 2 first. rewrite {1}(_ : (fun x => _) = (fun x => BoundVect.endp (P1 x) - BoundVect.endp (Q1 0))); last first. by rewrite funeqE => ?; rewrite Q1_fixed_in_F1. - apply: derivable_mxB. - apply/derivable_mxP. - exact: derivable_mxP1. + apply: derivableB. + exact/derivable_mxP/derivable_mxP1. by move=> a b; exact: ex_derive. - apply/derivable_mxP. - exact: derivable_mx_FromTo. -rewrite derive1mxB; last 2 first. - apply/derivable_mxP. - exact: derivable_mxP1. + exact/derivable_mxP/derivable_mx_FromTo. +rewrite deriveB; last 2 first. + exact/derivable_mxP/derivable_mxP1. rewrite (_ : (fun x => _) = cst (BoundVect.endp (Q1 0))); last first. by rewrite funeqE => x; rewrite Q1_fixed_in_F1. exact: derivable_cst. -congr (_*m _ + _). +congr (_ *m _ + _). rewrite [in X in _ + X = _](_ : (fun x => _) = cst (BoundVect.endp (Q1 0))); last first. by rewrite funeqE => x; rewrite Q1_fixed_in_F1. - rewrite /=. by rewrite derive_cst//= subr0. rewrite -spinE unspinK; last first. rewrite ang_vel_mx_is_so; first by []. by move=> t'; by rewrite FromTo_is_O. move=> t'. - apply/derivable_mxP. - exact: derivable_mx_FromTo. + exact/derivable_mxP/derivable_mx_FromTo. rewrite /ang_vel_mx mulmxA; congr (_ *m _). rewrite /P /Q /= opprD addrACA subrr add0r mulmxBl -!mulmxA. by rewrite orthogonal_mul_tr ?FromTo_is_O // !mulmx1. @@ -304,9 +332,7 @@ Proof. rewrite velocity_composition_rule; congr (_ + _). suff -> : 'D_1 (fun x => P1 x : 'M__) t = 0 by rewrite mul0mx addr0. apply/matrixP => a b; rewrite !mxE/=. -rewrite derive_funmxE//=; last first. - apply/derivable_mxP. - exact/derivable_mxP1. +rewrite derive_mx//=; last exact/derivable_mxP/derivable_mxP1. rewrite mxE/=. rewrite (_ : (fun x => _) = cst (P1 0 a b)); last first. rewrite funeqE => x /=; by rewrite /boundvectendp (P1_fixed_in_F1 x). @@ -404,7 +430,7 @@ End spatial_velocity. Section body_velocity. Variables (R : realType) (M : R -> 'M[R^o]_4). -Hypothesis derivableM : forall t, derivable M t 1. +Hypothesis Mt1 : forall t, derivable M t 1. Hypothesis MSE : forall t, M t \in 'SE3[R]. Definition body_velocity t : 'M_4 := 'D_1 M t * (M t)^-1. @@ -414,13 +440,14 @@ Definition body_lin_vel := let p : R -> 'rV[R^o]_3:= @trans_of_hom _ \o M in fun t => 'D_1 p t *m (r t)^T. -Lemma body_ang_vel_is_so t : body_ang_vel_mx (@rot_of_hom _ \o M) t \is 'so[R]_3. +Lemma body_ang_vel_is_so (t : R) : + body_ang_vel_mx (@rot_of_hom _ \o M) t \is 'so[R]_3. Proof. rewrite /body_ang_vel_mx. have : forall t, (@rot_of_hom R^o \o M) t \is 'O[R]_3. - move=> t0; by rewrite rotation_sub // rot_of_hom_is_SO. + by move=> t0; rewrite rotation_sub // rot_of_hom_is_SO. move/ang_vel_mx_is_so => /=. -move => /(_ (derivable_rot_of_hom derivableM))/(_ t). +move => /(_ (fun t => derivable_rot_of_hom (@Mt1 t)))/(_ t). rewrite /ang_vel_mx. move/(conj_so (((rot_of_hom (T:=R) \o M) t)^T)). rewrite !mulmxA !trmxK orthogonal_mul_tr ?rotation_sub // ?rot_of_hom_is_SO //. @@ -535,41 +562,30 @@ have : (fun t => (F2 t) _R^ F) = (fun t => ((F2 t) _R^ (F1 t)) *m ((F1 t) _R^ F) move/(congr1 (fun x => 'D_(1:R^o) x)). rewrite funeqE. move/(_ t). -rewrite derive1mxM; last 2 first. - apply/derivable_mxP. - exact: derivable_mx_FromTo'. - apply/derivable_mxP. - exact: derivable_mx_FromTo. +rewrite derive_mulmx; last 2 first. + exact/derivable_mxP/derivable_mx_FromTo'. + exact/derivable_mxP/derivable_mx_FromTo. rewrite derive1mx_ang_vel; last 2 first. - move=> t'; by rewrite FromTo_is_O. - move=> t'. - apply/derivable_mxP => /=. - by apply: derivable_mx_FromTo'. + by move=> t'; rewrite FromTo_is_O. + by move=> t'; apply/derivable_mxP/derivable_mx_FromTo. rewrite derive1mx_ang_vel; last 2 first. - move=> t'; by rewrite FromTo_is_O. - move=> t'. - apply/derivable_mxP. - by apply: derivable_mx_FromTo => //. + by move=> t'; rewrite FromTo_is_O. + by move=> t'; apply/derivable_mxP/derivable_mx_FromTo'. rewrite derive1mx_ang_vel; last 2 first. - move=> t'; by rewrite FromTo_is_O. - move=> t'. - apply/derivable_mxP => /=. - by apply: derivable_mx_FromTo. + by move=> t'; rewrite FromTo_is_O. + move=> t'; apply/derivable_mxP. + by apply/derivable_mx_FromTo. rewrite ang_vel_mxE; last 2 first. - move=> t'; by rewrite FromTo_is_O. - move=> t'. - apply/derivable_mxP => /=. - by apply: derivable_mx_FromTo. + by move=> t'; rewrite FromTo_is_O. + move=> t'; apply/derivable_mxP. + by apply/derivable_mx_FromTo. rewrite ang_vel_mxE; last 2 first. - move=> t'; by rewrite FromTo_is_O. - move=> t'. - apply/derivable_mxP => /=. - by apply: derivable_mx_FromTo'. + by move=> t'; rewrite FromTo_is_O. + move=> t'; apply/derivable_mxP. + by apply/derivable_mx_FromTo'. rewrite ang_vel_mxE; last 2 first. - move=> t'; by rewrite FromTo_is_O. - move=> t'. - apply/derivable_mxP => /=. - by apply: derivable_mx_FromTo. + by move=> t'; rewrite FromTo_is_O. + by move=> t'; exact/derivable_mxP/derivable_mx_FromTo. rewrite mulmxE -[in X in _ = X + _](mulr1 ((F2 t) _R^ (F1 t))). rewrite -(@orthogonal_tr_mul _ _ (F _R^ (F1 t))) ?FromTo_is_O //. rewrite -{2}(trmx_FromTo (F1 t) F). @@ -593,43 +609,6 @@ Qed. End link_velocity. -From mathcomp Require Import trigo. - -Lemma derive1_cos (R : realType) (t : R) : derive1 (cos : _ -> R^o) t = - sin t. -Proof. -rewrite derive1E. -have u := is_derive_cos t. -by have := @derive_val _ _ _ _ _ _ _ u. -Qed. - -Lemma derive1_sin (R : realType) (t : R) : derive1 (sin : _ -> R^o) t = cos t. -Proof. -rewrite derive1E. -have u := is_derive_sin t. -by have := @derive_val _ _ _ _ _ _ _ u. -Qed. - -Lemma derivable_sin (R : realType) (t : R) : derivable (sin : R^o -> R^o) t 1. -Proof. exact: ex_derive. Qed. - -Lemma derivable_cos (R : realType) (t : R) : derivable (cos : R^o -> R^o) t 1. -Proof. exact: ex_derive. Qed. - -Lemma derivable_cos_comp (R : realType) (t : R) (a : R^o -> R^o) : - derivable a t 1 -> derivable (cos \o a : _ -> R^o) t 1. -Proof. by move=> /derivableP Hs; exact: ex_derive. Qed. - -Lemma derivable_sin_comp (R : realType) (t : R) (a : R^o -> R^o) : - derivable a t 1 -> derivable ((sin : _ -> R^o) \o a) t 1. -Proof. by move=> /derivableP Hs; exact: ex_derive. Qed. - -Lemma derive1_cos_comp (R : realType) t (a : R^o -> R^o) : derivable a t 1 -> - derive1 (cos \o a : _ -> R^o) t = - (derive1 a t) * sin (a t). -Proof. -move=> H; rewrite (derive1_comp H); last exact: derivable_cos. -by rewrite derive1_cos mulrC mulNr mulrN. -Qed. - Definition Rz' (T : realType) (a : T) := col_mx3 (row3 (- sin a) (cos a) 0) (row3 (- cos a) (sin a) 0) 'e_2. @@ -678,27 +657,23 @@ Lemma derive1mx_RzE (R : realType) (a : R^o -> R^o) t : derivable a t 1 -> Proof. move=> Ha. apply/matrix3P/and9P; split; rewrite !mxE /=. -- rewrite derive_funmxE; last first. - exact: derivable_Rz. +- rewrite derive_mx; last exact: derivable_Rz. rewrite mxE/=. rewrite (_ : (fun _ => _) = cos \o a); last by rewrite funeqE => x; rewrite !mxE. rewrite -derive1E. rewrite (derive1_comp Ha); last exact/derivable_cos. by rewrite derive1_cos mulrC. -- rewrite derive_funmxE; last first. - exact: derivable_Rz. +- rewrite derive_mx; last exact: derivable_Rz. rewrite mxE/=. rewrite (_ : (fun _ => _) = sin \o a); last by rewrite funeqE => x; rewrite !mxE. rewrite -derive1E. rewrite (derive1_comp Ha); last exact/derivable_sin. by rewrite derive1_sin mulrC. -- rewrite derive_funmxE; last first. - exact: derivable_Rz. +- rewrite derive_mx; last exact: derivable_Rz. rewrite mxE/=. rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. by rewrite derive_cst mulr0. -- rewrite derive_funmxE; last first. - exact: derivable_Rz. +- rewrite derive_mx; last exact: derivable_Rz. rewrite mxE/=. rewrite (_ : (fun _ => _) = - sin \o a); last by rewrite funeqE => x; rewrite !mxE. rewrite (_ : - _ \o _ = - (sin \o a)) // derive1E deriveN; last first. @@ -707,31 +682,26 @@ apply/matrix3P/and9P; split; rewrite !mxE /=. exact/derivable1_diffP/derivable_sin. rewrite -!derive1E (derive1_comp Ha); last exact/derivable_sin. by rewrite derive1_sin mulrN mulrC. -- rewrite derive_funmxE; last first. - exact: derivable_Rz. +- rewrite derive_mx; last exact: derivable_Rz. rewrite mxE/=. rewrite (_ : (fun _ => _) = cos \o a); last by rewrite funeqE => x; rewrite !mxE. rewrite -derive1E (derive1_comp Ha); last exact/derivable_cos. by rewrite derive1_cos mulrN mulNr mulrC. -- rewrite derive_funmxE; last first. - exact: derivable_Rz. +- rewrite derive_mx; last exact: derivable_Rz. rewrite mxE/=. rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. by rewrite derive_cst mulr0. -- rewrite derive_funmxE; last first. - exact: derivable_Rz. +- rewrite derive_mx; last exact: derivable_Rz. rewrite mxE/=. rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. by rewrite derive_cst mulr0. -- rewrite derive_funmxE; last first. - exact: derivable_Rz. +- rewrite derive_mx; last exact: derivable_Rz. rewrite mxE/=. rewrite (_ : (fun _ => _) = \0); last by rewrite funeqE => x; rewrite !mxE. by rewrite derive_cst mulr0. -- rewrite derive_funmxE; last first. - exact: derivable_Rz. +- rewrite derive_mx; last exact: derivable_Rz. rewrite mxE/=. - rewrite (_ : (fun _ => _) = cst 1); last by rewrite funeqE => x; rewrite !mxE. + rewrite (_ : (fun _ => _) = cst 1); last by rewrite funeqE => x; rewrite !mxE. by rewrite derive_cst mulr0. Qed. @@ -801,11 +771,15 @@ Section scara_geometric_jacobian. Variable R : realType. Variable theta1 : R -> R. +Hypothesis derivable_theta1 : forall t, derivable theta1 t 1. Variable a1 : R. Variable theta2 : R -> R. +Hypothesis derivable_theta2 : forall t, derivable theta2 t 1. Variable a2 : R. Variable d3 : R -> R. +Hypothesis derivable_d3 : forall t, derivable d3 t 1. Variable theta4 : R -> R. +Hypothesis derivable_theta4 : forall t, derivable theta4 t 1. Variable d4 : R. (* direct kinematics equation written in function of the joint variables, from scara.v *) @@ -845,9 +819,21 @@ Hypothesis o2E : forall t, \o{Fim1 2%:R t} = \o{Fim1 1 t} + Hypothesis o3E : forall t, \o{Fim1 3%:R t} = \o{Fim1 2%:R t} + (d3 t) *: 'e_2. Hypothesis o4E : forall t, \o{Fmax t} = \o{Fim1 3%:R t} + d4 *: 'e_2. -Lemma derivable_joint_variable t : derivable (fun t0 : R^o => \row_i joint_variable (scara_joints i) t0) t 1. +Lemma derivable_joint_variable t : + derivable (fun t0 : R^o => \row_i joint_variable (scara_joints i) t0) t 1. Proof. -Admitted. +apply/derivable_mxP => a b. +rewrite (ord1 a)/=. +move: b => [[|[|[|[|//]]]]]/= ?. +- under eq_fun do rewrite mxE/=. + exact: derivable_theta1. +- under eq_fun do rewrite mxE/=. + exact: derivable_theta2. +- under eq_fun do rewrite mxE/=. + exact: derivable_d3. +- under eq_fun do rewrite mxE/=. + exact: derivable_theta4. +Qed. Lemma scale_realType (K : realType) (k1 : K) (k2 : K^o) : k1 *: k2 = k1 * k2. Proof. by []. Qed. @@ -866,18 +852,18 @@ rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). - rewrite /scara_lin_vel (_ : @trans_of_hom R \o _ = trans); last first. rewrite funeqE => x /=; exact: trans_of_hom_hom. rewrite /trans /scara_trans. - rewrite derive_funmxE//=; last first. - apply: derivable_row3; apply: derivableD => /=; [| | | | exact: derivable_cst |exact: H3]. + rewrite derive_mx//=; last first. + apply: derivable_row3; apply: derivableD => /=; [ | | | + | exact: derivable_cst + | exact: H3]. apply: derivableM; first exact: derivable_cst. - apply: derivable_cos_comp. - exact: derivableD. + by apply: derivable_cos_comp; exact: derivableD. apply: derivableM; first exact: derivable_cst. - by apply: derivable_cos_comp. + exact: derivable_cos_comp. apply: derivableM; first exact: derivable_cst. - apply: derivable_sin_comp. - exact: derivableD. + by apply: derivable_sin_comp; exact: derivableD. apply: derivableM; first exact: derivable_cst. - by apply: derivable_sin_comp. + exact: derivable_sin_comp. rewrite [RHS]row3_proj /= ![in RHS]mxE [in RHS]/=. transitivity ( derive1 (theta1 : R^o -> R^o) t *: (Fim1 0 t)~k *v (\o{Fmax t} - \o{Fim1 0 t}) + @@ -885,16 +871,14 @@ rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). derive1 (d3 : R^o -> R^o) t *: (Fim1 2 t)~k + derive1 (theta4 : R^o -> R^o) t *: (Fim1 3%:R t)~k *v (\o{Fmax t} - \o{Fim1 3%:R t})). rewrite /scara_joint_velocities /scara_joint_variables. - rewrite derive_funmxE; last first. - exact: derivable_joint_variable. + rewrite derive_mx; last exact: derivable_joint_variable. rewrite /geo_jac_lin /=. apply/rowP => i; rewrite 3![in RHS]mxE [in LHS]mxE sum4E; (repeat apply: f_equal2). - rewrite 2!mxE /=. rewrite (linearZl_LR _ (\o{Fmax t} - \o{Fim1``_t}))/=. rewrite [in RHS]mxE !derive1E//=. - under eq_fun do rewrite !mxE/=. - done. + by under eq_fun do rewrite !mxE/=. - rewrite 2!mxE /=. rewrite (linearZl_LR _ (\o{Fmax t} - \o{Fim1 1 t}))/=. under eq_fun do rewrite !mxE/=. @@ -1035,7 +1019,7 @@ rewrite (mul_mx_row _ a) {}/a; congr (@row_mx _ _ 3 3 _ _). derive1 (theta2 : R^o -> R^o) t *: (Fim1 1 t)~k + derive1 (theta4 : R^o -> R^o) t *: (Fim1 3%:R t)~k). rewrite /scara_joint_velocities /scara_joint_variables. - rewrite derive_funmxE; last first. + rewrite derive_mx; last first. (* derivable (fun t0 : R^o => \row_i joint_variable (scara_joints i) t0) t 1 *) exact: derivable_joint_variable. rewrite /geo_jac_ang /=. diff --git a/tilt.v b/tilt.v index bfc47765..8da87580 100644 --- a/tilt.v +++ b/tilt.v @@ -88,73 +88,80 @@ Definition locnegsemidef {R : realType} (T : normedModType R) (V : T -> R) (x : Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := V x = 0 /\ \forall z \near 0^', V z < 0. -Section derive_matrix. -Variable R : realFieldType. -Context {m n : nat}. - -From mathcomp Require Import constructive_ereal. - -Lemma derive1mxE'' (M : R -> 'M[R]_(m.+1, n.+1)) (t : R) : - derivable M t 1 -> - M^`() t = \matrix_(i < m.+1, j < n.+1) (fun t : R => M t i j)^`() t. -Admitted. (* Proved in MathComp-Analysis, to be PRed *) - -End derive_matrix. - Section derive_help. Local Open Scope classical_set_scope. -Lemma derivemx_derive1 {R : realFieldType} m n - (f : R -> 'M[R]_(m.+1, n.+1)) (x0 : R) (i : 'I_m.+1) (j : 'I_n.+1) : - 'D_1 f x0 i j = 'D_1 (fun x => f x i j) x0. -Proof. -rewrite /=. -rewrite -!derive1E. -rewrite (_ : (fun x => f x i j) = (fun M : 'M_(m.+1,n.+1) => M i j) \o f ) //. -rewrite !fctE. -Search "derive" ('M_(_,_)). -rewrite derive1mxE''. -Admitted. -Lemma derivemx_derive {R : realFieldType} (V : normedModType R) m n - (f : V -> 'M[R]_(m.+1, n.+1)) (x0 : V) (v : V) (i : 'I_m.+1) (j : 'I_n.+1) : - 'D_v f x0 i j = 'D_v (fun x => f x i j) x0. +Lemma derivable_dotmul {R : realFieldType} {n} + (u v : R -> 'rV[R]_n.+1) t : + derivable u t 1 -> derivable v t 1 -> + derivable (fun x => u x *d v x) t 1. Proof. -rewrite /derive /=. -set g := fun h => h^-1 *: (f (h *: v + x0) - f x0). -have Hfunc : forall x, g x i j = x^-1 *: (f (x *: v + x0) i j - f x0 i j). - move=> x. - rewrite /g mxE. - rewrite mxE. - by rewrite mxE. -under eq_fun do rewrite -Hfunc. -symmetry. -Search lim ( 'M_(_,_)). -Admitted. -Local Close Scope classical_set_scope. +move=> ut1 vt1/=. +rewrite /dotmul. +rewrite (_ : (fun x : R => _) = + \sum_k (fun x : R => (u x)``_k * (v x) 0 k)); last first. + apply/funext => x. + rewrite !mxE. + under eq_bigr do rewrite !mxE. + elim/big_ind2 : _ => //= f a g b -> ->. + by rewrite fctE. +apply: derivable_sum => i. +by apply: derivableM => //=; exact: derivable_coord. +Qed. -Local Open Scope classical_set_scope. Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : + u t != 0 -> + derivable u t 1 -> (1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() t = - 2*(fun t => ('D_1 u t *m (u t)^T)``_0) t :> K. + 2 * (fun t => ('D_1 u t *m (u t)^T)``_0) t :> K. Proof. +move=> u0 ut1. rewrite [LHS]derive1E deriveMl/=; last first. - admit. + apply/derivable1_diffP. + apply/(@differentiable_comp _ _ _ _ (fun x => norm (u x)) (fun x => x ^+ 2)) => //=. + rewrite /norm. + apply/(@differentiable_comp _ _ _ _ _ (fun x => Num.sqrt x)) => //=. + apply/derivable1_diffP. + exact/derivable_dotmul. + apply/derivable1_diffP. + apply/ex_derive. + apply: is_derive1_sqrt. + rewrite dotmulvv. + by rewrite exprn_gt0// norm_gt0. rewrite -derive1E mul1r. under eq_fun do rewrite -dotmulvv. rewrite dotmulP mxE /= mulr1n. rewrite derive1E. -rewrite derive1mx_dotmul ; last 2 first. -admit. -admit. +rewrite derive_dotmul ; last 2 first. + exact: ut1. + exact: ut1. rewrite dotmulC. by field. -Admitted. +Qed. + +Lemma derivable_scalar_mx {R : realFieldType} n (f : 'rV[R]_n.+1 -> R) + (a : 'rV[R]_n.+1) v : + derivable f a v -> + derivable (@scalar_mx _ 1 \o f) a v. +Proof. +move=> /cvg_ex[/= l fav]. +apply/cvg_ex => /=. +exists (\col_(i < 1) l). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : fav => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leLHS]/Num.Def.normr/= !mx_normrE/=. +apply: bigmax_le => //= -[i j] _. +rewrite !mxE/=. +by rewrite !ord1 eqxx !mulr1n. +Qed. Lemma derive1mx_row_mx {R : realFieldType} {n : nat} {m : nat} : forall (f : R -> 'rV[R]_(n.+1 + m.+1)) (g : R -> 'rV[R]_(n.+1 + m.+1)) (t : R), 'D_1 (fun x => row_mx (f x) (g x)) t = row_mx ('D_1 f t) ('D_1 g t). -Admitted. +Abort. End derive_help. @@ -169,9 +176,13 @@ Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) (i : 'I_n.+1) : + derivable f a 'e_i -> partial f a i = ('D_'e_i (@scalar_mx _ 1 \o f) a) 0 0. Proof. -rewrite derivemx_derive/= /partial /derive /=. +move=> fa1. +rewrite derive_mx ?mxE//=; last first. + exact: derivable_scalar_mx. +rewrite /partial. under eq_fun do rewrite (addrC a). by under [in RHS]eq_fun do rewrite !mxE/= !mulr1n. Qed. @@ -185,7 +196,7 @@ Lemma err_vecE {R : ringType} n (i : 'I_n.+1) : Proof. apply/rowP => j. by rewrite !mxE eqxx /= eq_sym. -Abort. +Qed. Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := \row_(i < n.+1) partial f a i. @@ -202,11 +213,12 @@ Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> R) gradient_partial f v = (jacobian1 f v)^T. Proof. move=> fa; apply/rowP => i. -rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE. - by rewrite partial_diff. -apply: differentiable_comp => //. -exact: differentiable_scalar_mx. -Unshelve. all: by end_near. Qed. +rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. + apply: differentiable_comp => //. + exact: differentiable_scalar_mx. +rewrite partial_diff//. +exact/diff_derivable. +Qed. End gradient. @@ -242,8 +254,11 @@ by rewrite mxE [in RHS]mxE -scalemxAr mxE. Qed. Lemma LieDerivativeD {K : realType} n (f g : 'rV_n.+1 -> K) (x : K -> 'rV_n.+1) : + (forall t, differentiable f (x t)) -> + (forall t, differentiable g (x t)) -> LieDerivative (f + g) x = LieDerivative f x + LieDerivative g x. Proof. +move=> dfx dgx. rewrite /LieDerivative /jacobian1 !fctE /dotmul /jacobian. apply/funext => t. rewrite (_ : (fun x0 : 'rV_n.+1 => (f x0 + g x0)%:M) = @@ -252,8 +267,10 @@ rewrite (_ : (fun x0 : 'rV_n.+1 => (f x0 + g x0)%:M) = apply/matrixP => i j. by rewrite !mxE mulrnDl. rewrite [X in ((lin1_mx X )^T *m ('D_1 x t)^T) 0 0 = _ ](@diffD K _ _ _ _ (x t)) ; last 2 first. - admit. - admit. + apply/differentiable_comp => //. + exact/differentiable_scalar_mx. + apply/differentiable_comp => //. + exact/differentiable_scalar_mx. rewrite -trmx_mul. rewrite ( _ : lin1_mx ('d _ (x t) \+ 'd _ (x t)) = lin1_mx ('d (@scalar_mx _ _ \o f) (x t)) + lin1_mx ('d (@scalar_mx _ _ \o g) (x t))); last first. @@ -262,7 +279,7 @@ rewrite ( _ : lin1_mx ('d _ (x t) \+ 'd _ (x t)) = by congr +%R; rewrite mxE. rewrite [in LHS] mulmxDr /= mxE mxE. by congr +%R; rewrite -trmx_mul [RHS]mxE. -Admitted. +Qed. Lemma derivative_LieDerivative_eq0 {K : realType} n (f : 'rV_n.+1 -> K) (x : K -> 'rV[K]_n.+1) (t : K) : @@ -298,7 +315,8 @@ transitivity ( ('D_('D_1 x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). admit. rewrite deriveE ; last first. admit. -rewrite derive_funmxE//=; last admit. +rewrite derive_mx//=; last first. + admit. rewrite deriveE ; last first. admit. transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). @@ -453,7 +471,7 @@ Lemma ya_E t : ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t = y_a p R g0 t. Proof. rewrite mulmxDl /y_a/=. congr +%R. -rewrite [in RHS]derive1mxM; [|admit|admit]. +rewrite [in RHS]derive_mulmx; [|admit|admit]. rewrite derive1mx_ang_vel//; [|admit|admit]. rewrite ang_vel_mxE//; [|admit|admit]. rewrite addrCA. @@ -492,7 +510,7 @@ Qed. Lemma dRu t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) (w' := ang_vel T) : 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(w' t) + 'D_1 u t *m T t. Proof. -rewrite derive1mxM; last 2 first. +rewrite derive_mulmx; last 2 first. admit. admit. rewrite addrC. @@ -530,21 +548,21 @@ rewrite /x2. have ->: 'D_1 (fun t0 : K => 'e_2 *m (R t0)) t = ('e_2 *m 'D_1 (fun t => (R t)) t). move => n. rewrite /=. - rewrite derive1mxM//=; last first. + rewrite derive_mulmx//=; last first. by rewrite derive_cst mul0mx add0r. rewrite /=. rewrite derive1mx_ang_vel /=; last 2 first. by move=> ?; rewrite rotation_sub. - admit. + by []. by rewrite mulmxA. -Admitted. +Qed. End problem_statementA. Section problem_statementB. Variable K : realType. Variable gamma : K. -Variable alpha1 : K. +Variable alpha1 : K. Variable p : K -> 'rV[K]_3. Let v t := 'D_1 p t. Variable R : K -> 'M[K]_3. @@ -559,21 +577,21 @@ Let x1_hat_dot t := - x1_hat t *m \S(y_g t) + y_a t - g0 *: x2_prime_hat t. Let x2_hat_dot t := x2_hat t *m - \S(y_g t - gamma *: x2_prime_hat t *m \S(x2_hat t)). Hypothesis x2_hat_S2 : x2_hat 0 \in S2. Notation x2 := (x2 R). -Let p1 t := x2 t - x2_prime_hat t. +Let p1 t := x2 t - x2_prime_hat t. Let x2_tilde (t : K) := x2 t - x2_hat t. -Let p1_point t := 'D_1 p1 t. +Let p1_point t := 'D_1 p1 t. Lemma derive_p1 t : 'D_1 p1 t = p1 t *m \S(w t) - gamma *: p1 t. Proof. rewrite /p1. -rewrite derive1mxB; last 2 first. +rewrite deriveB; last 2 first. admit. admit. rewrite /x2_prime_hat /=. rewrite deriveZ /=; last first. admit. -rewrite derive1mxM; last 2 first. +rewrite derive_mulmx; last 2 first. admit. admit. rewrite derive1mx_ang_vel; last 2 first. @@ -582,15 +600,15 @@ rewrite derive1mx_ang_vel; last 2 first. rewrite -scaleNr opprK -scaleNr opprK. rewrite !mulmxA. rewrite addrAC. -rewrite derive1mxB; last 2 first. +rewrite deriveB; last 2 first. admit. admit. rewrite derive1mx_ang_vel; last 2 first. admit. admit. -rewrite mulmxA. +rewrite mulmxA. rewrite -(mulmxA('e_2)). -rewrite orthogonal_mul_tr /=. +rewrite orthogonal_mul_tr /=. rewrite -(mulmxA('e_2)) mul1mx. rewrite ang_vel_mxE; last 2 first. admit. @@ -639,7 +657,10 @@ set fy := row_mx (- alpha1 *: Left y) rewrite /Num.norm/=. rewrite !mx_normrE. apply: bigmax_le => /=. - admit. + rewrite mulr_ge0//. + apply: le_trans; last first. + apply: (le_bigmax _ _ (ord0, ord0)) => //. + by []. move=> -[a b] _. rewrite /=. rewrite [leRHS](_ : _ = \big[maxr/0]_ij (maxr alpha1 gamma * `|(x - y) ij.1 ij.2|)); last first. @@ -683,13 +704,14 @@ apply/seteqP; split. transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). apply/funext => x. rewrite !derive1E. - rewrite derive_funmxE; last admit. + rewrite derive_mx; last first. + admit. rewrite /dotmul. under eq_fun do rewrite dotmulP /=. rewrite dotmulP. rewrite !mxE /= mulr1n. under eq_fun do rewrite !mxE /= mulr1n. - rewrite !derive1mx_dotmul; last 2 first. + rewrite !derive_dotmul/=; last 2 first. admit. admit. rewrite /dotmul /=. @@ -698,16 +720,17 @@ apply/seteqP; split. rewrite !mxE /= !mulr1n. have -> : ('D_1 (fun x0 : K => 'e_2 - Right (y x0)) x) = - (Right ('D_1 y x)). - rewrite derive1mxB /= ; last 2 first. + rewrite deriveB /= ; last 2 first. exact: derivable_cst. admit. rewrite derive_cst /= sub0r. congr (-_). - by apply derive1mx_rsubmx. + rewrite derive_rsubmx//=. + admit. (* forall x, derivable y x 1 *) rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. apply/matrixP => a b; rewrite !mxE. - rewrite derive_funmxE//= ?mxE//. - admit. + rewrite derive_mx//= ?mxE//. + admit. (* derivable y x 1 *) ring. have Rsu t0 : (Right (y^`()%classic t0) = (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2)). @@ -940,15 +963,17 @@ Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gam 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). Proof. move=> /(_ z)/(congr1 Left). -by rewrite row_mxKl => ?; rewrite derive1mx_lsubmx. -Qed. +rewrite row_mxKl => ?; rewrite derive_lsubmx//=. +admit. (* forall x : K, derivable traj x 1 *) +Admitted. Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj -> 'D_1 (Right \o traj) z = gamma *: (Right (traj z) - Left (traj z)) *m \S('e_2 - Right (traj z)) ^+ 2. Proof. -by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive1mx_rsubmx. -Qed. +move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx//=. +admit. (* forall x : K, derivable traj x 1 *) +Admitted. Let c1 := 2^-1 / alpha1. Let c2 := 2^-1 / gamma. @@ -978,6 +1003,9 @@ Qed. Lemma differentiable_norm_Left (y : 'rV[K]_6) : differentiable (fun x : 'rV_6 => norm (Left x) ^+ 2 : K) y. Proof. +apply/(@differentiable_comp _ _ _ _ (fun x => norm (Left x)) (fun x => x ^+ 2)) => //=. +apply/differentiable_comp. + (*derivable_lsubmx.*) admit. Admitted. Lemma differentiable_norm_Right (y : 'rV[K]_6) : @@ -990,7 +1018,13 @@ Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (eqn33 alpha1 gamma) x -> Proof. move=> eqn33x. rewrite /V1. -rewrite LieDerivativeD. +rewrite LieDerivativeD; last 2 first. + move=> t0. + apply: differentiableM => //=. + exact: differentiable_norm_Left. + move=> t0. + apply: differentiableM => //=. + exact: differentiable_norm_Right. rewrite !invfM /=. rewrite fctE. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. @@ -1096,8 +1130,8 @@ rewrite !sum2E/= ![in leRHS]mxE !sum2E/= ![in leRHS]mxE /=. rewrite !mulr1 mulrN mulNr opprK mulrDl mulNr -expr2. rewrite [in leLHS] addrCA -!addrA lerD2l mulrDl (mulNr (norm w)). rewrite -expr2 !addrA lerD2r !(mulrN , mulNr) opprK -mulrA. -rewrite [in leRHS](mulrC _ (norm w)) -mulrDr [in leRHS](mulrC (2 ^-1)). -by rewrite -mulrDr -div1r -splitr mulr1. +rewrite [in leRHS](mulrC (_ / 2)) (mulrC 2^-1) -mulrDr -splitr. +by rewrite [leRHS]mulrC. Qed. (* TODO: rework of this proof is needed *) @@ -1166,4 +1200,3 @@ split; first exact: equilibrium_point1. Qed. End Lyapunov. - diff --git a/tilt_robot.v b/tilt_robot.v index 35adc386..c336c2bc 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -24,7 +24,7 @@ Lemma CauchySchwarz_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : (a *d b)^+2 <= (a *d a) * (b *d b). Proof. suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. - rewrite -subr_ge0. + rewrite subr_ge0. rewrite mulrC. exact. rewrite subr_ge0 expr2 mulrC !dotmulvv /= -expr2. @@ -115,30 +115,62 @@ Lemma norm_squared {R : rcfType} n (u : 'rV[R]_n) : (u *m (u)^T) 0 0 = norm u ^+2. Proof. by rewrite -dotmulvv /dotmul. Qed. -Lemma derive1mx_rsubmx {R : realType} : - forall (f : R -> 'rV[R]_(3 + 3)) (t : R), - 'D_1 (fun x => rsubmx (f x)) t = @rsubmx R _ 3 3 ('D_1 f t). +Lemma derivable_rsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v : + (forall x, derivable f x v) -> + derivable (fun x => rsubmx (f x)) t v. Proof. -move=> f t. -apply/matrixP => i j. -rewrite !mxE /=. -rewrite /rsubmx /=. -(*under eq_fun do rewrite mxE mxE. -symmetry. -by under eq_fun do rewrite mxE. -Qed.*) Admitted. +move=> /= => df1. +apply/derivable_mxP => i j/=. +rewrite (ord1 i). +have /cvg_ex[/= l Hl]:= df1 t. +apply/cvg_ex => /=; exists (l``_(rshift 3 j)). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, rshift 3 j)). +by rewrite !mxE. +Qed. + +Lemma derive_rsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v: + (forall x, derivable f x v) -> + 'D_v (fun x => rsubmx (f x)) t = @rsubmx R _ 3 3 ('D_v f t). +Proof. +move=> df1; apply/matrixP => i j; rewrite !mxE /=. +rewrite derive_mx ?mxE//=; last exact: derivable_rsubmx. +rewrite derive_mx ?mxE//=. +f_equal. +by apply/funext => x; rewrite !mxE. +Qed. -Lemma derive1mx_lsubmx {R : realType} : - forall (f : R -> 'rV[R]_(3 + 3)) (t : R), - 'D_1 (fun x => lsubmx (f x)) t = @lsubmx R _ 3 3 ('D_1 f t). +Lemma derivable_lsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v : + (forall x, derivable f x v) -> + derivable (fun x => lsubmx (f x)) t v. Proof. -move=> f t. -(*rewrite /derive1mx. -rewrite -!derive1mx_matrix /=. -apply/matrixP => i j. -rewrite !mxE /=. -rewrite /lsubmx /=. -under eq_fun do rewrite mxE mxE. -symmetry. -by under eq_fun do rewrite mxE. -Qed.*) Admitted. +move=> /= => df1. +apply/derivable_mxP => i j/=. +rewrite (ord1 i). +have /cvg_ex[/= l Hl]:= df1 t. +apply/cvg_ex => /=; exists (l``_(lshift 3 j)). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, lshift 3 j)). +by rewrite !mxE. +Qed. + +Lemma derive_lsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v : + (forall x, derivable f x v) -> + 'D_v (fun x => lsubmx (f x)) t = @lsubmx R _ 3 3 ('D_v f t). +Proof. +move=> df1; apply/matrixP => i j; rewrite !mxE /=. +rewrite derive_mx ?mxE//=; last exact: derivable_lsubmx. +rewrite derive_mx ?mxE//=. +f_equal. +by apply/funext => x; rewrite !mxE. +Qed. From 392059edfc9c0432a7c70ebada12347fb1604743 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 1 Aug 2025 18:06:58 +0900 Subject: [PATCH 037/144] part 3B --- tilt.v | 220 +++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 182 insertions(+), 38 deletions(-) diff --git a/tilt.v b/tilt.v index 8da87580..d130cfec 100644 --- a/tilt.v +++ b/tilt.v @@ -452,8 +452,9 @@ Variable R : K -> 'M[K]_3. Variable g0 : K. Let v t := 'D_1 p t *m R t. Let w t := ang_vel R t. -Definition y_a t := - v t *m \S( w t) + 'D_1 v t + g0 *: 'e_2 *m R t. +Let x1 t := v t. Definition x2 t : 'rV_3 := 'e_2 *m R t. +Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. End ya. Definition S2 {K : realType} := [set x : 'rV[K]_3 | norm x = 1]. @@ -528,7 +529,7 @@ Admitted. (* eqn 10*) Notation y_a := (y_a p R g0). -Lemma derive_x1point t : 'D_1 x1 t = x1 t *m \S(w t) + y_a t - g0 *: 'e_2 *m R t. +Lemma derive_x1 t : 'D_1 x1 t = x1 t *m \S(w t) + y_a t - g0 *: x2 t. Proof. rewrite /y_a/= -addrA addrK. rewrite /x1. @@ -537,7 +538,7 @@ by rewrite (addrC(-_)) subrr add0r. Qed. (* eqn 11b *) -Lemma derive_x2point (t : K) : x2_point t = x2 t *m \S( w t ). +Lemma derive_x2 (t : K) : x2_point t = x2 t *m \S( w t ). Proof. rewrite /w. rewrite -ang_vel_mxE; last 2 first. @@ -564,60 +565,203 @@ Variable K : realType. Variable gamma : K. Variable alpha1 : K. Variable p : K -> 'rV[K]_3. -Let v t := 'D_1 p t. Variable R : K -> 'M[K]_3. +Hypothesis derivableR : forall t, derivable R t 1. +Let v t := 'D_1 p t *m R t. Let w t := ang_vel R t. Variable x1_hat : K -> 'rV[K]_3. Variable x2_hat : K -> 'rV[K]_3. -Let y_g := w. Variable g0 : K. +Hypotheses g0_eq0 : g0 != 0. Notation y_a := (y_a p R g0). -Let x2_prime_hat t := -(alpha1 / gamma) *: (v t - x1_hat t). -Let x1_hat_dot t := - x1_hat t *m \S(y_g t) + y_a t - g0 *: x2_prime_hat t. -Let x2_hat_dot t := x2_hat t *m - \S(y_g t - gamma *: x2_prime_hat t *m \S(x2_hat t)). +Let x1 t := v t. +Let x2'hat t := -(alpha1 / g0) *: (x1 t - x1_hat t). (* 12b*) +Hypothesis eq12a : forall t, 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'hat t. +Hypothesis eq12c : forall t, 'D_1 x2_hat t = x2_hat t *m \S(w t - gamma *: x2'hat t *m \S(x2_hat t)). (*12c*) Hypothesis x2_hat_S2 : x2_hat 0 \in S2. Notation x2 := (x2 R). -Let p1 t := x2 t - x2_prime_hat t. -Let x2_tilde (t : K) := x2 t - x2_hat t. +Let p1 t := x2 t - x2'hat t. +Let x2_tilde t := x2 t - x2_hat t. Let p1_point t := 'D_1 p1 t. +Let x2_tilde_point t := 'D_1 x2_tilde t. +Hypothesis RisSO : forall t, R t \is 'SO[K]_3. +Lemma p1E t : p1 t = x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). +Proof. +rewrite /p1 /x2 /x2'hat. +rewrite /x1. +by rewrite scaleNr opprK. +Qed. -Lemma derive_p1 t : 'D_1 p1 t = p1 t *m \S(w t) - gamma *: p1 t. +Lemma derivex1_hat t : 'D_1 x1_hat t = x1_hat t *m \S(w t). Proof. -rewrite /p1. -rewrite deriveB; last 2 first. - admit. - admit. -rewrite /x2_prime_hat /=. -rewrite deriveZ /=; last first. - admit. -rewrite derive_mulmx; last 2 first. - admit. - admit. -rewrite derive1mx_ang_vel; last 2 first. - admit. +rewrite eq12a. +rewrite /y_a/=. +Abort. + +Lemma derivex2_hat t : 'D_1 x2_hat t = x2_hat t *m \S(w t). +Proof. +rewrite eq12c. +Abort. + +Lemma derive_p1 t : 'D_1 p1 t = p1 t *m \S(w t) - alpha1 *: p1 t. +Proof. +simpl in *. +transitivity ('D_1 (fun t => x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) t). + rewrite /=. + f_equal. + apply/funext => x. + by rewrite p1E. +rewrite /=. +rewrite deriveD//=; last 2 first. + admit. (* ok *) admit. -rewrite -scaleNr opprK -scaleNr opprK. -rewrite !mulmxA. -rewrite addrAC. +rewrite deriveZ//=; last admit. +rewrite deriveB//; [|admit|admit]. +rewrite (derive_x1 g0). +rewrite -/(x2 t). +rewrite derive_x2//. +rewrite -/(x2 t). +rewrite -/(v t). +rewrite -/(x1 t). +rewrite -/(w t). +rewrite eq12a. +transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) - alpha1 *: p1 t). + transitivity (x2 t *m \S(w t) + (alpha1 / g0) *: (x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'hat t))). + do 2 f_equal. + rewrite -3![in LHS]addrA. + rewrite -[in RHS]addrA. + congr +%R. + rewrite opprD. + rewrite addrCA. + rewrite [in RHS]opprB. + rewrite [in RHS]addrA [in RHS]addrC. + congr +%R. + by rewrite opprD addrACA subrr add0r opprK. + rewrite (_ : x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'hat t) = + (x1 t - x1_hat t) *m \S(w t) - g0 *: (x2 t - x2'hat t)); last first. + rewrite mulmxBl scalerDr. + rewrite scalerN. + rewrite opprB. + rewrite addrA [LHS]addrC 2!addrA. + rewrite -addrA; congr +%R. + by rewrite addrC. + by rewrite opprB addrC. + rewrite -/(p1 t). + rewrite scalerDr. + rewrite addrA. + rewrite scalemxAl. + rewrite -mulmxDl. + rewrite -p1E. + rewrite scalerN scalerA. + by rewrite divfK//. +by rewrite -p1E. +Admitted. + +Hypothesis norm_x2_hat : forall t, norm (x2_hat t) = 1. + +Lemma derive_x2tilde t : x2_tilde_point t = x2_tilde t *m \S( w t) + gamma *: (x2_tilde t - p1 t) *m \S( x2_hat t ) ^+ 2 . +Proof. +rewrite /x2_tilde_point /x2_tilde. rewrite deriveB; last 2 first. admit. admit. -rewrite derive1mx_ang_vel; last 2 first. - admit. - admit. +rewrite derive_x2//. +rewrite -/(x2 t) -/(w t). +rewrite -/(x2_tilde t). +rewrite eq12c. +rewrite spinD. +rewrite spinN. +rewrite -scalemxAl. +rewrite (spinZ gamma). +rewrite mulmxBr. +rewrite opprB. +rewrite [LHS]addrA. +rewrite [in LHS]addrC. +rewrite addrA. +rewrite (addrC _ (x2 t *m \S(w t))). +rewrite -mulmxBl. +rewrite -/(x2_tilde t). +congr +%R. +rewrite -scalemxAr. +rewrite -[RHS]scalemxAl. +congr (_ *: _). +rewrite fact216. +xxx rewrite mulmxA. -rewrite -(mulmxA('e_2)). -rewrite orthogonal_mul_tr /=. -rewrite -(mulmxA('e_2)) mul1mx. -rewrite ang_vel_mxE; last 2 first. + +rewrite -mulmxDl. + +rewrite skew.sqr_spin /=. +rewrite norm_x2_hat expr1n. +have -> : norm ( x2_hat t) ^+ 2 = 1. admit. +have -> : (gamma *: (x2 t - x2_hat t) - gamma *: (x2 t - x2_prime_hat t)) = - gamma *: (x2_hat t - x2_prime_hat t). + rewrite -scalerBr. + rewrite !opprB. + rewrite addrA. + rewrite addrC. + rewrite addrA addrA. + have -> : (- x2 t + x2 t ) = 0. + by rewrite addrC subrr. + rewrite sub0r. + rewrite scalerDr. + rewrite scalerN. + rewrite scalerBr. + rewrite scaleNr. + congr ( - (gamma *: x2_hat t) + _). + rewrite scaleNr. + by rewrite opprK. +rewrite mulmxBl. +have -> : - gamma *: (x2_hat t - x2_prime_hat t) *m ((x2_hat t)^T *m x2_hat t - 1%:A) = 0. +rewrite scalerBr. +rewrite !mulmxBl /=. +rewrite !mulmxDr. +rewrite !mulmxA. +rewrite linearZ /=. +rewrite -scalemxAl -scalemxAl. +rewrite -!scalemxAr. +rewrite opprD. +rewrite -[in LHS]scaleNr. +rewrite addrA scale1r. +rewrite mulmxN mulmx1. +rewrite !scalemxAl. +rewrite !scaleNr. +rewrite scale1r. +rewrite !opprK. +have -> : - (gamma *: x2_hat t) *m (x2_hat t)^T *m x2_hat t + gamma *: x2_hat t - - (gamma *: x2_prime_hat t) *m (x2_hat t)^T *m x2_hat t + gamma *: x2_prime_hat t *m -1 = - (gamma *: x2_hat t) *m (x2_hat t)^T *m x2_hat t + gamma *: x2_hat t + (gamma *: x2_prime_hat t) *m (x2_hat t)^T *m x2_hat t + gamma *: x2_prime_hat t *m -1. + by rewrite !mulNmx opprK. +rewrite -scalerN. +rewrite -scalemxAl. +rewrite mulNmx. +have -> : (x2_hat t *m (x2_hat t)^T) = 1. + Search (`|_|). + rewrite dotmulP /=. + Search (norm) (dotmul). + rewrite dotmulvv. admit. -rewrite /w. -rewrite derive_cst mul0mx add0r. -rewrite /x2. -rewrite /v. -Abort. +rewrite scalerN /=. +rewrite mulmxN mulmx1. +have -> : - gamma%:A *m x2_hat t + gamma *: x2_hat t = 0. +rewrite addrC. +rewrite mulNmx. +Search (_ *m_) (_ *:_). +rewrite -mul_scalar_mx. +by rewrite scalemx1 subrr. +rewrite add0r. +rewrite -mulmxA. +have -> : (x2_hat t)^T *m x2_hat t = 1. +Search (_ ^T *m _). + Search (norm _ = 1). + + + apply/trmx_inj. + rewrite trmx_mul. + rewrite dotmulP. + admit. +by rewrite mulmx1 subrr. +by rewrite addr0. +Admitted. End problem_statementB. From 0fbab7d4ac67b8dc1811481ab4cd688f1f53073e Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Wed, 6 Aug 2025 11:26:52 +0900 Subject: [PATCH 038/144] velocity is not derived anymore but a measure --- tilt.v | 207 ++++++++++++++++++++++++++++++++------------------------- 1 file changed, 118 insertions(+), 89 deletions(-) diff --git a/tilt.v b/tilt.v index d130cfec..40ce94dc 100644 --- a/tilt.v +++ b/tilt.v @@ -447,12 +447,11 @@ Definition is_invariant_solution_equa_diff {K : realType} Section ya. (* mesure de l'accelerometre *) Variable K : realType. -Variable p : K -> 'rV[K]_3. +Variable v : K -> 'rV[K]_3. Variable R : K -> 'M[K]_3. Variable g0 : K. -Let v t := 'D_1 p t *m R t. Let w t := ang_vel R t. -Let x1 t := v t. +Let x1 t := v t *m R t. Definition x2 t : 'rV_3 := 'e_2 *m R t. Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. End ya. @@ -463,12 +462,11 @@ Section ya_E. Context {K : realType}. Variable R : K -> 'M[K]_3. Hypothesis RSO : forall t, R t \is 'SO[K]_3. -Variable p : K -> 'rV[K]_3. +Variable v : K -> 'rV[K]_3. Variable g0 : K. -Let v t := 'D_1 p t *m R t. Let w t := ang_vel R t. -Lemma ya_E t : ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t = y_a p R g0 t. +Lemma ya_E t : ('D_1 v t + g0 *: 'e_2) *m R t = y_a v R g0 t. Proof. rewrite mulmxDl /y_a/=. congr +%R. @@ -482,6 +480,7 @@ rewrite [X in _ = _ X]addrC. rewrite !mulNmx. rewrite -mulmxA. by rewrite subrr addr0. +by rewrite /x2 scalemxAl. Admitted. End ya_E. @@ -492,9 +491,8 @@ Variable g0 : K. Variable R : K -> 'M[K]_3. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. Hypothesis derivableR : forall t, derivable R t 1. -Variable p : K -> 'rV[K]_3. -Let v t := 'D_1 p t *m R t. -Let x1 t := v t. +Variable v : K -> 'rV[K]_3. +Let x1 t := v t *m R t. Let x2 t : 'rV_3 := ('e_2) *m R t (* eqn (8) *). Let x1_point t := 'D_1 x1 t. Let x2_point t := 'D_1 x2 t. @@ -528,12 +526,12 @@ by []. Admitted. (* eqn 10*) -Notation y_a := (y_a p R g0). +Notation y_a := (y_a v R g0). Lemma derive_x1 t : 'D_1 x1 t = x1 t *m \S(w t) + y_a t - g0 *: x2 t. Proof. rewrite /y_a/= -addrA addrK. rewrite /x1. -rewrite addrCA addrA mulNmx /= /v /w. +rewrite addrCA addrA mulNmx /= /w. by rewrite (addrC(-_)) subrr add0r. Qed. @@ -564,17 +562,16 @@ Section problem_statementB. Variable K : realType. Variable gamma : K. Variable alpha1 : K. -Variable p : K -> 'rV[K]_3. +Variable v : K -> 'rV[K]_3. Variable R : K -> 'M[K]_3. Hypothesis derivableR : forall t, derivable R t 1. -Let v t := 'D_1 p t *m R t. Let w t := ang_vel R t. Variable x1_hat : K -> 'rV[K]_3. Variable x2_hat : K -> 'rV[K]_3. Variable g0 : K. Hypotheses g0_eq0 : g0 != 0. -Notation y_a := (y_a p R g0). -Let x1 t := v t. +Notation y_a := (y_a v R g0). +Let x1 t := v t *m R t. Let x2'hat t := -(alpha1 / g0) *: (x1 t - x1_hat t). (* 12b*) Hypothesis eq12a : forall t, 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'hat t. Hypothesis eq12c : forall t, 'D_1 x2_hat t = x2_hat t *m \S(w t - gamma *: x2'hat t *m \S(x2_hat t)). (*12c*) @@ -585,6 +582,8 @@ Let x2_tilde t := x2 t - x2_hat t. Let p1_point t := 'D_1 p1 t. Let x2_tilde_point t := 'D_1 x2_tilde t. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. +Let zp1 t := p1 t *m (R t)^T. +Let z2 t := x2_tilde t *m (R t)^T. Lemma p1E t : p1 t = x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). Proof. @@ -597,6 +596,17 @@ Lemma derivex1_hat t : 'D_1 x1_hat t = x1_hat t *m \S(w t). Proof. rewrite eq12a. rewrite /y_a/=. +rewrite !derive_mulmx; last 2 first. + admit. + admit. +rewrite -/(w t). +rewrite !addrA. +rewrite !scalemxAl. +rewrite mulNmx. +rewrite -addrA -addrA -addrA -addrA. +have -> : (- (v t *m R t *m \S(w t)) + ('D_1 v t *m R t + (v t *m 'D_1 R t + (g0 *: 'e_2 *m R t - g0 *: x2'hat t)))) = 0. +rewrite !addrA. +rewrite -mulmxN. Abort. Lemma derivex2_hat t : 'D_1 x2_hat t = x2_hat t *m \S(w t). @@ -618,9 +628,9 @@ rewrite deriveD//=; last 2 first. admit. rewrite deriveZ//=; last admit. rewrite deriveB//; [|admit|admit]. -rewrite (derive_x1 g0). -rewrite -/(x2 t). -rewrite derive_x2//. +rewrite !(derive_x2) //. +rewrite -/(x2 t) /=. +rewrite (derive_x1 g0) //. rewrite -/(x2 t). rewrite -/(v t). rewrite -/(x1 t). @@ -660,9 +670,9 @@ Admitted. Hypothesis norm_x2_hat : forall t, norm (x2_hat t) = 1. -Lemma derive_x2tilde t : x2_tilde_point t = x2_tilde t *m \S( w t) + gamma *: (x2_tilde t - p1 t) *m \S( x2_hat t ) ^+ 2 . +Lemma derive_x2tilde t : 'D_1 x2_tilde t = x2_tilde t *m \S( w t) - gamma *: (x2_tilde t - p1 t) *m \S( x2_hat t ) ^+ 2 . Proof. -rewrite /x2_tilde_point /x2_tilde. +rewrite /x2_tilde. rewrite deriveB; last 2 first. admit. admit. @@ -684,83 +694,102 @@ rewrite -mulmxBl. rewrite -/(x2_tilde t). congr +%R. rewrite -scalemxAr. +rewrite -mulNmx. +rewrite -scalerN. rewrite -[RHS]scalemxAl. congr (_ *: _). -rewrite fact216. -xxx -rewrite mulmxA. +rewrite /x2_tilde /p1. +rewrite (opprB _ (x2'hat t)). +rewrite -addrA. +rewrite (addrC (x2 t)). +rewrite addrA subrK. +rewrite opprD opprK. +rewrite mulmxBl. +rewrite [X in _ = X + _](_ : _ = 0) ?add0r; last first. + rewrite mulmxA. + rewrite -(mulmxA(x2_hat t)) sqr_spin //. + rewrite mulmxDr !mulmxA. + rewrite dotmul1 // mul1mx. + by rewrite mulmxN mulmx1 subrr. +rewrite expr2. +rewrite -mulmxE. +rewrite fact215 -mulmxE. +rewrite -spin_crossmul. +rewrite [in RHS]mulmxA. +rewrite [in RHS]spinE. +rewrite spinE spinE. +by rewrite [LHS](@lieC _ (vec3 K))/=. +Admitted. -rewrite -mulmxDl. +Lemma Rx2 t : x2_hat t *m (R t)^T = 'e_2 - z2 t. +Proof. +rewrite /z2. +rewrite /x2_tilde. +rewrite mulmxBl. +rewrite opprB. +rewrite addrCA. +rewrite [X in _ + X](_ : _ = 0) ?addr0//. +rewrite /x2 -mulmxA. +by rewrite orthogonal_mul_tr ?rotation_sub// mulmx1 subrr. +Qed. -rewrite skew.sqr_spin /=. -rewrite norm_x2_hat expr1n. -have -> : norm ( x2_hat t) ^+ 2 = 1. +Lemma derive_zp1t t : 'D_1 zp1 t = -alpha1 *: zp1 t. +Proof. +rewrite /zp1. +rewrite derive_mulmx; last 2 first. admit. -have -> : (gamma *: (x2 t - x2_hat t) - gamma *: (x2 t - x2_prime_hat t)) = - gamma *: (x2_hat t - x2_prime_hat t). - rewrite -scalerBr. - rewrite !opprB. - rewrite addrA. - rewrite addrC. - rewrite addrA addrA. - have -> : (- x2 t + x2 t ) = 0. - by rewrite addrC subrr. - rewrite sub0r. - rewrite scalerDr. - rewrite scalerN. - rewrite scalerBr. - rewrite scaleNr. - congr ( - (gamma *: x2_hat t) + _). - rewrite scaleNr. - by rewrite opprK. -rewrite mulmxBl. -have -> : - gamma *: (x2_hat t - x2_prime_hat t) *m ((x2_hat t)^T *m x2_hat t - 1%:A) = 0. -rewrite scalerBr. -rewrite !mulmxBl /=. -rewrite !mulmxDr. -rewrite !mulmxA. -rewrite linearZ /=. -rewrite -scalemxAl -scalemxAl. -rewrite -!scalemxAr. -rewrite opprD. -rewrite -[in LHS]scaleNr. -rewrite addrA scale1r. -rewrite mulmxN mulmx1. -rewrite !scalemxAl. -rewrite !scaleNr. -rewrite scale1r. -rewrite !opprK. -have -> : - (gamma *: x2_hat t) *m (x2_hat t)^T *m x2_hat t + gamma *: x2_hat t - - (gamma *: x2_prime_hat t) *m (x2_hat t)^T *m x2_hat t + gamma *: x2_prime_hat t *m -1 = - (gamma *: x2_hat t) *m (x2_hat t)^T *m x2_hat t + gamma *: x2_hat t + (gamma *: x2_prime_hat t) *m (x2_hat t)^T *m x2_hat t + gamma *: x2_prime_hat t *m -1. - by rewrite !mulNmx opprK. -rewrite -scalerN. -rewrite -scalemxAl. -rewrite mulNmx. -have -> : (x2_hat t *m (x2_hat t)^T) = 1. - Search (`|_|). - rewrite dotmulP /=. - Search (norm) (dotmul). - rewrite dotmulvv. admit. -rewrite scalerN /=. -rewrite mulmxN mulmx1. -have -> : - gamma%:A *m x2_hat t + gamma *: x2_hat t = 0. -rewrite addrC. -rewrite mulNmx. -Search (_ *m_) (_ *:_). -rewrite -mul_scalar_mx. -by rewrite scalemx1 subrr. -rewrite add0r. +rewrite derive_p1. +rewrite mulmxBl. +rewrite addrAC. +apply/eqP. +rewrite subr_eq. +rewrite [in eqbRHS]addrC. +rewrite scaleNr. +rewrite scalemxAl subrr /=. +rewrite derive_trmx; last by admit. +rewrite derive1mx_ang_vel //; last by move => t0; rewrite rotation_sub. +rewrite ang_vel_mxE //; last by move => t1 ; rewrite rotation_sub. +rewrite -/(w t). rewrite -mulmxA. -have -> : (x2_hat t)^T *m x2_hat t = 1. -Search (_ ^T *m _). - Search (norm _ = 1). - - - apply/trmx_inj. - rewrite trmx_mul. - rewrite dotmulP. +rewrite -mulmxDr. +rewrite trmx_mul. +rewrite tr_spin. +by rewrite mulNmx subrr mulmx0. +Admitted. + +Lemma derive_z2t t : 'D_1 z2 t = gamma *: (z2 t - zp1 t) *m - \S('e_2 -z2 t)^+2. +Proof. +rewrite [LHS]derive_mulmx; last 2 first. + admit. admit. -by rewrite mulmx1 subrr. -by rewrite addr0. +simpl in *. +rewrite derive_trmx//. +rewrite derive1mx_ang_vel; last 2 first. + by move => t0; rewrite rotation_sub. + by []. +rewrite !ang_vel_mxE; last 2 first. + by move => t0; rewrite rotation_sub. + by []. +rewrite trmx_mul mulmxA -mulmxDl. +rewrite derive_x2tilde /=. +rewrite addrAC -/(w t) tr_spin mulmxN subrr sub0r. +rewrite -scalemxAl -scaleNr -scalemxAl. +rewrite mulmxN -scalemxAl -[in RHS]scaleNr. +congr (- _ *: _). +rewrite -Rx2. +rewrite -spin_similarity; last admit. +rewrite trmxK. +rewrite [in RHS]expr2 -mulmxE !mulmxA. +congr (_ *m _ *m _). +rewrite -[in RHS]mulmxA. +rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. +congr (_ *m _). +rewrite mulmxBl; congr (_ - _). + (* do a lemma with that *) + rewrite /z2 -mulmxA. + by rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. +by rewrite /zp1 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. Admitted. End problem_statementB. From 70245badb0ce5156447c8e4a455a3b33aee28873 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Wed, 6 Aug 2025 18:38:11 +0900 Subject: [PATCH 039/144] checkpoint --- tilt.v | 359 +++++++++++++++++++++++++++------------------------------ 1 file changed, 169 insertions(+), 190 deletions(-) diff --git a/tilt.v b/tilt.v index 40ce94dc..ddff264d 100644 --- a/tilt.v +++ b/tilt.v @@ -341,15 +341,15 @@ Let T := 'rV[K]_n.+1. Variable f : (K -> T) -> K -> T. -Definition solves_equation (x : K -> T) : Prop := - forall t, 'D_1 x t = f x t. +Definition solves_equation (z : K -> T) : Prop := + (forall t, derivable z t (1:K)%R) /\ forall t, 'D_1 z t = f z t. -Definition is_equilibrium_point p := solves_equation (cst p). +Definition is_equilibrium_point x := solves_equation (cst x). -Definition equilibrium_points := [set p : T | is_equilibrium_point p]. +Definition equilibrium_points := [set p : T | is_equilibrium_point p ]. Definition state_space := - [set p : T | exists y, solves_equation y /\ exists t, p = y t]. + [set p : T | exists y, solves_equation y /\ exists t, p = y t ]. End ode_equation. @@ -357,12 +357,12 @@ Definition is_lyapunov_stable_at {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) (x0 : 'rV[K]_n.+1) : Prop := - [/\ is_equilibrium_point f x0, + [/\ is_equilibrium_point f x0 , is_lyapunov_candidate V x0 & - forall traj : K -> 'rV[K]_n.+1, - solves_equation f traj -> - traj 0 = x0 -> - locnegsemidef (LieDerivative V traj) 0]. + forall traj1 traj2 : (K -> 'rV[K]_n.+1), + solves_equation f traj1 -> + traj1 0 = x0 -> + locnegsemidef (LieDerivative V traj1) 0]. (* see Appendix VII.A of https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) @@ -427,8 +427,6 @@ End basic_facts. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -Definition state_space33 {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. - (* definition du probleme *) Record equa_diff (K : realType) := { equa_f : 'rV[K]_6 -> 'rV[K]_6 ; (* autonomous *) @@ -439,10 +437,10 @@ Record equa_diff (K : realType) := { }. Definition is_invariant_solution_equa_diff {K : realType} - (e : equa_diff K) (y : K -> 'rV[K]_6) := - solves_equation (fun y t => equa_f e (y t)) y /\ - (y (equa_t0 e) \in equa_S0 e -> - (forall t, t > 0 -> y (equa_t0 e + t) \in equa_S0 e)). + (e : equa_diff K) (y1 : K -> 'rV[K]_6) := + solves_equation (fun y t => equa_f e (y t)) y1 /\ + (y1 (equa_t0 e) \in equa_S0 e -> + (forall t, t > 0 -> y1 (equa_t0 e + t) \in equa_S0 e)). (*TODO*) Section ya. (* mesure de l'accelerometre *) @@ -451,7 +449,7 @@ Variable v : K -> 'rV[K]_3. Variable R : K -> 'M[K]_3. Variable g0 : K. Let w t := ang_vel R t. -Let x1 t := v t *m R t. +Let x1 t := v t. Definition x2 t : 'rV_3 := 'e_2 *m R t. Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. End ya. @@ -468,8 +466,11 @@ Let w t := ang_vel R t. Lemma ya_E t : ('D_1 v t + g0 *: 'e_2) *m R t = y_a v R g0 t. Proof. -rewrite mulmxDl /y_a/=. +rewrite mulmxDl /y_a/= /x2. +rewrite -scalemxAl. congr +%R. +rewrite -ang_vel_mxE/=; [|admit|admit]. +(* rewrite [in RHS]derive_mulmx; [|admit|admit]. rewrite derive1mx_ang_vel//; [|admit|admit]. rewrite ang_vel_mxE//; [|admit|admit]. @@ -480,7 +481,7 @@ rewrite [X in _ = _ X]addrC. rewrite !mulNmx. rewrite -mulmxA. by rewrite subrr addr0. -by rewrite /x2 scalemxAl. +by rewrite /x2 scalemxAl.*) Admitted. End ya_E. @@ -492,7 +493,7 @@ Variable R : K -> 'M[K]_3. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. Hypothesis derivableR : forall t, derivable R t 1. Variable v : K -> 'rV[K]_3. -Let x1 t := v t *m R t. +Let x1 t := v t. Let x2 t : 'rV_3 := ('e_2) *m R t (* eqn (8) *). Let x1_point t := 'D_1 x1 t. Let x2_point t := 'D_1 x2 t. @@ -567,15 +568,18 @@ Variable R : K -> 'M[K]_3. Hypothesis derivableR : forall t, derivable R t 1. Let w t := ang_vel R t. Variable x1_hat : K -> 'rV[K]_3. +Hypothesis derivable_x1_hat : forall t, derivable x1_hat t 1. Variable x2_hat : K -> 'rV[K]_3. Variable g0 : K. Hypotheses g0_eq0 : g0 != 0. Notation y_a := (y_a v R g0). -Let x1 t := v t *m R t. +Let x1 t := v t . Let x2'hat t := -(alpha1 / g0) *: (x1 t - x1_hat t). (* 12b*) Hypothesis eq12a : forall t, 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'hat t. Hypothesis eq12c : forall t, 'D_1 x2_hat t = x2_hat t *m \S(w t - gamma *: x2'hat t *m \S(x2_hat t)). (*12c*) Hypothesis x2_hat_S2 : x2_hat 0 \in S2. +Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. +Hypothesis v_derivable : forall t, derivable v t 1. Notation x2 := (x2 R). Let p1 t := x2 t - x2'hat t. Let x2_tilde t := x2 t - x2_hat t. @@ -584,142 +588,88 @@ Let x2_tilde_point t := 'D_1 x2_tilde t. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. Let zp1 t := p1 t *m (R t)^T. Let z2 t := x2_tilde t *m (R t)^T. +Hypothesis norm_x2_hat : forall t, norm (x2_hat t) = 1. -Lemma p1E t : p1 t = x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). +Let p1E : p1 = fun t => x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). Proof. -rewrite /p1 /x2 /x2'hat. -rewrite /x1. -by rewrite scaleNr opprK. +apply/funext => ?. +rewrite /p1 /x2; congr +%R. +by rewrite /x2'hat scaleNr opprK. Qed. -Lemma derivex1_hat t : 'D_1 x1_hat t = x1_hat t *m \S(w t). +Let x2_tildeE t : x2_tilde t = z2 t *m R t. Proof. -rewrite eq12a. -rewrite /y_a/=. -rewrite !derive_mulmx; last 2 first. - admit. - admit. -rewrite -/(w t). -rewrite !addrA. -rewrite !scalemxAl. -rewrite mulNmx. -rewrite -addrA -addrA -addrA -addrA. -have -> : (- (v t *m R t *m \S(w t)) + ('D_1 v t *m R t + (v t *m 'D_1 R t + (g0 *: 'e_2 *m R t - g0 *: x2'hat t)))) = 0. -rewrite !addrA. -rewrite -mulmxN. -Abort. +rewrite /z2 -mulmxA. +by rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. +Qed. -Lemma derivex2_hat t : 'D_1 x2_hat t = x2_hat t *m \S(w t). -Proof. -rewrite eq12c. -Abort. +Let derivable_x2 t : derivable x2 t 1. Proof. exact: derivable_mulmx. Qed. + +Let derivable_x2'hat t : derivable x2'hat t 1. +Proof. by apply: derivableZ => /=; exact: derivableB. Qed. + +Let derivable_p1 t : derivable p1 t 1. Proof. exact: derivableB. Qed. + +Let derivable_x2_tilde t : derivable x2_tilde t 1. Proof. exact: derivableB. Qed. Lemma derive_p1 t : 'D_1 p1 t = p1 t *m \S(w t) - alpha1 *: p1 t. Proof. simpl in *. -transitivity ('D_1 (fun t => x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) t). - rewrite /=. - f_equal. - apply/funext => x. - by rewrite p1E. -rewrite /=. -rewrite deriveD//=; last 2 first. - admit. (* ok *) - admit. -rewrite deriveZ//=; last admit. -rewrite deriveB//; [|admit|admit]. -rewrite !(derive_x2) //. -rewrite -/(x2 t) /=. -rewrite (derive_x1 g0) //. -rewrite -/(x2 t). -rewrite -/(v t). -rewrite -/(x1 t). -rewrite -/(w t). +rewrite p1E. +rewrite deriveD//=; last first. + by apply: derivableZ => /=; exact: derivableB. +rewrite deriveZ//=; last exact: derivableB. +rewrite deriveB//. +rewrite !(derive_x2) // -/(x2 t) /=. +rewrite (derive_x1 g0 R) //. +rewrite -/(x2 t) -/(v t) -/(x1 t) -/(w t). rewrite eq12a. transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) - alpha1 *: p1 t). transitivity (x2 t *m \S(w t) + (alpha1 / g0) *: (x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'hat t))). do 2 f_equal. - rewrite -3![in LHS]addrA. - rewrite -[in RHS]addrA. + rewrite -3![in LHS]addrA -[in RHS]addrA. congr +%R. - rewrite opprD. - rewrite addrCA. - rewrite [in RHS]opprB. - rewrite [in RHS]addrA [in RHS]addrC. + rewrite opprD addrCA. + rewrite [in RHS]opprB [in RHS]addrA [in RHS]addrC. congr +%R. by rewrite opprD addrACA subrr add0r opprK. rewrite (_ : x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'hat t) = (x1 t - x1_hat t) *m \S(w t) - g0 *: (x2 t - x2'hat t)); last first. - rewrite mulmxBl scalerDr. - rewrite scalerN. - rewrite opprB. - rewrite addrA [LHS]addrC 2!addrA. + rewrite mulmxBl scalerDr scalerN opprB addrA [LHS]addrC 2!addrA. rewrite -addrA; congr +%R. by rewrite addrC. by rewrite opprB addrC. rewrite -/(p1 t). - rewrite scalerDr. - rewrite addrA. - rewrite scalemxAl. - rewrite -mulmxDl. - rewrite -p1E. - rewrite scalerN scalerA. - by rewrite divfK//. -by rewrite -p1E. -Admitted. - -Hypothesis norm_x2_hat : forall t, norm (x2_hat t) = 1. + rewrite scalerDr addrA scalemxAl -mulmxDl scalerN scalerA. + by rewrite divfK. +by rewrite p1E. +Qed. Lemma derive_x2tilde t : 'D_1 x2_tilde t = x2_tilde t *m \S( w t) - gamma *: (x2_tilde t - p1 t) *m \S( x2_hat t ) ^+ 2 . Proof. rewrite /x2_tilde. -rewrite deriveB; last 2 first. - admit. - admit. +rewrite [in LHS]deriveB//. rewrite derive_x2//. -rewrite -/(x2 t) -/(w t). -rewrite -/(x2_tilde t). +rewrite -/(x2 t) -/(w t) -/(x2_tilde t). rewrite eq12c. -rewrite spinD. -rewrite spinN. -rewrite -scalemxAl. -rewrite (spinZ gamma). -rewrite mulmxBr. -rewrite opprB. -rewrite [LHS]addrA. -rewrite [in LHS]addrC. -rewrite addrA. -rewrite (addrC _ (x2 t *m \S(w t))). -rewrite -mulmxBl. -rewrite -/(x2_tilde t). +rewrite spinD spinN -scalemxAl (spinZ gamma). +rewrite mulmxBr opprB [LHS]addrA [in LHS]addrC addrA (addrC _ (x2 t *m \S(w t))). +rewrite -mulmxBl -/(x2_tilde t). congr +%R. -rewrite -scalemxAr. -rewrite -mulNmx. -rewrite -scalerN. -rewrite -[RHS]scalemxAl. +rewrite -scalemxAr -mulNmx -scalerN -[RHS]scalemxAl. congr (_ *: _). rewrite /x2_tilde /p1. -rewrite (opprB _ (x2'hat t)). -rewrite -addrA. -rewrite (addrC (x2 t)). -rewrite addrA subrK. -rewrite opprD opprK. -rewrite mulmxBl. +rewrite (opprB _ (x2'hat t)) -addrA (addrC (x2 t)) addrA subrK opprD opprK mulmxBl. rewrite [X in _ = X + _](_ : _ = 0) ?add0r; last first. rewrite mulmxA. rewrite -(mulmxA(x2_hat t)) sqr_spin //. rewrite mulmxDr !mulmxA. rewrite dotmul1 // mul1mx. by rewrite mulmxN mulmx1 subrr. -rewrite expr2. -rewrite -mulmxE. -rewrite fact215 -mulmxE. -rewrite -spin_crossmul. -rewrite [in RHS]mulmxA. -rewrite [in RHS]spinE. -rewrite spinE spinE. +rewrite expr2 -mulmxE fact215 -mulmxE -spin_crossmul. +rewrite [in RHS]mulmxA [in RHS]spinE spinE spinE. by rewrite [LHS](@lieC _ (vec3 K))/=. -Admitted. +Qed. Lemma Rx2 t : x2_hat t *m (R t)^T = 'e_2 - z2 t. Proof. @@ -736,9 +686,7 @@ Qed. Lemma derive_zp1t t : 'D_1 zp1 t = -alpha1 *: zp1 t. Proof. rewrite /zp1. -rewrite derive_mulmx; last 2 first. - admit. - admit. +rewrite derive_mulmx//=; last by rewrite derivable_trmx. rewrite derive_p1. rewrite mulmxBl. rewrite addrAC. @@ -747,7 +695,7 @@ rewrite subr_eq. rewrite [in eqbRHS]addrC. rewrite scaleNr. rewrite scalemxAl subrr /=. -rewrite derive_trmx; last by admit. +rewrite derive_trmx//. rewrite derive1mx_ang_vel //; last by move => t0; rewrite rotation_sub. rewrite ang_vel_mxE //; last by move => t1 ; rewrite rotation_sub. rewrite -/(w t). @@ -756,21 +704,18 @@ rewrite -mulmxDr. rewrite trmx_mul. rewrite tr_spin. by rewrite mulNmx subrr mulmx0. -Admitted. +Qed. Lemma derive_z2t t : 'D_1 z2 t = gamma *: (z2 t - zp1 t) *m - \S('e_2 -z2 t)^+2. Proof. -rewrite [LHS]derive_mulmx; last 2 first. - admit. - admit. +rewrite [LHS]derive_mulmx//=; last first. + by rewrite derivable_trmx. simpl in *. rewrite derive_trmx//. -rewrite derive1mx_ang_vel; last 2 first. +rewrite derive1mx_ang_vel//=; last first. by move => t0; rewrite rotation_sub. - by []. -rewrite !ang_vel_mxE; last 2 first. +rewrite !ang_vel_mxE//; last first. by move => t0; rewrite rotation_sub. - by []. rewrite trmx_mul mulmxA -mulmxDl. rewrite derive_x2tilde /=. rewrite addrAC -/(w t) tr_spin mulmxN subrr sub0r. @@ -778,19 +723,20 @@ rewrite -scalemxAl -scaleNr -scalemxAl. rewrite mulmxN -scalemxAl -[in RHS]scaleNr. congr (- _ *: _). rewrite -Rx2. -rewrite -spin_similarity; last admit. +rewrite -spin_similarity ?rotationV//. rewrite trmxK. rewrite [in RHS]expr2 -mulmxE !mulmxA. congr (_ *m _ *m _). rewrite -[in RHS]mulmxA. rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. congr (_ *m _). -rewrite mulmxBl; congr (_ - _). - (* do a lemma with that *) - rewrite /z2 -mulmxA. - by rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. +rewrite x2_tildeE. +rewrite mulmxBl; congr (_ - _)%R. by rewrite /zp1 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. -Admitted. +Qed. + +(* TODO relier derivezp1 et derivez2 a eqn33?*) +(* TODO see about thm11a and the rest*) End problem_statementB. @@ -800,9 +746,25 @@ Variable alpha1 : K. Variable gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Variable g0 : K. Variable y0 : K -> 'rV[K]_6. Variable R : K -> 'M[K]_3. +Hypothesis derivableR : forall t, derivable R t 1. +Let w t := ang_vel R t. +Variable v : K -> 'rV[K]_3. +Let x1 t := v t . +Variable g0 : K. +Variable x1_hat : K -> 'rV[K]_3. +Notation x2 := (x2 R). +Let x2'hat t := -(alpha1 / g0) *: (x1 t - x1_hat t). (* 12b*) +Let p1 (t : K) := x2 t - x2'hat t . +Let zp1 t := p1 t *m (R t)^T. +Variable x2_hat : K -> 'rV[K]_3. +Hypothesis x2_hat_S2 : x2_hat 0 \in S2. +Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. +Hypothesis v_derivable : forall t, derivable v t 1. +Let x2_tilde t := x2 t - x2_hat t. +Let z2 t := x2_tilde t *m (R t)^T. +Variable y1 : K -> 'rV[K]_6. Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := let zp1_point := Left \o zp1_z2_point in @@ -810,23 +772,26 @@ Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := fun t => row_mx (- alpha1 *: zp1_point t) (gamma *: (z2_point t - zp1_point t) *m \S('e_2%:R - z2_point t) ^+ 2). +(*Lemma eqn33E t : eqn33 t = eqn33' (y1 t). +Proof. +by rewrite /eqn33 /eqn33' /y row_mxKr row_mxKl. +Qed.*) + Definition eqn33' (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := let zp1_point := Left zp1_z2_point in let z2_point := Right zp1_z2_point in row_mx (- alpha1 *: zp1_point) (gamma *: (z2_point - zp1_point) *m \S('e_2%:R - z2_point) ^+ 2). -Lemma eqn33E y t : eqn33 y t = eqn33' (y t). Proof. by []. Qed. - Lemma eqn33'_lipschitz : exists k, k.-lipschitz_setT eqn33'. Proof. near (pinfty_nbhs K) => k. -exists k => -[/= x y] _. +exists k => -[/= x x0] _. rewrite /eqn33'. set fx := row_mx (- alpha1 *: Left x) (gamma *: (Right x - Left x) *m \S('e_2 - Right x) ^+ 2). -set fy := row_mx (- alpha1 *: Left y) - (gamma *: (Right y - Left y) *m \S('e_2 - Right y) ^+ 2). +set fy := row_mx (- alpha1 *: Left x0) + (gamma *: (Right x0 - Left x0) *m \S('e_2 - Right x0) ^+ 2). rewrite /Num.norm/=. rewrite !mx_normrE. apply: bigmax_le => /=. @@ -836,16 +801,16 @@ apply: bigmax_le => /=. by []. move=> -[a b] _. rewrite /=. -rewrite [leRHS](_ : _ = \big[maxr/0]_ij (maxr alpha1 gamma * `|(x - y) ij.1 ij.2|)); last first. +rewrite [leRHS](_ : _ = \big[maxr/0]_ij (maxr alpha1 gamma * `|(x - x0) ij.1 ij.2|)); last first. admit. rewrite (le_trans (@ler_peMl _ (maxr alpha1 gamma) _ _ _))//. admit. apply: le_trans; last first. - exact: (@le_bigmax _ _ _ 0 (fun ij => maxr alpha1 gamma * `|(x - y) ij.1 ij.2|) (a, b)). + exact: (@le_bigmax _ _ _ 0 (fun ij => maxr alpha1 gamma * `|(x - x0) ij.1 ij.2|) (a, b)). rewrite /=. apply: (@le_trans _ _ (`|(maxr alpha1 gamma *: fx - maxr alpha1 gamma *: fy) a b|)). admit. -apply: (@le_trans _ _ (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: y a b|)); last first. +apply: (@le_trans _ _ (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: x0 a b|)); last first. Admitted. (* cauchy lipschitz par F1 qui definit un champ de vecteur lisse : @@ -855,57 +820,57 @@ gamma1 ⊆ state_space*) state_space ⊆ gamma1 *) -Lemma invariant_state_space33 p (p33 : state_space eqn33 p) : +(*Lemma invariant_state_space33 p (p33 : state_space eqn33 p) : let y := sval (cid p33) in let t := sval (cid (svalP (cid p33)).2) in forall Delta, Delta >= 0 -> state_space eqn33 (y (t + Delta)). Proof. -case: p33 => /= y sol_y Delta Delta_ge0. +case: p33 => /= x0 sol_y Delta Delta_ge0. rewrite /state_space/=. -exists y; split. +exists x0; split. by case: sol_y. case: cid => //= y' y'sol. case: cid => t'/= pt'. -eexists. -Abort. +Abort.*) + +Definition state_space33 {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. Lemma thm11a : state_space eqn33 = state_space33. Proof. apply/seteqP; split. -- move=> p [y [y33]] [t ->]. +- move=> p [y [[dy y33]]] [t ->]. + rewrite /state_space33. have : derive1 (fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). apply/funext => x. rewrite !derive1E. rewrite derive_mx; last first. - admit. + by auto. rewrite /dotmul. under eq_fun do rewrite dotmulP /=. rewrite dotmulP. rewrite !mxE /= mulr1n. under eq_fun do rewrite !mxE /= mulr1n. rewrite !derive_dotmul/=; last 2 first. - admit. - admit. + by apply: derivableB => //=; exact: derivable_rsubmx. + by apply: derivableB => //=; exact: derivable_rsubmx. rewrite /dotmul /=. rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. rewrite !mxE /= !mulr1n. - have -> : ('D_1 (fun x0 : K => 'e_2 - Right (y x0)) x) + have -> : ('D_1 (fun x2 : K => 'e_2 - Right (y x2)) x) = - (Right ('D_1 y x)). rewrite deriveB /= ; last 2 first. exact: derivable_cst. - admit. + exact: derivable_rsubmx. rewrite derive_cst /= sub0r. congr (-_). - rewrite derive_rsubmx//=. - admit. (* forall x, derivable y x 1 *) + by rewrite derive_rsubmx//=. rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. apply/matrixP => a b; rewrite !mxE. - rewrite derive_mx//= ?mxE//. - admit. (* derivable y x 1 *) + by rewrite derive_mx//= ?mxE//. ring. - have Rsu t0 : (Right (y^`()%classic t0) = +have Rsu t0 : (Right (y^`()%classic t0) = (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2)). rewrite derive1E. rewrite y33. @@ -933,7 +898,8 @@ apply/seteqP; split. move => s0. by apply: s0. rewrite /state_space33/=. -(* move: y0init. + simpl in *. + (* move: y0init. rewrite inE /state_space33 /=. move=> Hnorm0. (* reecrire ce charabia *) *) @@ -960,30 +926,40 @@ Admitted. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). +(* on doit pouvoir noter que z2 est un point quon peut decider ..*) + Lemma equilibrium_point1 : is_equilibrium_point eqn33 point1. Proof. -move=> t; rewrite derive_cst /eqn33 /point; apply/eqP. +split => //=. +move=> t; rewrite derive_cst /eqn33 /point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. - by rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i; rewrite !mxE. + rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. + rewrite /zp1 /p1 /= /x2 /x2'hat /x1. + admit. apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. - rewrite /N /=; apply /rowP; move => a; by rewrite !mxE subr0. + rewrite /N /=; apply /rowP; move => a. + rewrite mxE. + admit. by move => n; rewrite n scaler0 mul0mx. -Qed. +Admitted. Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2. Proof. +split => //=. move => t; rewrite derive_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). have N0 : N = 0. - apply/rowP; move => i; rewrite !mxE; case: splitP. - move => j _; by rewrite mxE. + apply/rowP; move => i; rewrite /p1. + rewrite /N /zp1 /p1. + admit. + (*move => j _; by rewrite mxE. move => k /= i3k. have := ltn_ord i. - by rewrite i3k -ltn_subRL subnn. + by rewrite i3k -ltn_subRL subnn.*) split. by rewrite scaler_eq0 N0 eqxx orbT. rewrite -scalemxAl scalemx_eq0 gt_eqF//=. -rewrite -[Left point2]/N N0 subr0. +(*rewrite -[Left point2]/N N0 subr0. set M := (X in X *m _); rewrite -/M. have ME : M = 2 *: 'e_2. apply/rowP => i; rewrite !mxE eqxx/=. @@ -995,7 +971,8 @@ have ME : M = 2 *: 'e_2. by rewrite !mxE eqxx/=. rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. -Qed. +Qed.*) +Admitted. (* this lemma asks for lyapunov + lasalle *) Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation eqn33 y -> @@ -1118,16 +1095,11 @@ End V1. Section Lyapunov. Local Open Scope classical_set_scope. Context {K : realType}. -Variable x1_hat : K -> 'rV[K]_3. -Variable x2_hat : K -> 'rV[K]_3. Variable alpha1 : K. Variable gamma : K. -Variable g0 : K. -Hypothesis g0_pos : 0 < g0. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. Variable R : K -> 'M[K]_3. -Variable v : K -> 'rV[K]_3. Variable y0 : K -> 'rV[K]_6. Hypothesis y0init: y0 0 \in state_space33. Hypothesis y0sol : solves_equation (eqn33 alpha1 gamma) y0. @@ -1135,18 +1107,18 @@ Hypothesis y0sol : solves_equation (eqn33 alpha1 gamma) y0. Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj -> 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). Proof. +move=> [/= dtraj]. move=> /(_ z)/(congr1 Left). -rewrite row_mxKl => ?; rewrite derive_lsubmx//=. -admit. (* forall x : K, derivable traj x 1 *) -Admitted. +by rewrite row_mxKl => ?; rewrite derive_lsubmx//=. +Qed. Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj -> 'D_1 (Right \o traj) z = gamma *: (Right (traj z) - Left (traj z)) *m \S('e_2 - Right (traj z)) ^+ 2. Proof. -move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx//=. -admit. (* forall x : K, derivable traj x 1 *) -Admitted. +move=> [/= dtraj]. +by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx//=. +Qed. Let c1 := 2^-1 / alpha1. Let c2 := 2^-1 / gamma. @@ -1179,6 +1151,7 @@ Proof. apply/(@differentiable_comp _ _ _ _ (fun x => norm (Left x)) (fun x => x ^+ 2)) => //=. apply/differentiable_comp. (*derivable_lsubmx.*) admit. +admit. Admitted. Lemma differentiable_norm_Right (y : 'rV[K]_6) : @@ -1213,9 +1186,9 @@ Lemma Gamma1_traj (y : K -> 'rV_6) t : solves_equation (eqn33 alpha1 gamma) y -> state_space33 (y t). Proof. move=> iss. -rewrite -(thm11a gamma_gt0 alpha1_gt0). -exists y; split => //. -by exists t. +Fail rewrite -(@thm11a _ _ _ gamma_gt0 alpha1_gt0 y0 R)//=. +Fail exists y; split => //. +Fail by exists t. Admitted. Lemma norm_u1 (traj : K -> 'rV_6) (z : K) (z2 := Right \o traj) @@ -1343,18 +1316,24 @@ Lemma V1_point_is_lnsd (y : K -> 'rV_6) : y 0 = point1 -> locnegsemidef (LieDerivative (V1 alpha1 gamma) y) 0. Proof. -move=> dtraj traj0. -have Gamma1_traj t : state_space33 (y t) by apply/Gamma1_traj. +move=> [dy dtraj] traj0. +have Gamma1_traj t : state_space33 (y t). + apply/Gamma1_traj. + by split => //. rewrite /locnegsemidef /V1. -rewrite LieDerivativeD /=. -split; last exact/near0_le0. +rewrite LieDerivativeD /=; last 2 first. + admit. + admit. +split; last first. + apply/near0_le0; last by []. + by split => //. rewrite !invfM /=. rewrite !fctE. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Left. rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Right. -rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. +rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. admit. rewrite [LHS]dtraj /eqn33/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. From 88653ed719905b9cc34378fa301b8db73f9eccde Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Wed, 6 Aug 2025 18:46:33 +0900 Subject: [PATCH 040/144] working state --- tilt.v | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/tilt.v b/tilt.v index ddff264d..40576a75 100644 --- a/tilt.v +++ b/tilt.v @@ -340,9 +340,10 @@ Context {K : realType} {n : nat}. Let T := 'rV[K]_n.+1. Variable f : (K -> T) -> K -> T. +(*Variable y0 : T.*) Definition solves_equation (z : K -> T) : Prop := - (forall t, derivable z t (1:K)%R) /\ forall t, 'D_1 z t = f z t. + (*z 0 = t0 /\*) (forall t, derivable z t (1:K)%R) /\ forall t, 'D_1 z t = f z t. Definition is_equilibrium_point x := solves_equation (cst x). @@ -935,31 +936,29 @@ move=> t; rewrite derive_cst /eqn33 /point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. rewrite /zp1 /p1 /= /x2 /x2'hat /x1. - admit. + by rewrite lsubmx_const. apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. rewrite /N /=; apply /rowP; move => a. - rewrite mxE. - admit. + rewrite !mxE. + by rewrite subrr. by move => n; rewrite n scaler0 mul0mx. -Admitted. +Qed. Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2. Proof. -split => //=. +split => //. move => t; rewrite derive_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). have N0 : N = 0. - apply/rowP; move => i; rewrite /p1. - rewrite /N /zp1 /p1. - admit. - (*move => j _; by rewrite mxE. + apply/rowP; move => i; rewrite !mxE; case: splitP. + move => j _; by rewrite mxE. move => k /= i3k. have := ltn_ord i. - by rewrite i3k -ltn_subRL subnn.*) + by rewrite i3k -ltn_subRL subnn. split. by rewrite scaler_eq0 N0 eqxx orbT. rewrite -scalemxAl scalemx_eq0 gt_eqF//=. -(*rewrite -[Left point2]/N N0 subr0. +rewrite -[Left point2]/N N0 subr0. set M := (X in X *m _); rewrite -/M. have ME : M = 2 *: 'e_2. apply/rowP => i; rewrite !mxE eqxx/=. @@ -971,8 +970,7 @@ have ME : M = 2 *: 'e_2. by rewrite !mxE eqxx/=. rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. -Qed.*) -Admitted. +Qed. (* this lemma asks for lyapunov + lasalle *) Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation eqn33 y -> @@ -1346,9 +1344,11 @@ Admitted. Lemma V1_is_lyapunov_stable : is_lyapunov_stable_at (eqn33 alpha1 gamma) (V1 alpha1 gamma) point1. Proof. -split; first exact: equilibrium_point1. +split. +- by apply: equilibrium_point1 => //. - exact: V1_is_lyapunov_candidate. -- exact: V1_point_is_lnsd. +- move=> traj1 ? ? ?. + by apply: V1_point_is_lnsd => //. Qed. End Lyapunov. From b4fc16519d8280b9bf0ca0365b0f10ce98677792 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 8 Aug 2025 12:19:08 +0900 Subject: [PATCH 041/144] fix solves_equations --- tilt.v | 186 ++++++++++++++++++++++++++------------------------------- 1 file changed, 85 insertions(+), 101 deletions(-) diff --git a/tilt.v b/tilt.v index 40576a75..6a026a60 100644 --- a/tilt.v +++ b/tilt.v @@ -340,28 +340,28 @@ Context {K : realType} {n : nat}. Let T := 'rV[K]_n.+1. Variable f : (K -> T) -> K -> T. -(*Variable y0 : T.*) -Definition solves_equation (z : K -> T) : Prop := - (*z 0 = t0 /\*) (forall t, derivable z t (1:K)%R) /\ forall t, 'D_1 z t = f z t. +Definition solves_equation (z : K -> T) (A : set T) : Prop := + z 0 \in A /\ (forall t, derivable z t (1:K)%R) /\ forall t, 'D_1 z t = f z t. Definition is_equilibrium_point x := solves_equation (cst x). -Definition equilibrium_points := [set p : T | is_equilibrium_point p ]. +Definition equilibrium_points A := [set p : T | is_equilibrium_point p A ]. -Definition state_space := - [set p : T | exists y, solves_equation y /\ exists t, p = y t ]. +Definition state_space A := + [set p : T | exists y, solves_equation y A /\ exists t, p = y t ]. End ode_equation. Definition is_lyapunov_stable_at {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (A : set 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) (x0 : 'rV[K]_n.+1) : Prop := - [/\ is_equilibrium_point f x0 , + [/\ is_equilibrium_point f x0 A, is_lyapunov_candidate V x0 & forall traj1 traj2 : (K -> 'rV[K]_n.+1), - solves_equation f traj1 -> + solves_equation f traj1 A -> traj1 0 = x0 -> locnegsemidef (LieDerivative V traj1) 0]. @@ -438,8 +438,8 @@ Record equa_diff (K : realType) := { }. Definition is_invariant_solution_equa_diff {K : realType} - (e : equa_diff K) (y1 : K -> 'rV[K]_6) := - solves_equation (fun y t => equa_f e (y t)) y1 /\ + (e : equa_diff K) (y1 : K -> 'rV[K]_6) A := + solves_equation (fun y t => equa_f e (y t)) y1 A /\ (y1 (equa_t0 e) \in equa_S0 e -> (forall t, t > 0 -> y1 (equa_t0 e + t) \in equa_S0 e)). (*TODO*) @@ -747,25 +747,7 @@ Variable alpha1 : K. Variable gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Variable y0 : K -> 'rV[K]_6. -Variable R : K -> 'M[K]_3. -Hypothesis derivableR : forall t, derivable R t 1. -Let w t := ang_vel R t. -Variable v : K -> 'rV[K]_3. -Let x1 t := v t . -Variable g0 : K. -Variable x1_hat : K -> 'rV[K]_3. -Notation x2 := (x2 R). -Let x2'hat t := -(alpha1 / g0) *: (x1 t - x1_hat t). (* 12b*) -Let p1 (t : K) := x2 t - x2'hat t . -Let zp1 t := p1 t *m (R t)^T. -Variable x2_hat : K -> 'rV[K]_3. -Hypothesis x2_hat_S2 : x2_hat 0 \in S2. -Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. -Hypothesis v_derivable : forall t, derivable v t 1. -Let x2_tilde t := x2 t - x2_hat t. -Let z2 t := x2_tilde t *m (R t)^T. -Variable y1 : K -> 'rV[K]_6. +Definition state_space33 {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := let zp1_point := Left \o zp1_z2_point in @@ -773,17 +755,14 @@ Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := fun t => row_mx (- alpha1 *: zp1_point t) (gamma *: (z2_point t - zp1_point t) *m \S('e_2%:R - z2_point t) ^+ 2). -(*Lemma eqn33E t : eqn33 t = eqn33' (y1 t). -Proof. -by rewrite /eqn33 /eqn33' /y row_mxKr row_mxKl. -Qed.*) - Definition eqn33' (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := let zp1_point := Left zp1_z2_point in let z2_point := Right zp1_z2_point in row_mx (- alpha1 *: zp1_point) (gamma *: (z2_point - zp1_point) *m \S('e_2%:R - z2_point) ^+ 2). +(*Lemma eqn33E t : eqn33 y0 t = eqn33' (y0 t). Proof. by []. Qed.*) + Lemma eqn33'_lipschitz : exists k, k.-lipschitz_setT eqn33'. Proof. near (pinfty_nbhs K) => k. @@ -821,10 +800,10 @@ gamma1 ⊆ state_space*) state_space ⊆ gamma1 *) -(*Lemma invariant_state_space33 p (p33 : state_space eqn33 p) : +Lemma invariant_state_space33 p (p33 : state_space eqn33 state_space33 p) : let y := sval (cid p33) in let t := sval (cid (svalP (cid p33)).2) in - forall Delta, Delta >= 0 -> state_space eqn33 (y (t + Delta)). + forall Delta, Delta >= 0 -> state_space eqn33 state_space33 (y (t + Delta)). Proof. case: p33 => /= x0 sol_y Delta Delta_ge0. rewrite /state_space/=. @@ -832,14 +811,12 @@ exists x0; split. by case: sol_y. case: cid => //= y' y'sol. case: cid => t'/= pt'. -Abort.*) - -Definition state_space33 {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. +Abort. -Lemma thm11a : state_space eqn33 = state_space33. +Lemma thm11a : state_space eqn33 state_space33 = state_space33 . Proof. apply/seteqP; split. -- move=> p [y [[dy y33]]] [t ->]. +- move=> p [y [[y0_init1]] [deri] y33 ] [t ->]. rewrite /state_space33. have : derive1 (fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). @@ -853,8 +830,8 @@ apply/seteqP; split. rewrite !mxE /= mulr1n. under eq_fun do rewrite !mxE /= mulr1n. rewrite !derive_dotmul/=; last 2 first. - by apply: derivableB => //=; exact: derivable_rsubmx. - by apply: derivableB => //=; exact: derivable_rsubmx. + by apply: derivableB => //=; exact : derivable_rsubmx => //=. + by apply: derivableB => //=; exact: derivable_rsubmx => //=. rewrite /dotmul /=. rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. @@ -863,15 +840,15 @@ apply/seteqP; split. = - (Right ('D_1 y x)). rewrite deriveB /= ; last 2 first. exact: derivable_cst. - exact: derivable_rsubmx. + by apply: derivable_rsubmx. rewrite derive_cst /= sub0r. congr (-_). - by rewrite derive_rsubmx//=. + by apply derive_rsubmx. rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. apply/matrixP => a b; rewrite !mxE. - by rewrite derive_mx//= ?mxE//. + rewrite derive_mx//= ?mxE//. ring. -have Rsu t0 : (Right (y^`()%classic t0) = + have Rsu t0 : (Right (y^`()%classic t0) = (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2)). rewrite derive1E. rewrite y33. @@ -887,7 +864,8 @@ have Rsu t0 : (Right (y^`()%classic t0) = by rewrite !mulmx0 mxE. under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0 *) move => h. - have norm_constant : norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. + have norm_constant : forall t, norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. + move => t0. have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. move => x0. apply: DeriveDef. @@ -898,30 +876,20 @@ have Rsu t0 : (Right (y^`()%classic t0) = move/ (_ _ 0). move => s0. by apply: s0. - rewrite /state_space33/=. - simpl in *. - (* move: y0init. - rewrite inE /state_space33 /=. - move=> Hnorm0. (* reecrire ce charabia *) -*) - -(* replace y with y0. (* vient de l'unicite des solutions de l'EDO. cauchy lipschitz ... *) - replace y with y0 in norm_constant. - rewrite Hnorm0 in norm_constant. - move: norm_constant. - move=> Hsq. - apply/eqP. - rewrite [RHS]expr2 mulr1 in Hsq. - move/eqP in Hsq. - rewrite sqrp_eq1 in Hsq ; last first. - exact: norm_ge0. - exact : Hsq. - admit. - admit.*) admit. + suff: norm ('e_2 - Right (y t)) ^+ 2 = 1. + move => /(congr1 Num.sqrt). + rewrite sqrtr1 sqr_sqrtr //. + by rewrite dotmulvv sqr_ge0. + rewrite norm_constant. + move: y0_init1. + rewrite inE /state_space33 /= => ->. + by rewrite expr2 mulr1. - move=> p. + rewrite /state_space33 /=. move=> p_statespace33. - rewrite /state_space. - rewrite /=. + rewrite /state_space /=. + rewrite /solves_equation /=. + admit. Admitted. Definition point1 : 'rV[K]_6 := 0. @@ -929,13 +897,17 @@ Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). (* on doit pouvoir noter que z2 est un point quon peut decider ..*) -Lemma equilibrium_point1 : is_equilibrium_point eqn33 point1. +Lemma equilibrium_point1 : is_equilibrium_point eqn33 point1 state_space33. Proof. split => //=. -move=> t; rewrite derive_cst /eqn33 /point1; apply/eqP. + rewrite inE /state_space33 /point1. + rewrite /=. + by rewrite rsubmx_const /= subr0 normeE. +split => //=. +move=> t ; rewrite derive_cst /eqn33 /point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. - rewrite /zp1 /p1 /= /x2 /x2'hat /x1. + rewrite /=. by rewrite lsubmx_const. apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. rewrite /N /=; apply /rowP; move => a. @@ -944,10 +916,17 @@ apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. by move => n; rewrite n scaler0 mul0mx. Qed. -Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2. +Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2 state_space33. Proof. split => //. -move => t; rewrite derive_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. + rewrite inE /state_space33 /point2 /=. + rewrite row_mxKr. + rewrite -[X in X - _ ]scale1r. + rewrite -scalerBl normZ normeE mulr1 distrC. + rewrite [X in _ - X](_:1 = 1%:R) //. + by rewrite -natrB //= normr1. +split => //. +move => t. rewrite derive_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). have N0 : N = 0. apply/rowP; move => i; rewrite !mxE; case: splitP. @@ -973,7 +952,7 @@ by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trm Qed. (* this lemma asks for lyapunov + lasalle *) -Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation eqn33 y -> +Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation eqn33 y state_space33 -> y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. Proof. move=> is_sol_y. @@ -1098,23 +1077,25 @@ Variable gamma : K. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. Variable R : K -> 'M[K]_3. -Variable y0 : K -> 'rV[K]_6. +(*Variable y0 : K -> 'rV[K]_6. Hypothesis y0init: y0 0 \in state_space33. -Hypothesis y0sol : solves_equation (eqn33 alpha1 gamma) y0. +Hypothesis y0sol : solves_equation (eqn33 alpha1 gamma) y0 state_space33.*) -Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj -> +Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj state_space33 -> 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). Proof. -move=> [/= dtraj]. +move=> [/= traj0]. +case. +move => dtraj. move=> /(_ z)/(congr1 Left). by rewrite row_mxKl => ?; rewrite derive_lsubmx//=. Qed. -Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj -> +Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj state_space33 -> 'D_1 (Right \o traj) z = gamma *: (Right (traj z) - Left (traj z)) *m \S('e_2 - Right (traj z)) ^+ 2. Proof. -move=> [/= dtraj]. +move=> [/= traj0][dtraj]. by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx//=. Qed. @@ -1123,7 +1104,7 @@ Let c2 := 2^-1 / gamma. Lemma derive_V1dot (z : K) (traj : K -> 'rV_6) (zp1 := Left \o traj) (z2 := Right \o traj) : - solves_equation (eqn33 alpha1 gamma) traj -> + solves_equation (eqn33 alpha1 gamma) traj state_space33 -> c1 *: (2 *: 'D_1 zp1 z *m (Left (traj z))^T) 0 0 + c2 *: (2 *: 'D_1 z2 z *m (Right (traj z))^T) 0 0 = V1dot (traj z). @@ -1148,7 +1129,8 @@ Lemma differentiable_norm_Left (y : 'rV[K]_6) : Proof. apply/(@differentiable_comp _ _ _ _ (fun x => norm (Left x)) (fun x => x ^+ 2)) => //=. apply/differentiable_comp. - (*derivable_lsubmx.*) admit. +(*derivable_lsubmx.*) +admit. admit. Admitted. @@ -1157,7 +1139,7 @@ Lemma differentiable_norm_Right (y : 'rV[K]_6) : Proof. Admitted. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (eqn33 alpha1 gamma) x -> +Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (eqn33 alpha1 gamma) x state_space33 -> LieDerivative (V1 alpha1 gamma) x t = V1dot (x t). Proof. move=> eqn33x. @@ -1181,27 +1163,29 @@ Qed. (* TODO: Section general properties of our system *) Lemma Gamma1_traj (y : K -> 'rV_6) t : - solves_equation (eqn33 alpha1 gamma) y -> state_space33 (y t). + solves_equation (eqn33 alpha1 gamma) y state_space33 -> state_space33 (y t). Proof. move=> iss. -Fail rewrite -(@thm11a _ _ _ gamma_gt0 alpha1_gt0 y0 R)//=. -Fail exists y; split => //. -Fail by exists t. -Admitted. +case: iss. +move=> y033 [dy deriv_y]. +rewrite -(@thm11a _ _ _ gamma_gt0 alpha1_gt0)//=. +exists y; split => //. +by exists t. +Qed. Lemma norm_u1 (traj : K -> 'rV_6) (z : K) (z2 := Right \o traj) (zp1 := Left \o traj) (u := 'e_2 - z2 z) : - solves_equation (eqn33 alpha1 gamma) traj -> norm u = 1. + solves_equation (eqn33 alpha1 gamma) traj state_space33 -> norm u = 1. Proof. move=> dtraj. suff: state_space33 (row_mx (zp1 z) (z2 z)) by rewrite /state_space33/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. -exact/Gamma1_traj. +by apply:Gamma1_traj. Qed. Lemma Hsq (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : - solves_equation (eqn33 alpha1 gamma) traj -> + solves_equation (eqn33 alpha1 gamma) traj state_space33 -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> dtraj. @@ -1224,7 +1208,7 @@ by rewrite 2!mulNmx mulmx1 mxE. Qed. Lemma neg_spin (traj : K -> 'rV_6) (z : K) : - solves_equation (eqn33 alpha1 gamma) traj -> + solves_equation (eqn33 alpha1 gamma) traj state_space33 -> norm (Right (traj z) *m \S('e_2) *m - \S('e_2 - Right (traj z))) = norm (Right (traj z) *m \S('e_2)). Proof. @@ -1249,7 +1233,7 @@ Qed. Lemma V1dot_ub (traj : K -> 'rV_6) (z : K) (zp1 := Left \o traj) (z2 := Right \o traj) (w := z2 z *m \S('e_2)) (u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i) : - solves_equation (eqn33 alpha1 gamma) traj -> + solves_equation (eqn33 alpha1 gamma) traj state_space33 -> V1dot (traj z) <= (- u1 *m u2 *m u1^T) 0 0. Proof. move=> dtrak. @@ -1280,7 +1264,7 @@ Qed. (* TODO: rework of this proof is needed *) Lemma near0_le0 (traj : K -> 'rV_6) : - solves_equation (eqn33 alpha1 gamma) traj -> + solves_equation (eqn33 alpha1 gamma) traj state_space33 -> traj 0 = point1 -> \forall z \near 0^', (LieDerivative (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) traj + @@ -1310,11 +1294,11 @@ by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. Unshelve. all: try by end_near. Qed. Lemma V1_point_is_lnsd (y : K -> 'rV_6) : - solves_equation (eqn33 alpha1 gamma) y -> + solves_equation (eqn33 alpha1 gamma) y state_space33-> y 0 = point1 -> locnegsemidef (LieDerivative (V1 alpha1 gamma) y) 0. Proof. -move=> [dy dtraj] traj0. +move=> [y033] [dy dtraj] traj0. have Gamma1_traj t : state_space33 (y t). apply/Gamma1_traj. by split => //. @@ -1332,17 +1316,17 @@ under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Left. rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Right. rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. - admit. + by []. rewrite [LHS]dtraj /eqn33/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - admit. + by []. rewrite [LHS]dtraj /eqn33/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. Admitted. Lemma V1_is_lyapunov_stable : - is_lyapunov_stable_at (eqn33 alpha1 gamma) (V1 alpha1 gamma) point1. + is_lyapunov_stable_at (eqn33 alpha1 gamma) state_space33 (V1 alpha1 gamma) point1. Proof. split. - by apply: equilibrium_point1 => //. From 43d75f0e6450987a485d6caf0e09ee146b037abc Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 8 Aug 2025 14:05:31 +0900 Subject: [PATCH 042/144] rocq 9 update --- derive_matrix.v | 7 ++++--- euclidean.v | 2 +- robot-rocq.opam | 2 +- tilt.v | 25 ++++++++++++++++--------- tilt_robot.v | 6 ++---- 5 files changed, 24 insertions(+), 18 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index 33d6a53b..ee11683f 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -558,7 +558,8 @@ case: ifPn => [/eqP _|/ifnot0P/orP[]/eqP -> /=]. rewrite addrCA -!addrA; congr (_ + (_ + _)). by rewrite derive_mx//= mxE. by rewrite mulrC derive_mx//= mxE. - rewrite addrC opprD mulrC. + rewrite [in LHS]addrC. + rewrite opprD mulrC. rewrite derive_mx//= mxE. congr (_ - _)%R. by rewrite derive_mx//= mxE. @@ -570,7 +571,7 @@ case: ifPn => [/eqP _|/ifnot0P/orP[]/eqP -> /=]. rewrite addrCA -!addrA; congr (_ + (_ + _)). by rewrite derive_mx//= mxE. by rewrite mulrC derive_mx//= mxE. - rewrite addrC opprD mulrC. + rewrite [in LHS]addrC opprD mulrC. rewrite derive_mx//= mxE. congr (_ - _)%R. by rewrite derive_mx//= mxE. @@ -582,7 +583,7 @@ case: ifPn => [/eqP _|/ifnot0P/orP[]/eqP -> /=]. rewrite addrCA -!addrA; congr (_ + (_ + _)). by rewrite derive_mx//= mxE. by rewrite mulrC derive_mx//= mxE. - rewrite addrC opprD mulrC. + rewrite [in LHS]addrC opprD mulrC. rewrite derive_mx//= mxE. congr (_ - _)%R. by rewrite derive_mx//= mxE. diff --git a/euclidean.v b/euclidean.v index defe0399..49cf690e 100644 --- a/euclidean.v +++ b/euclidean.v @@ -1672,7 +1672,7 @@ rewrite [X in _ + _ + X](_ : _ = - M 0 2%:R * M 2%:R 0); last first. rewrite coefD coefM sum2E subn0 coefC coefC mulr0 add0r. rewrite coefC mul0r add0r coefM sum2E subn0 subnn coefC [in X in X * _`_1]/=. rewrite coefD coefX coefN !coefC/= !(subr0,mul0r,mulr0,mulr1,addr0). - by rewrite coefB coefC/= subr0 coefX eqxx mulr1 mulNr. + by rewrite mulNr. rewrite /Z. apply/(@mulrI _ 2%:R); first exact: pnatf_unit. rewrite mulrA div1r divrr ?pnatf_unit // mul1r. diff --git a/robot-rocq.opam b/robot-rocq.opam index 1cf5dfd5..4e489bbe 100644 --- a/robot-rocq.opam +++ b/robot-rocq.opam @@ -26,7 +26,7 @@ depends: [ "coq-mathcomp-algebra" { (>= "2.5.0") } "coq-mathcomp-solvable" { (>= "2.5.0") } "coq-mathcomp-field" { (>= "2.5.0") } - "coq-mathcomp-analysis" { (>= "1.11.0") } + "coq-mathcomp-analysis" { (>= "1.15.0") } "coq-mathcomp-real-closed" { (>= "2.0.0") } "coq-mathcomp-algebra-tactics" { (>= "1.2.4") } ] diff --git a/tilt.v b/tilt.v index 6a026a60..f7a69888 100644 --- a/tilt.v +++ b/tilt.v @@ -627,13 +627,18 @@ rewrite -/(x2 t) -/(v t) -/(x1 t) -/(w t). rewrite eq12a. transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) - alpha1 *: p1 t). transitivity (x2 t *m \S(w t) + (alpha1 / g0) *: (x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'hat t))). - do 2 f_equal. - rewrite -3![in LHS]addrA -[in RHS]addrA. - congr +%R. - rewrite opprD addrCA. - rewrite [in RHS]opprB [in RHS]addrA [in RHS]addrC. - congr +%R. - by rewrite opprD addrACA subrr add0r opprK. + congr (_ + _ *: _). + rewrite -2![in LHS]addrA -[in RHS]addrA. + congr +%R. + rewrite opprD [in LHS]addrCA. + rewrite opprK. + rewrite [in RHS]opprB. + rewrite [in RHS]addrCA [in RHS]addrC. + rewrite -[in RHS]addrA. + congr +%R. + rewrite [in LHS]addrA. + congr +%R. + by rewrite opprD addrCA subrr addr0. rewrite (_ : x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'hat t) = (x1 t - x1_hat t) *m \S(w t) - g0 *: (x2 t - x2'hat t)); last first. rewrite mulmxBl scalerDr scalerN opprB addrA [LHS]addrC 2!addrA. @@ -653,7 +658,9 @@ rewrite [in LHS]deriveB//. rewrite derive_x2//. rewrite -/(x2 t) -/(w t) -/(x2_tilde t). rewrite eq12c. -rewrite spinD spinN -scalemxAl (spinZ gamma). +rewrite spinD spinN. +rewrite -[in LHS]scalemxAl. +rewrite (spinZ gamma). rewrite mulmxBr opprB [LHS]addrA [in LHS]addrC addrA (addrC _ (x2 t *m \S(w t))). rewrite -mulmxBl -/(x2_tilde t). congr +%R. @@ -720,7 +727,7 @@ rewrite !ang_vel_mxE//; last first. rewrite trmx_mul mulmxA -mulmxDl. rewrite derive_x2tilde /=. rewrite addrAC -/(w t) tr_spin mulmxN subrr sub0r. -rewrite -scalemxAl -scaleNr -scalemxAl. +rewrite -[in LHS]scalemxAl -scaleNr -[in LHS]scalemxAl. rewrite mulmxN -scalemxAl -[in RHS]scaleNr. congr (- _ *: _). rewrite -Rx2. diff --git a/tilt_robot.v b/tilt_robot.v index c336c2bc..a5366835 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -25,14 +25,12 @@ Lemma CauchySchwarz_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : Proof. suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. rewrite subr_ge0. - rewrite mulrC. - exact. + by rewrite mulrC. rewrite subr_ge0 expr2 mulrC !dotmulvv /= -expr2. have [->|hb] := eqVneq b 0. rewrite dotmulv0 expr0n. rewrite norm0. - rewrite expr0n //=. - by rewrite mul0r. + rewrite expr0n mul0r //=. pose t := (a *d b) / (norm b ^+ 2). have h : 0 <= norm (a - t *: b) ^+ 2. rewrite exprn_ge0 //. From aa078b676e3b6d3c38fbcd9876d6a04cc6a230e7 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Wed, 13 Aug 2025 13:57:50 +0900 Subject: [PATCH 043/144] frames + diff --- tilt.v | 343 ++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 227 insertions(+), 116 deletions(-) diff --git a/tilt.v b/tilt.v index f7a69888..77e72383 100644 --- a/tilt.v +++ b/tilt.v @@ -161,6 +161,10 @@ Lemma derive1mx_row_mx {R : realFieldType} {n : nat} {m : nat} : forall (f : R -> 'rV[R]_(n.+1 + m.+1)) (g : R -> 'rV[R]_(n.+1 + m.+1)) (t : R), 'D_1 (fun x => row_mx (f x) (g x)) t = row_mx ('D_1 f t) ('D_1 g t). +rewrite /=. +move => f g t. +rewrite deriveE /=; last first. + admit. Abort. End derive_help. @@ -170,8 +174,8 @@ Section gradient. Definition jacobian1 {R : numFieldType} n (f : 'rV[R]_n.+1 -> R) : 'rV_n.+1 -> 'cV_n.+1 := jacobian (scalar_mx \o f). - -Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := +(* not used*) +(*Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) @@ -185,10 +189,10 @@ rewrite derive_mx ?mxE//=; last first. rewrite /partial. under eq_fun do rewrite (addrC a). by under [in RHS]eq_fun do rewrite !mxE/= !mulr1n. -Qed. +Qed.*) (* NB: not used *) -Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := +(*Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := \row_(j < n.+1) (i == j)%:R. Lemma err_vecE {R : ringType} n (i : 'I_n.+1) : @@ -218,12 +222,13 @@ rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. exact: differentiable_scalar_mx. rewrite partial_diff//. exact/diff_derivable. -Qed. +Qed.*) End gradient. Section LieDerivative. +(* TODO isnt it just a directional derivative?*) Definition LieDerivative {R : realFieldType} n (V : 'rV[R]_n.+1 -> R) (x : R -> 'rV[R]_n.+1) (t : R) : R := (jacobian1 V (x t))^T *d 'D_1 x t. @@ -291,49 +296,135 @@ rewrite /LieDerivative /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. by rewrite dtraj mul0mx !mxE. Qed. +Local Notation Left := (@lsubmx _ 1 3 3). +Local Notation Right := (@rsubmx _ 1 3 3). + +Lemma differentiable_norm_Left {K : realType} (y : 'rV[K]_6) : + differentiable (fun x : 'rV_6 => norm (Left x) ^+ 2 : K) y. +Proof. +apply/(@differentiable_comp _ _ _ _ (fun x => norm (Left x)) (fun x => x ^+ 2)) => //=. +apply/differentiable_comp. +(*derivable_lsubmx.*) +admit. +admit. +Admitted. + +Lemma differentiable_norm_Right {K : realType} (y : 'rV[K]_6) : + differentiable (fun x : 'rV_6 => norm (Right x) ^+ 2 : K) y. +Proof. +apply/(@differentiable_comp _ _ _ _ (fun x => norm (Right x)) (fun x => x ^+ 2)) => //=. +apply/differentiable_comp. +admit. +admit. +Admitted. + +(* TODO norm is not differentiable at 0*) +Lemma differentiable_norm {K : realType} n (f : 'rV[K]_n.+1 -> 'rV_3) + (x : K -> 'rV[K]_n.+1) (t : K) : +differentiable (fun x0 : 'rV_n.+1 => norm (f x0)) (x t). +Proof. +Admitted. + +Lemma differentiable_rsubmx {K : realType} (x : K -> 'rV[K]_6) (t : K) : differentiable x t -> differentiable Right (x t). +Proof. +rewrite /Right; move => difx. +Admitted. + +Lemma differentiable_lsubmx {K : realType} (x : K -> 'rV[K]_6) (t : K) : differentiable x t -> differentiable Left (x t). +Proof. +Admitted. + Lemma LieDerivative_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) (x : K -> 'rV[K]_6) (t : K) : - LieDerivative (fun y => (norm (f y)) ^+ 2) x t = + (f \o x) t != 0 -> + differentiable x t -> differentiable f (x t) -> LieDerivative (fun y => (norm (f y)) ^+ 2) x t = (2%:R *: 'D_1 (f \o x) t *m (f (x t))^T) 0 0. Proof. rewrite /LieDerivative. rewrite /jacobian1. rewrite /dotmul. rewrite -trmx_mul. +move => f0 difx diff1. rewrite -derivemxE; last first. - admit. + apply/differentiable_comp; last first. + apply differentiable_scalar_mx. + rewrite -fctE /=. + apply: differentiableM; last 2 first. + apply: differentiable_norm. + apply: differentiable_norm. have := derive_norm. +rewrite //=. (*move=> /( congr1 (fun z => z t)).*) rewrite -scalemxAl [X in _ -> _ = X]mxE. -move => <-. -rewrite derive1Ml; last first. - admit. -rewrite mul1r. -rewrite !mxE. -rewrite derive1E. -transitivity ( ('D_('D_1 x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). - admit. -rewrite deriveE ; last first. - admit. -rewrite derive_mx//=; last first. - admit. -rewrite deriveE ; last first. - admit. -transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). - (*by [].*) admit. -rewrite -diff_comp; last 2 first. - admit. - admit. -(*rewrite deriveE //.*) -admit. +move => <-; last 2 first. + by []. + apply: diff_derivable. + apply: differentiable_comp; last 2 first. + by []. + by []. +rewrite derive1Ml; last 2 first. + rewrite fctE /=. + rewrite mul1r. + rewrite !mxE. + rewrite derive1E. + transitivity ( ('D_('D_1 x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). + under eq_fun do rewrite scalar_mxM. + admit. + rewrite deriveE ; last first. + apply: differentiableM; last 2 first. + apply: differentiable_norm. + apply: differentiable_norm. + rewrite derive_mx//=; last first. + by apply: diff_derivable. + rewrite deriveE ; last first. + apply: differentiableM; last 2 first. + rewrite /=. + rewrite -fctE. + apply: differentiable_comp; last 2 first. + rewrite -fctE. + apply: differentiable_comp; last 2 first. + by []. + by []. + admit. + rewrite /=. + apply: differentiable_comp; last 2 first. + rewrite /=. + apply: differentiable_comp; last 2 first. + by []. + by []. + (*apply: differentiable_norm.*) + admit. + transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). + rewrite -derive_mx //=; last by apply: diff_derivable. + by rewrite deriveE. + rewrite -diff_comp //=. + rewrite -fctE /=. + apply: differentiableM; last 2 first. + apply: differentiable_norm. + apply: differentiable_norm. + apply: diff_derivable. + rewrite -fctE /=. + apply: differentiableM; last 2 first. + apply: differentiable_comp; last 2 first. + rewrite /=. + apply: differentiable_comp; last 2 first. + by []. + by []. + admit. + apply: differentiable_comp; last 2 first. + apply: differentiable_comp; last 2 first. + by []. + by []. + (*apply differentiable_norm*) + admit. Admitted. End LieDerivative. (* not used, can be shown to be equivalent to LieDerivative *) -Definition LieDerivative_partial {R : realType} n (V : 'rV[R]_n.+1 -> R) +(*Definition LieDerivative_partial {R : realType} n (V : 'rV[R]_n.+1 -> R) (a : R -> 'rV[R]_n.+1) (t : R) : R := - \sum_(i < n.+1) (partial V (a t) i * ('D_1 a t) ``_ i). + \sum_(i < n.+1) (partial V (a t) i * ('D_1 a t) ``_ i).*) Section ode_equation. Context {K : realType} {n : nat}. @@ -446,13 +537,13 @@ Definition is_invariant_solution_equa_diff {K : realType} Section ya. (* mesure de l'accelerometre *) Variable K : realType. -Variable v : K -> 'rV[K]_3. -Variable R : K -> 'M[K]_3. -Variable g0 : K. -Let w t := ang_vel R t. -Let x1 t := v t. -Definition x2 t : 'rV_3 := 'e_2 *m R t. -Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. +Variable v : K -> 'rV[K]_3. (* local frame of the sensor *) +Variable R : K -> 'M[K]_3. (*L -> W*) +Variable g0 : K. (*standard gravity constant*) +Let w t := ang_vel R t. (* local frame of the sensor (gyroscope) *) +Let x1 t := v t. (* local frame*) +Definition x2 t : 'rV_3 := 'e_2 *m R t. (* tilt in local frame, e2 is in global frame but R brings it back*) +Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. (* local frame of the sensor*) End ya. Definition S2 {K : realType} := [set x : 'rV[K]_3 | norm x = 1]. @@ -465,6 +556,7 @@ Variable v : K -> 'rV[K]_3. Variable g0 : K. Let w t := ang_vel R t. +(* needs a different v,should be a different lemma..*) Lemma ya_E t : ('D_1 v t + g0 *: 'e_2) *m R t = y_a v R g0 t. Proof. rewrite mulmxDl /y_a/= /x2. @@ -508,7 +600,8 @@ rewrite inE /= orth_preserves_norm. by rewrite rotation_sub // rotationV. Qed. -Lemma dRu t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) (w' := ang_vel T) +(* not used but could be interesting *) +(*Lemma dRu t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) (w' := ang_vel T) : 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(w' t) + 'D_1 u t *m T t. Proof. rewrite derive_mulmx; last 2 first. @@ -525,7 +618,7 @@ rewrite -derive1mx_ang_vel; last 2 first. admit. admit. by []. -Admitted. +Admitted.*) (* eqn 10*) Notation y_a := (y_a v R g0). @@ -681,11 +774,7 @@ Qed. Lemma Rx2 t : x2_hat t *m (R t)^T = 'e_2 - z2 t. Proof. -rewrite /z2. -rewrite /x2_tilde. -rewrite mulmxBl. -rewrite opprB. -rewrite addrCA. +rewrite /z2 /x2_tilde mulmxBl opprB addrCA. rewrite [X in _ + X](_ : _ = 0) ?addr0//. rewrite /x2 -mulmxA. by rewrite orthogonal_mul_tr ?rotation_sub// mulmx1 subrr. @@ -696,21 +785,14 @@ Proof. rewrite /zp1. rewrite derive_mulmx//=; last by rewrite derivable_trmx. rewrite derive_p1. -rewrite mulmxBl. -rewrite addrAC. +rewrite mulmxBl addrAC. apply/eqP. rewrite subr_eq. -rewrite [in eqbRHS]addrC. -rewrite scaleNr. -rewrite scalemxAl subrr /=. +rewrite [in eqbRHS]addrC scaleNr scalemxAl subrr /=. rewrite derive_trmx//. rewrite derive1mx_ang_vel //; last by move => t0; rewrite rotation_sub. rewrite ang_vel_mxE //; last by move => t1 ; rewrite rotation_sub. -rewrite -/(w t). -rewrite -mulmxA. -rewrite -mulmxDr. -rewrite trmx_mul. -rewrite tr_spin. +rewrite -/(w t) -mulmxA -mulmxDr trmx_mul tr_spin. by rewrite mulNmx subrr mulmx0. Qed. @@ -754,9 +836,9 @@ Variable alpha1 : K. Variable gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Definition state_space33 {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. +Definition state_space_tilt {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. -Definition eqn33 (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := +Definition tilt_eqn (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := let zp1_point := Left \o zp1_z2_point in let z2_point := Right \o zp1_z2_point in fun t => row_mx (- alpha1 *: zp1_point t) @@ -807,10 +889,10 @@ gamma1 ⊆ state_space*) state_space ⊆ gamma1 *) -Lemma invariant_state_space33 p (p33 : state_space eqn33 state_space33 p) : +Lemma invariant_state_space_tilt p (p33 : state_space tilt_eqn state_space_tilt p) : let y := sval (cid p33) in let t := sval (cid (svalP (cid p33)).2) in - forall Delta, Delta >= 0 -> state_space eqn33 state_space33 (y (t + Delta)). + forall Delta, Delta >= 0 -> state_space tilt_eqn state_space_tilt (y (t + Delta)). Proof. case: p33 => /= x0 sol_y Delta Delta_ge0. rewrite /state_space/=. @@ -820,11 +902,11 @@ case: cid => //= y' y'sol. case: cid => t'/= pt'. Abort. -Lemma thm11a : state_space eqn33 state_space33 = state_space33 . +Lemma thm11a : state_space tilt_eqn state_space_tilt = state_space_tilt . Proof. apply/seteqP; split. - move=> p [y [[y0_init1]] [deri] y33 ] [t ->]. - rewrite /state_space33. + rewrite /state_space_tilt. have : derive1 (fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). apply/funext => x. @@ -889,29 +971,46 @@ apply/seteqP; split. by rewrite dotmulvv sqr_ge0. rewrite norm_constant. move: y0_init1. - rewrite inE /state_space33 /= => ->. + rewrite inE /state_space_tilt /= => ->. by rewrite expr2 mulr1. - move=> p. - rewrite /state_space33 /=. + rewrite /state_space_tilt /=. move=> p_statespace33. rewrite /state_space /=. rewrite /solves_equation /=. + exists (fun _ : K => 0). + split. + split. + by rewrite inE /= rsubmx_const subr0 normeE. + split. + apply: derivable_cst => //. + move => t. + rewrite /tilt_eqn /= derive_cst. + apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. + split. + apply/eqP. + have alpha1_neq0 : alpha1 != 0 by rewrite gt_eqF. + apply/eqP. + rewrite scaler_eq0 //. + rewrite eqr_oppLR oppr0. + move/negbTE: alpha1_neq0 => alpha1_nz. + rewrite alpha1_nz // Bool.orb_false_l. + by rewrite lsubmx_const. + by rewrite lsubmx_const rsubmx_const subr0 scaler0 mul0mx. admit. Admitted. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). -(* on doit pouvoir noter que z2 est un point quon peut decider ..*) - -Lemma equilibrium_point1 : is_equilibrium_point eqn33 point1 state_space33. +Lemma equilibrium_point1 : is_equilibrium_point tilt_eqn point1 state_space_tilt. Proof. split => //=. - rewrite inE /state_space33 /point1. + rewrite inE /state_space_tilt /point1. rewrite /=. by rewrite rsubmx_const /= subr0 normeE. split => //=. -move=> t ; rewrite derive_cst /eqn33 /point1; apply/eqP. +move=> t ; rewrite derive_cst /tilt_eqn /point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. rewrite /=. @@ -923,10 +1022,10 @@ apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. by move => n; rewrite n scaler0 mul0mx. Qed. -Lemma equilibrium_point2 : is_equilibrium_point eqn33 point2 state_space33. +Lemma equilibrium_point2 : is_equilibrium_point tilt_eqn point2 state_space_tilt. Proof. split => //. - rewrite inE /state_space33 /point2 /=. + rewrite inE /state_space_tilt /point2 /=. rewrite row_mxKr. rewrite -[X in X - _ ]scale1r. rewrite -scalerBl normZ normeE mulr1 distrC. @@ -959,7 +1058,7 @@ by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trm Qed. (* this lemma asks for lyapunov + lasalle *) -Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation eqn33 y state_space33 -> +Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation tilt_eqn y state_space_tilt -> y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. Proof. move=> is_sol_y. @@ -1085,10 +1184,10 @@ Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. Variable R : K -> 'M[K]_3. (*Variable y0 : K -> 'rV[K]_6. -Hypothesis y0init: y0 0 \in state_space33. -Hypothesis y0sol : solves_equation (eqn33 alpha1 gamma) y0 state_space33.*) +Hypothesis y0init: y0 0 \in state_space_tilt. +Hypothesis y0sol : solves_equation (tilt_eqn alpha1 gamma) y0 state_space_tilt.*) -Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj state_space33 -> +Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). Proof. move=> [/= traj0]. @@ -1098,7 +1197,7 @@ move=> /(_ z)/(congr1 Left). by rewrite row_mxKl => ?; rewrite derive_lsubmx//=. Qed. -Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : solves_equation (eqn33 alpha1 gamma) traj state_space33 -> +Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> 'D_1 (Right \o traj) z = gamma *: (Right (traj z) - Left (traj z)) *m \S('e_2 - Right (traj z)) ^+ 2. Proof. @@ -1111,7 +1210,7 @@ Let c2 := 2^-1 / gamma. Lemma derive_V1dot (z : K) (traj : K -> 'rV_6) (zp1 := Left \o traj) (z2 := Right \o traj) : - solves_equation (eqn33 alpha1 gamma) traj state_space33 -> + solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> c1 *: (2 *: 'D_1 zp1 z *m (Left (traj z))^T) 0 0 + c2 *: (2 *: 'D_1 z2 z *m (Right (traj z))^T) 0 0 = V1dot (traj z). @@ -1131,25 +1230,10 @@ rewrite tr_sqr_spin. by rewrite mulmxA. Qed. -Lemma differentiable_norm_Left (y : 'rV[K]_6) : - differentiable (fun x : 'rV_6 => norm (Left x) ^+ 2 : K) y. -Proof. -apply/(@differentiable_comp _ _ _ _ (fun x => norm (Left x)) (fun x => x ^+ 2)) => //=. -apply/differentiable_comp. -(*derivable_lsubmx.*) -admit. -admit. -Admitted. - -Lemma differentiable_norm_Right (y : 'rV[K]_6) : - differentiable (fun x : 'rV_6 => norm (Right x) ^+ 2 : K) y. -Proof. -Admitted. - -Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (eqn33 alpha1 gamma) x state_space33 -> +Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> differentiable x t -> LieDerivative (V1 alpha1 gamma) x t = V1dot (x t). Proof. -move=> eqn33x. +move=> tilt_eqnx dif1. rewrite /V1. rewrite LieDerivativeD; last 2 first. move=> t0. @@ -1164,13 +1248,19 @@ under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Left. rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Right. -rewrite !fctE !LieDerivative_norm /=. +rewrite !fctE !LieDerivative_norm /=; last 6 first. + admit. + by []. + apply: differentiable_rsubmx; last by []. + admit. + by []. + apply: differentiable_lsubmx; last by []. by rewrite derive_V1dot. -Qed. +Admitted. (* TODO: Section general properties of our system *) Lemma Gamma1_traj (y : K -> 'rV_6) t : - solves_equation (eqn33 alpha1 gamma) y state_space33 -> state_space33 (y t). + solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt -> state_space_tilt (y t). Proof. move=> iss. case: iss. @@ -1182,17 +1272,17 @@ Qed. Lemma norm_u1 (traj : K -> 'rV_6) (z : K) (z2 := Right \o traj) (zp1 := Left \o traj) (u := 'e_2 - z2 z) : - solves_equation (eqn33 alpha1 gamma) traj state_space33 -> norm u = 1. + solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> norm u = 1. Proof. move=> dtraj. -suff: state_space33 (row_mx (zp1 z) (z2 z)) by rewrite /state_space33/= row_mxKr. +suff: state_space_tilt (row_mx (zp1 z) (z2 z)) by rewrite /state_space_tilt/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. by apply:Gamma1_traj. Qed. -Lemma Hsq (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) +Lemma angvel_sqr (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : - solves_equation (eqn33 alpha1 gamma) traj state_space33 -> + solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> dtraj. @@ -1215,7 +1305,7 @@ by rewrite 2!mulNmx mulmx1 mxE. Qed. Lemma neg_spin (traj : K -> 'rV_6) (z : K) : - solves_equation (eqn33 alpha1 gamma) traj state_space33 -> + solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> norm (Right (traj z) *m \S('e_2) *m - \S('e_2 - Right (traj z))) = norm (Right (traj z) *m \S('e_2)). Proof. @@ -1224,11 +1314,11 @@ rewrite mulmxN normN. pose zp1 := fun r => Left (traj r). pose z2 := fun r => Right (traj r). set w := (z2 z) *m \S('e_2). -have Gamma1_traj t : state_space33 (traj t) by apply/Gamma1_traj. +have Gamma1_traj t : state_space_tilt (traj t) by apply/Gamma1_traj. rewrite /norm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. have Hnorm_sq : norm (w *m \S('e_2 - Right (traj z))) ^+ 2 = norm w ^+ 2. - rewrite -!dotmulvv Hsq // !dotmulvv norm_u1 /= //. + rewrite -!dotmulvv angvel_sqr // !dotmulvv norm_u1 /= //. rewrite -!dotmulvv expr2 !mul1r mulr1. have -> : w *d ('e_2 - Right (traj z)) = 0. by rewrite dotmulC ortho_spin. @@ -1240,10 +1330,10 @@ Qed. Lemma V1dot_ub (traj : K -> 'rV_6) (z : K) (zp1 := Left \o traj) (z2 := Right \o traj) (w := z2 z *m \S('e_2)) (u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i) : - solves_equation (eqn33 alpha1 gamma) traj state_space33 -> + solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> V1dot (traj z) <= (- u1 *m u2 *m u1^T) 0 0. Proof. -move=> dtrak. +move=> dtraj. rewrite mxE. rewrite /V1dot. rewrite mxE norm_spin mxE addrA expr2 mulmxA. @@ -1271,20 +1361,27 @@ Qed. (* TODO: rework of this proof is needed *) Lemma near0_le0 (traj : K -> 'rV_6) : - solves_equation (eqn33 alpha1 gamma) traj state_space33 -> + solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> traj 0 = point1 -> \forall z \near 0^', (LieDerivative (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) traj + LieDerivative (fun x => norm (Right x) ^+ 2 / (2 * gamma)) traj) z <= 0. Proof. move=> dtraj traj0. -near=> z. rewrite !fctE !invfM /=. +near=> z. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Left. rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Right. -rewrite /= !fctE !LieDerivative_norm derive_V1dot //. +rewrite /= !fctE !LieDerivative_norm; last 6 first. + admit. + admit. + admit. + admit. + admit. + admit. +rewrite derive_V1dot //. pose zp1 := Left \o traj. pose z2 := Right \o traj. set w := (z2 z) *m \S('e_2). @@ -1298,21 +1395,35 @@ have [->|H] := eqVneq u1 0. have Hpos := def u1 H. rewrite -oppr_ge0 -oppr_le0 opprK ltW//. by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. -Unshelve. all: try by end_near. Qed. +Unshelve. all: try by end_near. +Admitted. Lemma V1_point_is_lnsd (y : K -> 'rV_6) : - solves_equation (eqn33 alpha1 gamma) y state_space33-> + solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt-> y 0 = point1 -> locnegsemidef (LieDerivative (V1 alpha1 gamma) y) 0. Proof. move=> [y033] [dy dtraj] traj0. -have Gamma1_traj t : state_space33 (y t). +have Gamma1_traj t : state_space_tilt (y t). apply/Gamma1_traj. by split => //. rewrite /locnegsemidef /V1. rewrite LieDerivativeD /=; last 2 first. - admit. - admit. + move => t. + apply: differentiableM; last 2 first. + rewrite /=. + apply: differentiableM; last 2 first. + apply: differentiable_norm. + apply: differentiable_norm. + rewrite -fctE. + apply: differentiable_cst; last first. + move => t. + apply: differentiableM; last 2 first. + apply: differentiableM; last 2 first. + apply: differentiable_norm. + apply: differentiable_norm. + rewrite -fctE. + apply: differentiable_cst. split; last first. apply/near0_le0; last by []. by split => //. @@ -1324,16 +1435,16 @@ rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Left. rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Right. rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. by []. - rewrite [LHS]dtraj /eqn33/= traj0 /point1. + rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by []. - rewrite [LHS]dtraj /eqn33/= traj0 /point1. + rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. -Admitted. +Qed. Lemma V1_is_lyapunov_stable : - is_lyapunov_stable_at (eqn33 alpha1 gamma) state_space33 (V1 alpha1 gamma) point1. + is_lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. Proof. split. - by apply: equilibrium_point1 => //. From 0f194e89e8a6fa61a935ede9fbe5aa42e7aa4e43 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Thu, 14 Aug 2025 10:25:00 +0900 Subject: [PATCH 044/144] upd --- tilt.v | 194 +++++++++++++++++++++++++++++---------------------- tilt_robot.v | 20 ++++++ 2 files changed, 132 insertions(+), 82 deletions(-) diff --git a/tilt.v b/tilt.v index 77e72383..481c719c 100644 --- a/tilt.v +++ b/tilt.v @@ -1,6 +1,7 @@ +From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra ring. From mathcomp Require Import boolp classical_sets functions reals. -From mathcomp Require Import topology normedtype derive realfun. +From mathcomp Require Import topology normedtype landau derive realfun. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. (*Require Import lasalle pendulum.*) @@ -157,7 +158,7 @@ rewrite !mxE/=. by rewrite !ord1 eqxx !mulr1n. Qed. -Lemma derive1mx_row_mx {R : realFieldType} {n : nat} {m : nat} : +Lemma derive_row_mx {R : realFieldType} {n : nat} {m : nat} : forall (f : R -> 'rV[R]_(n.+1 + m.+1)) (g : R -> 'rV[R]_(n.+1 + m.+1)) (t : R), 'D_1 (fun x => row_mx (f x) (g x)) t = row_mx ('D_1 f t) ('D_1 g t). @@ -299,45 +300,30 @@ Qed. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -Lemma differentiable_norm_Left {K : realType} (y : 'rV[K]_6) : - differentiable (fun x : 'rV_6 => norm (Left x) ^+ 2 : K) y. +Lemma derivable_sqrt {K: realType} (u : K) : u > 0 -> derivable Num.sqrt (u) 1. Proof. -apply/(@differentiable_comp _ _ _ _ (fun x => norm (Left x)) (fun x => x ^+ 2)) => //=. -apply/differentiable_comp. -(*derivable_lsubmx.*) -admit. -admit. +move => gt0. +Search (derivable _ _). Admitted. -Lemma differentiable_norm_Right {K : realType} (y : 'rV[K]_6) : - differentiable (fun x : 'rV_6 => norm (Right x) ^+ 2 : K) y. -Proof. -apply/(@differentiable_comp _ _ _ _ (fun x => norm (Right x)) (fun x => x ^+ 2)) => //=. -apply/differentiable_comp. -admit. -admit. -Admitted. - -(* TODO norm is not differentiable at 0*) -Lemma differentiable_norm {K : realType} n (f : 'rV[K]_n.+1 -> 'rV_3) - (x : K -> 'rV[K]_n.+1) (t : K) : +Lemma differentiable_norm {K : realType} n (f : 'rV[K]_n.+1 -> 'rV_3) + (x : K -> 'rV[K]_n.+1) (t : K) : (forall x0, f x0 != 0) -> derivable (f \o x) t 1 -> differentiable (fun x0 : 'rV_n.+1 => norm (f x0)) (x t). Proof. -Admitted. - -Lemma differentiable_rsubmx {K : realType} (x : K -> 'rV[K]_6) (t : K) : differentiable x t -> differentiable Right (x t). -Proof. -rewrite /Right; move => difx. -Admitted. - -Lemma differentiable_lsubmx {K : realType} (x : K -> 'rV[K]_6) (t : K) : differentiable x t -> differentiable Left (x t). -Proof. +move => fx0 dif1. +rewrite /norm -fctE. +apply: differentiable_comp; last first. + apply/derivable1_diffP. + apply/derivable_sqrt. + by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0 //. + admit. Admitted. Lemma LieDerivative_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) (x : K -> 'rV[K]_6) (t : K) : (f \o x) t != 0 -> - differentiable x t -> differentiable f (x t) -> LieDerivative (fun y => (norm (f y)) ^+ 2) x t = + differentiable x t -> derivable (f \o x) t 1 -> + LieDerivative (fun y => (norm (f y)) ^+ 2) x t = (2%:R *: 'D_1 (f \o x) t *m (f (x t))^T) 0 0. Proof. rewrite /LieDerivative. @@ -347,21 +333,27 @@ rewrite -trmx_mul. move => f0 difx diff1. rewrite -derivemxE; last first. apply/differentiable_comp; last first. - apply differentiable_scalar_mx. + exact: differentiable_scalar_mx. rewrite -fctE /=. apply: differentiableM; last 2 first. - apply: differentiable_norm. - apply: differentiable_norm. + apply/differentiable_norm; last 2 first. + admit. + by []. + apply/differentiable_norm; last first. + by []. + move => x0. + admit. have := derive_norm. rewrite //=. (*move=> /( congr1 (fun z => z t)).*) rewrite -scalemxAl [X in _ -> _ = X]mxE. move => <-; last 2 first. by []. - apply: diff_derivable. + by []. +(* apply: diff_derivable. apply: differentiable_comp; last 2 first. by []. - by []. + by [].*) rewrite derive1Ml; last 2 first. rewrite fctE /=. rewrite mul1r. @@ -372,51 +364,61 @@ rewrite derive1Ml; last 2 first. admit. rewrite deriveE ; last first. apply: differentiableM; last 2 first. - apply: differentiable_norm. + apply: differentiable_norm; last 2 first. + admit. + by []. apply: differentiable_norm. + admit. + by []. rewrite derive_mx//=; last first. by apply: diff_derivable. rewrite deriveE ; last first. - apply: differentiableM; last 2 first. - rewrite /=. - rewrite -fctE. - apply: differentiable_comp; last 2 first. - rewrite -fctE. - apply: differentiable_comp; last 2 first. - by []. - by []. - admit. - rewrite /=. - apply: differentiable_comp; last 2 first. - rewrite /=. - apply: differentiable_comp; last 2 first. - by []. - by []. - (*apply: differentiable_norm.*) - admit. + apply: differentiableM => /=. + rewrite /norm. + (* differentiable norm needs to be generalized*) + apply: differentiable_comp; last first. + apply/derivable1_diffP. + apply/derivable_sqrt. + by rewrite dotmulvv expr2 mulr_gt0 // norm_gt0 //. + apply/derivable1_diffP. + by apply/derivable_dotmul. + rewrite /norm. + apply: differentiable_comp; last first. + apply/derivable1_diffP. + apply/derivable_sqrt. + by rewrite dotmulvv expr2 mulr_gt0 // norm_gt0 //. + apply/derivable1_diffP. + by apply/derivable_dotmul. transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). rewrite -derive_mx //=; last by apply: diff_derivable. by rewrite deriveE. rewrite -diff_comp //=. rewrite -fctE /=. - apply: differentiableM; last 2 first. - apply: differentiable_norm. - apply: differentiable_norm. - apply: diff_derivable. - rewrite -fctE /=. - apply: differentiableM; last 2 first. - apply: differentiable_comp; last 2 first. - rewrite /=. - apply: differentiable_comp; last 2 first. - by []. - by []. + apply: differentiableM; last first. + apply: differentiable_norm; last 2 first. admit. - apply: differentiable_comp; last 2 first. - apply: differentiable_comp; last 2 first. - by []. - by []. - (*apply differentiable_norm*) + by []. + apply: differentiable_norm. admit. + by []. +apply: diff_derivable. +rewrite -fctE /=. +apply: differentiableM; last 2 first. + apply/differentiable_comp; last first. + rewrite /norm. + admit. + rewrite /=. + rewrite -fctE //. + by apply/derivable1_diffP. +apply/differentiable_comp; last 2 first. + rewrite /= -fctE. + by apply/derivable1_diffP. + apply/differentiable_comp; last 2 first. + rewrite /=. + admit. + apply/derivable1_diffP. + apply/derivable_sqrt. + by rewrite dotmulvv expr2 mulr_gt0 // norm_gt0 //. Admitted. End LieDerivative. @@ -1230,7 +1232,7 @@ rewrite tr_sqr_spin. by rewrite mulmxA. Qed. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> differentiable x t -> +Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> (forall t, differentiable x t) -> LieDerivative (V1 alpha1 gamma) x t = V1dot (x t). Proof. move=> tilt_eqnx dif1. @@ -1238,23 +1240,39 @@ rewrite /V1. rewrite LieDerivativeD; last 2 first. move=> t0. apply: differentiableM => //=. - exact: differentiable_norm_Left. + apply: differentiableM => //=. + admit. + admit. move=> t0. apply: differentiableM => //=. - exact: differentiable_norm_Right. + apply: differentiableM => //=. + admit. + admit. rewrite !invfM /=. rewrite fctE. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. -rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Left. -rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Right. +rewrite LieDerivativeMl; last first. + move => t0. + apply: differentiableM => //=. + admit. + admit. +rewrite LieDerivativeMl; last first. + move => t0. + apply: differentiableM => //=. + admit. + admit. rewrite !fctE !LieDerivative_norm /=; last 6 first. admit. by []. - apply: differentiable_rsubmx; last by []. + apply/derivable1_diffP. + apply: differentiable_rsubmx => /= x0. + by []. admit. by []. - apply: differentiable_lsubmx; last by []. + apply/derivable1_diffP. + apply: differentiable_lsubmx => /= x0. + by []. by rewrite derive_V1dot. Admitted. @@ -1372,8 +1390,10 @@ rewrite !fctE !invfM /=. near=> z. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. -rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Left. -rewrite LieDerivativeMl; last by move=> y; exact: differentiable_norm_Right. +rewrite LieDerivativeMl; last first. + admit. +rewrite LieDerivativeMl; last first. + admit. rewrite /= !fctE !LieDerivative_norm; last 6 first. admit. admit. @@ -1414,14 +1434,22 @@ rewrite LieDerivativeD /=; last 2 first. rewrite /=. apply: differentiableM; last 2 first. apply: differentiable_norm. + admit. + admit. apply: differentiable_norm. + admit. + admit. rewrite -fctE. apply: differentiable_cst; last first. move => t. apply: differentiableM; last 2 first. apply: differentiableM; last 2 first. apply: differentiable_norm. + admit. + admit. apply: differentiable_norm. + admit. + admit. rewrite -fctE. apply: differentiable_cst. split; last first. @@ -1431,8 +1459,10 @@ rewrite !invfM /=. rewrite !fctE. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. -rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Left. -rewrite LieDerivativeMl; last by move=> z; exact: differentiable_norm_Right. +rewrite LieDerivativeMl; last first. + admit. +rewrite LieDerivativeMl; last first. + admit. rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. by []. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. @@ -1441,7 +1471,7 @@ rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. -Qed. +Admitted. Lemma V1_is_lyapunov_stable : is_lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. diff --git a/tilt_robot.v b/tilt_robot.v index a5366835..79832333 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -132,6 +132,16 @@ apply: le_trans; last first. by rewrite !mxE. Qed. +Lemma differentiable_rsubmx {R : realType} (f : R -> 'rV[R]_(3 + 3)) t : + (forall x, differentiable f x) -> + differentiable (fun x => rsubmx (f x)) t. +Proof. +move=> /= => df1. +apply/derivable1_diffP. +apply/derivable_rsubmx => x. +exact/derivable1_diffP. +Qed. + Lemma derive_rsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v: (forall x, derivable f x v) -> 'D_v (fun x => rsubmx (f x)) t = @rsubmx R _ 3 3 ('D_v f t). @@ -162,6 +172,16 @@ apply: le_trans; last first. by rewrite !mxE. Qed. +Lemma differentiable_lsubmx {R : realType} (f : R -> 'rV[R]_(3 + 3)) t : + (forall x, differentiable f x) -> + differentiable (fun x => lsubmx (f x)) t. +Proof. +move=> /= => df1. +apply/derivable1_diffP. +apply/derivable_lsubmx => x. +exact/derivable1_diffP. +Qed. + Lemma derive_lsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v : (forall x, derivable f x v) -> 'D_v (fun x => lsubmx (f x)) t = @lsubmx R _ 3 3 ('D_v f t). From 20ec58ee0cf32b77b19f004c7a3c918c35d40764 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 14 Aug 2025 11:09:46 +0900 Subject: [PATCH 045/144] a few lemmas about derivation - tentative use of sesquilinear.v - derive row_mx - differentiable norm --- derive_matrix.v | 106 +++++++++++++++++++++++++++------------ euclidean.v | 35 ++++++++++--- tilt.v | 41 +++------------- tilt_robot.v | 128 ++++++++++++++++++++++++++++++++++++++---------- 4 files changed, 213 insertions(+), 97 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index ee11683f..e6671cb9 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -1,4 +1,5 @@ (* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. From mathcomp Require Import interval_inference. @@ -450,45 +451,86 @@ End row_belast. (* TODO: could be derived from more generic lemmas about bilinearity in derive.v? *) Section product_rules. +Global Instance is_diff_sum {R : numFieldType} {V W : normedModType R} + n (h : 'I_n -> V -> W) (x : V) + (dh : 'I_n -> V -> W) : (forall i, is_diff x (h i) (dh i)) -> + is_diff x (\sum_(i < n) h i) (\sum_(i < n) dh i). +Proof. +by elim/big_ind2 : _ => // [|] *; [exact: is_diff_cst|exact: is_diffD]. +Qed. + Lemma derive_dotmul {R : realFieldType} {V : normedModType R} n (u v : V -> 'rV[R]_n.+1) (t : V) (w : V) : derivable u t w -> derivable v t w -> - 'D_w (fun x => u x *d v x) t = - 'D_w u t *d v t + u t *d 'D_w v t. + 'D_w (fun x => u x *d v x) t = 'D_w u t *d v t + u t *d 'D_w v t. Proof. move=> /derivable_mxP utw /derivable_mxP vtw. -evar (f : V -> R); rewrite (_ : (fun x : V => u x *d v x : R^o) = f); last first. - by rewrite funeqE => x /=; exact: dotmulE. -rewrite {}/f. -set f := fun i : 'I__ => fun x => ((u x) ``_ i * (v x) ``_ i). +under eq_fun do rewrite dotmulE. +set f := fun i : 'I__ => fun x => (u x) ``_ i * (v x) ``_ i. rewrite (_ : (fun _ : V => _) = \sum_(k < _) f k); last first. by rewrite funeqE => x; rewrite /f /= fct_sumE. -rewrite derive_sum; last by move=> ?; exact: derivableM (utw _ _) (vtw _ _). -rewrite {}/f. -elim: n u v => [|n IH] u v in utw vtw *. - rewrite big_ord_recl/= big_ord0 addr0. - rewrite /dotmul !mxE !sum1E !mxE. - rewrite deriveM//=. - rewrite addrC. - rewrite mulrC//. - rewrite derive_mx//; last exact/derivable_mxP. - rewrite !mxE. - rewrite derive_mx//; last exact/derivable_mxP. - by rewrite !mxE. -rewrite [LHS]big_ord_recr /=. -set u' := fun x => row_belast (u x). set v' := fun x => row_belast (v x). -transitivity ('D_w u' t *d v' t + u' t *d 'D_w v' t + - derive (fun x => (u x)``_ord_max * (v x)``_ord_max) t w). - rewrite -(IH _ _ (derivable_row_belast utw) (derivable_row_belast vtw)). - apply: f_equal2; last by []. - apply eq_bigr => i _; congr (derive _ t w). - by rewrite funeqE => x; rewrite !mxE. -rewrite (deriveM (utw _ _) (vtw _ _)) /= -!addrA addrC addrA. -rewrite -(addrA (_ + _)) [in RHS]addrC derive1mx_dotmul_belast; last first. - exact/derivable_mxP. -congr (_ + _). -rewrite [in RHS]dotmulC -derive1mx_dotmul_belast; last exact/derivable_mxP. -by rewrite addrC dotmulC. +rewrite derive_sum; last by move=> i; exact: derivableM. +rewrite !dotmulE -big_split/=; apply: eq_bigr => i _. +by rewrite {}/f deriveM// mulrC addrC; congr (_ * _ + _ * _); + rewrite derive_mx ?mxE//=; exact/derivable_mxP. +Qed. + +(* NB: from Damien's LaSalle *) +Notation "p ..[ i ]" := (p 0 i) (at level 10). + +Global Instance is_diff_component {R : realFieldType} n i (p : 'rV[R]_n.+1) : + is_diff p (fun q => q..[i] : R^o) (fun q => q..[i]). +Proof. +have comp_lin : linear (fun q : 'rV[R]_n.+1 => q..[i] : R^o). + by move=> ???; rewrite !mxE. +have comp_cont : continuous (fun q : 'rV[R]_n.+1 => q..[i] : R^o). + move=> q A [_/posnumP[e] Ae] /=; apply/nbhs_ballP; exists e%:num => //=. + by move=> r /(_ ord0) /(_ i) /Ae. +pose glM := GRing.isLinear.Build _ _ _ _ _ comp_lin. +pose gL : {linear 'rV_n.+1 -> R^o} := HB.pack (fun q : 'rV_n.+1 => q ..[ i]) glM. +apply: DiffDef; first exact: (@linear_differentiable _ _ _ gL). +by rewrite (@diff_lin _ _ _ gL). +Qed. + +Global Instance is_diff_component_comp {R : realFieldType} (V : normedModType R) n + (f : V -> 'rV[R]_n.+1) i p df : is_diff p f df -> + is_diff p (fun q => (f q)..[i] : R^o) (fun q => (df q)..[i]). +Proof. +move=> dfp. +have -> : (fun q => (f q)..[i]) = (fun v => v..[i]) \o f by rewrite funeqE. +(* This should work *) +(* apply: is_diff_eq. *) +exact: is_diff_comp. +Qed. +(* /NB: from Damien's LaSalle *) + +Global Instance is_diff_dotmul {R : realFieldType} m n (V := 'rV[R]_m.+1) + (u v du dv : V -> 'rV[R]_n.+1) (t : V) : + is_diff t u du -> is_diff t v dv -> + is_diff t (fun x => u x *d v x) + (fun x => u t *d dv x + v t *d du x). +Proof. +move=> udu vdv/=. +under eq_fun do rewrite dotmulE. +set f := fun i : 'I__ => (fun x => (u x) ``_ i) * (fun x => (v x) ``_ i). +rewrite [X in is_diff _ X _](_ : _ = \sum_(k < _) f k); last first. + by rewrite funeqE => x; rewrite /f /= fct_sumE. +rewrite [X in is_diff _ _ X](_ : _ = \sum_(i < n.+1) + ((u t)``_i *: (fun x => (dv x)``_i) + (v t)``_i *: (fun x => (du x)``_i))); last first. + by apply/funext => x; rewrite 2!dotmulE -big_split/= fct_sumE. +apply: is_diff_sum => i. +rewrite {}/f /=. +exact: is_diffM. +Qed. + +Lemma differentiable_dotmul {R : realFieldType} m n (V := 'rV[R]_m.+1) + (u v : V -> 'rV[R]_n.+1) (t : V) : + differentiable u t -> + differentiable v t -> + differentiable (fun x => u x *d v x) t. +Proof. +move=> /differentiableP udu /differentiableP vdv/=. +by have [/=] := is_diff_dotmul udu vdv. Qed. Lemma derive_mulmx {R : realFieldType} {V : normedModType R} n m p diff --git a/euclidean.v b/euclidean.v index 49cf690e..78675a4e 100644 --- a/euclidean.v +++ b/euclidean.v @@ -199,8 +199,8 @@ Section dotmul_bilinear_Pz. Variables (R : comPzRingType) (n : nat). Definition dotmul_rev (v u : 'rV[R]_n) := u *d v. -Canonical rev_dotmul := @RevOp _ _ _ dotmul_rev (@dotmul R n) - (fun _ _ => erefl). +(*Canonical rev_dotmul := @RevOp _ _ _ dotmul_rev (@dotmul R n) + (fun _ _ => erefl).*) Lemma dotmul_is_linear u : linear (dotmul u : 'rV[R]_n -> R^o). Proof. move=> /= k v w; by rewrite dotmulDr dotmulvZ. Qed. @@ -252,17 +252,40 @@ move/allP => H; apply/eqP/rowP => i. apply/eqP; by rewrite mxE -sqrf_eq0 expr2 -(implyTb ( _ == _)) H. Qed. +Lemma dotmul_is_hermitian x y : + (@dotmul T n) x y = (-1) ^+ false * idfun ((@dotmul T n) y x). +Proof. +by rewrite /= expr0 mul1r dotmulC. +Qed. + +HB.instance Definition _ := + @isHermitianSesquilinear.Build _ _ _ _ _ dotmul_is_hermitian. + +Check @dotmul _ _ : {symmetric 'rV[T]_n}. + +Let neq0_norm_gt0 (u : 'rV[T]_n) : u != 0 -> 0 < dotmul u u. +Proof. +move=> u0. +by rewrite lt_neqAle eq_sym dotmulvv0 u0 le0dotmul. +Qed. + +HB.instance Definition _ := isDotProduct.Build _ _ (@dotmul T n) neq0_norm_gt0. + End dot_product. Section norm. - -Variables (T : rcfType) (n : nat). +Context {T : rcfType} {n : nat}. Implicit Types u v : 'rV[T]_n. -Definition norm u := Num.sqrt (u *d u). +Local Notation "''[' u , v ]" := (dotmul u v) : ring_scope. +Local Notation "''[' u ]" := '[u, u]%R : ring_scope. + +Definition norm u : T := Num.sqrt '[u]. Lemma normN u : norm (- u) = norm u. -Proof. by rewrite /norm dotmulNv dotmulvN opprK. Qed. +Proof. +by rewrite /norm (@hnormN T false idfun). +Qed. Lemma norm0 : norm 0 = 0. Proof. by rewrite /norm dotmul0v sqrtr0. Qed. diff --git a/tilt.v b/tilt.v index 481c719c..43b69caa 100644 --- a/tilt.v +++ b/tilt.v @@ -140,34 +140,6 @@ rewrite dotmulC. by field. Qed. -Lemma derivable_scalar_mx {R : realFieldType} n (f : 'rV[R]_n.+1 -> R) - (a : 'rV[R]_n.+1) v : - derivable f a v -> - derivable (@scalar_mx _ 1 \o f) a v. -Proof. -move=> /cvg_ex[/= l fav]. -apply/cvg_ex => /=. -exists (\col_(i < 1) l). -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : fav => /(_ _ e0). -apply: filterS => x. -apply: le_trans. -rewrite [in leLHS]/Num.Def.normr/= !mx_normrE/=. -apply: bigmax_le => //= -[i j] _. -rewrite !mxE/=. -by rewrite !ord1 eqxx !mulr1n. -Qed. - -Lemma derive_row_mx {R : realFieldType} {n : nat} {m : nat} : -forall (f : R -> 'rV[R]_(n.+1 + m.+1)) (g : R -> 'rV[R]_(n.+1 + m.+1)) (t : R), - 'D_1 (fun x => row_mx (f x) (g x)) t = - row_mx ('D_1 f t) ('D_1 g t). -rewrite /=. -move => f g t. -rewrite deriveE /=; last first. - admit. -Abort. - End derive_help. Section gradient. @@ -307,8 +279,10 @@ Search (derivable _ _). Admitted. Lemma differentiable_norm {K : realType} n (f : 'rV[K]_n.+1 -> 'rV_3) - (x : K -> 'rV[K]_n.+1) (t : K) : (forall x0, f x0 != 0) -> derivable (f \o x) t 1 -> -differentiable (fun x0 : 'rV_n.+1 => norm (f x0)) (x t). + (x : K -> 'rV[K]_n.+1) (t : K) : + (forall x0, f x0 != 0) -> + derivable (f \o x) t 1 -> + differentiable (fun x0 : 'rV_n.+1 => norm (f x0)) (x t). Proof. move => fx0 dif1. rewrite /norm -fctE. @@ -316,7 +290,7 @@ apply: differentiable_comp; last first. apply/derivable1_diffP. apply/derivable_sqrt. by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0 //. - admit. +apply: differentiable_dotmul => //. Admitted. Lemma LieDerivative_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) @@ -932,9 +906,8 @@ apply/seteqP; split. rewrite deriveB /= ; last 2 first. exact: derivable_cst. by apply: derivable_rsubmx. - rewrite derive_cst /= sub0r. - congr (-_). - by apply derive_rsubmx. + rewrite derive_cst /= sub0r; congr (-_). + exact: derive_rsubmx. rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. apply/matrixP => a b; rewrite !mxE. rewrite derive_mx//= ?mxE//. diff --git a/tilt_robot.v b/tilt_robot.v index 79832333..a0bcfb68 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -113,82 +113,160 @@ Lemma norm_squared {R : rcfType} n (u : 'rV[R]_n) : (u *m (u)^T) 0 0 = norm u ^+2. Proof. by rewrite -dotmulvv /dotmul. Qed. -Lemma derivable_rsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v : +Lemma derivable_rsubmx {R : realType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : (forall x, derivable f x v) -> - derivable (fun x => rsubmx (f x)) t v. + derivable (fun x => @rsubmx _ _ n1.+1 _ (f x)) t v. Proof. move=> /= => df1. apply/derivable_mxP => i j/=. rewrite (ord1 i). have /cvg_ex[/= l Hl]:= df1 t. -apply/cvg_ex => /=; exists (l``_(rshift 3 j)). +apply/cvg_ex => /=; exists (l``_(rshift n1.+1 j)). apply/cvgrPdist_le => /= e e0. move/cvgrPdist_le : Hl => /(_ _ e0). apply: filterS => x. apply: le_trans. rewrite [in leRHS]/Num.Def.normr/= mx_normrE. apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, rshift 3 j)). + exact: (le_bigmax _ _ (ord0, rshift n1.+1 j)). by rewrite !mxE. Qed. -Lemma differentiable_rsubmx {R : realType} (f : R -> 'rV[R]_(3 + 3)) t : +Lemma differentiable_rsubmx {R : realType} {n1 n2} + (f : R -> 'rV[R]_(n1.+1 + n2.+1)) t : (forall x, differentiable f x) -> differentiable (fun x => rsubmx (f x)) t. Proof. move=> /= => df1. -apply/derivable1_diffP. -apply/derivable_rsubmx => x. -exact/derivable1_diffP. +by apply/derivable1_diffP/derivable_rsubmx => x; exact/derivable1_diffP. Qed. -Lemma derive_rsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v: +Lemma derive_rsubmx {R : realType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v: (forall x, derivable f x v) -> - 'D_v (fun x => rsubmx (f x)) t = @rsubmx R _ 3 3 ('D_v f t). + 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1.+1 _ ('D_v f t). Proof. move=> df1; apply/matrixP => i j; rewrite !mxE /=. rewrite derive_mx ?mxE//=; last exact: derivable_rsubmx. -rewrite derive_mx ?mxE//=. -f_equal. +rewrite derive_mx ?mxE//=; congr ('D_v _ t). by apply/funext => x; rewrite !mxE. Qed. -Lemma derivable_lsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v : - (forall x, derivable f x v) -> - derivable (fun x => lsubmx (f x)) t v. +Lemma derivable_lsubmx {R : realType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : + (forall x, derivable f x v) -> derivable (fun x => lsubmx (f x)) t v. Proof. move=> /= => df1. apply/derivable_mxP => i j/=. rewrite (ord1 i). have /cvg_ex[/= l Hl]:= df1 t. -apply/cvg_ex => /=; exists (l``_(lshift 3 j)). +apply/cvg_ex => /=; exists (l``_(lshift n2.+1 j)). apply/cvgrPdist_le => /= e e0. move/cvgrPdist_le : Hl => /(_ _ e0). apply: filterS => x. apply: le_trans. rewrite [in leRHS]/Num.Def.normr/= mx_normrE. apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, lshift 3 j)). + exact: (le_bigmax _ _ (ord0, lshift n2.+1 j)). by rewrite !mxE. Qed. -Lemma differentiable_lsubmx {R : realType} (f : R -> 'rV[R]_(3 + 3)) t : +Lemma differentiable_lsubmx {R : realType} {n1 n2} + (f : R -> 'rV[R]_(n1.+1 + n2.+2)) t : (forall x, differentiable f x) -> differentiable (fun x => lsubmx (f x)) t. Proof. move=> /= => df1. -apply/derivable1_diffP. -apply/derivable_lsubmx => x. -exact/derivable1_diffP. +by apply/derivable1_diffP; apply/derivable_lsubmx => x; exact/derivable1_diffP. Qed. -Lemma derive_lsubmx {R : realType} {V : normedModType R} (f : V -> 'rV[R]_(3 + 3)) t v : +Lemma derive_lsubmx {R : realType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : (forall x, derivable f x v) -> - 'D_v (fun x => lsubmx (f x)) t = @lsubmx R _ 3 3 ('D_v f t). + 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1.+1 _ ('D_v f t). Proof. move=> df1; apply/matrixP => i j; rewrite !mxE /=. rewrite derive_mx ?mxE//=; last exact: derivable_lsubmx. -rewrite derive_mx ?mxE//=. -f_equal. +rewrite derive_mx ?mxE//=; congr ('D_v _ t). by apply/funext => x; rewrite !mxE. Qed. + +Lemma derivable_row_mx {R : realFieldType} {n1 n2 : nat} + (f : R -> 'rV[R]_n1.+1) (g : R -> 'rV[R]_n2.+1) t v : + (forall x, derivable f x v) -> (forall x, derivable g x v) -> + derivable (fun x : R => row_mx (f x) (g x)) t v. +Proof. +move=> /= fv gv; apply/derivable_mxP => i j. +rewrite (ord1 i)/=. +have /cvg_ex[/= l Hl]:= fv t. +have /cvg_ex[/= k Hk]:= gv t. +apply/cvg_ex => /=; exists (row_mx l k)``_j. +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0) Hl. +move/cvgrPdist_le : Hk => /(_ _ e0) Hk. +move: Hl Hk; apply: filterS2 => x Hl Hk. +rewrite !mxE. +case: fintype.splitP => j1 jj1. + apply: le_trans Hl. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE. + apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, j1)). + by rewrite !mxE/=. +apply: le_trans Hk. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, j1)). +by rewrite !mxE/=. +Qed. + +Lemma derive_row_mx {R : realFieldType} {n1 n2 : nat} + (f : R -> 'rV[R]_n1.+1) (g : R -> 'rV[R]_n2.+1) t v : + (forall x : R, derivable f x v) -> + (forall x : R, derivable g x v) -> + 'D_v (fun x => row_mx (f x) (g x)) t = row_mx ('D_v f t) ('D_v g t). +Proof. +move=> fv gv. +apply/matrixP => i j. +rewrite derive_mx ?mxE//=; last first. + by apply: derivable_row_mx; [exact: fv|exact: gv]. +do 2 rewrite derive_mx ?mxE//=. +case: fintype.split_ordP => /= j1 jj1; rewrite !mxE; congr ('D_v _ t). + apply/funext => x; rewrite !mxE. + case: fintype.split_ordP => k jE. + congr (f x i _). + move: jE. + by rewrite jj1 => /(congr1 val) => /= /val_inj. + move: jE. + rewrite jj1 => /(congr1 val)/=. + have /[swap] -> := ltn_ord j1. + by rewrite ltnNge/= addSn ltnS leq_addr. +apply/funext => x; rewrite !mxE. +case: fintype.split_ordP => k jE. + move: jE. + rewrite jj1 => /(congr1 val)/=. + have /[swap] <- := ltn_ord k. + by rewrite ltnNge/= addSn ltnS leq_addr. +congr (g x i _). +move: jE. +rewrite jj1 => /(congr1 val) => /= /eqP. +by rewrite eqn_add2l => /eqP /val_inj. +Qed. + +Lemma derivable_scalar_mx {R : realFieldType} n (f : 'rV[R]_n.+1 -> R) + (a : 'rV[R]_n.+1) v : + derivable f a v -> + derivable (@scalar_mx _ 1 \o f) a v. +Proof. +move=> /cvg_ex[/= l fav]. +apply/cvg_ex => /=. +exists (\col_(i < 1) l). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : fav => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leLHS]/Num.Def.normr/= !mx_normrE/=. +apply: bigmax_le => //= -[i j] _. +rewrite !mxE/=. +by rewrite !ord1 eqxx !mulr1n. +Qed. From e759828f99b64c129100a157932fa98e0bc94499 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Thu, 14 Aug 2025 15:17:46 +0900 Subject: [PATCH 046/144] propagate deriv hypo (broken state) --- tilt.v | 151 +++++++++++++++++++++++++-------------------------------- 1 file changed, 65 insertions(+), 86 deletions(-) diff --git a/tilt.v b/tilt.v index 43b69caa..f5aa6fdc 100644 --- a/tilt.v +++ b/tilt.v @@ -272,31 +272,37 @@ Qed. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). +(* sqrt est l'inverse de la fonction carree..*) Lemma derivable_sqrt {K: realType} (u : K) : u > 0 -> derivable Num.sqrt (u) 1. Proof. move => gt0. -Search (derivable _ _). -Admitted. +apply: ex_derive. +apply: (is_derive1_sqrt gt0). +Qed. + +Lemma differentiable_sqrt {K: realType} (u : K) : u > 0 -> + differentiable Num.sqrt u. +Proof. move=> u0; exact/derivable1_diffP/derivable_sqrt. Qed. Lemma differentiable_norm {K : realType} n (f : 'rV[K]_n.+1 -> 'rV_3) - (x : K -> 'rV[K]_n.+1) (t : K) : - (forall x0, f x0 != 0) -> - derivable (f \o x) t 1 -> - differentiable (fun x0 : 'rV_n.+1 => norm (f x0)) (x t). + y : + f y != 0 -> + (forall y, differentiable f y) -> + differentiable (fun x0 : 'rV_n.+1 => norm (f x0)) y. Proof. -move => fx0 dif1. +move => fxt0 dif1. rewrite /norm -fctE. apply: differentiable_comp; last first. apply/derivable1_diffP. apply/derivable_sqrt. by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0 //. -apply: differentiable_dotmul => //. -Admitted. +exact: differentiable_dotmul. +Qed. Lemma LieDerivative_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) (x : K -> 'rV[K]_6) (t : K) : (f \o x) t != 0 -> - differentiable x t -> derivable (f \o x) t 1 -> + differentiable x t -> (forall t, differentiable f t) -> LieDerivative (fun y => (norm (f y)) ^+ 2) x t = (2%:R *: 'D_1 (f \o x) t *m (f (x t))^T) 0 0. Proof. @@ -309,91 +315,63 @@ rewrite -derivemxE; last first. apply/differentiable_comp; last first. exact: differentiable_scalar_mx. rewrite -fctE /=. - apply: differentiableM; last 2 first. - apply/differentiable_norm; last 2 first. - admit. - by []. - apply/differentiable_norm; last first. - by []. - move => x0. - admit. + by apply: differentiableM; apply/differentiable_norm => //=. have := derive_norm. rewrite //=. (*move=> /( congr1 (fun z => z t)).*) rewrite -scalemxAl [X in _ -> _ = X]mxE. -move => <-; last 2 first. - by []. - by []. -(* apply: diff_derivable. - apply: differentiable_comp; last 2 first. - by []. - by [].*) -rewrite derive1Ml; last 2 first. - rewrite fctE /=. - rewrite mul1r. - rewrite !mxE. - rewrite derive1E. - transitivity ( ('D_('D_1 x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). - under eq_fun do rewrite scalar_mxM. - admit. - rewrite deriveE ; last first. - apply: differentiableM; last 2 first. - apply: differentiable_norm; last 2 first. - admit. - by []. - apply: differentiable_norm. - admit. - by []. - rewrite derive_mx//=; last first. - by apply: diff_derivable. - rewrite deriveE ; last first. - apply: differentiableM => /=. - rewrite /norm. - (* differentiable norm needs to be generalized*) - apply: differentiable_comp; last first. - apply/derivable1_diffP. - apply/derivable_sqrt. - by rewrite dotmulvv expr2 mulr_gt0 // norm_gt0 //. - apply/derivable1_diffP. - by apply/derivable_dotmul. +move => <-//; last first. + apply/diff_derivable. + by apply: differentiable_comp. +rewrite derive1Ml; last 1 first. + apply/diff_derivable. + under eq_fun do rewrite expr2. + apply: differentiableM => /=; + apply: (@differentiable_comp _ _ _ _ x (norm \o f)) => //; + by apply: differentiable_norm. +rewrite fctE /=. +rewrite mul1r. +rewrite !mxE. +rewrite derive1E. +transitivity ( ('D_('D_1 x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). + under eq_fun do rewrite scalar_mxM. + rewrite derive_mx ?mxE; last first. + apply: derivable_mulmx => //=; apply: derivable_scalar_mx; + by apply/diff_derivable; apply: differentiable_norm. + rewrite /=. + under [in RHS]eq_fun do rewrite expr2. + under eq_fun do rewrite -scalar_mxM. + by under eq_fun do rewrite mxE eqxx mulr1n. +rewrite deriveE ; last first. + by apply: differentiableM; apply: differentiable_norm => //. +rewrite derive_mx//=; last first. + by apply: diff_derivable. +rewrite deriveE ; last first. + apply: differentiableM => /=. rewrite /norm. + (* differentiable norm needs to be generalized*) apply: differentiable_comp; last first. apply/derivable1_diffP. apply/derivable_sqrt. by rewrite dotmulvv expr2 mulr_gt0 // norm_gt0 //. apply/derivable1_diffP. - by apply/derivable_dotmul. - transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). - rewrite -derive_mx //=; last by apply: diff_derivable. - by rewrite deriveE. - rewrite -diff_comp //=. - rewrite -fctE /=. - apply: differentiableM; last first. - apply: differentiable_norm; last 2 first. - admit. - by []. - apply: differentiable_norm. - admit. - by []. -apply: diff_derivable. -rewrite -fctE /=. -apply: differentiableM; last 2 first. - apply/differentiable_comp; last first. + by apply/derivable_dotmul => //=; + apply/derivable1_diffP; apply: differentiable_comp. rewrite /norm. - admit. - rewrite /=. - rewrite -fctE //. - by apply/derivable1_diffP. -apply/differentiable_comp; last 2 first. - rewrite /= -fctE. - by apply/derivable1_diffP. - apply/differentiable_comp; last 2 first. - rewrite /=. - admit. - apply/derivable1_diffP. - apply/derivable_sqrt. - by rewrite dotmulvv expr2 mulr_gt0 // norm_gt0 //. -Admitted. + apply: differentiable_comp; last first. + apply/derivable1_diffP. + apply/derivable_sqrt. + by rewrite dotmulvv expr2 mulr_gt0 // norm_gt0 //. + apply/derivable1_diffP. + by apply/derivable_dotmul => //=; + apply/derivable1_diffP; apply: differentiable_comp. +transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). + rewrite -derive_mx //=; last by apply: diff_derivable. + by rewrite deriveE. +rewrite -diff_comp //=. +rewrite -fctE /=. +by apply: differentiableM; by apply: differentiable_norm. +Qed. End LieDerivative. @@ -820,6 +798,7 @@ Definition tilt_eqn (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := fun t => row_mx (- alpha1 *: zp1_point t) (gamma *: (z2_point t - zp1_point t) *m \S('e_2%:R - z2_point t) ^+ 2). +(* TODO: use tilt_eqn *) Definition eqn33' (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := let zp1_point := Left zp1_z2_point in let z2_point := Right zp1_z2_point in @@ -856,7 +835,7 @@ rewrite /=. apply: (@le_trans _ _ (`|(maxr alpha1 gamma *: fx - maxr alpha1 gamma *: fy) a b|)). admit. apply: (@le_trans _ _ (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: x0 a b|)); last first. -Admitted. +Abort. (* cauchy lipschitz par F1 qui definit un champ de vecteur lisse : il existe une solution depuis tout point: @@ -972,7 +951,7 @@ apply/seteqP; split. rewrite alpha1_nz // Bool.orb_false_l. by rewrite lsubmx_const. by rewrite lsubmx_const rsubmx_const subr0 scaler0 mul0mx. - admit. + admit. (* NG *) Admitted. Definition point1 : 'rV[K]_6 := 0. From 297e7adbca3266db884b8b08f6de0d1169e99dc1 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 15 Aug 2025 17:16:25 +0900 Subject: [PATCH 047/144] cleaning - removed most admits --- derive_matrix.v | 18 +++ tilt.v | 382 +++++++++++++++++++++++++----------------------- tilt_analysis.v | 107 +++++++++++++- tilt_robot.v | 136 +++++++++++++---- 4 files changed, 426 insertions(+), 217 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index e6671cb9..44a38adc 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -576,6 +576,24 @@ congr ('D_w _ t). by apply/funext => y; rewrite !mxE. Qed. +Lemma derivable_dotmul {R : realFieldType} {n} + (u v : R -> 'rV[R]_n.+1) t : + derivable u t 1 -> derivable v t 1 -> + derivable (fun x => u x *d v x) t 1. +Proof. +move=> ut1 vt1/=. +rewrite /dotmul. +rewrite (_ : (fun x : R => _) = + \sum_k (fun x : R => (u x)``_k * (v x) 0 k)); last first. + apply/funext => x. + rewrite !mxE. + under eq_bigr do rewrite !mxE. + elim/big_ind2 : _ => //= f a g b -> ->. + by rewrite fctE. +apply: derivable_sum => i. +by apply: derivableM => //=; exact: derivable_coord. +Qed. + Lemma derive_crossmul {R : realFieldType} {V : normedModType R} (u v : V -> 'rV[R]_3) t w : derivable u t w -> derivable v t w -> diff --git a/tilt.v b/tilt.v index f5aa6fdc..8fe272a3 100644 --- a/tilt.v +++ b/tilt.v @@ -91,55 +91,6 @@ Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop Section derive_help. Local Open Scope classical_set_scope. - -Lemma derivable_dotmul {R : realFieldType} {n} - (u v : R -> 'rV[R]_n.+1) t : - derivable u t 1 -> derivable v t 1 -> - derivable (fun x => u x *d v x) t 1. -Proof. -move=> ut1 vt1/=. -rewrite /dotmul. -rewrite (_ : (fun x : R => _) = - \sum_k (fun x : R => (u x)``_k * (v x) 0 k)); last first. - apply/funext => x. - rewrite !mxE. - under eq_bigr do rewrite !mxE. - elim/big_ind2 : _ => //= f a g b -> ->. - by rewrite fctE. -apply: derivable_sum => i. -by apply: derivableM => //=; exact: derivable_coord. -Qed. - -Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : - u t != 0 -> - derivable u t 1 -> - (1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`() t = - 2 * (fun t => ('D_1 u t *m (u t)^T)``_0) t :> K. -Proof. -move=> u0 ut1. -rewrite [LHS]derive1E deriveMl/=; last first. - apply/derivable1_diffP. - apply/(@differentiable_comp _ _ _ _ (fun x => norm (u x)) (fun x => x ^+ 2)) => //=. - rewrite /norm. - apply/(@differentiable_comp _ _ _ _ _ (fun x => Num.sqrt x)) => //=. - apply/derivable1_diffP. - exact/derivable_dotmul. - apply/derivable1_diffP. - apply/ex_derive. - apply: is_derive1_sqrt. - rewrite dotmulvv. - by rewrite exprn_gt0// norm_gt0. -rewrite -derive1E mul1r. -under eq_fun do rewrite -dotmulvv. -rewrite dotmulP mxE /= mulr1n. -rewrite derive1E. -rewrite derive_dotmul ; last 2 first. - exact: ut1. - exact: ut1. -rewrite dotmulC. -by field. -Qed. - End derive_help. Section gradient. @@ -148,7 +99,7 @@ Definition jacobian1 {R : numFieldType} n (f : 'rV[R]_n.+1 -> R) : 'rV_n.+1 -> 'cV_n.+1 := jacobian (scalar_mx \o f). (* not used*) -(*Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := +Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) @@ -162,10 +113,10 @@ rewrite derive_mx ?mxE//=; last first. rewrite /partial. under eq_fun do rewrite (addrC a). by under [in RHS]eq_fun do rewrite !mxE/= !mulr1n. -Qed.*) +Qed. (* NB: not used *) -(*Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := +Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := \row_(j < n.+1) (i == j)%:R. Lemma err_vecE {R : ringType} n (i : 'I_n.+1) : @@ -195,7 +146,7 @@ rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. exact: differentiable_scalar_mx. rewrite partial_diff//. exact/diff_derivable. -Qed.*) +Qed. End gradient. @@ -272,37 +223,12 @@ Qed. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -(* sqrt est l'inverse de la fonction carree..*) -Lemma derivable_sqrt {K: realType} (u : K) : u > 0 -> derivable Num.sqrt (u) 1. -Proof. -move => gt0. -apply: ex_derive. -apply: (is_derive1_sqrt gt0). -Qed. - -Lemma differentiable_sqrt {K: realType} (u : K) : u > 0 -> - differentiable Num.sqrt u. -Proof. move=> u0; exact/derivable1_diffP/derivable_sqrt. Qed. - -Lemma differentiable_norm {K : realType} n (f : 'rV[K]_n.+1 -> 'rV_3) - y : - f y != 0 -> - (forall y, differentiable f y) -> - differentiable (fun x0 : 'rV_n.+1 => norm (f x0)) y. -Proof. -move => fxt0 dif1. -rewrite /norm -fctE. -apply: differentiable_comp; last first. - apply/derivable1_diffP. - apply/derivable_sqrt. - by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0 //. -exact: differentiable_dotmul. -Qed. - +(* TODO version squared sans different de 0 *) Lemma LieDerivative_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) (x : K -> 'rV[K]_6) (t : K) : - (f \o x) t != 0 -> + differentiable f (x t) -> differentiable x t -> (forall t, differentiable f t) -> + (forall x0 : 'rV_6, f x0 != 0) -> LieDerivative (fun y => (norm (f y)) ^+ 2) x t = (2%:R *: 'D_1 (f \o x) t *m (f (x t))^T) 0 0. Proof. @@ -310,12 +236,12 @@ rewrite /LieDerivative. rewrite /jacobian1. rewrite /dotmul. rewrite -trmx_mul. -move => f0 difx diff1. +move => diff difx diff0 neq0. rewrite -derivemxE; last first. apply/differentiable_comp; last first. exact: differentiable_scalar_mx. rewrite -fctE /=. - by apply: differentiableM; apply/differentiable_norm => //=. + apply: differentiableM; apply/differentiable_norm => //=. have := derive_norm. rewrite //=. (*move=> /( congr1 (fun z => z t)).*) @@ -323,6 +249,7 @@ rewrite -scalemxAl [X in _ -> _ = X]mxE. move => <-//; last first. apply/diff_derivable. by apply: differentiable_comp. + by rewrite fctE //. rewrite derive1Ml; last 1 first. apply/diff_derivable. under eq_fun do rewrite expr2. @@ -373,12 +300,88 @@ rewrite -fctE /=. by apply: differentiableM; by apply: differentiable_norm. Qed. +Lemma LieDerivative_norm_squared {K : realType} (f : 'rV[K]_6 -> 'rV_3) + (x : K -> 'rV[K]_6) (t : K) : + differentiable f (x t) -> + differentiable x t -> (forall t, differentiable f t) -> + LieDerivative (fun y => (norm (f y)) ^+ 2) x t = + (2%:R *: 'D_1 (f \o x) t *m (f (x t))^T) 0 0. +Proof. +rewrite /LieDerivative. +rewrite /jacobian1. +rewrite /dotmul. +rewrite -trmx_mul. +move => diff difx diff0. +rewrite -derivemxE; last first. + apply/differentiable_comp; last first. + exact: differentiable_scalar_mx. + apply/differentiable_norm_squared => //. +have := derive_norm_squared. +rewrite //=. +(*move=> /( congr1 (fun z => z t)).*) +rewrite -scalemxAl [X in _ -> _ = X]mxE. +move => <-//; last first. + apply/diff_derivable. + by apply: differentiable_comp. +rewrite derive1Ml; last 1 first. + apply/derivable_norm_squared. + apply/diff_derivable. + apply/differentiable_comp => //=. +rewrite fctE /=. +rewrite mul1r. +rewrite !mxE. +rewrite derive1E. +transitivity ( ('D_('D_1 x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). + rewrite derive_mx ?mxE ; last first. + apply/diff_derivable. + apply/differentiable_comp => //=. + apply/differentiable_norm_squared => //=. + apply: differentiable_scalar_mx. + rewrite /=. +rewrite [in RHS]deriveE ; last first. + apply: differentiable_norm_squared => //. +rewrite derive_mx//=; last first. + by apply: diff_derivable. +rewrite deriveE ; last first. + under eq_fun do rewrite mxE eqxx //= mulr1n. + apply/differentiable_norm_squared => //. + rewrite -[in LHS]derive_mx //=; last by apply: diff_derivable. + rewrite [in LHS]deriveE; last first. + by []. + under eq_fun do rewrite mxE eqxx //= mulr1n. + rewrite -[in RHS]derive_mx //=; last by apply: diff_derivable. + rewrite [in RHS]deriveE; last first. + by []. + by []. +transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). + rewrite derive_mx //=; last by apply: diff_derivable. + rewrite [in LHS]deriveE; last first. + apply/differentiable_norm_squared => //. + rewrite -derive_mx //=; last by apply: diff_derivable. + rewrite [in LHS]deriveE; last first. + by []. + by []. +rewrite -diff_comp; last 2 first. + by []. + apply/differentiable_norm_squared => //. +rewrite fctE /=. +rewrite deriveE; last first. + under eq_fun do rewrite expr2 -expr2. + Search "diff" "derivable". + apply/derivable1_diffP. + apply/derivable_norm_squared => //. + apply/diff_derivable. + rewrite -fctE. + apply/differentiable_comp => //. +by under [in RHS]eq_fun do rewrite expr2 -expr2. +Qed. + End LieDerivative. (* not used, can be shown to be equivalent to LieDerivative *) -(*Definition LieDerivative_partial {R : realType} n (V : 'rV[R]_n.+1 -> R) +Definition LieDerivative_partial {R : realType} n (V : 'rV[R]_n.+1 -> R) (a : R -> 'rV[R]_n.+1) (t : R) : R := - \sum_(i < n.+1) (partial V (a t) i * ('D_1 a t) ``_ i).*) + \sum_(i < n.+1) (partial V (a t) i * ('D_1 a t) ``_ i). Section ode_equation. Context {K : realType} {n : nat}. @@ -497,27 +500,22 @@ Variable g0 : K. (*standard gravity constant*) Let w t := ang_vel R t. (* local frame of the sensor (gyroscope) *) Let x1 t := v t. (* local frame*) Definition x2 t : 'rV_3 := 'e_2 *m R t. (* tilt in local frame, e2 is in global frame but R brings it back*) -Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. (* local frame of the sensor*) -End ya. - -Definition S2 {K : realType} := [set x : 'rV[K]_3 | norm x = 1]. +Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. (* local frame of the sensor*) +Variable p : K -> 'rV[K]_3. +Let v1 := fun t : K => 'D_1 p t *m R t. +Definition y_a1 t := - v1 t *m \S( w t)+ 'D_1 v1 t + g0 *: x2 t. +Hypothesis RisSO : forall t, R t \is 'SO[K]_3. -Section ya_E. -Context {K : realType}. -Variable R : K -> 'M[K]_3. -Hypothesis RSO : forall t, R t \is 'SO[K]_3. -Variable v : K -> 'rV[K]_3. -Variable g0 : K. -Let w t := ang_vel R t. -(* needs a different v,should be a different lemma..*) -Lemma ya_E t : ('D_1 v t + g0 *: 'e_2) *m R t = y_a v R g0 t. +Lemma y_aE t : ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t= y_a1 t . Proof. -rewrite mulmxDl /y_a/= /x2. -rewrite -scalemxAl. -congr +%R. -rewrite -ang_vel_mxE/=; [|admit|admit]. -(* +rewrite mulmxDl. +rewrite /y_a1/= /v1 /= /x2. +congr +%R; last by rewrite scalemxAl. +rewrite -ang_vel_mxE/=; last 2 first. + move=> t0. + rewrite rotation_sub //. + admit. rewrite [in RHS]derive_mulmx; [|admit|admit]. rewrite derive1mx_ang_vel//; [|admit|admit]. rewrite ang_vel_mxE//; [|admit|admit]. @@ -526,12 +524,12 @@ rewrite -mulmxE. rewrite -mulNmx. rewrite [X in _ = _ X]addrC. rewrite !mulNmx. -rewrite -mulmxA. -by rewrite subrr addr0. -by rewrite /x2 scalemxAl.*) +by rewrite -mulmxA /= addrN addr0. Admitted. -End ya_E. +End ya. + +Definition S2 {K : realType} := [set x : 'rV[K]_3 | norm x = 1]. Section problem_statementA. Variable K : realType. @@ -555,7 +553,7 @@ by rewrite rotation_sub // rotationV. Qed. (* not used but could be interesting *) -(*Lemma dRu t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) (w' := ang_vel T) +Lemma dRu t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) (w' := ang_vel T) : 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(w' t) + 'D_1 u t *m T t. Proof. rewrite derive_mulmx; last 2 first. @@ -572,7 +570,7 @@ rewrite -derive1mx_ang_vel; last 2 first. admit. admit. by []. -Admitted.*) +Admitted. (* eqn 10*) Notation y_a := (y_a v R g0). @@ -912,7 +910,9 @@ apply/seteqP; split. have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. move => x0. apply: DeriveDef. - admit. + apply/derivable_norm_squared => //=. + apply/derivableB => //=. + apply/derivable_rsubmx => //. by rewrite -derive1E h. rewrite /=. move/is_derive_0_is_cst. @@ -1092,7 +1092,8 @@ Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. Definition V1 (zp1_z2 : 'rV[K]_6) : K := - let zp1 := Left zp1_z2 in let z2 := Right zp1_z2 in + let zp1 := Left zp1_z2 in + let z2 := Right zp1_z2 in (norm zp1)^+2 / (2 * alpha1) + (norm z2)^+2 / (2 * gamma). Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 point1. @@ -1184,51 +1185,6 @@ rewrite tr_sqr_spin. by rewrite mulmxA. Qed. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> (forall t, differentiable x t) -> - LieDerivative (V1 alpha1 gamma) x t = V1dot (x t). -Proof. -move=> tilt_eqnx dif1. -rewrite /V1. -rewrite LieDerivativeD; last 2 first. - move=> t0. - apply: differentiableM => //=. - apply: differentiableM => //=. - admit. - admit. - move=> t0. - apply: differentiableM => //=. - apply: differentiableM => //=. - admit. - admit. -rewrite !invfM /=. -rewrite fctE. -under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. -rewrite LieDerivativeMl; last first. - move => t0. - apply: differentiableM => //=. - admit. - admit. -rewrite LieDerivativeMl; last first. - move => t0. - apply: differentiableM => //=. - admit. - admit. -rewrite !fctE !LieDerivative_norm /=; last 6 first. - admit. - by []. - apply/derivable1_diffP. - apply: differentiable_rsubmx => /= x0. - by []. - admit. - by []. - apply/derivable1_diffP. - apply: differentiable_lsubmx => /= x0. - by []. -by rewrite derive_V1dot. -Admitted. - -(* TODO: Section general properties of our system *) Lemma Gamma1_traj (y : K -> 'rV_6) t : solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt -> state_space_tilt (y t). Proof. @@ -1250,6 +1206,52 @@ rewrite /zp1 /z2 hsubmxK /=. by apply:Gamma1_traj. Qed. +Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> (forall t, differentiable x t) -> + LieDerivative (V1 alpha1 gamma) x t = V1dot (x t). +Proof. +rewrite /tilt_eqn. +move=> tilt_eqnx dif1. +rewrite /V1. +rewrite LieDerivativeD; last 2 first. + move=> t0. + apply/differentiableM => //=. + apply/differentiable_norm_squared => //. + rewrite /tilt_eqn. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + by apply: differentiable_lsubmx. + move => t0. + apply/differentiableM => //=. + apply/differentiable_norm_squared => //=. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_rsubmx => //. +rewrite !invfM /=. +rewrite fctE. +under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. +rewrite LieDerivativeMl; last first. + move => t0. + apply/differentiable_norm_squared. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_lsubmx => //. +rewrite LieDerivativeMl; last first. + move => t0. + apply/differentiable_norm_squared => //=. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_rsubmx => //. +rewrite !fctE !LieDerivative_norm_squared /=; last 6 first. + apply/differentiable_rsubmx => //. + apply (dif1 t). + move => t0. + apply/differentiable_rsubmx => //. + apply/differentiable_lsubmx => //. + apply (dif1 t). + move => t0. + apply/differentiable_lsubmx => //. +by rewrite derive_V1dot. +Qed. + +(* TODO: Section general properties of our system *) + Lemma angvel_sqr (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> @@ -1342,17 +1344,29 @@ rewrite !fctE !invfM /=. near=> z. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. +move: dtraj => [H0 [Hderiv Htilt]]. +have Hz_derivable : derivable traj z 1. + by apply: Hderiv. rewrite LieDerivativeMl; last first. - admit. + move => t. + apply/differentiable_norm_squared => //=; last first. + (* en temps superieur a zero?*) + apply/differentiable_lsubmx => //. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). rewrite LieDerivativeMl; last first. - admit. -rewrite /= !fctE !LieDerivative_norm; last 6 first. - admit. - admit. - admit. - admit. - admit. - admit. +move => t. +apply/differentiable_norm_squared; last first. + apply/differentiable_rsubmx => //. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). +rewrite /= !fctE !LieDerivative_norm_squared; last 6 first. + by apply/differentiable_rsubmx => //. + by apply/derivable1_diffP => //. + move => t. + apply/differentiable_rsubmx => //. + apply/differentiable_lsubmx => //. + by apply/derivable1_diffP => //. + move => t. + apply/differentiable_lsubmx => //. rewrite derive_V1dot //. pose zp1 := Left \o traj. pose z2 := Right \o traj. @@ -1368,7 +1382,7 @@ have Hpos := def u1 H. rewrite -oppr_ge0 -oppr_le0 opprK ltW//. by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. Unshelve. all: try by end_near. -Admitted. +Qed. Lemma V1_point_is_lnsd (y : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt-> @@ -1384,25 +1398,15 @@ rewrite LieDerivativeD /=; last 2 first. move => t. apply: differentiableM; last 2 first. rewrite /=. - apply: differentiableM; last 2 first. - apply: differentiable_norm. - admit. - admit. - apply: differentiable_norm. - admit. - admit. - rewrite -fctE. + apply: differentiable_norm_squared; last 2 first. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_lsubmx => //. apply: differentiable_cst; last first. - move => t. - apply: differentiableM; last 2 first. + move => t. apply: differentiableM; last 2 first. - apply: differentiable_norm. - admit. - admit. - apply: differentiable_norm. - admit. - admit. - rewrite -fctE. + apply: differentiable_norm_squared=> //. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_rsubmx => //. apply: differentiable_cst. split; last first. apply/near0_le0; last by []. @@ -1412,9 +1416,15 @@ rewrite !fctE. under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl; last first. - admit. + move => t. + apply/differentiable_norm_squared; last 2 first. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_lsubmx => //. rewrite LieDerivativeMl; last first. - admit. + move => t. + apply/differentiable_norm_squared; last first. + apply/differentiable_rsubmx => //. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. by []. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. @@ -1423,7 +1433,7 @@ rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. -Admitted. +Qed. Lemma V1_is_lyapunov_stable : is_lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. diff --git a/tilt_analysis.v b/tilt_analysis.v index 6f906f4e..65fd2f35 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -1,6 +1,8 @@ From mathcomp Require Import all_ssreflect all_algebra ring. From mathcomp Require Import boolp classical_sets functions reals. -From mathcomp Require Import topology normedtype derive realfun. +From mathcomp Require Import topology normedtype derive realfun landau. +From HB Require Import structures. +Require Import ssr_ext euclidean rigid frame skew derive_matrix. Set Implicit Arguments. Unset Strict Implicit. @@ -70,3 +72,106 @@ rewrite scaler1 -raddfB/= addrK (scale_scalar_mx _ t^-1) mulVf. by rewrite subrr normr0 ltW. by near: t; exact: nbhs_dnbhs_neq. Unshelve. all: by end_near. Qed. + +Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : + u t != 0 -> + derivable u t 1 -> + (1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`()%classic t = + 2 * (fun t => ('D_1 u t *m (u t)^T)``_0) t :> K. +Proof. +move=> u0 ut1. +rewrite [LHS]derive1E deriveMl/=; last first. + apply/derivable1_diffP. + apply/(@differentiable_comp _ _ _ _ (fun x => norm (u x)) (fun x => x ^+ 2)) => //=. + rewrite /norm. + apply/(@differentiable_comp _ _ _ _ _ (fun x => Num.sqrt x)) => //=. + apply/derivable1_diffP. + exact/derivable_dotmul. + apply/derivable1_diffP. + apply/ex_derive. + apply: is_derive1_sqrt. + rewrite dotmulvv. + by rewrite exprn_gt0// norm_gt0. +rewrite -derive1E mul1r. +under eq_fun do rewrite -dotmulvv. +rewrite dotmulP mxE /= mulr1n. +rewrite derive1E. +rewrite derive_dotmul ; last 2 first. + exact: ut1. + exact: ut1. +rewrite dotmulC. +by field. +Qed. + +Lemma derivable_norm_squared {K : rcfType} n (f : K -> 'rV[K]_n.+1) (x0 : K) : + derivable f x0 1 -> + derivable (fun x => norm (f x) ^+ 2) x0 1. +Proof. +move => dif1. +apply/diff_derivable. +rewrite /=. +under eq_fun do rewrite -dotmulvv dotmulE. +have -> : (fun x : K => \sum_k (f x)``_k * (f x)``_k) = + \sum_k (fun x => (f x)``_k * (f x)``_k ). + apply/funext => x => //=. + by rewrite fct_sumE. +apply/differentiable_sum => k => //=. +apply/differentiableM => //=. + apply/derivable1_diffP. + by apply/derivable_coord => //. +apply/derivable1_diffP. +by apply/derivable_coord => //. +Qed. + +Lemma derive_norm_squared {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : + derivable u t 1 -> + (1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`()%classic t = + 2 * (fun t => ('D_1 u t *m (u t)^T)``_0) t :> K. +Proof. +move=> ut1. +rewrite [LHS]derive1E deriveMl/=; last first. + by apply/derivable_norm_squared => //. +rewrite -derive1E mul1r. +under eq_fun do rewrite -dotmulvv. +rewrite dotmulP mxE /= mulr1n. +rewrite derive1E. +rewrite derive_dotmul ; last 2 first. + exact: ut1. + exact: ut1. +rewrite dotmulC. +by field. +Qed. + +Lemma derivable_sqrt {K: realType} (u : K) : u > 0 -> derivable Num.sqrt (u) 1. +Proof. +move => gt0. +apply: ex_derive. +by apply: (is_derive1_sqrt gt0). +Qed. + +Lemma differentiable_norm {K : realType} n m (f : 'rV[K]_n.+1 -> 'rV_m.+1) + (x : K -> 'rV[K]_n.+1) (t : K) : + differentiable f (x t) -> f (x t) != 0 -> + differentiable (fun x0 => norm (f x0)) (x t) . +Proof. +move => fx0 dif1. +rewrite /norm -fctE. +apply: differentiable_comp; last first. + apply/derivable1_diffP. + apply/derivable_sqrt. + by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0 //. +by apply: differentiable_dotmul => //. +Qed. + +Lemma differentiable_norm_squared {R : rcfType} m n (V := 'rV[R]_m.+1) + (u v : V -> 'rV[R]_n.+1) (t : V) : + differentiable u t -> + differentiable (fun x => norm (u x)^+2 ) t . +Proof. +move => dif1. +under eq_fun do rewrite -dotmulvv. +rewrite /=. +by apply: differentiable_dotmul => //. +Qed. + + diff --git a/tilt_robot.v b/tilt_robot.v index a0bcfb68..089aeab7 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -1,4 +1,6 @@ +From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra ring. +From mathcomp Require Import interval_inference. From mathcomp Require Import boolp classical_sets functions reals. From mathcomp Require Import topology normedtype derive. Require Import ssr_ext euclidean rigid frame skew derive_matrix. @@ -20,7 +22,7 @@ Proof. by apply/esym/eqP; rewrite -symE; exact: sqr_spin_is_sym. Qed. Lemma mul_tr_spin {R : comNzRingType} (u : 'rV[R]_3) : u *m \S(u)^T = 0. Proof. by apply: trmx_inj; rewrite trmx_mul trmxK spin_mul_tr trmx0. Qed. -Lemma CauchySchwarz_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : +Lemma CauchySchwarz_vec {R : rcfType} {n : nat} (a b : 'rV[R]_n.+1) : (a *d b)^+2 <= (a *d a) * (b *d b). Proof. suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. @@ -64,7 +66,7 @@ by rewrite dotmulvv mulrC in h2. Qed. (* not used *) -Lemma young_inequality_vec {R : realType} {n : nat} (a b : 'rV[R]_n.+1) : +Lemma young_inequality_vec {R : rcfType} {n : nat} (a b : 'rV[R]_n.+1) : (a *d b) <= (2^-1 * (norm a)^+2) + (2^-1 * (norm b)^+2). Proof. have normage0 : 0 <= (norm a)^+2. @@ -113,18 +115,18 @@ Lemma norm_squared {R : rcfType} n (u : 'rV[R]_n) : (u *m (u)^T) 0 0 = norm u ^+2. Proof. by rewrite -dotmulvv /dotmul. Qed. -Lemma derivable_rsubmx {R : realType} {V : normedModType R} {n1 n2} + +Lemma derivable_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : - (forall x, derivable f x v) -> - derivable (fun x => @rsubmx _ _ n1.+1 _ (f x)) t v. + (forall x, derivable f x v) -> derivable (fun x => rsubmx (f x)) t v. Proof. move=> /= => df1. apply/derivable_mxP => i j/=. rewrite (ord1 i). -have /cvg_ex[/= l Hl]:= df1 t. -apply/cvg_ex => /=; exists (l``_(rshift n1.+1 j)). +have /cvg_ex[/= r Hr]:= df1 t. +apply/cvg_ex => /=; exists (r``_(rshift n1.+1 j)). apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hl => /(_ _ e0). +move/cvgrPdist_le : Hr => /(_ _ e0). apply: filterS => x. apply: le_trans. rewrite [in leRHS]/Num.Def.normr/= mx_normrE. @@ -133,17 +135,8 @@ apply: le_trans; last first. by rewrite !mxE. Qed. -Lemma differentiable_rsubmx {R : realType} {n1 n2} - (f : R -> 'rV[R]_(n1.+1 + n2.+1)) t : - (forall x, differentiable f x) -> - differentiable (fun x => rsubmx (f x)) t. -Proof. -move=> /= => df1. -by apply/derivable1_diffP/derivable_rsubmx => x; exact/derivable1_diffP. -Qed. - -Lemma derive_rsubmx {R : realType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v: +Lemma derive_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : (forall x, derivable f x v) -> 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1.+1 _ ('D_v f t). Proof. @@ -153,7 +146,53 @@ rewrite derive_mx ?mxE//=; congr ('D_v _ t). by apply/funext => x; rewrite !mxE. Qed. -Lemma derivable_lsubmx {R : realType} {V : normedModType R} {n1 n2} +Lemma differentiable_rsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : + differentiable (@rsubmx R 1 n1.+1 n2.+1) t. +Proof. +have lin_rsubmx : linear (@rsubmx R 1 n1.+1 n2.+1). + move=> a b c. + by rewrite linearD//= linearZ. +pose build_lin_rsubmx := GRing.isLinear.Build _ _ _ _ _ lin_rsubmx. +pose Rsubmx : {linear 'rV[R^o]_(n1.+1 + n2.+1) -> 'rV[R^o]_n2.+1} := HB.pack (@rsubmx R _ _ _) build_lin_rsubmx. +apply: (@linear_differentiable _ _ _ Rsubmx). +move=> /= u A /=. +move/nbhs_ballP=> [e /= e0 eA]. +apply/nbhs_ballP; exists e => //= v uv. +apply: eA. +(* TODO: lemma *) +move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. +apply: (le_lt_trans _ (uv i (rshift n1.+1 j))). +by rewrite !mxE. +Qed. + +Global Instance is_diff_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f df : V -> 'rV[R]_(n1.+1 + n2.+1)) t : + is_diff t f df -> + is_diff t (fun x => rsubmx (f x)) (fun x => rsubmx (df x)). +Proof. +case=> diff_f dfE. +apply: DiffDef. + by apply: differentiable_comp => //; exact: differentiable_rsubmx0. +apply/funext => v. +rewrite -dfE. +rewrite -[LHS]deriveE; last first. + by apply: differentiable_comp => //; exact: differentiable_rsubmx0. +rewrite -[in RHS]deriveE; last first. + by []. +rewrite derive_rsubmx//. +Abort. + +Lemma differentiable_rsubmx {R : realFieldType} (V : normedModType R) {n1 n2} + (f : V -> 'rV[R]_(n1.+1 + n2.+2)) t : + (forall x, differentiable f x) -> + differentiable (fun x => rsubmx (f x)) t. +Proof. +move=> /= => df1. +apply: differentiable_comp => //. +exact: differentiable_rsubmx0. +Qed. + +Lemma derivable_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : (forall x, derivable f x v) -> derivable (fun x => lsubmx (f x)) t v. Proof. @@ -172,16 +211,7 @@ apply: le_trans; last first. by rewrite !mxE. Qed. -Lemma differentiable_lsubmx {R : realType} {n1 n2} - (f : R -> 'rV[R]_(n1.+1 + n2.+2)) t : - (forall x, differentiable f x) -> - differentiable (fun x => lsubmx (f x)) t. -Proof. -move=> /= => df1. -by apply/derivable1_diffP; apply/derivable_lsubmx => x; exact/derivable1_diffP. -Qed. - -Lemma derive_lsubmx {R : realType} {V : normedModType R} {n1 n2} +Lemma derive_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : (forall x, derivable f x v) -> 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1.+1 _ ('D_v f t). @@ -192,6 +222,52 @@ rewrite derive_mx ?mxE//=; congr ('D_v _ t). by apply/funext => x; rewrite !mxE. Qed. +Lemma differentiable_lsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : + differentiable (@lsubmx R 1 n1.+1 n2.+1) t. +Proof. +have lin_lsubmx : linear (@lsubmx R 1 n1.+1 n2.+1). + move=> a b c. + by rewrite linearD//= linearZ. +pose build_lin_lsubmx := GRing.isLinear.Build _ _ _ _ _ lin_lsubmx. +pose Lsubmx : {linear 'rV[R^o]_(n1.+1 + n2.+1) -> 'rV[R^o]_n1.+1} := HB.pack (@lsubmx R _ _ _) build_lin_lsubmx. +apply: (@linear_differentiable _ _ _ Lsubmx). +move=> /= u A /=. +move/nbhs_ballP=> [e /= e0 eA]. +apply/nbhs_ballP; exists e => //= v uv. +apply: eA. +(* TODO: lemma *) +move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. +apply: (le_lt_trans _ (uv i (lshift n2.+1 j))). +by rewrite !mxE. +Qed. + +Global Instance is_diff_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f df : V -> 'rV[R]_(n1.+1 + n2.+1)) t : + is_diff t f df -> + is_diff t (fun x => lsubmx (f x)) (fun x => lsubmx (df x)). +Proof. +case=> diff_f dfE. +apply: DiffDef. + by apply: differentiable_comp => //; exact: differentiable_lsubmx0. +apply/funext => v. +rewrite -dfE. +rewrite -[LHS]deriveE; last first. + by apply: differentiable_comp => //; exact: differentiable_lsubmx0. +rewrite -[in RHS]deriveE; last first. + by []. +rewrite derive_lsubmx//. +Abort. + +Lemma differentiable_lsubmx {R : realFieldType} (V : normedModType R) {n1 n2} + (f : V -> 'rV[R]_(n1.+1 + n2.+2)) t : + (forall x, differentiable f x) -> + differentiable (fun x => lsubmx (f x)) t. +Proof. +move=> /= => df1. +apply: differentiable_comp => //. +exact: differentiable_lsubmx0. +Qed. + Lemma derivable_row_mx {R : realFieldType} {n1 n2 : nat} (f : R -> 'rV[R]_n1.+1) (g : R -> 'rV[R]_n2.+1) t v : (forall x, derivable f x v) -> (forall x, derivable g x v) -> From 6e40a068d5609f0a03ae5c212728c383da747e2f Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 29 Aug 2025 18:24:13 +0900 Subject: [PATCH 048/144] wip lyapunov + closed ball --- tilt.v | 553 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 540 insertions(+), 13 deletions(-) diff --git a/tilt.v b/tilt.v index 8fe272a3..5daa0875 100644 --- a/tilt.v +++ b/tilt.v @@ -1,10 +1,10 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra ring. -From mathcomp Require Import boolp classical_sets functions reals. +From mathcomp Require Import boolp classical_sets functions reals order. From mathcomp Require Import topology normedtype landau derive realfun. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. -(*Require Import lasalle pendulum.*) +Require Import lasalle pendulum. (**md**************************************************************************) (* # tentative formalization of [1] *) @@ -71,23 +71,24 @@ Admitted. Local Open Scope classical_set_scope. -Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0^', V z > 0. +Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (D : set T) (x : T) : Prop := + x \in D /\ V x = 0 /\ open D /\ forall z, z \in D -> z != x -> V z > 0. -Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) - (x0 : 'rV[K]_n.+1) := locposdef V x0. +(* add continuously diff*) +Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) (D : set 'rV[K]_n.+1) + (x0 : 'rV[K]_n.+1) := locposdef V D x0 /\ differentiable V x0. (* locally positive semi definite (NB* not used yet) *) Definition lpsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0^', V z >= 0. + V x = 0 /\ \forall z \near x^', V z >= 0. (* locally negative semidefinite *) Definition locnegsemidef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0^', V z <= 0. + V x = 0 /\ \forall z \near x^', V z <= 0. (* locally negative definite (NB: not used yet) *) Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near 0^', V z < 0. + V x = 0 /\ \forall z \near x^', V z < 0. Section derive_help. Local Open Scope classical_set_scope. @@ -367,7 +368,6 @@ rewrite -diff_comp; last 2 first. rewrite fctE /=. rewrite deriveE; last first. under eq_fun do rewrite expr2 -expr2. - Search "diff" "derivable". apply/derivable1_diffP. apply/derivable_norm_squared => //. apply/diff_derivable. @@ -399,7 +399,407 @@ Definition equilibrium_points A := [set p : T | is_equilibrium_point p A ]. Definition state_space A := [set p : T | exists y, solves_equation y A /\ exists t, p = y t ]. +Definition is_stable_equilibrium_at + (A : set T) (x : T) + (z : K -> 'rV[K]_n.+1) + (solve_z : solves_equation z A):= + is_equilibrium_point x A /\ + forall eps, eps > 0 -> + exists2 d, d > 0 & + (`| z 0 - x | < d -> forall t, t >= 0 -> `| z t - x | < eps). + +Definition is_stable_equilibrium + (A : set T) (x : T) := + forall z (solves_z : solves_equation z A), is_stable_equilibrium_at x solves_z. + +(* a voir*) +Definition is_asymptotically_stable_equilibrium + (A : set T) (x : T) : Prop := + is_stable_equilibrium A x /\ + forall z, solves_equation z A -> + exists2 d, d > 0 & + (`| z 0 - x | < d -> z t @[t --> +oo] --> x). + End ode_equation. + (* axiom cauchy thm 3.3 *) + +(* preuve qui repose sur la continuite et la monotonie via locpos + continument differentiable V*) + +Definition traj_lin {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (x : 'rV[K]_n.+1) (t : K) := + x + t *: (f (cst x) 0). + +Definition LieDerivative_at {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (V : 'rV[K]_n.+1 -> K) + (x : 'rV[K]_n.+1) := + LieDerivative V (traj_lin f x) 0. + +Lemma LieDerivative_traj1 {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (traj1 : K -> 'rV[K]_n.+1) + (D : set 'rV[K]_n.+1) + (V : 'rV[K]_n.+1 -> K) : + solves_equation f traj1 D -> + forall t0, traj1 t0 \in D -> + LieDerivative V traj1 t0 = LieDerivative_at f V (traj1 t0). +Admitted. + +Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n.+1) : + closed_ball x e = [set y | `|y - x| <= e]. +Proof. +have [e0|s0] := leP e 0. + admit. +rewrite /closed_ball. +apply/seteqP; split => /= y. + rewrite /closure/= => H. + near (0:K)^'+ => f. + have [/= z []] : ball x e `&` ball y f !=set0. + admit. + rewrite mx_norm_ball /ball_/=. + move=> xze yzf. + rewrite -(subrK z y). + rewrite -addrA (le_trans (ler_normD _ _))//. + rewrite (@le_trans _ _ (f + `|z - x|))//. + admit. + rewrite distrC. + rewrite -lerBrDr. +Admitted. + +Theorem Lyapunov_stability0 {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (traj1 : K -> 'rV[K]_n.+1) + (D : set 'rV[K]_n.+1) + (V : 'rV[K]_n.+1 -> K) + (fdtraj : solves_equation f traj1 D) + (traj10 : traj1 0 \in D) + (Vx0 : is_lyapunov_candidate V D 0) + (V'le_0 : forall x, x \in D -> LieDerivative_at f V x <= 0) : + is_equilibrium_point f 0 D -> + is_stable_equilibrium_at 0 fdtraj. + +(* todo: systeme autonome, trajectoire pointwise *) +Proof. +move => eq. +rewrite /is_stable_equilibrium. +split => //=. +move => eps eps0. +rewrite /is_lyapunov_candidate in Vx0. +move: Vx0 => [/= Vloc Vdiff]. +rewrite /locposdef in Vloc. +move: Vloc => [/= inD [V0 [openD z]]]. +have : exists r : K, 0 < r /\ r <= eps /\ closed_ball (0:'rV[K]_n.+1) r `<=` D. + rewrite inE in inD. + have [r0 /= Hr0D] := open_subball openD inD. + pose r := Num.min (r0/2) eps. + move=> q. + exists (r/2). + split. + rewrite /r. + case: (lerP (r0/2) eps) => H. + rewrite divr_gt0 =>//. + by rewrite divr_gt0. + by rewrite divr_gt0. + rewrite /r. + split. + rewrite /minr. + rewrite /r; case: ifPn => H. + rewrite ler_pdivrMr//. + rewrite (le_trans (ltW H))//. + by rewrite ler_peMr ?ler1n// ltW. + rewrite /=. + rewrite ler_pdivrMr//. + by rewrite ler_peMr ?ler1n// ltW. + move=> B rB. + apply (q (r)); last first. + rewrite -/r in rB. + move : rB. + Search closed_ball ball. + apply: subset_closure_half => //. + + case: (lerP (r0/2) eps) => H. + rewrite /r /minr; case: ifPn => H1. + by rewrite divr_gt0. + by exact: eps0. + rewrite /r /minr; case: ifPn => H1. + by rewrite divr_gt0. + by exact: eps0. + rewrite /r /minr; case: ifPn => H1. + by rewrite divr_gt0. + by exact: eps0. + rewrite ball_normE. + rewrite /ball /=. + rewrite sub0r normrN. + rewrite /r. + rewrite gtr0_norm. + case: (lerP (r0/2) eps) => H. + rewrite ltr_pdivrMr. + rewrite mulr2n mulrDr mulr1. + by rewrite ltrDl. + by []. + apply: (lt_trans H _). + rewrite ltr_pdivrMr. + rewrite mulr2n mulrDr mulr1. + by rewrite ltrDl. + by []. + case: (lerP (r0/2) eps) => H. + by rewrite divr_gt0. + by exact: eps0. +have Hcont := differentiable_continuous Vdiff. +move=> [r [r_pos [r_le_eps Br_sub_D]]]. +pose sphere_r := [set x : 'rV[K]_n.+1 | `|x| = r]. +have Halpha : {x : 'rV[K]_n.+1 | forall y, y \in sphere_r -> V(x) <= V(y)}. +(* extreme value theorem?*) + admit. +pose alpha := V (sval Halpha). +have alpha_gt0 : 0 < alpha. + have sphere_pos: forall y, y \in sphere_r -> 0 < V y. + move=> y hy. + apply: z. + move : hy. + rewrite /sphere_r. + move : Br_sub_D. + rewrite closed_ballAE. + move => Br_sub_D. + rewrite inE. + move => yr. + rewrite inE. + apply: Br_sub_D. + (* TODO*) + admit. + rewrite gtr0_norm_neq0 => //. + move : hy. + rewrite /sphere_r. + rewrite inE. + move => hy. + have :`|y| = r. + by apply: hy. + move => yr. + by rewrite yr. + rewrite /alpha. + rewrite sphere_pos => //. + rewrite /sphere_r inE. + + admit. +have: exists beta, 0 < beta < alpha. + rewrite /=. + exists (alpha / 2). + rewrite divr_gt0 //=. + rewrite ltr_pdivrMr. + rewrite mulr2n mulrDr mulr1. + by rewrite ltrDl. + by []. +move=> [beta Hbeta]. +set ball_r := [set x : 'rV[K]_n.+1 | `|x| < r]. +set Omega_beta := [set x : 'rV[K]_n.+1 | (ball 0 r) x /\ V x <= beta]. +have HOmega_beta : Omega_beta `<=` interior (ball 0 r). + rewrite /Omega_beta /ball_r. + move=> x [Hx mini]. + have open_ball_r := ball_open 0 r_pos. + have int : ball 0 r `<=` (ball 0 r)°. + move => t. + rewrite -open_subsetE. + done. + (*apply (open_ball_r t).*) + admit. + apply: int. + exact: Hx. +have H1 : traj1 0 \in Omega_beta -> forall t, t >= 0 -> traj1 t \in Omega_beta. + move => traj10Omega. + have H : forall x, x \in D -> LieDerivative_at f V x <= 0 -> forall t : K, t >= 0 -> V (traj1 t) <= V (traj1 0) <= beta. + move => x xinD Lie0 t t0. + rewrite /is_equilibrium_point /solves_equation /= in eq. + rewrite /locnegsemidef. + have Vneg_incr: forall s1 s2, 0 <= s1 <= s2 -> V (traj1 s2) <= V (traj1 s1). + move=> s1 s2 Hs1_pos. + apply: (@ler0_derive1_nincr _ (fun s => V (traj1 s)) 0 s2). + move=> s Hs_in. + have Dz: derivable traj1 s 1. + move : fdtraj. + rewrite /solves_equation. + move=> [Hz0inA [Hder Hdz]]. + exact: (Hder s). + apply: diff_derivable. + rewrite -fctE. + apply: differentiable_comp; last first. + admit. + by apply/derivable1_diffP. + move=> s Hs_in. + admit. + admit. + move: Hs1_pos => /andP [H0s1 Hs1s2]. + apply: H0s1. + move: Hs1_pos => /andP [H0s1 Hs1s2]. + apply: Hs1s2. + done. + have H1 : V (traj1 t) <= V (traj1 0). + apply: Vneg_incr. + apply/andP; split. + done. + by []. + apply/andP; split. + by []. + move: traj10Omega. + rewrite inE. + move => traj10Omega. + by case: traj10Omega. + move => t t0. + rewrite inE. + split; last first. + have /andP [Hle1 Hle2] := H (traj1 0) traj10 (V'le_0 _ traj10) t t0. + by apply: (le_trans Hle1 Hle2). + have compact_Omega_beta : compact Omega_beta. + rewrite /Omega_beta. + Search compact. + apply: bounded_closed_compact. + Search bounded_set. + admit. + apply: closedI. + rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. + rewrite /=. + move => t1 clo. + move : clo. + + admit. + rewrite /=. + Search closed_ball. + apply: closed_comp; last first. + move => t1 clos //=. + admit. + rewrite /=. + admit. +have V_traj_le_beta : V (traj1 t) <= V (traj1 0) <= beta. + apply: H. + exact: traj10. + apply: V'le_0; exact: traj10. + exact: t0. +have traj1t_in_Omega : traj1 t \in Omega_beta. +rewrite /Omega_beta. +rewrite inE. +split. + admit. + admit. +move : traj1t_in_Omega. +rewrite inE /Omega_beta. +move =>bla. +case : bla => Hball _. +done. +have [delta0 Hdelta0] : exists d, d > 0 /\ forall x, `|x| < d -> V x < beta. + rewrite /=. + (* continuity*) + admit. +pose delta := Num.min delta0 r. +have Hdelta : 0 < delta /\ (forall x, `|x| < delta -> V x < beta). + split. + rewrite /delta /minr. + case: (delta0 < r) => //. + exact: Hdelta0.1. + rewrite /=. + move => x xdel. + move: Hdelta0 => [Hdelta0_pos Hdelta0_prop]. +have x_lt_delta0: `|x| < delta0. +rewrite /delta in xdel. +apply: lt_le_trans xdel _. +rewrite /minr. + case: (delta0 < r) => //. + apply: ltW. + admit. +by apply: Hdelta0_prop. +have inclusion : ball 0 delta `<=` Omega_beta /\ Omega_beta `<=` ball 0 r. + split; last first. + apply: subset_trans HOmega_beta _. + by apply: interior_subset. + rewrite /Omega_beta. + apply/subsetP => x Hx. + rewrite inE. + split; last first. + have [/= Hdelta_pos Hdelta_bound] := Hdelta. + move: Hx. + rewrite inE. + rewrite mx_norm_ball. + rewrite /ball_. + under eq_fun do rewrite sub0r normrN. + move => Hx. + have Vx_lt_beta := Hdelta_bound _ Hx. + by apply: ltW. + rewrite mx_norm_ball. + rewrite /ball_; under eq_fun do rewrite sub0r normrN. + have delta_le_r: delta <= r. + rewrite /delta. + rewrite /minr. + case: ifP => Hlt. + by rewrite ltW. + by []. + rewrite inE in Hx. + move : Hx. + rewrite mx_norm_ball. + rewrite /ball_; under eq_fun do rewrite sub0r normrN. + move=> Hball . + by apply: lt_le_trans Hball delta_le_r. +have inclusion2 : (ball 0 delta) (traj1 0) -> traj1 0 \in Omega_beta -> forall t, t >= 0 -> traj1 t \in + Omega_beta -> (ball 0 r) (traj1 t). + move => ball0 traj10in t t0 traj1tin. + by move: traj1tin; rewrite /Omega_beta inE => [] [Hball _]. +have Hlast : `|traj1 0| < delta -> forall t : K , t >=0 -> `|traj1 t| < r <= eps. + move => traj10delta t t0. + case: inclusion => [Hin_ball_delta _]. + have traj1_in_Omega : traj1 0 \in Omega_beta. + rewrite inE. + apply: Hin_ball_delta; rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN; exact: traj10delta. +have traj1t_in_Omega := H1 traj1_in_Omega t t0. +rewrite /Omega_beta inE in traj1t_in_Omega. +case: traj1t_in_Omega => [Hball_traj1t _]. +move : Hball_traj1t. +rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. +move => Hball_traj1t. +apply/andP; split. +apply: Hball_traj1t. +exact : r_le_eps. +exists delta. +by case: Hdelta. +rewrite !subr0. +move=> Hnorm t Ht. +rewrite subr0. +have /andP [Hlt Hle] := Hlast Hnorm t Ht. +by apply: (lt_le_trans Hlt Hle). +Admitted. + +Theorem Lyapunov_stability {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (traj1 : K -> 'rV[K]_n.+1) + (x0 : 'rV[K]_n.+1) + (D : set 'rV[K]_n.+1) + (x0inD : x0 \in D) + (V : 'rV[K]_n.+1 -> K) + (fdtraj : solves_equation f traj1 D) (* continuously diff*) + (traj10 : traj1 0 \in D) + (Vx0 : is_lyapunov_candidate V x0) + (V'le_0 : LieDerivative V traj1 0 <= 0): + is_equilibrium_point f x0 D -> + is_stable_equilibrium_at x0 fdtraj. +Proof. +(* TODO (lynda, 2025-09-03) prove with lyapunov stability zero*) +Admitted. + +Theorem Lyapunov_asymptotic_stability {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (A : set 'rV[K]_n.+1) + (V : 'rV[K]_n.+1 -> K) + (x0 : 'rV[K]_n.+1) : + (is_equilibrium_point f x0 A /\ is_lyapunov_candidate V x0) -> + (forall traj1 : (K -> 'rV[K]_n.+1), + solves_equation f traj1 A -> + locnegsemidef (LieDerivative V traj1) 0 -> + traj1 0 = x0 ) -> + is_asymptotically_stable_equilibrium f A x0. +Proof. +move => [eq [lya dif]] Htraj. +split. +rewrite /is_stable_equilibrium; split. +by []. +Admitted. Definition is_lyapunov_stable_at {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) @@ -408,7 +808,7 @@ Definition is_lyapunov_stable_at {K : realType} {n} (x0 : 'rV[K]_n.+1) : Prop := [/\ is_equilibrium_point f x0 A, is_lyapunov_candidate V x0 & - forall traj1 traj2 : (K -> 'rV[K]_n.+1), + forall traj1 : (K -> 'rV[K]_n.+1), solves_equation f traj1 A -> traj1 0 = x0 -> locnegsemidef (LieDerivative V traj1) 0]. @@ -1011,6 +1411,14 @@ rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// sca by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. Qed. +Variable F1 : 'rV[K]_6 -> 'rV[K]_6. +Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. +Hypothesis sol_correct : forall x0, ('D_1 fun t=> (sol x0 t)) = fun t => F1 (sol x0 t). +Definition tilt_eqn_interface (x : 'rV_6) (t : K) : 'rV_6 := + tilt_eqn (fun _ => x) t. + +Hypothesis invariant_gamma : is_invariant tilt_eqn_interface (state_space_tilt). (* a transformer en lemme*) + (* this lemma asks for lyapunov + lasalle *) Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation tilt_eqn y state_space_tilt -> y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. @@ -1099,7 +1507,8 @@ Definition V1 (zp1_z2 : 'rV[K]_6) : K := Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 point1. Proof. rewrite /locposdef; split. -- by rewrite /V1 /point1 lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. +- rewrite /V1 /point1 /locposdef; split. + by rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. - near=> z_near. simpl in *. have z_neq0 : z_near != 0 by near: z_near; exact: nbhs_dnbhs_neq. @@ -1120,6 +1529,17 @@ rewrite /locposdef; split. - rewrite ltr_pwDr//. by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0// norm_gt0. by rewrite divr_ge0 ?exprn_ge0 ?norm_ge0// mulr_ge0// ltW. + - rewrite /V1. + rewrite -fctE. + apply/differentiableD => //; last first. + apply/differentiableM => //. + apply/differentiable_norm_squared => //=. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_rsubmx => //. + apply/differentiableM => //. + apply/differentiable_norm_squared => //=. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_lsubmx => //. Unshelve. all: by end_near. Qed. Definition V1dot (zp1_z2 : 'rV[K]_6) : K := @@ -1435,14 +1855,121 @@ rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. by rewrite scaler0 scaler0 add0r. Qed. +Lemma V1_point_is_lnd (y : K -> 'rV_6) + (z : K) + (zp1 := Left \o y) (z2 := Right \o y) + (w := z2 z *m \S('e_2)) + (u1: 'rV[K]_2 := + \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i ) : + u1 != 0 -> + solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt-> + y 0 = point1 -> + lnd (LieDerivative (V1 alpha1 gamma) y) 0. +Proof. +move=> neq0 [y033] [dy dtraj] traj0. +have Gamma1_traj t : state_space_tilt (y t). + apply/Gamma1_traj. + by split => //. +rewrite /lnd. +split; last first. +near=> z0. +rewrite deriveV1. +have Hle : V1dot (y z) <= (- u1 *m u2 *m u1^T) 0 0. + by apply: V1dot_ub. +have := @defposmxu2 K. +rewrite defposmxP => def. +have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0 by apply: def. +have Hneg : - (u1 *m u2 *m u1^T) 0 0 < 0. by rewrite oppr_lt0. +rewrite lt_neqAle. +have sol : solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt by split => //. +apply/andP; split; last first. + apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). + have Hle_z0 : V1dot (y z0) <= (- u1 *m u2 *m u1^T) 0 0. + replace z0 with z; last by admit. + by []. + admit. +have -> : (- u1 *m u2 *m u1^T) 0 0 = - (u1 *m u2 *m u1^T) 0 0. + rewrite !mxE -sumrN. + under [in RHS]eq_bigr do rewrite -mulNr. + under eq_bigr do rewrite mulNmx. + admit. + by apply/ltW => //. + replace z0 with z. + admit. + admit. +by []. +move => t. +apply/derivable1_diffP => //. +rewrite /V1. +rewrite !invfM /=. +rewrite LieDerivativeD /=; last 2 first. + move => t. + apply: differentiableM; last 2 first. + rewrite /=. + apply: differentiable_norm_squared; last 2 first. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_lsubmx => //. + apply: differentiable_cst; last first. + move => t. + apply: differentiableM; last 2 first. + apply: differentiable_norm_squared=> //; last first. + apply/differentiable_rsubmx => //. + apply: differentiable_cst. +rewrite !fctE. +under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. +rewrite LieDerivativeMl; last first. + move => t. + apply/differentiable_norm_squared; last 2 first. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_lsubmx => //. +rewrite LieDerivativeMl; last first. + move => t. + apply/differentiable_norm_squared; last first. + apply/differentiable_rsubmx => //. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). +rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. + by []. + rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. + by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. + by []. + rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. + by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. +by rewrite scaler0 scaler0 add0r. +Unshelve. all: by end_near. +Admitted. + Lemma V1_is_lyapunov_stable : is_lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. Proof. split. - by apply: equilibrium_point1 => //. - exact: V1_is_lyapunov_candidate. -- move=> traj1 ? ? ?. +- move=> traj1 ? ? . by apply: V1_point_is_lnsd => //. Qed. +(* thm 4.6 p136*) +Definition hurwitz n (A : 'M[K]_n.+1) : Prop := (forall a, eigenvalue A a -> a < 0). + +(* thm 4.7 p139 + fact: it is exponentially stable*) +Definition locally_exponentially_stable_at n (eqn : 'rV[K]_n.+1 -> 'rV[K]_n.+1) (point : 'rV[K]_n.+1) : Prop := + hurwitz (jacobian eqn point). + +Lemma eqn33_is_locally_exponentially_stable_at_0 : locally_exponentially_stable_at (eqn33' alpha1 gamma) point1. +Proof. +rewrite /locally_exponentially_stable_at /jacobian /hurwitz. +move => a. +move/eigenvalueP => [u] /[swap] u0 H. +have a_eigen : eigenvalue (jacobian (eqn33' alpha1 gamma) point1) a. + apply/eigenvalueP. + exists u. + exact: H. + exact: u0. +have : root (char_poly (jacobian (eqn33' alpha1 gamma) point1)) a. + rewrite -eigenvalue_root_char. + exact : a_eigen. +rewrite /eqn33' /jacobian. +Admitted. + End Lyapunov. From 22e281b54f1d35aecd09a3da35bcdf1545134d3f Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 11 Sep 2025 11:23:44 +0900 Subject: [PATCH 049/144] use closed_ball_ --- tilt.v | 163 ++++++++++++++++++++++++--------------------------------- 1 file changed, 68 insertions(+), 95 deletions(-) diff --git a/tilt.v b/tilt.v index 5daa0875..5588f094 100644 --- a/tilt.v +++ b/tilt.v @@ -4,7 +4,7 @@ From mathcomp Require Import boolp classical_sets functions reals order. From mathcomp Require Import topology normedtype landau derive realfun. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. -Require Import lasalle pendulum. +(*Require Import lasalle pendulum.*) (**md**************************************************************************) (* # tentative formalization of [1] *) @@ -438,8 +438,8 @@ Definition LieDerivative_at {K : realType} {n} LieDerivative V (traj_lin f x) 0. Lemma LieDerivative_traj1 {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (traj1 : K -> 'rV[K]_n.+1) + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (traj1 : K -> 'rV[K]_n.+1) (D : set 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) : solves_equation f traj1 D -> @@ -447,30 +447,40 @@ Lemma LieDerivative_traj1 {K : realType} {n} LieDerivative V traj1 t0 = LieDerivative_at f V (traj1 t0). Admitted. -Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n.+1) : - closed_ball x e = [set y | `|y - x| <= e]. +From mathcomp Require Import normedtype. +From mathcomp Require Import matrix_normedtype. + +Lemma ball0_le0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : + ball a r = set0 -> r <= 0. Proof. -have [e0|s0] := leP e 0. - admit. -rewrite /closed_ball. -apply/seteqP; split => /= y. - rewrite /closure/= => H. - near (0:K)^'+ => f. - have [/= z []] : ball x e `&` ball y f !=set0. - admit. - rewrite mx_norm_ball /ball_/=. - move=> xze yzf. - rewrite -(subrK z y). - rewrite -addrA (le_trans (ler_normD _ _))//. - rewrite (@le_trans _ _ (f + `|z - x|))//. - admit. - rewrite distrC. - rewrite -lerBrDr. -Admitted. +rewrite -subset0 => ar0; rewrite leNgt; apply/negP => r0. +by have /(_ (ballxx _ r0)) := ar0 a. +Qed. + +Lemma le0_ball0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : + r <= 0 -> ball a r = set0. +Proof. +move=> r0; rewrite -subset0 => y. +rewrite -ball_normE /ball_/= ltNge => /negP; apply. +by rewrite (le_trans r0). +Qed. + +Lemma closed_ball0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : + r <= 0 -> closed_ball a r = set0. +Proof. +move=> r0; rewrite -subset0 => v. +by rewrite /closed_ball le0_ball0// closure0. +Qed. + +Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n.+1) : + 0 < e -> closed_ball x e = closed_ball_ (@mx_norm _ _ _) x e. +Proof. +by move=> e0; rewrite closed_ballE. +Qed. Theorem Lyapunov_stability0 {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (traj1 : K -> 'rV[K]_n.+1) + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (traj1 : K -> 'rV[K]_n.+1) (D : set 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) (fdtraj : solves_equation f traj1 D) @@ -479,7 +489,6 @@ Theorem Lyapunov_stability0 {K : realType} {n} (V'le_0 : forall x, x \in D -> LieDerivative_at f V x <= 0) : is_equilibrium_point f 0 D -> is_stable_equilibrium_at 0 fdtraj. - (* todo: systeme autonome, trajectoire pointwise *) Proof. move => eq. @@ -490,63 +499,40 @@ rewrite /is_lyapunov_candidate in Vx0. move: Vx0 => [/= Vloc Vdiff]. rewrite /locposdef in Vloc. move: Vloc => [/= inD [V0 [openD z]]]. -have : exists r : K, 0 < r /\ r <= eps /\ closed_ball (0:'rV[K]_n.+1) r `<=` D. +have : exists r : K, 0 < r /\ r <= eps /\ closed_ball_ (fun x => `|x|) (0:'rV[K]_n.+1) r `<=` D. rewrite inE in inD. have [r0 /= Hr0D] := open_subball openD inD. - pose r := Num.min (r0/2) eps. + pose r := Num.min (r0 / 2) eps. + have r_gt0 : 0 < r. + rewrite /r /minr. + case: ifPn => // _. + by rewrite divr_gt0. move=> q. - exists (r/2). + exists (r / 2). split. - rewrite /r. - case: (lerP (r0/2) eps) => H. - rewrite divr_gt0 =>//. - by rewrite divr_gt0. - by rewrite divr_gt0. - rewrite /r. + by rewrite divr_gt0. split. - rewrite /minr. - rewrite /r; case: ifPn => H. + rewrite /r. + rewrite /minr. + case: ifPn. + move/ltW; apply: le_trans. + rewrite ler_pdivrMr//. + by rewrite ler_peMr ?ler1n// divr_ge0// ltW. + move=> _. rewrite ler_pdivrMr//. - rewrite (le_trans (ltW H))//. by rewrite ler_peMr ?ler1n// ltW. - rewrite /=. - rewrite ler_pdivrMr//. - by rewrite ler_peMr ?ler1n// ltW. - move=> B rB. - apply (q (r)); last first. - rewrite -/r in rB. - move : rB. - Search closed_ball ball. - apply: subset_closure_half => //. - - case: (lerP (r0/2) eps) => H. - rewrite /r /minr; case: ifPn => H1. - by rewrite divr_gt0. - by exact: eps0. - rewrite /r /minr; case: ifPn => H1. - by rewrite divr_gt0. - by exact: eps0. - rewrite /r /minr; case: ifPn => H1. - by rewrite divr_gt0. - by exact: eps0. - rewrite ball_normE. - rewrite /ball /=. - rewrite sub0r normrN. - rewrite /r. - rewrite gtr0_norm. - case: (lerP (r0/2) eps) => H. - rewrite ltr_pdivrMr. - rewrite mulr2n mulrDr mulr1. - by rewrite ltrDl. - by []. - apply: (lt_trans H _). - rewrite ltr_pdivrMr. - rewrite mulr2n mulrDr mulr1. - by rewrite ltrDl. + move=> v rv. + apply (q r); last 2 first. by []. - case: (lerP (r0/2) eps) => H. - by rewrite divr_gt0. - by exact: eps0. + move: rv. + rewrite -closed_ballE//; last first. + by rewrite divr_gt0. + by apply: subset_closure_half => //. + rewrite /ball/=. + rewrite sub0r normrN gtr0_norm// /r. + rewrite gt_min. + rewrite ltr_pdivrMr//. + by rewrite ltr_pMr// ltr1n. have Hcont := differentiable_continuous Vdiff. move=> [r [r_pos [r_le_eps Br_sub_D]]]. pose sphere_r := [set x : 'rV[K]_n.+1 | `|x| = r]. @@ -557,31 +543,18 @@ pose alpha := V (sval Halpha). have alpha_gt0 : 0 < alpha. have sphere_pos: forall y, y \in sphere_r -> 0 < V y. move=> y hy. - apply: z. - move : hy. - rewrite /sphere_r. - move : Br_sub_D. - rewrite closed_ballAE. - move => Br_sub_D. - rewrite inE. - move => yr. - rewrite inE. + apply: z; last first. + rewrite gtr0_norm_neq0 //. + move: hy. + by rewrite inE /sphere_r/= => ->. + apply/mem_set. apply: Br_sub_D. - (* TODO*) - admit. - rewrite gtr0_norm_neq0 => //. + rewrite /closed_ball_/= sub0r. move : hy. - rewrite /sphere_r. - rewrite inE. - move => hy. - have :`|y| = r. - by apply: hy. - move => yr. - by rewrite yr. + by rewrite inE /sphere_r/= normrN => ->. rewrite /alpha. rewrite sphere_pos => //. - rewrite /sphere_r inE. - + rewrite /sphere_r inE/=. admit. have: exists beta, 0 < beta < alpha. rewrite /=. From a00346505a242da955c440003fb60549621e0fe8 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 12 Sep 2025 15:16:44 +0900 Subject: [PATCH 050/144] wip lyapunov --- _CoqProject | 3 + tilt.v | 788 +++++++++++++++++++++++------------------------- tilt_analysis.v | 2 +- 3 files changed, 380 insertions(+), 413 deletions(-) diff --git a/_CoqProject b/_CoqProject index eea696ab..639d7d99 100644 --- a/_CoqProject +++ b/_CoqProject @@ -20,6 +20,9 @@ extra_trigo.v tilt_mathcomp.v tilt_analysis.v tilt_robot.v +lasalle.v +pendulum.v tilt.v + -R . robot diff --git a/tilt.v b/tilt.v index 5588f094..fe75fefe 100644 --- a/tilt.v +++ b/tilt.v @@ -153,68 +153,89 @@ End gradient. Section LieDerivative. -(* TODO isnt it just a directional derivative?*) -Definition LieDerivative {R : realFieldType} n (V : 'rV[R]_n.+1 -> R) - (x : R -> 'rV[R]_n.+1) (t : R) : R := - (jacobian1 V (x t))^T *d 'D_1 x t. - -Lemma LieDerivativeMl {R : realType} n (f : 'rV_n.+1 -> R) (x : R -> 'rV_n.+1) - (k : R) : - (forall t, differentiable f (x t)) -> - LieDerivative (k *: f) x = k *: LieDerivative f x. +Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) + (phi : 'rV[R]_n.+1 -> R -> 'rV[R]_n.+1) (x : 'rV[R]_n.+1) (t : R) : R := + (jacobian1 V (phi x t))^T *d 'D_1 (phi x) t. +(* we assume that phi is the solution of a diff equa such that phi 0 x = x *) + +Lemma LieDerivative_derive {R : realType} n (V : 'rV[R]_n.+1 -> R) + (phi : 'rV[R]_n.+1 -> R -> 'rV[R]_n.+1) (t : R) (x : 'rV[R]_n.+1) : + (differentiable V (phi x t)) -> (differentiable (phi x) t) -> + LieDerivative V phi x t = 'D_1 (V \o (phi x)) t. +(* Warning: we are not representing the initial state at t = 0 of the trajectory x + see Khalil p.114 *) Proof. -move=> dfx. -rewrite /LieDerivative /jacobian1 /jacobian. -rewrite !fctE. -apply/funext => y. +move => dif1 dif2. +rewrite /LieDerivative /=. +rewrite /jacobian1. +rewrite /jacobian. rewrite /dotmul. -rewrite (_ : (fun v : 'rV_n.+1 => (k *: f v)%:M) = - k *: (fun v : 'rV_n.+1 => (f v)%:M)); last first. - apply/funext => v //=. - by rewrite fctE scale_scalar_mx. -rewrite [X in ((lin1_mx X)^T *m ('D_1 x y)^T) 0 0 = _](@diffZ R _ _ _ _ _ ); last first. - apply/differentiable_comp. - exact: dfx. - exact: differentiable_scalar_mx. -rewrite -!trmx_mul. -rewrite ( _ : lin1_mx (k \*: 'd _ _) = - k *: lin1_mx ('d (fun x0 : 'rV_n.+1 => (f x0)%:M) (x y))); last first. - by apply/matrixP => i j; rewrite !mxE. -by rewrite mxE [in RHS]mxE -scalemxAr mxE. +rewrite -trmx_mul. +rewrite mul_rV_lin1. +rewrite mxE. +rewrite -deriveE => //=; last first. + apply: differentiable_comp => //=. + exact/differentiable_scalar_mx (* *). +rewrite derive_mx /=. +rewrite mxE. +rewrite [in RHS]deriveE => //=. +rewrite [in RHS]diff_comp => //=. +rewrite -![in RHS]deriveE => //=. +under eq_fun do rewrite mxE /= mulr1n /=. +by []. +apply: differentiable_comp => //=; last first. +apply: derivable_scalar_mx => //=. +apply: diff_derivable => //=. Qed. -Lemma LieDerivativeD {K : realType} n (f g : 'rV_n.+1 -> K) (x : K -> 'rV_n.+1) : - (forall t, differentiable f (x t)) -> - (forall t, differentiable g (x t)) -> - LieDerivative (f + g) x = LieDerivative f x + LieDerivative g x. +Lemma LieDerivativeMl {R : realType} n (f : 'rV_n.+1 -> R) (phi : 'rV[R]_n.+1 -> R -> 'rV_n.+1) + (x : 'rV[R]_n.+1) + (k : R) t : + (differentiable f (phi x t)) -> differentiable (phi x) t -> + LieDerivative (k *: f) phi x t = k *: LieDerivative f phi x t. Proof. -move=> dfx dgx. -rewrite /LieDerivative /jacobian1 !fctE /dotmul /jacobian. -apply/funext => t. -rewrite (_ : (fun x0 : 'rV_n.+1 => (f x0 + g x0)%:M) = - (fun x0 : 'rV_n.+1 => (f x0)%:M) + (fun x0 : 'rV_n.+1 => (g x0)%:M)); last first. - apply/funext => v //=. - apply/matrixP => i j. - by rewrite !mxE mulrnDl. -rewrite [X in ((lin1_mx X )^T *m ('D_1 x t)^T) 0 0 = _ ](@diffD K _ _ _ _ (x t)) ; last 2 first. - apply/differentiable_comp => //. - exact/differentiable_scalar_mx. - apply/differentiable_comp => //. - exact/differentiable_scalar_mx. -rewrite -trmx_mul. -rewrite ( _ : lin1_mx ('d _ (x t) \+ 'd _ (x t)) = - lin1_mx ('d (@scalar_mx _ _ \o f) (x t)) + lin1_mx ('d (@scalar_mx _ _ \o g) (x t))); last first. - apply/matrixP => i j. - rewrite mxE [RHS]mxE // [in LHS] /= [LHS]mxE. - by congr +%R; rewrite mxE. -rewrite [in LHS] mulmxDr /= mxE mxE. by congr +%R; - rewrite -trmx_mul [RHS]mxE. +move=> dfx dpx. +rewrite LieDerivative_derive; last 2 first. + apply: differentiable_comp => //=. + done. +rewrite deriveZ/=; last first => //=. + apply: diff_derivable => //=. + rewrite -fctE. + apply: differentiable_comp => //=. +congr (_ *: _). +rewrite LieDerivative_derive//=. +Qed. + +Lemma LieDerivativeD {R : realType} n (f g : 'rV_n.+1 -> R) (phi : 'rV[R]_n.+1 -> R -> 'rV_n.+1) (x : 'rV_n.+1) t : + (differentiable f (phi x t)) -> differentiable g (phi x t) -> + differentiable (phi x) t -> + LieDerivative (f + g) phi x t = LieDerivative f phi x t + LieDerivative g phi x t. +Proof. +move=> dfx dgx difp. +rewrite LieDerivative_derive; last 2 first. + by apply: differentiableD => //=. + done. +rewrite deriveD/=; last 2 first. + apply: diff_derivable => //. + rewrite -fctE . + by apply: differentiable_comp => //=. + apply: diff_derivable => //. + rewrite -fctE . + by apply: differentiable_comp => //=. +rewrite LieDerivative_derive; last 2 first. + by []. + by []. +rewrite LieDerivative_derive; last 2 first. + by []. + by []. +by []. Qed. Lemma derivative_LieDerivative_eq0 {K : realType} n - (f : 'rV_n.+1 -> K) (x : K -> 'rV[K]_n.+1) (t : K) : - derivable x t 1 -> - 'D_1 x t = 0 -> LieDerivative f x t = 0. + (phi : 'rV[K]_n.+1 -> K -> 'rV_n.+1) + (f : 'rV_n.+1 -> K) (x : 'rV[K]_n.+1) (t : K) : + (differentiable f (phi x t)) -> + 'D_1 (phi x) t = 0 -> LieDerivative f phi x t = 0. Proof. move=> xt1 dtraj. rewrite /LieDerivative /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. @@ -225,155 +246,32 @@ Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). (* TODO version squared sans different de 0 *) -Lemma LieDerivative_norm {K : realType} (f : 'rV[K]_6 -> 'rV_3) - (x : K -> 'rV[K]_6) (t : K) : - differentiable f (x t) -> - differentiable x t -> (forall t, differentiable f t) -> - (forall x0 : 'rV_6, f x0 != 0) -> - LieDerivative (fun y => (norm (f y)) ^+ 2) x t = - (2%:R *: 'D_1 (f \o x) t *m (f (x t))^T) 0 0. -Proof. -rewrite /LieDerivative. -rewrite /jacobian1. -rewrite /dotmul. -rewrite -trmx_mul. -move => diff difx diff0 neq0. -rewrite -derivemxE; last first. - apply/differentiable_comp; last first. - exact: differentiable_scalar_mx. - rewrite -fctE /=. - apply: differentiableM; apply/differentiable_norm => //=. -have := derive_norm. -rewrite //=. -(*move=> /( congr1 (fun z => z t)).*) -rewrite -scalemxAl [X in _ -> _ = X]mxE. -move => <-//; last first. - apply/diff_derivable. - by apply: differentiable_comp. - by rewrite fctE //. -rewrite derive1Ml; last 1 first. - apply/diff_derivable. - under eq_fun do rewrite expr2. - apply: differentiableM => /=; - apply: (@differentiable_comp _ _ _ _ x (norm \o f)) => //; - by apply: differentiable_norm. -rewrite fctE /=. -rewrite mul1r. -rewrite !mxE. -rewrite derive1E. -transitivity ( ('D_('D_1 x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). - under eq_fun do rewrite scalar_mxM. - rewrite derive_mx ?mxE; last first. - apply: derivable_mulmx => //=; apply: derivable_scalar_mx; - by apply/diff_derivable; apply: differentiable_norm. - rewrite /=. - under [in RHS]eq_fun do rewrite expr2. - under eq_fun do rewrite -scalar_mxM. - by under eq_fun do rewrite mxE eqxx mulr1n. -rewrite deriveE ; last first. - by apply: differentiableM; apply: differentiable_norm => //. -rewrite derive_mx//=; last first. - by apply: diff_derivable. -rewrite deriveE ; last first. - apply: differentiableM => /=. - rewrite /norm. - (* differentiable norm needs to be generalized*) - apply: differentiable_comp; last first. - apply/derivable1_diffP. - apply/derivable_sqrt. - by rewrite dotmulvv expr2 mulr_gt0 // norm_gt0 //. - apply/derivable1_diffP. - by apply/derivable_dotmul => //=; - apply/derivable1_diffP; apply: differentiable_comp. - rewrite /norm. - apply: differentiable_comp; last first. - apply/derivable1_diffP. - apply/derivable_sqrt. - by rewrite dotmulvv expr2 mulr_gt0 // norm_gt0 //. - apply/derivable1_diffP. - by apply/derivable_dotmul => //=; - apply/derivable1_diffP; apply: differentiable_comp. -transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). - rewrite -derive_mx //=; last by apply: diff_derivable. - by rewrite deriveE. -rewrite -diff_comp //=. -rewrite -fctE /=. -by apply: differentiableM; by apply: differentiable_norm. -Qed. - -Lemma LieDerivative_norm_squared {K : realType} (f : 'rV[K]_6 -> 'rV_3) - (x : K -> 'rV[K]_6) (t : K) : - differentiable f (x t) -> - differentiable x t -> (forall t, differentiable f t) -> - LieDerivative (fun y => (norm (f y)) ^+ 2) x t = - (2%:R *: 'D_1 (f \o x) t *m (f (x t))^T) 0 0. +Lemma LieDerivative_norm {K : realType} n (f : 'rV[K]_n.+1 -> 'rV_n.+1) + (phi : 'rV[K]_n.+1 -> K -> 'rV_n.+1) + (x : 'rV[K]_n.+1) (t : K) : + differentiable f (phi x t) -> + differentiable (phi x) t -> + (forall t, differentiable f t) -> + (f (phi x t) != 0) -> + LieDerivative (fun y => (norm (f y)) ^+ 2) phi x t = + (2%:R *: 'D_1 (f \o phi x) t *m (f (phi x t))^T) 0 0. Proof. -rewrite /LieDerivative. -rewrite /jacobian1. -rewrite /dotmul. -rewrite -trmx_mul. -move => diff difx diff0. -rewrite -derivemxE; last first. - apply/differentiable_comp; last first. - exact: differentiable_scalar_mx. - apply/differentiable_norm_squared => //. -have := derive_norm_squared. -rewrite //=. -(*move=> /( congr1 (fun z => z t)).*) -rewrite -scalemxAl [X in _ -> _ = X]mxE. -move => <-//; last first. - apply/diff_derivable. - by apply: differentiable_comp. -rewrite derive1Ml; last 1 first. - apply/derivable_norm_squared. - apply/diff_derivable. - apply/differentiable_comp => //=. -rewrite fctE /=. -rewrite mul1r. -rewrite !mxE. -rewrite derive1E. -transitivity ( ('D_('D_1 x t) (fun y : 'rV_6 => (norm (f y) ^+ 2)) (x t)) ). - rewrite derive_mx ?mxE ; last first. - apply/diff_derivable. - apply/differentiable_comp => //=. - apply/differentiable_norm_squared => //=. - apply: differentiable_scalar_mx. - rewrite /=. -rewrite [in RHS]deriveE ; last first. - apply: differentiable_norm_squared => //. -rewrite derive_mx//=; last first. - by apply: diff_derivable. -rewrite deriveE ; last first. - under eq_fun do rewrite mxE eqxx //= mulr1n. - apply/differentiable_norm_squared => //. - rewrite -[in LHS]derive_mx //=; last by apply: diff_derivable. - rewrite [in LHS]deriveE; last first. - by []. - under eq_fun do rewrite mxE eqxx //= mulr1n. - rewrite -[in RHS]derive_mx //=; last by apply: diff_derivable. - rewrite [in RHS]deriveE; last first. - by []. - by []. -transitivity(('d (fun y : 'rV_6 => norm (f y) ^+ 2) (x t ) \o ('d x t)) 1). - rewrite derive_mx //=; last by apply: diff_derivable. - rewrite [in LHS]deriveE; last first. - apply/differentiable_norm_squared => //. - rewrite -derive_mx //=; last by apply: diff_derivable. - rewrite [in LHS]deriveE; last first. - by []. - by []. -rewrite -diff_comp; last 2 first. - by []. - apply/differentiable_norm_squared => //. -rewrite fctE /=. -rewrite deriveE; last first. - under eq_fun do rewrite expr2 -expr2. - apply/derivable1_diffP. - apply/derivable_norm_squared => //. - apply/diff_derivable. +move => diffp difpx difft0 neq0. +rewrite LieDerivative_derive => //=; last first. + apply: differentiable_norm_squared => //=. +rewrite -derive1E /=. +rewrite fctE. +replace (fun x0 : K => norm (f (phi x x0)) ^+ 2) + with ((1 \*o (GRing.exp (R:=K))^~ 2 \o norm) \o (f \o phi x)); last first. + rewrite !fctE. rewrite -fctE. - apply/differentiable_comp => //. -by under [in RHS]eq_fun do rewrite expr2 -expr2. + apply/funext => s. + by rewrite /= /GRing.exp mul1r. +rewrite derive_norm_squared => //=; last first. + apply: diff_derivable=> //=. + apply: differentiable_comp => //=. +rewrite mulrDl mul1r scalerDl scale1r mulmxDl. +by rewrite [in RHS]mxE. Qed. End LieDerivative. @@ -387,10 +285,10 @@ Section ode_equation. Context {K : realType} {n : nat}. Let T := 'rV[K]_n.+1. -Variable f : (K -> T) -> K -> T. +Variable phi : (K -> T) -> K -> T. -Definition solves_equation (z : K -> T) (A : set T) : Prop := - z 0 \in A /\ (forall t, derivable z t (1:K)%R) /\ forall t, 'D_1 z t = f z t. +Definition solves_equation (x : K -> T) (A : set T) : Prop := + x 0 \in A /\ (forall t, derivable x t (1:K)%R) /\ forall t, 'D_1 x t = phi x t. Definition is_equilibrium_point x := solves_equation (cst x). @@ -399,24 +297,20 @@ Definition equilibrium_points A := [set p : T | is_equilibrium_point p A ]. Definition state_space A := [set p : T | exists y, solves_equation y A /\ exists t, p = y t ]. -Definition is_stable_equilibrium_at - (A : set T) (x : T) - (z : K -> 'rV[K]_n.+1) - (solve_z : solves_equation z A):= - is_equilibrium_point x A /\ +Definition equilibrium_is_stable_at + (A : set T) (x : T) (z : K -> 'rV[K]_n.+1) := forall eps, eps > 0 -> exists2 d, d > 0 & (`| z 0 - x | < d -> forall t, t >= 0 -> `| z t - x | < eps). -Definition is_stable_equilibrium +(*Definition is_stable_equilibrium (A : set T) (x : T) := - forall z (solves_z : solves_equation z A), is_stable_equilibrium_at x solves_z. + forall z (solves_z : solves_equation z A), is_stable_equilibrium_at x solves_z.*) (* a voir*) -Definition is_asymptotically_stable_equilibrium - (A : set T) (x : T) : Prop := - is_stable_equilibrium A x /\ - forall z, solves_equation z A -> + +Definition equilibrium_is_asymptotically_stable_at + (A : set T) (x : T) (z : K -> 'rV[K]_n.+1) : Prop := exists2 d, d > 0 & (`| z 0 - x | < d -> z t @[t --> +oo] --> x). @@ -426,27 +320,6 @@ End ode_equation. (* preuve qui repose sur la continuite et la monotonie via locpos continument differentiable V*) -Definition traj_lin {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (x : 'rV[K]_n.+1) (t : K) := - x + t *: (f (cst x) 0). - -Definition LieDerivative_at {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (V : 'rV[K]_n.+1 -> K) - (x : 'rV[K]_n.+1) := - LieDerivative V (traj_lin f x) 0. - -Lemma LieDerivative_traj1 {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (traj1 : K -> 'rV[K]_n.+1) - (D : set 'rV[K]_n.+1) - (V : 'rV[K]_n.+1 -> K) : - solves_equation f traj1 D -> - forall t0, traj1 t0 \in D -> - LieDerivative V traj1 t0 = LieDerivative_at f V (traj1 t0). -Admitted. - From mathcomp Require Import normedtype. From mathcomp Require Import matrix_normedtype. @@ -477,28 +350,28 @@ Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n.+1) : Proof. by move=> e0; rewrite closed_ballE. Qed. - -Theorem Lyapunov_stability0 {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (traj1 : K -> 'rV[K]_n.+1) +(* continuously differentiable*) +Theorem Lyapunov_stability {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (sol : 'rV_n.+1 -> K -> 'rV[K]_n.+1) (D : set 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) - (fdtraj : solves_equation f traj1 D) - (traj10 : traj1 0 \in D) - (Vx0 : is_lyapunov_candidate V D 0) - (V'le_0 : forall x, x \in D -> LieDerivative_at f V x <= 0) : + (fdtraj : forall x0, x0 \in D -> solves_equation f (sol x0) D) + (x : 'rV[K]_n.+1 := 0) + (Vx0 : is_lyapunov_candidate V D x) (*contient l'hypothese x in D*) + (t : K) + (V'le_0 : forall s t, s \in D -> LieDerivative V sol s t <= 0) : is_equilibrium_point f 0 D -> - is_stable_equilibrium_at 0 fdtraj. -(* todo: systeme autonome, trajectoire pointwise *) + equilibrium_is_stable_at D x (sol x). Proof. move => eq. -rewrite /is_stable_equilibrium. -split => //=. move => eps eps0. rewrite /is_lyapunov_candidate in Vx0. move: Vx0 => [/= Vloc Vdiff]. -rewrite /locposdef in Vloc. -move: Vloc => [/= inD [V0 [openD z]]]. +move: Vloc => [/= inD [V0 [openD z1]]]. +have init : forall y, sol y 0 = y. + move => y. + by admit. have : exists r : K, 0 < r /\ r <= eps /\ closed_ball_ (fun x => `|x|) (0:'rV[K]_n.+1) r `<=` D. rewrite inE in inD. have [r0 /= Hr0D] := open_subball openD inD. @@ -536,14 +409,15 @@ have : exists r : K, 0 < r /\ r <= eps /\ closed_ball_ (fun x => `|x|) (0:'rV[K] have Hcont := differentiable_continuous Vdiff. move=> [r [r_pos [r_le_eps Br_sub_D]]]. pose sphere_r := [set x : 'rV[K]_n.+1 | `|x| = r]. -have Halpha : {x : 'rV[K]_n.+1 | forall y, y \in sphere_r -> V(x) <= V(y)}. +have Halpha : {x : 'rV[K]_n.+1 | x \in sphere_r /\ forall y, y \in sphere_r -> V(x) <= V(y)}. (* extreme value theorem?*) +(* sphere must be compact*) admit. pose alpha := V (sval Halpha). have alpha_gt0 : 0 < alpha. have sphere_pos: forall y, y \in sphere_r -> 0 < V y. move=> y hy. - apply: z; last first. + apply: z1; last first. rewrite gtr0_norm_neq0 //. move: hy. by rewrite inE /sphere_r/= => ->. @@ -552,204 +426,294 @@ have alpha_gt0 : 0 < alpha. rewrite /closed_ball_/= sub0r. move : hy. by rewrite inE /sphere_r/= normrN => ->. - rewrite /alpha. - rewrite sphere_pos => //. + rewrite /alpha sphere_pos => //. rewrite /sphere_r inE/=. - admit. + have Hsval := svalP Halpha. + move: Hsval => [/= Hsphere _]. + move : Hsphere. + rewrite inE. + move => Hsphere. + exact: Hsphere. have: exists beta, 0 < beta < alpha. rewrite /=. exists (alpha / 2). rewrite divr_gt0 //=. - rewrite ltr_pdivrMr. + rewrite ltr_pdivrMr => //=. rewrite mulr2n mulrDr mulr1. by rewrite ltrDl. - by []. move=> [beta Hbeta]. -set ball_r := [set x : 'rV[K]_n.+1 | `|x| < r]. -set Omega_beta := [set x : 'rV[K]_n.+1 | (ball 0 r) x /\ V x <= beta]. -have HOmega_beta : Omega_beta `<=` interior (ball 0 r). - rewrite /Omega_beta /ball_r. - move=> x [Hx mini]. - have open_ball_r := ball_open 0 r_pos. - have int : ball 0 r `<=` (ball 0 r)°. - move => t. - rewrite -open_subsetE. - done. - (*apply (open_ball_r t).*) - admit. - apply: int. - exact: Hx. -have H1 : traj1 0 \in Omega_beta -> forall t, t >= 0 -> traj1 t \in Omega_beta. - move => traj10Omega. - have H : forall x, x \in D -> LieDerivative_at f V x <= 0 -> forall t : K, t >= 0 -> V (traj1 t) <= V (traj1 0) <= beta. - move => x xinD Lie0 t t0. - rewrite /is_equilibrium_point /solves_equation /= in eq. - rewrite /locnegsemidef. - have Vneg_incr: forall s1 s2, 0 <= s1 <= s2 -> V (traj1 s2) <= V (traj1 s1). - move=> s1 s2 Hs1_pos. - apply: (@ler0_derive1_nincr _ (fun s => V (traj1 s)) 0 s2). - move=> s Hs_in. - have Dz: derivable traj1 s 1. - move : fdtraj. - rewrite /solves_equation. - move=> [Hz0inA [Hder Hdz]]. - exact: (Hder s). - apply: diff_derivable. - rewrite -fctE. - apply: differentiable_comp; last first. - admit. - by apply/derivable1_diffP. - move=> s Hs_in. - admit. - admit. - move: Hs1_pos => /andP [H0s1 Hs1s2]. - apply: H0s1. - move: Hs1_pos => /andP [H0s1 Hs1s2]. - apply: Hs1s2. - done. - have H1 : V (traj1 t) <= V (traj1 0). - apply: Vneg_incr. - apply/andP; split. - done. - by []. - apply/andP; split. - by []. - move: traj10Omega. - rewrite inE. - move => traj10Omega. - by case: traj10Omega. - move => t t0. +set Omega_beta := [set x : 'rV[K]_n.+1 | (closed_ball_ [eta normr])``_r x /\ V x <= beta]. +have HOmega_beta : Omega_beta `<=` interior (closed_ball_ [eta normr])``_r. + rewrite /Omega_beta. + move=> x1 [Hx mini]. + rewrite -closed_ballAE /=. + rewrite interior_closed_ballE => //=. + rewrite /Omega_beta /=. + have Hnorm_le : `|x1| <= r. + move : Hx. + rewrite /closed_ball_ /ball. + under eq_fun do rewrite sub0r normrN. + move => Hx. + by apply: Hx. + case: (ltgtP (`|x1|) r) => [Hlt | Heq | Hgt]. + by rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN; apply Hlt. + exfalso. + have Hrr : r < r by apply: (lt_le_trans Heq Hnorm_le). + by move: Hrr; rewrite ltxx. + have xin_sphere : x1 \in sphere_r. + rewrite /sphere_r inE. + by apply: Hgt. + have Vx_ge_alpha : alpha <= V x1. + rewrite /alpha. + case: (svalP Halpha) => [Hy_sphere Hy_min]. + apply: Hy_min. + exact: xin_sphere. + exfalso. + move: mini Hbeta => HleVx [/andP [Hbeta_pos Hbeta_lt]]. + have : alpha <= V x1 <= beta. + by apply/andP; split. + have : alpha <= beta by apply: (le_trans Vx_ge_alpha HleVx). + move=> Hle_alpha_beta alphavxbeta. + have Hbb : beta < beta by apply: (lt_le_trans Hbeta_lt Hle_alpha_beta). + by move : Hbb; rewrite ltxx. + by exact: r_pos. +have H1 : forall t, sol x 0 \in Omega_beta -> t >= 0 -> sol x t \in Omega_beta. + move => t0 xOmega t00 . + have H2 : forall x t, x \in Omega_beta -> t >= 0 -> LieDerivative V sol x t <= 0 -> V (sol x t) <= V (sol x 0) <= beta. + move => x1 t1 x1Omega t10 Lie0. + have Vneg_incr: forall s1 s2, 0 <= s1 <= s2 -> forall x, x \in D -> V (sol x s2) <= V (sol x s1). + move=> s1 s2 Hs1_pos x2 xinD . + apply: (@ler0_derive1_nincr _ (fun s => V (sol x2 s)) 0 s2) => //. + - rewrite -fctE. + move => x3 x1in. + apply: diff_derivable. + apply: differentiable_comp; last first. + (* continuity*) + admit. + admit. + - move=> s Hs_in. + (* TODO *) + (* LEMMA*) + move : (V'le_0 x2 s xinD ). + rewrite LieDerivative_derive; last 2 first. + admit. + admit. + rewrite derive1E /=. + rewrite fctE. + by []. + - admit. + - move: Hs1_pos => /andP [H0s1 Hs1s2]. + by apply: H0s1. + - move: Hs1_pos => /andP [H0s1 Hs1s2]. + by apply: Hs1s2 => //=. + have H3 : V (sol x1 t1) <= V (sol x1 0). + apply: Vneg_incr => //=. + apply/andP; split => //=. + rewrite inE. + apply: Br_sub_D. + move : x1Omega. + rewrite inE. + rewrite /Omega_beta. + move => [clo Vxb]. + by apply: clo. + apply/andP; split => //=. + move : x1Omega. + rewrite inE /Omega_beta. + move=> [clo Vxb]. + have -> : sol x1 0 = x1. + by apply: init. + by []. rewrite inE. - split; last first. - have /andP [Hle1 Hle2] := H (traj1 0) traj10 (V'le_0 _ traj10) t t0. - by apply: (le_trans Hle1 Hle2). + have V_bound := H2 x t0 _ t00 (V'le_0 _ t0 _). + split; last first => //=. + have x0_in_D : sol x 0 \in D. + rewrite inE. + apply: (Br_sub_D). + move: xOmega. + rewrite inE. + move => [Hball _]. + exact: Hball. + rewrite init in xOmega. + have Vchain := V_bound xOmega inD. + have /andP [Vt0_le_V0 V0_le_beta] := Vchain. + exact: le_trans Vt0_le_V0 V0_le_beta. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. + have Hx0: (sol x 0) \in closed_ball_ [eta normr] 0 r. + rewrite inE. + case: xOmega. + rewrite inE. + case. + move => etc Vxb. + by []. have compact_Omega_beta : compact Omega_beta. rewrite /Omega_beta. - Search compact. + (* use compact_closedI? *) apply: bounded_closed_compact. - Search bounded_set. - admit. - apply: closedI. - rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. - rewrite /=. - move => t1 clo. - move : clo. - - admit. - rewrite /=. - Search closed_ball. - apply: closed_comp; last first. - move => t1 clos //=. - admit. - rewrite /=. - admit. -have V_traj_le_beta : V (traj1 t) <= V (traj1 0) <= beta. - apply: H. - exact: traj10. - apply: V'le_0; exact: traj10. - exact: t0. -have traj1t_in_Omega : traj1 t \in Omega_beta. -rewrite /Omega_beta. -rewrite inE. -split. - admit. - admit. -move : traj1t_in_Omega. -rewrite inE /Omega_beta. -move =>bla. -case : bla => Hball _. -done. -have [delta0 Hdelta0] : exists d, d > 0 /\ forall x, `|x| < d -> V x < beta. + - rewrite /bounded_set /= /globally. + exists r => //=. + split => //=. + move => x1 rx x2. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. + move=> [/= x0_le_r ?]. + apply: le_trans x0_le_r _. + exact: ltW rx. + - apply: closedI. + rewrite -closed_ballAE=> //=. + by apply: closed_ball_closed => //=. + rewrite /=. + rewrite [X in closed X](_ : _ = V @^-1` [set x : K | x <= beta]); last first. + by apply/seteqP; split. + apply: closed_comp => //=. + (* continuity*) + admit. + (* TODO *) + admit. +have [delta0 Hdelta0] : exists d, d > 0 /\ forall x, `|x| <= d -> V x < beta. rewrite /=. (* continuity*) admit. pose delta := Num.min delta0 r. -have Hdelta : 0 < delta /\ (forall x, `|x| < delta -> V x < beta). +have Hdelta : 0 < delta /\ (forall x, `|x| <= delta -> V x < beta). split. rewrite /delta /minr. - case: (delta0 < r) => //. + case: (delta0 < r) => //=. exact: Hdelta0.1. rewrite /=. - move => x xdel. + move => x1 xdel. move: Hdelta0 => [Hdelta0_pos Hdelta0_prop]. -have x_lt_delta0: `|x| < delta0. -rewrite /delta in xdel. -apply: lt_le_trans xdel _. -rewrite /minr. - case: (delta0 < r) => //. - apply: ltW. +have x_lt_delta0: `|x1| <= delta0. +rewrite /delta /minr in xdel. +apply: le_trans xdel _. + case: (delta0 < r) => //=. + (* dont know, continuity?*) admit. by apply: Hdelta0_prop. -have inclusion : ball 0 delta `<=` Omega_beta /\ Omega_beta `<=` ball 0 r. - split; last first. - apply: subset_trans HOmega_beta _. - by apply: interior_subset. +have inclusion : (closed_ball_ [eta normr])``_delta `<=` Omega_beta /\ Omega_beta `<=` (closed_ball_ [eta normr])``_r . + split; last first => //=. + apply: subset_trans HOmega_beta _. + rewrite -closed_ballAE /=. + rewrite interior_closed_ballE => //=. + by apply: subset_closed_ball. + by apply: r_pos. rewrite /Omega_beta. - apply/subsetP => x Hx. + apply/subsetP => x1 Hx. rewrite inE. - split; last first. - have [/= Hdelta_pos Hdelta_bound] := Hdelta. + split; last first => //=. + have [/= Hdelta_Le_Rpos Hdelta_bound] := Hdelta. move: Hx. rewrite inE. - rewrite mx_norm_ball. - rewrite /ball_. - under eq_fun do rewrite sub0r normrN. - move => Hx. - have Vx_lt_beta := Hdelta_bound _ Hx. - by apply: ltW. - rewrite mx_norm_ball. - rewrite /ball_; under eq_fun do rewrite sub0r normrN. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. + move => Hx. + apply: ltW. + by have Vx_lt_beta := Hdelta_bound _ Hx. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. have delta_le_r: delta <= r. - rewrite /delta. - rewrite /minr. - case: ifP => Hlt. + rewrite /delta. + rewrite /minr. + case: ifP => Hlt => //. by rewrite ltW. - by []. rewrite inE in Hx. move : Hx. - rewrite mx_norm_ball. - rewrite /ball_; under eq_fun do rewrite sub0r normrN. - move=> Hball . - by apply: lt_le_trans Hball delta_le_r. -have inclusion2 : (ball 0 delta) (traj1 0) -> traj1 0 \in Omega_beta -> forall t, t >= 0 -> traj1 t \in - Omega_beta -> (ball 0 r) (traj1 t). - move => ball0 traj10in t t0 traj1tin. - by move: traj1tin; rewrite /Omega_beta inE => [] [Hball _]. -have Hlast : `|traj1 0| < delta -> forall t : K , t >=0 -> `|traj1 t| < r <= eps. - move => traj10delta t t0. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. + move => Hball. + move: Hball delta_le_r => /= Hx_lt_delta Hdelta_le_r. + by apply: (le_trans (Hx_lt_delta) Hdelta_le_r). +have inclusion2 : ((closed_ball_ [eta normr])``_delta) (sol x 0) -> sol x 0 \in Omega_beta -> forall t, t >= 0 -> sol x t \in + Omega_beta -> ((closed_ball_ [eta normr])``_r) (sol x t). + move => ball0 sol0in t1 t2 soltin. + by move: soltin; rewrite /Omega_beta inE => [] [Hball _]. +rewrite /x !subr0. +have Hlast : `|sol x 0| < delta -> forall t : K , t >=0 -> `|sol x t| < r <= eps. + move => sol0delta t1 t2. case: inclusion => [Hin_ball_delta _]. - have traj1_in_Omega : traj1 0 \in Omega_beta. - rewrite inE. - apply: Hin_ball_delta; rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN; exact: traj10delta. -have traj1t_in_Omega := H1 traj1_in_Omega t t0. -rewrite /Omega_beta inE in traj1t_in_Omega. -case: traj1t_in_Omega => [Hball_traj1t _]. -move : Hball_traj1t. -rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. -move => Hball_traj1t. -apply/andP; split. -apply: Hball_traj1t. -exact : r_le_eps. + have sol_in_Omega : sol x 0 \in Omega_beta. + rewrite inE. + apply: Hin_ball_delta. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN; apply/ltW; exact: sol0delta. + rewrite /Omega_beta inE in sol_in_Omega. + case: sol_in_Omega => [Hball_solt _]. + move : Hball_solt. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. + move => Hball_solt. + have : ((closed_ball_ [eta normr])``_r)° (sol x t1). + apply: ( HOmega_beta). + rewrite -inE. + have xinO : sol x 0 \in Omega_beta. + rewrite inE. + rewrite /Omega_beta. + split => //=. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. + exact: Hball_solt. + have x00 : sol x 0 = x by rewrite init => //=. + have z0_in_ball : (closed_ball_ [eta normr])``_delta (sol x 0). + rewrite /closed_ball_; apply: ltW. + rewrite sub0r normrN. + by apply: sol0delta. + move : (Hin_ball_delta _ z0_in_ball). + by move => [clo Vxb]. + + apply: H1; first exact : xinO. + exact: t2. + rewrite -closed_ballAE => //=. + rewrite interior_closed_ballE => //=. + rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. + move => etc. + by apply/andP; split => //. exists delta. -by case: Hdelta. -rewrite !subr0. -move=> Hnorm t Ht. -rewrite subr0. -have /andP [Hlt Hle] := Hlast Hnorm t Ht. -by apply: (lt_le_trans Hlt Hle). + by case: Hdelta. +move=> x0_lt_delta t0 t0_ge0. +rewrite /x subr0. +(* sol? z ?*) +have Htraj0 : `|sol x t0| < r. + rewrite /Omega_beta. + have x0_in_Omega : x \in Omega_beta. + rewrite inE. + apply: inclusion.1. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. + apply: ltW. + rewrite /x. + rewrite init in x0_lt_delta. + by apply: x0_lt_delta. + have sol_in_Omega : sol x t0 \in Omega_beta. + apply: H1 => //=. + rewrite init. + exact: x0_in_Omega; exact: t0_ge0. + rewrite /Omega_beta inE in sol_in_Omega. + case: sol_in_Omega => Hnorm _. + move : Hnorm. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. + move => Hnorm. + have traj_in_Omega: sol x t0 \in Omega_beta. + apply: H1. + rewrite init. + exact: x0_in_Omega. + exact: t0_ge0. + have in_interior: ((closed_ball_ [eta normr])``_r)° (sol x t0). + apply: HOmega_beta. + rewrite -inE. + exact: traj_in_Omega. + move: in_interior. + rewrite -closed_ballE /=. + rewrite interior_closed_ballE => //=. + rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. + apply => //=. + exact : r_pos. +rewrite init in x0_lt_delta. +by apply: (lt_le_trans Htraj0 r_le_eps). + Admitted. Theorem Lyapunov_stability {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (traj1 : K -> 'rV[K]_n.+1) + (sol : K -> 'rV[K]_n.+1) (x0 : 'rV[K]_n.+1) (D : set 'rV[K]_n.+1) (x0inD : x0 \in D) (V : 'rV[K]_n.+1 -> K) - (fdtraj : solves_equation f traj1 D) (* continuously diff*) - (traj10 : traj1 0 \in D) + (fdtraj : solves_equation f sol D) (* continuously diff*) + (sol0 : sol 0 \in D) (Vx0 : is_lyapunov_candidate V x0) - (V'le_0 : LieDerivative V traj1 0 <= 0): + (V'le_0 : LieDerivative V sol 0 <= 0): is_equilibrium_point f x0 D -> is_stable_equilibrium_at x0 fdtraj. Proof. @@ -762,10 +726,10 @@ Theorem Lyapunov_asymptotic_stability {K : realType} {n} (V : 'rV[K]_n.+1 -> K) (x0 : 'rV[K]_n.+1) : (is_equilibrium_point f x0 A /\ is_lyapunov_candidate V x0) -> - (forall traj1 : (K -> 'rV[K]_n.+1), - solves_equation f traj1 A -> - locnegsemidef (LieDerivative V traj1) 0 -> - traj1 0 = x0 ) -> + (forall sol : (K -> 'rV[K]_n.+1), + solves_equation f sol A -> + locnegsemidef (LieDerivative V sol) 0 -> + sol 0 = x0 ) -> is_asymptotically_stable_equilibrium f A x0. Proof. move => [eq [lya dif]] Htraj. diff --git a/tilt_analysis.v b/tilt_analysis.v index 65fd2f35..b8dc5552 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -62,7 +62,7 @@ apply: derive_val. exact: is_derive1_sqrt. Qed. -Lemma differentiable_scalar_mx {R : realType} n (r : R) : +Lemma differentiable_scalar_mx {R : realFieldType} n (r : R) : differentiable (@scalar_mx _ n.+1) r. Proof. apply/derivable1_diffP/cvg_ex => /=. From c82a96dd72ecec4ad19193ab9303939d01445bc7 Mon Sep 17 00:00:00 2001 From: Lynda Bentoucha Date: Fri, 19 Sep 2025 15:35:03 +0900 Subject: [PATCH 051/144] fix compilation of tilt.v --- tilt.v | 446 +++++++++++++++++++++++++++++++++------------------------ 1 file changed, 257 insertions(+), 189 deletions(-) diff --git a/tilt.v b/tilt.v index fe75fefe..d63bafec 100644 --- a/tilt.v +++ b/tilt.v @@ -246,17 +246,16 @@ Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). (* TODO version squared sans different de 0 *) -Lemma LieDerivative_norm {K : realType} n (f : 'rV[K]_n.+1 -> 'rV_n.+1) +Lemma LieDerivative_norm {K : realType} n m (f : 'rV[K]_n.+1 -> 'rV_m.+1) (phi : 'rV[K]_n.+1 -> K -> 'rV_n.+1) (x : 'rV[K]_n.+1) (t : K) : differentiable f (phi x t) -> differentiable (phi x) t -> (forall t, differentiable f t) -> - (f (phi x t) != 0) -> LieDerivative (fun y => (norm (f y)) ^+ 2) phi x t = (2%:R *: 'D_1 (f \o phi x) t *m (f (phi x t))^T) 0 0. Proof. -move => diffp difpx difft0 neq0. +move => diffp difpx difft0 . rewrite LieDerivative_derive => //=; last first. apply: differentiable_norm_squared => //=. rewrite -derive1E /=. @@ -351,26 +350,26 @@ Proof. by move=> e0; rewrite closed_ballE. Qed. (* continuously differentiable*) +(* trajectory wise *) Theorem Lyapunov_stability {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (sol : 'rV_n.+1 -> K -> 'rV[K]_n.+1) (D : set 'rV[K]_n.+1) - (V : 'rV[K]_n.+1 -> K) - (fdtraj : forall x0, x0 \in D -> solves_equation f (sol x0) D) + (sol : 'rV_n.+1 -> K -> 'rV[K]_n.+1) (x : 'rV[K]_n.+1 := 0) - (Vx0 : is_lyapunov_candidate V D x) (*contient l'hypothese x in D*) - (t : K) - (V'le_0 : forall s t, s \in D -> LieDerivative V sol s t <= 0) : - is_equilibrium_point f 0 D -> + (fsolD : forall z, z \in D -> solves_equation f (sol z) D) + (V : 'rV[K]_n.+1 -> K) + (VDx : is_lyapunov_candidate V D x) (*contient l'hypothese x in D*) + (V'le_0 : forall phi, solves_equation f phi D -> forall t, t >= 0 -> LieDerivative V sol (phi 0) t <= 0) + (Vderiv : forall t, differentiable V t) : + is_equilibrium_point f x D -> equilibrium_is_stable_at D x (sol x). Proof. move => eq. move => eps eps0. -rewrite /is_lyapunov_candidate in Vx0. -move: Vx0 => [/= Vloc Vdiff]. +rewrite /is_lyapunov_candidate in VDx. +move: VDx => [/= Vloc Vdiff]. move: Vloc => [/= inD [V0 [openD z1]]]. -have init : forall y, sol y 0 = y. - move => y. +have init : forall x, sol x 0 = x. by admit. have : exists r : K, 0 < r /\ r <= eps /\ closed_ball_ (fun x => `|x|) (0:'rV[K]_n.+1) r `<=` D. rewrite inE in inD. @@ -477,10 +476,26 @@ have HOmega_beta : Omega_beta `<=` interior (closed_ball_ [eta normr])``_r. have Hbb : beta < beta by apply: (lt_le_trans Hbeta_lt Hle_alpha_beta). by move : Hbb; rewrite ltxx. by exact: r_pos. -have H1 : forall t, sol x 0 \in Omega_beta -> t >= 0 -> sol x t \in Omega_beta. - move => t0 xOmega t00 . - have H2 : forall x t, x \in Omega_beta -> t >= 0 -> LieDerivative V sol x t <= 0 -> V (sol x t) <= V (sol x 0) <= beta. - move => x1 t1 x1Omega t10 Lie0. +have uniqueness_of_solution : forall (phi1 phi2 : K -> 'rV_n.+1) (x0 : 'rV_n.+1), + solves_equation f phi1 D -> + solves_equation f phi2 D -> + phi1 0 = x0 -> phi2 0 = x0 -> + phi1 = phi2 by admit. +have H1 : forall phi , solves_equation f phi D -> phi 0 \in Omega_beta -> forall t, 0 <= t -> phi t \in Omega_beta. + move => phi solves xOmega t t0. +have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi 0) u <= 0 -> + V (sol (phi 0) t) <= V (sol (phi 0) 0) <= beta. +(* have H2 : forall t, t >= 0 -> LieDerivative V phi x t <= 0 -> V (sol x t) <= V (sol x 0) <= beta.*) + move => t1 t10 u u10. + have -> : phi = sol (phi 0). + apply: uniqueness_of_solution => //=. + apply: fsolD => //. + rewrite inE. + apply: Br_sub_D => //. + move : xOmega. + rewrite inE /Omega_beta. + by move => [H1 H2]. + rewrite !init /=. have Vneg_incr: forall s1 s2, 0 <= s1 <= s2 -> forall x, x \in D -> V (sol x s2) <= V (sol x s1). move=> s1 s2 Hs1_pos x2 xinD . apply: (@ler0_derive1_nincr _ (fun s => V (sol x2 s)) 0 s2) => //. @@ -488,64 +503,132 @@ have H1 : forall t, sol x 0 \in Omega_beta -> t >= 0 -> sol x t \in Omega_beta. move => x3 x1in. apply: diff_derivable. apply: differentiable_comp; last first. + apply: differentiable_comp => //. + (* continuity*) admit. - admit. - move=> s Hs_in. (* TODO *) (* LEMMA*) - move : (V'le_0 x2 s xinD ). - rewrite LieDerivative_derive; last 2 first. - admit. - admit. - rewrite derive1E /=. + move : (V'le_0 phi solves t t0). + rewrite LieDerivative_derive => //=; last first. + admit. + rewrite derive1E. rewrite fctE. - by []. - - admit. + pose phi2 := (fun t => sol x2 t). + have solves_phi2 : solves_equation f phi2 D by admit. + have s_pos : 0 <= s. + by move: Hs_in; case/andP => /ltW. + have deriv_le0 := V'le_0 phi2 solves_phi2 s s_pos. + move => H. + rewrite LieDerivative_derive /phi2 init in deriv_le0 => //. + admit. + admit. - move: Hs1_pos => /andP [H0s1 Hs1s2]. by apply: H0s1. - move: Hs1_pos => /andP [H0s1 Hs1s2]. by apply: Hs1s2 => //=. - have H3 : V (sol x1 t1) <= V (sol x1 0). + have H3 : V (sol x t1) <= V (sol x 0). apply: Vneg_incr => //=. - apply/andP; split => //=. - rewrite inE. - apply: Br_sub_D. - move : x1Omega. - rewrite inE. - rewrite /Omega_beta. - move => [clo Vxb]. - by apply: clo. + by apply/andP; split => //=. + move => bla. apply/andP; split => //=. - move : x1Omega. + move : xOmega. rewrite inE /Omega_beta. move=> [clo Vxb]. - have -> : sol x1 0 = x1. - by apply: init. + have Hdec := Vneg_incr 0 t1 _ (phi 0) _. + rewrite init in Hdec. + apply: Hdec => //=. + by apply/andP; split => //. + rewrite inE /Omega_beta. + apply: Br_sub_D => //. + move : xOmega. + rewrite inE /Omega_beta. + by move=> [clo Vxb]. + rewrite inE; split; last first. + have t00 : 0 <= t <= t. + apply/andP; split. by []. - rewrite inE. - have V_bound := H2 x t0 _ t00 (V'le_0 _ t0 _). - split; last first => //=. - have x0_in_D : sol x 0 \in D. - rewrite inE. - apply: (Br_sub_D). - move: xOmega. - rewrite inE. - move => [Hball _]. - exact: Hball. - rewrite init in xOmega. - have Vchain := V_bound xOmega inD. - have /andP [Vt0_le_V0 V0_le_beta] := Vchain. - exact: le_trans Vt0_le_V0 V0_le_beta. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - have Hx0: (sol x 0) \in closed_ball_ [eta normr] 0 r. - rewrite inE. - case: xOmega. - rewrite inE. - case. - move => etc Vxb. by []. - have compact_Omega_beta : compact Omega_beta. + have H_lie : LieDerivative V sol (phi 0) t <= 0. + apply V'le_0. + - exact solves. + - exact t0. + have V_bound := H2 t t0 t t00 H_lie. + move : V_bound. + rewrite !init. + have -> : sol (phi 0) = phi. + apply: uniqueness_of_solution => //. + apply: fsolD => //. + rewrite inE. + apply: Br_sub_D => //. + move : xOmega. + rewrite inE /Omega_beta. + by move => [h1 h2]. + case/andP => h1 h2. + by apply: (le_trans h1 h2). + move: xOmega. + rewrite inE /Omega_beta/=. + rewrite /closed_ball_/=. + rewrite !sub0r !normrN => -[] + Vxbeta. + (* axiomatiser thm 3.3 *) + move=> x0r. + move : HOmega_beta. + rewrite -closed_ballE /= => //. + rewrite interior_closed_ballE => //. + rewrite /Omega_beta. + rewrite /closed_ball_. + rewrite mx_norm_ball /ball_. + rewrite /= => /(_ (sol x t)). + under eq_fun do rewrite !sub0r normrN. + move => a. + rewrite leNgt. + apply/negP. + have : `|phi t| > r -> exists t0, t0 >=0 /\ `|phi t0 | = r. + (* continuity, TVI *) + by admit. + move => cont solxr. + have [t1 [t1_ge0 xt1r]] := cont solxr. + have : alpha <= V (phi t1). + rewrite {}/alpha in alpha_gt0 Hbeta *. + move: Halpha alpha_gt0 Hbeta. + case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. + apply. + by rewrite inE /sphere_r/=. + have H1 : V (phi t1) >= alpha. + have sol_in_sphere : phi t1 \in sphere_r. + rewrite inE. + by rewrite /sphere_r. + rewrite {}/alpha in alpha_gt0 Hbeta *. + move: Halpha alpha_gt0 Hbeta. + case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. + exact. + have H3 : beta < V (phi t1). + rewrite (lt_le_trans _ H1)//. + by case/andP : Hbeta. + have : V (phi t1) <= beta. + have : forall u, u >= 0 -> LieDerivative V sol (phi 0) u <= 0. + move => u u0. + apply V'le_0. + - exact solves. + - exact u0. + move : (H2 t1 t1_ge0). + move=> Ht1 Hderiv. +have Heq_sol_phi : sol (phi 0) = phi. + apply: uniqueness_of_solution => //. + apply : fsolD => //. + rewrite inE. + apply: Br_sub_D => //. + rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. + by apply: x0r. +rewrite Heq_sol_phi in Ht1. +have Vphi_le := Ht1 t1 _ _. +have t1_chain : 0 <= t1 <= t1. + apply/andP ; split; [exact: t1_ge0 | exact: lexx]. +move: (Vphi_le t1_chain (Hderiv t1 t1_ge0)) => [/andP [Vt1_le V0_le_beta]]. +by apply: (le_trans Vt1_le). + by rewrite leNgt H3. +have compact_Omega_beta : compact Omega_beta. rewrite /Omega_beta. (* use compact_closedI? *) apply: bounded_closed_compact. @@ -565,9 +648,7 @@ have H1 : forall t, sol x 0 \in Omega_beta -> t >= 0 -> sol x t \in Omega_beta. by apply/seteqP; split. apply: closed_comp => //=. (* continuity*) - admit. - (* TODO *) - admit. + admit. have [delta0 Hdelta0] : exists d, d > 0 /\ forall x, `|x| <= d -> V x < beta. rewrite /=. (* continuity*) @@ -575,19 +656,19 @@ have [delta0 Hdelta0] : exists d, d > 0 /\ forall x, `|x| <= d -> V x < beta. pose delta := Num.min delta0 r. have Hdelta : 0 < delta /\ (forall x, `|x| <= delta -> V x < beta). split. - rewrite /delta /minr. - case: (delta0 < r) => //=. - exact: Hdelta0.1. + rewrite /delta /minr. + case: (delta0 < r) => //=. + exact: Hdelta0.1. rewrite /=. move => x1 xdel. move: Hdelta0 => [Hdelta0_pos Hdelta0_prop]. -have x_lt_delta0: `|x1| <= delta0. -rewrite /delta /minr in xdel. -apply: le_trans xdel _. - case: (delta0 < r) => //=. - (* dont know, continuity?*) - admit. -by apply: Hdelta0_prop. + have x_lt_delta0: `|x1| <= delta0. + rewrite /delta /minr in xdel. + apply: le_trans xdel _. + case: (delta0 < r) => //=. + (* dont know, continuity?*) + admit. + by apply: Hdelta0_prop. have inclusion : (closed_ball_ [eta normr])``_delta `<=` Omega_beta /\ Omega_beta `<=` (closed_ball_ [eta normr])``_r . split; last first => //=. apply: subset_trans HOmega_beta _. @@ -651,9 +732,8 @@ have Hlast : `|sol x 0| < delta -> forall t : K , t >=0 -> `|sol x t| < r <= eps by apply: sol0delta. move : (Hin_ball_delta _ z0_in_ball). by move => [clo Vxb]. - - apply: H1; first exact : xinO. - exact: t2. + apply: H1 => //. + by apply: fsolD => //. rewrite -closed_ballAE => //=. rewrite interior_closed_ballE => //=. rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. @@ -676,6 +756,7 @@ have Htraj0 : `|sol x t0| < r. by apply: x0_lt_delta. have sol_in_Omega : sol x t0 \in Omega_beta. apply: H1 => //=. + by apply: fsolD => //. rewrite init. exact: x0_in_Omega; exact: t0_ge0. rewrite /Omega_beta inE in sol_in_Omega. @@ -683,11 +764,10 @@ have Htraj0 : `|sol x t0| < r. move : Hnorm. rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. move => Hnorm. - have traj_in_Omega: sol x t0 \in Omega_beta. - apply: H1. - rewrite init. - exact: x0_in_Omega. - exact: t0_ge0. + have traj_in_Omega : sol x t0 \in Omega_beta. + apply: H1 => //. + apply: fsolD => //. + by rewrite init. have in_interior: ((closed_ball_ [eta normr])``_r)° (sol x t0). apply: HOmega_beta. rewrite -inE. @@ -703,53 +783,22 @@ by apply: (lt_le_trans Htraj0 r_le_eps). Admitted. -Theorem Lyapunov_stability {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (sol : K -> 'rV[K]_n.+1) - (x0 : 'rV[K]_n.+1) +Theorem Lyapunov_asymptotic_stability {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) (D : set 'rV[K]_n.+1) - (x0inD : x0 \in D) + (sol : 'rV_n.+1 -> K -> 'rV[K]_n.+1) + (x : 'rV[K]_n.+1 := 0) + (fsolD : forall z, z \in D -> solves_equation f (sol z) D) (V : 'rV[K]_n.+1 -> K) - (fdtraj : solves_equation f sol D) (* continuously diff*) - (sol0 : sol 0 \in D) - (Vx0 : is_lyapunov_candidate V x0) - (V'le_0 : LieDerivative V sol 0 <= 0): - is_equilibrium_point f x0 D -> - is_stable_equilibrium_at x0 fdtraj. + (VDx : is_lyapunov_candidate V D x) (*contient l'hypothese x in D*) + (V'le_0 : forall phi, solves_equation f phi D -> forall t, t >= 0 -> LieDerivative V sol (phi 0) t <= 0) + (Vderiv : forall t, differentiable V t) : + is_equilibrium_point f x D -> + equilibrium_is_asymptotically_stable_at D x (sol x). Proof. -(* TODO (lynda, 2025-09-03) prove with lyapunov stability zero*) -Admitted. +move => eq. -Theorem Lyapunov_asymptotic_stability {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (A : set 'rV[K]_n.+1) - (V : 'rV[K]_n.+1 -> K) - (x0 : 'rV[K]_n.+1) : - (is_equilibrium_point f x0 A /\ is_lyapunov_candidate V x0) -> - (forall sol : (K -> 'rV[K]_n.+1), - solves_equation f sol A -> - locnegsemidef (LieDerivative V sol) 0 -> - sol 0 = x0 ) -> - is_asymptotically_stable_equilibrium f A x0. -Proof. -move => [eq [lya dif]] Htraj. -split. -rewrite /is_stable_equilibrium; split. -by []. Admitted. - -Definition is_lyapunov_stable_at {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (A : set 'rV[K]_n.+1) - (V : 'rV[K]_n.+1 -> K) - (x0 : 'rV[K]_n.+1) : Prop := - [/\ is_equilibrium_point f x0 A, - is_lyapunov_candidate V x0 & - forall traj1 : (K -> 'rV[K]_n.+1), - solves_equation f traj1 A -> - traj1 0 = x0 -> - locnegsemidef (LieDerivative V traj1) 0]. - (* see Appendix VII.A of https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) Section basic_facts. @@ -1354,7 +1403,7 @@ Hypothesis sol_correct : forall x0, ('D_1 fun t=> (sol x0 t)) = fun t => F1 (sol Definition tilt_eqn_interface (x : 'rV_6) (t : K) : 'rV_6 := tilt_eqn (fun _ => x) t. -Hypothesis invariant_gamma : is_invariant tilt_eqn_interface (state_space_tilt). (* a transformer en lemme*) +(*Hypothesis invariant_gamma : is_invariant tilt_eqn_interface (state_space_tilt). a transformer en lemme*) (* this lemma asks for lyapunov + lasalle *) Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation tilt_eqn y state_space_tilt -> @@ -1441,18 +1490,20 @@ Definition V1 (zp1_z2 : 'rV[K]_6) : K := let z2 := Right zp1_z2 in (norm zp1)^+2 / (2 * alpha1) + (norm z2)^+2 / (2 * gamma). -Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 point1. +Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 setT point1. Proof. rewrite /locposdef; split. - rewrite /V1 /point1 /locposdef; split. - by rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. -- near=> z_near. - simpl in *. - have z_neq0 : z_near != 0 by near: z_near; exact: nbhs_dnbhs_neq. - rewrite /V1. + by rewrite inE. + rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. + split. + by []. + split. + exact: openT. + move => z_near _ z0. have /orP[lz0|rz0] : (Left z_near != 0) || (Right z_near != 0). + rewrite -negb_and. - apply: contra z_neq0 => /andP[/eqP l0 /eqP r0]. + apply: contra z0 => /andP[/eqP l0 /eqP r0]. rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. by apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; rewrite mxE. + set rsub := Right z_near. @@ -1499,8 +1550,7 @@ Variable R : K -> 'M[K]_3. Hypothesis y0init: y0 0 \in state_space_tilt. Hypothesis y0sol : solves_equation (tilt_eqn alpha1 gamma) y0 state_space_tilt.*) -Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> - 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). +Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). Proof. move=> [/= traj0]. case. @@ -1563,39 +1613,36 @@ rewrite /zp1 /z2 hsubmxK /=. by apply:Gamma1_traj. Qed. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> (forall t, differentiable x t) -> - LieDerivative (V1 alpha1 gamma) x t = V1dot (x t). +Lemma deriveV1 (x : K -> 'rV[K]_6) t : + solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> (forall t, differentiable x t) -> + LieDerivative (V1 alpha1 gamma) (fun a => x) 0 t = V1dot (x t). Proof. rewrite /tilt_eqn. move=> tilt_eqnx dif1. rewrite /V1. -rewrite LieDerivativeD; last 2 first. - move=> t0. +rewrite LieDerivativeD; last 3 first. apply/differentiableM => //=. apply/differentiable_norm_squared => //. rewrite /tilt_eqn. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). by apply: differentiable_lsubmx. - move => t0. apply/differentiableM => //=. apply/differentiable_norm_squared => //=. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_rsubmx => //. -rewrite !invfM /=. -rewrite fctE. -under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. -rewrite LieDerivativeMl; last first. - move => t0. + by []. +under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. +rewrite LieDerivativeMl => //; last first. apply/differentiable_norm_squared. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_lsubmx => //. -rewrite LieDerivativeMl; last first. - move => t0. +rewrite LieDerivativeMl => //; last first. apply/differentiable_norm_squared => //=. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_rsubmx => //. -rewrite !fctE !LieDerivative_norm_squared /=; last 6 first. +rewrite -fctE /=. +rewrite !LieDerivative_norm /=; last 6 first. apply/differentiable_rsubmx => //. apply (dif1 t). move => t0. @@ -1604,7 +1651,10 @@ rewrite !fctE !LieDerivative_norm_squared /=; last 6 first. apply (dif1 t). move => t0. apply/differentiable_lsubmx => //. -by rewrite derive_V1dot. + rewrite -derive_V1dot. + rewrite /c1 /c2. + by rewrite !invfM. + by []. Qed. (* TODO: Section general properties of our system *) @@ -1693,29 +1743,29 @@ Lemma near0_le0 (traj : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> traj 0 = point1 -> \forall z \near 0^', - (LieDerivative (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) traj + - LieDerivative (fun x => norm (Right x) ^+ 2 / (2 * gamma)) traj) z <= 0. + (LieDerivative (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) (fun a=> traj) 0 + + LieDerivative (fun x => norm (Right x) ^+ 2 / (2 * gamma)) (fun a => traj) 0) z <= 0. Proof. move=> dtraj traj0. -rewrite !fctE !invfM /=. +rewrite fctE !invfM /=. near=> z. -under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. +under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. move: dtraj => [H0 [Hderiv Htilt]]. have Hz_derivable : derivable traj z 1. by apply: Hderiv. rewrite LieDerivativeMl; last first. - move => t. + by apply derivable1_diffP. apply/differentiable_norm_squared => //=; last first. (* en temps superieur a zero?*) apply/differentiable_lsubmx => //. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). rewrite LieDerivativeMl; last first. -move => t. + by apply derivable1_diffP. apply/differentiable_norm_squared; last first. apply/differentiable_rsubmx => //. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). -rewrite /= !fctE !LieDerivative_norm_squared; last 6 first. +rewrite /= !LieDerivative_norm; last 6 first. by apply/differentiable_rsubmx => //. by apply/derivable1_diffP => //. move => t. @@ -1744,53 +1794,53 @@ Qed. Lemma V1_point_is_lnsd (y : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt-> y 0 = point1 -> - locnegsemidef (LieDerivative (V1 alpha1 gamma) y) 0. + locnegsemidef (LieDerivative (V1 alpha1 gamma) (fun a => y) 0 ) 0. Proof. move=> [y033] [dy dtraj] traj0. have Gamma1_traj t : state_space_tilt (y t). apply/Gamma1_traj. by split => //. rewrite /locnegsemidef /V1. -rewrite LieDerivativeD /=; last 2 first. - move => t. +rewrite LieDerivativeD /=; last 3 first. apply: differentiableM; last 2 first. rewrite /=. apply: differentiable_norm_squared; last 2 first. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_lsubmx => //. apply: differentiable_cst; last first. - move => t. apply: differentiableM; last 2 first. apply: differentiable_norm_squared=> //. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_rsubmx => //. apply: differentiable_cst. + by apply derivable1_diffP. split; last first. - apply/near0_le0; last by []. - by split => //. -rewrite !invfM /=. -rewrite !fctE. -under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. + admit. +under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl; last first. - move => t. + by apply derivable1_diffP. apply/differentiable_norm_squared; last 2 first. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_lsubmx => //. rewrite LieDerivativeMl; last first. - move => t. + by apply derivable1_diffP. apply/differentiable_norm_squared; last first. + apply/differentiable_rsubmx => //. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). +rewrite /= !derivative_LieDerivative_eq0; last 4 first. + apply/differentiable_norm_squared; last first. apply/differentiable_rsubmx => //. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). -rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. - by []. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - by []. + apply/differentiable_norm_squared; last first. + apply/differentiable_lsubmx => //. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. -Qed. +Admitted. Lemma V1_point_is_lnd (y : K -> 'rV_6) (z : K) @@ -1801,7 +1851,7 @@ Lemma V1_point_is_lnd (y : K -> 'rV_6) u1 != 0 -> solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt-> y 0 = point1 -> - lnd (LieDerivative (V1 alpha1 gamma) y) 0. + lnd (LieDerivative (V1 alpha1 gamma) (fun a => y) 0 ) 0. Proof. move=> neq0 [y033] [dy dtraj] traj0. have Gamma1_traj t : state_space_tilt (y t). @@ -1840,42 +1890,60 @@ apply/derivable1_diffP => //. rewrite /V1. rewrite !invfM /=. rewrite LieDerivativeD /=; last 2 first. - move => t. apply: differentiableM; last 2 first. rewrite /=. apply: differentiable_norm_squared; last 2 first. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_lsubmx => //. + apply/differentiable_rsubmx => //. apply: differentiable_cst; last first. - move => t. - apply: differentiableM; last 2 first. - apply: differentiable_norm_squared=> //; last first. - apply/differentiable_rsubmx => //. - apply: differentiable_cst. -rewrite !fctE. -under [X in LieDerivative X _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + LieDerivative X _ _]eq_fun do rewrite mulrC. + by apply derivable1_diffP. +under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl; last first. - move => t. + by apply derivable1_diffP. apply/differentiable_norm_squared; last 2 first. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_lsubmx => //. rewrite LieDerivativeMl; last first. - move => t. + by apply derivable1_diffP. apply/differentiable_norm_squared; last first. apply/differentiable_rsubmx => //. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). -rewrite /= !fctE !derivative_LieDerivative_eq0; last 4 first. - by []. +rewrite /= !derivative_LieDerivative_eq0; last 4 first. + apply/differentiable_norm_squared; last 2 first. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_rsubmx => //. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - by []. + apply/differentiable_norm_squared; last 2 first. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_lsubmx => //. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. +apply/differentiableM. +apply/differentiable_norm_squared; last 2 first. + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_lsubmx => //. +by apply: differentiable_cst. Unshelve. all: by end_near. Admitted. + + + + +Definition is_lyapunov_stable_at {K : realType} {n} + (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) + (A : set 'rV[K]_n.+1) + (V : 'rV[K]_n.+1 -> K) + (x0 : 'rV[K]_n.+1) : Prop := + [/\ is_equilibrium_point f x0 A, + is_lyapunov_candidate V setT x0 & + forall traj1 traj2 : (K -> 'rV[K]_n.+1), + solves_equation f traj1 A -> + traj1 0 = x0 -> + locnegsemidef (LieDerivative V (fun a => traj1) 0 ) 0]. Lemma V1_is_lyapunov_stable : is_lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. Proof. From a4cf7f11548406f166a8d61fad7d5eafa211285b Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 19 Sep 2025 16:13:57 +0900 Subject: [PATCH 052/144] doc formatting, cleaning --- _CoqProject | 2 -- derive_matrix.v | 16 +++------- euclidean.v | 12 ++++++-- extra_trigo.v | 78 ++----------------------------------------------- quaternion.v | 13 +++++++-- rigid.v | 8 +++-- rot.v | 21 +++++++++++-- scara.v | 8 +++-- screw.v | 8 +++-- skew.v | 10 +++++-- ssr_ext.v | 14 +++++---- tilt.v | 54 ++++++++++++++++++---------------- tilt_analysis.v | 4 +-- 13 files changed, 107 insertions(+), 141 deletions(-) diff --git a/_CoqProject b/_CoqProject index 639d7d99..cee97fc7 100644 --- a/_CoqProject +++ b/_CoqProject @@ -20,8 +20,6 @@ extra_trigo.v tilt_mathcomp.v tilt_analysis.v tilt_robot.v -lasalle.v -pendulum.v tilt.v diff --git a/derive_matrix.v b/derive_matrix.v index 44a38adc..89f0c72c 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -10,8 +10,8 @@ From mathcomp Require Import topology normedtype landau derive trigo. From mathcomp Require Import functions. Require Import ssr_ext euclidean rigid skew. -(******************************************************************************) -(* Derivatives of time-varying matrices *) +(**md**************************************************************************) +(* # Derivatives of time-varying matrices *) (* *) (* ang_vel_mx M == angular velocity matrix of M(t) *) (* *) @@ -20,6 +20,7 @@ Require Import ssr_ext euclidean rigid skew. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. + Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. @@ -29,12 +30,6 @@ Lemma mx_lin1N (R : pzRingType) n (M : 'M[R]_n) : mx_lin1 (- M) = -1 \*: mx_lin1 M :> ( _ -> _). Proof. by rewrite funeqE => v /=; rewrite scaleN1r mulmxN. Qed. -Lemma mxE_funeqE (R : realFieldType) (V W : normedModType R) - n m (f : V -> 'I_n -> 'I_m -> W) i j : - (fun x => (\matrix_(i < n, j < m) (f x i j)) i j) = - (fun x => f x i j). -Proof. by rewrite funeqE => ?; rewrite mxE. Qed. - Lemma norm_trmx (R : realFieldType) m n (M : 'M[R]_(m.+1, n.+1)) : `|M^T| = `|M|. Proof. @@ -475,9 +470,6 @@ by rewrite {}/f deriveM// mulrC addrC; congr (_ * _ + _ * _); rewrite derive_mx ?mxE//=; exact/derivable_mxP. Qed. -(* NB: from Damien's LaSalle *) -Notation "p ..[ i ]" := (p 0 i) (at level 10). - Global Instance is_diff_component {R : realFieldType} n i (p : 'rV[R]_n.+1) : is_diff p (fun q => q..[i] : R^o) (fun q => q..[i]). Proof. @@ -608,7 +600,7 @@ rewrite derive_mx/=; last first. apply: derivableB => //=; by apply: derivableM => //=; exact: derivable_coord. rewrite !mxE/=. -rewrite (mxE_funeqE (fun x : V => _))/=. +under eq_fun do rewrite !mxE/=. rewrite 2!crossmulE !{1}[in RHS]mxE /=. case: ifPn => [/eqP _|/ifnot0P/orP[]/eqP -> /=]. - rewrite deriveB//=; [ | diff --git a/euclidean.v b/euclidean.v index 78675a4e..c4ddf1da 100644 --- a/euclidean.v +++ b/euclidean.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. From mathcomp Require Import sesquilinear. @@ -7,8 +7,8 @@ From mathcomp Require Import realalg complex fingroup perm. From mathcomp Require Import reals. Require Import ssr_ext. -(******************************************************************************) -(* Elements of Euclidean geometry *) +(**md**************************************************************************) +(* # Elements of Euclidean geometry *) (* *) (* This file provides elements of Euclidean geometry, with specializations to *) (* the 3D case. It develops the theory of the dot-product and of the *) @@ -17,10 +17,13 @@ Require Import ssr_ext. (* preservation of the dot-product by orthogonal matrices or a closed formula *) (* for the characteristic polynomial of a 3x3 matrix. *) (* *) +(* ``` *) (* jacobi_identity == Jacobi identity *) (* lieAlgebraType R == the type of Lie algebra over R *) (* lie[x, y] == Lie brackets *) +(* ``` *) (* *) +(* ``` *) (* u *d w == the dot-product of the vectors u and v, i.e., the only *) (* component of the 1x1-matrix u * v^T *) (* norm u == the norm of vector u, i.e., the square root of u *d u *) @@ -29,8 +32,10 @@ Require Import ssr_ext. (* 'O[T]_n == the type of orthogonal matrices of size n *) (* 'SO[T]_n == the type of rotation matrices of size n *) (* cross M == generalized cross-product *) +(* ``` *) (* *) (* Specializations to the 3D case: *) +(* ``` *) (* row2 a b == the row vector [a,b] *) (* row3 a b c == the row vector [a,b,c] *) (* col_mx2 u v == specialization of col_mx two row vectors of size 2 *) @@ -41,6 +46,7 @@ Require Import ssr_ext. (* algebra *) (* vaxis_euler M == the vector-axis of the rotation matrix M of Euler's *) (* theorem *) +(* ``` *) (* *) (******************************************************************************) diff --git a/extra_trigo.v b/extra_trigo.v index 39918779..16c36108 100644 --- a/extra_trigo.v +++ b/extra_trigo.v @@ -1,9 +1,9 @@ From mathcomp Require Import all_ssreflect ssralg ssrnum. -From mathcomp Require Import interval reals trigo. +From mathcomp Require Import boolp interval reals trigo. Require Import ssr_ext. -(******************************************************************************) -(* Extra material for trigo *) +(**md**************************************************************************) +(* # Extra material for trigo *) (* *) (******************************************************************************) @@ -121,78 +121,6 @@ rewrite sin_eq0_Npipi //; case: eqP => /= [aE _|_ /eqP //]. by move/eqP: caE; rewrite aE cos0 -eqr_oppLR eqrNxx oner_eq0. Qed. -(* NB: PR to analysis in progress *) -Lemma acos1 : acos (1 : R) = 0. -Proof. -have := @cosK R 0; rewrite cos0 => -> //. -by rewrite in_itv //= lexx pi_ge0. -Qed. - -Lemma acos0 : acos (0 : R) = pi / 2%:R. -Proof. -have := @cosK R (pi / 2%:R). -rewrite cos_pihalf => -> //. -rewrite in_itv //= divr_ge0 ?ler0n ?pi_ge0 //=. -rewrite ler_pdivrMr ?ltr0n //. -by rewrite mulr_natr mulr2n -lerBlDr subrr pi_ge0. -Qed. - -Lemma acosN1 : acos (- 1) = (pi : R). -Proof. -have oneB : -1 <= (-1 : R) <= 1 by rewrite lexx ge0_cp ?(ler0n _ 1). -apply: cos_inj; rewrite ?in_itv//= ?pi_ge0 ?lexx //. - by rewrite acos_ge0 // acos_lepi. -by rewrite acosK ?in_itv//= cospi. -Qed. - -Lemma acosN a : -1 <= a <= 1 -> acos (- a) = pi - acos a. -Proof. -move=> aB. -have aBN : -1 <= - a <= 1 by rewrite lerNl opprK lerNl andbC. -apply: cos_inj; first by rewrite in_itv/= acos_ge0 // acos_lepi. - rewrite in_itv/= subr_ge0 acos_lepi // -subr_le0 addrAC subrr sub0r. - by rewrite oppr_cp0 acos_ge0. -by rewrite addrC cosDpi cosN !acosK. -Qed. - -Lemma cosKN a : - pi <= a <= 0 -> acos (cos a) = - a. -Proof. -move=> Hs. -rewrite -(cosN a) cosK // ?in_itv/=. -by rewrite lerNr oppr0 lerNl andbC. -Qed. - -Lemma atan0 : atan 0 = 0 :> R. -Proof. -apply: tan_inj; first 2 last. -- by rewrite atanK tan0. -- by rewrite in_itv/= atan_gtNpi2 atan_ltpi2. -by rewrite in_itv/= oppr_cp0 divr_gt0 ?pi_gt0 // ltr0n. -Qed. - -Lemma atan1 : atan 1 = pi / 4%:R :> R. -Proof. -apply: tan_inj; first 2 last. -- by rewrite atanK tan_piquarter. -- by rewrite in_itv/= atan_gtNpi2 atan_ltpi2. -have v2_ge0 : 0 <= 2%:R :> R by rewrite ler0n. -have v2_gt0 : 0 < 2%:R :> R by rewrite ltr0n. -rewrite in_itv/= -mulNr (lt_trans _ (_ : 0 < _ )) /=; last 2 first. -- by rewrite mulNr oppr_cp0 divr_gt0 // pi_gt0. -- by rewrite divr_gt0 ?pi_gt0 // ltr0n. -rewrite (natrM _ 2 2) invfM mulrA lter_pdivrMr // divfK ?natr_eq0 //. - by rewrite ltr_pdivrMr // mulr_natr mulr2n -subr_gte0 addrK ?pi_gt0. -by case: ltgtP v2_gt0. -Qed. - -Lemma atanN (x : R) : atan (- x) = - atan x. -Proof. -apply: tan_inj; first by rewrite in_itv/= atan_ltpi2 atan_gtNpi2. - by rewrite in_itv/= ltrNl opprK ltrNl andbC atan_ltpi2 atan_gtNpi2. -by rewrite tanN !atanK. -Qed. -(* /NB: PR to analysis in progress *) - Lemma sin_half_angle a : `| sin (a / 2%:R) | = Num.sqrt ((1 - cos a) / 2%:R). Proof. move: (cosD (a / 2%:R) (a / 2%:R)). diff --git a/quaternion.v b/quaternion.v index 1d67660a..51a9c5cb 100644 --- a/quaternion.v +++ b/quaternion.v @@ -9,14 +9,15 @@ From mathcomp Require Import interval reals trigo. Require Import ssr_ext euclidean vec_angle frame rot. Require Import extra_trigo. -(******************************************************************************) -(* Quaternions *) +(**md**************************************************************************) +(* # Quaternions *) (* *) (* This file develops the theory of quaternions. It defines the type of *) (* quaternions and the type of unit quaternions and show that quaternions *) (* form a ZmodType, a RingType, a LmodType, a UnitRingType. It also defines *) (* polar coordinates and dual quaternions. *) (* *) +(* ``` *) (* quat R == type of quaternions over the ringType R *) (* x%:q == quaternion with scalar part x and vector part 0 *) (* x \is realq == the quaternion x has no vector part *) @@ -30,28 +31,36 @@ Require Import extra_trigo. (* normq x == norm of the quaternion x *) (* uquat R == type of unit quaternions, i.e., quaternions with norm 1 *) (* conjugation x == v |-> x v x^* *) +(* ``` *) (* *) (* Polar coordinates: *) +(* ``` *) (* polar_of_quat a == polar coordinates of the quaternion a *) (* quat_of_polar a u == quaternion corresponding to the polar coordinates *) (* angle a and vector u *) (* quat_rot x == snd \o conjugation x (rotation of angle 2a about *) (* vector v where a,v are the polar coordinates of x, *) (* a unit quaternion *) +(* ``` *) +(* *) (* Dual numbers: *) +(* ``` *) (* dual R == the type of dual numbers over a ringType R *) (* x.1 == left part of the dual number x *) (* x.2 == right part of the dual number x *) +(* ``` *) (* Dual numbers are equipped with a structure of ZmodType, RingType, and of *) (* LmodType when R is a ringType, of Com/UnitRingType when R is a *) (* Com/UnitRingType. *) (* *) (* Dual quaternions: *) +(* ``` *) (* x +ɛ* y == dual number formed by x and y *) (* dquat == type of dual quaternions *) (* x \is puredq == the dual quaternion x is pure *) (* a \is dnum == a has no vector part *) (* x^*dq == conjugate of dual quaternion x *) +(* ``` *) (* *) (******************************************************************************) diff --git a/rigid.v b/rigid.v index 21fa4df6..886bc1c6 100644 --- a/rigid.v +++ b/rigid.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. @@ -6,8 +6,8 @@ From mathcomp Require Import realalg complex finset fingroup perm. From mathcomp Require Import interval reals trigo. Require Import ssr_ext euclidean skew vec_angle rot frame extra_trigo. -(******************************************************************************) -(* Rigid Body Transformations *) +(**md**************************************************************************) +(* # Rigid Body Transformations *) (* *) (* This file develops the theory of isometries, proving basic properties such *) (* as the preservation of the cross-product by derivative maps, the facts *) @@ -16,6 +16,7 @@ Require Import ssr_ext euclidean skew vec_angle rot frame extra_trigo. (* body transformations are represented by elements of the special Euclidean *) (* group and are shown to preserve norms. *) (* *) +(* ``` *) (* 'Iso[T]_n == the type of isometries *) (* 'CIso[T]_n == the type of central isometries, i.e., isometries f such *) (* that f 0 = 0 *) @@ -38,6 +39,7 @@ Require Import ssr_ext euclidean skew vec_angle rot frame extra_trigo. (* homogeneous representation *) (* Adjoint g == adjoint transformation associated with the homogeneous *) (* matrix g *) +(* ``` *) (* *) (******************************************************************************) diff --git a/rot.v b/rot.v index fb23246d..4a187b24 100644 --- a/rot.v +++ b/rot.v @@ -10,17 +10,20 @@ From mathcomp Require Import sesquilinear. Require Import extra_trigo. Require Import ssr_ext euclidean skew vec_angle frame. -(******************************************************************************) -(* Rotations *) +(**md**************************************************************************) +(* # Rotations *) (* *) (* This file develops the theory of 3D rotations with results such as *) (* Rodrigues formula, the fact that any rotation matrix can be represented *) (* by its exponential coordinates, angle-axis representation, Euler angles, *) (* etc. See also quaternion.v for rotations using quaternions. *) (* *) +(* ``` *) (* RO a, RO' a == two dimensional rotations of angle a *) +(* ``` *) (* *) (* Elementary rotations (row vector convention): *) +(* ``` *) (* Rx a, Rx' a == rotations about axis x of angle a *) (* Ry a == rotation about axis y of angle a *) (* Rz a == rotation about axis z of angle a *) @@ -29,7 +32,9 @@ Require Import ssr_ext euclidean skew vec_angle frame. (* sample lemmas: *) (* all rotations around a vector of angle a have trace "1 + 2 * cos a" *) (* equivalence SO[R]_3 <-> Rot (isRot_SO, SO_is_Rot) *) +(* ``` *) (* *) +(* ``` *) (* `e(a, M) == specialized exponential map for angle a and matrix M *) (* `e^(a, w) == specialized exponential map for the matrix \S(w), i.e., the *) (* skew-symmetric matrix corresponding to vector w *) @@ -37,40 +42,52 @@ Require Import ssr_ext euclidean skew vec_angle frame. (* inverse of the exponential map, *) (* exponential map of a skew matrix is a rotation *) (* *) +(* ``` *) (* rodrigues u a w == linear combination of the vectors u, (u *d w)w, w *v u *) (* that provides an alternative expression for the vector *) (* u * e^(a,w) *) +(* ``` *) (* *) (* Angle-axis representation: *) +(* ``` *) (* Aa.angle M == angle of angle-axis representation for the matrix M *) (* Aa.vaxis M == axis of angle-axis representation for the matrix M *) (* sample lemma *) (* a rotation matrix has Aa.angle M and normalize (Aa.vaxis M) for *) (* exponential coordinates *) +(* ``` *) (* *) (* Composition of elementary rotations (row vector convention): *) +(* ``` *) (* Rzyz a b c == composition of a Rz rotation of angle c, a Ry rotation of *) (* angle b, and a Rz rotation of angle a *) (* Rxyz a b c == composition of a Rx rotation of angle c, a Ry rotation of *) (* angle b, and a Rz notation of angle a *) +(* ``` *) (* *) (* ZYZ angles given a rotation matrix M (ref: [sciavicco] 2.4.1): *) (* with zyz_b in ]0;pi[: *) +(* ``` *) (* zyz_a M == angle of the last Rz rotation *) (* zyz_b M == angle of the Ry rotation *) (* zyz_c M == angle of the first Rz rotation *) +(* ``` *) (* *) (* Roll-Pitch-Yaw (ZYX) angles given a rotation matrix M *) (* with pitch in ]-pi/2;pi/2[ (ref: [sciavicco] 2.4.2): *) +(* ``` *) (* rpy_a M == angle about axis z (roll) *) (* rpy_b M == angle about axis y (pitch) *) (* rpy_c M == angle about axis x (yaw) *) +(* ``` *) (* *) (* Alternative formulation of ZYX angles: *) (* (ref: [Gregory G. Slabaugh, Computer Euler angles from a rotation matrix]) *) +(* ``` *) (* euler_a == angle about z *) (* euler_b == angle about y *) (* euler_c == angle about x *) +(* ``` *) (******************************************************************************) Reserved Notation "'`e(' a ',' M ')'" (format "'`e(' a ',' M ')'"). diff --git a/scara.v b/scara.v index 7dabcad8..26db53e6 100644 --- a/scara.v +++ b/scara.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. From mathcomp Require Import realalg complex fingroup perm. @@ -8,18 +8,20 @@ Require Import ssr_ext euclidean skew vec_angle rot frame rigid screw. From mathcomp Require Import reals. Require Import extra_trigo. -(******************************************************************************) -(* SCARA Robot Manipulator *) +(**md**************************************************************************) +(* # SCARA Robot Manipulator *) (* *) (* This file addresses the forward kinematics problem for the SCARA robot *) (* manipulator in two ways: (1) it first provides the DH parameters, *) (* (2) using screw motions. *) (* *) +(* ``` *) (* B10,B21,B32,B43 == relative positions of the consecutive frames of the *) (* SCARA robot manipulator using DH parameters *) (* t1,t2,t3,t4 == twists of the SCARA robot manipulator *) (* g0 == position of the end-effector using twists *) (* g == orientation of the end-effector using twists *) +(* ``` *) (* *) (******************************************************************************) diff --git a/screw.v b/screw.v index 37304ea0..3354f68b 100644 --- a/screw.v +++ b/screw.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_boot order ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. @@ -7,8 +7,8 @@ From mathcomp Require Import sesquilinear. From mathcomp Require Import interval reals trigo. Require Import ssr_ext euclidean skew vec_angle frame rot rigid extra_trigo. -(******************************************************************************) -(* Screw Motions *) +(**md**************************************************************************) +(* # Screw Motions *) (* *) (* This file develops the theory of screws and twists. It establishes in *) (* particular Chasles' theorem (given a rigid body motion, it shows *) @@ -16,6 +16,7 @@ Require Import ssr_ext euclidean skew vec_angle frame rot rigid extra_trigo. (* rigid body motion), Mozzi-Chasles' theorem (it shows the existence of a *) (* set of points that undergo just a translation---this is the screw axis). *) (* *) +(* ``` *) (* Module sqLieAlgebra == square matrices form a Lie algebra *) (* 'se3[R] == the set of twists *) (* wedge t == form a twist in 'se3[R] given twist (coordinates) *) @@ -35,6 +36,7 @@ Require Import ssr_ext euclidean skew vec_angle frame rot rigid extra_trigo. (* `e$(a, t) == the exponential of a twist t with angle a *) (* rjoint_twist w p == twist of a revolute joint *) (* pjoint_twist v == twist of a prismatic joint *) +(* ``` *) (* *) (******************************************************************************) diff --git a/skew.v b/skew.v index 5a577f43..35add614 100644 --- a/skew.v +++ b/skew.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. @@ -7,12 +7,13 @@ From mathcomp Require Import realalg complex finset fingroup perm ring. Require Import ssr_ext euclidean vec_angle. From mathcomp Require Import reals. -(******************************************************************************) -(* Skew-symmetric matrices *) +(**md**************************************************************************) +(* # Skew-symmetric matrices *) (* *) (* This file develops the theory of skew-symmetric matrices to be used in *) (* particular to represent the exponential coordinates of rotation matrices. *) (* *) +(* ``` *) (* 'so[R]_n == the type of skew-symmetric matrices, i.e., matrices M such *) (* that M = -M^T *) (* \S(w) == the spin of vector w, i.e., the (row-vector convention) *) @@ -20,10 +21,13 @@ From mathcomp Require Import reals. (* symp A == symmetric part of matrix A *) (* antip A == antisymmetric part of matrix A *) (* spin_eigenvalues u == eigenvalues of \S(u) *) +(* ``` *) (* *) (* Cayley transform: *) +(* ``` *) (* cayley M == (1 - M)^-1 * (1 + M) *) (* uncayley M == (M - 1) * (M + 1)^-1 *) +(* ``` *) (* *) (******************************************************************************) diff --git a/ssr_ext.v b/ssr_ext.v index 25e7aee1..54378002 100644 --- a/ssr_ext.v +++ b/ssr_ext.v @@ -1,19 +1,21 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) -From Stdlib Require Import NsatzTactic. +(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) +Require Import NsatzTactic. From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. From mathcomp Require Import perm path fingroup complex. -(******************************************************************************) -(* Minor additions to MathComp libraries *) +(**md**************************************************************************) +(* # Minor additions to MathComp libraries *) (* *) (* This file contains minor additions ssrbool, ssralg, ssrnum, and complex *) (* and more. *) (* *) +(* ``` *) (* u``_i == the ith component of the row vector u *) (* 'e_0, 'e_1, 'e_2 == the canonical vectors *) (* Section Nsatz_rcfType == type classes for the Coq nsatz tactic *) (* (https://coq.inria.fr/refman/addendum/nsatz.html) *) +(* ``` *) (* *) (******************************************************************************) @@ -21,9 +23,11 @@ Reserved Notation "''e_' i" (format "''e_' i", at level 8, i at level 2). Reserved Notation "u '``_' i" (at level 3, i at level 2, left associativity, format "u '``_' i"). -(* TODO: overrides forms.v *) Notation "u '``_' i" := (u (@GRing.zero _) i) : ring_scope. +(* NB: like Damien's LaSalle *) +Notation "p ..[ i ]" := (p (@GRing.zero _) i) (at level 10, only parsing). + Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. diff --git a/tilt.v b/tilt.v index d63bafec..6414aec3 100644 --- a/tilt.v +++ b/tilt.v @@ -9,7 +9,8 @@ Require Import tilt_mathcomp tilt_analysis tilt_robot. (**md**************************************************************************) (* # tentative formalization of [1] *) (* *) -(* defposmx M == M is definite positive *) +(* ``` *) +(* posdefmx M == M is definite positive *) (* locposdef V x == V is locally positive definite at x *) (* is_lyapunov_candidate V := locposdef V *) (* locnegsemidef V x == V is locally negative semidefinite *) @@ -19,6 +20,7 @@ Require Import tilt_mathcomp tilt_analysis tilt_robot. (* state_space f == the set points attainable by a solution *) (* (in the sense of `solves_equation`) *) (* is_lyapunov_stable_at f V x == Lyapunov stability *) +(* ``` *) (* *) (* References: *) (* - [1] *) @@ -35,13 +37,13 @@ Local Open Scope ring_scope. (* spin and matrix/norm properties*) -Lemma norm_spin {R : realType} (u : 'rV[R]_3) (v : 'rV[R]_3) : +Lemma norm_spin {R : rcfType} (u : 'rV[R]_3) (v : 'rV[R]_3) : (u *m \S(v - u) ^+ 2 *m (u)^T) 0 0 = - norm (u *m \S(v)) ^+ 2. Proof. rewrite spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !mul_tr_spin !addr0. rewrite -dotmulvv /dotmul trmx_mul. rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. -by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. + by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. by rewrite tr_spin mulNmx mulmxN [in RHS]mxE opprK mulmxA. Qed. @@ -56,25 +58,26 @@ rewrite mulmxE sqrspin. by rewrite [in RHS]mxE [in RHS]mxE /= -mulNrn mxE -mulNrn. Qed. -Definition defposmx {R : realType} m (M : 'M[R]_m) : Prop := +Definition posdefmx {R : realType} m (M : 'M[R]_m) : Prop := M \is sym m R /\ forall a, eigenvalue M a -> a > 0. -Lemma defposmxP {R : realType} m (M : 'M[R]_m) : - defposmx M <-> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). +Lemma posdefmxP {R : realType} m (M : 'M[R]_m) : + posdefmx M <-> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). Proof. split. - move => [matsym eigen] x xneq0. - apply/eigen/eigenvalueP; exists x => //=. - apply/matrixP => i j. - (* theoreme spectral? *) + move => [Msym eigenM] x x_neq0. + apply/eigenM/eigenvalueP. + exists x => //=. + (* spectral theorem? *) Admitted. Local Open Scope classical_set_scope. -Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (D : set T) (x : T) : Prop := +Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) + (D : set T) (x : T) : Prop := x \in D /\ V x = 0 /\ open D /\ forall z, z \in D -> z != x -> V z > 0. -(* add continuously diff*) +(* add continuously diff *) Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) (D : set 'rV[K]_n.+1) (x0 : 'rV[K]_n.+1) := locposdef V D x0 /\ differentiable V x0. @@ -1168,13 +1171,15 @@ Qed. End problem_statementB. +Definition state_space_tilt {K : realType} := + [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. + Section eqn33. Variable K : realType. Variable alpha1 : K. Variable gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Definition state_space_tilt {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. Definition tilt_eqn (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := let zp1_point := Left \o zp1_z2_point in @@ -1264,12 +1269,11 @@ apply/seteqP; split. rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. rewrite !mxE /= !mulr1n. - have -> : ('D_1 (fun x2 : K => 'e_2 - Right (y x2)) x) - = - (Right ('D_1 y x)). + have -> : 'D_1 (fun x2 : K => 'e_2 - Right (y x2)) x = - Right ('D_1 y x). rewrite deriveB /= ; last 2 first. exact: derivable_cst. - by apply: derivable_rsubmx. - rewrite derive_cst /= sub0r; congr (-_). + exact: derivable_rsubmx. + rewrite derive_cst /= sub0r; congr (- _). exact: derive_rsubmx. rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. apply/matrixP => a b; rewrite !mxE. @@ -1449,7 +1453,7 @@ Proof. by rewrite /u2/= /mxtrace /= sum2E/= !mxE/=. Qed. Lemma det_u2 : \det u2 = 3/4. Proof. by rewrite /u2 det_mx22 /= !mxE /=; field. Qed. -Lemma defposmxu2 : defposmx u2. +Lemma posdefmxu2 : posdefmx u2. Proof. split; first exact: u2_sym. move=> a. @@ -1486,14 +1490,14 @@ Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. Definition V1 (zp1_z2 : 'rV[K]_6) : K := - let zp1 := Left zp1_z2 in + let zp1 := Left zp1_z2 in let z2 := Right zp1_z2 in (norm zp1)^+2 / (2 * alpha1) + (norm z2)^+2 / (2 * gamma). Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 setT point1. Proof. rewrite /locposdef; split. -- rewrite /V1 /point1 /locposdef; split. +- rewrite /V1 /point1 /locposdef; split. by rewrite inE. rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. split. @@ -1781,8 +1785,8 @@ set w := (z2 z) *m \S('e_2). pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). by rewrite V1dot_ub. -have := @defposmxu2 K. -rewrite defposmxP => def. +have := @posdefmxu2 K. +rewrite posdefmxP => def. have [->|H] := eqVneq u1 0. by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. have Hpos := def u1 H. @@ -1863,8 +1867,8 @@ near=> z0. rewrite deriveV1. have Hle : V1dot (y z) <= (- u1 *m u2 *m u1^T) 0 0. by apply: V1dot_ub. -have := @defposmxu2 K. -rewrite defposmxP => def. +have := @posdefmxu2 K. +rewrite posdefmxP => def. have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0 by apply: def. have Hneg : - (u1 *m u2 *m u1^T) 0 0 < 0. by rewrite oppr_lt0. rewrite lt_neqAle. @@ -1968,7 +1972,7 @@ move => a. move/eigenvalueP => [u] /[swap] u0 H. have a_eigen : eigenvalue (jacobian (eqn33' alpha1 gamma) point1) a. apply/eigenvalueP. - exists u. + exists u. exact: H. exact: u0. have : root (char_poly (jacobian (eqn33' alpha1 gamma) point1)) a. diff --git a/tilt_analysis.v b/tilt_analysis.v index b8dc5552..9577ebcc 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -111,7 +111,7 @@ move => dif1. apply/diff_derivable. rewrite /=. under eq_fun do rewrite -dotmulvv dotmulE. -have -> : (fun x : K => \sum_k (f x)``_k * (f x)``_k) = +have -> : (fun x : K => \sum_k (f x)``_k * (f x)``_k) = \sum_k (fun x => (f x)``_k * (f x)``_k ). apply/funext => x => //=. by rewrite fct_sumE. @@ -173,5 +173,3 @@ under eq_fun do rewrite -dotmulvv. rewrite /=. by apply: differentiable_dotmul => //. Qed. - - From 357ef795f7f245f7e36de3e43375e3fee442a8e8 Mon Sep 17 00:00:00 2001 From: yosakaon Date: Sun, 5 Oct 2025 23:49:51 +0200 Subject: [PATCH 053/144] remove differentiability admits --- tilt.v | 80 +++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 48 insertions(+), 32 deletions(-) diff --git a/tilt.v b/tilt.v index 6414aec3..7f3d0f46 100644 --- a/tilt.v +++ b/tilt.v @@ -360,6 +360,12 @@ Theorem Lyapunov_stability {K : realType} {n} (sol : 'rV_n.+1 -> K -> 'rV[K]_n.+1) (x : 'rV[K]_n.+1 := 0) (fsolD : forall z, z \in D -> solves_equation f (sol z) D) + (sol0x : forall x, sol x 0 = x) + (uniqueness_of_solution : forall (phi1 phi2 : K -> 'rV_n.+1) (x0 : 'rV_n.+1), + solves_equation f phi1 D -> + solves_equation f phi2 D -> + phi1 0 = x0 -> phi2 0 = x0 -> + phi1 = phi2) (V : 'rV[K]_n.+1 -> K) (VDx : is_lyapunov_candidate V D x) (*contient l'hypothese x in D*) (V'le_0 : forall phi, solves_equation f phi D -> forall t, t >= 0 -> LieDerivative V sol (phi 0) t <= 0) @@ -372,8 +378,6 @@ move => eps eps0. rewrite /is_lyapunov_candidate in VDx. move: VDx => [/= Vloc Vdiff]. move: Vloc => [/= inD [V0 [openD z1]]]. -have init : forall x, sol x 0 = x. - by admit. have : exists r : K, 0 < r /\ r <= eps /\ closed_ball_ (fun x => `|x|) (0:'rV[K]_n.+1) r `<=` D. rewrite inE in inD. have [r0 /= Hr0D] := open_subball openD inD. @@ -479,11 +483,6 @@ have HOmega_beta : Omega_beta `<=` interior (closed_ball_ [eta normr])``_r. have Hbb : beta < beta by apply: (lt_le_trans Hbeta_lt Hle_alpha_beta). by move : Hbb; rewrite ltxx. by exact: r_pos. -have uniqueness_of_solution : forall (phi1 phi2 : K -> 'rV_n.+1) (x0 : 'rV_n.+1), - solves_equation f phi1 D -> - solves_equation f phi2 D -> - phi1 0 = x0 -> phi2 0 = x0 -> - phi1 = phi2 by admit. have H1 : forall phi , solves_equation f phi D -> phi 0 \in Omega_beta -> forall t, 0 <= t -> phi t \in Omega_beta. move => phi solves xOmega t t0. have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi 0) u <= 0 -> @@ -498,34 +497,51 @@ have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi move : xOmega. rewrite inE /Omega_beta. by move => [H1 H2]. - rewrite !init /=. + rewrite !sol0x /=. have Vneg_incr: forall s1 s2, 0 <= s1 <= s2 -> forall x, x \in D -> V (sol x s2) <= V (sol x s1). - move=> s1 s2 Hs1_pos x2 xinD . - apply: (@ler0_derive1_nincr _ (fun s => V (sol x2 s)) 0 s2) => //. + move=> s1 s2 Hs1_pos x0 xinD . + apply: (@ler0_derive1_nincr _ (fun s => V (sol x0 s)) 0 s2) => //. - rewrite -fctE. - move => x3 x1in. + move => x1 x1in. apply: diff_derivable. apply: differentiable_comp; last first. apply: differentiable_comp => //. - - (* continuity*) - admit. + have solx0 := fsolD _ xinD. + case: solx0 => _ [diff_sol _]. + rewrite -derivable1_diffP. + by apply: diff_sol. - move=> s Hs_in. - (* TODO *) - (* LEMMA*) move : (V'le_0 phi solves t t0). rewrite LieDerivative_derive => //=; last first. - admit. + rewrite inE in xOmega. + have Hsol := fsolD (phi 0) _. + have Heq := uniqueness_of_solution phi (sol (phi 0)) (phi 0) solves _ _ _ => //. + rewrite -Heq => //=. + rewrite /solves_equation in solves. + rewrite -derivable1_diffP. + by case: solves => _ []. + apply: Hsol. + rewrite inE. + apply: Br_sub_D. + by case: xOmega. rewrite derive1E. rewrite fctE. - pose phi2 := (fun t => sol x2 t). - have solves_phi2 : solves_equation f phi2 D by admit. - have s_pos : 0 <= s. - by move: Hs_in; case/andP => /ltW. - have deriv_le0 := V'le_0 phi2 solves_phi2 s s_pos. - move => H. - rewrite LieDerivative_derive /phi2 init in deriv_le0 => //. - admit. + move=> _. + have H := V'le_0 (sol x0) (fsolD x0 xinD) s _. + rewrite LieDerivative_derive sol0x in H. + rewrite -fctE. + apply: H. + move : Hs_in. + rewrite inE. + move=> /itvP [] [Hs Hs1 Hs2]. + rewrite ltW => //. + by rewrite Hs. + exact : Vderiv. + move: (fsolD x0 xinD) => solx0. + rewrite /solves_equation in solx0. + move: solx0 => [_ [Hdiff _]]. + rewrite -derivable1_diffP. + exact: Hdiff. admit. - move: Hs1_pos => /andP [H0s1 Hs1s2]. by apply: H0s1. @@ -540,7 +556,7 @@ have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi rewrite inE /Omega_beta. move=> [clo Vxb]. have Hdec := Vneg_incr 0 t1 _ (phi 0) _. - rewrite init in Hdec. + rewrite sol0x in Hdec. apply: Hdec => //=. by apply/andP; split => //. rewrite inE /Omega_beta. @@ -559,7 +575,7 @@ have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi - exact t0. have V_bound := H2 t t0 t t00 H_lie. move : V_bound. - rewrite !init. + rewrite !sol0x. have -> : sol (phi 0) = phi. apply: uniqueness_of_solution => //. apply: fsolD => //. @@ -728,7 +744,7 @@ have Hlast : `|sol x 0| < delta -> forall t : K , t >=0 -> `|sol x t| < r <= eps split => //=. rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. exact: Hball_solt. - have x00 : sol x 0 = x by rewrite init => //=. + have x00 : sol x 0 = x by rewrite sol0x => //=. have z0_in_ball : (closed_ball_ [eta normr])``_delta (sol x 0). rewrite /closed_ball_; apply: ltW. rewrite sub0r normrN. @@ -755,12 +771,12 @@ have Htraj0 : `|sol x t0| < r. rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. apply: ltW. rewrite /x. - rewrite init in x0_lt_delta. + rewrite sol0x in x0_lt_delta. by apply: x0_lt_delta. have sol_in_Omega : sol x t0 \in Omega_beta. apply: H1 => //=. by apply: fsolD => //. - rewrite init. + rewrite sol0x. exact: x0_in_Omega; exact: t0_ge0. rewrite /Omega_beta inE in sol_in_Omega. case: sol_in_Omega => Hnorm _. @@ -770,7 +786,7 @@ have Htraj0 : `|sol x t0| < r. have traj_in_Omega : sol x t0 \in Omega_beta. apply: H1 => //. apply: fsolD => //. - by rewrite init. + by rewrite sol0x. have in_interior: ((closed_ball_ [eta normr])``_r)° (sol x t0). apply: HOmega_beta. rewrite -inE. @@ -781,7 +797,7 @@ have Htraj0 : `|sol x t0| < r. rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. apply => //=. exact : r_pos. -rewrite init in x0_lt_delta. +rewrite sol0x in x0_lt_delta. by apply: (lt_le_trans Htraj0 r_le_eps). Admitted. From 7fc20cb335618ff4a66691a5c26694ecf79a6300 Mon Sep 17 00:00:00 2001 From: yosakaon Date: Tue, 7 Oct 2025 11:14:06 +0200 Subject: [PATCH 054/144] renaming of part A --- tilt.v | 83 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 45 insertions(+), 38 deletions(-) diff --git a/tilt.v b/tilt.v index 7f3d0f46..0d736b21 100644 --- a/tilt.v +++ b/tilt.v @@ -904,15 +904,18 @@ Variable R : K -> 'M[K]_3. (*L -> W*) Variable g0 : K. (*standard gravity constant*) Let w t := ang_vel R t. (* local frame of the sensor (gyroscope) *) Let x1 t := v t. (* local frame*) -Definition x2 t : 'rV_3 := 'e_2 *m R t. (* tilt in local frame, e2 is in global frame but R brings it back*) -Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. (* local frame of the sensor*) +Definition x2 t : 'rV_3 := 'e_2 *m R t. (**) +Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. (*worlf frame ?*) Variable p : K -> 'rV[K]_3. Let v1 := fun t : K => 'D_1 p t *m R t. Definition y_a1 t := - v1 t *m \S( w t)+ 'D_1 v1 t + g0 *: x2 t. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. - -Lemma y_aE t : ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t= y_a1 t . +Lemma y_aE t + ( derivableR : forall t, derivable R t 1) + ( derivablep : forall t, derivable p t 1) + ( derivableDp : forall t, derivable ('D_1 p) t 1) + : ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t= y_a1 t . Proof. rewrite mulmxDl. rewrite /y_a1/= /v1 /= /x2. @@ -920,17 +923,21 @@ congr +%R; last by rewrite scalemxAl. rewrite -ang_vel_mxE/=; last 2 first. move=> t0. rewrite rotation_sub //. - admit. -rewrite [in RHS]derive_mulmx; [|admit|admit]. -rewrite derive1mx_ang_vel//; [|admit|admit]. -rewrite ang_vel_mxE//; [|admit|admit]. + exact : derivableR. + rewrite [in RHS]derive_mulmx => //. + rewrite derive1mx_ang_vel => //; last first. + move => t0. + by rewrite rotation_sub => //. + rewrite ang_vel_mxE// => //; last first. + move => t0. + by rewrite rotation_sub => //. rewrite addrCA. rewrite -mulmxE. rewrite -mulNmx. rewrite [X in _ = _ X]addrC. rewrite !mulNmx. by rewrite -mulmxA /= addrN addr0. -Admitted. +Qed. End ya. @@ -944,7 +951,7 @@ Hypothesis RisSO : forall t, R t \is 'SO[K]_3. Hypothesis derivableR : forall t, derivable R t 1. Variable v : K -> 'rV[K]_3. Let x1 t := v t. -Let x2 t : 'rV_3 := ('e_2) *m R t (* eqn (8) *). +Let x2 t : 'rV_3 := ('e_2) *m R t (* eqn (8) *). (* local frame ez ? *) Let x1_point t := 'D_1 x1 t. Let x2_point t := 'D_1 x2 t. Let w t := ang_vel R t. @@ -1032,25 +1039,25 @@ Hypothesis x2_hat_S2 : x2_hat 0 \in S2. Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. Hypothesis v_derivable : forall t, derivable v t 1. Notation x2 := (x2 R). -Let p1 t := x2 t - x2'hat t. -Let x2_tilde t := x2 t - x2_hat t. -Let p1_point t := 'D_1 p1 t. -Let x2_tilde_point t := 'D_1 x2_tilde t. +Let erreur1 t := x2 t - x2'hat t. +Let erreur2 t := x2 t - x2_hat t. +Let erreur1_point t := 'D_1 erreur1 t. +Let errur2_point t := 'D_1 erreur2 t. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. -Let zp1 t := p1 t *m (R t)^T. -Let z2 t := x2_tilde t *m (R t)^T. +Let erreur1_p t := erreur1 t *m (R t)^T. +Let erreur2_p t := erreur2 t *m (R t)^T. Hypothesis norm_x2_hat : forall t, norm (x2_hat t) = 1. -Let p1E : p1 = fun t => x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). +Let p1E : erreur1 = fun t => x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). Proof. apply/funext => ?. -rewrite /p1 /x2; congr +%R. +rewrite /erreur1 /x2; congr +%R. by rewrite /x2'hat scaleNr opprK. Qed. -Let x2_tildeE t : x2_tilde t = z2 t *m R t. +Let x2_tildeE t : erreur2 t = erreur2_p t *m R t. Proof. -rewrite /z2 -mulmxA. +rewrite /erreur2 -mulmxA. by rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. Qed. @@ -1059,11 +1066,11 @@ Let derivable_x2 t : derivable x2 t 1. Proof. exact: derivable_mulmx. Qed. Let derivable_x2'hat t : derivable x2'hat t 1. Proof. by apply: derivableZ => /=; exact: derivableB. Qed. -Let derivable_p1 t : derivable p1 t 1. Proof. exact: derivableB. Qed. +Let derivable_erreur1 t : derivable erreur1 t 1. Proof. exact: derivableB. Qed. -Let derivable_x2_tilde t : derivable x2_tilde t 1. Proof. exact: derivableB. Qed. +Let derivable_x2_tilde t : derivable erreur2 t 1. Proof. exact: derivableB. Qed. -Lemma derive_p1 t : 'D_1 p1 t = p1 t *m \S(w t) - alpha1 *: p1 t. +Lemma derive_erreur1 t : 'D_1 erreur1 t = erreur1 t *m \S(w t) - alpha1 *: erreur1 t. Proof. simpl in *. rewrite p1E. @@ -1075,7 +1082,7 @@ rewrite !(derive_x2) // -/(x2 t) /=. rewrite (derive_x1 g0 R) //. rewrite -/(x2 t) -/(v t) -/(x1 t) -/(w t). rewrite eq12a. -transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) - alpha1 *: p1 t). +transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) - alpha1 *: erreur1 t). transitivity (x2 t *m \S(w t) + (alpha1 / g0) *: (x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'hat t))). congr (_ + _ *: _). rewrite -2![in LHS]addrA -[in RHS]addrA. @@ -1095,28 +1102,28 @@ transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) - alpha1 *: rewrite -addrA; congr +%R. by rewrite addrC. by rewrite opprB addrC. - rewrite -/(p1 t). + rewrite -/(erreur1 t). rewrite scalerDr addrA scalemxAl -mulmxDl scalerN scalerA. by rewrite divfK. by rewrite p1E. Qed. -Lemma derive_x2tilde t : 'D_1 x2_tilde t = x2_tilde t *m \S( w t) - gamma *: (x2_tilde t - p1 t) *m \S( x2_hat t ) ^+ 2 . +Lemma derive_erreur2 t : 'D_1 erreur2 t = erreur2 t *m \S( w t) - gamma *: (erreur2 t - erreur1 t) *m \S( x2_hat t ) ^+ 2 . Proof. -rewrite /x2_tilde. +rewrite /erreur2. rewrite [in LHS]deriveB//. rewrite derive_x2//. -rewrite -/(x2 t) -/(w t) -/(x2_tilde t). +rewrite -/(x2 t) -/(w t) -/(erreur2 t). rewrite eq12c. rewrite spinD spinN. rewrite -[in LHS]scalemxAl. rewrite (spinZ gamma). rewrite mulmxBr opprB [LHS]addrA [in LHS]addrC addrA (addrC _ (x2 t *m \S(w t))). -rewrite -mulmxBl -/(x2_tilde t). +rewrite -mulmxBl -/(erreur2 t). congr +%R. rewrite -scalemxAr -mulNmx -scalerN -[RHS]scalemxAl. congr (_ *: _). -rewrite /x2_tilde /p1. +rewrite /erreur2 /erreur1. rewrite (opprB _ (x2'hat t)) -addrA (addrC (x2 t)) addrA subrK opprD opprK mulmxBl. rewrite [X in _ = X + _](_ : _ = 0) ?add0r; last first. rewrite mulmxA. @@ -1129,19 +1136,19 @@ rewrite [in RHS]mulmxA [in RHS]spinE spinE spinE. by rewrite [LHS](@lieC _ (vec3 K))/=. Qed. -Lemma Rx2 t : x2_hat t *m (R t)^T = 'e_2 - z2 t. +Lemma Rx2 t : x2_hat t *m (R t)^T = 'e_2 - erreur2_p t. Proof. -rewrite /z2 /x2_tilde mulmxBl opprB addrCA. +rewrite /erreur2_p /erreur2 mulmxBl opprB addrCA. rewrite [X in _ + X](_ : _ = 0) ?addr0//. rewrite /x2 -mulmxA. by rewrite orthogonal_mul_tr ?rotation_sub// mulmx1 subrr. Qed. -Lemma derive_zp1t t : 'D_1 zp1 t = -alpha1 *: zp1 t. +Lemma derive_erreur1_p t : 'D_1 erreur1_p t = -alpha1 *: erreur1_p t. Proof. -rewrite /zp1. +rewrite /erreur1. rewrite derive_mulmx//=; last by rewrite derivable_trmx. -rewrite derive_p1. +rewrite derive_erreur1. rewrite mulmxBl addrAC. apply/eqP. rewrite subr_eq. @@ -1153,7 +1160,7 @@ rewrite -/(w t) -mulmxA -mulmxDr trmx_mul tr_spin. by rewrite mulNmx subrr mulmx0. Qed. -Lemma derive_z2t t : 'D_1 z2 t = gamma *: (z2 t - zp1 t) *m - \S('e_2 -z2 t)^+2. +Lemma derive_erreur2_p t : 'D_1 erreur2_p t = gamma *: (erreur2_p t - erreur1_p t) *m - \S('e_2 - erreur2_p t)^+2. Proof. rewrite [LHS]derive_mulmx//=; last first. by rewrite derivable_trmx. @@ -1164,7 +1171,7 @@ rewrite derive1mx_ang_vel//=; last first. rewrite !ang_vel_mxE//; last first. by move => t0; rewrite rotation_sub. rewrite trmx_mul mulmxA -mulmxDl. -rewrite derive_x2tilde /=. +rewrite derive_erreur2 /=. rewrite addrAC -/(w t) tr_spin mulmxN subrr sub0r. rewrite -[in LHS]scalemxAl -scaleNr -[in LHS]scalemxAl. rewrite mulmxN -scalemxAl -[in RHS]scaleNr. @@ -1179,7 +1186,7 @@ rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. congr (_ *m _). rewrite x2_tildeE. rewrite mulmxBl; congr (_ - _)%R. -by rewrite /zp1 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. +by rewrite /erreur1 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. Qed. (* TODO relier derivezp1 et derivez2 a eqn33?*) From 0478e413aa3b2b890f83a5523abb64bd612bfe0c Mon Sep 17 00:00:00 2001 From: yosakaon Date: Tue, 7 Oct 2025 20:10:15 +0200 Subject: [PATCH 055/144] removed continuity admits from lyapunov proof --- tilt.v | 191 ++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 121 insertions(+), 70 deletions(-) diff --git a/tilt.v b/tilt.v index 0d736b21..f716236f 100644 --- a/tilt.v +++ b/tilt.v @@ -352,8 +352,7 @@ Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n.+1) : Proof. by move=> e0; rewrite closed_ballE. Qed. -(* continuously differentiable*) -(* trajectory wise *) +(* TODO continuously differentiable*) Theorem Lyapunov_stability {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) (D : set 'rV[K]_n.+1) @@ -484,10 +483,9 @@ have HOmega_beta : Omega_beta `<=` interior (closed_ball_ [eta normr])``_r. by move : Hbb; rewrite ltxx. by exact: r_pos. have H1 : forall phi , solves_equation f phi D -> phi 0 \in Omega_beta -> forall t, 0 <= t -> phi t \in Omega_beta. - move => phi solves xOmega t t0. + move => phi solves_phi xOmega t t0. have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi 0) u <= 0 -> V (sol (phi 0) t) <= V (sol (phi 0) 0) <= beta. -(* have H2 : forall t, t >= 0 -> LieDerivative V phi x t <= 0 -> V (sol x t) <= V (sol x 0) <= beta.*) move => t1 t10 u u10. have -> : phi = sol (phi 0). apply: uniqueness_of_solution => //=. @@ -511,15 +509,15 @@ have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi rewrite -derivable1_diffP. by apply: diff_sol. - move=> s Hs_in. - move : (V'le_0 phi solves t t0). + move : (V'le_0 phi solves_phi t t0). rewrite LieDerivative_derive => //=; last first. rewrite inE in xOmega. have Hsol := fsolD (phi 0) _. - have Heq := uniqueness_of_solution phi (sol (phi 0)) (phi 0) solves _ _ _ => //. + have Heq := uniqueness_of_solution phi (sol (phi 0)) (phi 0) solves_phi _ _ _ => //. rewrite -Heq => //=. - rewrite /solves_equation in solves. + rewrite /solves_equation in solves_phi. rewrite -derivable1_diffP. - by case: solves => _ []. + by case: solves_phi => _ []. apply: Hsol. rewrite inE. apply: Br_sub_D. @@ -542,7 +540,13 @@ have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi move: solx0 => [_ [Hdiff _]]. rewrite -derivable1_diffP. exact: Hdiff. - admit. + apply: continuous_subspaceT. + move => x1. + apply: continuous_comp. + apply: differentiable_continuous => //. + case : (fsolD _ xinD) => _ [+ _] => /(_ x1). + by move => /(derivable1_diffP). + by apply: differentiable_continuous => //. - move: Hs1_pos => /andP [H0s1 Hs1s2]. by apply: H0s1. - move: Hs1_pos => /andP [H0s1 Hs1s2]. @@ -571,7 +575,7 @@ have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi by []. have H_lie : LieDerivative V sol (phi 0) t <= 0. apply V'le_0. - - exact solves. + - exact solves_phi. - exact t0. have V_bound := H2 t t0 t t00 H_lie. move : V_bound. @@ -604,49 +608,78 @@ have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi rewrite leNgt. apply/negP. have : `|phi t| > r -> exists t0, t0 >=0 /\ `|phi t0 | = r. - (* continuity, TVI *) - by admit. - move => cont solxr. - have [t1 [t1_ge0 xt1r]] := cont solxr. - have : alpha <= V (phi t1). - rewrite {}/alpha in alpha_gt0 Hbeta *. - move: Halpha alpha_gt0 Hbeta. - case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. - apply. - by rewrite inE /sphere_r/=. - have H1 : V (phi t1) >= alpha. - have sol_in_sphere : phi t1 \in sphere_r. + move : x0r. + move=> phi0_le_r r_lt_phit. + have bounds : minr `|phi 0| `|phi t| <= r <= maxr `|phi 0| `|phi t|. + rewrite /minr /maxr. + have r_le_phit : r <= `|phi t|. + by apply: ltW. + apply/andP; split. + case : ifPn => // . + rewrite -real_leNgt. + move=> phi_t_le_phi0. + apply: le_trans phi_t_le_phi0 phi0_le_r. + by apply normr_real. + by apply normr_real. + case: ltrP => Hcase. + exact: r_le_phit. + by apply: (le_trans r_le_phit Hcase). + have /IVT : 0 <= t by []. + move=> IVT. + have norm_phi_cont : {within `[0, t]%classic, continuous (fun u : K => `|phi u|)}. + apply: continuous_subspaceT. + rewrite -fctE. + move => x1. + apply: continuous_comp => //. + apply: differentiable_continuous => //. + case : (solves_phi) => _ [+ _] => /(_ x1). + by rewrite derivable1_diffP. + by apply: norm_continuous. + have [c cI norm_phi_c] := IVT (fun u => `|phi u|) r norm_phi_cont bounds. + exists c. + split => //. + move : cI. + move=> /itvP [c0 _]. + by case: c0 => [[c_ge0 _] _]. + move => cont solxr. + have [t1 [t1_ge0 xt1r]] := cont solxr. + have : alpha <= V (phi t1). + rewrite {}/alpha in alpha_gt0 Hbeta *. + move: Halpha alpha_gt0 Hbeta. + case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. + apply. + by rewrite inE /sphere_r/=. + have H1 : V (phi t1) >= alpha. + have sol_in_sphere : phi t1 \in sphere_r. + rewrite inE. + by rewrite /sphere_r. + rewrite {}/alpha in alpha_gt0 Hbeta *. + move: Halpha alpha_gt0 Hbeta. + case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. + exact. + have H3 : beta < V (phi t1). + rewrite (lt_le_trans _ H1)//. + by case/andP : Hbeta. + have : V (phi t1) <= beta. + have : forall u, u >= 0 -> LieDerivative V sol (phi 0) u <= 0. + move => u u0. + by apply V'le_0 => //. + move : (H2 t1 t1_ge0). + move=> Ht1 Hderiv. + have Heq_sol_phi : sol (phi 0) = phi. + apply: uniqueness_of_solution => //. + apply : fsolD => //. rewrite inE. - by rewrite /sphere_r. - rewrite {}/alpha in alpha_gt0 Hbeta *. - move: Halpha alpha_gt0 Hbeta. - case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. - exact. - have H3 : beta < V (phi t1). - rewrite (lt_le_trans _ H1)//. - by case/andP : Hbeta. - have : V (phi t1) <= beta. - have : forall u, u >= 0 -> LieDerivative V sol (phi 0) u <= 0. - move => u u0. - apply V'le_0. - - exact solves. - - exact u0. - move : (H2 t1 t1_ge0). - move=> Ht1 Hderiv. -have Heq_sol_phi : sol (phi 0) = phi. - apply: uniqueness_of_solution => //. - apply : fsolD => //. - rewrite inE. - apply: Br_sub_D => //. - rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. - by apply: x0r. -rewrite Heq_sol_phi in Ht1. -have Vphi_le := Ht1 t1 _ _. -have t1_chain : 0 <= t1 <= t1. - apply/andP ; split; [exact: t1_ge0 | exact: lexx]. -move: (Vphi_le t1_chain (Hderiv t1 t1_ge0)) => [/andP [Vt1_le V0_le_beta]]. -by apply: (le_trans Vt1_le). - by rewrite leNgt H3. + apply: Br_sub_D => //. + rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. + by apply: x0r. + rewrite Heq_sol_phi in Ht1. + have Vphi_le := Ht1 t1 _ _. + have t1_chain : 0 <= t1 <= t1. + by apply/andP ; split; [exact: t1_ge0 | exact: lexx]. + move: (Vphi_le t1_chain (Hderiv t1 t1_ge0)) => [/andP [Vt1_le V0_le_beta]]. + by apply: (le_trans Vt1_le). + by rewrite leNgt H3. have compact_Omega_beta : compact Omega_beta. rewrite /Omega_beta. (* use compact_closedI? *) @@ -666,12 +699,36 @@ have compact_Omega_beta : compact Omega_beta. rewrite [X in closed X](_ : _ = V @^-1` [set x : K | x <= beta]); last first. by apply/seteqP; split. apply: closed_comp => //=. - (* continuity*) - admit. + move => x1 _ => //. + apply: continuous_comp => //=. + by apply: differentiable_continuous => //. have [delta0 Hdelta0] : exists d, d > 0 /\ forall x, `|x| <= d -> V x < beta. rewrite /=. - (* continuity*) - admit. + have [d [d_pos Hd]] : exists d : K, 0 < d /\ + forall y, `|y - x| < d -> `|V y - V x| < beta. + have : V x @[x --> nbhs x] --> V x by exact: Hcont. + move : Hbeta. + move=> Hbeta_alpha /cvgrPdist_lt. + have beta_pos : 0 < beta by case/andP: Hbeta_alpha. + move=> /(_ beta beta_pos). + rewrite nearE /=. + move=> /nbhs_ballP [d d_pos Hd]. + exists d; split => // y Hy. + move: Hd; rewrite mx_norm_ball /ball_ /=. + move=> Hsub. + have Hy' : `|x - y| < d by rewrite distrC. + move: (Hsub y) => /= /(_ Hy'). + by rewrite distrC. + exists (d / 2); split. + by apply: divr_gt0 => //. + move=> x0 Hx0. + have Hx0' : `|x0 - x| < d. + rewrite subr0. + apply: (le_lt_trans Hx0). + by rewrite ltr_pdivrMr // ltr_pMr // ltr1n. + move: (Hd x0 Hx0'). + rewrite V0 subr0. + by apply: ltr_normlW. pose delta := Num.min delta0 r. have Hdelta : 0 < delta /\ (forall x, `|x| <= delta -> V x < beta). split. @@ -681,12 +738,14 @@ have Hdelta : 0 < delta /\ (forall x, `|x| <= delta -> V x < beta). rewrite /=. move => x1 xdel. move: Hdelta0 => [Hdelta0_pos Hdelta0_prop]. - have x_lt_delta0: `|x1| <= delta0. - rewrite /delta /minr in xdel. - apply: le_trans xdel _. - case: (delta0 < r) => //=. - (* dont know, continuity?*) - admit. +have delta_le_delta0 : delta <= delta0. + rewrite /delta. + rewrite /minr. + case: ifPn => //. + rewrite -real_leNgt => //. + by rewrite realE => //; rewrite ltW. + by rewrite realE => //; rewrite ltW. + have: `|x1| <= delta0 by apply: (le_trans xdel delta_le_delta0). by apply: Hdelta0_prop. have inclusion : (closed_ball_ [eta normr])``_delta `<=` Omega_beta /\ Omega_beta `<=` (closed_ball_ [eta normr])``_r . split; last first => //=. @@ -762,7 +821,6 @@ exists delta. by case: Hdelta. move=> x0_lt_delta t0 t0_ge0. rewrite /x subr0. -(* sol? z ?*) have Htraj0 : `|sol x t0| < r. rewrite /Omega_beta. have x0_in_Omega : x \in Omega_beta. @@ -1189,9 +1247,6 @@ rewrite mulmxBl; congr (_ - _)%R. by rewrite /erreur1 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. Qed. -(* TODO relier derivezp1 et derivez2 a eqn33?*) -(* TODO see about thm11a and the rest*) - End problem_statementB. Definition state_space_tilt {K : realType} := @@ -1956,10 +2011,6 @@ by apply: differentiable_cst. Unshelve. all: by end_near. Admitted. - - - - Definition is_lyapunov_stable_at {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) (A : set 'rV[K]_n.+1) From e2fd6e3385b7d337ecd9011915f42dcb3e47abd5 Mon Sep 17 00:00:00 2001 From: yosakaon Date: Wed, 8 Oct 2025 11:37:15 +0200 Subject: [PATCH 056/144] fix notation --- dh.v | 2 +- differential_kinematics.v | 12 ++++++------ frame.v | 20 +++++++++++--------- rot.v | 4 ++-- 4 files changed, 20 insertions(+), 18 deletions(-) diff --git a/dh.v b/dh.v index 0292a4f4..9aa12bd9 100644 --- a/dh.v +++ b/dh.v @@ -196,7 +196,7 @@ Variables F0 F1 : tframe T. Definition From1To0 := locked (F1 _R^ F0). Definition p1_in_0 : 'rV[T]_3 := (\o{F1} - \o{F0}) *m (can_tframe T) _R^ F0. -Goal `[ p1_in_0 $ F0 ] = rmap F0 `[ \o{F1} - \o{F0} $ can_tframe T ]. +Goal '[ p1_in_0 $ F0 ] = rmap F0 '[ \o{F1} - \o{F0} $ can_tframe T ]. Proof. rewrite /p1_in_0. by rewrite /rmap. diff --git a/differential_kinematics.v b/differential_kinematics.v index 0974f20d..b7266426 100644 --- a/differential_kinematics.v +++ b/differential_kinematics.v @@ -95,7 +95,7 @@ Section about_bound_vectors. Variables (T : pzRingType) (F : tframe T). -Definition FramedVect_of_Bound (p : bvec F) : fvec F := `[ BoundVect.endp p $ F ]. +Definition FramedVect_of_Bound (p : bvec F) : fvec F := '[ BoundVect.endp p $ F ]. Definition BoundVect_add (a b : bvec F) : bvec F := BoundVect.mk F (BoundVect.endp a + BoundVect.endp b). @@ -110,7 +110,7 @@ Lemma BoundFramed_addA (a : bvec F) (b c : fvec F) : Proof. by rewrite /BoundFramed_add /= addrA. Qed. Definition BoundVect_sub (F : tframe T) (a b : bvec F) : fvec F := - `[ BoundVect.endp a - BoundVect.endp b $ F ]. + '[ BoundVect.endp a - BoundVect.endp b $ F ]. Local Notation "a \-b b" := (BoundVect_sub a b). @@ -195,7 +195,7 @@ Proof. move=> HF HG a b. have @G' : forall t0, rframe (F t0). move=> t0. - exact: (@RFrame.mk _ _ (@BoundVect.mk _ _ \o{F t0}) `[(F t0)~i $ F t0] `[(F t0)~j $ F t0] `[(F t0)~k $ F t0] (F t0)). + exact: (@RFrame.mk _ _ (@BoundVect.mk _ _ \o{F t0}) '[(F t0)~i $ F t0] '[(F t0)~j $ F t0] '[(F t0)~k $ F t0] (F t0)). apply: (@derivable_mx_FromTo' R F G' G). by []. by []. @@ -511,7 +511,7 @@ Let o2 t : bvec F := RFrame.o (F2 t). Let r12 : forall t : R, bvec (F1 t) := fun t => BoundVect.mk (F1 t) - (FramedVect.v (rmap (F1 t) `[ \o{F2 t} - \o{F1 t} $ F ])). + (FramedVect.v (rmap (F1 t) '[ \o{F2 t} - \o{F1 t} $ F ])). Hypothesis derivable_F1 : forall t, derivable_mx F1 t 1. Hypothesis derivable_F1o : forall t, derivable_mx (@TFrame.o R^o \o F1) t 1. @@ -527,13 +527,13 @@ Qed. Definition w1 := ang_vel (fun t => (F1 t) _R^ F). -Lemma eqn314_helper t : FramedVect.v (rmap F `[r12 t $ F1 t]) = \o{F2 t} - \o{F1 t}. +Lemma eqn314_helper t : FramedVect.v (rmap F '[r12 t $ F1 t]) = \o{F2 t} - \o{F1 t}. Proof. by rewrite /= -mulmxA FromTo_comp FromToI mulmx1. Qed. (* lin. vel. of Link i as a function of the translational and rotational velocities of Link i-1 *) Lemma eqn314 t : 'D_1 (fun x => o2 x : 'M__) t = 'D_1 (fun x => o1 x : 'M__) t + - FramedVect.v (rmap F `['D_1 (fun x => r12 x : 'M__) t $ F1 t]) + FramedVect.v (rmap F '['D_1 (fun x => r12 x : 'M__) t $ F1 t]) (* velocity of the origin of Frame i w.r.t. the origin of Frame i-1 *) + w1 t *v (\o{F2 t} - \o{F1 t}). Proof. diff --git a/frame.v b/frame.v index 1b0829b2..9e266b08 100644 --- a/frame.v +++ b/frame.v @@ -855,27 +855,29 @@ End framed_vector. End FramedVect. Notation fvec := FramedVect.t. -Notation "`[ v $ F ]" := (FramedVect.mk F v) - (at level 5, v, F at next level, format "`[ v $ F ]"). +Notation "''[' v $ F ]" := (FramedVect.mk F v) + (at level 5, v, F at next level, format "''[' v $ F ]") : frame_scope. Definition FramedVect_add (T : pzRingType) (F : tframe T) (a b : fvec F) : fvec F := - `[ FramedVect.v a + FramedVect.v b $ F ]. + '[ FramedVect.v a + FramedVect.v b $ F ]. Notation "a \+f b" := (FramedVect_add a b) (at level 39). -Lemma fv_eq (T : pzRingType) a b : a = b -> forall F : frame T, `[ a $ F ] = `[ b $ F ]. +Lemma fv_eq (T : pzRingType) a b : a = b -> forall F : frame T, '[ a $ F ] = '[ b $ F ]. Proof. by move=> ->. Qed. +Notation "a \+f b" := (FramedVect_add a b) (at level 39). + Section change_of_coordinate_by_rotation. Variable T : realType. Implicit Types A B : frame T. -Lemma FramedVectvK A (x : fvec A) : `[FramedVect.v x $ A] = x. +Lemma FramedVectvK A (x : fvec A) : '[FramedVect.v x $ A] = x. Proof. by case: x. Qed. (* change of coordinates: "rotation mapping" from frame A to frame B *) -Definition rmap A B (x : fvec A) : fvec B := `[FramedVect.v x *m (A _R^ B) $ B]. +Definition rmap A B (x : fvec A) : fvec B := '[FramedVect.v x *m (A _R^ B) $ B]. Lemma rmapK A B (x : fvec A) : rmap A (rmap B x) = x. Proof. @@ -885,15 +887,15 @@ by rewrite divrr ?noframe_is_unit // mulmx1 /= FramedVectvK. Qed. Lemma rmapE A B (x : 'rV[T]_3) : - rmap B `[x $ A] = `[x *m A (*A->can*) *m B^T(*can->B*) $ B]. + rmap B '[x $ A] = '[x *m A (*A->can*) *m B^T(*can->B*) $ B]. Proof. by rewrite /rmap FromToE noframe_inv mulmxA. Qed. Lemma rmapE_from_can A (x : 'rV[T]_3) : - rmap A `[x $ can_tframe T] = `[x *m A^T $ A]. + rmap A '[x $ can_tframe T] = '[x *m A^T $ A]. Proof. by rewrite rmapE can_frame_1 mulmx1. Qed. Lemma rmapE_to_can A (x : 'rV[T]_3) : - rmap (can_tframe T) `[x $ A] = `[x *m A $ can_tframe T]. + rmap (can_tframe T) '[x $ A] = '[x *m A $ can_tframe T]. Proof. by rewrite rmapE can_frame_1 trmx1 mulmx1. Qed. End change_of_coordinate_by_rotation. diff --git a/rot.v b/rot.v index 4a187b24..9a22b759 100644 --- a/rot.v +++ b/rot.v @@ -345,8 +345,8 @@ Lemma RzE a : Rz a = (frame_of_SO (Rz_is_SO a)) _R^ (can_frame T). Proof. rewrite FromTo_to_can; by apply/matrix3P/and9P; split; rewrite !mxE. Qed. Lemma rmap_Rz_e0 a : - rmap (can_tframe T) `[ 'e_0 $ frame_of_SO (Rz_is_SO a) ] = - `[ row 0 (Rz a) $ can_tframe T ]. + rmap (can_tframe T) '[ 'e_0 $ frame_of_SO (Rz_is_SO a) ] = + '[ row 0 (Rz a) $ can_tframe T ]. Proof. by rewrite rmapE_to_can rowE [in RHS]RzE FromTo_to_can. Qed. Definition Rzy a b := col_mx3 From 7b4166cf4ee698e7f86c90664df752dc4609040e Mon Sep 17 00:00:00 2001 From: yosakaon Date: Wed, 8 Oct 2025 19:33:32 +0200 Subject: [PATCH 057/144] trying to prove 0 is stable --- tilt.v | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/tilt.v b/tilt.v index f716236f..0d555db1 100644 --- a/tilt.v +++ b/tilt.v @@ -2055,4 +2055,29 @@ have : root (char_poly (jacobian (eqn33' alpha1 gamma) point1)) a. rewrite /eqn33' /jacobian. Admitted. +Lemma equilibrium_zero_stable : + forall zp1_z2_point : K -> 'rV_6, + solves_equation (tilt_eqn alpha1 gamma) zp1_z2_point state_space_tilt -> + equilibrium_is_stable_at state_space_tilt point1 zp1_z2_point. +Proof. +move => y solves. +apply: Lyapunov_stability => //. +move => z. +rewrite inE. +move => statez. +by apply: solves. +admit. +admit. +rewrite -/point1. +have Hsubset : state_space_tilt = [set: 'rV_6]. + rewrite /state_space_tilt. + + admit. +rewrite Hsubset. +apply: V1_is_lyapunov_candidate => //. +Search V1. +have:= V1_point_is_lnsd. +move => y0 y1 solves1. +rewrite /locnegsemidef in y0. +Abort. End Lyapunov. From 58e6275944a3a9abe139b5876b191a6c5f530970 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 8 Oct 2025 20:05:38 +0900 Subject: [PATCH 058/144] progress, cleaning, fix --- derive_matrix.v | 10 +- tilt.v | 874 +++++++++++++++++++++++------------------------- tilt_robot.v | 8 +- 3 files changed, 431 insertions(+), 461 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index 89f0c72c..678b274f 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -470,16 +470,16 @@ by rewrite {}/f deriveM// mulrC addrC; congr (_ * _ + _ * _); rewrite derive_mx ?mxE//=; exact/derivable_mxP. Qed. -Global Instance is_diff_component {R : realFieldType} n i (p : 'rV[R]_n.+1) : +Global Instance is_diff_component {R : realFieldType} n i (p : 'rV[R]_n) : is_diff p (fun q => q..[i] : R^o) (fun q => q..[i]). Proof. -have comp_lin : linear (fun q : 'rV[R]_n.+1 => q..[i] : R^o). +have comp_lin : linear (fun q : 'rV[R]_n => q..[i] : R^o). by move=> ???; rewrite !mxE. -have comp_cont : continuous (fun q : 'rV[R]_n.+1 => q..[i] : R^o). +have comp_cont : continuous (fun q : 'rV[R]_n=> q..[i] : R^o). move=> q A [_/posnumP[e] Ae] /=; apply/nbhs_ballP; exists e%:num => //=. - by move=> r /(_ ord0) /(_ i) /Ae. + by move=> r [e0] /(_ ord0) /(_ i) /Ae. pose glM := GRing.isLinear.Build _ _ _ _ _ comp_lin. -pose gL : {linear 'rV_n.+1 -> R^o} := HB.pack (fun q : 'rV_n.+1 => q ..[ i]) glM. +pose gL : {linear 'rV_n -> R^o} := HB.pack (fun q : 'rV_n => q ..[ i]) glM. apply: DiffDef; first exact: (@linear_differentiable _ _ _ gL). by rewrite (@diff_lin _ _ _ gL). Qed. diff --git a/tilt.v b/tilt.v index 0d555db1..a7c40bfb 100644 --- a/tilt.v +++ b/tilt.v @@ -78,8 +78,9 @@ Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) x \in D /\ V x = 0 /\ open D /\ forall z, z \in D -> z != x -> V z > 0. (* add continuously diff *) -Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) (D : set 'rV[K]_n.+1) - (x0 : 'rV[K]_n.+1) := locposdef V D x0 /\ differentiable V x0. +Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) + (D : set 'rV[K]_n.+1) (x0 : 'rV[K]_n.+1) := + locposdef V D x0 /\ differentiable V x0. (* locally positive semi definite (NB* not used yet) *) Definition lpsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := @@ -252,7 +253,7 @@ Local Notation Right := (@rsubmx _ 1 3 3). Lemma LieDerivative_norm {K : realType} n m (f : 'rV[K]_n.+1 -> 'rV_m.+1) (phi : 'rV[K]_n.+1 -> K -> 'rV_n.+1) (x : 'rV[K]_n.+1) (t : K) : - differentiable f (phi x t) -> + differentiable f (phi x t) -> differentiable (phi x) t -> (forall t, differentiable f t) -> LieDerivative (fun y => (norm (f y)) ^+ 2) phi x t = @@ -268,7 +269,7 @@ replace (fun x0 : K => norm (f (phi x x0)) ^+ 2) rewrite !fctE. rewrite -fctE. apply/funext => s. - by rewrite /= /GRing.exp mul1r. + by rewrite /= /GRing.exp mul1r. rewrite derive_norm_squared => //=; last first. apply: diff_derivable=> //=. apply: differentiable_comp => //=. @@ -290,7 +291,8 @@ Let T := 'rV[K]_n.+1. Variable phi : (K -> T) -> K -> T. Definition solves_equation (x : K -> T) (A : set T) : Prop := - x 0 \in A /\ (forall t, derivable x t (1:K)%R) /\ forall t, 'D_1 x t = phi x t. + [/\ x 0 \in A, (forall t, derivable x t (1:K)%R) + & forall t, 'D_1 x t = phi x t]. Definition is_equilibrium_point x := solves_equation (cst x). @@ -301,7 +303,7 @@ Definition state_space A := Definition equilibrium_is_stable_at (A : set T) (x : T) (z : K -> 'rV[K]_n.+1) := - forall eps, eps > 0 -> + forall eps, eps > 0 -> exists2 d, d > 0 & (`| z 0 - x | < d -> forall t, t >= 0 -> `| z t - x | < eps). @@ -315,7 +317,7 @@ Definition equilibrium_is_asymptotically_stable_at (A : set T) (x : T) (z : K -> 'rV[K]_n.+1) : Prop := exists2 d, d > 0 & (`| z 0 - x | < d -> z t @[t --> +oo] --> x). - + End ode_equation. (* axiom cauchy thm 3.3 *) @@ -352,23 +354,40 @@ Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n.+1) : Proof. by move=> e0; rewrite closed_ballE. Qed. + +(* we introduce a definition of uniqueness of solutions of a +differential equation that we will assume when necessary for +lack of a formalization of Cauchy-Lipschitz/Picard-Lindelof theorem. *) +Section solutions_unique. +Context {K : realType} {n : nat}. +Variable D : set 'rV[K]_n.+1. +Variable f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. + +Definition solutions_unique := forall (a b : K -> 'rV_n.+1) (x0 : 'rV_n.+1), + solves_equation f a D -> + solves_equation f b D -> + a 0 = x0 -> b 0 = x0 -> + a = b. + +End solutions_unique. + +Section Lyapunov_stability. +Context {K : realType} {n : nat}. +Variable D : set 'rV[K]_n.+1. +Variable f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. +Hypothesis Df_unique : solutions_unique D f. + (* TODO continuously differentiable*) -Theorem Lyapunov_stability {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (D : set 'rV[K]_n.+1) +(* TODO: prove the same theorem with equilibrium_is_asymptotically_stable_at *) +Theorem lyapunov_stability (sol : 'rV_n.+1 -> K -> 'rV[K]_n.+1) (x : 'rV[K]_n.+1 := 0) (fsolD : forall z, z \in D -> solves_equation f (sol z) D) (sol0x : forall x, sol x 0 = x) - (uniqueness_of_solution : forall (phi1 phi2 : K -> 'rV_n.+1) (x0 : 'rV_n.+1), - solves_equation f phi1 D -> - solves_equation f phi2 D -> - phi1 0 = x0 -> phi2 0 = x0 -> - phi1 = phi2) (V : 'rV[K]_n.+1 -> K) (VDx : is_lyapunov_candidate V D x) (*contient l'hypothese x in D*) - (V'le_0 : forall phi, solves_equation f phi D -> forall t, t >= 0 -> LieDerivative V sol (phi 0) t <= 0) - (Vderiv : forall t, differentiable V t) : + (V'le_0 : forall phi, solves_equation f phi D -> forall t, t >= 0 -> LieDerivative V sol (phi 0) t <= 0) + (Vderiv : forall t, differentiable V t) : is_equilibrium_point f x D -> equilibrium_is_stable_at D x (sol x). Proof. @@ -417,7 +436,7 @@ pose sphere_r := [set x : 'rV[K]_n.+1 | `|x| = r]. have Halpha : {x : 'rV[K]_n.+1 | x \in sphere_r /\ forall y, y \in sphere_r -> V(x) <= V(y)}. (* extreme value theorem?*) (* sphere must be compact*) - admit. + admit. pose alpha := V (sval Halpha). have alpha_gt0 : 0 < alpha. have sphere_pos: forall y, y \in sphere_r -> 0 < V y. @@ -456,7 +475,7 @@ have HOmega_beta : Omega_beta `<=` interior (closed_ball_ [eta normr])``_r. rewrite /Omega_beta /=. have Hnorm_le : `|x1| <= r. move : Hx. - rewrite /closed_ball_ /ball. + rewrite /closed_ball_ /ball. under eq_fun do rewrite sub0r normrN. move => Hx. by apply: Hx. @@ -465,7 +484,7 @@ have HOmega_beta : Omega_beta `<=` interior (closed_ball_ [eta normr])``_r. exfalso. have Hrr : r < r by apply: (lt_le_trans Heq Hnorm_le). by move: Hrr; rewrite ltxx. - have xin_sphere : x1 \in sphere_r. + have xin_sphere : x1 \in sphere_r. rewrite /sphere_r inE. by apply: Hgt. have Vx_ge_alpha : alpha <= V x1. @@ -482,114 +501,104 @@ have HOmega_beta : Omega_beta `<=` interior (closed_ball_ [eta normr])``_r. have Hbb : beta < beta by apply: (lt_le_trans Hbeta_lt Hle_alpha_beta). by move : Hbb; rewrite ltxx. by exact: r_pos. -have H1 : forall phi , solves_equation f phi D -> phi 0 \in Omega_beta -> forall t, 0 <= t -> phi t \in Omega_beta. - move => phi solves_phi xOmega t t0. -have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi 0) u <= 0 -> - V (sol (phi 0) t) <= V (sol (phi 0) 0) <= beta. +have Df_Omega_beta phi : solves_equation f phi D -> phi 0 \in Omega_beta -> + forall t, 0 <= t -> phi t \in Omega_beta. + move=> solves_phi xOmega t t0. + have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi 0) u <= 0 -> + V (sol (phi 0) t) <= V (sol (phi 0) 0) <= beta. move => t1 t10 u u10. - have -> : phi = sol (phi 0). - apply: uniqueness_of_solution => //=. - apply: fsolD => //. - rewrite inE. - apply: Br_sub_D => //. - move : xOmega. - rewrite inE /Omega_beta. - by move => [H1 H2]. + have -> : phi = sol (phi 0). + apply: Df_unique => //=. + apply: fsolD => //. + rewrite inE. + apply: Br_sub_D => //. + move : xOmega. + by rewrite inE /Omega_beta => -[]. rewrite !sol0x /=. have Vneg_incr: forall s1 s2, 0 <= s1 <= s2 -> forall x, x \in D -> V (sol x s2) <= V (sol x s1). move=> s1 s2 Hs1_pos x0 xinD . - apply: (@ler0_derive1_nincr _ (fun s => V (sol x0 s)) 0 s2) => //. + apply: (@ler0_derive1_le_cc _ (fun s => V (sol x0 s)) 0 s2) => //. - rewrite -fctE. move => x1 x1in. apply: diff_derivable. - apply: differentiable_comp; last first. - apply: differentiable_comp => //. - have solx0 := fsolD _ xinD. - case: solx0 => _ [diff_sol _]. + apply: differentiable_comp; last exact: differentiable_comp. + have [_ diff_sol _] := fsolD _ xinD. rewrite -derivable1_diffP. - by apply: diff_sol. + exact: diff_sol. - move=> s Hs_in. - move : (V'le_0 phi solves_phi t t0). + move : (V'le_0 phi solves_phi t t0). rewrite LieDerivative_derive => //=; last first. - rewrite inE in xOmega. - have Hsol := fsolD (phi 0) _. - have Heq := uniqueness_of_solution phi (sol (phi 0)) (phi 0) solves_phi _ _ _ => //. - rewrite -Heq => //=. - rewrite /solves_equation in solves_phi. - rewrite -derivable1_diffP. - by case: solves_phi => _ []. - apply: Hsol. - rewrite inE. - apply: Br_sub_D. - by case: xOmega. + rewrite inE in xOmega. + have Hsol := fsolD (phi 0) _. + have Heq := @Df_unique phi (sol (phi 0)) (phi 0) _ _ _ => //. + rewrite -Heq => //=. + rewrite /solves_equation in solves_phi. + rewrite -derivable1_diffP. + by case: solves_phi. + apply: Hsol. + rewrite inE. + apply: Br_sub_D. + by case: xOmega. rewrite derive1E. rewrite fctE. move=> _. have H := V'le_0 (sol x0) (fsolD x0 xinD) s _. rewrite LieDerivative_derive sol0x in H. - rewrite -fctE. - apply: H. - move : Hs_in. - rewrite inE. - move=> /itvP [] [Hs Hs1 Hs2]. - rewrite ltW => //. - by rewrite Hs. - exact : Vderiv. - move: (fsolD x0 xinD) => solx0. - rewrite /solves_equation in solx0. - move: solx0 => [_ [Hdiff _]]. - rewrite -derivable1_diffP. - exact: Hdiff. - apply: continuous_subspaceT. + + rewrite -fctE. + apply: H. + move : Hs_in. + rewrite inE. + move=> /itvP [] [Hs Hs1 Hs2]. + rewrite ltW => //. + by rewrite Hs. + + exact : Vderiv. + + move: (fsolD x0 xinD) => solx0. + rewrite /solves_equation in solx0. + move: solx0 => [_ Hdiff _]. + rewrite -derivable1_diffP. + exact: Hdiff. + - apply: continuous_subspaceT. move => x1. apply: continuous_comp. - apply: differentiable_continuous => //. - case : (fsolD _ xinD) => _ [+ _] => /(_ x1). - by move => /(derivable1_diffP). - by apply: differentiable_continuous => //. - - move: Hs1_pos => /andP [H0s1 Hs1s2]. - by apply: H0s1. - - move: Hs1_pos => /andP [H0s1 Hs1s2]. - by apply: Hs1s2 => //=. + apply: differentiable_continuous => //. + case : (fsolD _ xinD) => _ + _ => /(_ x1). + by move => /(derivable1_diffP). + exact: differentiable_continuous. + - move: Hs1_pos => /andP[H0s1 Hs1s2]. + by rewrite !in_itv/= lexx (le_trans H0s1). + - by case/andP: Hs1_pos. have H3 : V (sol x t1) <= V (sol x 0). - apply: Vneg_incr => //=. - by apply/andP; split => //=. - move => bla. + by rewrite Vneg_incr//= t10 andbT. + move => bla. apply/andP; split => //=. + move : xOmega. + rewrite inE /Omega_beta. + move=> [clo Vxb]. + have Hdec := Vneg_incr 0 t1 _ (phi 0) _. + rewrite sol0x in Hdec. + apply: Hdec => //=. + by apply/andP; split => //. + rewrite inE /Omega_beta. + by apply: Br_sub_D. move : xOmega. - rewrite inE /Omega_beta. - move=> [clo Vxb]. - have Hdec := Vneg_incr 0 t1 _ (phi 0) _. - rewrite sol0x in Hdec. - apply: Hdec => //=. - by apply/andP; split => //. - rewrite inE /Omega_beta. - apply: Br_sub_D => //. - move : xOmega. - rewrite inE /Omega_beta. - by move=> [clo Vxb]. + by rewrite inE /Omega_beta => -[]. rewrite inE; split; last first. - have t00 : 0 <= t <= t. - apply/andP; split. - by []. - by []. - have H_lie : LieDerivative V sol (phi 0) t <= 0. - apply V'le_0. - - exact solves_phi. - - exact t0. - have V_bound := H2 t t0 t t00 H_lie. - move : V_bound. - rewrite !sol0x. - have -> : sol (phi 0) = phi. - apply: uniqueness_of_solution => //. - apply: fsolD => //. - rewrite inE. - apply: Br_sub_D => //. - move : xOmega. - rewrite inE /Omega_beta. - by move => [h1 h2]. - case/andP => h1 h2. - by apply: (le_trans h1 h2). + have t00 : 0 <= t <= t by rewrite lexx t0. + have H_lie : LieDerivative V sol (phi 0) t <= 0. + apply V'le_0. + - exact solves_phi. + - exact t0. + have := H2 t t0 t t00 H_lie. + rewrite !sol0x. + have -> : sol (phi 0) = phi; last first. + case/andP => h1 h2. + exact: (le_trans h1 h2). + apply: Df_unique => //. + apply: fsolD => //. + rewrite inE. + apply: Br_sub_D => //. + move : xOmega. + by rewrite inE /Omega_beta => -[]. move: xOmega. rewrite inE /Omega_beta/=. rewrite /closed_ball_/=. @@ -601,153 +610,136 @@ have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi rewrite interior_closed_ballE => //. rewrite /Omega_beta. rewrite /closed_ball_. - rewrite mx_norm_ball /ball_. + rewrite mx_norm_ball /ball_. rewrite /= => /(_ (sol x t)). under eq_fun do rewrite !sub0r normrN. move => a. - rewrite leNgt. - apply/negP. - have : `|phi t| > r -> exists t0, t0 >=0 /\ `|phi t0 | = r. - move : x0r. - move=> phi0_le_r r_lt_phit. - have bounds : minr `|phi 0| `|phi t| <= r <= maxr `|phi 0| `|phi t|. - rewrite /minr /maxr. - have r_le_phit : r <= `|phi t|. - by apply: ltW. - apply/andP; split. - case : ifPn => // . - rewrite -real_leNgt. - move=> phi_t_le_phi0. - apply: le_trans phi_t_le_phi0 phi0_le_r. - by apply normr_real. - by apply normr_real. - case: ltrP => Hcase. - exact: r_le_phit. - by apply: (le_trans r_le_phit Hcase). - have /IVT : 0 <= t by []. - move=> IVT. - have norm_phi_cont : {within `[0, t]%classic, continuous (fun u : K => `|phi u|)}. - apply: continuous_subspaceT. - rewrite -fctE. - move => x1. - apply: continuous_comp => //. - apply: differentiable_continuous => //. - case : (solves_phi) => _ [+ _] => /(_ x1). - by rewrite derivable1_diffP. - by apply: norm_continuous. - have [c cI norm_phi_c] := IVT (fun u => `|phi u|) r norm_phi_cont bounds. - exists c. - split => //. - move : cI. - move=> /itvP [c0 _]. - by case: c0 => [[c_ge0 _] _]. - move => cont solxr. - have [t1 [t1_ge0 xt1r]] := cont solxr. - have : alpha <= V (phi t1). - rewrite {}/alpha in alpha_gt0 Hbeta *. - move: Halpha alpha_gt0 Hbeta. - case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. - apply. - by rewrite inE /sphere_r/=. - have H1 : V (phi t1) >= alpha. - have sol_in_sphere : phi t1 \in sphere_r. - rewrite inE. - by rewrite /sphere_r. - rewrite {}/alpha in alpha_gt0 Hbeta *. - move: Halpha alpha_gt0 Hbeta. - case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. - exact. - have H3 : beta < V (phi t1). - rewrite (lt_le_trans _ H1)//. - by case/andP : Hbeta. - have : V (phi t1) <= beta. - have : forall u, u >= 0 -> LieDerivative V sol (phi 0) u <= 0. - move => u u0. - by apply V'le_0 => //. - move : (H2 t1 t1_ge0). - move=> Ht1 Hderiv. - have Heq_sol_phi : sol (phi 0) = phi. - apply: uniqueness_of_solution => //. - apply : fsolD => //. - rewrite inE. - apply: Br_sub_D => //. - rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. - by apply: x0r. - rewrite Heq_sol_phi in Ht1. - have Vphi_le := Ht1 t1 _ _. - have t1_chain : 0 <= t1 <= t1. - by apply/andP ; split; [exact: t1_ge0 | exact: lexx]. - move: (Vphi_le t1_chain (Hderiv t1 t1_ge0)) => [/andP [Vt1_le V0_le_beta]]. - by apply: (le_trans Vt1_le). - by rewrite leNgt H3. -have compact_Omega_beta : compact Omega_beta. - rewrite /Omega_beta. - (* use compact_closedI? *) - apply: bounded_closed_compact. - - rewrite /bounded_set /= /globally. - exists r => //=. - split => //=. - move => x1 rx x2. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - move=> [/= x0_le_r ?]. - apply: le_trans x0_le_r _. - exact: ltW rx. - - apply: closedI. - rewrite -closed_ballAE=> //=. - by apply: closed_ball_closed => //=. - rewrite /=. - rewrite [X in closed X](_ : _ = V @^-1` [set x : K | x <= beta]); last first. - by apply/seteqP; split. - apply: closed_comp => //=. - move => x1 _ => //. - apply: continuous_comp => //=. - by apply: differentiable_continuous => //. -have [delta0 Hdelta0] : exists d, d > 0 /\ forall x, `|x| <= d -> V x < beta. + rewrite leNgt. + apply/negP. + have : `|phi t| > r -> exists t0, t0 >=0 /\ `|phi t0 | = r. + move : x0r. + move=> phi0_le_r r_lt_phit. + have bounds : minr `|phi 0| `|phi t| <= r <= maxr `|phi 0| `|phi t|. + rewrite /minr /maxr. + have r_le_phit : r <= `|phi t| by apply: ltW. + apply/andP; split. + case : ifPn => // . + rewrite -real_leNgt ?normr_real//. + move=> phi_t_le_phi0. + exact: le_trans phi_t_le_phi0 phi0_le_r. + case: ltrP => Hcase. + exact: r_le_phit. + exact: le_trans Hcase. + have /IVT : 0 <= t by []. + move=> IVT. + have norm_phi_cont : {within `[0, t]%classic, continuous (fun u : K => `|phi u|)}. + apply: continuous_subspaceT. + rewrite -fctE. + move => x1. + apply: continuous_comp => //. + apply: differentiable_continuous => //. + case : (solves_phi) => _ + _ => /(_ x1). + by rewrite derivable1_diffP. + by apply: norm_continuous. + have [c cI norm_phi_c] := IVT (fun u => `|phi u|) r norm_phi_cont bounds. + exists c; split => //. + move : cI. + move=> /itvP [c0 _]. + by case: c0 => [[c_ge0 _] _]. + move => cont solxr. + have [t1 [t1_ge0 xt1r]] := cont solxr. + have : alpha <= V (phi t1). + rewrite {}/alpha in alpha_gt0 Hbeta *. + move: Halpha alpha_gt0 Hbeta. + case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. + apply. + by rewrite inE /sphere_r/=. + move=> alphaVphit1. + have : beta < V (phi t1). + rewrite (lt_le_trans _ alphaVphit1)//. + by case/andP : Hbeta. + apply/negP; rewrite -leNgt. + have : forall u, u >= 0 -> LieDerivative V sol (phi 0) u <= 0. + move => u u0. + by apply V'le_0 => //. + move : (H2 t1 t1_ge0). + move=> Ht1 Hderiv. + have Heq_sol_phi : sol (phi 0) = phi. + apply: Df_unique => //. + apply : fsolD => //. + rewrite inE. + apply: Br_sub_D => //. + rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. + by apply: x0r. + rewrite Heq_sol_phi in Ht1. + have Vphi_le := Ht1 t1 _ _. + have t1_chain : 0 <= t1 <= t1. + by apply/andP ; split; [exact: t1_ge0 | exact: lexx]. + move: (Vphi_le t1_chain (Hderiv t1 t1_ge0)) => [/andP [Vt1_le V0_le_beta]]. + exact: (le_trans Vt1_le). +have _ : compact Omega_beta. + rewrite /Omega_beta. + (* use compact_closedI? *) + apply: bounded_closed_compact. + - rewrite /bounded_set /= /globally. + exists r => //=. + split => //= => x1 rx x2. + rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. + move=> [/= x0_le_r ?]. + apply: le_trans x0_le_r _. + exact: ltW rx. + - apply: closedI. + rewrite -closed_ballAE=> //=. + exact: closed_ball_closed. + rewrite /=. + rewrite [X in closed X](_ : _ = V @^-1` [set x : K | x <= beta]); last first. + by apply/seteqP; split. + apply: closed_comp => //= x1 _. + apply: continuous_comp => //=. + exact: differentiable_continuous. +have [d0 Vbeta] : exists d, d > 0 /\ forall x, `|x| <= d -> V x < beta. rewrite /=. - have [d [d_pos Hd]] : exists d : K, 0 < d /\ - forall y, `|y - x| < d -> `|V y - V x| < beta. - have : V x @[x --> nbhs x] --> V x by exact: Hcont. - move : Hbeta. - move=> Hbeta_alpha /cvgrPdist_lt. - have beta_pos : 0 < beta by case/andP: Hbeta_alpha. - move=> /(_ beta beta_pos). - rewrite nearE /=. - move=> /nbhs_ballP [d d_pos Hd]. - exists d; split => // y Hy. - move: Hd; rewrite mx_norm_ball /ball_ /=. - move=> Hsub. - have Hy' : `|x - y| < d by rewrite distrC. - move: (Hsub y) => /= /(_ Hy'). - by rewrite distrC. - exists (d / 2); split. - by apply: divr_gt0 => //. - move=> x0 Hx0. - have Hx0' : `|x0 - x| < d. - rewrite subr0. - apply: (le_lt_trans Hx0). - by rewrite ltr_pdivrMr // ltr_pMr // ltr1n. - move: (Hd x0 Hx0'). - rewrite V0 subr0. - by apply: ltr_normlW. -pose delta := Num.min delta0 r. + have [d [d_pos Hd]] : exists d : K, 0 < d /\ + forall y, `|y - x| < d -> `|V y - V x| < beta. + have : V x @[x --> nbhs x] --> V x by exact: Hcont. + move : Hbeta. + move=> Hbeta_alpha /cvgrPdist_lt. + have beta_pos : 0 < beta by case/andP: Hbeta_alpha. + move=> /(_ beta beta_pos). + rewrite nearE /=. + move=> /nbhs_ballP [d d_pos Hd]. + exists d; split => // y Hy. + move: Hd; rewrite mx_norm_ball /ball_ /=. + move=> Hsub. + have Hy' : `|x - y| < d by rewrite distrC. + move: (Hsub y) => /= /(_ Hy'). + by rewrite distrC. + exists (d / 2); split; first exact: divr_gt0. + move=> x0 Hx0. + have /(Hd x0) : `|x0 - x| < d. + by rewrite subr0 (le_lt_trans Hx0)// ltr_pdivrMr // ltr_pMr // ltr1n. + rewrite V0 subr0. + exact: ltr_normlW. +pose delta := Num.min d0 r. have Hdelta : 0 < delta /\ (forall x, `|x| <= delta -> V x < beta). split. rewrite /delta /minr. - case: (delta0 < r) => //=. - exact: Hdelta0.1. + case: (d0 < r) => //=. + by case: Vbeta. rewrite /=. move => x1 xdel. - move: Hdelta0 => [Hdelta0_pos Hdelta0_prop]. -have delta_le_delta0 : delta <= delta0. - rewrite /delta. - rewrite /minr. - case: ifPn => //. - rewrite -real_leNgt => //. - by rewrite realE => //; rewrite ltW. - by rewrite realE => //; rewrite ltW. - have: `|x1| <= delta0 by apply: (le_trans xdel delta_le_delta0). + move: Vbeta => [Hdelta0_pos Hdelta0_prop]. + have delta_le_delta0 : delta <= d0. + rewrite /delta. + rewrite /minr. + case: ifPn => //. + rewrite -real_leNgt => //. + by rewrite realE => //; rewrite ltW. + by rewrite realE => //; rewrite ltW. + have: `|x1| <= d0 by apply: (le_trans xdel delta_le_delta0). by apply: Hdelta0_prop. -have inclusion : (closed_ball_ [eta normr])``_delta `<=` Omega_beta /\ Omega_beta `<=` (closed_ball_ [eta normr])``_r . +have inclusion : (closed_ball_ [eta normr])``_delta `<=` Omega_beta /\ + Omega_beta `<=` (closed_ball_ [eta normr])``_r . split; last first => //=. apply: subset_trans HOmega_beta _. rewrite -closed_ballAE /=. @@ -766,7 +758,7 @@ have inclusion : (closed_ball_ [eta normr])``_delta `<=` Omega_beta /\ Omega_ apply: ltW. by have Vx_lt_beta := Hdelta_bound _ Hx. rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - have delta_le_r: delta <= r. + have delta_le_r: delta <= r. rewrite /delta. rewrite /minr. case: ifP => Hlt => //. @@ -810,13 +802,12 @@ have Hlast : `|sol x 0| < delta -> forall t : K , t >=0 -> `|sol x t| < r <= eps by apply: sol0delta. move : (Hin_ball_delta _ z0_in_ball). by move => [clo Vxb]. - apply: H1 => //. + apply: Df_Omega_beta => //. by apply: fsolD => //. rewrite -closed_ballAE => //=. rewrite interior_closed_ballE => //=. rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. - move => etc. - by apply/andP; split => //. + by move=> /= ->/=. exists delta. by case: Hdelta. move=> x0_lt_delta t0 t0_ge0. @@ -829,53 +820,29 @@ have Htraj0 : `|sol x t0| < r. rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. apply: ltW. rewrite /x. - rewrite sol0x in x0_lt_delta. - by apply: x0_lt_delta. + by move: x0_lt_delta; rewrite sol0x; exact. have sol_in_Omega : sol x t0 \in Omega_beta. - apply: H1 => //=. + apply: Df_Omega_beta => //=. by apply: fsolD => //. rewrite sol0x. exact: x0_in_Omega; exact: t0_ge0. rewrite /Omega_beta inE in sol_in_Omega. - case: sol_in_Omega => Hnorm _. - move : Hnorm. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - move => Hnorm. - have traj_in_Omega : sol x t0 \in Omega_beta. - apply: H1 => //. + case: sol_in_Omega => + _. + (rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN) => Hnorm. + have : ((closed_ball_ [eta normr])``_r)° (sol x t0). + apply: HOmega_beta. + rewrite -inE Df_Omega_beta//. apply: fsolD => //. by rewrite sol0x. - have in_interior: ((closed_ball_ [eta normr])``_r)° (sol x t0). - apply: HOmega_beta. - rewrite -inE. - exact: traj_in_Omega. - move: in_interior. - rewrite -closed_ballE /=. - rewrite interior_closed_ballE => //=. + rewrite -(closed_ballE _ r_pos) interior_closed_ballE //=. rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. - apply => //=. - exact : r_pos. + exact. rewrite sol0x in x0_lt_delta. -by apply: (lt_le_trans Htraj0 r_le_eps). - +exact: lt_le_trans r_le_eps. Admitted. -Theorem Lyapunov_asymptotic_stability {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (D : set 'rV[K]_n.+1) - (sol : 'rV_n.+1 -> K -> 'rV[K]_n.+1) - (x : 'rV[K]_n.+1 := 0) - (fsolD : forall z, z \in D -> solves_equation f (sol z) D) - (V : 'rV[K]_n.+1 -> K) - (VDx : is_lyapunov_candidate V D x) (*contient l'hypothese x in D*) - (V'le_0 : forall phi, solves_equation f phi D -> forall t, t >= 0 -> LieDerivative V sol (phi 0) t <= 0) - (Vderiv : forall t, differentiable V t) : - is_equilibrium_point f x D -> - equilibrium_is_asymptotically_stable_at D x (sol x). -Proof. -move => eq. +End Lyapunov_stability. -Admitted. (* see Appendix VII.A of https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) Section basic_facts. @@ -1010,11 +977,11 @@ Hypothesis derivableR : forall t, derivable R t 1. Variable v : K -> 'rV[K]_3. Let x1 t := v t. Let x2 t : 'rV_3 := ('e_2) *m R t (* eqn (8) *). (* local frame ez ? *) -Let x1_point t := 'D_1 x1 t. -Let x2_point t := 'D_1 x2 t. +Let x1_dot t := 'D_1 x1 t. +Let x2_dot t := 'D_1 x2 t. Let w t := ang_vel R t. -Lemma x2_s2 (t0 : K) : x2 t0 \in S2. +Lemma x2_S2 (t0 : K) : x2 t0 \in S2. Proof. rewrite /S2 /x2 /=. rewrite inE /= orth_preserves_norm. @@ -1024,7 +991,7 @@ Qed. (* not used but could be interesting *) Lemma dRu t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) (w' := ang_vel T) - : 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(w' t) + 'D_1 u t *m T t. + : 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(w' t) + 'D_1 u t *m T t. Proof. rewrite derive_mulmx; last 2 first. admit. @@ -1053,13 +1020,13 @@ by rewrite (addrC(-_)) subrr add0r. Qed. (* eqn 11b *) -Lemma derive_x2 (t : K) : x2_point t = x2 t *m \S( w t ). +Lemma derive_x2 (t : K) : x2_dot t = x2 t *m \S( w t ). Proof. rewrite /w. rewrite -ang_vel_mxE; last 2 first. by move=> ?; rewrite rotation_sub. by []. -rewrite /x2_point. +rewrite /x2_dot. rewrite /x2. have ->: 'D_1 (fun t0 : K => 'e_2 *m (R t0)) t = ('e_2 *m 'D_1 (fun t => (R t)) t). move => n. @@ -1090,48 +1057,50 @@ Variable g0 : K. Hypotheses g0_eq0 : g0 != 0. Notation y_a := (y_a v R g0). Let x1 t := v t . -Let x2'hat t := -(alpha1 / g0) *: (x1 t - x1_hat t). (* 12b*) -Hypothesis eq12a : forall t, 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'hat t. -Hypothesis eq12c : forall t, 'D_1 x2_hat t = x2_hat t *m \S(w t - gamma *: x2'hat t *m \S(x2_hat t)). (*12c*) +Let x2'_hat t := -(alpha1 / g0) *: (x1 t - x1_hat t). (* 12b*) +Hypothesis eq12a : forall t, 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'_hat t. +Hypothesis eq12c : forall t, 'D_1 x2_hat t = x2_hat t *m \S(w t - gamma *: x2'_hat t *m \S(x2_hat t)). (*12c*) Hypothesis x2_hat_S2 : x2_hat 0 \in S2. Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. Hypothesis v_derivable : forall t, derivable v t 1. Notation x2 := (x2 R). -Let erreur1 t := x2 t - x2'hat t. -Let erreur2 t := x2 t - x2_hat t. -Let erreur1_point t := 'D_1 erreur1 t. -Let errur2_point t := 'D_1 erreur2 t. +(* estimation error *) +Let error1 t := x2 t - x2'_hat t. (* p_1 in [benallegue2023ieeetac] *) +Let error2 t := x2 t - x2_hat t. (* \tilde{x_2} in [benallegue2023ieeetac] *) +Let error1_dot t := 'D_1 error1 t. +Let error2_dot t := 'D_1 error2 t. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. -Let erreur1_p t := erreur1 t *m (R t)^T. -Let erreur2_p t := erreur2 t *m (R t)^T. +(* projection from the local frame to the world frame(?) *) +Let error1_p t := error1 t *m (R t)^T. +Let error2_p t := error2 t *m (R t)^T. Hypothesis norm_x2_hat : forall t, norm (x2_hat t) = 1. -Let p1E : erreur1 = fun t => x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). +Let error1E : error1 = fun t => x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). Proof. apply/funext => ?. -rewrite /erreur1 /x2; congr +%R. -by rewrite /x2'hat scaleNr opprK. +rewrite /error1 /x2; congr +%R. +by rewrite /x2'_hat scaleNr opprK. Qed. -Let x2_tildeE t : erreur2 t = erreur2_p t *m R t. +Let error2E t : error2 t = error2_p t *m R t. Proof. -rewrite /erreur2 -mulmxA. +rewrite /error2 -mulmxA. by rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. Qed. Let derivable_x2 t : derivable x2 t 1. Proof. exact: derivable_mulmx. Qed. -Let derivable_x2'hat t : derivable x2'hat t 1. +Let derivable_x2'_hat t : derivable x2'_hat t 1. Proof. by apply: derivableZ => /=; exact: derivableB. Qed. -Let derivable_erreur1 t : derivable erreur1 t 1. Proof. exact: derivableB. Qed. +Let derivable_error1 t : derivable error1 t 1. Proof. exact: derivableB. Qed. -Let derivable_x2_tilde t : derivable erreur2 t 1. Proof. exact: derivableB. Qed. +Let derivable_error2 t : derivable error2 t 1. Proof. exact: derivableB. Qed. -Lemma derive_erreur1 t : 'D_1 erreur1 t = erreur1 t *m \S(w t) - alpha1 *: erreur1 t. +Lemma derive_error1 t : 'D_1 error1 t = error1 t *m \S(w t) - alpha1 *: error1 t. Proof. simpl in *. -rewrite p1E. +rewrite error1E. rewrite deriveD//=; last first. by apply: derivableZ => /=; exact: derivableB. rewrite deriveZ//=; last exact: derivableB. @@ -1140,49 +1109,54 @@ rewrite !(derive_x2) // -/(x2 t) /=. rewrite (derive_x1 g0 R) //. rewrite -/(x2 t) -/(v t) -/(x1 t) -/(w t). rewrite eq12a. -transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) - alpha1 *: erreur1 t). - transitivity (x2 t *m \S(w t) + (alpha1 / g0) *: (x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'hat t))). - congr (_ + _ *: _). - rewrite -2![in LHS]addrA -[in RHS]addrA. - congr +%R. - rewrite opprD [in LHS]addrCA. - rewrite opprK. - rewrite [in RHS]opprB. - rewrite [in RHS]addrCA [in RHS]addrC. - rewrite -[in RHS]addrA. - congr +%R. - rewrite [in LHS]addrA. - congr +%R. - by rewrite opprD addrCA subrr addr0. - rewrite (_ : x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'hat t) = - (x1 t - x1_hat t) *m \S(w t) - g0 *: (x2 t - x2'hat t)); last first. +transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) + - alpha1 *: error1 t). + transitivity (x2 t *m \S(w t) + (alpha1 / g0) + *: (x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'_hat t))). + congr (_ + _ *: _). + rewrite -2![in LHS]addrA -[in RHS]addrA. + congr +%R. + rewrite opprD [in LHS]addrCA. + rewrite opprK. + rewrite [in RHS]opprB. + rewrite [in RHS]addrCA [in RHS]addrC. + rewrite -[in RHS]addrA. + congr +%R. + rewrite opprD. + rewrite [LHS]addrA. + rewrite (addrC (y_a t)). + by rewrite subrK. + rewrite (_ : x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'_hat t) = + (x1 t - x1_hat t) *m \S(w t) - g0 *: (x2 t - x2'_hat t)); last first. rewrite mulmxBl scalerDr scalerN opprB addrA [LHS]addrC 2!addrA. rewrite -addrA; congr +%R. by rewrite addrC. by rewrite opprB addrC. - rewrite -/(erreur1 t). + rewrite -/(error1 t). rewrite scalerDr addrA scalemxAl -mulmxDl scalerN scalerA. by rewrite divfK. -by rewrite p1E. +by rewrite error1E. Qed. -Lemma derive_erreur2 t : 'D_1 erreur2 t = erreur2 t *m \S( w t) - gamma *: (erreur2 t - erreur1 t) *m \S( x2_hat t ) ^+ 2 . +Lemma derive_error2 t : + 'D_1 error2 t = error2 t *m \S( w t) + - gamma *: (error2 t - error1 t) *m \S(x2_hat t) ^+ 2. Proof. -rewrite /erreur2. +rewrite /error2. rewrite [in LHS]deriveB//. rewrite derive_x2//. -rewrite -/(x2 t) -/(w t) -/(erreur2 t). +rewrite -/(x2 t) -/(w t) -/(error2 t). rewrite eq12c. rewrite spinD spinN. rewrite -[in LHS]scalemxAl. rewrite (spinZ gamma). rewrite mulmxBr opprB [LHS]addrA [in LHS]addrC addrA (addrC _ (x2 t *m \S(w t))). -rewrite -mulmxBl -/(erreur2 t). +rewrite -mulmxBl -/(error2 t). congr +%R. rewrite -scalemxAr -mulNmx -scalerN -[RHS]scalemxAl. congr (_ *: _). -rewrite /erreur2 /erreur1. -rewrite (opprB _ (x2'hat t)) -addrA (addrC (x2 t)) addrA subrK opprD opprK mulmxBl. +rewrite /error2 /error1. +rewrite (opprB _ (x2'_hat t)) -addrA (addrC (x2 t)) addrA subrK opprD opprK mulmxBl. rewrite [X in _ = X + _](_ : _ = 0) ?add0r; last first. rewrite mulmxA. rewrite -(mulmxA(x2_hat t)) sqr_spin //. @@ -1194,19 +1168,19 @@ rewrite [in RHS]mulmxA [in RHS]spinE spinE spinE. by rewrite [LHS](@lieC _ (vec3 K))/=. Qed. -Lemma Rx2 t : x2_hat t *m (R t)^T = 'e_2 - erreur2_p t. +Lemma Rx2 t : x2_hat t *m (R t)^T = 'e_2 - error2_p t. Proof. -rewrite /erreur2_p /erreur2 mulmxBl opprB addrCA. +rewrite /error2_p /error2 mulmxBl opprB addrCA. rewrite [X in _ + X](_ : _ = 0) ?addr0//. rewrite /x2 -mulmxA. by rewrite orthogonal_mul_tr ?rotation_sub// mulmx1 subrr. Qed. -Lemma derive_erreur1_p t : 'D_1 erreur1_p t = -alpha1 *: erreur1_p t. +Lemma derive_error1_p t : 'D_1 error1_p t = -alpha1 *: error1_p t. Proof. -rewrite /erreur1. +rewrite /error1. rewrite derive_mulmx//=; last by rewrite derivable_trmx. -rewrite derive_erreur1. +rewrite derive_error1. rewrite mulmxBl addrAC. apply/eqP. rewrite subr_eq. @@ -1218,7 +1192,7 @@ rewrite -/(w t) -mulmxA -mulmxDr trmx_mul tr_spin. by rewrite mulNmx subrr mulmx0. Qed. -Lemma derive_erreur2_p t : 'D_1 erreur2_p t = gamma *: (erreur2_p t - erreur1_p t) *m - \S('e_2 - erreur2_p t)^+2. +Lemma derive_error2_p t : 'D_1 error2_p t = gamma *: (error2_p t - error1_p t) *m - \S('e_2 - error2_p t)^+2. Proof. rewrite [LHS]derive_mulmx//=; last first. by rewrite derivable_trmx. @@ -1229,7 +1203,7 @@ rewrite derive1mx_ang_vel//=; last first. rewrite !ang_vel_mxE//; last first. by move => t0; rewrite rotation_sub. rewrite trmx_mul mulmxA -mulmxDl. -rewrite derive_erreur2 /=. +rewrite derive_error2 /=. rewrite addrAC -/(w t) tr_spin mulmxN subrr sub0r. rewrite -[in LHS]scalemxAl -scaleNr -[in LHS]scalemxAl. rewrite mulmxN -scalemxAl -[in RHS]scaleNr. @@ -1242,9 +1216,9 @@ congr (_ *m _ *m _). rewrite -[in RHS]mulmxA. rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. congr (_ *m _). -rewrite x2_tildeE. +rewrite error2E. rewrite mulmxBl; congr (_ - _)%R. -by rewrite /erreur1 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. +by rewrite /error1 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. Qed. End problem_statementB. @@ -1252,33 +1226,33 @@ End problem_statementB. Definition state_space_tilt {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. -Section eqn33. +Section tilt_eqn. Variable K : realType. Variable alpha1 : K. Variable gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Definition tilt_eqn (zp1_z2_point : K -> 'rV[K]_6) : K ->'rV[K]_6 := - let zp1_point := Left \o zp1_z2_point in - let z2_point := Right \o zp1_z2_point in - fun t => row_mx (- alpha1 *: zp1_point t) - (gamma *: (z2_point t - zp1_point t) *m \S('e_2%:R - z2_point t) ^+ 2). +Definition tilt_eqn (error1_p_error2_dot : K -> 'rV[K]_6) : K ->'rV[K]_6 := + let error1_p_dot := Left \o error1_p_error2_dot in + let error2_dot := Right \o error1_p_error2_dot in + fun t => row_mx (- alpha1 *: error1_p_dot t) + (gamma *: (error2_dot t - error1_p_dot t) *m \S('e_2%:R - error2_dot t) ^+ 2). -(* TODO: use tilt_eqn *) -Definition eqn33' (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := +Definition tilt_eqn_wip (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := let zp1_point := Left zp1_z2_point in let z2_point := Right zp1_z2_point in row_mx (- alpha1 *: zp1_point) (gamma *: (z2_point - zp1_point) *m \S('e_2%:R - z2_point) ^+ 2). -(*Lemma eqn33E t : eqn33 y0 t = eqn33' (y0 t). Proof. by []. Qed.*) +Lemma tilt_eqnE f t : tilt_eqn f t = tilt_eqn_wip (f t). +Proof. by []. Qed. -Lemma eqn33'_lipschitz : exists k, k.-lipschitz_setT eqn33'. +Lemma tilt_eqn_wip_lipschitz : exists k, k.-lipschitz_setT tilt_eqn_wip. Proof. near (pinfty_nbhs K) => k. exists k => -[/= x x0] _. -rewrite /eqn33'. +rewrite /tilt_eqn_wip. set fx := row_mx (- alpha1 *: Left x) (gamma *: (Right x - Left x) *m \S('e_2 - Right x) ^+ 2). set fy := row_mx (- alpha1 *: Left x0) @@ -1327,7 +1301,7 @@ Abort. Lemma thm11a : state_space tilt_eqn state_space_tilt = state_space_tilt . Proof. apply/seteqP; split. -- move=> p [y [[y0_init1]] [deri] y33 ] [t ->]. +- move=> p [y [[y0_init1]] deri y33 ] [t ->]. rewrite /state_space_tilt. have : derive1 (fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). @@ -1402,23 +1376,22 @@ apply/seteqP; split. rewrite /solves_equation /=. exists (fun _ : K => 0). split. - split. - by rewrite inE /= rsubmx_const subr0 normeE. - split. - apply: derivable_cst => //. - move => t. - rewrite /tilt_eqn /= derive_cst. - apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. - split. - apply/eqP. - have alpha1_neq0 : alpha1 != 0 by rewrite gt_eqF. - apply/eqP. - rewrite scaler_eq0 //. - rewrite eqr_oppLR oppr0. - move/negbTE: alpha1_neq0 => alpha1_nz. - rewrite alpha1_nz // Bool.orb_false_l. - by rewrite lsubmx_const. - by rewrite lsubmx_const rsubmx_const subr0 scaler0 mul0mx. + + split. + * by rewrite inE /= rsubmx_const subr0 normeE. + * by apply: derivable_cst => //. + * move => t. + rewrite /tilt_eqn /= derive_cst. + apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. + split. + apply/eqP. + have alpha1_neq0 : alpha1 != 0 by rewrite gt_eqF. + apply/eqP. + rewrite scaler_eq0 //. + rewrite eqr_oppLR oppr0. + move/negbTE: alpha1_neq0 => alpha1_nz. + rewrite alpha1_nz // Bool.orb_false_l. + by rewrite lsubmx_const. + by rewrite lsubmx_const rsubmx_const subr0 scaler0 mul0mx. admit. (* NG *) Admitted. @@ -1428,55 +1401,53 @@ Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). Lemma equilibrium_point1 : is_equilibrium_point tilt_eqn point1 state_space_tilt. Proof. split => //=. - rewrite inE /state_space_tilt /point1. +- rewrite inE /state_space_tilt /point1. rewrite /=. by rewrite rsubmx_const /= subr0 normeE. -split => //=. -move=> t ; rewrite derive_cst /tilt_eqn /point1; apply/eqP. -rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. - rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. - rewrite /=. - by rewrite lsubmx_const. -apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. - rewrite /N /=; apply /rowP; move => a. - rewrite !mxE. - by rewrite subrr. -by move => n; rewrite n scaler0 mul0mx. +- move=> t ; rewrite derive_cst /tilt_eqn /point1; apply/eqP. + rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. + rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. + rewrite /=. + by rewrite lsubmx_const. + apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. + rewrite /N /=; apply /rowP; move => a. + rewrite !mxE. + by rewrite subrr. + by move => n; rewrite n scaler0 mul0mx. Qed. Lemma equilibrium_point2 : is_equilibrium_point tilt_eqn point2 state_space_tilt. Proof. split => //. - rewrite inE /state_space_tilt /point2 /=. +- rewrite inE /state_space_tilt /point2 /=. rewrite row_mxKr. rewrite -[X in X - _ ]scale1r. rewrite -scalerBl normZ normeE mulr1 distrC. rewrite [X in _ - X](_:1 = 1%:R) //. by rewrite -natrB //= normr1. -split => //. -move => t. rewrite derive_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. -set N := (X in _ *: X == 0 /\ _). -have N0 : N = 0. - apply/rowP; move => i; rewrite !mxE; case: splitP. - move => j _; by rewrite mxE. - move => k /= i3k. - have := ltn_ord i. - by rewrite i3k -ltn_subRL subnn. -split. - by rewrite scaler_eq0 N0 eqxx orbT. -rewrite -scalemxAl scalemx_eq0 gt_eqF//=. -rewrite -[Left point2]/N N0 subr0. -set M := (X in X *m _); rewrite -/M. -have ME : M = 2 *: 'e_2. - apply/rowP => i; rewrite !mxE eqxx/=. - case: splitP => [j ij|j]/=. - have := ltn_ord j. - by rewrite -ij. - move/eqP. - rewrite eqn_add2l => /eqP /ord_inj ->. - by rewrite !mxE eqxx/=. -rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. -by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. +- move => t. rewrite derive_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. + set N := (X in _ *: X == 0 /\ _). + have N0 : N = 0. + apply/rowP; move => i; rewrite !mxE; case: splitP. + move => j _; by rewrite mxE. + move => k /= i3k. + have := ltn_ord i. + by rewrite i3k -ltn_subRL subnn. + split. + by rewrite scaler_eq0 N0 eqxx orbT. + rewrite -scalemxAl scalemx_eq0 gt_eqF//=. + rewrite -[Left point2]/N N0 subr0. + set M := (X in X *m _); rewrite -/M. + have ME : M = 2 *: 'e_2. + apply/rowP => i; rewrite !mxE eqxx/=. + case: splitP => [j ij|j]/=. + have := ltn_ord j. + by rewrite -ij. + move/eqP. + rewrite eqn_add2l => /eqP /ord_inj ->. + by rewrite !mxE eqxx/=. + rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. + by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. Qed. Variable F1 : 'rV[K]_6 -> 'rV[K]_6. @@ -1494,7 +1465,7 @@ Proof. move=> is_sol_y. Abort. -End eqn33. +End tilt_eqn. Arguments point1 {K}. Open Scope classical_set_scope. @@ -1620,7 +1591,7 @@ Definition V1dot (zp1_z2 : 'rV[K]_6) : K := End V1. -Section Lyapunov. +Section tilt_eqn_Lyapunov. Local Open Scope classical_set_scope. Context {K : realType}. Variable alpha1 : K. @@ -1632,11 +1603,11 @@ Variable R : K -> 'M[K]_3. Hypothesis y0init: y0 0 \in state_space_tilt. Hypothesis y0sol : solves_equation (tilt_eqn alpha1 gamma) y0 state_space_tilt.*) -Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). +Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : + solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> + 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). Proof. -move=> [/= traj0]. -case. -move => dtraj. +move=> [/= traj0 dtraj]. move=> /(_ z)/(congr1 Left). by rewrite row_mxKl => ?; rewrite derive_lsubmx//=. Qed. @@ -1645,7 +1616,7 @@ Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 'D_1 (Right \o traj) z = gamma *: (Right (traj z) - Left (traj z)) *m \S('e_2 - Right (traj z)) ^+ 2. Proof. -move=> [/= traj0][dtraj]. +move=> [/= traj0 dtraj]. by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx//=. Qed. @@ -1679,7 +1650,7 @@ Lemma Gamma1_traj (y : K -> 'rV_6) t : Proof. move=> iss. case: iss. -move=> y033 [dy deriv_y]. +move=> y033 dy deriv_y. rewrite -(@thm11a _ _ _ gamma_gt0 alpha1_gt0)//=. exists y; split => //. by exists t. @@ -1696,7 +1667,7 @@ by apply:Gamma1_traj. Qed. Lemma deriveV1 (x : K -> 'rV[K]_6) t : - solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> (forall t, differentiable x t) -> + solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> (forall t, differentiable x t) -> LieDerivative (V1 alpha1 gamma) (fun a => x) 0 t = V1dot (x t). Proof. rewrite /tilt_eqn. @@ -1709,7 +1680,7 @@ rewrite LieDerivativeD; last 3 first. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). by apply: differentiable_lsubmx. apply/differentiableM => //=. - apply/differentiable_norm_squared => //=. + apply/differentiable_norm_squared => //=. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_rsubmx => //. by []. @@ -1717,7 +1688,7 @@ under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl => //; last first. apply/differentiable_norm_squared. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_lsubmx => //. rewrite LieDerivativeMl => //; last first. apply/differentiable_norm_squared => //=. @@ -1833,7 +1804,7 @@ rewrite fctE !invfM /=. near=> z. under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. -move: dtraj => [H0 [Hderiv Htilt]]. +move: dtraj => [H0 Hderiv Htilt]. have Hz_derivable : derivable traj z 1. by apply: Hderiv. rewrite LieDerivativeMl; last first. @@ -1870,7 +1841,7 @@ have [->|H] := eqVneq u1 0. have Hpos := def u1 H. rewrite -oppr_ge0 -oppr_le0 opprK ltW//. by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. -Unshelve. all: try by end_near. +Unshelve. all: try by end_near. Qed. Lemma V1_point_is_lnsd (y : K -> 'rV_6) : @@ -1878,7 +1849,7 @@ Lemma V1_point_is_lnsd (y : K -> 'rV_6) : y 0 = point1 -> locnegsemidef (LieDerivative (V1 alpha1 gamma) (fun a => y) 0 ) 0. Proof. -move=> [y033] [dy dtraj] traj0. +move=> [y033] dy dtraj traj0. have Gamma1_traj t : state_space_tilt (y t). apply/Gamma1_traj. by split => //. @@ -1897,6 +1868,7 @@ rewrite LieDerivativeD /=; last 3 first. apply: differentiable_cst. by apply derivable1_diffP. split; last first. + near=> z. admit. under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. @@ -1924,18 +1896,18 @@ rewrite /= !derivative_LieDerivative_eq0; last 4 first. by rewrite scaler0 scaler0 add0r. Admitted. -Lemma V1_point_is_lnd (y : K -> 'rV_6) +Lemma V1_point_is_lnd (y : K -> 'rV_6) (z : K) (zp1 := Left \o y) (z2 := Right \o y) (w := z2 z *m \S('e_2)) - (u1: 'rV[K]_2 := + (u1: 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i ) : u1 != 0 -> solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt-> y 0 = point1 -> lnd (LieDerivative (V1 alpha1 gamma) (fun a => y) 0 ) 0. Proof. -move=> neq0 [y033] [dy dtraj] traj0. +move=> neq0 [y033] dy dtraj traj0. have Gamma1_traj t : state_space_tilt (y t). apply/Gamma1_traj. by split => //. @@ -1960,7 +1932,6 @@ apply/andP; split; last first. have -> : (- u1 *m u2 *m u1^T) 0 0 = - (u1 *m u2 *m u1^T) 0 0. rewrite !mxE -sumrN. under [in RHS]eq_bigr do rewrite -mulNr. - under eq_bigr do rewrite mulNmx. admit. by apply/ltW => //. replace z0 with z. @@ -2008,7 +1979,7 @@ apply/differentiable_norm_squared; last 2 first. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_lsubmx => //. by apply: differentiable_cst. -Unshelve. all: by end_near. +Unshelve. all: by end_near. Admitted. Definition is_lyapunov_stable_at {K : realType} {n} @@ -2022,14 +1993,14 @@ Definition is_lyapunov_stable_at {K : realType} {n} solves_equation f traj1 A -> traj1 0 = x0 -> locnegsemidef (LieDerivative V (fun a => traj1) 0 ) 0]. + Lemma V1_is_lyapunov_stable : is_lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. Proof. split. -- by apply: equilibrium_point1 => //. +- exact: equilibrium_point1. - exact: V1_is_lyapunov_candidate. -- move=> traj1 ? ? . - by apply: V1_point_is_lnsd => //. +- by move=> traj1 ? ?; exact: V1_point_is_lnsd. Qed. (* thm 4.6 p136*) @@ -2039,45 +2010,42 @@ Definition hurwitz n (A : 'M[K]_n.+1) : Prop := (forall a, eigenvalue A a -> a < Definition locally_exponentially_stable_at n (eqn : 'rV[K]_n.+1 -> 'rV[K]_n.+1) (point : 'rV[K]_n.+1) : Prop := hurwitz (jacobian eqn point). -Lemma eqn33_is_locally_exponentially_stable_at_0 : locally_exponentially_stable_at (eqn33' alpha1 gamma) point1. +Lemma tilt_eqn_is_locally_exponentially_stable_at_0 : + locally_exponentially_stable_at (tilt_eqn_wip alpha1 gamma) point1. Proof. rewrite /locally_exponentially_stable_at /jacobian /hurwitz. move => a. move/eigenvalueP => [u] /[swap] u0 H. -have a_eigen : eigenvalue (jacobian (eqn33' alpha1 gamma) point1) a. +have a_eigen : eigenvalue (jacobian (tilt_eqn_wip alpha1 gamma) point1) a. apply/eigenvalueP. exists u. exact: H. exact: u0. -have : root (char_poly (jacobian (eqn33' alpha1 gamma) point1)) a. +have : root (char_poly (jacobian (tilt_eqn_wip alpha1 gamma) point1)) a. rewrite -eigenvalue_root_char. exact : a_eigen. -rewrite /eqn33' /jacobian. -Admitted. +rewrite /tilt_eqn_wip /jacobian. +Abort. -Lemma equilibrium_zero_stable : +(* NB: wip *) +Lemma equilibrium_zero_stable (H : solutions_unique state_space_tilt (tilt_eqn alpha1 gamma)) : forall zp1_z2_point : K -> 'rV_6, - solves_equation (tilt_eqn alpha1 gamma) zp1_z2_point state_space_tilt -> - equilibrium_is_stable_at state_space_tilt point1 zp1_z2_point. + solves_equation (tilt_eqn alpha1 gamma) zp1_z2_point state_space_tilt -> + equilibrium_is_stable_at state_space_tilt point1 zp1_z2_point. Proof. -move => y solves. -apply: Lyapunov_stability => //. -move => z. -rewrite inE. -move => statez. -by apply: solves. -admit. -admit. -rewrite -/point1. -have Hsubset : state_space_tilt = [set: 'rV_6]. - rewrite /state_space_tilt. - +move=> y solves. +apply: (@lyapunov_stability _ _ _ _ H _ _ _ (V1 alpha1 gamma)). +- move => z. + rewrite inE. + move => statez. + by apply: solves. +- admit. +- (* apply: V1_is_lyapunov_candidate. TODO: generalize V1_is_lyapunov_candidate *) admit. -rewrite Hsubset. -apply: V1_is_lyapunov_candidate => //. Search V1. -have:= V1_point_is_lnsd. +have := V1_point_is_lnsd. move => y0 y1 solves1. rewrite /locnegsemidef in y0. Abort. -End Lyapunov. + +End tilt_eqn_Lyapunov. diff --git a/tilt_robot.v b/tilt_robot.v index 089aeab7..1235e51b 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -159,8 +159,9 @@ move=> /= u A /=. move/nbhs_ballP=> [e /= e0 eA]. apply/nbhs_ballP; exists e => //= v uv. apply: eA. +split; first exact: e0. (* TODO: lemma *) -move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. +move: uv => [_]; rewrite /ball/= /mx_ball/ball /= => uv i j. apply: (le_lt_trans _ (uv i (rshift n1.+1 j))). by rewrite !mxE. Qed. @@ -235,8 +236,9 @@ move=> /= u A /=. move/nbhs_ballP=> [e /= e0 eA]. apply/nbhs_ballP; exists e => //= v uv. apply: eA. +split; first exact: e0. (* TODO: lemma *) -move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. +move: uv => -[_]; rewrite /ball/= /mx_ball/ball /= => uv i j. apply: (le_lt_trans _ (uv i (lshift n2.+1 j))). by rewrite !mxE. Qed. @@ -304,7 +306,7 @@ Lemma derive_row_mx {R : realFieldType} {n1 n2 : nat} Proof. move=> fv gv. apply/matrixP => i j. -rewrite derive_mx ?mxE//=; last first. +rewrite [in LHS]derive_mx ?mxE//=; last first. by apply: derivable_row_mx; [exact: fv|exact: gv]. do 2 rewrite derive_mx ?mxE//=. case: fintype.split_ordP => /= j1 jj1; rewrite !mxE; congr ('D_v _ t). From c7c7a175a72dcaa9fbd588d3c563df6fce4f4806 Mon Sep 17 00:00:00 2001 From: yosakaon Date: Fri, 10 Oct 2025 11:04:25 +0200 Subject: [PATCH 059/144] upd lnd --- tilt.v | 118 +++++++++++++++++++++++++-------------------------------- 1 file changed, 51 insertions(+), 67 deletions(-) diff --git a/tilt.v b/tilt.v index a7c40bfb..43f7d56d 100644 --- a/tilt.v +++ b/tilt.v @@ -1759,19 +1759,21 @@ have Hnorm_sq : norm (w *m \S('e_2 - Right (traj z))) ^+ 2 = norm w ^+ 2. by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?norm_ge0. Qed. -Lemma V1dot_ub (traj : K -> 'rV_6) (z : K) (zp1 := Left \o traj) (z2 := Right \o traj) - (w := z2 z *m \S('e_2)) - (u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i) : +Lemma V1dot_ub (traj : K -> 'rV_6) (zp1 := Left \o traj) (z2 := Right \o traj) : solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> + forall z, + let w := z2 z *m \S('e_2) in + let u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i in V1dot (traj z) <= (- u1 *m u2 *m u1^T) 0 0. Proof. -move=> dtraj. -rewrite mxE. +move=> dtraj z. +set w := z2 z *m \S('e_2). +pose u1 := \row_i [eta fun=> 0 with 0 |-> norm (zp1 z), 1 |-> norm w] i. rewrite /V1dot. rewrite mxE norm_spin mxE addrA expr2 mulmxA. have -> : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2). by rewrite spinD spinN -tr_spin !mulmxDr !mul_tr_spin !addr0. -rewrite -/w -dotmulNv addrC -mulmxN -expr2. +rewrite -dotmulNv addrC -mulmxN -expr2. have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= norm(w *m - (\S('e_2 - z2 z))) * norm(zp1 z). rewrite mxE /= mulr1n (le_trans (ler_norm _)) //. @@ -1783,6 +1785,7 @@ apply: (@le_trans _ _ (norm (w *m - \S('e_2 - z2 z)) * norm (zp1 z) + (- norm (z rewrite (le_trans _ (cauchy)) //. by rewrite mxE eqxx mulr1n. rewrite neg_spin /u1 /u2 //. +rewrite mxE. rewrite !sum2E/= ![in leRHS]mxE !sum2E/= ![in leRHS]mxE /=. rewrite !mulr1 mulrN mulNr opprK mulrDl mulNr -expr2. rewrite [in leLHS] addrCA -!addrA lerD2l mulrDl (mulNr (norm w)). @@ -1833,7 +1836,7 @@ pose z2 := Right \o traj. set w := (z2 z) *m \S('e_2). pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). - by rewrite V1dot_ub. + apply: V1dot_ub => //. have := @posdefmxu2 K. rewrite posdefmxP => def. have [->|H] := eqVneq u1 0. @@ -1869,6 +1872,8 @@ rewrite LieDerivativeD /=; last 3 first. by apply derivable1_diffP. split; last first. near=> z. + rewrite LieDerivative_derive => //; last by admit. + admit. admit. under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. @@ -1895,90 +1900,70 @@ rewrite /= !derivative_LieDerivative_eq0; last 4 first. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. Admitted. - +(* forall z? *) Lemma V1_point_is_lnd (y : K -> 'rV_6) - (z : K) - (zp1 := Left \o y) (z2 := Right \o y) - (w := z2 z *m \S('e_2)) - (u1: 'rV[K]_2 := - \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i ) : - u1 != 0 -> - solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt-> + (zp1 := Left \o y) (z2 := Right \o y) : + solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt -> + (forall t : K, state_space_tilt (y t)) -> y 0 = point1 -> - lnd (LieDerivative (V1 alpha1 gamma) (fun a => y) 0 ) 0. + lnd (LieDerivative (V1 alpha1 gamma) (fun a => y) 0) 0. Proof. -move=> neq0 [y033] dy dtraj traj0. +move=> solves state y0. have Gamma1_traj t : state_space_tilt (y t). - apply/Gamma1_traj. - by split => //. +by apply/Gamma1_traj. rewrite /lnd. split; last first. near=> z0. rewrite deriveV1. -have Hle : V1dot (y z) <= (- u1 *m u2 *m u1^T) 0 0. - by apply: V1dot_ub. +have V1dot_le := V1dot_ub solves z0 => //; last first. have := @posdefmxu2 K. rewrite posdefmxP => def. -have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0 by apply: def. +set w := z2 z0 *m \S('e_2). +set u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z0), 1 |-> norm w] i. +have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0. apply: def. +rewrite /u1. +admit. have Hneg : - (u1 *m u2 *m u1^T) 0 0 < 0. by rewrite oppr_lt0. rewrite lt_neqAle. -have sol : solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt by split => //. apply/andP; split; last first. apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). have Hle_z0 : V1dot (y z0) <= (- u1 *m u2 *m u1^T) 0 0. - replace z0 with z; last by admit. + move: V1dot_le. + rewrite /=. + by []. by []. - admit. -have -> : (- u1 *m u2 *m u1^T) 0 0 = - (u1 *m u2 *m u1^T) 0 0. +have ee : (- u1 *m u2 *m u1^T) 0 0 = - (u1 *m u2 *m u1^T) 0 0. rewrite !mxE -sumrN. - under [in RHS]eq_bigr do rewrite -mulNr. - admit. + under [in LHS]eq_bigr do rewrite mulNmx mxE. + by under [in LHS]eq_bigr do rewrite mulNr. + rewrite ee. by apply/ltW => //. - replace z0 with z. - admit. + rewrite /V1dot. + rewrite mxE/=. + apply/eqP => Habs. admit. -by []. + by []. move => t. apply/derivable1_diffP => //. +move : solves; rewrite /solves_equation. +case. +by []. +rewrite /solves_equation in solves. +rewrite /= derivative_LieDerivative_eq0 => //; last first. + +admit. rewrite /V1. -rewrite !invfM /=. -rewrite LieDerivativeD /=; last 2 first. + apply: differentiableD => //; last first. apply: differentiableM; last 2 first. rewrite /=. apply: differentiable_norm_squared; last 2 first. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). apply/differentiable_rsubmx => //. - apply: differentiable_cst; last first. - by apply derivable1_diffP. -under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. -rewrite LieDerivativeMl; last first. - by apply derivable1_diffP. - apply/differentiable_norm_squared; last 2 first. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_lsubmx => //. -rewrite LieDerivativeMl; last first. - by apply derivable1_diffP. + apply: differentiable_cst; last first. + apply: differentiableM => //; last first. apply/differentiable_norm_squared; last first. - apply/differentiable_rsubmx => //. + apply/differentiable_lsubmx => //. exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). -rewrite /= !derivative_LieDerivative_eq0; last 4 first. - apply/differentiable_norm_squared; last 2 first. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_rsubmx => //. - rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. - by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - apply/differentiable_norm_squared; last 2 first. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_lsubmx => //. - rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. - by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. -by rewrite scaler0 scaler0 add0r. -apply/differentiableM. -apply/differentiable_norm_squared; last 2 first. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_lsubmx => //. -by apply: differentiable_cst. Unshelve. all: by end_near. Admitted. @@ -2040,12 +2025,11 @@ apply: (@lyapunov_stability _ _ _ _ H _ _ _ (V1 alpha1 gamma)). move => statez. by apply: solves. - admit. -- (* apply: V1_is_lyapunov_candidate. TODO: generalize V1_is_lyapunov_candidate *) +have := V1_is_lyapunov_candidate. admit. -Search V1. -have := V1_point_is_lnsd. -move => y0 y1 solves1. -rewrite /locnegsemidef in y0. + move => et c d a. + have := V1_point_is_lnd. +rewrite /lnd. Abort. End tilt_eqn_Lyapunov. From 9292e4f0c7978e6b19ae72f94ff5890b0850f87d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 10 Oct 2025 18:49:13 +0900 Subject: [PATCH 060/144] fix derive norm squared --- tilt.v | 261 ++++++++++++++++++++---------------------------- tilt_analysis.v | 56 ++--------- 2 files changed, 115 insertions(+), 202 deletions(-) diff --git a/tilt.v b/tilt.v index 43f7d56d..a1ecfc1e 100644 --- a/tilt.v +++ b/tilt.v @@ -249,32 +249,19 @@ Qed. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -(* TODO version squared sans different de 0 *) -Lemma LieDerivative_norm {K : realType} n m (f : 'rV[K]_n.+1 -> 'rV_m.+1) - (phi : 'rV[K]_n.+1 -> K -> 'rV_n.+1) - (x : 'rV[K]_n.+1) (t : K) : - differentiable f (phi x t) -> - differentiable (phi x) t -> - (forall t, differentiable f t) -> - LieDerivative (fun y => (norm (f y)) ^+ 2) phi x t = - (2%:R *: 'D_1 (f \o phi x) t *m (f (phi x t))^T) 0 0. +Lemma LieDerivative_norm_squared {K : realType} n m (f : 'rV[K]_n.+1 -> 'rV_m.+1) + (phi : 'rV[K]_n.+1 -> K -> 'rV_n.+1) + (x : 'rV[K]_n.+1) (t : K) : + differentiable f (phi x t) -> + differentiable (phi x) t -> + LieDerivative (fun y => norm (f y) ^+ 2) phi x t = + (2 *: 'D_1 (f \o phi x) t *m (f (phi x t))^T) 0 0. Proof. -move => diffp difpx difft0 . -rewrite LieDerivative_derive => //=; last first. - apply: differentiable_norm_squared => //=. -rewrite -derive1E /=. -rewrite fctE. -replace (fun x0 : K => norm (f (phi x x0)) ^+ 2) - with ((1 \*o (GRing.exp (R:=K))^~ 2 \o norm) \o (f \o phi x)); last first. - rewrite !fctE. - rewrite -fctE. - apply/funext => s. - by rewrite /= /GRing.exp mul1r. -rewrite derive_norm_squared => //=; last first. - apply: diff_derivable=> //=. - apply: differentiable_comp => //=. -rewrite mulrDl mul1r scalerDl scale1r mulmxDl. -by rewrite [in RHS]mxE. +move=> difff diffphi. +rewrite LieDerivative_derive => //=; last exact: differentiable_norm_squared. +rewrite -derive1E /= fctE derive_norm_squared //=; last first. + by apply: diff_derivable=> //=; exact: differentiable_comp. +by rewrite mulrDl mul1r scalerDl scale1r mulmxDl [in RHS]mxE. Qed. End LieDerivative. @@ -1533,8 +1520,7 @@ End u2. Section V1. Local Open Scope classical_set_scope. Context {K : realType}. -Variable alpha1 : K. -Variable gamma : K. +Variables alpha1 gamma : K. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. @@ -1543,44 +1529,38 @@ Definition V1 (zp1_z2 : 'rV[K]_6) : K := let z2 := Right zp1_z2 in (norm zp1)^+2 / (2 * alpha1) + (norm z2)^+2 / (2 * gamma). -Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 setT point1. +Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 [set: 'rV_6] point1. Proof. -rewrite /locposdef; split. -- rewrite /V1 /point1 /locposdef; split. - by rewrite inE. - rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. - split. - by []. - split. +rewrite /locposdef; split; last first. + rewrite /V1 -fctE. + apply/differentiableD => //; last first. + apply/differentiableM => //; apply/differentiable_norm_squared => //=. + exact/differentiable_rsubmx. + apply/differentiableM => //; apply/differentiable_norm_squared => //=. + exact/differentiable_lsubmx. +rewrite /V1 /point1 /locposdef; split; first by rewrite inE. +split. + by rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. +split. exact: openT. - move => z_near _ z0. - have /orP[lz0|rz0] : (Left z_near != 0) || (Right z_near != 0). - + rewrite -negb_and. - apply: contra z0 => /andP[/eqP l0 /eqP r0]. - rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. - by apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; rewrite mxE. - + set rsub := Right z_near. - have : norm rsub >= 0 by rewrite norm_ge0. - set lsub := Left z_near. - move => nor. - have normlsub : norm lsub > 0 by rewrite norm_gt0. - rewrite ltr_pwDl//. - by rewrite divr_gt0 ?exprn_gt0// mulr_gt0. - by rewrite divr_ge0 ?exprn_ge0// mulr_ge0// ltW. - - rewrite ltr_pwDr//. - by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0// norm_gt0. - by rewrite divr_ge0 ?exprn_ge0 ?norm_ge0// mulr_ge0// ltW. - - rewrite /V1. - rewrite -fctE. - apply/differentiableD => //; last first. - apply/differentiableM => //. - apply/differentiable_norm_squared => //=. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_rsubmx => //. - apply/differentiableM => //. - apply/differentiable_norm_squared => //=. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_lsubmx => //. +move=> /= z_near _ z0. +have /orP[lz0|rz0] : (Left z_near != 0) || (Right z_near != 0). + rewrite -negb_and. + apply: contra z0 => /andP[/eqP l0 /eqP r0]. + rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. + apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; + by rewrite mxE. +- set rsub := Right z_near. + have : norm rsub >= 0 by rewrite norm_ge0. + set lsub := Left z_near. + move=> nor. + have normlsub : norm lsub > 0 by rewrite norm_gt0. + rewrite ltr_pwDl//. + by rewrite divr_gt0 ?exprn_gt0// mulr_gt0. + by rewrite divr_ge0 ?exprn_ge0// mulr_ge0// ltW. +- rewrite ltr_pwDr//. + by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0// norm_gt0. + by rewrite divr_ge0 ?exprn_ge0 ?norm_ge0// mulr_ge0// ltW. Unshelve. all: by end_near. Qed. Definition V1dot (zp1_z2 : 'rV[K]_6) : K := @@ -1667,8 +1647,9 @@ by apply:Gamma1_traj. Qed. Lemma deriveV1 (x : K -> 'rV[K]_6) t : - solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> (forall t, differentiable x t) -> - LieDerivative (V1 alpha1 gamma) (fun a => x) 0 t = V1dot (x t). + solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> + (forall t, differentiable x t) -> + LieDerivative (V1 alpha1 gamma) (fun a => x) 0 t = V1dot (x t). Proof. rewrite /tilt_eqn. move=> tilt_eqnx dif1. @@ -1676,38 +1657,28 @@ rewrite /V1. rewrite LieDerivativeD; last 3 first. apply/differentiableM => //=. apply/differentiable_norm_squared => //. - rewrite /tilt_eqn. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - by apply: differentiable_lsubmx. + exact: differentiable_lsubmx. apply/differentiableM => //=. apply/differentiable_norm_squared => //=. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_rsubmx => //. + exact: differentiable_rsubmx. by []. under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl => //; last first. apply/differentiable_norm_squared. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_lsubmx => //. + exact/differentiable_lsubmx. rewrite LieDerivativeMl => //; last first. apply/differentiable_norm_squared => //=. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_rsubmx => //. + exact/differentiable_rsubmx. rewrite -fctE /=. -rewrite !LieDerivative_norm /=; last 6 first. - apply/differentiable_rsubmx => //. - apply (dif1 t). - move => t0. - apply/differentiable_rsubmx => //. - apply/differentiable_lsubmx => //. - apply (dif1 t). - move => t0. - apply/differentiable_lsubmx => //. - rewrite -derive_V1dot. - rewrite /c1 /c2. - by rewrite !invfM. - by []. +rewrite !LieDerivative_norm_squared//=. +- rewrite -derive_V1dot. + rewrite /c1 /c2. + by rewrite !invfM. + rewrite /= in tilt_eqnx. + exact: tilt_eqnx. +- exact/differentiable_rsubmx. +- exact/differentiable_lsubmx. Qed. (* TODO: Section general properties of our system *) @@ -1810,26 +1781,19 @@ under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. move: dtraj => [H0 Hderiv Htilt]. have Hz_derivable : derivable traj z 1. by apply: Hderiv. -rewrite LieDerivativeMl; last first. +rewrite LieDerivativeMl; last 2 first. + apply/differentiable_norm_squared => //=. + exact/differentiable_lsubmx. by apply derivable1_diffP. - apply/differentiable_norm_squared => //=; last first. - (* en temps superieur a zero?*) - apply/differentiable_lsubmx => //. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). -rewrite LieDerivativeMl; last first. +rewrite LieDerivativeMl; last 2 first. + apply/differentiable_norm_squared => //=. + exact/differentiable_rsubmx. by apply derivable1_diffP. -apply/differentiable_norm_squared; last first. - apply/differentiable_rsubmx => //. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). -rewrite /= !LieDerivative_norm; last 6 first. - by apply/differentiable_rsubmx => //. - by apply/derivable1_diffP => //. - move => t. - apply/differentiable_rsubmx => //. - apply/differentiable_lsubmx => //. - by apply/derivable1_diffP => //. - move => t. - apply/differentiable_lsubmx => //. +rewrite /= !LieDerivative_norm_squared; last 4 first. + exact/differentiable_rsubmx. + by apply/derivable1_diffP. + exact/differentiable_lsubmx. + by apply/derivable1_diffP. rewrite derive_V1dot //. pose zp1 := Left \o traj. pose z2 := Right \o traj. @@ -1844,13 +1808,13 @@ have [->|H] := eqVneq u1 0. have Hpos := def u1 H. rewrite -oppr_ge0 -oppr_le0 opprK ltW//. by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. -Unshelve. all: try by end_near. -Qed. +Unshelve. all: try by end_near. Qed. -Lemma V1_point_is_lnsd (y : K -> 'rV_6) : - solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt-> +(* NB: should be completed to prove asymptotic stability *) +Lemma V1_dot_is_lnsd (y : K -> 'rV_6) : + solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt -> y 0 = point1 -> - locnegsemidef (LieDerivative (V1 alpha1 gamma) (fun a => y) 0 ) 0. + locnegsemidef (LieDerivative (V1 alpha1 gamma) (fun a => y) 0) 0. Proof. move=> [y033] dy dtraj traj0. have Gamma1_traj t : state_space_tilt (y t). @@ -1858,59 +1822,52 @@ have Gamma1_traj t : state_space_tilt (y t). by split => //. rewrite /locnegsemidef /V1. rewrite LieDerivativeD /=; last 3 first. - apply: differentiableM; last 2 first. - rewrite /=. - apply: differentiable_norm_squared; last 2 first. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_lsubmx => //. - apply: differentiable_cst; last first. - apply: differentiableM; last 2 first. - apply: differentiable_norm_squared=> //. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_rsubmx => //. - apply: differentiable_cst. - by apply derivable1_diffP. + apply: differentiableM => /=; last exact: differentiable_cst. + apply: differentiable_norm_squared. + exact/differentiable_lsubmx. + apply: differentiableM; last exact: differentiable_cst. + apply: differentiable_norm_squared=> //. + exact/differentiable_rsubmx. + by apply derivable1_diffP. split; last first. near=> z. - rewrite LieDerivative_derive => //; last by admit. + rewrite LieDerivative_derive //; last first. + admit. admit. admit. under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. rewrite LieDerivativeMl; last first. by apply derivable1_diffP. - apply/differentiable_norm_squared; last 2 first. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_lsubmx => //. -rewrite LieDerivativeMl; last first. + apply/differentiable_norm_squared. + exact/differentiable_lsubmx. +rewrite LieDerivativeMl; last 2 first. + apply/differentiable_norm_squared. + exact/differentiable_rsubmx. by apply derivable1_diffP. - apply/differentiable_norm_squared; last first. - apply/differentiable_rsubmx => //. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). rewrite /= !derivative_LieDerivative_eq0; last 4 first. - apply/differentiable_norm_squared; last first. - apply/differentiable_rsubmx => //. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + apply/differentiable_norm_squared. + exact/differentiable_rsubmx. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. apply/differentiable_norm_squared; last first. - apply/differentiable_lsubmx => //. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). + exact/differentiable_lsubmx. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. -Admitted. +Abort. + (* forall z? *) -Lemma V1_point_is_lnd (y : K -> 'rV_6) +Lemma V1_dot_is_lnd (y : K -> 'rV_6) (zp1 := Left \o y) (z2 := Right \o y) : solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt -> (forall t : K, state_space_tilt (y t)) -> y 0 = point1 -> lnd (LieDerivative (V1 alpha1 gamma) (fun a => y) 0) 0. Proof. -move=> solves state y0. +move=> solves state y0. have Gamma1_traj t : state_space_tilt (y t). -by apply/Gamma1_traj. + by apply/Gamma1_traj. rewrite /lnd. split; last first. near=> z0. @@ -1953,17 +1910,13 @@ rewrite /= derivative_LieDerivative_eq0 => //; last first. admit. rewrite /V1. - apply: differentiableD => //; last first. - apply: differentiableM; last 2 first. - rewrite /=. - apply: differentiable_norm_squared; last 2 first. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). - apply/differentiable_rsubmx => //. - apply: differentiable_cst; last first. - apply: differentiableM => //; last first. - apply/differentiable_norm_squared; last first. - apply/differentiable_lsubmx => //. - exact (fun z => gamma *: ((Right z - Left z) *m \S('e_2 - Right z) ^+ 2)). +apply: differentiableD => //; last first. + apply: differentiableM; last exact: differentiable_cst. + apply: differentiable_norm_squared. + exact/differentiable_rsubmx. +apply: differentiableM => //. + apply/differentiable_norm_squared. +exact/differentiable_lsubmx. Unshelve. all: by end_near. Admitted. @@ -1985,8 +1938,8 @@ Proof. split. - exact: equilibrium_point1. - exact: V1_is_lyapunov_candidate. -- by move=> traj1 ? ?; exact: V1_point_is_lnsd. -Qed. +(*- by move=> traj1 ? ?; exact: V1_point_is_lnsd. +Qed.*) Abort. (* thm 4.6 p136*) Definition hurwitz n (A : 'M[K]_n.+1) : Prop := (forall a, eigenvalue A a -> a < 0). @@ -2028,8 +1981,8 @@ apply: (@lyapunov_stability _ _ _ _ H _ _ _ (V1 alpha1 gamma)). have := V1_is_lyapunov_candidate. admit. move => et c d a. - have := V1_point_is_lnd. -rewrite /lnd. +(* have := V1_point_is_lnd. +rewrite /lnd.*) Abort. End tilt_eqn_Lyapunov. diff --git a/tilt_analysis.v b/tilt_analysis.v index 9577ebcc..e0c01208 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -73,37 +73,7 @@ rewrite scaler1 -raddfB/= addrK (scale_scalar_mx _ t^-1) mulVf. by near: t; exact: nbhs_dnbhs_neq. Unshelve. all: by end_near. Qed. -Lemma derive_norm {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : - u t != 0 -> - derivable u t 1 -> - (1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`()%classic t = - 2 * (fun t => ('D_1 u t *m (u t)^T)``_0) t :> K. -Proof. -move=> u0 ut1. -rewrite [LHS]derive1E deriveMl/=; last first. - apply/derivable1_diffP. - apply/(@differentiable_comp _ _ _ _ (fun x => norm (u x)) (fun x => x ^+ 2)) => //=. - rewrite /norm. - apply/(@differentiable_comp _ _ _ _ _ (fun x => Num.sqrt x)) => //=. - apply/derivable1_diffP. - exact/derivable_dotmul. - apply/derivable1_diffP. - apply/ex_derive. - apply: is_derive1_sqrt. - rewrite dotmulvv. - by rewrite exprn_gt0// norm_gt0. -rewrite -derive1E mul1r. -under eq_fun do rewrite -dotmulvv. -rewrite dotmulP mxE /= mulr1n. -rewrite derive1E. -rewrite derive_dotmul ; last 2 first. - exact: ut1. - exact: ut1. -rewrite dotmulC. -by field. -Qed. - -Lemma derivable_norm_squared {K : rcfType} n (f : K -> 'rV[K]_n.+1) (x0 : K) : +Lemma derivable_norm_squared {K : rcfType} n (f : K -> 'rV[K]_n.+1) (x0 : K) : derivable f x0 1 -> derivable (fun x => norm (f x) ^+ 2) x0 1. Proof. @@ -123,22 +93,13 @@ apply/derivable1_diffP. by apply/derivable_coord => //. Qed. -Lemma derive_norm_squared {K : realType} n (u : K^o -> 'rV[K^o]_n.+1) (t : K) : +Lemma derive_norm_squared {K : realType} n (u : K -> 'rV[K]_n.+1) (t : K) : derivable u t 1 -> - (1 \*o (@GRing.exp K ^~ 2) \o @norm K n.+1 \o u)^`()%classic t = - 2 * (fun t => ('D_1 u t *m (u t)^T)``_0) t :> K. + (fun x => norm (u x) ^+ 2)^`()%classic t = 2 * ('D_1 u t *m (u t)^T)``_0 :> K. Proof. move=> ut1. -rewrite [LHS]derive1E deriveMl/=; last first. - by apply/derivable_norm_squared => //. -rewrite -derive1E mul1r. under eq_fun do rewrite -dotmulvv. -rewrite dotmulP mxE /= mulr1n. -rewrite derive1E. -rewrite derive_dotmul ; last 2 first. - exact: ut1. - exact: ut1. -rewrite dotmulC. +rewrite dotmulP mxE /= mulr1n derive1E derive_dotmul// dotmulC. by field. Qed. @@ -164,12 +125,11 @@ by apply: differentiable_dotmul => //. Qed. Lemma differentiable_norm_squared {R : rcfType} m n (V := 'rV[R]_m.+1) - (u v : V -> 'rV[R]_n.+1) (t : V) : + (u : V -> 'rV[R]_n.+1) (t : V) : differentiable u t -> - differentiable (fun x => norm (u x)^+2 ) t . + differentiable (fun x => norm (u x) ^+ 2) t. Proof. -move => dif1. +move=> dif1. under eq_fun do rewrite -dotmulvv. -rewrite /=. -by apply: differentiable_dotmul => //. +exact: differentiable_dotmul. Qed. From 7b420566fd916b8ca4638b818c5cf694c75fa5e1 Mon Sep 17 00:00:00 2001 From: yosakaon Date: Mon, 13 Oct 2025 15:31:00 +0200 Subject: [PATCH 061/144] progress lyapunov application missing EVT + open state space --- tilt.v | 364 ++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 241 insertions(+), 123 deletions(-) diff --git a/tilt.v b/tilt.v index a1ecfc1e..39c046ed 100644 --- a/tilt.v +++ b/tilt.v @@ -75,7 +75,7 @@ Local Open Scope classical_set_scope. Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) (D : set T) (x : T) : Prop := - x \in D /\ V x = 0 /\ open D /\ forall z, z \in D -> z != x -> V z > 0. + x \in D /\ V x = 0 /\ forall z, z \in D -> z != x -> V z > 0. (* add continuously diff *) Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) @@ -277,16 +277,16 @@ Let T := 'rV[K]_n.+1. Variable phi : (K -> T) -> K -> T. -Definition solves_equation (x : K -> T) (A : set T) : Prop := +Definition is_sol (x : K -> T) (A : set T) : Prop := [/\ x 0 \in A, (forall t, derivable x t (1:K)%R) & forall t, 'D_1 x t = phi x t]. - -Definition is_equilibrium_point x := solves_equation (cst x). + (*sol0x : sol (phi 0) 0 = phi 0*) +Definition is_equilibrium_point x := is_sol (cst x). Definition equilibrium_points A := [set p : T | is_equilibrium_point p A ]. Definition state_space A := - [set p : T | exists y, solves_equation y A /\ exists t, p = y t ]. + [set p : T | exists y, is_sol y A /\ exists t, p = y t ]. Definition equilibrium_is_stable_at (A : set T) (x : T) (z : K -> 'rV[K]_n.+1) := @@ -351,8 +351,8 @@ Variable D : set 'rV[K]_n.+1. Variable f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. Definition solutions_unique := forall (a b : K -> 'rV_n.+1) (x0 : 'rV_n.+1), - solves_equation f a D -> - solves_equation f b D -> + is_sol f a D -> + is_sol f b D -> a 0 = x0 -> b 0 = x0 -> a = b. @@ -362,18 +362,50 @@ Section Lyapunov_stability. Context {K : realType} {n : nat}. Variable D : set 'rV[K]_n.+1. Variable f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. -Hypothesis Df_unique : solutions_unique D f. - +Variable sol : 'rV[K]_n.+1 -> K -> 'rV[K]_n.+1. +Hypothesis openD : open D. (* D est forcement un ouvert *) +Hypothesis solP : forall y, y 0 \in D -> + is_sol f y D <-> + sol (y 0) = y. +(* see Cohen Rouhling ITP 2017 Sect 3.2*) +Hypothesis solves : forall x, x \in D -> + is_sol f (sol x) D. + + +Let Df_unique : solutions_unique D f. +Proof. +rewrite /solutions_unique. +move => a b x0. +move => fad fbd a0 b0. +apply/funext => x. +case : (fad) => //=. +move => a0D Da fa. +have := solP a0D. +case. +move => /(_ fad). +move => a0a _. +case : (fbd) => //=. +move => b0D Db fb. +have := solP b0D. +case. +move => /(_ fbd). +move => b0b _. +rewrite -b0b -a0a. +by rewrite a0 b0. +Qed. (* TODO continuously differentiable*) (* TODO: prove the same theorem with equilibrium_is_asymptotically_stable_at *) + Theorem lyapunov_stability - (sol : 'rV_n.+1 -> K -> 'rV[K]_n.+1) (x : 'rV[K]_n.+1 := 0) - (fsolD : forall z, z \in D -> solves_equation f (sol z) D) - (sol0x : forall x, sol x 0 = x) +(* (fsolD : forall z, z \in D -> is_sol f (sol z) D /\ + sol z 0 = z)*) + (* (sol0x : forall x, sol x 0 = x)*) + (*sol0x : sol (phi 0) 0 = phi 0*) (V : 'rV[K]_n.+1 -> K) - (VDx : is_lyapunov_candidate V D x) (*contient l'hypothese x in D*) - (V'le_0 : forall phi, solves_equation f phi D -> forall t, t >= 0 -> LieDerivative V sol (phi 0) t <= 0) + (VDx : is_lyapunov_candidate V D x) + (*contient l'hypothese x in D*) + (V'le_0 : forall y : K -> 'rV[K]_n.+1, y 0 \in D (*-> is_sol f (sol (y 0)) D*) -> forall t, t >= 0 -> LieDerivative V sol (y 0) t <= 0) (Vderiv : forall t, differentiable V t) : is_equilibrium_point f x D -> equilibrium_is_stable_at D x (sol x). @@ -382,7 +414,10 @@ move => eq. move => eps eps0. rewrite /is_lyapunov_candidate in VDx. move: VDx => [/= Vloc Vdiff]. -move: Vloc => [/= inD [V0 [openD z1]]]. +move: Vloc => [/= inD [V0 z1]]. +(*have solx1_0 (x1 : K -> 'rV_n.+1) (Dx1 : x1 0 \in D) : sol (x1 0) = x1. + apply solP => //. + have H0 := solves Dx1 => //.*) have : exists r : K, 0 < r /\ r <= eps /\ closed_ball_ (fun x => `|x|) (0:'rV[K]_n.+1) r `<=` D. rewrite inE in inD. have [r0 /= Hr0D] := open_subball openD inD. @@ -488,20 +523,18 @@ have HOmega_beta : Omega_beta `<=` interior (closed_ball_ [eta normr])``_r. have Hbb : beta < beta by apply: (lt_le_trans Hbeta_lt Hle_alpha_beta). by move : Hbb; rewrite ltxx. by exact: r_pos. -have Df_Omega_beta phi : solves_equation f phi D -> phi 0 \in Omega_beta -> +have Df_Omega_beta phi : is_sol f phi D -> phi 0 \in Omega_beta -> forall t, 0 <= t -> phi t \in Omega_beta. move=> solves_phi xOmega t t0. have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi 0) u <= 0 -> V (sol (phi 0) t) <= V (sol (phi 0) 0) <= beta. move => t1 t10 u u10. - have -> : phi = sol (phi 0). - apply: Df_unique => //=. - apply: fsolD => //. - rewrite inE. - apply: Br_sub_D => //. - move : xOmega. - by rewrite inE /Omega_beta => -[]. - rewrite !sol0x /=. + have phi0 : phi = sol (phi 0). + apply/eqP; rewrite eq_sym; apply/eqP. + apply solP => //. + by case : solves_phi => //. + (*apply solves => //. + by case : solves_phi.*) have Vneg_incr: forall s1 s2, 0 <= s1 <= s2 -> forall x, x \in D -> V (sol x s2) <= V (sol x s1). move=> s1 s2 Hs1_pos x0 xinD . apply: (@ler0_derive1_le_cc _ (fun s => V (sol x0 s)) 0 s2) => //. @@ -509,47 +542,38 @@ have Df_Omega_beta phi : solves_equation f phi D -> phi 0 \in Omega_beta -> move => x1 x1in. apply: diff_derivable. apply: differentiable_comp; last exact: differentiable_comp. - have [_ diff_sol _] := fsolD _ xinD. - rewrite -derivable1_diffP. - exact: diff_sol. + rewrite -derivable1_diffP. + by case : (solves xinD). - move=> s Hs_in. - move : (V'le_0 phi solves_phi t t0). - rewrite LieDerivative_derive => //=; last first. + (*move : (V'le_0 phi solves_phi t t0). + rewrite -LieDerivative_derive => //=; last first. rewrite inE in xOmega. - have Hsol := fsolD (phi 0) _. - have Heq := @Df_unique phi (sol (phi 0)) (phi 0) _ _ _ => //. - rewrite -Heq => //=. - rewrite /solves_equation in solves_phi. - rewrite -derivable1_diffP. - by case: solves_phi. - apply: Hsol. - rewrite inE. - apply: Br_sub_D. - by case: xOmega. + rewrite -phi0. + rewrite -derivable1_diffP. + by case : solves_phi.*) rewrite derive1E. - rewrite fctE. - move=> _. - have H := V'le_0 (sol x0) (fsolD x0 xinD) s _. - rewrite LieDerivative_derive sol0x in H. - + rewrite -fctE. - apply: H. + rewrite -fctE. + rewrite -LieDerivative_derive. + have Hsol: forall x1, x1 \in D -> is_sol f (sol x1) D. + move=> x1 x1inD => //. + by apply : solves => //. + have Hs0 : 0 <= s. move : Hs_in. - rewrite inE. - move=> /itvP [] [Hs Hs1 Hs2]. + rewrite inE; move=> /itvP [] [Hs Hs1 Hs2]. rewrite ltW => //. by rewrite Hs. - + exact : Vderiv. - + move: (fsolD x0 xinD) => solx0. - rewrite /solves_equation in solx0. - move: solx0 => [_ Hdiff _]. - rewrite -derivable1_diffP. - exact: Hdiff. + set y := sol x0. + apply : V'le_0 => //. + apply: Vderiv => //. + admit. + rewrite -derivable1_diffP. + by case: (solves xinD) => //. - apply: continuous_subspaceT. move => x1. apply: continuous_comp. apply: differentiable_continuous => //. - case : (fsolD _ xinD) => _ + _ => /(_ x1). - by move => /(derivable1_diffP). + rewrite -derivable1_diffP. + by case : (solves xinD). exact: differentiable_continuous. - move: Hs1_pos => /andP[H0s1 Hs1s2]. by rewrite !in_itv/= lexx (le_trans H0s1). @@ -562,30 +586,43 @@ have Df_Omega_beta phi : solves_equation f phi D -> phi 0 \in Omega_beta -> rewrite inE /Omega_beta. move=> [clo Vxb]. have Hdec := Vneg_incr 0 t1 _ (phi 0) _. - rewrite sol0x in Hdec. - apply: Hdec => //=. + apply: Hdec => //. by apply/andP; split => //. rewrite inE /Omega_beta. by apply: Br_sub_D. - move : xOmega. - by rewrite inE /Omega_beta => -[]. + rewrite inE in xOmega. + + rewrite -phi0. + by move: xOmega; rewrite /Omega_beta; case. rewrite inE; split; last first. have t00 : 0 <= t <= t by rewrite lexx t0. have H_lie : LieDerivative V sol (phi 0) t <= 0. - apply V'le_0. - - exact solves_phi. - - exact t0. + apply V'le_0 => //. + by case: solves_phi. have := H2 t t0 t t00 H_lie. - rewrite !sol0x. have -> : sol (phi 0) = phi; last first. case/andP => h1 h2. exact: (le_trans h1 h2). - apply: Df_unique => //. - apply: fsolD => //. - rewrite inE. + apply solP => //. + by case : solves_phi. + (* by rewrite inE /Omega_beta => -[]. + apply/eqP. + rewrite eq_sym. + apply/eqP. + have Hsol_phi : sol (phi 0) = phi. + - apply solP. + + by case: solves_phi => //. + + apply solves; by case : solves_phi => //. + by rewrite Hsol_phi. + rewrite inE. apply: Br_sub_D => //. move : xOmega. by rewrite inE /Omega_beta => -[]. + apply: solves. + rewrite inE. + apply: Br_sub_D => //. + move : xOmega. + by rewrite inE /Omega_beta => -[].*) move: xOmega. rewrite inE /Omega_beta/=. rewrite /closed_ball_/=. @@ -646,18 +683,23 @@ have Df_Omega_beta phi : solves_equation f phi D -> phi 0 \in Omega_beta -> rewrite (lt_le_trans _ alphaVphit1)//. by case/andP : Hbeta. apply/negP; rewrite -leNgt. + have Heq_sol_phi : sol (phi 0) = phi. + apply solP => //. + rewrite inE. + apply: Br_sub_D => //. + rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. + by apply: x0r. + (*apply: solves => //. + rewrite inE. + apply: Br_sub_D => //. + rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. + by apply: x0r.*) have : forall u, u >= 0 -> LieDerivative V sol (phi 0) u <= 0. move => u u0. - by apply V'le_0 => //. - move : (H2 t1 t1_ge0). + apply: V'le_0 => //. + by case :solves_phi => //. + move : (H2 t1 t1_ge0). move=> Ht1 Hderiv. - have Heq_sol_phi : sol (phi 0) = phi. - apply: Df_unique => //. - apply : fsolD => //. - rewrite inE. - apply: Br_sub_D => //. - rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. - by apply: x0r. rewrite Heq_sol_phi in Ht1. have Vphi_le := Ht1 t1 _ _. have t1_chain : 0 <= t1 <= t1. @@ -781,8 +823,7 @@ have Hlast : `|sol x 0| < delta -> forall t : K , t >=0 -> `|sol x t| < r <= eps rewrite /Omega_beta. split => //=. rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - exact: Hball_solt. - have x00 : sol x 0 = x by rewrite sol0x => //=. + exact: Hball_solt. have z0_in_ball : (closed_ball_ [eta normr])``_delta (sol x 0). rewrite /closed_ball_; apply: ltW. rewrite sub0r normrN. @@ -790,7 +831,7 @@ have Hlast : `|sol x 0| < delta -> forall t : K , t >=0 -> `|sol x t| < r <= eps move : (Hin_ball_delta _ z0_in_ball). by move => [clo Vxb]. apply: Df_Omega_beta => //. - by apply: fsolD => //. + by apply solves => //. rewrite -closed_ballAE => //=. rewrite interior_closed_ballE => //=. rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. @@ -807,24 +848,38 @@ have Htraj0 : `|sol x t0| < r. rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. apply: ltW. rewrite /x. - by move: x0_lt_delta; rewrite sol0x; exact. - have sol_in_Omega : sol x t0 \in Omega_beta. + move: x0_lt_delta. + rewrite normr0; by case : Hdelta. + by have /andP []:= Hlast x0_lt_delta _ t0_ge0. + (* have sol_in_Omega : sol x t0 \in Omega_beta. apply: Df_Omega_beta => //=. - by apply: fsolD => //. - rewrite sol0x. - exact: x0_in_Omega; exact: t0_ge0. + by apply solves => //. + simpl in *. + have x00 : sol x 0 = x. + have [solx0inD _ _] := solves inD. + have [] := solP x0_in_Omega. + + apply solP. + by rewrite solx1_0 => //. + rewrite x00 => //. + + rewrite -(@solP (sol x) _ ) => //=. rewrite /Omega_beta inE in sol_in_Omega. case: sol_in_Omega => + _. (rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN) => Hnorm. have : ((closed_ball_ [eta normr])``_r)° (sol x t0). apply: HOmega_beta. rewrite -inE Df_Omega_beta//. - apply: fsolD => //. - by rewrite sol0x. + apply solves => //. + have x00 : x \in D -> sol x 0 = x. + move => xinD. + by rewrite solx1_0 => //. + rewrite x00 => //. + rewrite /Omega_beta inE in x0_in_Omega. + case: x0_in_Omega => + _. rewrite -(closed_ballE _ r_pos) interior_closed_ballE //=. rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. - exact. -rewrite sol0x in x0_lt_delta. + exact.*) exact: lt_le_trans r_le_eps. Admitted. @@ -904,7 +959,7 @@ Record equa_diff (K : realType) := { Definition is_invariant_solution_equa_diff {K : realType} (e : equa_diff K) (y1 : K -> 'rV[K]_6) A := - solves_equation (fun y t => equa_f e (y t)) y1 A /\ + is_sol (fun y t => equa_f e (y t)) y1 A /\ (y1 (equa_t0 e) \in equa_S0 e -> (forall t, t > 0 -> y1 (equa_t0 e + t) \in equa_S0 e)). (*TODO*) @@ -1360,7 +1415,7 @@ apply/seteqP; split. rewrite /state_space_tilt /=. move=> p_statespace33. rewrite /state_space /=. - rewrite /solves_equation /=. + rewrite /is_sol /=. exists (fun _ : K => 0). split. + split. @@ -1446,7 +1501,7 @@ Definition tilt_eqn_interface (x : 'rV_6) (t : K) : 'rV_6 := (*Hypothesis invariant_gamma : is_invariant tilt_eqn_interface (state_space_tilt). a transformer en lemme*) (* this lemma asks for lyapunov + lasalle *) -Lemma tractories_converge (y : K -> 'rV[K]_6) : solves_equation tilt_eqn y state_space_tilt -> +Lemma tractories_converge (y : K -> 'rV[K]_6) : is_sol tilt_eqn y state_space_tilt -> y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. Proof. move=> is_sol_y. @@ -1541,8 +1596,6 @@ rewrite /locposdef; split; last first. rewrite /V1 /point1 /locposdef; split; first by rewrite inE. split. by rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. -split. - exact: openT. move=> /= z_near _ z0. have /orP[lz0|rz0] : (Left z_near != 0) || (Right z_near != 0). rewrite -negb_and. @@ -1581,10 +1634,10 @@ Hypothesis gamma_gt0 : 0 < gamma. Variable R : K -> 'M[K]_3. (*Variable y0 : K -> 'rV[K]_6. Hypothesis y0init: y0 0 \in state_space_tilt. -Hypothesis y0sol : solves_equation (tilt_eqn alpha1 gamma) y0 state_space_tilt.*) +Hypothesis y0sol : is_sol (tilt_eqn alpha1 gamma) y0 state_space_tilt.*) Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : - solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). Proof. move=> [/= traj0 dtraj]. @@ -1592,7 +1645,7 @@ move=> /(_ z)/(congr1 Left). by rewrite row_mxKl => ?; rewrite derive_lsubmx//=. Qed. -Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> +Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> 'D_1 (Right \o traj) z = gamma *: (Right (traj z) - Left (traj z)) *m \S('e_2 - Right (traj z)) ^+ 2. Proof. @@ -1605,7 +1658,7 @@ Let c2 := 2^-1 / gamma. Lemma derive_V1dot (z : K) (traj : K -> 'rV_6) (zp1 := Left \o traj) (z2 := Right \o traj) : - solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> c1 *: (2 *: 'D_1 zp1 z *m (Left (traj z))^T) 0 0 + c2 *: (2 *: 'D_1 z2 z *m (Right (traj z))^T) 0 0 = V1dot (traj z). @@ -1626,7 +1679,7 @@ by rewrite mulmxA. Qed. Lemma Gamma1_traj (y : K -> 'rV_6) t : - solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt -> state_space_tilt (y t). + is_sol (tilt_eqn alpha1 gamma) y state_space_tilt -> state_space_tilt (y t). Proof. move=> iss. case: iss. @@ -1638,7 +1691,7 @@ Qed. Lemma norm_u1 (traj : K -> 'rV_6) (z : K) (z2 := Right \o traj) (zp1 := Left \o traj) (u := 'e_2 - z2 z) : - solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> norm u = 1. + is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> norm u = 1. Proof. move=> dtraj. suff: state_space_tilt (row_mx (zp1 z) (z2 z)) by rewrite /state_space_tilt/= row_mxKr. @@ -1647,7 +1700,7 @@ by apply:Gamma1_traj. Qed. Lemma deriveV1 (x : K -> 'rV[K]_6) t : - solves_equation (tilt_eqn alpha1 gamma) x state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) x state_space_tilt -> (forall t, differentiable x t) -> LieDerivative (V1 alpha1 gamma) (fun a => x) 0 t = V1dot (x t). Proof. @@ -1685,7 +1738,7 @@ Qed. Lemma angvel_sqr (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : - solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> dtraj. @@ -1708,7 +1761,7 @@ by rewrite 2!mulNmx mulmx1 mxE. Qed. Lemma neg_spin (traj : K -> 'rV_6) (z : K) : - solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> norm (Right (traj z) *m \S('e_2) *m - \S('e_2 - Right (traj z))) = norm (Right (traj z) *m \S('e_2)). Proof. @@ -1731,7 +1784,7 @@ have Hnorm_sq : norm (w *m \S('e_2 - Right (traj z))) ^+ 2 = norm w ^+ 2. Qed. Lemma V1dot_ub (traj : K -> 'rV_6) (zp1 := Left \o traj) (z2 := Right \o traj) : - solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> forall z, let w := z2 z *m \S('e_2) in let u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i in @@ -1767,7 +1820,7 @@ Qed. (* TODO: rework of this proof is needed *) Lemma near0_le0 (traj : K -> 'rV_6) : - solves_equation (tilt_eqn alpha1 gamma) traj state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> traj 0 = point1 -> \forall z \near 0^', (LieDerivative (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) (fun a=> traj) 0 + @@ -1812,7 +1865,7 @@ Unshelve. all: try by end_near. Qed. (* NB: should be completed to prove asymptotic stability *) Lemma V1_dot_is_lnsd (y : K -> 'rV_6) : - solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) y state_space_tilt -> y 0 = point1 -> locnegsemidef (LieDerivative (V1 alpha1 gamma) (fun a => y) 0) 0. Proof. @@ -1860,7 +1913,7 @@ Abort. (* forall z? *) Lemma V1_dot_is_lnd (y : K -> 'rV_6) (zp1 := Left \o y) (z2 := Right \o y) : - solves_equation (tilt_eqn alpha1 gamma) y state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) y state_space_tilt -> (forall t : K, state_space_tilt (y t)) -> y 0 = point1 -> lnd (LieDerivative (V1 alpha1 gamma) (fun a => y) 0) 0. @@ -1902,10 +1955,10 @@ have ee : (- u1 *m u2 *m u1^T) 0 0 = - (u1 *m u2 *m u1^T) 0 0. by []. move => t. apply/derivable1_diffP => //. -move : solves; rewrite /solves_equation. +move : solves; rewrite /is_sol. case. by []. -rewrite /solves_equation in solves. +rewrite /is_sol in solves. rewrite /= derivative_LieDerivative_eq0 => //; last first. admit. @@ -1928,7 +1981,7 @@ Definition is_lyapunov_stable_at {K : realType} {n} [/\ is_equilibrium_point f x0 A, is_lyapunov_candidate V setT x0 & forall traj1 traj2 : (K -> 'rV[K]_n.+1), - solves_equation f traj1 A -> + is_sol f traj1 A -> traj1 0 = x0 -> locnegsemidef (LieDerivative V (fun a => traj1) 0 ) 0]. @@ -1965,24 +2018,89 @@ have : root (char_poly (jacobian (tilt_eqn_wip alpha1 gamma) point1)) a. rewrite /tilt_eqn_wip /jacobian. Abort. -(* NB: wip *) -Lemma equilibrium_zero_stable (H : solutions_unique state_space_tilt (tilt_eqn alpha1 gamma)) : - forall zp1_z2_point : K -> 'rV_6, - solves_equation (tilt_eqn alpha1 gamma) zp1_z2_point state_space_tilt -> - equilibrium_is_stable_at state_space_tilt point1 zp1_z2_point. +Lemma V1_dot_le0 : + forall y, is_sol (tilt_eqn alpha1 gamma) y state_space_tilt -> + (forall t, differentiable y t) -> + y 0 = point1 -> + forall t : K , t >= 0 -> + LieDerivative (V1 alpha1 gamma) (fun=> y) (y t) t <= 0. Proof. -move=> y solves. -apply: (@lyapunov_stability _ _ _ _ H _ _ _ (V1 alpha1 gamma)). -- move => z. - rewrite inE. - move => statez. - by apply: solves. + move=> y solves diff y0 t t0. + change (LieDerivative (V1 alpha1 gamma) (fun=> y) (y t) t) + with ((LieDerivative (V1 alpha1 gamma) (fun=> y))``_t). + rewrite deriveV1 => //. + have Hub := V1dot_ub solves t. + have := @posdefmxu2 K. + rewrite posdefmxP => def. + apply: (le_trans Hub). +have Hquad : let u1 := \row_i [eta fun=> 0 + with 0 |-> norm ((Left \o y) t), + 1 |-> norm ((Right \o y) t *m \S('e_2))] + i in 0 <= (u1 *m u2 *m u1^T) 0 0. +set u1 := \row_i [eta fun=> 0 + with 0 |-> norm ((Left \o y) t), + 1 |-> norm ((Right \o y) t *m \S('e_2))] + i. +rewrite /=. +case: (u1 =P 0) => [->|/eqP u1_neq0]. + by rewrite !mul0mx mxE. + apply: ltW. + exact: (def u1 u1_neq0). +rewrite -oppr_ge0. +by rewrite !mulNmx mxE opprK Hquad. +Qed. + +Variable y0 : K -> 'rV[K]_6. +Hypothesis y0init: y0 0 \in state_space_tilt. +Hypothesis y0init_sol : is_sol (tilt_eqn alpha1 gamma) y0 state_space_tilt . +Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. +Hypothesis solP : + forall y : K -> 'rV[K]_6, + y 0 \in state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) y state_space_tilt <-> + sol (y 0) = y. + +Lemma equilibrium_zero_stable : + equilibrium_is_stable_at state_space_tilt point1 y0. +Proof. +apply : (@lyapunov_stability K 5 state_space_tilt (tilt_eqn alpha1 gamma) _ _ solP _ (V1 alpha1 gamma) ). - admit. -have := V1_is_lyapunov_candidate. +- move => y y0in. + apply: y0init_sol => //. +- have := V1_is_lyapunov_candidate alpha1_gt0 gamma_gt0. + move => HV1. + case: HV1 => [Hpos Hdif]. + split. + rewrite /point1 in Hpos Hdif. + have subset : state_space_tilt `<=` [set : 'rV_6]. + move => t. + by apply: subsetT. + case: Hpos => inset [a _]. + split. + rewrite /state_space_tilt inE /=. + by rewrite rsubmx_const /= subr0 normeE. + split. + exact: a. + rewrite /state_space_tilt. + admit. + by rewrite /point1 in Hdif. + move => y solvess t t00. + apply: V1_dot_le0 => //. + move => t0. + rewrite -derivable1_diffP. + by case : y0init_sol. admit. - move => et c d a. -(* have := V1_point_is_lnd. -rewrite /lnd.*) + move =>t. + rewrite /V1. + apply/differentiableD => //. + apply/differentiableM => //. + apply/differentiable_norm_squared => //. + apply/differentiable_lsubmx => //. + apply/differentiableM => //. + apply/differentiable_norm_squared => //. + apply/differentiable_rsubmx => //. + - apply: equilibrium_point1 => //. + Abort. End tilt_eqn_Lyapunov. From 772274d7fd09a7e0f465037e714487df5ffea04b Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 13 Oct 2025 22:59:15 +0900 Subject: [PATCH 062/144] evt for rV --- tilt.v | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 144 insertions(+), 20 deletions(-) diff --git a/tilt.v b/tilt.v index 39c046ed..c3441ddd 100644 --- a/tilt.v +++ b/tilt.v @@ -1,5 +1,6 @@ From HB Require Import structures. From mathcomp Require Import all_ssreflect all_algebra ring. +From mathcomp Require Import interval_inference. From mathcomp Require Import boolp classical_sets functions reals order. From mathcomp Require Import topology normedtype landau derive realfun. Require Import ssr_ext euclidean rigid frame skew derive_matrix. @@ -35,6 +36,61 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. +Local Open Scope classical_set_scope. +(* NB: we are just mimicking the proofs for the real line already available in derive.v *) +Lemma EVT_max_rV (R : realType) n (f : 'rV[R]_n.+1 -> R) (A : set 'rV[R]_n.+1) : + A !=set0 -> + compact A -> + {within A, continuous f} -> exists2 c, c \in A & + forall t, t \in A -> f t <= f c. +Proof. +move=> A0 compactA fcont; set imf := f @` A. +have imf_sup : has_sup imf. + split. + case: A0 => a Aa. + by exists (f a); apply/imageP. + have [M [Mreal imfltM]] : bounded_set (f @` A). + exact/compact_bounded/continuous_compact. + exists (M + 1) => y /imfltM yleM. + by rewrite (le_trans _ (yleM _ _)) ?ler_norm ?ltrDl. +have [|imf_ltsup] := pselect (exists2 c, c \in A & f c = sup imf). + move=> [c cab fceqsup]; exists c => // t tab; rewrite fceqsup. + apply/sup_upper_bound => //. + exact/imageP/set_mem. +have {}imf_ltsup t : t \in A -> f t < sup imf. + move=> tab; case: (ltrP (f t) (sup imf)) => // supleft. + rewrite falseE; apply: imf_ltsup; exists t => //; apply/eqP. + rewrite eq_le supleft andbT sup_upper_bound//. + exact/imageP/set_mem. +pose g t : R := (sup imf - f t)^-1. +have invf_continuous : {within A, continuous g}. + rewrite continuous_subspace_in => t tab; apply: cvgV => //=. + by rewrite subr_eq0 gt_eqF // imf_ltsup //; rewrite inE in tab. + by apply: cvgD; [exact: cst_continuous | apply: cvgN; exact: (fcont t)]. +have /ex_strict_bound_gt0 [k k_gt0 /= imVfltk] : bounded_set (g @` A). + by apply/compact_bounded/continuous_compact. +have [_ [t tab <-]] : exists2 y, imf y & sup imf - k^-1 < y. + by apply: sup_adherent => //; rewrite invr_gt0. +rewrite ltrBlDr -ltrBlDl. +suff : sup imf - f t > k^-1 by move=> /ltW; rewrite leNgt => /negbTE ->. +rewrite -[ltRHS]invrK ltf_pV2// ?qualifE/= ?invr_gt0 ?subr_gt0 ?imf_ltsup//; last first. + exact/mem_set. +by rewrite (le_lt_trans (ler_norm _) _) ?imVfltk//; exact: imageP. +Qed. + +Lemma EVT_min_rV (R : realType) n (f : 'rV[R]_n.+1 -> R) (A : set 'rV[R]_n.+1) : + A !=set0 -> + compact A -> + {within A, continuous f} -> exists2 c, c \in A & + forall t, t \in A -> f c <= f t. +Proof. +move=> A0 cA fcont. +have /(EVT_max_rV A0 cA) [c clr fcmax] : {within A, continuous (- f)}. + by move=> ?; apply: continuousN => ?; exact: fcont. +by exists c => // ? /fcmax; rewrite lerN2. +Qed. +Local Close Scope classical_set_scope. + (* spin and matrix/norm properties*) Lemma norm_spin {R : rcfType} (u : 'rV[R]_3) (v : 'rV[R]_3) : @@ -396,6 +452,34 @@ Qed. (* TODO continuously differentiable*) (* TODO: prove the same theorem with equilibrium_is_asymptotically_stable_at *) +Import Order.Def. + +(* NB: added to be able to produce the following instance to be able to use bigop lemmas *) +Lemma nng_max0r : left_id ((0:K)%:nng) (@maxr {nonneg K}). +Proof. +move=> x. +rewrite /max; case: ifPn => //. +rewrite -leNgt => x0. +apply/eqP; rewrite eq_le; apply/andP; split; last first. + exact: x0. +by have : 0 <= x%:nngnum by []. (* NB: this should be automatic *) +Qed. + +HB.instance Definition _ := + Monoid.isComLaw.Build {nonneg K} 0%:nng max maxA maxC nng_max0r. + +Lemma maxE (x y : {nonneg K}) : (max x%:num y%:num) = (max x y)%:num. +Proof. +rewrite /max; apply/esym. +case: ifPn => // xy. + case: ifPn => //. + rewrite -leNgt => yx. + by apply/eqP; rewrite eq_le yx/= ltW. +case: ifPn => // yx. +apply/eqP; rewrite eq_le (ltW yx)/=. +by rewrite -leNgt in xy. +Qed. + Theorem lyapunov_stability (x : 'rV[K]_n.+1 := 0) (* (fsolD : forall z, z \in D -> is_sol f (sol z) D /\ @@ -455,10 +539,50 @@ have : exists r : K, 0 < r /\ r <= eps /\ closed_ball_ (fun x => `|x|) (0:'rV[K] have Hcont := differentiable_continuous Vdiff. move=> [r [r_pos [r_le_eps Br_sub_D]]]. pose sphere_r := [set x : 'rV[K]_n.+1 | `|x| = r]. -have Halpha : {x : 'rV[K]_n.+1 | x \in sphere_r /\ forall y, y \in sphere_r -> V(x) <= V(y)}. -(* extreme value theorem?*) -(* sphere must be compact*) - admit. +have Halpha : {x : 'rV[K]_n.+1 | x \in sphere_r /\ forall y, y \in sphere_r -> V x <= V y}. + have sphere_r0 : sphere_r !=set0. + exists (const_mx r). + rewrite /sphere_r/= /normr/=. + (* TODO: need lemma *) + rewrite mx_normrE/=. + apply/eqP; rewrite eq_le; apply/andP; split. + apply: bigmax_le => //. + exact: ltW. + by move=> i _; rewrite mxE gtr0_norm. + under eq_bigr do rewrite mxE gtr0_norm//. + apply/le_bigmax => /=. + exact: (ord0, ord0). + have compact_sphere_r : compact sphere_r. + apply: bounded_closed_compact. + suff : \forall M \near +oo, forall p, sphere_r p -> forall i, `|p ord0 i| < M. + rewrite /bounded_set; apply: filter_app; near=> M0. + move=> Kbnd /= p /Kbnd ltpM0. + rewrite /normr/= mx_normrE. + apply/bigmax_leP; split => //= i _. + by rewrite ord1; exact/ltW/ltpM0. + near=> M => v. + rewrite /sphere_r/= => vr i. + rewrite (@le_lt_trans _ _ r)//. + rewrite -vr [leRHS]/normr/= mx_normE. + under eq_bigr do rewrite ord1. + rewrite -(pair_big xpredT xpredT (fun _ j => `|v ord0 j|%:nng))//=. + rewrite big_ord_recr/= big_ord0. + rewrite max_r; last exact/bigmax_ge_id. + rewrite (bigD1 i)//= -maxE le_max. + by apply/orP; left. + clear v vr i. + by near: M; apply: nbhs_pinfty_gt; rewrite num_real. + pose d := fun x : 'rV[K]_n.+1 => `|x| : K. + have contd : continuous d by move=> /= z; exact: norm_continuous. + rewrite [X in closed X](_ : _ = d @^-1` [set r]); last first. + by apply/seteqP; split. + by apply continuous_closedP. + have contV : {within sphere_r, continuous V}. + apply: continuous_subspaceT => /= v. + apply/differentiable_continuous. + exact/Vderiv. + have := @EVT_min_rV _ _ V sphere_r sphere_r0 compact_sphere_r contV. + by move=> /cid2[c sphere_r_c sphere_r_V]; exists c; split. pose alpha := V (sval Halpha). have alpha_gt0 : 0 < alpha. have sphere_pos: forall y, y \in sphere_r -> 0 < V y. @@ -557,7 +681,7 @@ have Df_Omega_beta phi : is_sol f phi D -> phi 0 \in Omega_beta -> have Hsol: forall x1, x1 \in D -> is_sol f (sol x1) D. move=> x1 x1inD => //. by apply : solves => //. - have Hs0 : 0 <= s. + have Hs0 : 0 <= s. move : Hs_in. rewrite inE; move=> /itvP [] [Hs Hs1 Hs2]. rewrite ltW => //. @@ -565,7 +689,6 @@ have Df_Omega_beta phi : is_sol f phi D -> phi 0 \in Omega_beta -> set y := sol x0. apply : V'le_0 => //. apply: Vderiv => //. - admit. rewrite -derivable1_diffP. by case: (solves xinD) => //. - apply: continuous_subspaceT. @@ -881,7 +1004,7 @@ have Htraj0 : `|sol x t0| < r. rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. exact.*) exact: lt_le_trans r_le_eps. -Admitted. +Unshelve. all: by end_near. Qed. End Lyapunov_stability. @@ -1049,7 +1172,7 @@ rewrite -derive1mx_ang_vel; last 2 first. admit. admit. by []. -Admitted. +Abort. (* eqn 10*) Notation y_a := (y_a v R g0). @@ -1340,9 +1463,9 @@ case: cid => //= y' y'sol. case: cid => t'/= pt'. Abort. -Lemma thm11a : state_space tilt_eqn state_space_tilt = state_space_tilt . +Lemma thm11a : state_space tilt_eqn state_space_tilt `<=` state_space_tilt. Proof. -apply/seteqP; split. +(*apply/seteqP; split.*) - move=> p [y [[y0_init1]] deri y33 ] [t ->]. rewrite /state_space_tilt. have : derive1 (fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. @@ -1411,7 +1534,7 @@ apply/seteqP; split. move: y0_init1. rewrite inE /state_space_tilt /= => ->. by rewrite expr2 mulr1. -- move=> p. +(*- move=> p. rewrite /state_space_tilt /=. move=> p_statespace33. rewrite /state_space /=. @@ -1435,7 +1558,8 @@ apply/seteqP; split. by rewrite lsubmx_const. by rewrite lsubmx_const rsubmx_const subr0 scaler0 mul0mx. admit. (* NG *) -Admitted. +*) +Qed. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). @@ -1684,7 +1808,7 @@ Proof. move=> iss. case: iss. move=> y033 dy deriv_y. -rewrite -(@thm11a _ _ _ gamma_gt0 alpha1_gt0)//=. +apply: (@thm11a _ alpha1 gamma) => //=. exists y; split => //. by exists t. Qed. @@ -1971,9 +2095,9 @@ apply: differentiableM => //. apply/differentiable_norm_squared. exact/differentiable_lsubmx. Unshelve. all: by end_near. -Admitted. +Abort. -Definition is_lyapunov_stable_at {K : realType} {n} +(*Definition is_lyapunov_stable_at {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) (A : set 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) @@ -1983,16 +2107,16 @@ Definition is_lyapunov_stable_at {K : realType} {n} forall traj1 traj2 : (K -> 'rV[K]_n.+1), is_sol f traj1 A -> traj1 0 = x0 -> - locnegsemidef (LieDerivative V (fun a => traj1) 0 ) 0]. + locnegsemidef (LieDerivative V (fun a => traj1) 0 ) 0].*) -Lemma V1_is_lyapunov_stable : +(*Lemma V1_is_lyapunov_stable : is_lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. Proof. split. - exact: equilibrium_point1. - exact: V1_is_lyapunov_candidate. (*- by move=> traj1 ? ?; exact: V1_point_is_lnsd. -Qed.*) Abort. +Qed.*) Abort.*) (* thm 4.6 p136*) Definition hurwitz n (A : 'M[K]_n.+1) : Prop := (forall a, eigenvalue A a -> a < 0). @@ -2085,7 +2209,7 @@ apply : (@lyapunov_stability K 5 state_space_tilt (tilt_eqn alpha1 gamma) _ _ so admit. by rewrite /point1 in Hdif. move => y solvess t t00. - apply: V1_dot_le0 => //. +(* apply: V1_dot_le0 => //. move => t0. rewrite -derivable1_diffP. by case : y0init_sol. @@ -2100,7 +2224,7 @@ apply : (@lyapunov_stability K 5 state_space_tilt (tilt_eqn alpha1 gamma) _ _ so apply/differentiable_norm_squared => //. apply/differentiable_rsubmx => //. - apply: equilibrium_point1 => //. - +*) Abort. End tilt_eqn_Lyapunov. From 40305dffb2d71a74d5465c819358cb7354af03ec Mon Sep 17 00:00:00 2001 From: yosakaon Date: Tue, 14 Oct 2025 10:30:00 +0200 Subject: [PATCH 063/144] finished lyapunov --- tilt.v | 108 +++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 74 insertions(+), 34 deletions(-) diff --git a/tilt.v b/tilt.v index c3441ddd..40d1dac1 100644 --- a/tilt.v +++ b/tilt.v @@ -1818,6 +1818,7 @@ Lemma norm_u1 (traj : K -> 'rV_6) (z : K) (z2 := Right \o traj) is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> norm u = 1. Proof. move=> dtraj. + suff: state_space_tilt (row_mx (zp1 z) (z2 z)) by rewrite /state_space_tilt/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. by apply:Gamma1_traj. @@ -2174,57 +2175,96 @@ rewrite -oppr_ge0. by rewrite !mulNmx mxE opprK Hquad. Qed. +Variable D : set 'rV[K]_6. Variable y0 : K -> 'rV[K]_6. -Hypothesis y0init: y0 0 \in state_space_tilt. -Hypothesis y0init_sol : is_sol (tilt_eqn alpha1 gamma) y0 state_space_tilt . +Hypothesis y0init: y0 0 \in D. +Hypothesis y0init_sol : is_sol (tilt_eqn alpha1 gamma) y0 D. Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. Hypothesis solP : forall y : K -> 'rV[K]_6, - y 0 \in state_space_tilt -> - is_sol (tilt_eqn alpha1 gamma) y state_space_tilt <-> + y 0 \in D -> + is_sol (tilt_eqn alpha1 gamma) y D <-> sol (y 0) = y. +Hypothesis y0origin : y0 0 = 0. + + +Lemma is_sol_subset (D_in_state : D `<=` state_space_tilt) : is_sol (tilt_eqn alpha1 gamma) y0 D -> is_sol (tilt_eqn alpha1 gamma) y0 state_space_tilt. +Proof. +rewrite /is_sol inE. +move => [inD0 deriv tilt]. +rewrite inE. +split. +by apply D_in_state => //. +exact : deriv. +exact : tilt. +Qed. + +Lemma is_equilibrium_subset : (is_equilibrium_point (tilt_eqn alpha1 gamma))``_state_space_tilt -> (is_equilibrium_point (tilt_eqn alpha1 gamma))``_D. +Proof. +rewrite /is_equilibrium_point. +rewrite /is_sol inE. +move => [inD0 deriv tilt]. +rewrite inE. +split. +rewrite /= -y0origin => //. +move : y0init. +rewrite inE. +apply. +exact : deriv. +exact : tilt. +Qed. + -Lemma equilibrium_zero_stable : - equilibrium_is_stable_at state_space_tilt point1 y0. +Lemma equilibrium_zero_stable (openD : open D) (D0 : 0 \in D) (D_in_state : D `<=` state_space_tilt) : equilibrium_is_stable_at D point1 y0. Proof. -apply : (@lyapunov_stability K 5 state_space_tilt (tilt_eqn alpha1 gamma) _ _ solP _ (V1 alpha1 gamma) ). -- admit. -- move => y y0in. - apply: y0init_sol => //. -- have := V1_is_lyapunov_candidate alpha1_gt0 gamma_gt0. +apply : (@lyapunov_stability K 5 D (tilt_eqn alpha1 gamma) _ openD solP _ (V1 alpha1 gamma) ). +- exact : openD. +- by move => y y0in => //. +- have := V1_is_lyapunov_candidate alpha1_gt0 gamma_gt0. move => HV1. case: HV1 => [Hpos Hdif]. split. - rewrite /point1 in Hpos Hdif. - have subset : state_space_tilt `<=` [set : 'rV_6]. - move => t. - by apply: subsetT. - case: Hpos => inset [a _]. - split. - rewrite /state_space_tilt inE /=. - by rewrite rsubmx_const /= subr0 normeE. - split. - exact: a. - rewrite /state_space_tilt. - admit. + rewrite /point1 in Hpos Hdif. + rewrite /locposdef. + split => //. + rewrite -y0origin => //. + split => //. + rewrite /V1 y0origin. + rewrite lsubmx_const rsubmx_const //=. + by rewrite !expr2 !norm0 !mulr0 !mul0r add0r. + move => z zin z_neq0. + rewrite /locposdef in Hpos. + case : Hpos => //. + move => _. + move => [_ Hpos]. + apply: Hpos => //. + move : zin. + have subset : D `<=` [set : 'rV_6]. + move => t. + by apply subsetT. + rewrite inE. + move => Hw. + rewrite inE. + by apply: subset => //. + by rewrite y0origin in z_neq0. by rewrite /point1 in Hdif. - move => y solvess t t00. -(* apply: V1_dot_le0 => //. +- move => y solvess t t00. + apply: V1_dot_le0 => //. + by apply is_sol_subset => //. move => t0. rewrite -derivable1_diffP. by case : y0init_sol. - admit. - move =>t. +- move =>t. rewrite /V1. apply/differentiableD => //. + apply/differentiableM => //. + apply/differentiable_norm_squared => //. + by apply/differentiable_lsubmx => //. apply/differentiableM => //. apply/differentiable_norm_squared => //. - apply/differentiable_lsubmx => //. - apply/differentiableM => //. - apply/differentiable_norm_squared => //. - apply/differentiable_rsubmx => //. - - apply: equilibrium_point1 => //. -*) -Abort. + by apply/differentiable_rsubmx => //. + - apply: is_equilibrium_subset. + by apply: equilibrium_point1 => //. +Qed. End tilt_eqn_Lyapunov. From 6ca04bb18deec60d000622b812d7777f2f7646eb Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 14 Oct 2025 17:31:34 +0900 Subject: [PATCH 064/144] various fixes: - shorten thm 4.1 - new notation - nitpicks - rebase on MCA 1.14.0 --- derive_matrix.v | 112 +-- tilt.v | 2115 +++++++++++++++++++---------------------------- tilt_analysis.v | 39 +- tilt_robot.v | 76 +- 4 files changed, 986 insertions(+), 1356 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index 678b274f..384e1e82 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -30,23 +30,34 @@ Lemma mx_lin1N (R : pzRingType) n (M : 'M[R]_n) : mx_lin1 (- M) = -1 \*: mx_lin1 M :> ( _ -> _). Proof. by rewrite funeqE => v /=; rewrite scaleN1r mulmxN. Qed. -Lemma norm_trmx (R : realFieldType) m n - (M : 'M[R]_(m.+1, n.+1)) : `|M^T| = `|M|. +Import Order.Def. + +(* NB: added to be able to produce the following instance to be able to use bigop lemmas *) +Lemma nng_max0r {K : realFieldType} : left_id ((0:K)%:nng) (@maxr {nonneg K}). Proof. -rewrite /Num.Def.normr/= !mx_normrE. +move=> x. +rewrite /max; case: ifPn => //. +rewrite -leNgt => x0. +apply/eqP; rewrite eq_le; apply/andP; split; last first. + exact: x0. +by have : 0 <= x%:nngnum by []. (* NB: this should be automatic *) +Qed. + +(* TODO: backport to MCA *) +HB.instance Definition _ {K : realFieldType} := + Monoid.isComLaw.Build {nonneg K} 0%:nng max maxA maxC nng_max0r. + +Lemma norm_trmx (R : realFieldType) m n (M : 'M[R]_(m, n)) : `|M^T| = `|M|. +Proof. +rewrite [LHS]mx_normE/=. under eq_bigr do rewrite mxE. -apply/eqP; rewrite eq_le; apply/andP; split. -- apply: bigmax_le => //=. - exact: le_trans (le_bigmax _ _ (ord0, ord0)). - by move=> i _; apply/bigmax_geP; right => /=; exists (i.2, i.1). -- apply: bigmax_le => //=. - exact: le_trans (le_bigmax _ _ (ord0, ord0)). - by move=> i _; apply/bigmax_geP; right => /=; exists (i.2, i.1). +rewrite -(pair_big xpredT xpredT (fun i j => `|M j i|%:nng))/=. +by rewrite exchange_big//= pair_big. Qed. Section pointwise_derivable. Context {R : realFieldType} {V W : normedModType R} {m n : nat}. -Implicit Types M : V -> 'M[R]_(m.+1, n.+1). +Implicit Types M : V -> 'M[R]_(m, n). Definition derivable_mx M t v := forall i j, derivable (fun x => M x i j) t v. @@ -56,7 +67,7 @@ Proof. split; rewrite /derivable_mx /derivable. - move=> H. apply/cvg_ex => /=. - pose l := \matrix_(i < m.+1, j < n.+1) sval (cid ((cvg_ex _).1 (H i j))). + pose l := \matrix_(i < m, j < n) sval (cid ((cvg_ex _).1 (H i j))). exists l. apply/cvgrPdist_le => /= e e0. near=> x. @@ -126,6 +137,26 @@ rewrite propeqE; split; rewrite /derivable/=. by near: x; exact: nbhs_dnbhs_neq. Unshelve. all: by end_near. Qed. +Lemma derivable_coord (a : V -> 'rV[R]_n) t v (i : 'I_n) : + derivable a t v -> + derivable (fun x : V => (a x)``_i) t v. +Proof. +move=> /cvg_ex[/= l Hl]. +apply/cvg_ex; exists (l``_i) => /=. +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0) Hl. +apply: filterS Hl => x. +rewrite {1}/Num.Def.normr/= mx_normrE. +move/bigmax_leP => -[_/=] /(_ (ord0, i)). +by rewrite !mxE/=; exact. +Qed. + +End pointwise_derivable. + +Section pointwise_derivable_TODO. (* TODO: generalize n/m+1 -> n/m*) +Context {R : realFieldType} {V W : normedModType R} {m n : nat}. +Implicit Types M : V -> 'M[R]_(m.+1, n.+1). + Lemma derivable_row M t v i : derivable M t v -> derivable (row i \o M) t v. Proof. rewrite /derivable => /cvg_ex[/= l Hl]. @@ -142,7 +173,7 @@ apply: le_trans; last first. rewrite /Num.Def.normr/= !mx_normrE. apply/bigmax_leP => /=. split. - exact: le_trans (le_bigmax _ _ (ord0, ord0)). + exact: le_trans (le_bigmax _ _ (ord0, ord0)). move=> j _. rewrite !mxE. under eq_bigr do rewrite !mxE. @@ -219,29 +250,15 @@ apply: ue. by near: x; exact: nbhs_dnbhs_neq. Unshelve. all: by end_near. Qed. -Lemma derivable_coord (a : V -> 'rV[R]_n.+1) t v (i : 'I_n.+1) : - derivable a t v -> - derivable (fun x : V => (a x)``_i) t v. -Proof. -move=> /cvg_ex[/= l Hl]. -apply/cvg_ex; exists (l``_i) => /=. -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hl => /(_ _ e0) Hl. -apply: filterS Hl => x. -rewrite {1}/Num.Def.normr/= mx_normrE. -move/bigmax_leP => -[_/=] /(_ (ord0, i)). -by rewrite !mxE/=; exact. -Qed. - -End pointwise_derivable. +End pointwise_derivable_TODO. Section pointwise_derive. Local Open Scope classical_set_scope. Context {R : realFieldType} {V W : normedModType R} . -Lemma derive_mx {m n : nat} (M : V -> 'M[R]_(m.+1, n.+1)) t v : - derivable M t v -> - 'D_v M t = \matrix_(i < m.+1, j < n.+1) 'D_v (fun t => M t i j) t. +Lemma derive_mx {m n : nat} (M : V -> 'M[R]_(m, n)) t v : + derivable M t v -> + 'D_v M t = \matrix_(i < m, j < n) 'D_v (fun t => M t i j) t. Proof. move=> /cvg_ex[/= l Hl]; apply/cvg_lim => //=. apply/cvgrPdist_le => /= e e0. @@ -276,7 +293,7 @@ rewrite -(addrA (_ - _)) (le_trans (ler_normD _ _))// (splitr e) lerD//. by rewrite !mxE. Unshelve. all: by end_near. Qed. -Lemma derive_trmx {m n : nat} (M : V -> 'M[R]_(m.+1, n.+1)) t v : +Lemma derive_trmx {m n : nat} (M : V -> 'M[R]_(m, n)) t v : derivable M t v -> 'D_v (trmx \o M) t = ('D_v M t)^T. Proof. move=> Mt1. @@ -291,11 +308,11 @@ Section derivable_mulmx. Context {R : realFieldType} {V : normedModType R} {m n k : nat}. Lemma derivable_mulmx - (f : V -> 'M[R]_(m.+1, k.+1)) (g : V -> 'M[R]_(k.+1, n.+1)) t v : + (f : V -> 'M[R]_(m, k)) (g : V -> 'M[R]_(k, n)) t v : derivable f t v -> derivable g t v -> derivable (fun x => f x *m g x) t v. Proof. move=> /derivable_mxP Hf /derivable_mxP Hg; apply/derivable_mxP => a b. -evar (f1 : 'I_k.+1 -> V -> R). +evar (f1 : 'I_k -> V -> R). rewrite (_ : (fun x => _) = \sum_i f1 i); last first. rewrite funeqE => t'; rewrite mxE fct_sumE; apply: eq_bigr => k0 _. by rewrite /f1; reflexivity. @@ -385,15 +402,15 @@ rewrite mulr1n; congr (_ ``_ _); apply val_inj; by rewrite /= ni addn0. Qed. Lemma derivable_row_belast (R : realFieldType) {V : normedModType R} - n (u : V -> 'rV[R]_n.+2) (t : V) (v : V): + n (u : V -> 'rV[R]_n.+1) (t : V) (v : V): derivable_mx u t v -> derivable_mx (fun x => row_belast (u x)) t v. Proof. -move=> H i j; move: (H ord0 (widen_ord (leqnSn n.+1) j)) => {H}. +move=> H i j; move: (H ord0 (widen_ord (leqnSn n) j)) => {H}. set f := fun _ => _. set g := fun _ => _. by rewrite (_ : f = g) // funeqE => x; rewrite /f /g mxE. Qed. -Lemma dotmul_belast {R : realFieldType} n (u : 'rV[R]_n.+2) (v1 : 'rV[R]_n.+1) v2 H : +Lemma dotmul_belast {R : realFieldType} n (u : 'rV[R]_n.+1) (v1 : 'rV[R]_n) v2 H : u *d castmx (erefl 1%nat, H) (row_mx v1 v2) = u *d castmx (erefl 1%nat, H) (row_mx v1 0%:M) + u *d castmx (erefl 1%nat, H) (row_mx 0 v2). @@ -403,7 +420,7 @@ case: fintype.splitP => [k /= jk|[] [] // ? /= jn]; by rewrite !(mxE,addr0,add0r Qed. Lemma derive1mx_dotmul_belast {R : realFieldType} {V : normedModType R} n - (u v : V -> 'rV[R]_n.+2) t w : + (u v : V -> 'rV[R]_n.+1) t w : derivable v t w -> let u' x := row_belast (u x) in let v' x := row_belast (v x) in u' t *d 'D_w v' t + (u t)``_ord_max *: derive (fun x => (v x)``_ord_max) t w = @@ -455,7 +472,7 @@ by elim/big_ind2 : _ => // [|] *; [exact: is_diff_cst|exact: is_diffD]. Qed. Lemma derive_dotmul {R : realFieldType} {V : normedModType R} n - (u v : V -> 'rV[R]_n.+1) (t : V) (w : V) : + (u v : V -> 'rV[R]_n) (t : V) (w : V) : derivable u t w -> derivable v t w -> 'D_w (fun x => u x *d v x) t = 'D_w u t *d v t + u t *d 'D_w v t. Proof. @@ -470,12 +487,13 @@ by rewrite {}/f deriveM// mulrC addrC; congr (_ * _ + _ * _); rewrite derive_mx ?mxE//=; exact/derivable_mxP. Qed. +(* NB: from Damien's LaSalle *) Global Instance is_diff_component {R : realFieldType} n i (p : 'rV[R]_n) : is_diff p (fun q => q..[i] : R^o) (fun q => q..[i]). Proof. have comp_lin : linear (fun q : 'rV[R]_n => q..[i] : R^o). by move=> ???; rewrite !mxE. -have comp_cont : continuous (fun q : 'rV[R]_n=> q..[i] : R^o). +have comp_cont : continuous (fun q : 'rV[R]_n => q..[i] : R^o). move=> q A [_/posnumP[e] Ae] /=; apply/nbhs_ballP; exists e%:num => //=. by move=> r [e0] /(_ ord0) /(_ i) /Ae. pose glM := GRing.isLinear.Build _ _ _ _ _ comp_lin. @@ -485,7 +503,7 @@ by rewrite (@diff_lin _ _ _ gL). Qed. Global Instance is_diff_component_comp {R : realFieldType} (V : normedModType R) n - (f : V -> 'rV[R]_n.+1) i p df : is_diff p f df -> + (f : V -> 'rV[R]_n) i p df : is_diff p f df -> is_diff p (fun q => (f q)..[i] : R^o) (fun q => (df q)..[i]). Proof. move=> dfp. @@ -496,8 +514,8 @@ exact: is_diff_comp. Qed. (* /NB: from Damien's LaSalle *) -Global Instance is_diff_dotmul {R : realFieldType} m n (V := 'rV[R]_m.+1) - (u v du dv : V -> 'rV[R]_n.+1) (t : V) : +Global Instance is_diff_dotmul {R : realFieldType} m n (V := 'rV[R]_m) + (u v du dv : V -> 'rV[R]_n) (t : V) : is_diff t u du -> is_diff t v dv -> is_diff t (fun x => u x *d v x) (fun x => u t *d dv x + v t *d du x). @@ -507,7 +525,7 @@ under eq_fun do rewrite dotmulE. set f := fun i : 'I__ => (fun x => (u x) ``_ i) * (fun x => (v x) ``_ i). rewrite [X in is_diff _ X _](_ : _ = \sum_(k < _) f k); last first. by rewrite funeqE => x; rewrite /f /= fct_sumE. -rewrite [X in is_diff _ _ X](_ : _ = \sum_(i < n.+1) +rewrite [X in is_diff _ _ X](_ : _ = \sum_(i < n) ((u t)``_i *: (fun x => (dv x)``_i) + (v t)``_i *: (fun x => (du x)``_i))); last first. by apply/funext => x; rewrite 2!dotmulE -big_split/= fct_sumE. apply: is_diff_sum => i. @@ -515,8 +533,8 @@ rewrite {}/f /=. exact: is_diffM. Qed. -Lemma differentiable_dotmul {R : realFieldType} m n (V := 'rV[R]_m.+1) - (u v : V -> 'rV[R]_n.+1) (t : V) : +Lemma differentiable_dotmul {R : realFieldType} m n (V := 'rV[R]_m) + (u v : V -> 'rV[R]_n) (t : V) : differentiable u t -> differentiable v t -> differentiable (fun x => u x *d v x) t. @@ -569,7 +587,7 @@ by apply/funext => y; rewrite !mxE. Qed. Lemma derivable_dotmul {R : realFieldType} {n} - (u v : R -> 'rV[R]_n.+1) t : + (u v : R -> 'rV[R]_n) t : derivable u t 1 -> derivable v t 1 -> derivable (fun x => u x *d v x) t 1. Proof. diff --git a/tilt.v b/tilt.v index 40d1dac1..7ed98ad3 100644 --- a/tilt.v +++ b/tilt.v @@ -3,31 +3,36 @@ From mathcomp Require Import all_ssreflect all_algebra ring. From mathcomp Require Import interval_inference. From mathcomp Require Import boolp classical_sets functions reals order. From mathcomp Require Import topology normedtype landau derive realfun. +From mathcomp Require Import matrix_normedtype. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. -(*Require Import lasalle pendulum.*) (**md**************************************************************************) -(* # tentative formalization of [1] *) +(* # Tentative formalization of [1] *) (* *) (* ``` *) -(* posdefmx M == M is definite positive *) -(* locposdef V x == V is locally positive definite at x *) -(* is_lyapunov_candidate V := locposdef V *) -(* locnegsemidef V x == V is locally negative semidefinite *) -(* LieDerivative V x == Lie derivative *) -(* solves_equation f y == the function y satisfies y' = f y *) -(* is_equilibrium_point f p := solves_equation f (cst p) *) -(* state_space f == the set points attainable by a solution *) -(* (in the sense of `solves_equation`) *) -(* is_lyapunov_stable_at f V x == Lyapunov stability *) +(* posdefmx M == M is definite positive *) +(* locposdef V x == V is locally positive definite at x *) +(* is_Lyapunov_candidate V := locposdef V *) +(* locnegsemidef V x == V is locally negative semidefinite *) +(* 'D~(sol, x0) V == derivative of V along the solution sol *) +(* starting at x0 *) +(* is_sol f y == the function y satisfies y' = phi y *) +(* is_equilibrium_point f p := solves_equation f (cst p) *) +(* state_space f == the set points attainable by a solution *) +(* (in the sense of `is_sol`) *) +(* is_Lyapunov_stable_at f V x == Lyapunov stability *) (* ``` *) (* *) -(* References: *) +(* Reference: *) (* - [1] *) (* https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) +(* - [2]: Hassan K. Khalil, Nonlinear systems, 2002*) (******************************************************************************) +Reserved Notation "''D~(' sol , x ) f" (at level 10, sol, x, f at next level, + format "''D~(' sol , x ) f"). + Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -36,9 +41,55 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. +(* additions to MathComp-Analysis *) + + +Lemma ball0_le0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : + ball a r = set0 -> r <= 0. +Proof. +rewrite -subset0 => ar0; rewrite leNgt; apply/negP => r0. +by have /(_ (ballxx _ r0)) := ar0 a. +Qed. + +Lemma le0_ball0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : + r <= 0 -> ball a r = set0. +Proof. +move=> r0; rewrite -subset0 => y. +rewrite -ball_normE /ball_/= ltNge => /negP; apply. +by rewrite (le_trans r0). +Qed. + +Lemma closed_ball0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : + r <= 0 -> closed_ball a r = set0. +Proof. +move=> r0; rewrite -subset0 => v. +by rewrite /closed_ball le0_ball0// closure0. +Qed. + +Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n) : + 0 < e -> closed_ball x e = closed_ball_ (@mx_norm _ _ _) x e. +Proof. +by move=> e0; rewrite closed_ballE. +Qed. + +Import Order.Def. + +Lemma maxE {K : realType} (x y : {nonneg K}) : + (max x%:num y%:num) = (max x y)%:num. +Proof. +rewrite /max; apply/esym. +case: ifPn => // xy. + case: ifPn => //. + rewrite -leNgt => yx. + by apply/eqP; rewrite eq_le yx/= ltW. +case: ifPn => // yx. +apply/eqP; rewrite eq_le (ltW yx)/=. +by rewrite -leNgt in xy. +Qed. + Local Open Scope classical_set_scope. (* NB: we are just mimicking the proofs for the real line already available in derive.v *) -Lemma EVT_max_rV (R : realType) n (f : 'rV[R]_n.+1 -> R) (A : set 'rV[R]_n.+1) : +Lemma EVT_max_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : A !=set0 -> compact A -> {within A, continuous f} -> exists2 c, c \in A & @@ -78,7 +129,7 @@ rewrite -[ltRHS]invrK ltf_pV2// ?qualifE/= ?invr_gt0 ?subr_gt0 ?imf_ltsup//; las by rewrite (le_lt_trans (ler_norm _) _) ?imVfltk//; exact: imageP. Qed. -Lemma EVT_min_rV (R : realType) n (f : 'rV[R]_n.+1 -> R) (A : set 'rV[R]_n.+1) : +Lemma EVT_min_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : A !=set0 -> compact A -> {within A, continuous f} -> exists2 c, c \in A & @@ -91,6 +142,69 @@ by exists c => // ? /fcmax; rewrite lerN2. Qed. Local Close Scope classical_set_scope. +(* TODO: rm with MCA 1.15.0 *) +Definition Jacobian n m (R : numFieldType) (f : 'rV[R]_n -> 'rV[R]_m) p := + lin1_mx ('d f p). + +Section gradient. + +Definition jacobian1 {R : numFieldType} n (f : 'rV[R]_n -> R) + : 'rV_n -> 'cV_n := + Jacobian (scalar_mx \o f). + +(* NB: not used*) +Definition partial {R : realType} {n : nat} (f : 'rV[R]_n -> R) (a : 'rV[R]_n) i := + lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. + +Lemma partial_diff {R : realType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) + (i : 'I_n) : + derivable f a 'e_i -> + partial f a i = ('D_'e_i (@scalar_mx _ 1 \o f) a) 0 0. +Proof. +move=> fa1. +rewrite derive_mx ?mxE//=; last first. + exact: derivable_scalar_mx. +rewrite /partial. +under eq_fun do rewrite (addrC a). +by under [in RHS]eq_fun do rewrite !mxE/= !mulr1n. +Qed. + +(* NB: not used *) +Definition err_vec {R : pzRingType} n (i : 'I_n) : 'rV[R]_n := + \row_(j < n) (i == j)%:R. + +Lemma err_vecE {R : pzRingType} n (i : 'I_n) : + err_vec i = 'e_i :> 'rV[R]_n. +Proof. +apply/rowP => j. +by rewrite !mxE eqxx /= eq_sym. +Qed. + +Definition gradient_partial {R : realType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) := + \row_(i < n) partial f a i. + +Lemma gradient_partial_sum {R : realType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) : + gradient_partial f a = \sum_(i < n) partial f a i *: 'e_i. +Proof. +rewrite /gradient_partial [LHS]row_sum_delta. +by under eq_bigr do rewrite mxE. +Qed. + +(* TODO: generalize with MCA 1.15.0 *) +Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n -> R) + (v : 'rV[R]_n) : differentiable f v -> + gradient_partial f v = (jacobian1 f v)^T. +Proof. +move=> fa; apply/rowP => i. +rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. + apply: differentiable_comp => //. + exact: differentiable_scalar_mx. +rewrite partial_diff//. +exact/diff_derivable. +Qed. + +End gradient. + (* spin and matrix/norm properties*) Lemma norm_spin {R : rcfType} (u : 'rV[R]_3) (v : 'rV[R]_3) : @@ -117,116 +231,65 @@ Qed. Definition posdefmx {R : realType} m (M : 'M[R]_m) : Prop := M \is sym m R /\ forall a, eigenvalue M a -> a > 0. +(*From mathcomp Require Import spectral. +From mathcomp Require Import complex.*) + Lemma posdefmxP {R : realType} m (M : 'M[R]_m) : posdefmx M <-> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). Proof. split. +(* rewrite /posdefmx => -[symM eigen_gt0] v v0. +Local Open Scope complex_scope. + pose M' := map_mx (fun r => r%:C) M. + have : M' \is normalmx. + apply: symmetric_normalmx.*) move => [Msym eigenM] x x_neq0. apply/eigenM/eigenvalueP. exists x => //=. - (* spectral theorem? *) Admitted. Local Open Scope classical_set_scope. -Definition locposdef {R : realType} (T : normedModType R) (V : T -> R) - (D : set T) (x : T) : Prop := +Section locdef. +Context {R : realType} {T : normedModType R}. +Implicit Types V : T -> R. + +Definition locposdef V (D : set T) (x : T) := x \in D /\ V x = 0 /\ forall z, z \in D -> z != x -> V z > 0. -(* add continuously diff *) -Definition is_lyapunov_candidate {K : realType} {n} (V : 'rV[K]_n.+1 -> K) - (D : set 'rV[K]_n.+1) (x0 : 'rV[K]_n.+1) := - locposdef V D x0 /\ differentiable V x0. +Definition locnegdef V (x : T) := V x = 0 /\ \forall z \near x^', V z < 0. -(* locally positive semi definite (NB* not used yet) *) -Definition lpsd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near x^', V z >= 0. +(* locally positive semi definite *) +(* NB: not used yet *) +Definition locposemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z >= 0. (* locally negative semidefinite *) -Definition locnegsemidef {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near x^', V z <= 0. +Definition locnegsemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z <= 0. -(* locally negative definite (NB: not used yet) *) -Definition lnd {R : realType} (T : normedModType R) (V : T -> R) (x : T) : Prop := - V x = 0 /\ \forall z \near x^', V z < 0. +End locdef. +Notation is_Lyapunov_candidate := locposdef. -Section derive_help. -Local Open Scope classical_set_scope. -End derive_help. +(* derivation along the trajectory h *) +Definition derive_along {R : realType} {n : nat} + (V : 'rV[R]_n -> R) (f : R -> 'rV[R]_n) + (t : R) : R := + (jacobian1 V (f t))^T *d 'D_1 f t. -Section gradient. +Notation "''D~(' sol , x ) f" := (derive_along f (sol x)). -Definition jacobian1 {R : numFieldType} n (f : 'rV[R]_n.+1 -> R) - : 'rV_n.+1 -> 'cV_n.+1 := - jacobian (scalar_mx \o f). -(* not used*) -Definition partial {R : realType} {n : nat} (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) i := - lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. +Section derive_along. +Context {R : realType} {n : nat}. +Variable sol : 'rV[R]_n -> R -> 'rV[R]_n. +(* sol represents the solutions of a differential equation *) -Lemma partial_diff {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) - (i : 'I_n.+1) : - derivable f a 'e_i -> - partial f a i = ('D_'e_i (@scalar_mx _ 1 \o f) a) 0 0. -Proof. -move=> fa1. -rewrite derive_mx ?mxE//=; last first. - exact: derivable_scalar_mx. -rewrite /partial. -under eq_fun do rewrite (addrC a). -by under [in RHS]eq_fun do rewrite !mxE/= !mulr1n. -Qed. - -(* NB: not used *) -Definition err_vec {R : ringType} n (i : 'I_n.+1) : 'rV[R]_n.+1 := - \row_(j < n.+1) (i == j)%:R. - -Lemma err_vecE {R : ringType} n (i : 'I_n.+1) : - err_vec i = 'e_i :> 'rV[R]_n.+1. -Proof. -apply/rowP => j. -by rewrite !mxE eqxx /= eq_sym. -Qed. - -Definition gradient_partial {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) := - \row_(i < n.+1) partial f a i. - -Lemma gradient_partial_sum {R : realType} n (f : 'rV[R]_n.+1 -> R) (a : 'rV[R]_n.+1) : - gradient_partial f a = \sum_(i < n.+1) partial f a i *: 'e_i. -Proof. -rewrite /gradient_partial [LHS]row_sum_delta. -by under eq_bigr do rewrite mxE. -Qed. - -Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n.+1 -> R) - (v : 'rV[R]_n.+1) : differentiable f v -> - gradient_partial f v = (jacobian1 f v)^T. -Proof. -move=> fa; apply/rowP => i. -rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. - apply: differentiable_comp => //. - exact: differentiable_scalar_mx. -rewrite partial_diff//. -exact/diff_derivable. -Qed. - -End gradient. - -Section LieDerivative. - -Definition LieDerivative {R : realType} n (V : 'rV[R]_n.+1 -> R) - (phi : 'rV[R]_n.+1 -> R -> 'rV[R]_n.+1) (x : 'rV[R]_n.+1) (t : R) : R := - (jacobian1 V (phi x t))^T *d 'D_1 (phi x) t. -(* we assume that phi is the solution of a diff equa such that phi 0 x = x *) - -Lemma LieDerivative_derive {R : realType} n (V : 'rV[R]_n.+1 -> R) - (phi : 'rV[R]_n.+1 -> R -> 'rV[R]_n.+1) (t : R) (x : 'rV[R]_n.+1) : - (differentiable V (phi x t)) -> (differentiable (phi x) t) -> - LieDerivative V phi x t = 'D_1 (V \o (phi x)) t. +Lemma derive_along_derive (V : 'rV[R]_n -> R) (x0 : 'rV[R]_n) (t : R) : + differentiable V (sol x0 t) -> differentiable (sol x0) t -> + 'D~(sol, x0) V t = 'D_1 (V \o sol x0) t. (* Warning: we are not representing the initial state at t = 0 of the trajectory x see Khalil p.114 *) Proof. move => dif1 dif2. -rewrite /LieDerivative /=. +rewrite /derive_along /=. rewrite /jacobian1. rewrite /jacobian. rewrite /dotmul. @@ -235,775 +298,439 @@ rewrite mul_rV_lin1. rewrite mxE. rewrite -deriveE => //=; last first. apply: differentiable_comp => //=. - exact/differentiable_scalar_mx (* *). -rewrite derive_mx /=. + exact/differentiable_scalar_mx. +rewrite derive_mx /=; last first. + apply: derivable_scalar_mx => //=. + exact: diff_derivable. rewrite mxE. rewrite [in RHS]deriveE => //=. rewrite [in RHS]diff_comp => //=. rewrite -![in RHS]deriveE => //=. under eq_fun do rewrite mxE /= mulr1n /=. -by []. -apply: differentiable_comp => //=; last first. -apply: derivable_scalar_mx => //=. -apply: diff_derivable => //=. + by []. +exact: differentiable_comp. Qed. -Lemma LieDerivativeMl {R : realType} n (f : 'rV_n.+1 -> R) (phi : 'rV[R]_n.+1 -> R -> 'rV_n.+1) - (x : 'rV[R]_n.+1) - (k : R) t : - (differentiable f (phi x t)) -> differentiable (phi x) t -> - LieDerivative (k *: f) phi x t = k *: LieDerivative f phi x t. +Lemma derive_alongMl (f : 'rV_n -> R) (k : R) (x : 'rV[R]_n) t : + differentiable f (sol x t) -> differentiable (sol x) t -> + 'D~(sol, x) (k *: f) t = k *: 'D~(sol, x) f t. Proof. move=> dfx dpx. -rewrite LieDerivative_derive; last 2 first. - apply: differentiable_comp => //=. - done. +rewrite derive_along_derive; last 2 first. + exact: differentiable_comp. + by []. rewrite deriveZ/=; last first => //=. apply: diff_derivable => //=. rewrite -fctE. - apply: differentiable_comp => //=. + exact: differentiable_comp. congr (_ *: _). -rewrite LieDerivative_derive//=. +by rewrite derive_along_derive. Qed. -Lemma LieDerivativeD {R : realType} n (f g : 'rV_n.+1 -> R) (phi : 'rV[R]_n.+1 -> R -> 'rV_n.+1) (x : 'rV_n.+1) t : - (differentiable f (phi x t)) -> differentiable g (phi x t) -> - differentiable (phi x) t -> - LieDerivative (f + g) phi x t = LieDerivative f phi x t + LieDerivative g phi x t. +Lemma derive_alongD (f g : 'rV_n -> R) (x : 'rV_n) t : + differentiable f (sol x t) -> differentiable g (sol x t) -> + differentiable (sol x) t -> + 'D~(sol, x) (f + g) t = 'D~(sol, x) f t + 'D~(sol, x) g t. Proof. move=> dfx dgx difp. -rewrite LieDerivative_derive; last 2 first. - by apply: differentiableD => //=. - done. +rewrite derive_along_derive; last 2 first. + exact: differentiableD. + by []. rewrite deriveD/=; last 2 first. apply: diff_derivable => //. rewrite -fctE . - by apply: differentiable_comp => //=. + exact: differentiable_comp. apply: diff_derivable => //. rewrite -fctE . - by apply: differentiable_comp => //=. -rewrite LieDerivative_derive; last 2 first. - by []. - by []. -rewrite LieDerivative_derive; last 2 first. - by []. - by []. -by []. + exact: differentiable_comp. +rewrite derive_along_derive; [|by []..]. +by rewrite derive_along_derive. Qed. -Lemma derivative_LieDerivative_eq0 {K : realType} n - (phi : 'rV[K]_n.+1 -> K -> 'rV_n.+1) - (f : 'rV_n.+1 -> K) (x : 'rV[K]_n.+1) (t : K) : - (differentiable f (phi x t)) -> - 'D_1 (phi x) t = 0 -> LieDerivative f phi x t = 0. +Lemma derivative_derive_along_eq0 (f : 'rV_n -> R) (x : 'rV[R]_n) (t : R) : + differentiable f (sol x t) -> + 'D_1 (sol x) t = 0 -> 'D~(sol, x) f t = 0. Proof. move=> xt1 dtraj. -rewrite /LieDerivative /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. +rewrite /derive_along /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. by rewrite dtraj mul0mx !mxE. Qed. -Local Notation Left := (@lsubmx _ 1 3 3). -Local Notation Right := (@rsubmx _ 1 3 3). - -Lemma LieDerivative_norm_squared {K : realType} n m (f : 'rV[K]_n.+1 -> 'rV_m.+1) - (phi : 'rV[K]_n.+1 -> K -> 'rV_n.+1) - (x : 'rV[K]_n.+1) (t : K) : - differentiable f (phi x t) -> - differentiable (phi x) t -> - LieDerivative (fun y => norm (f y) ^+ 2) phi x t = - (2 *: 'D_1 (f \o phi x) t *m (f (phi x t))^T) 0 0. +Lemma derive_along_norm_squared m (f : 'rV[R]_n -> 'rV_m) + (x : 'rV[R]_n) (t : R) : + differentiable f (sol x t) -> + differentiable (sol x) t -> + 'D~(sol, x) (fun y => norm (f y) ^+ 2) t = + (2 *: 'D_1 (f \o sol x) t *m (f (sol x t))^T) 0 0. Proof. move=> difff diffphi. -rewrite LieDerivative_derive => //=; last exact: differentiable_norm_squared. -rewrite -derive1E /= fctE derive_norm_squared //=; last first. +rewrite derive_along_derive => //=; last exact: differentiable_norm_squared. +rewrite fctE derive_norm_squared //=; last first. by apply: diff_derivable=> //=; exact: differentiable_comp. by rewrite mulrDl mul1r scalerDl scale1r mulmxDl [in RHS]mxE. Qed. -End LieDerivative. +End derive_along. -(* not used, can be shown to be equivalent to LieDerivative *) -Definition LieDerivative_partial {R : realType} n (V : 'rV[R]_n.+1 -> R) - (a : R -> 'rV[R]_n.+1) (t : R) : R := - \sum_(i < n.+1) (partial V (a t) i * ('D_1 a t) ``_ i). +(* NB: not used, can be shown to be equivalent to derive_along *) +Definition derive_along_partial {R : realType} n (V : 'rV[R]_n -> R) + (a : R -> 'rV[R]_n) (t : R) : R := + \sum_(i < n) (partial V (a t) i * ('D_1 a t) ``_ i). Section ode_equation. Context {K : realType} {n : nat}. -Let T := 'rV[K]_n.+1. +Let T := 'rV[K]_n. Variable phi : (K -> T) -> K -> T. -Definition is_sol (x : K -> T) (A : set T) : Prop := - [/\ x 0 \in A, (forall t, derivable x t (1:K)%R) +Definition is_sol (x : K -> T) (A : set T) := + [/\ x 0 \in A, (forall t, derivable x t 1) & forall t, 'D_1 x t = phi x t]. - (*sol0x : sol (phi 0) 0 = phi 0*) -Definition is_equilibrium_point x := is_sol (cst x). -Definition equilibrium_points A := [set p : T | is_equilibrium_point p A ]. +Lemma is_sol_subset y0 (A B : set T) (AB : A `<=` B) : + is_sol y0 A -> is_sol y0 B. +Proof. +rewrite /is_sol inE => -[inD0 deriv tilt]; rewrite inE. +by split; [exact: AB|exact: deriv|exact: tilt]. +Qed. Definition state_space A := [set p : T | exists y, is_sol y A /\ exists t, p = y t ]. +Definition is_equilibrium_point x := is_sol (cst x). + +Lemma is_equilibrium_point_subset x (A B : set T) (AB : A `<=` B) : + is_equilibrium_point x A -> is_equilibrium_point x B. +Proof. +rewrite /is_equilibrium_point /is_sol inE => -[inD0 deriv tilt]. +by rewrite inE; split; [exact: AB|exact: deriv|exact: tilt]. +Qed. + +Definition equilibrium_points A := [set p : T | is_equilibrium_point p A ]. + Definition equilibrium_is_stable_at - (A : set T) (x : T) (z : K -> 'rV[K]_n.+1) := + (A : set T) (x : T) (z : K -> 'rV[K]_n) := forall eps, eps > 0 -> exists2 d, d > 0 & (`| z 0 - x | < d -> forall t, t >= 0 -> `| z t - x | < eps). -(*Definition is_stable_equilibrium - (A : set T) (x : T) := - forall z (solves_z : solves_equation z A), is_stable_equilibrium_at x solves_z.*) - -(* a voir*) - Definition equilibrium_is_asymptotically_stable_at - (A : set T) (x : T) (z : K -> 'rV[K]_n.+1) : Prop := + (A : set T) (x : T) (z : K -> 'rV[K]_n) : Prop := exists2 d, d > 0 & (`| z 0 - x | < d -> z t @[t --> +oo] --> x). End ode_equation. - (* axiom cauchy thm 3.3 *) - -(* preuve qui repose sur la continuite et la monotonie via locpos - continument differentiable V*) - -From mathcomp Require Import normedtype. -From mathcomp Require Import matrix_normedtype. - -Lemma ball0_le0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : - ball a r = set0 -> r <= 0. -Proof. -rewrite -subset0 => ar0; rewrite leNgt; apply/negP => r0. -by have /(_ (ballxx _ r0)) := ar0 a. -Qed. -Lemma le0_ball0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : - r <= 0 -> ball a r = set0. -Proof. -move=> r0; rewrite -subset0 => y. -rewrite -ball_normE /ball_/= ltNge => /negP; apply. -by rewrite (le_trans r0). -Qed. +Definition existence_uniqueness {K : realType} {n} (D : set 'rV[K]_n) + (f : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) + (sol : 'rV[K]_n -> K -> 'rV[K]_n) := + forall y, y 0 \in D -> is_sol f y D <-> sol (y 0) = y. -Lemma closed_ball0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : - r <= 0 -> closed_ball a r = set0. -Proof. -move=> r0; rewrite -subset0 => v. -by rewrite /closed_ball le0_ball0// closure0. -Qed. +Definition initial_condition {K : realType} {n} + (sol : 'rV[K]_n -> K -> 'rV[K]_n) := + forall p, sol p 0 = p. -Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n.+1) : - 0 < e -> closed_ball x e = closed_ball_ (@mx_norm _ _ _) x e. -Proof. -by move=> e0; rewrite closed_ballE. -Qed. - -(* we introduce a definition of uniqueness of solutions of a -differential equation that we will assume when necessary for -lack of a formalization of Cauchy-Lipschitz/Picard-Lindelof theorem. *) Section solutions_unique. Context {K : realType} {n : nat}. -Variable D : set 'rV[K]_n.+1. -Variable f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. +Variable D : set 'rV[K]_n. +Variable f : (K -> 'rV[K]_n) -> K -> 'rV[K]_n. -Definition solutions_unique := forall (a b : K -> 'rV_n.+1) (x0 : 'rV_n.+1), - is_sol f a D -> - is_sol f b D -> +Definition solutions_unique := forall (a b : K -> 'rV_n) (x0 : 'rV_n), + is_sol f a D -> + is_sol f b D -> a 0 = x0 -> b 0 = x0 -> a = b. End solutions_unique. -Section Lyapunov_stability. -Context {K : realType} {n : nat}. -Variable D : set 'rV[K]_n.+1. -Variable f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. -Variable sol : 'rV[K]_n.+1 -> K -> 'rV[K]_n.+1. -Hypothesis openD : open D. (* D est forcement un ouvert *) -Hypothesis solP : forall y, y 0 \in D -> - is_sol f y D <-> - sol (y 0) = y. -(* see Cohen Rouhling ITP 2017 Sect 3.2*) -Hypothesis solves : forall x, x \in D -> - is_sol f (sol x) D. - - -Let Df_unique : solutions_unique D f. +Lemma existence_uniqueness_unique {K : realType} {n} (D : set 'rV[K]_n) + (f : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) + (sol : 'rV[K]_n -> K -> 'rV[K]_n) : + existence_uniqueness D f sol -> solutions_unique D f. Proof. -rewrite /solutions_unique. +move=> solP. move => a b x0. move => fad fbd a0 b0. apply/funext => x. case : (fad) => //=. move => a0D Da fa. -have := solP a0D. +have := solP _ a0D. case. move => /(_ fad). -move => a0a _. +move => a0a _. case : (fbd) => //=. move => b0D Db fb. -have := solP b0D. +have := solP _ b0D. case. move => /(_ fbd). -move => b0b _. +move => b0b _. rewrite -b0b -a0a. by rewrite a0 b0. Qed. -(* TODO continuously differentiable*) -(* TODO: prove the same theorem with equilibrium_is_asymptotically_stable_at *) -Import Order.Def. +Lemma existence_uniqueness_exists {K : realType} {n} (D : set 'rV[K]_n) + (f : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) + (sol : 'rV[K]_n -> K -> 'rV[K]_n) : + existence_uniqueness D f sol -> initial_condition sol -> + forall p, p \in D -> is_sol f (sol p) D. +Proof. +move=> solP sol0 p pD. +have H := solP (sol p). +apply H. + by rewrite sol0. +by rewrite sol0. +Qed. -(* NB: added to be able to produce the following instance to be able to use bigop lemmas *) -Lemma nng_max0r : left_id ((0:K)%:nng) (@maxr {nonneg K}). -Proof. -move=> x. -rewrite /max; case: ifPn => //. -rewrite -leNgt => x0. -apply/eqP; rewrite eq_le; apply/andP; split; last first. - exact: x0. -by have : 0 <= x%:nngnum by []. (* NB: this should be automatic *) +Section sphere. +Context {K : realType} {n : nat}. + +Definition sphere r := [set x : 'rV[K]_n.+1 | `|x| = r]. + +Lemma sphere_nonempty r : 0 < r -> sphere r !=set0. +Proof. +move=> r_gt0; exists (const_mx r). +rewrite /sphere /= /normr/=. +(* TODO: need lemma? *) +rewrite mx_normrE/=. +apply/eqP; rewrite eq_le; apply/andP; split. + apply: bigmax_le. + exact: ltW. + by move=> i _; rewrite mxE gtr0_norm. +under eq_bigr do rewrite mxE gtr0_norm//. +apply/le_bigmax => /=. +exact: (ord0, ord0). Qed. -HB.instance Definition _ := - Monoid.isComLaw.Build {nonneg K} 0%:nng max maxA maxC nng_max0r. +Lemma compact_sphere r : compact (sphere r). +Proof. +apply: bounded_closed_compact. + suff : \forall M \near +oo, forall p, sphere r p -> forall i, `|p ord0 i| < M. + rewrite /bounded_set; apply: filter_app; near=> M0. + move=> Kbnd /= p /Kbnd ltpM0. + rewrite /normr/= mx_normrE. + apply/bigmax_leP; split => //= i _. + by rewrite ord1; exact/ltW/ltpM0. + near=> M => v. + rewrite /sphere /= => vr i. + rewrite (@le_lt_trans _ _ r)//. + rewrite -vr [leRHS]/normr/= mx_normE. + under eq_bigr do rewrite ord1. + rewrite -(pair_big xpredT xpredT (fun _ j => `|v ord0 j|%:nng))//=. + rewrite big_ord_recr/= big_ord0. + rewrite max_r; last exact/bigmax_ge_id. + rewrite (bigD1 i)//= -maxE le_max. + by apply/orP; left. + clear v vr i. + by near: M; apply: nbhs_pinfty_gt; rewrite num_real. +pose d := fun x : 'rV[K]_n.+1 => `|x| : K. +have contd : continuous d by move=> /= z; exact: norm_continuous. +rewrite [X in closed X](_ : _ = d @^-1` [set r]); last first. + by apply/seteqP; split. +by apply continuous_closedP. +Unshelve. all: by end_near. Qed. + +End sphere. + +Section Lyapunov_stability. +Context {K : realType} {n : nat}. +Variable D : set 'rV[K]_n.+1 (* TODO: n+1 -> n *). +Variable f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. +Variable sol : 'rV[K]_n.+1 -> K -> 'rV[K]_n.+1. +Hypothesis openD : open D. (* D est forcement un ouvert *) +(* see Cohen Rouhling ITP 2017 Sect 3.2 *) +Hypothesis solP : existence_uniqueness D f sol. +Hypothesis sol0 : initial_condition sol. + +Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. -Lemma maxE (x y : {nonneg K}) : (max x%:num y%:num) = (max x y)%:num. +Let BE r : 0 < r -> B r = closed_ball 0 r. +Proof. by move=> r0; rewrite /B -closed_ballE. Qed. + +Variable V : 'rV[K]_n.+1 -> K. +Hypothesis V'le_0 : forall x, x \in D -> + forall t, t >= 0 -> 'D~(sol, x) V t <= 0. +Hypothesis Vderiv : forall t : 'rV[K]_n.+1, differentiable V t. + +Let V_nincr a b : 0 <= a <= b -> + forall x, x \in D -> V (sol x b) <= V (sol x a). Proof. -rewrite /max; apply/esym. -case: ifPn => // xy. - case: ifPn => //. - rewrite -leNgt => yx. - by apply/eqP; rewrite eq_le yx/= ltW. -case: ifPn => // yx. -apply/eqP; rewrite eq_le (ltW yx)/=. -by rewrite -leNgt in xy. +move=> /andP[a_ge0 ab] x xD. +apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. +- move=> y yb. + apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. + rewrite -derivable1_diffP. + by have [] : is_sol f (sol x) D by apply solP; rewrite sol0. +- move=> y yb. + rewrite derive1E -derive_along_derive//. + + apply: V'le_0 => //. + by move : yb; rewrite in_itv/= => /andP[/ltW]. + + rewrite -derivable1_diffP. + by have [] : is_sol f (sol x) D by apply solP; rewrite sol0. +- apply: continuous_subspaceT => z. + apply: continuous_comp; last exact: differentiable_continuous. + apply: differentiable_continuous => //. + rewrite -derivable1_diffP. + by have [] : is_sol f (sol x) D by apply solP; rewrite sol0. +- by rewrite !in_itv/= lexx (le_trans a_ge0). +- by rewrite in_itv/= ab andbT. Qed. -Theorem lyapunov_stability - (x : 'rV[K]_n.+1 := 0) -(* (fsolD : forall z, z \in D -> is_sol f (sol z) D /\ - sol z 0 = z)*) - (* (sol0x : forall x, sol x 0 = x)*) - (*sol0x : sol (phi 0) 0 = phi 0*) - (V : 'rV[K]_n.+1 -> K) - (VDx : is_lyapunov_candidate V D x) - (*contient l'hypothese x in D*) - (V'le_0 : forall y : K -> 'rV[K]_n.+1, y 0 \in D (*-> is_sol f (sol (y 0)) D*) -> forall t, t >= 0 -> LieDerivative V sol (y 0) t <= 0) - (Vderiv : forall t, differentiable V t) : +(* khalil theorem 4.1 *) (* TODO: generalize to x != 0 *) +Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) + (VDx : is_Lyapunov_candidate V D x) : is_equilibrium_point f x D -> equilibrium_is_stable_at D x (sol x). Proof. -move => eq. -move => eps eps0. -rewrite /is_lyapunov_candidate in VDx. -move: VDx => [/= Vloc Vdiff]. -move: Vloc => [/= inD [V0 z1]]. -(*have solx1_0 (x1 : K -> 'rV_n.+1) (Dx1 : x1 0 \in D) : sol (x1 0) = x1. - apply solP => //. - have H0 := solves Dx1 => //.*) -have : exists r : K, 0 < r /\ r <= eps /\ closed_ball_ (fun x => `|x|) (0:'rV[K]_n.+1) r `<=` D. - rewrite inE in inD. - have [r0 /= Hr0D] := open_subball openD inD. +move=> eq /= eps eps0. +move: VDx => [/= xD [Vx0 DxV]]. +have [r [r_gt0 [r_eps BrD]]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` D. + move: xD; rewrite inE => /(open_subball openD)[r0/= r0_gt0] q. pose r := Num.min (r0 / 2) eps. - have r_gt0 : 0 < r. - rewrite /r /minr. - case: ifPn => // _. - by rewrite divr_gt0. - move=> q. - exists (r / 2). - split. - by rewrite divr_gt0. - split. - rewrite /r. - rewrite /minr. - case: ifPn. - move/ltW; apply: le_trans. - rewrite ler_pdivrMr//. - by rewrite ler_peMr ?ler1n// divr_ge0// ltW. - move=> _. - rewrite ler_pdivrMr//. - by rewrite ler_peMr ?ler1n// ltW. - move=> v rv. - apply (q r); last 2 first. - by []. - move: rv. - rewrite -closed_ballE//; last first. - by rewrite divr_gt0. - by apply: subset_closure_half => //. - rewrite /ball/=. - rewrite sub0r normrN gtr0_norm// /r. - rewrite gt_min. - rewrite ltr_pdivrMr//. - by rewrite ltr_pMr// ltr1n. -have Hcont := differentiable_continuous Vdiff. -move=> [r [r_pos [r_le_eps Br_sub_D]]]. -pose sphere_r := [set x : 'rV[K]_n.+1 | `|x| = r]. -have Halpha : {x : 'rV[K]_n.+1 | x \in sphere_r /\ forall y, y \in sphere_r -> V x <= V y}. - have sphere_r0 : sphere_r !=set0. - exists (const_mx r). - rewrite /sphere_r/= /normr/=. - (* TODO: need lemma *) - rewrite mx_normrE/=. - apply/eqP; rewrite eq_le; apply/andP; split. - apply: bigmax_le => //. - exact: ltW. - by move=> i _; rewrite mxE gtr0_norm. - under eq_bigr do rewrite mxE gtr0_norm//. - apply/le_bigmax => /=. - exact: (ord0, ord0). - have compact_sphere_r : compact sphere_r. - apply: bounded_closed_compact. - suff : \forall M \near +oo, forall p, sphere_r p -> forall i, `|p ord0 i| < M. - rewrite /bounded_set; apply: filter_app; near=> M0. - move=> Kbnd /= p /Kbnd ltpM0. - rewrite /normr/= mx_normrE. - apply/bigmax_leP; split => //= i _. - by rewrite ord1; exact/ltW/ltpM0. - near=> M => v. - rewrite /sphere_r/= => vr i. - rewrite (@le_lt_trans _ _ r)//. - rewrite -vr [leRHS]/normr/= mx_normE. - under eq_bigr do rewrite ord1. - rewrite -(pair_big xpredT xpredT (fun _ j => `|v ord0 j|%:nng))//=. - rewrite big_ord_recr/= big_ord0. - rewrite max_r; last exact/bigmax_ge_id. - rewrite (bigD1 i)//= -maxE le_max. - by apply/orP; left. - clear v vr i. - by near: M; apply: nbhs_pinfty_gt; rewrite num_real. - pose d := fun x : 'rV[K]_n.+1 => `|x| : K. - have contd : continuous d by move=> /= z; exact: norm_continuous. - rewrite [X in closed X](_ : _ = d @^-1` [set r]); last first. - by apply/seteqP; split. - by apply continuous_closedP. - have contV : {within sphere_r, continuous V}. + have r_gt0 : 0 < r by rewrite /r lt_min eps0 divr_gt0. + exists (r / 2); first by rewrite divr_gt0. + split; first by rewrite /r ler_pdivrMr// ge_min ler_pMr// ler1n orbT. + move=> v Brv; apply (q r) => //. + rewrite /ball/= sub0r normrN gtr0_norm//. + by rewrite /r gt_min ltr_pdivrMr// ltr_pMr// ltr1n. + by move: Brv; rewrite BE ?divr_gt0//; exact: subset_closure_half. +have alpha_min : {x : 'rV[K]_n.+1 | x \in sphere r /\ + forall y, y \in sphere r -> V x <= V y}. + have : {within sphere r, continuous V}. apply: continuous_subspaceT => /= v. - apply/differentiable_continuous. - exact/Vderiv. - have := @EVT_min_rV _ _ V sphere_r sphere_r0 compact_sphere_r contV. - by move=> /cid2[c sphere_r_c sphere_r_V]; exists c; split. -pose alpha := V (sval Halpha). + by apply/differentiable_continuous; exact/Vderiv. + move/(EVT_min_rV (sphere_nonempty r_gt0) (@compact_sphere _ _ r)). + by move=> /cid2[c sphere_r_c sphere_r_V]; exists c. +pose alpha := V (sval alpha_min). have alpha_gt0 : 0 < alpha. - have sphere_pos: forall y, y \in sphere_r -> 0 < V y. - move=> y hy. - apply: z1; last first. - rewrite gtr0_norm_neq0 //. - move: hy. - by rewrite inE /sphere_r/= => ->. - apply/mem_set. - apply: Br_sub_D. - rewrite /closed_ball_/= sub0r. - move : hy. - by rewrite inE /sphere_r/= normrN => ->. - rewrite /alpha sphere_pos => //. - rewrite /sphere_r inE/=. - have Hsval := svalP Halpha. - move: Hsval => [/= Hsphere _]. - move : Hsphere. - rewrite inE. - move => Hsphere. - exact: Hsphere. -have: exists beta, 0 < beta < alpha. - rewrite /=. - exists (alpha / 2). - rewrite divr_gt0 //=. - rewrite ltr_pdivrMr => //=. - rewrite mulr2n mulrDr mulr1. - by rewrite ltrDl. -move=> [beta Hbeta]. -set Omega_beta := [set x : 'rV[K]_n.+1 | (closed_ball_ [eta normr])``_r x /\ V x <= beta]. -have HOmega_beta : Omega_beta `<=` interior (closed_ball_ [eta normr])``_r. - rewrite /Omega_beta. - move=> x1 [Hx mini]. - rewrite -closed_ballAE /=. - rewrite interior_closed_ballE => //=. - rewrite /Omega_beta /=. - have Hnorm_le : `|x1| <= r. - move : Hx. - rewrite /closed_ball_ /ball. - under eq_fun do rewrite sub0r normrN. - move => Hx. - by apply: Hx. - case: (ltgtP (`|x1|) r) => [Hlt | Heq | Hgt]. - by rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN; apply Hlt. - exfalso. - have Hrr : r < r by apply: (lt_le_trans Heq Hnorm_le). - by move: Hrr; rewrite ltxx. - have xin_sphere : x1 \in sphere_r. - rewrite /sphere_r inE. - by apply: Hgt. - have Vx_ge_alpha : alpha <= V x1. - rewrite /alpha. - case: (svalP Halpha) => [Hy_sphere Hy_min]. - apply: Hy_min. - exact: xin_sphere. - exfalso. - move: mini Hbeta => HleVx [/andP [Hbeta_pos Hbeta_lt]]. - have : alpha <= V x1 <= beta. - by apply/andP; split. - have : alpha <= beta by apply: (le_trans Vx_ge_alpha HleVx). - move=> Hle_alpha_beta alphavxbeta. - have Hbb : beta < beta by apply: (lt_le_trans Hbeta_lt Hle_alpha_beta). - by move : Hbb; rewrite ltxx. - by exact: r_pos. -have Df_Omega_beta phi : is_sol f phi D -> phi 0 \in Omega_beta -> - forall t, 0 <= t -> phi t \in Omega_beta. - move=> solves_phi xOmega t t0. - have H2 : forall t, 0 <= t -> forall u, 0 <= u <= t -> LieDerivative V sol (phi 0) u <= 0 -> + have sphere_pos y : y \in sphere r -> 0 < V y. + move=> yr; apply: DxV; last first. + rewrite gtr0_norm_neq0//. + by move: yr; rewrite inE /sphere/= => ->. + apply/mem_set/BrD. + move : yr; rewrite inE /sphere/= => <-. + by rewrite /B /closed_ball_/= sub0r normrN. + rewrite /alpha sphere_pos// /sphere inE/=. + by have [+ _] := svalP alpha_min; rewrite inE. +have [beta /andP[beta_gt0 beta_alpha]] : exists beta, 0 < beta < alpha. + by exists (alpha / 2); rewrite divr_gt0//= ltr_pdivrMr//= ltr_pMr// ltr1n. +set Omega_beta := [set x : 'rV[K]_n.+1 | B r x /\ V x <= beta]. +have Omega_beta_Br : Omega_beta `<=` (B r)°. + move=> y [Bry Vybeta]. + rewrite BE// interior_closed_ballE => //=. + have yr : `|y| <= r by move: Bry; rewrite /B /closed_ball_/= sub0r normrN. + have [{}yr | ry | {}yr] := ltgtP (`|y|) r. + - by rewrite mx_norm_ball /ball_/= sub0r normrN. + - by have := le_lt_trans yr ry; rewrite ltxx. + - have alphaVy : alpha <= V y. + by rewrite /alpha; case: (svalP alpha_min) => [_]; apply; rewrite inE. + by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. +(* any trajectory starting in Omega_beta at t = 0 + stays in Omega_beta for all t >= 0 *) +have Df_Omega_beta phi : is_sol f phi D -> + phi 0 \in Omega_beta -> forall t, 0 <= t -> phi t \in Omega_beta. + move=> sol_phi phi_Omega. + have /= V_nincr_consequence : forall t, 0 <= t -> forall u, 0 <= u <= t -> + 'D~(sol, phi 0) V u <= 0 -> V (sol (phi 0) t) <= V (sol (phi 0) 0) <= beta. - move => t1 t10 u u10. - have phi0 : phi = sol (phi 0). - apply/eqP; rewrite eq_sym; apply/eqP. - apply solP => //. - by case : solves_phi => //. - (*apply solves => //. - by case : solves_phi.*) - have Vneg_incr: forall s1 s2, 0 <= s1 <= s2 -> forall x, x \in D -> V (sol x s2) <= V (sol x s1). - move=> s1 s2 Hs1_pos x0 xinD . - apply: (@ler0_derive1_le_cc _ (fun s => V (sol x0 s)) 0 s2) => //. - - rewrite -fctE. - move => x1 x1in. - apply: diff_derivable. - apply: differentiable_comp; last exact: differentiable_comp. - rewrite -derivable1_diffP. - by case : (solves xinD). - - move=> s Hs_in. - (*move : (V'le_0 phi solves_phi t t0). - rewrite -LieDerivative_derive => //=; last first. - rewrite inE in xOmega. - rewrite -phi0. - rewrite -derivable1_diffP. - by case : solves_phi.*) - rewrite derive1E. - rewrite -fctE. - rewrite -LieDerivative_derive. - have Hsol: forall x1, x1 \in D -> is_sol f (sol x1) D. - move=> x1 x1inD => //. - by apply : solves => //. - have Hs0 : 0 <= s. - move : Hs_in. - rewrite inE; move=> /itvP [] [Hs Hs1 Hs2]. - rewrite ltW => //. - by rewrite Hs. - set y := sol x0. - apply : V'le_0 => //. - apply: Vderiv => //. - rewrite -derivable1_diffP. - by case: (solves xinD) => //. - - apply: continuous_subspaceT. - move => x1. - apply: continuous_comp. - apply: differentiable_continuous => //. - rewrite -derivable1_diffP. - by case : (solves xinD). - exact: differentiable_continuous. - - move: Hs1_pos => /andP[H0s1 Hs1s2]. - by rewrite !in_itv/= lexx (le_trans H0s1). - - by case/andP: Hs1_pos. - have H3 : V (sol x t1) <= V (sol x 0). - by rewrite Vneg_incr//= t10 andbT. - move => bla. - apply/andP; split => //=. - move : xOmega. - rewrite inE /Omega_beta. - move=> [clo Vxb]. - have Hdec := Vneg_incr 0 t1 _ (phi 0) _. - apply: Hdec => //. - by apply/andP; split => //. - rewrite inE /Omega_beta. - by apply: Br_sub_D. - rewrite inE in xOmega. - - rewrite -phi0. - by move: xOmega; rewrite /Omega_beta; case. + move=> /= t1 t10 u ut1 Vle0. + apply/andP; split. + move : phi_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. + by apply: V_nincr; [rewrite lexx t10|rewrite inE; exact: BrD]. + by rewrite sol0; move: phi_Omega; rewrite inE => -[]. + move=> t t0. rewrite inE; split; last first. - have t00 : 0 <= t <= t by rewrite lexx t0. - have H_lie : LieDerivative V sol (phi 0) t <= 0. - apply V'le_0 => //. - by case: solves_phi. - have := H2 t t0 t t00 H_lie. - have -> : sol (phi 0) = phi; last first. - case/andP => h1 h2. - exact: (le_trans h1 h2). - apply solP => //. - by case : solves_phi. - (* by rewrite inE /Omega_beta => -[]. - apply/eqP. - rewrite eq_sym. - apply/eqP. - have Hsol_phi : sol (phi 0) = phi. - - apply solP. - + by case: solves_phi => //. - + apply solves; by case : solves_phi => //. - by rewrite Hsol_phi. - rewrite inE. - apply: Br_sub_D => //. - move : xOmega. - by rewrite inE /Omega_beta => -[]. - apply: solves. - rewrite inE. - apply: Br_sub_D => //. - move : xOmega. - by rewrite inE /Omega_beta => -[].*) - move: xOmega. - rewrite inE /Omega_beta/=. - rewrite /closed_ball_/=. - rewrite !sub0r !normrN => -[] + Vxbeta. - (* axiomatiser thm 3.3 *) - move=> x0r. - move : HOmega_beta. - rewrite -closed_ballE /= => //. - rewrite interior_closed_ballE => //. - rewrite /Omega_beta. - rewrite /closed_ball_. - rewrite mx_norm_ball /ball_. - rewrite /= => /(_ (sol x t)). - under eq_fun do rewrite !sub0r normrN. - move => a. - rewrite leNgt. - apply/negP. - have : `|phi t| > r -> exists t0, t0 >=0 /\ `|phi t0 | = r. - move : x0r. - move=> phi0_le_r r_lt_phit. - have bounds : minr `|phi 0| `|phi t| <= r <= maxr `|phi 0| `|phi t|. - rewrite /minr /maxr. - have r_le_phit : r <= `|phi t| by apply: ltW. - apply/andP; split. - case : ifPn => // . - rewrite -real_leNgt ?normr_real//. - move=> phi_t_le_phi0. - exact: le_trans phi_t_le_phi0 phi0_le_r. - case: ltrP => Hcase. - exact: r_le_phit. - exact: le_trans Hcase. - have /IVT : 0 <= t by []. - move=> IVT. - have norm_phi_cont : {within `[0, t]%classic, continuous (fun u : K => `|phi u|)}. - apply: continuous_subspaceT. - rewrite -fctE. - move => x1. - apply: continuous_comp => //. - apply: differentiable_continuous => //. - case : (solves_phi) => _ + _ => /(_ x1). - by rewrite derivable1_diffP. - by apply: norm_continuous. - have [c cI norm_phi_c] := IVT (fun u => `|phi u|) r norm_phi_cont bounds. - exists c; split => //. - move : cI. - move=> /itvP [c0 _]. - by case: c0 => [[c_ge0 _] _]. - move => cont solxr. - have [t1 [t1_ge0 xt1r]] := cont solxr. - have : alpha <= V (phi t1). - rewrite {}/alpha in alpha_gt0 Hbeta *. - move: Halpha alpha_gt0 Hbeta. - case => alpha /= [alpha_gt0 +] Valpha_gt0 beta_alpha. - apply. - by rewrite inE /sphere_r/=. - move=> alphaVphit1. + have : 'D~(sol, phi 0) V t <= 0. + by apply: V'le_0 => //; case: sol_phi. + move/V_nincr_consequence => /(_ t). + rewrite lexx t0/= => /(_ isT isT). + have -> : sol (phi 0) = phi by apply solP => //; case: sol_phi. + by case/andP; exact: le_trans. + move: phi_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. + rewrite !sub0r !normrN => -[phi0r Vphi0beta]. + rewrite leNgt; apply/negP => phi_t_r. + have [t1 [t1_ge0 phit1r]] : exists t0, t0 >= 0 /\ `|phi t0| = r. + have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o phi)}. + apply: continuous_subspaceT => /= y. + apply: continuous_comp; last exact: norm_continuous. + apply: differentiable_continuous => //. + case : (sol_phi) => _ + _ => /(_ y). + by rewrite derivable1_diffP. + have : min `|phi 0| `|phi t| <= r <= max `|phi 0| `|phi t|. + by rewrite ge_min phi0r/= le_max (ltW phi_t_r) orbT. + move=> /(IVT t0 norm_phi_cont)[c cI norm_phi_c]. + by exists c; split => //; move/itvP: cI => ->. + have alphaVphit1 : alpha <= V (phi t1). + rewrite {alpha_gt0 beta_alpha} /alpha; case: alpha_min => /=. + by move=> y [_ +]; apply; rewrite inE. have : beta < V (phi t1). - rewrite (lt_le_trans _ alphaVphit1)//. - by case/andP : Hbeta. + by rewrite (lt_le_trans _ alphaVphit1)//; case/andP : beta_alpha. apply/negP; rewrite -leNgt. - have Heq_sol_phi : sol (phi 0) = phi. - apply solP => //. - rewrite inE. - apply: Br_sub_D => //. - rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. - by apply: x0r. - (*apply: solves => //. - rewrite inE. - apply: Br_sub_D => //. - rewrite /closed_ball_; under eq_fun do rewrite !sub0r normrN. - by apply: x0r.*) - have : forall u, u >= 0 -> LieDerivative V sol (phi 0) u <= 0. - move => u u0. - apply: V'le_0 => //. - by case :solves_phi => //. - move : (H2 t1 t1_ge0). - move=> Ht1 Hderiv. - rewrite Heq_sol_phi in Ht1. - have Vphi_le := Ht1 t1 _ _. - have t1_chain : 0 <= t1 <= t1. - by apply/andP ; split; [exact: t1_ge0 | exact: lexx]. - move: (Vphi_le t1_chain (Hderiv t1 t1_ge0)) => [/andP [Vt1_le V0_le_beta]]. - exact: (le_trans Vt1_le). + have := V_nincr_consequence t1 t1_ge0 t1. + rewrite lexx t1_ge0 => /(_ isT). + have : 'D~(sol, phi 0) V t1 <= 0 by apply: V'le_0 => //; case: sol_phi. + move=> /[swap] /[apply]. + have -> : sol (phi 0) = phi. + apply solP => //;rewrite inE; apply: BrD => //. + by rewrite /B /closed_ball_/= sub0r normrN. + by move=> /andP[]; exact: le_trans. have _ : compact Omega_beta. - rewrite /Omega_beta. - (* use compact_closedI? *) - apply: bounded_closed_compact. + apply: bounded_closed_compact; rewrite /Omega_beta. - rewrite /bounded_set /= /globally. - exists r => //=. - split => //= => x1 rx x2. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - move=> [/= x0_le_r ?]. - apply: le_trans x0_le_r _. - exact: ltW rx. - - apply: closedI. - rewrite -closed_ballAE=> //=. - exact: closed_ball_closed. - rewrite /=. - rewrite [X in closed X](_ : _ = V @^-1` [set x : K | x <= beta]); last first. + exists r; split => //= t rt v. + rewrite /B /closed_ball_/= sub0r normrN. + by move=> [/le_trans vr _]; rewrite vr// ltW. + - apply: closedI => /=. + by rewrite BE//; exact: closed_ball_closed. + rewrite [X in closed X](_ : _ = V @^-1` [set x | x <= beta]); last first. by apply/seteqP; split. - apply: closed_comp => //= x1 _. - apply: continuous_comp => //=. + apply: closed_comp => //= v _. + apply: continuous_comp; first by []. exact: differentiable_continuous. -have [d0 Vbeta] : exists d, d > 0 /\ forall x, `|x| <= d -> V x < beta. - rewrite /=. - have [d [d_pos Hd]] : exists d : K, 0 < d /\ +have [d0 d0_gt0 Vbeta] : exists2 d, d > 0 & forall x, `|x| <= d -> V x < beta. + have [d d_gt0 xdV] : exists2 d : K, 0 < d & forall y, `|y - x| < d -> `|V y - V x| < beta. - have : V x @[x --> nbhs x] --> V x by exact: Hcont. - move : Hbeta. - move=> Hbeta_alpha /cvgrPdist_lt. - have beta_pos : 0 < beta by case/andP: Hbeta_alpha. - move=> /(_ beta beta_pos). - rewrite nearE /=. - move=> /nbhs_ballP [d d_pos Hd]. - exists d; split => // y Hy. - move: Hd; rewrite mx_norm_ball /ball_ /=. - move=> Hsub. - have Hy' : `|x - y| < d by rewrite distrC. - move: (Hsub y) => /= /(_ Hy'). + have /cvgrPdist_lt /(_ _ beta_gt0) : V x @[x --> nbhs x] --> V x. + exact/differentiable_continuous/Vderiv. + rewrite nearE /= => /nbhs_ballP[d /= d_pos xdV]. + exists d => // y. + move: xdV; rewrite mx_norm_ball /ball_ /= distrC => /[apply]. by rewrite distrC. - exists (d / 2); split; first exact: divr_gt0. - move=> x0 Hx0. - have /(Hd x0) : `|x0 - x| < d. - by rewrite subr0 (le_lt_trans Hx0)// ltr_pdivrMr // ltr_pMr // ltr1n. - rewrite V0 subr0. - exact: ltr_normlW. + exists (d / 2); first exact: divr_gt0. + move=> v vd; have /(xdV v) : `|v - x| < d. + by rewrite subr0 (le_lt_trans vd)// ltr_pdivrMr // ltr_pMr // ltr1n. + by rewrite Vx0 subr0; apply: le_lt_trans; rewrite ler_normlW. pose delta := Num.min d0 r. -have Hdelta : 0 < delta /\ (forall x, `|x| <= delta -> V x < beta). - split. - rewrite /delta /minr. - case: (d0 < r) => //=. - by case: Vbeta. - rewrite /=. - move => x1 xdel. - move: Vbeta => [Hdelta0_pos Hdelta0_prop]. - have delta_le_delta0 : delta <= d0. - rewrite /delta. - rewrite /minr. - case: ifPn => //. - rewrite -real_leNgt => //. - by rewrite realE => //; rewrite ltW. - by rewrite realE => //; rewrite ltW. - have: `|x1| <= d0 by apply: (le_trans xdel delta_le_delta0). - by apply: Hdelta0_prop. -have inclusion : (closed_ball_ [eta normr])``_delta `<=` Omega_beta /\ - Omega_beta `<=` (closed_ball_ [eta normr])``_r . - split; last first => //=. - apply: subset_trans HOmega_beta _. - rewrite -closed_ballAE /=. - rewrite interior_closed_ballE => //=. - by apply: subset_closed_ball. - by apply: r_pos. - rewrite /Omega_beta. - apply/subsetP => x1 Hx. - rewrite inE. - split; last first => //=. - have [/= Hdelta_Le_Rpos Hdelta_bound] := Hdelta. - move: Hx. - rewrite inE. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - move => Hx. - apply: ltW. - by have Vx_lt_beta := Hdelta_bound _ Hx. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - have delta_le_r: delta <= r. - rewrite /delta. - rewrite /minr. - case: ifP => Hlt => //. - by rewrite ltW. - rewrite inE in Hx. - move : Hx. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - move => Hball. - move: Hball delta_le_r => /= Hx_lt_delta Hdelta_le_r. - by apply: (le_trans (Hx_lt_delta) Hdelta_le_r). -have inclusion2 : ((closed_ball_ [eta normr])``_delta) (sol x 0) -> sol x 0 \in Omega_beta -> forall t, t >= 0 -> sol x t \in - Omega_beta -> ((closed_ball_ [eta normr])``_r) (sol x t). - move => ball0 sol0in t1 t2 soltin. - by move: soltin; rewrite /Omega_beta inE => [] [Hball _]. +have delta_gt0 : 0 < delta by rewrite /delta lt_min d0_gt0 r_gt0. +have deltaV y : `|y| <= delta -> V y < beta. + move=> /= ydelta. + have : `|y| <= d0 by rewrite (le_trans ydelta)// /delta ge_min lexx. + exact: Vbeta. +have B_delta_Omega_beta : B delta `<=` Omega_beta. + rewrite /Omega_beta => /= v. + rewrite /B /closed_ball_/= sub0r normrN => vdelta. + split; last exact/ltW/deltaV. + by rewrite (le_trans vdelta)// /delta ge_min lexx orbT. +have _ : (B delta) (sol x 0) -> + forall t, t >= 0 -> sol x t \in Omega_beta -> (B r) (sol x t). + by move => ball0 t1 t1_ge0; rewrite /Omega_beta inE => -[]. rewrite /x !subr0. -have Hlast : `|sol x 0| < delta -> forall t : K , t >=0 -> `|sol x t| < r <= eps. - move => sol0delta t1 t2. - case: inclusion => [Hin_ball_delta _]. - have sol_in_Omega : sol x 0 \in Omega_beta. - rewrite inE. - apply: Hin_ball_delta. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN; apply/ltW; exact: sol0delta. - rewrite /Omega_beta inE in sol_in_Omega. - case: sol_in_Omega => [Hball_solt _]. - move : Hball_solt. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - move => Hball_solt. - have : ((closed_ball_ [eta normr])``_r)° (sol x t1). - apply: ( HOmega_beta). - rewrite -inE. - have xinO : sol x 0 \in Omega_beta. - rewrite inE. - rewrite /Omega_beta. - split => //=. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - exact: Hball_solt. - have z0_in_ball : (closed_ball_ [eta normr])``_delta (sol x 0). - rewrite /closed_ball_; apply: ltW. - rewrite sub0r normrN. - by apply: sol0delta. - move : (Hin_ball_delta _ z0_in_ball). - by move => [clo Vxb]. - apply: Df_Omega_beta => //. - by apply solves => //. - rewrite -closed_ballAE => //=. - rewrite interior_closed_ballE => //=. - rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. - by move=> /= ->/=. -exists delta. - by case: Hdelta. -move=> x0_lt_delta t0 t0_ge0. -rewrite /x subr0. -have Htraj0 : `|sol x t0| < r. - rewrite /Omega_beta. - have x0_in_Omega : x \in Omega_beta. - rewrite inE. - apply: inclusion.1. - rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN. - apply: ltW. - rewrite /x. - move: x0_lt_delta. - rewrite normr0; by case : Hdelta. - by have /andP []:= Hlast x0_lt_delta _ t0_ge0. - (* have sol_in_Omega : sol x t0 \in Omega_beta. - apply: Df_Omega_beta => //=. - by apply solves => //. - simpl in *. - have x00 : sol x 0 = x. - have [solx0inD _ _] := solves inD. - have [] := solP x0_in_Omega. - - apply solP. - by rewrite solx1_0 => //. - rewrite x00 => //. - - rewrite -(@solP (sol x) _ ) => //=. - rewrite /Omega_beta inE in sol_in_Omega. - case: sol_in_Omega => + _. - (rewrite /closed_ball_; under eq_fun do rewrite sub0r normrN) => Hnorm. - have : ((closed_ball_ [eta normr])``_r)° (sol x t0). - apply: HOmega_beta. - rewrite -inE Df_Omega_beta//. - apply solves => //. - have x00 : x \in D -> sol x 0 = x. - move => xinD. - by rewrite solx1_0 => //. - rewrite x00 => //. - rewrite /Omega_beta inE in x0_in_Omega. - case: x0_in_Omega => + _. - rewrite -(closed_ballE _ r_pos) interior_closed_ballE //=. - rewrite mx_norm_ball /ball_; under eq_fun do rewrite sub0r normrN. - exact.*) -exact: lt_le_trans r_le_eps. +exists delta => // sol0_delta t0 t0_ge0. +rewrite subr0. +have : sol x 0 \in Omega_beta. + rewrite inE; apply: B_delta_Omega_beta. + by rewrite /B /closed_ball_/= sub0r normrN; apply/ltW; exact: sol0_delta. +rewrite inE => -[+ _]. +rewrite /B /closed_ball_/= sub0r normrN => solx0r. +have : (B r)° (sol x t0). + apply: Omega_beta_Br; apply/set_mem. + apply: Df_Omega_beta => //. + by have [] : is_sol f (sol x) D by apply solP; rewrite sol0. + rewrite inE; split; first by rewrite /B /closed_ball_/= sub0r normrN. + have : B delta (sol x 0). + by rewrite /closed_ball_; apply: ltW; rewrite sub0r normrN. + by move/B_delta_Omega_beta => []. +rewrite BE//= interior_closed_ballE//=. +rewrite mx_norm_ball /ball_/= sub0r normrN => /lt_le_trans; exact. Unshelve. all: by end_near. Qed. End Lyapunov_stability. @@ -1071,21 +798,7 @@ End basic_facts. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -(* definition du probleme *) -Record equa_diff (K : realType) := { - equa_f : 'rV[K]_6 -> 'rV[K]_6 ; (* autonomous *) - equa_S0 : set 'rV[K]_6 ; (* intended to be invariant *) - equa_fk : exists k, k.-lipschitz_equa_S0 equa_f ; - (* hypothesis for existence and uniqueness of a solution (NB: not really used yet) *) - equa_t0 : K ; (* initial time *) -}. - -Definition is_invariant_solution_equa_diff {K : realType} - (e : equa_diff K) (y1 : K -> 'rV[K]_6) A := - is_sol (fun y t => equa_f e (y t)) y1 A /\ - (y1 (equa_t0 e) \in equa_S0 e -> - (forall t, t > 0 -> y1 (equa_t0 e + t) \in equa_S0 e)). (*TODO*) - +(* Modelization of the physical problem *) Section ya. (* mesure de l'accelerometre *) Variable K : realType. @@ -1093,34 +806,31 @@ Variable v : K -> 'rV[K]_3. (* local frame of the sensor *) Variable R : K -> 'M[K]_3. (*L -> W*) Variable g0 : K. (*standard gravity constant*) Let w t := ang_vel R t. (* local frame of the sensor (gyroscope) *) -Let x1 t := v t. (* local frame*) -Definition x2 t : 'rV_3 := 'e_2 *m R t. (**) -Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. (*worlf frame ?*) +Let x1 t := v t. (* local frame *) +Definition x2 t : 'rV_3 := 'e_2 *m R t. +Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. (* world frame *) Variable p : K -> 'rV[K]_3. Let v1 := fun t : K => 'D_1 p t *m R t. -Definition y_a1 t := - v1 t *m \S( w t)+ 'D_1 v1 t + g0 *: x2 t. +Definition y_a1 t := - v1 t *m \S(w t) + 'D_1 v1 t + g0 *: x2 t. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. -Lemma y_aE t - ( derivableR : forall t, derivable R t 1) - ( derivablep : forall t, derivable p t 1) - ( derivableDp : forall t, derivable ('D_1 p) t 1) - : ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t= y_a1 t . +Lemma y_aE t (derivableR : forall t, derivable R t 1) + (derivablep : forall t, derivable p t 1) + (derivableDp : forall t, derivable ('D_1 p) t 1) : + ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t= y_a1 t . Proof. rewrite mulmxDl. rewrite /y_a1/= /v1 /= /x2. congr +%R; last by rewrite scalemxAl. rewrite -ang_vel_mxE/=; last 2 first. - move=> t0. - rewrite rotation_sub //. - exact : derivableR. - rewrite [in RHS]derive_mulmx => //. - rewrite derive1mx_ang_vel => //; last first. - move => t0. - by rewrite rotation_sub => //. - rewrite ang_vel_mxE// => //; last first. - move => t0. - by rewrite rotation_sub => //. + move=> t0. + by rewrite rotation_sub. + exact : derivableR. +rewrite [in RHS]derive_mulmx => //. +rewrite derive1mx_ang_vel => //; last first. + by move=> t0; rewrite rotation_sub. +rewrite ang_vel_mxE// => //; last first. + by move=> t0; rewrite rotation_sub. rewrite addrCA. rewrite -mulmxE. rewrite -mulNmx. @@ -1146,12 +856,9 @@ Let x1_dot t := 'D_1 x1 t. Let x2_dot t := 'D_1 x2 t. Let w t := ang_vel R t. -Lemma x2_S2 (t0 : K) : x2 t0 \in S2. +Lemma x2_S2 t : x2 t \in S2. Proof. -rewrite /S2 /x2 /=. -rewrite inE /= orth_preserves_norm. - by rewrite normeE. -by rewrite rotation_sub // rotationV. +by rewrite /S2 /x2 inE/= orth_preserves_norm ?normeE ?rotation_sub. Qed. (* not used but could be interesting *) @@ -1174,7 +881,7 @@ rewrite -derive1mx_ang_vel; last 2 first. by []. Abort. -(* eqn 10*) +(* eqn 10 *) Notation y_a := (y_a v R g0). Lemma derive_x1 t : 'D_1 x1 t = x1 t *m \S(w t) + y_a t - g0 *: x2 t. Proof. @@ -1193,12 +900,11 @@ rewrite -ang_vel_mxE; last 2 first. by []. rewrite /x2_dot. rewrite /x2. -have ->: 'D_1 (fun t0 : K => 'e_2 *m (R t0)) t = ('e_2 *m 'D_1 (fun t => (R t)) t). - move => n. - rewrite /=. - rewrite derive_mulmx//=; last first. +have ->: 'D_1 (fun t0 : K => 'e_2 *m (R t0)) t = + 'e_2 *m 'D_1 (fun t => (R t)) t. + move => n /=. + rewrite derive_mulmx//=. by rewrite derive_cst mul0mx add0r. -rewrite /=. rewrite derive1mx_ang_vel /=; last 2 first. by move=> ?; rewrite rotation_sub. by []. @@ -1223,20 +929,22 @@ Hypotheses g0_eq0 : g0 != 0. Notation y_a := (y_a v R g0). Let x1 t := v t . Let x2'_hat t := -(alpha1 / g0) *: (x1 t - x1_hat t). (* 12b*) -Hypothesis eq12a : forall t, 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'_hat t. -Hypothesis eq12c : forall t, 'D_1 x2_hat t = x2_hat t *m \S(w t - gamma *: x2'_hat t *m \S(x2_hat t)). (*12c*) +Hypothesis eqn12a : forall t, + 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'_hat t. +Hypothesis eqn12c : forall t, + 'D_1 x2_hat t = x2_hat t *m \S(w t - gamma *: x2'_hat t *m \S(x2_hat t)). Hypothesis x2_hat_S2 : x2_hat 0 \in S2. Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. Hypothesis v_derivable : forall t, derivable v t 1. Notation x2 := (x2 R). (* estimation error *) Let error1 t := x2 t - x2'_hat t. (* p_1 in [benallegue2023ieeetac] *) -Let error2 t := x2 t - x2_hat t. (* \tilde{x_2} in [benallegue2023ieeetac] *) +Let error2 t := x2 t - x2_hat t. (* \tilde{x_2} in [benallegue2023ieeetac] *) Let error1_dot t := 'D_1 error1 t. Let error2_dot t := 'D_1 error2 t. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. (* projection from the local frame to the world frame(?) *) -Let error1_p t := error1 t *m (R t)^T. +Let error1_p t := error1 t *m (R t)^T (* z_p_1 in [benallegue2023ieeetac] *). Let error2_p t := error2 t *m (R t)^T. Hypothesis norm_x2_hat : forall t, norm (x2_hat t) = 1. @@ -1262,7 +970,8 @@ Let derivable_error1 t : derivable error1 t 1. Proof. exact: derivableB. Qed. Let derivable_error2 t : derivable error2 t 1. Proof. exact: derivableB. Qed. -Lemma derive_error1 t : 'D_1 error1 t = error1 t *m \S(w t) - alpha1 *: error1 t. +Lemma derive_error1 t : + 'D_1 error1 t = error1 t *m \S(w t) - alpha1 *: error1 t. Proof. simpl in *. rewrite error1E. @@ -1273,7 +982,7 @@ rewrite deriveB//. rewrite !(derive_x2) // -/(x2 t) /=. rewrite (derive_x1 g0 R) //. rewrite -/(x2 t) -/(v t) -/(x1 t) -/(w t). -rewrite eq12a. +rewrite eqn12a. transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) - alpha1 *: error1 t). transitivity (x2 t *m \S(w t) + (alpha1 / g0) @@ -1291,8 +1000,10 @@ transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) rewrite [LHS]addrA. rewrite (addrC (y_a t)). by rewrite subrK. - rewrite (_ : x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'_hat t) = - (x1 t - x1_hat t) *m \S(w t) - g0 *: (x2 t - x2'_hat t)); last first. + rewrite (_ : x1 t *m \S(w t) - g0 *: x2 t - + (x1_hat t *m \S(w t) - g0 *: x2'_hat t) = + (x1 t - x1_hat t) *m \S(w t) - + g0 *: (x2 t - x2'_hat t)); last first. rewrite mulmxBl scalerDr scalerN opprB addrA [LHS]addrC 2!addrA. rewrite -addrA; congr +%R. by rewrite addrC. @@ -1304,14 +1015,14 @@ by rewrite error1E. Qed. Lemma derive_error2 t : - 'D_1 error2 t = error2 t *m \S( w t) - - gamma *: (error2 t - error1 t) *m \S(x2_hat t) ^+ 2. + 'D_1 error2 t = error2 t *m \S(w t) - + gamma *: (error2 t - error1 t) *m \S(x2_hat t) ^+ 2. Proof. rewrite /error2. rewrite [in LHS]deriveB//. rewrite derive_x2//. rewrite -/(x2 t) -/(w t) -/(error2 t). -rewrite eq12c. +rewrite eqn12c. rewrite spinD spinN. rewrite -[in LHS]scalemxAl. rewrite (spinZ gamma). @@ -1321,7 +1032,8 @@ congr +%R. rewrite -scalemxAr -mulNmx -scalerN -[RHS]scalemxAl. congr (_ *: _). rewrite /error2 /error1. -rewrite (opprB _ (x2'_hat t)) -addrA (addrC (x2 t)) addrA subrK opprD opprK mulmxBl. +rewrite (opprB _ (x2'_hat t)) -addrA (addrC (x2 t)) addrA. +rewrite subrK opprD opprK mulmxBl. rewrite [X in _ = X + _](_ : _ = 0) ?add0r; last first. rewrite mulmxA. rewrite -(mulmxA(x2_hat t)) sqr_spin //. @@ -1330,10 +1042,10 @@ rewrite [X in _ = X + _](_ : _ = 0) ?add0r; last first. by rewrite mulmxN mulmx1 subrr. rewrite expr2 -mulmxE fact215 -mulmxE -spin_crossmul. rewrite [in RHS]mulmxA [in RHS]spinE spinE spinE. -by rewrite [LHS](@lieC _ (vec3 K))/=. +by rewrite [LHS](@lieC _ (vec3 K)). Qed. -Lemma Rx2 t : x2_hat t *m (R t)^T = 'e_2 - error2_p t. +Lemma x2_hatR t : x2_hat t *m (R t)^T = 'e_2 - error2_p t. Proof. rewrite /error2_p /error2 mulmxBl opprB addrCA. rewrite [X in _ + X](_ : _ = 0) ?addr0//. @@ -1357,23 +1069,22 @@ rewrite -/(w t) -mulmxA -mulmxDr trmx_mul tr_spin. by rewrite mulNmx subrr mulmx0. Qed. -Lemma derive_error2_p t : 'D_1 error2_p t = gamma *: (error2_p t - error1_p t) *m - \S('e_2 - error2_p t)^+2. +Lemma derive_error2_p t : + 'D_1 error2_p t = + gamma *: (error2_p t - error1_p t) *m - \S('e_2 - error2_p t)^+2. Proof. -rewrite [LHS]derive_mulmx//=; last first. - by rewrite derivable_trmx. +rewrite [LHS]derive_mulmx//=; last by rewrite derivable_trmx. simpl in *. rewrite derive_trmx//. -rewrite derive1mx_ang_vel//=; last first. - by move => t0; rewrite rotation_sub. -rewrite !ang_vel_mxE//; last first. - by move => t0; rewrite rotation_sub. +rewrite derive1mx_ang_vel//=; last by move=> ?; rewrite rotation_sub. +rewrite !ang_vel_mxE//; last by move=> ?; rewrite rotation_sub. rewrite trmx_mul mulmxA -mulmxDl. rewrite derive_error2 /=. rewrite addrAC -/(w t) tr_spin mulmxN subrr sub0r. rewrite -[in LHS]scalemxAl -scaleNr -[in LHS]scalemxAl. rewrite mulmxN -scalemxAl -[in RHS]scaleNr. congr (- _ *: _). -rewrite -Rx2. +rewrite -x2_hatR. rewrite -spin_similarity ?rotationV//. rewrite trmxK. rewrite [in RHS]expr2 -mulmxE !mulmxA. @@ -1398,62 +1109,62 @@ Variable gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Definition tilt_eqn (error1_p_error2_dot : K -> 'rV[K]_6) : K ->'rV[K]_6 := - let error1_p_dot := Left \o error1_p_error2_dot in - let error2_dot := Right \o error1_p_error2_dot in - fun t => row_mx (- alpha1 *: error1_p_dot t) - (gamma *: (error2_dot t - error1_p_dot t) *m \S('e_2%:R - error2_dot t) ^+ 2). +Definition tilt_eqn (f : K -> 'rV[K]_6) : K ->'rV[K]_6 := + let error1_p_dot := Left \o f in + let error2_dot := Right \o f in + fun t => row_mx + (- alpha1 *: error1_p_dot t) + (gamma *: (error2_dot t - error1_p_dot t) *m \S('e_2 - error2_dot t) ^+ 2). -Definition tilt_eqn_wip (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := +Definition tilt_eqn_no_time (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := let zp1_point := Left zp1_z2_point in let z2_point := Right zp1_z2_point in row_mx (- alpha1 *: zp1_point) (gamma *: (z2_point - zp1_point) *m \S('e_2%:R - z2_point) ^+ 2). -Lemma tilt_eqnE f t : tilt_eqn f t = tilt_eqn_wip (f t). +Lemma tilt_eqnE f t : tilt_eqn f t = tilt_eqn_no_time (f t). Proof. by []. Qed. -Lemma tilt_eqn_wip_lipschitz : exists k, k.-lipschitz_setT tilt_eqn_wip. +Lemma tilt_eqn_no_time_lipschitz : exists k, k.-lipschitz_setT tilt_eqn_no_time. Proof. near (pinfty_nbhs K) => k. exists k => -[/= x x0] _. -rewrite /tilt_eqn_wip. +rewrite /tilt_eqn_no_time. set fx := row_mx (- alpha1 *: Left x) - (gamma *: (Right x - Left x) *m \S('e_2 - Right x) ^+ 2). + (gamma *: (Right x - Left x) *m \S('e_2 - Right x) ^+ 2). set fy := row_mx (- alpha1 *: Left x0) - (gamma *: (Right x0 - Left x0) *m \S('e_2 - Right x0) ^+ 2). + (gamma *: (Right x0 - Left x0) *m \S('e_2 - Right x0) ^+ 2). rewrite /Num.norm/=. rewrite !mx_normrE. apply: bigmax_le => /=. rewrite mulr_ge0//. apply: le_trans; last first. - apply: (le_bigmax _ _ (ord0, ord0)) => //. + exact: (le_bigmax _ _ (ord0, ord0)). by []. move=> -[a b] _. rewrite /=. -rewrite [leRHS](_ : _ = \big[maxr/0]_ij (maxr alpha1 gamma * `|(x - x0) ij.1 ij.2|)); last first. +rewrite [leRHS](_ : _ = + \big[maxr/0]_ij (maxr alpha1 gamma * `|(x - x0) ij.1 ij.2|)); last first. admit. rewrite (le_trans (@ler_peMl _ (maxr alpha1 gamma) _ _ _))//. admit. apply: le_trans; last first. - exact: (@le_bigmax _ _ _ 0 (fun ij => maxr alpha1 gamma * `|(x - x0) ij.1 ij.2|) (a, b)). + exact: (@le_bigmax _ _ _ 0 + (fun ij => maxr alpha1 gamma * `|(x - x0) ij.1 ij.2|) (a, b)). rewrite /=. -apply: (@le_trans _ _ (`|(maxr alpha1 gamma *: fx - maxr alpha1 gamma *: fy) a b|)). +apply: (@le_trans _ _ + (`|(maxr alpha1 gamma *: fx - maxr alpha1 gamma *: fy) a b|)). admit. -apply: (@le_trans _ _ (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: x0 a b|)); last first. +apply: (@le_trans _ _ + (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: x0 a b|)); last first. Abort. -(* cauchy lipschitz par F1 qui definit un champ de vecteur lisse : -il existe une solution depuis tout point: -gamma1 ⊆ state_space*) -(* prouver invariance geometrique, tangence donc les trajectoires restent dans gamma1: - state_space ⊆ gamma1 -*) - -Lemma invariant_state_space_tilt p (p33 : state_space tilt_eqn state_space_tilt p) : +Lemma invariant_state_space_tilt p + (p33 : state_space tilt_eqn state_space_tilt p) : let y := sval (cid p33) in let t := sval (cid (svalP (cid p33)).2) in - forall Delta, Delta >= 0 -> state_space tilt_eqn state_space_tilt (y (t + Delta)). + forall Delta, Delta >= 0 -> + state_space tilt_eqn state_space_tilt (y (t + Delta)). Proof. case: p33 => /= x0 sol_y Delta Delta_ge0. rewrite /state_space/=. @@ -1463,9 +1174,9 @@ case: cid => //= y' y'sol. case: cid => t'/= pt'. Abort. -Lemma thm11a : state_space tilt_eqn state_space_tilt `<=` state_space_tilt. +Lemma state_space_tiltS : + state_space tilt_eqn state_space_tilt `<=` state_space_tilt. Proof. -(*apply/seteqP; split.*) - move=> p [y [[y0_init1]] deri y33 ] [t ->]. rewrite /state_space_tilt. have : derive1 (fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. @@ -1492,20 +1203,22 @@ Proof. exact: derivable_rsubmx. rewrite derive_cst /= sub0r; congr (- _). exact: derive_rsubmx. - rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. + rewrite -(_ : 'D_1 y x = + (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. apply/matrixP => a b; rewrite !mxE. - rewrite derive_mx//= ?mxE//. + by rewrite derive_mx//= ?mxE. ring. - have Rsu t0 : (Right (y^`()%classic t0) = - (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2)). + have Rsu t0 : Right (y^`()%classic t0) = + (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). rewrite derive1E. rewrite y33. by rewrite row_mxKr. apply/funext => t0. rewrite /dotmul. - transitivity (-2 * (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2 - *m ('e_2 - Right (y t0))^T) 0 0). - by rewrite Rsu /=. + transitivity (-2 * (gamma *: (Right (y t0) - + Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2 *m + ('e_2 - Right (y t0))^T) 0 0). + by rewrite Rsu. rewrite !mulmxA. apply/eqP. rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. @@ -1525,7 +1238,7 @@ Proof. move/is_derive_0_is_cst. move/ (_ _ 0). move => s0. - by apply: s0. + exact: s0. suff: norm ('e_2 - Right (y t)) ^+ 2 = 1. move => /(congr1 Num.sqrt). rewrite sqrtr1 sqr_sqrtr //. @@ -1534,31 +1247,6 @@ Proof. move: y0_init1. rewrite inE /state_space_tilt /= => ->. by rewrite expr2 mulr1. -(*- move=> p. - rewrite /state_space_tilt /=. - move=> p_statespace33. - rewrite /state_space /=. - rewrite /is_sol /=. - exists (fun _ : K => 0). - split. - + split. - * by rewrite inE /= rsubmx_const subr0 normeE. - * by apply: derivable_cst => //. - * move => t. - rewrite /tilt_eqn /= derive_cst. - apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. - split. - apply/eqP. - have alpha1_neq0 : alpha1 != 0 by rewrite gt_eqF. - apply/eqP. - rewrite scaler_eq0 //. - rewrite eqr_oppLR oppr0. - move/negbTE: alpha1_neq0 => alpha1_nz. - rewrite alpha1_nz // Bool.orb_false_l. - by rewrite lsubmx_const. - by rewrite lsubmx_const rsubmx_const subr0 scaler0 mul0mx. - admit. (* NG *) -*) Qed. Definition point1 : 'rV[K]_6 := 0. @@ -1575,7 +1263,8 @@ split => //=. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. rewrite /=. by rewrite lsubmx_const. - apply/eqP/rowP; move => i; apply/eqP; set N := (X in _ *: X *m _); have : N = 0. + apply/eqP/rowP; move => i; apply/eqP. + set N := (X in _ *: X *m _); have : N = 0. rewrite /N /=; apply /rowP; move => a. rewrite !mxE. by rewrite subrr. @@ -1591,7 +1280,8 @@ split => //. rewrite -scalerBl normZ normeE mulr1 distrC. rewrite [X in _ - X](_:1 = 1%:R) //. by rewrite -natrB //= normr1. -- move => t. rewrite derive_cst; apply /eqP; rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. +- move => t. rewrite derive_cst; apply/eqP. + rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). have N0 : N = 0. apply/rowP; move => i; rewrite !mxE; case: splitP. @@ -1612,30 +1302,16 @@ split => //. move/eqP. rewrite eqn_add2l => /eqP /ord_inj ->. by rewrite !mxE eqxx/=. - rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/= [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. - by rewrite (_ : 'e_2 *m _ = 0) ?mul0mx// ; apply: trmx_inj; rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. + rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/=. + rewrite [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA. + rewrite subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. + rewrite (_ : 'e_2 *m _ = 0) ?mul0mx//; apply: trmx_inj. + by rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. Qed. -Variable F1 : 'rV[K]_6 -> 'rV[K]_6. -Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. -Hypothesis sol_correct : forall x0, ('D_1 fun t=> (sol x0 t)) = fun t => F1 (sol x0 t). -Definition tilt_eqn_interface (x : 'rV_6) (t : K) : 'rV_6 := - tilt_eqn (fun _ => x) t. - -(*Hypothesis invariant_gamma : is_invariant tilt_eqn_interface (state_space_tilt). a transformer en lemme*) - -(* this lemma asks for lyapunov + lasalle *) -Lemma tractories_converge (y : K -> 'rV[K]_6) : is_sol tilt_eqn y state_space_tilt -> - y t @[t --> +oo] --> point1 \/ y t @[t --> +oo] --> point2. -Proof. -move=> is_sol_y. -Abort. - End tilt_eqn. Arguments point1 {K}. -Open Scope classical_set_scope. - (* technical section, skip on a first reading *) Section u2. Context {K : realType}. @@ -1708,15 +1384,15 @@ Definition V1 (zp1_z2 : 'rV[K]_6) : K := let z2 := Right zp1_z2 in (norm zp1)^+2 / (2 * alpha1) + (norm z2)^+2 / (2 * gamma). -Lemma V1_is_lyapunov_candidate : is_lyapunov_candidate V1 [set: 'rV_6] point1. +Lemma V1_is_Lyapunov_candidate : is_Lyapunov_candidate V1 [set: 'rV_6] point1. Proof. -rewrite /locposdef; split; last first. - rewrite /V1 -fctE. +rewrite /locposdef. (*; split; last first. + rewrite /V1. apply/differentiableD => //; last first. apply/differentiableM => //; apply/differentiable_norm_squared => //=. exact/differentiable_rsubmx. apply/differentiableM => //; apply/differentiable_norm_squared => //=. - exact/differentiable_lsubmx. + exact/differentiable_lsubmx.*) rewrite /V1 /point1 /locposdef; split; first by rewrite inE. split. by rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. @@ -1748,6 +1424,37 @@ Definition V1dot (zp1_z2 : 'rV[K]_6) : K := End V1. +Section hurwitz. +Context {K : realType}. + +(* thm 4.6 p136*) +Definition hurwitz n (A : 'M[K]_n) : Prop := + (forall a, eigenvalue A a -> a < 0). + +(* thm 4.7 p139 + fact: it is exponentially stable*) +Definition locally_exponentially_stable_at n (eqn : 'rV[K]_n -> 'rV[K]_n) + (point : 'rV[K]_n) : Prop := + hurwitz (Jacobian eqn point). + +Lemma tilt_eqn_is_locally_exponentially_stable_at_0 alpha1 gamma : + locally_exponentially_stable_at (tilt_eqn_no_time alpha1 gamma) point1. +Proof. +rewrite /locally_exponentially_stable_at /jacobian /hurwitz. +move => a. +move/eigenvalueP => [u] /[swap] u0 H. +have a_eigen : eigenvalue (jacobian (tilt_eqn_no_time alpha1 gamma) point1) a. + apply/eigenvalueP. + exists u. + exact: H. + exact: u0. +have : root (char_poly (jacobian (tilt_eqn_no_time alpha1 gamma) point1)) a. + rewrite -eigenvalue_root_char. + exact : a_eigen. +rewrite /tilt_eqn_no_time /jacobian. +Abort. + +End hurwitz. + Section tilt_eqn_Lyapunov. Local Open Scope classical_set_scope. Context {K : realType}. @@ -1756,111 +1463,46 @@ Variable gamma : K. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. Variable R : K -> 'M[K]_3. -(*Variable y0 : K -> 'rV[K]_6. -Hypothesis y0init: y0 0 \in state_space_tilt. -Hypothesis y0sol : is_sol (tilt_eqn alpha1 gamma) y0 state_space_tilt.*) -Lemma derive_zp1 (z : K) (traj : K -> 'rV_6) : - is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> - 'D_1 (Left \o traj) z = - alpha1 *: Left (traj z). +Lemma derive_zp1 (z : K) (sol : K -> 'rV_6) : + is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + 'D_1 (Left \o sol) z = - alpha1 *: Left (sol z). Proof. move=> [/= traj0 dtraj]. move=> /(_ z)/(congr1 Left). by rewrite row_mxKl => ?; rewrite derive_lsubmx//=. Qed. -Lemma derive_z2 (z : K) (traj : K -> 'rV_6) : is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> - 'D_1 (Right \o traj) z = - gamma *: (Right (traj z) - Left (traj z)) *m \S('e_2 - Right (traj z)) ^+ 2. +Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : + is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + 'D_1 (Right \o sol) z = + gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. move=> [/= traj0 dtraj]. -by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx//=. +by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx. Qed. -Let c1 := 2^-1 / alpha1. -Let c2 := 2^-1 / gamma. - -Lemma derive_V1dot (z : K) (traj : K -> 'rV_6) - (zp1 := Left \o traj) (z2 := Right \o traj) : - is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> - c1 *: (2 *: 'D_1 zp1 z *m (Left (traj z))^T) 0 0 + - c2 *: (2 *: 'D_1 z2 z *m (Right (traj z))^T) 0 0 - = V1dot (traj z). +Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : + is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + state_space_tilt (sol t). Proof. -move=> ?. -rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. -rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC mulVf ?pnatr_eq0// div1r. -rewrite derive_zp1 // -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)) mulrN mulVf ?gt_eqF// mulN1r. -rewrite derive_z2 // -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE scalerA mulVf ?gt_eqF// scale1r. -rewrite norm_squared /V1dot. -congr +%R. -rewrite -2![in RHS]mulmxA -mulmxBr -mulmxBr -linearB/=. -rewrite -[X in _ = (X *m (_ *m _)) 0 0]trmxK -[X in _ = (_ *m (X *m _)) 0 0]trmxK. -rewrite mulmxA -trmx_mul -trmx_mul [RHS]mxE. -rewrite -(mulmxA (Right (traj z) - (Left (traj z)))) mulmxE -expr2. -rewrite tr_sqr_spin. -by rewrite mulmxA. -Qed. - -Lemma Gamma1_traj (y : K -> 'rV_6) t : - is_sol (tilt_eqn alpha1 gamma) y state_space_tilt -> state_space_tilt (y t). -Proof. -move=> iss. -case: iss. -move=> y033 dy deriv_y. -apply: (@thm11a _ alpha1 gamma) => //=. -exists y; split => //. +case => sol0 dsol deriv_sol. +apply: (@state_space_tiltS _ alpha1 gamma) => //=. +exists sol; split => //. by exists t. Qed. -Lemma norm_u1 (traj : K -> 'rV_6) (z : K) (z2 := Right \o traj) - (zp1 := Left \o traj) (u := 'e_2 - z2 z) : - is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> norm u = 1. +Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) + (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : + is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> norm u = 1. Proof. move=> dtraj. - -suff: state_space_tilt (row_mx (zp1 z) (z2 z)) by rewrite /state_space_tilt/= row_mxKr. +suff: state_space_tilt (row_mx (zp1 z) (z2 z)). + by rewrite /state_space_tilt/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. -by apply:Gamma1_traj. +exact: is_sol_state_space_tilt. Qed. -Lemma deriveV1 (x : K -> 'rV[K]_6) t : - is_sol (tilt_eqn alpha1 gamma) x state_space_tilt -> - (forall t, differentiable x t) -> - LieDerivative (V1 alpha1 gamma) (fun a => x) 0 t = V1dot (x t). -Proof. -rewrite /tilt_eqn. -move=> tilt_eqnx dif1. -rewrite /V1. -rewrite LieDerivativeD; last 3 first. - apply/differentiableM => //=. - apply/differentiable_norm_squared => //. - exact: differentiable_lsubmx. - apply/differentiableM => //=. - apply/differentiable_norm_squared => //=. - exact: differentiable_rsubmx. - by []. -under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. -rewrite LieDerivativeMl => //; last first. - apply/differentiable_norm_squared. - exact/differentiable_lsubmx. -rewrite LieDerivativeMl => //; last first. - apply/differentiable_norm_squared => //=. - exact/differentiable_rsubmx. -rewrite -fctE /=. -rewrite !LieDerivative_norm_squared//=. -- rewrite -derive_V1dot. - rewrite /c1 /c2. - by rewrite !invfM. - rewrite /= in tilt_eqnx. - exact: tilt_eqnx. -- exact/differentiable_rsubmx. -- exact/differentiable_lsubmx. -Qed. - -(* TODO: Section general properties of our system *) - Lemma angvel_sqr (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> @@ -1875,12 +1517,11 @@ rewrite [in RHS]mxE. rewrite [X in _ = - (w *m (\S('e_2) *m (z2 z)^T)) 0 0 * (u *d u)%:M 0 0 - 0%:M 0 0 * X]mxE mulr1n mulr0 subr0/=. rewrite /u -/w /dotmul. have Hw_ortho : (w *d u) = 0 by rewrite /u dotmulC ortho_spin. -rewrite !mulmxA dotmulP dotmulvv norm_u1 // expr2 mulr1. +rewrite !mulmxA dotmulP dotmulvv norm_e2z2 // expr2 mulr1. rewrite [X in _ = - (w *m \S('e_2) *m (z2 z)^T) 0 0 * X]mxE /= mulr1n /=. rewrite [X in _ = - (w *m \S('e_2) *m (z2 z)^T) 0 0 * X]mxE /= mulr1. have wu0 : w *m u^T *m u = 0 by rewrite dotmulP Hw_ortho mul_scalar_mx scale0r. -rewrite -[in LHS](mulmxA w) sqr_spin; last first. - by rewrite -/u norm_u1. +rewrite -[in LHS](mulmxA w) sqr_spin; last by rewrite -/u norm_e2z2. rewrite [in LHS]mulmxBr mulmxA wu0 sub0r. by rewrite 2!mulNmx mulmx1 mxE. Qed. @@ -1895,29 +1536,86 @@ rewrite mulmxN normN. pose zp1 := fun r => Left (traj r). pose z2 := fun r => Right (traj r). set w := (z2 z) *m \S('e_2). -have Gamma1_traj t : state_space_tilt (traj t) by apply/Gamma1_traj. +have Gamma1_traj t : state_space_tilt (traj t) by apply/is_sol_state_space_tilt. rewrite /norm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. have Hnorm_sq : norm (w *m \S('e_2 - Right (traj z))) ^+ 2 = norm w ^+ 2. - rewrite -!dotmulvv angvel_sqr // !dotmulvv norm_u1 /= //. + rewrite -!dotmulvv angvel_sqr// !dotmulvv norm_e2z2//=. rewrite -!dotmulvv expr2 !mul1r mulr1. - have -> : w *d ('e_2 - Right (traj z)) = 0. - by rewrite dotmulC ortho_spin. + have -> : w *d ('e_2 - Right (traj z)) = 0 by rewrite dotmulC ortho_spin. by rewrite expr2 mul0r subr0. - rewrite !normr_norm. - by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?norm_ge0. +rewrite !normr_norm. +by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?norm_ge0. Qed. -Lemma V1dot_ub (traj : K -> 'rV_6) (zp1 := Left \o traj) (z2 := Right \o traj) : - is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> - forall z, - let w := z2 z *m \S('e_2) in - let u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i in - V1dot (traj z) <= (- u1 *m u2 *m u1^T) 0 0. +Let c1 := 2^-1 / alpha1. +Let c2 := 2^-1 / gamma. + +Lemma V1dotE (z : K) (sol : K -> 'rV_6) + (zp1 := Left \o sol) (z2 := Right \o sol) : + is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + V1dot (sol z) = + c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + + c2 *: (2 *: 'D_1 z2 z *m (Right (sol z))^T) 0 0. +Proof. +move=> ?. +rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. +rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC. +rewrite mulVf// div1r. +rewrite derive_zp1 // -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)). +rewrite mulrN mulVf ?gt_eqF// mulN1r. +rewrite derive_z2 // -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE. +rewrite scalerA mulVf ?gt_eqF// scale1r. +rewrite norm_squared /V1dot. +congr +%R. +rewrite -2![in LHS]mulmxA -mulmxBr -mulmxBr -linearB/=. +rewrite -[X in (X *m (_ *m _)) 0 0 = _]trmxK. +rewrite -[X in (_ *m (X *m _)) 0 0 = _]trmxK. +rewrite mulmxA -trmx_mul -trmx_mul [LHS]mxE. +rewrite -(mulmxA (Right (sol z) - (Left (sol z)))) mulmxE -expr2. +rewrite tr_sqr_spin. +by rewrite mulmxA. +Qed. + +Lemma derive_along_V1 (x : 'rV[K]_6) t sol : + is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + (forall t, differentiable (sol x) t) -> + 'D~(sol, x) (V1 alpha1 gamma) t = V1dot (sol x t). +Proof. +rewrite /tilt_eqn => tilt_eqnx dif1. +rewrite /V1 derive_alongD; last 3 first. + apply/differentiableM => //=. + exact/differentiable_norm_squared/differentiable_lsubmx. + apply/differentiableM => //=. + exact/differentiable_norm_squared/differentiable_rsubmx. + exact: dif1. +under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. +rewrite derive_alongMl => //; last first. + exact/differentiable_norm_squared/differentiable_lsubmx. +rewrite derive_alongMl => //; last first. + exact/differentiable_norm_squared/differentiable_rsubmx. +rewrite -fctE /= !derive_along_norm_squared//=. +- rewrite V1dotE. + by rewrite /c1 /c2 !invfM. + rewrite /= in tilt_eqnx. + exact: tilt_eqnx. +- exact/differentiable_lsubmx. +- exact/differentiable_rsubmx. +Qed. + +Definition u1 (sol : K -> 'rV_6) t + (zp1 := Left \o sol) (z2 := Right \o sol) + (w := z2 t *m \S('e_2)) : 'rV[K]_2 := + \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 t), 1 |-> norm w] i. + +Lemma V1dot_ub (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : + is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + forall t, + V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. move=> dtraj z. set w := z2 z *m \S('e_2). -pose u1 := \row_i [eta fun=> 0 with 0 |-> norm (zp1 z), 1 |-> norm w] i. rewrite /V1dot. rewrite mxE norm_spin mxE addrA expr2 mulmxA. have -> : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2). @@ -1944,41 +1642,42 @@ by rewrite [leRHS]mulrC. Qed. (* TODO: rework of this proof is needed *) -Lemma near0_le0 (traj : K -> 'rV_6) : - is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> - traj 0 = point1 -> +(* NB: unused *) +Lemma derive_along_Left_Right_le0 sol (x : 'rV[K]_6) : + is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + sol x 0 = point1 -> \forall z \near 0^', - (LieDerivative (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) (fun a=> traj) 0 + - LieDerivative (fun x => norm (Right x) ^+ 2 / (2 * gamma)) (fun a => traj) 0) z <= 0. + ('D~(sol, x) (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) + + 'D~(sol, x) (fun x => norm (Right x) ^+ 2 / (2 * gamma))) z <= 0. Proof. move=> dtraj traj0. rewrite fctE !invfM /=. near=> z. -under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. +under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. move: dtraj => [H0 Hderiv Htilt]. -have Hz_derivable : derivable traj z 1. +have Hz_derivable : derivable (sol x) z 1. by apply: Hderiv. -rewrite LieDerivativeMl; last 2 first. - apply/differentiable_norm_squared => //=. - exact/differentiable_lsubmx. - by apply derivable1_diffP. -rewrite LieDerivativeMl; last 2 first. - apply/differentiable_norm_squared => //=. +rewrite derive_alongMl; last 2 first. + exact/differentiable_norm_squared/differentiable_lsubmx. + apply derivable1_diffP. + exact: Hderiv. +rewrite derive_alongMl; last 2 first. + exact/differentiable_norm_squared/differentiable_rsubmx. + exact/derivable1_diffP. +rewrite /= !derive_along_norm_squared; last 4 first. exact/differentiable_rsubmx. - by apply derivable1_diffP. -rewrite /= !LieDerivative_norm_squared; last 4 first. - exact/differentiable_rsubmx. - by apply/derivable1_diffP. + exact/derivable1_diffP. exact/differentiable_lsubmx. - by apply/derivable1_diffP. -rewrite derive_V1dot //. -pose zp1 := Left \o traj. -pose z2 := Right \o traj. + exact/derivable1_diffP. +rewrite -V1dotE //. +pose zp1 := Left \o sol x. +pose z2 := Right \o sol x. set w := (z2 z) *m \S('e_2). -pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. +pose u1 : 'rV[K]_2 := + \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). - apply: V1dot_ub => //. + exact: V1dot_ub. have := @posdefmxu2 K. rewrite posdefmxP => def. have [->|H] := eqVneq u1 0. @@ -1989,182 +1688,134 @@ by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. Unshelve. all: try by end_near. Qed. (* NB: should be completed to prove asymptotic stability *) -Lemma V1_dot_is_lnsd (y : K -> 'rV_6) : - is_sol (tilt_eqn alpha1 gamma) y state_space_tilt -> - y 0 = point1 -> - locnegsemidef (LieDerivative (V1 alpha1 gamma) (fun a => y) 0) 0. +Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : + is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + sol x 0 = point1 -> + locnegsemidef ('D~(sol, x) (V1 alpha1 gamma)) 0. Proof. move=> [y033] dy dtraj traj0. -have Gamma1_traj t : state_space_tilt (y t). - apply/Gamma1_traj. - by split => //. rewrite /locnegsemidef /V1. -rewrite LieDerivativeD /=; last 3 first. +rewrite derive_alongD /=; last 3 first. apply: differentiableM => /=; last exact: differentiable_cst. - apply: differentiable_norm_squared. - exact/differentiable_lsubmx. + exact/differentiable_norm_squared/differentiable_lsubmx. apply: differentiableM; last exact: differentiable_cst. - apply: differentiable_norm_squared=> //. - exact/differentiable_rsubmx. - by apply derivable1_diffP. + exact/differentiable_norm_squared/differentiable_rsubmx. + exact/derivable1_diffP. split; last first. near=> z. - rewrite LieDerivative_derive //; last first. - admit. - admit. - admit. -under [X in LieDerivative X _ _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + LieDerivative X _ _ _]eq_fun do rewrite mulrC. -rewrite LieDerivativeMl; last first. - by apply derivable1_diffP. - apply/differentiable_norm_squared. - exact/differentiable_lsubmx. -rewrite LieDerivativeMl; last 2 first. - apply/differentiable_norm_squared. - exact/differentiable_rsubmx. - by apply derivable1_diffP. -rewrite /= !derivative_LieDerivative_eq0; last 4 first. - apply/differentiable_norm_squared. - exact/differentiable_rsubmx. + rewrite derive_along_derive //; last exact/derivable1_diffP. + admit. (* TODO: lynda *) + admit. (* TODO: lynda *) +under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. +rewrite derive_alongMl; last 2 first. + exact/differentiable_norm_squared/differentiable_lsubmx. + exact/derivable1_diffP. +rewrite derive_alongMl; last 2 first. + exact/differentiable_norm_squared/differentiable_rsubmx. + exact/derivable1_diffP. +rewrite /= !derivative_derive_along_eq0; last 4 first. + exact/differentiable_norm_squared/differentiable_rsubmx. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - apply/differentiable_norm_squared; last first. - exact/differentiable_lsubmx. + exact/differentiable_norm_squared/differentiable_lsubmx. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. Abort. -(* forall z? *) -Lemma V1_dot_is_lnd (y : K -> 'rV_6) - (zp1 := Left \o y) (z2 := Right \o y) : - is_sol (tilt_eqn alpha1 gamma) y state_space_tilt -> - (forall t : K, state_space_tilt (y t)) -> - y 0 = point1 -> - lnd (LieDerivative (V1 alpha1 gamma) (fun a => y) 0) 0. +Lemma locnegdef_derive_along_V1 sol (x : 'rV[K]_6) + (zp1 := Left \o sol x) (z2 := Right \o sol x) : + is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + (forall t : K, state_space_tilt (sol x t)) -> + sol x 0 = point1 -> + locnegdef ('D~(sol, x) (V1 alpha1 gamma)) 0. Proof. move=> solves state y0. -have Gamma1_traj t : state_space_tilt (y t). - by apply/Gamma1_traj. -rewrite /lnd. -split; last first. +split. + rewrite /is_sol in solves. + rewrite /= derivative_derive_along_eq0 => //; last first. + admit. + rewrite /V1. + apply: differentiableD => //; last first. + apply: differentiableM; last exact: differentiable_cst. + exact/differentiable_norm_squared/differentiable_rsubmx. + apply: differentiableM => //. + exact/differentiable_norm_squared/differentiable_lsubmx. near=> z0. -rewrite deriveV1. -have V1dot_le := V1dot_ub solves z0 => //; last first. -have := @posdefmxu2 K. -rewrite posdefmxP => def. -set w := z2 z0 *m \S('e_2). -set u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z0), 1 |-> norm w] i. -have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0. apply: def. -rewrite /u1. -admit. -have Hneg : - (u1 *m u2 *m u1^T) 0 0 < 0. by rewrite oppr_lt0. -rewrite lt_neqAle. -apply/andP; split; last first. +rewrite derive_along_V1. +- have V1dot_le := V1dot_ub solves z0 => //. + have := @posdefmxu2 K. + rewrite posdefmxP => def. + set w := z2 z0 *m \S('e_2). + set u1 : 'rV[K]_2 := \row_(i < 2) + [eta (fun=> 0) with 0 |-> norm (zp1 z0), 1 |-> norm w] i. + have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0. + apply: def. + rewrite /u1. + admit. + have Hneg : - (u1 *m u2 *m u1^T) 0 0 < 0 by rewrite oppr_lt0. + rewrite lt_neqAle. + apply/andP; split; last first. apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). - have Hle_z0 : V1dot (y z0) <= (- u1 *m u2 *m u1^T) 0 0. - move: V1dot_le. - rewrite /=. - by []. - by []. -have ee : (- u1 *m u2 *m u1^T) 0 0 = - (u1 *m u2 *m u1^T) 0 0. - rewrite !mxE -sumrN. - under [in LHS]eq_bigr do rewrite mulNmx mxE. - by under [in LHS]eq_bigr do rewrite mulNr. - rewrite ee. + by []. + have -> : (- u1 *m u2 *m u1^T) 0 0 = - (u1 *m u2 *m u1^T) 0 0. + rewrite !mxE -sumrN. + under [in RHS]eq_bigr do rewrite -mulNr. + by under [in LHS]eq_bigr do rewrite mulNmx mxE. by apply/ltW => //. rewrite /V1dot. rewrite mxE/=. apply/eqP => Habs. admit. - by []. -move => t. -apply/derivable1_diffP => //. -move : solves; rewrite /is_sol. -case. -by []. -rewrite /is_sol in solves. -rewrite /= derivative_LieDerivative_eq0 => //; last first. - -admit. -rewrite /V1. -apply: differentiableD => //; last first. - apply: differentiableM; last exact: differentiable_cst. - apply: differentiable_norm_squared. - exact/differentiable_rsubmx. -apply: differentiableM => //. - apply/differentiable_norm_squared. -exact/differentiable_lsubmx. +- by []. +- move => t. + apply/derivable1_diffP => //. + move : solves; rewrite /is_sol. + by case. Unshelve. all: by end_near. Abort. -(*Definition is_lyapunov_stable_at {K : realType} {n} +(*Definition is_Lyapunov_stable_at {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) (A : set 'rV[K]_n.+1) (V : 'rV[K]_n.+1 -> K) (x0 : 'rV[K]_n.+1) : Prop := [/\ is_equilibrium_point f x0 A, - is_lyapunov_candidate V setT x0 & + is_Lyapunov_candidate V setT x0 & forall traj1 traj2 : (K -> 'rV[K]_n.+1), is_sol f traj1 A -> traj1 0 = x0 -> - locnegsemidef (LieDerivative V (fun a => traj1) 0 ) 0].*) + locnegsemidef (derive_along V (fun a => traj1) 0 ) 0].*) -(*Lemma V1_is_lyapunov_stable : - is_lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. +(*Lemma V1_is_Lyapunov_stable : + is_Lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. Proof. split. - exact: equilibrium_point1. -- exact: V1_is_lyapunov_candidate. +- exact: V1_is_Lyapunov_candidate. (*- by move=> traj1 ? ?; exact: V1_point_is_lnsd. Qed.*) Abort.*) -(* thm 4.6 p136*) -Definition hurwitz n (A : 'M[K]_n.+1) : Prop := (forall a, eigenvalue A a -> a < 0). - -(* thm 4.7 p139 + fact: it is exponentially stable*) -Definition locally_exponentially_stable_at n (eqn : 'rV[K]_n.+1 -> 'rV[K]_n.+1) (point : 'rV[K]_n.+1) : Prop := - hurwitz (jacobian eqn point). - -Lemma tilt_eqn_is_locally_exponentially_stable_at_0 : - locally_exponentially_stable_at (tilt_eqn_wip alpha1 gamma) point1. +Lemma derive_along_V1_le0 sol (x : 'rV[K]_6) : + is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + (forall t, differentiable (sol x) t) -> + forall t : K, 0 <= t -> + 'D~(sol, x) (V1 alpha1 gamma) t <= 0. Proof. -rewrite /locally_exponentially_stable_at /jacobian /hurwitz. -move => a. -move/eigenvalueP => [u] /[swap] u0 H. -have a_eigen : eigenvalue (jacobian (tilt_eqn_wip alpha1 gamma) point1) a. - apply/eigenvalueP. - exists u. - exact: H. - exact: u0. -have : root (char_poly (jacobian (tilt_eqn_wip alpha1 gamma) point1)) a. - rewrite -eigenvalue_root_char. - exact : a_eigen. -rewrite /tilt_eqn_wip /jacobian. -Abort. - -Lemma V1_dot_le0 : - forall y, is_sol (tilt_eqn alpha1 gamma) y state_space_tilt -> - (forall t, differentiable y t) -> - y 0 = point1 -> - forall t : K , t >= 0 -> - LieDerivative (V1 alpha1 gamma) (fun=> y) (y t) t <= 0. -Proof. - move=> y solves diff y0 t t0. - change (LieDerivative (V1 alpha1 gamma) (fun=> y) (y t) t) - with ((LieDerivative (V1 alpha1 gamma) (fun=> y))``_t). - rewrite deriveV1 => //. - have Hub := V1dot_ub solves t. - have := @posdefmxu2 K. - rewrite posdefmxP => def. - apply: (le_trans Hub). +move=> solves diff t t0. +rewrite derive_along_V1//. +have Hub := V1dot_ub solves t. +have := @posdefmxu2 K. +rewrite posdefmxP => def. +apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 - with 0 |-> norm ((Left \o y) t), - 1 |-> norm ((Right \o y) t *m \S('e_2))] + with 0 |-> norm ((Left \o sol x) t), + 1 |-> norm ((Right \o sol x) t *m \S('e_2))] i in 0 <= (u1 *m u2 *m u1^T) 0 0. set u1 := \row_i [eta fun=> 0 - with 0 |-> norm ((Left \o y) t), - 1 |-> norm ((Right \o y) t *m \S('e_2))] + with 0 |-> norm ((Left \o sol x) t), + 1 |-> norm ((Right \o sol x) t *m \S('e_2))] i. rewrite /=. case: (u1 =P 0) => [->|/eqP u1_neq0]. @@ -2175,96 +1826,60 @@ rewrite -oppr_ge0. by rewrite !mulNmx mxE opprK Hquad. Qed. +End tilt_eqn_Lyapunov. + +Section equilibrium_zero_stable. +Context {K : realType}. +Variables gamma alpha1 : K. +Hypothesis gamma_gt0 : 0 < gamma. +Hypothesis alpha1_gt0 : 0 < alpha1. Variable D : set 'rV[K]_6. -Variable y0 : K -> 'rV[K]_6. -Hypothesis y0init: y0 0 \in D. -Hypothesis y0init_sol : is_sol (tilt_eqn alpha1 gamma) y0 D. -Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. -Hypothesis solP : - forall y : K -> 'rV[K]_6, - y 0 \in D -> - is_sol (tilt_eqn alpha1 gamma) y D <-> - sol (y 0) = y. -Hypothesis y0origin : y0 0 = 0. - - -Lemma is_sol_subset (D_in_state : D `<=` state_space_tilt) : is_sol (tilt_eqn alpha1 gamma) y0 D -> is_sol (tilt_eqn alpha1 gamma) y0 state_space_tilt. -Proof. -rewrite /is_sol inE. -move => [inD0 deriv tilt]. -rewrite inE. -split. -by apply D_in_state => //. -exact : deriv. -exact : tilt. -Qed. +Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. +Hypothesis solP : existence_uniqueness D (tilt_eqn alpha1 gamma) sol. +Hypothesis sol0 : initial_condition sol. + +Hypothesis y0 : 0 \in D. +Hypothesis y_sol : is_sol (tilt_eqn alpha1 gamma) (sol 0) D. +Hypothesis y00 : sol 0 0 = 0. -Lemma is_equilibrium_subset : (is_equilibrium_point (tilt_eqn alpha1 gamma))``_state_space_tilt -> (is_equilibrium_point (tilt_eqn alpha1 gamma))``_D. +Lemma is_equilibrium_subset : + (is_equilibrium_point (tilt_eqn alpha1 gamma)) 0 state_space_tilt -> + (is_equilibrium_point (tilt_eqn alpha1 gamma)) 0 D. Proof. -rewrite /is_equilibrium_point. -rewrite /is_sol inE. -move => [inD0 deriv tilt]. -rewrite inE. -split. -rewrite /= -y0origin => //. -move : y0init. -rewrite inE. -apply. -exact : deriv. -exact : tilt. +rewrite /is_equilibrium_point /is_sol inE => -[inD0 deriv tilt]. +by rewrite inE; split => //; exact/set_mem. Qed. - -Lemma equilibrium_zero_stable (openD : open D) (D0 : 0 \in D) (D_in_state : D `<=` state_space_tilt) : equilibrium_is_stable_at D point1 y0. -Proof. -apply : (@lyapunov_stability K 5 D (tilt_eqn alpha1 gamma) _ openD solP _ (V1 alpha1 gamma) ). -- exact : openD. -- by move => y y0in => //. -- have := V1_is_lyapunov_candidate alpha1_gt0 gamma_gt0. - move => HV1. - case: HV1 => [Hpos Hdif]. - split. - rewrite /point1 in Hpos Hdif. - rewrite /locposdef. - split => //. - rewrite -y0origin => //. - split => //. - rewrite /V1 y0origin. - rewrite lsubmx_const rsubmx_const //=. - by rewrite !expr2 !norm0 !mulr0 !mul0r add0r. - move => z zin z_neq0. - rewrite /locposdef in Hpos. - case : Hpos => //. - move => _. - move => [_ Hpos]. - apply: Hpos => //. - move : zin. - have subset : D `<=` [set : 'rV_6]. - move => t. - by apply subsetT. - rewrite inE. - move => Hw. - rewrite inE. - by apply: subset => //. - by rewrite y0origin in z_neq0. - by rewrite /point1 in Hdif. -- move => y solvess t t00. - apply: V1_dot_le0 => //. - by apply is_sol_subset => //. - move => t0. - rewrite -derivable1_diffP. - by case : y0init_sol. -- move =>t. - rewrite /V1. +Lemma equilibrium_zero_stable (openD : open D) (D0 : 0 \in D) + (D_in_state : D `<=` state_space_tilt) : + equilibrium_is_stable_at D point1 (sol 0). +Proof. +apply: (@Lyapunov_stability K 5 D (tilt_eqn alpha1 gamma) + sol openD solP _ (V1 alpha1 gamma)). +- assumption. +- move=> z zD t t0; apply: derive_along_V1_le0; [by []|by []| | |]. + + apply: (is_sol_subset D_in_state). + by apply solP; rewrite sol0. + + move=> t1. + rewrite -derivable1_diffP. + have : is_sol (tilt_eqn alpha1 gamma) (sol z) D by apply solP; rewrite sol0. + by case. + + by []. +- move=> t. apply/differentiableD => //. apply/differentiableM => //. - apply/differentiable_norm_squared => //. - by apply/differentiable_lsubmx => //. + exact/differentiable_norm_squared/differentiable_lsubmx. apply/differentiableM => //. - apply/differentiable_norm_squared => //. - by apply/differentiable_rsubmx => //. - - apply: is_equilibrium_subset. - by apply: equilibrium_point1 => //. + exact/differentiable_norm_squared/differentiable_rsubmx. +- have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. + rewrite /is_Lyapunov_candidate /point1 => Hpos. + rewrite /V1 lsubmx_const rsubmx_const; split => //. + split. + by rewrite !expr2 !norm0 !mulr0 !mul0r add0r. + move=> z zin z_neq0. + case : Hpos => // _ [_]. + by apply => //; rewrite inE. +- exact/is_equilibrium_subset/equilibrium_point1. Qed. -End tilt_eqn_Lyapunov. +End equilibrium_zero_stable. diff --git a/tilt_analysis.v b/tilt_analysis.v index e0c01208..17a85a76 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -63,7 +63,7 @@ exact: is_derive1_sqrt. Qed. Lemma differentiable_scalar_mx {R : realFieldType} n (r : R) : - differentiable (@scalar_mx _ n.+1) r. + differentiable (@scalar_mx _ n) r. Proof. apply/derivable1_diffP/cvg_ex => /=. exists 1; apply/cvgrPdist_le => /= e e0. @@ -73,7 +73,7 @@ rewrite scaler1 -raddfB/= addrK (scale_scalar_mx _ t^-1) mulVf. by near: t; exact: nbhs_dnbhs_neq. Unshelve. all: by end_near. Qed. -Lemma derivable_norm_squared {K : rcfType} n (f : K -> 'rV[K]_n.+1) (x0 : K) : +Lemma derivable_norm_squared {K : rcfType} n (f : K -> 'rV[K]_n) (x0 : K) : derivable f x0 1 -> derivable (fun x => norm (f x) ^+ 2) x0 1. Proof. @@ -93,13 +93,14 @@ apply/derivable1_diffP. by apply/derivable_coord => //. Qed. -Lemma derive_norm_squared {K : realType} n (u : K -> 'rV[K]_n.+1) (t : K) : +Lemma derive_norm_squared {K : realType} n (u : K -> 'rV[K]_n) (t : K) : derivable u t 1 -> - (fun x => norm (u x) ^+ 2)^`()%classic t = 2 * ('D_1 u t *m (u t)^T)``_0 :> K. + 'D_1 (fun x => norm (u x) ^+ 2) t = + 2 * ('D_1 u t *m (u t)^T)``_0. Proof. move=> ut1. under eq_fun do rewrite -dotmulvv. -rewrite dotmulP mxE /= mulr1n derive1E derive_dotmul// dotmulC. +rewrite dotmulP mxE /= mulr1n derive_dotmul// dotmulC. by field. Qed. @@ -110,24 +111,22 @@ apply: ex_derive. by apply: (is_derive1_sqrt gt0). Qed. -Lemma differentiable_norm {K : realType} n m (f : 'rV[K]_n.+1 -> 'rV_m.+1) - (x : K -> 'rV[K]_n.+1) (t : K) : - differentiable f (x t) -> f (x t) != 0 -> - differentiable (fun x0 => norm (f x0)) (x t) . +Lemma differentiable_norm {K : realType} m n (f : 'rV[K]_m -> 'rV_n) + (g : K -> 'rV[K]_m) t : + differentiable f (g t) -> f (g t) != 0 -> + differentiable (fun x => norm (f x)) (g t) . Proof. -move => fx0 dif1. -rewrite /norm -fctE. -apply: differentiable_comp; last first. - apply/derivable1_diffP. - apply/derivable_sqrt. - by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0 //. -by apply: differentiable_dotmul => //. +move=> fgt fgt0; rewrite /norm -fctE. +apply: differentiable_comp. + exact: differentiable_dotmul. +apply/derivable1_diffP/derivable_sqrt. +by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0. Qed. -Lemma differentiable_norm_squared {R : rcfType} m n (V := 'rV[R]_m.+1) - (u : V -> 'rV[R]_n.+1) (t : V) : - differentiable u t -> - differentiable (fun x => norm (u x) ^+ 2) t. +Lemma differentiable_norm_squared {R : rcfType} m n + (f : 'rV[R]_m -> 'rV[R]_n) (v : 'rV[R]_m) : + differentiable f v -> + differentiable (fun x => norm (f x) ^+ 2) v. Proof. move=> dif1. under eq_fun do rewrite -dotmulvv. diff --git a/tilt_robot.v b/tilt_robot.v index 1235e51b..df763470 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -22,7 +22,7 @@ Proof. by apply/esym/eqP; rewrite -symE; exact: sqr_spin_is_sym. Qed. Lemma mul_tr_spin {R : comNzRingType} (u : 'rV[R]_3) : u *m \S(u)^T = 0. Proof. by apply: trmx_inj; rewrite trmx_mul trmxK spin_mul_tr trmx0. Qed. -Lemma CauchySchwarz_vec {R : rcfType} {n : nat} (a b : 'rV[R]_n.+1) : +Lemma CauchySchwarz_vec {R : rcfType} {n : nat} (a b : 'rV[R]_n) : (a *d b)^+2 <= (a *d a) * (b *d b). Proof. suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. @@ -66,7 +66,7 @@ by rewrite dotmulvv mulrC in h2. Qed. (* not used *) -Lemma young_inequality_vec {R : rcfType} {n : nat} (a b : 'rV[R]_n.+1) : +Lemma young_inequality_vec {R : rcfType} {n : nat} (a b : 'rV[R]_n) : (a *d b) <= (2^-1 * (norm a)^+2) + (2^-1 * (norm b)^+2). Proof. have normage0 : 0 <= (norm a)^+2. @@ -115,30 +115,29 @@ Lemma norm_squared {R : rcfType} n (u : 'rV[R]_n) : (u *m (u)^T) 0 0 = norm u ^+2. Proof. by rewrite -dotmulvv /dotmul. Qed. - Lemma derivable_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : + (f : V -> 'rV[R]_(n1 + n2)) t v : (forall x, derivable f x v) -> derivable (fun x => rsubmx (f x)) t v. Proof. move=> /= => df1. apply/derivable_mxP => i j/=. rewrite (ord1 i). have /cvg_ex[/= r Hr]:= df1 t. -apply/cvg_ex => /=; exists (r``_(rshift n1.+1 j)). +apply/cvg_ex => /=; exists (r``_(rshift n1 j)). apply/cvgrPdist_le => /= e e0. move/cvgrPdist_le : Hr => /(_ _ e0). apply: filterS => x. apply: le_trans. rewrite [in leRHS]/Num.Def.normr/= mx_normrE. apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, rshift n1.+1 j)). + exact: (le_bigmax _ _ (ord0, rshift n1 j)). by rewrite !mxE. Qed. Lemma derive_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : + (f : V -> 'rV[R]_(n1 + n2)) t v : (forall x, derivable f x v) -> - 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1.+1 _ ('D_v f t). + 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1 _ ('D_v f t). Proof. move=> df1; apply/matrixP => i j; rewrite !mxE /=. rewrite derive_mx ?mxE//=; last exact: derivable_rsubmx. @@ -147,27 +146,26 @@ by apply/funext => x; rewrite !mxE. Qed. Lemma differentiable_rsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : - differentiable (@rsubmx R 1 n1.+1 n2.+1) t. + differentiable (@rsubmx R 1 n1 n2) t. Proof. -have lin_rsubmx : linear (@rsubmx R 1 n1.+1 n2.+1). +have lin_rsubmx : linear (@rsubmx R 1 n1 n2). move=> a b c. by rewrite linearD//= linearZ. pose build_lin_rsubmx := GRing.isLinear.Build _ _ _ _ _ lin_rsubmx. -pose Rsubmx : {linear 'rV[R^o]_(n1.+1 + n2.+1) -> 'rV[R^o]_n2.+1} := HB.pack (@rsubmx R _ _ _) build_lin_rsubmx. +pose Rsubmx : {linear 'rV[R^o]_(n1 + n2) -> 'rV[R^o]_n2} := HB.pack (@rsubmx R _ _ _) build_lin_rsubmx. apply: (@linear_differentiable _ _ _ Rsubmx). move=> /= u A /=. move/nbhs_ballP=> [e /= e0 eA]. -apply/nbhs_ballP; exists e => //= v uv. -apply: eA. -split; first exact: e0. +apply/nbhs_ballP; exists e => //= v [? uv]. +apply: eA; split => //. (* TODO: lemma *) -move: uv => [_]; rewrite /ball/= /mx_ball/ball /= => uv i j. -apply: (le_lt_trans _ (uv i (rshift n1.+1 j))). +move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. +apply: (le_lt_trans _ (uv i (rshift n1 j))). by rewrite !mxE. Qed. Global Instance is_diff_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f df : V -> 'rV[R]_(n1.+1 + n2.+1)) t : + (f df : V -> 'rV[R]_(n1 + n2)) t : is_diff t f df -> is_diff t (fun x => rsubmx (f x)) (fun x => rsubmx (df x)). Proof. @@ -184,7 +182,7 @@ rewrite derive_rsubmx//. Abort. Lemma differentiable_rsubmx {R : realFieldType} (V : normedModType R) {n1 n2} - (f : V -> 'rV[R]_(n1.+1 + n2.+2)) t : + (f : V -> 'rV[R]_(n1 + n2)) t : (forall x, differentiable f x) -> differentiable (fun x => rsubmx (f x)) t. Proof. @@ -194,28 +192,28 @@ exact: differentiable_rsubmx0. Qed. Lemma derivable_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : + (f : V -> 'rV[R]_(n1 + n2)) t v : (forall x, derivable f x v) -> derivable (fun x => lsubmx (f x)) t v. Proof. move=> /= => df1. apply/derivable_mxP => i j/=. rewrite (ord1 i). have /cvg_ex[/= l Hl]:= df1 t. -apply/cvg_ex => /=; exists (l``_(lshift n2.+1 j)). +apply/cvg_ex => /=; exists (l``_(lshift n2 j)). apply/cvgrPdist_le => /= e e0. move/cvgrPdist_le : Hl => /(_ _ e0). apply: filterS => x. apply: le_trans. rewrite [in leRHS]/Num.Def.normr/= mx_normrE. apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, lshift n2.+1 j)). + exact: (le_bigmax _ _ (ord0, lshift n2 j)). by rewrite !mxE. Qed. Lemma derive_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1.+1 + n2.+1)) t v : + (f : V -> 'rV[R]_(n1 + n2)) t v : (forall x, derivable f x v) -> - 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1.+1 _ ('D_v f t). + 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1 _ ('D_v f t). Proof. move=> df1; apply/matrixP => i j; rewrite !mxE /=. rewrite derive_mx ?mxE//=; last exact: derivable_lsubmx. @@ -224,27 +222,27 @@ by apply/funext => x; rewrite !mxE. Qed. Lemma differentiable_lsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : - differentiable (@lsubmx R 1 n1.+1 n2.+1) t. + differentiable (@lsubmx R 1 n1 n2) t. Proof. -have lin_lsubmx : linear (@lsubmx R 1 n1.+1 n2.+1). +have lin_lsubmx : linear (@lsubmx R 1 n1 n2). move=> a b c. by rewrite linearD//= linearZ. pose build_lin_lsubmx := GRing.isLinear.Build _ _ _ _ _ lin_lsubmx. -pose Lsubmx : {linear 'rV[R^o]_(n1.+1 + n2.+1) -> 'rV[R^o]_n1.+1} := HB.pack (@lsubmx R _ _ _) build_lin_lsubmx. +pose Lsubmx : {linear 'rV[R^o]_(n1 + n2) -> 'rV[R^o]_n1} := + HB.pack (@lsubmx R _ _ _) build_lin_lsubmx. apply: (@linear_differentiable _ _ _ Lsubmx). move=> /= u A /=. move/nbhs_ballP=> [e /= e0 eA]. -apply/nbhs_ballP; exists e => //= v uv. -apply: eA. -split; first exact: e0. +apply/nbhs_ballP; exists e => //= v [? uv]. +apply: eA; split => //. (* TODO: lemma *) -move: uv => -[_]; rewrite /ball/= /mx_ball/ball /= => uv i j. -apply: (le_lt_trans _ (uv i (lshift n2.+1 j))). +move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. +apply: (le_lt_trans _ (uv i (lshift n2 j))). by rewrite !mxE. Qed. Global Instance is_diff_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f df : V -> 'rV[R]_(n1.+1 + n2.+1)) t : + (f df : V -> 'rV[R]_(n1 + n2)) t : is_diff t f df -> is_diff t (fun x => lsubmx (f x)) (fun x => lsubmx (df x)). Proof. @@ -261,7 +259,7 @@ rewrite derive_lsubmx//. Abort. Lemma differentiable_lsubmx {R : realFieldType} (V : normedModType R) {n1 n2} - (f : V -> 'rV[R]_(n1.+1 + n2.+2)) t : + (f : V -> 'rV[R]_(n1 + n2)) t : (forall x, differentiable f x) -> differentiable (fun x => lsubmx (f x)) t. Proof. @@ -271,7 +269,7 @@ exact: differentiable_lsubmx0. Qed. Lemma derivable_row_mx {R : realFieldType} {n1 n2 : nat} - (f : R -> 'rV[R]_n1.+1) (g : R -> 'rV[R]_n2.+1) t v : + (f : R -> 'rV[R]_n1) (g : R -> 'rV[R]_n2) t v : (forall x, derivable f x v) -> (forall x, derivable g x v) -> derivable (fun x : R => row_mx (f x) (g x)) t v. Proof. @@ -299,7 +297,7 @@ by rewrite !mxE/=. Qed. Lemma derive_row_mx {R : realFieldType} {n1 n2 : nat} - (f : R -> 'rV[R]_n1.+1) (g : R -> 'rV[R]_n2.+1) t v : + (f : R -> 'rV[R]_n1) (g : R -> 'rV[R]_n2) t v : (forall x : R, derivable f x v) -> (forall x : R, derivable g x v) -> 'D_v (fun x => row_mx (f x) (g x)) t = row_mx ('D_v f t) ('D_v g t). @@ -318,21 +316,21 @@ case: fintype.split_ordP => /= j1 jj1; rewrite !mxE; congr ('D_v _ t). move: jE. rewrite jj1 => /(congr1 val)/=. have /[swap] -> := ltn_ord j1. - by rewrite ltnNge/= addSn ltnS leq_addr. + by rewrite ltnNge/= leq_addr. apply/funext => x; rewrite !mxE. case: fintype.split_ordP => k jE. move: jE. rewrite jj1 => /(congr1 val)/=. have /[swap] <- := ltn_ord k. - by rewrite ltnNge/= addSn ltnS leq_addr. + by rewrite ltnNge/= leq_addr. congr (g x i _). move: jE. rewrite jj1 => /(congr1 val) => /= /eqP. by rewrite eqn_add2l => /eqP /val_inj. Qed. -Lemma derivable_scalar_mx {R : realFieldType} n (f : 'rV[R]_n.+1 -> R) - (a : 'rV[R]_n.+1) v : +Lemma derivable_scalar_mx {R : realFieldType} n (f : 'rV[R]_n -> R) + (a : 'rV[R]_n) v : derivable f a v -> derivable (@scalar_mx _ 1 \o f) a v. Proof. From be841a36ebd75982e8ded9e4468ce11e41e7066f Mon Sep 17 00:00:00 2001 From: yosakaon Date: Thu, 4 Dec 2025 10:22:28 +0100 Subject: [PATCH 065/144] cleaning of tilt files --- tilt_analysis.v | 239 ++++++++++++++++++++++++++++++++++++++++++++++-- tilt_mathcomp.v | 5 +- tilt_robot.v | 95 +++++++++++++++---- 3 files changed, 308 insertions(+), 31 deletions(-) diff --git a/tilt_analysis.v b/tilt_analysis.v index 17a85a76..841c33c8 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -11,7 +11,7 @@ Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. - + (* is already in realfun.v*) Global Instance is_derive1_sqrt {K : realType} (x : K) : 0 < x -> is_derive x 1 Num.sqrt (2 * Num.sqrt x)^-1. Proof. @@ -62,18 +62,19 @@ apply: derive_val. exact: is_derive1_sqrt. Qed. -Lemma differentiable_scalar_mx {R : realFieldType} n (r : R) : +Lemma differentiable_scalar_mx {R : realType} n (r : R) : differentiable (@scalar_mx _ n) r. Proof. apply/derivable1_diffP/cvg_ex => /=. exists 1; apply/cvgrPdist_le => /= e e0. near=> t. +Search (_%:A). rewrite scaler1 -raddfB/= addrK (scale_scalar_mx _ t^-1) mulVf. by rewrite subrr normr0 ltW. by near: t; exact: nbhs_dnbhs_neq. Unshelve. all: by end_near. Qed. -Lemma derivable_norm_squared {K : rcfType} n (f : K -> 'rV[K]_n) (x0 : K) : +(*Lemma derivable_norm_squared {K : realType} n (f : K -> 'rV[K]_n) (x0 : K) : derivable f x0 1 -> derivable (fun x => norm (f x) ^+ 2) x0 1. Proof. @@ -91,9 +92,9 @@ apply/differentiableM => //=. by apply/derivable_coord => //. apply/derivable1_diffP. by apply/derivable_coord => //. -Qed. +Qed.*) -Lemma derive_norm_squared {K : realType} n (u : K -> 'rV[K]_n) (t : K) : +(*Lemma derive_norm_squared {K : realType} n (u : K -> 'rV[K]_n) (t : K) : derivable u t 1 -> 'D_1 (fun x => norm (u x) ^+ 2) t = 2 * ('D_1 u t *m (u t)^T)``_0. @@ -102,7 +103,7 @@ move=> ut1. under eq_fun do rewrite -dotmulvv. rewrite dotmulP mxE /= mulr1n derive_dotmul// dotmulC. by field. -Qed. +Qed.*) Lemma derivable_sqrt {K: realType} (u : K) : u > 0 -> derivable Num.sqrt (u) 1. Proof. @@ -110,8 +111,8 @@ move => gt0. apply: ex_derive. by apply: (is_derive1_sqrt gt0). Qed. - -Lemma differentiable_norm {K : realType} m n (f : 'rV[K]_m -> 'rV_n) +(* should go to tilt_robot*) +(*Lemma differentiable_norm {K : realType} m n (f : 'rV[K]_m -> 'rV_n) (g : K -> 'rV[K]_m) t : differentiable f (g t) -> f (g t) != 0 -> differentiable (fun x => norm (f x)) (g t) . @@ -121,9 +122,9 @@ apply: differentiable_comp. exact: differentiable_dotmul. apply/derivable1_diffP/derivable_sqrt. by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0. -Qed. +Qed.*) -Lemma differentiable_norm_squared {R : rcfType} m n +(*Lemma differentiable_norm_squared {R : rcfType} m n (f : 'rV[R]_m -> 'rV[R]_n) (v : 'rV[R]_m) : differentiable f v -> differentiable (fun x => norm (f x) ^+ 2) v. @@ -131,4 +132,222 @@ Proof. move=> dif1. under eq_fun do rewrite -dotmulvv. exact: differentiable_dotmul. +Qed.*) +(* this one too *) +(*Lemma derivable_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + (forall x, derivable f x v) -> derivable (fun x => rsubmx (f x)) t v. +Proof. +move=> /= => df1. +apply/derivable_mxP => i j/=. +rewrite (ord1 i). +have /cvg_ex[/= r Hr]:= df1 t. +apply/cvg_ex => /=; exists (r``_(rshift n1 j)). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hr => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, rshift n1 j)). +by rewrite !mxE. +Qed.*) + +(*Lemma derive_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + (forall x, derivable f x v) -> + 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1 _ ('D_v f t). +Proof. +move=> df1; apply/matrixP => i j; rewrite !mxE /=. +rewrite derive_mx ?mxE//=; last exact: derivable_rsubmx. +rewrite derive_mx ?mxE//=; congr ('D_v _ t). +by apply/funext => x; rewrite !mxE. +Qed.*) +(*DONE*) +Lemma differentiable_rsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : + differentiable (@rsubmx R 1 n1 n2) t. +Proof. +have lin_rsubmx : linear (@rsubmx R 1 n1 n2). + move=> a b c. + by rewrite linearD//= linearZ. +pose build_lin_rsubmx := GRing.isLinear.Build _ _ _ _ _ lin_rsubmx. +pose Rsubmx : {linear 'rV[R^o]_(n1 + n2) -> 'rV[R^o]_n2} := HB.pack (@rsubmx R _ _ _) build_lin_rsubmx. +apply: (@linear_differentiable _ _ _ Rsubmx). +move=> /= u A /=. +move/nbhs_ballP=> [e /= e0 eA]. +apply/nbhs_ballP; exists e => //= v [? uv]. +apply: eA; split => //. +(* TODO: lemma *) +move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. +apply: (le_lt_trans _ (uv i (rshift n1 j))). +by rewrite !mxE. +Qed. +(*DONE*) +Lemma differentiable_rsubmx {R : realFieldType} (V : normedModType R) {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t : + (forall x, differentiable f x) -> + differentiable (fun x => rsubmx (f x)) t. +Proof. +move=> /= => df1. +apply: differentiable_comp => //. +exact: differentiable_rsubmx0. Qed. +(*TODO*) +Lemma derivable_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + (forall x, derivable f x v) -> derivable (fun x => lsubmx (f x)) t v. +Proof. +move=> /= => df1. +apply/derivable_mxP => i j/=. +rewrite (ord1 i). +have /cvg_ex[/= l Hl]:= df1 t. +apply/cvg_ex => /=; exists (l``_(lshift n2 j)). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, lshift n2 j)). +by rewrite !mxE. +Qed. + +Lemma derive_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + (forall x, derivable f x v) -> + 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1 _ ('D_v f t). +Proof. +move=> df1; apply/matrixP => i j; rewrite !mxE /=. +rewrite derive_mx ?mxE//=; last exact: derivable_lsubmx. +rewrite derive_mx ?mxE//=; congr ('D_v _ t). +by apply/funext => x; rewrite !mxE. +Qed. +(*DONE*) +Lemma differentiable_lsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : + differentiable (@lsubmx R 1 n1 n2) t. +Proof. +have lin_lsubmx : linear (@lsubmx R 1 n1 n2). + move=> a b c. + by rewrite linearD//= linearZ. +pose build_lin_lsubmx := GRing.isLinear.Build _ _ _ _ _ lin_lsubmx. +pose Lsubmx : {linear 'rV[R^o]_(n1 + n2) -> 'rV[R^o]_n1} := + HB.pack (@lsubmx R _ _ _) build_lin_lsubmx. +apply: (@linear_differentiable _ _ _ Lsubmx). +move=> /= u A /=. +move/nbhs_ballP=> [e /= e0 eA]. +apply/nbhs_ballP; exists e => //= v [? uv]. +apply: eA; split => //. +(* TODO: lemma *) +move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. +apply: (le_lt_trans _ (uv i (lshift n2 j))). +by rewrite !mxE. +Qed. + +(*Global Instance is_diff_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f df : V -> 'rV[R]_(n1 + n2)) t : + is_diff t f df -> + is_diff t (fun x => lsubmx (f x)) (fun x => lsubmx (df x)). +Proof. +case=> diff_f dfE. +apply: DiffDef. + by apply: differentiable_comp => //; exact: differentiable_lsubmx0. +apply/funext => v. +rewrite -dfE. +rewrite -[LHS]deriveE; last first. + by apply: differentiable_comp => //; exact: differentiable_lsubmx0. +rewrite -[in RHS]deriveE; last first. + by []. +rewrite derive_lsubmx//. +Abort.*) +(*DONE*) +Lemma differentiable_lsubmx {R : realFieldType} (V : normedModType R) {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t : + (forall x, differentiable f x) -> + differentiable (fun x => lsubmx (f x)) t. +Proof. +move=> /= => df1. +apply: differentiable_comp => //. +exact: differentiable_lsubmx0. +Qed. + +(*Lemma derivable_row_mx {R : realFieldType} {n1 n2 : nat} + (f : R -> 'rV[R]_n1) (g : R -> 'rV[R]_n2) t v : + (forall x, derivable f x v) -> (forall x, derivable g x v) -> + derivable (fun x : R => row_mx (f x) (g x)) t v. +Proof. +move=> /= fv gv; apply/derivable_mxP => i j. +rewrite (ord1 i)/=. +have /cvg_ex[/= l Hl]:= fv t. +have /cvg_ex[/= k Hk]:= gv t. +apply/cvg_ex => /=; exists (row_mx l k)``_j. +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0) Hl. +move/cvgrPdist_le : Hk => /(_ _ e0) Hk. +move: Hl Hk; apply: filterS2 => x Hl Hk. +rewrite !mxE. +case: fintype.splitP => j1 jj1. + apply: le_trans Hl. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE. + apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, j1)). + by rewrite !mxE/=. +apply: le_trans Hk. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, j1)). +by rewrite !mxE/=. +Qed.*) + +(* used in derive_along_derive*) +(*TODO*) +Lemma derivable_scalar_mx {R : realFieldType} n (f : 'rV[R]_n -> R) + (a : 'rV[R]_n) v : + derivable f a v -> + derivable (@scalar_mx _ 1 \o f) a v. +Proof. +move=> /cvg_ex[/= l fav]. +apply/cvg_ex => /=. +exists (\col_(i < 1) l). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : fav => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leLHS]/Num.Def.normr/= !mx_normrE/=. +apply: bigmax_le => //= -[i j] _. +rewrite !mxE/=. +by rewrite !ord1 eqxx !mulr1n. +Qed. + +(* not used? *) +(*Lemma derive_row_mx {R : realFieldType} {n1 n2 : nat} + (f : R -> 'rV[R]_n1) (g : R -> 'rV[R]_n2) t v : + (forall x : R, derivable f x v) -> + (forall x : R, derivable g x v) -> + 'D_v (fun x => row_mx (f x) (g x)) t = row_mx ('D_v f t) ('D_v g t). +Proof. +move=> fv gv. +apply/matrixP => i j. +rewrite derive_mx ?mxE//=; last first. + by apply: derivable_row_mx; [exact: fv|exact: gv]. +do 2 rewrite derive_mx ?mxE//=. +case: fintype.split_ordP => /= j1 jj1; rewrite !mxE; congr ('D_v _ t). + apply/funext => x; rewrite !mxE. + case: fintype.split_ordP => k jE. + congr (f x i _). + move: jE. + by rewrite jj1 => /(congr1 val) => /= /val_inj. + move: jE. + rewrite jj1 => /(congr1 val)/=. + have /[swap] -> := ltn_ord j1. + by rewrite ltnNge/= leq_addr. +apply/funext => x; rewrite !mxE. +case: fintype.split_ordP => k jE. + move: jE. + rewrite jj1 => /(congr1 val)/=. + have /[swap] <- := ltn_ord k. + by rewrite ltnNge/= leq_addr. +congr (g x i _). +move: jE. +rewrite jj1 => /(congr1 val) => /= /eqP. +by rewrite eqn_add2l => /eqP /val_inj. +Qed.*) diff --git a/tilt_mathcomp.v b/tilt_mathcomp.v index ab32f357..3eeca902 100644 --- a/tilt_mathcomp.v +++ b/tilt_mathcomp.v @@ -24,7 +24,8 @@ by move=> x y x0 y0 /(congr1 (@Num.sqrt R)); rewrite !sqrtr_sqr! ger0_norm. Qed. (* PR to MathComp *) -Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. +(* det_mx22 depend de robot*) +(*Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. Proof. set P := (RHS). apply/polyP => -[|[|[|i]]]; last first. @@ -43,4 +44,4 @@ apply/polyP => -[|[|[|i]]]; last first. by rewrite /P -addrA addrCA !coefD coefN coefCM coefX/= mulr1 coefC/= addr0 coefXn addr0. - rewrite char_poly_det sqrrN expr1n mul1r. by rewrite /P !coefD coefC/= coefN coefCM coefX mulr0 subr0 coefXn/= add0r. -Qed. +Qed.*) diff --git a/tilt_robot.v b/tilt_robot.v index df763470..e57c4da4 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -3,7 +3,7 @@ From mathcomp Require Import all_ssreflect all_algebra ring. From mathcomp Require Import interval_inference. From mathcomp Require Import boolp classical_sets functions reals. From mathcomp Require Import topology normedtype derive. -Require Import ssr_ext euclidean rigid frame skew derive_matrix. +Require Import ssr_ext euclidean rigid frame skew derive_matrix tilt_analysis. Set Implicit Arguments. Unset Strict Implicit. @@ -114,7 +114,7 @@ Proof. by rewrite dotmulBl dotmulC dotmulspin1 dotmulC dotmulspin2 subr0. Qed. Lemma norm_squared {R : rcfType} n (u : 'rV[R]_n) : (u *m (u)^T) 0 0 = norm u ^+2. Proof. by rewrite -dotmulvv /dotmul. Qed. - + (* TODO in tilt_analysis.v *) Lemma derivable_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t v : (forall x, derivable f x v) -> derivable (fun x => rsubmx (f x)) t v. @@ -241,7 +241,7 @@ apply: (le_lt_trans _ (uv i (lshift n2 j))). by rewrite !mxE. Qed. -Global Instance is_diff_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} +(*Global Instance is_diff_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} (f df : V -> 'rV[R]_(n1 + n2)) t : is_diff t f df -> is_diff t (fun x => lsubmx (f x)) (fun x => lsubmx (df x)). @@ -256,7 +256,7 @@ rewrite -[LHS]deriveE; last first. rewrite -[in RHS]deriveE; last first. by []. rewrite derive_lsubmx//. -Abort. +Abort.*) Lemma differentiable_lsubmx {R : realFieldType} (V : normedModType R) {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t : @@ -329,20 +329,77 @@ rewrite jj1 => /(congr1 val) => /= /eqP. by rewrite eqn_add2l => /eqP /val_inj. Qed. -Lemma derivable_scalar_mx {R : realFieldType} n (f : 'rV[R]_n -> R) - (a : 'rV[R]_n) v : - derivable f a v -> - derivable (@scalar_mx _ 1 \o f) a v. + +Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. Proof. -move=> /cvg_ex[/= l fav]. -apply/cvg_ex => /=. -exists (\col_(i < 1) l). -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : fav => /(_ _ e0). -apply: filterS => x. -apply: le_trans. -rewrite [in leLHS]/Num.Def.normr/= !mx_normrE/=. -apply: bigmax_le => //= -[i j] _. -rewrite !mxE/=. -by rewrite !ord1 eqxx !mulr1n. +set P := (RHS). +apply/polyP => -[|[|[|i]]]; last first. +- have := (rwP (leq_sizeP (char_poly M) i.+3)).2. + rewrite size_char_poly => /(_ erefl) /(_ i.+3) => ->//. + rewrite (rwP (leq_sizeP P i.+3)).2//. + rewrite /P -addrA size_addl ?size_polyXn//. + rewrite -mulNr size_MXaddC; case: ifPn => // _. + by rewrite ltnS -polyCN size_polyC; case: (_ == _). +- rewrite /P -[in RHS]addrA [RHS]coefD coefXn/= coefD -mulrN coefCM coefC/= coefN coefX/= oppr0 mulr0 !addr0. + rewrite /char_poly det_mx22//. + rewrite /char_poly_mx !mxE/= mulr1n mulr0n sub0r mulNr opprK sub0r mulrN. + rewrite coefD coefN coefCM coefC/= mulr0 subr0. + by rewrite coefM sum3E !coefE/= !(subr0,mul0r,mulr0,addr0,mulr1,add0r). +- rewrite char_poly_trace//. + by rewrite /P -addrA addrCA !coefD coefN coefCM coefX/= mulr1 coefC/= addr0 coefXn addr0. +- rewrite char_poly_det sqrrN expr1n mul1r. + by rewrite /P !coefD coefC/= coefN coefCM coefX mulr0 subr0 coefXn/= add0r. +Qed. + +Lemma differentiable_norm {K : realType} m n (f : 'rV[K]_m -> 'rV_n) + (g : K -> 'rV[K]_m) t : + differentiable f (g t) -> f (g t) != 0 -> + differentiable (fun x => norm (f x)) (g t) . +Proof. +move=> fgt fgt0; rewrite /norm -fctE. +apply: differentiable_comp. + exact: differentiable_dotmul. +apply/derivable1_diffP/derivable_sqrt. +by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0. +Qed. + +Lemma derivable_norm_squared {K : realType} n (f : K -> 'rV[K]_n) (x0 : K) : + derivable f x0 1 -> + derivable (fun x => norm (f x) ^+ 2) x0 1. +Proof. +move => dif1. +apply/diff_derivable. +rewrite /=. +under eq_fun do rewrite -dotmulvv dotmulE. +have -> : (fun x : K => \sum_k (f x)``_k * (f x)``_k) = + \sum_k (fun x => (f x)``_k * (f x)``_k ). + apply/funext => x => //=. + by rewrite fct_sumE. +apply/differentiable_sum => k => //=. +apply/differentiableM => //=. + apply/derivable1_diffP. + by apply/derivable_coord => //. +apply/derivable1_diffP. +by apply/derivable_coord => //. +Qed. + +Lemma derive_norm_squared {K : realType} n (u : K -> 'rV[K]_n) (t : K) : + derivable u t 1 -> + 'D_1 (fun x => norm (u x) ^+ 2) t = + 2 * ('D_1 u t *m (u t)^T)``_0. +Proof. +move=> ut1. +under eq_fun do rewrite -dotmulvv. +rewrite dotmulP mxE /= mulr1n derive_dotmul// dotmulC. +by field. +Qed. + +Lemma differentiable_norm_squared {R : rcfType} m n + (f : 'rV[R]_m -> 'rV[R]_n) (v : 'rV[R]_m) : + differentiable f v -> + differentiable (fun x => norm (f x) ^+ 2) v. +Proof. +move=> dif1. +under eq_fun do rewrite -dotmulvv. +exact: differentiable_dotmul. Qed. From d6060bef8bf6d89c4869584b129ca3098373bc27 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 4 Dec 2025 23:45:21 +0900 Subject: [PATCH 066/144] minor renaming --- tilt.v | 305 +++++++++++++++++++++++++++++++-------------------------- 1 file changed, 168 insertions(+), 137 deletions(-) diff --git a/tilt.v b/tilt.v index 7ed98ad3..b0f0febd 100644 --- a/tilt.v +++ b/tilt.v @@ -254,20 +254,17 @@ Section locdef. Context {R : realType} {T : normedModType R}. Implicit Types V : T -> R. -Definition locposdef V (D : set T) (x : T) := +Definition is_Lyapunov_candidate V (D : set T) (x : T) := x \in D /\ V x = 0 /\ forall z, z \in D -> z != x -> V z > 0. +(* TODO: useful? mettre dans un fichier wip.v? *) Definition locnegdef V (x : T) := V x = 0 /\ \forall z \near x^', V z < 0. -(* locally positive semi definite *) -(* NB: not used yet *) -Definition locposemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z >= 0. - +(* TODO: useful? mettre dans un fichier wip.v? *) (* locally negative semidefinite *) Definition locnegsemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z <= 0. End locdef. -Notation is_Lyapunov_candidate := locposdef. (* derivation along the trajectory h *) Definition derive_along {R : realType} {n : nat} @@ -377,102 +374,130 @@ Definition derive_along_partial {R : realType} n (V : 'rV[R]_n -> R) (a : R -> 'rV[R]_n) (t : R) : R := \sum_(i < n) (partial V (a t) i * ('D_1 a t) ``_ i). -Section ode_equation. +Section ode. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : (K -> T) -> K -> T. -Definition is_sol (x : K -> T) (A : set T) := - [/\ x 0 \in A, (forall t, derivable x t 1) +Definition is_sol (Init : set T) (x : K -> T) := + [/\ x 0 \in Init, (forall t, derivable x t 1) & forall t, 'D_1 x t = phi x t]. +End ode. + +Section is_sol. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : (K -> T) -> K -> T. Lemma is_sol_subset y0 (A B : set T) (AB : A `<=` B) : - is_sol y0 A -> is_sol y0 B. + is_sol phi A y0 -> is_sol phi B y0. Proof. rewrite /is_sol inE => -[inD0 deriv tilt]; rewrite inE. by split; [exact: AB|exact: deriv|exact: tilt]. Qed. -Definition state_space A := - [set p : T | exists y, is_sol y A /\ exists t, p = y t ]. +End is_sol. + +Section state_space. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : (K -> T) -> K -> T. + +Definition state_space (Init : set T) := + [set x | exists f, is_sol phi Init f /\ exists t, x = f t ]. + +End state_space. + +Section equilibrium_point. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : (K -> T) -> K -> T. +Variable Init : set T. + +Definition is_equilibrium_point (x : T) := is_sol phi Init (cst x). + +End equilibrium_point. -Definition is_equilibrium_point x := is_sol (cst x). +Section equilibrium_point. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : (K -> T) -> K -> T. Lemma is_equilibrium_point_subset x (A B : set T) (AB : A `<=` B) : - is_equilibrium_point x A -> is_equilibrium_point x B. + is_equilibrium_point phi A x -> is_equilibrium_point phi B x. Proof. rewrite /is_equilibrium_point /is_sol inE => -[inD0 deriv tilt]. by rewrite inE; split; [exact: AB|exact: deriv|exact: tilt]. Qed. -Definition equilibrium_points A := [set p : T | is_equilibrium_point p A ]. +Definition equilibrium_points Init := + [set p : T | is_equilibrium_point phi Init p ]. -Definition equilibrium_is_stable_at - (A : set T) (x : T) (z : K -> 'rV[K]_n) := - forall eps, eps > 0 -> - exists2 d, d > 0 & - (`| z 0 - x | < d -> forall t, t >= 0 -> `| z t - x | < eps). +End equilibrium_point. -Definition equilibrium_is_asymptotically_stable_at - (A : set T) (x : T) (z : K -> 'rV[K]_n) : Prop := - exists2 d, d > 0 & - (`| z 0 - x | < d -> z t @[t --> +oo] --> x). +Section stability. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. -End ode_equation. +Definition is_stable_at (x : T) (z : K -> 'rV[K]_n) := + forall eps, eps > 0 -> exists2 d, d > 0 & + `| z 0 - x | < d -> forall t, t >= 0 -> `| z t - x | < eps. -Definition existence_uniqueness {K : realType} {n} (D : set 'rV[K]_n) - (f : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) - (sol : 'rV[K]_n -> K -> 'rV[K]_n) := - forall y, y 0 \in D -> is_sol f y D <-> sol (y 0) = y. +Definition is_asymptotically_stable_at (x : T) (z : K -> 'rV[K]_n) : Prop := + exists2 d, d > 0 & `| z 0 - x | < d -> z t @[t --> +oo] --> x. + +End stability. + +Definition existence_uniqueness {K : realType} {n} + (phi : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) (Init : set 'rV[K]_n) + (sol : 'rV[K]_n -> K -> 'rV[K]_n) := + forall y, y 0 \in Init -> is_sol phi Init y <-> sol (y 0) = y. Definition initial_condition {K : realType} {n} (sol : 'rV[K]_n -> K -> 'rV[K]_n) := - forall p, sol p 0 = p. + forall x0, sol x0 0 = x0. Section solutions_unique. Context {K : realType} {n : nat}. -Variable D : set 'rV[K]_n. -Variable f : (K -> 'rV[K]_n) -> K -> 'rV[K]_n. +Variable phi : (K -> 'rV[K]_n) -> K -> 'rV[K]_n. +Variable Init : set 'rV[K]_n. -Definition solutions_unique := forall (a b : K -> 'rV_n) (x0 : 'rV_n), - is_sol f a D -> - is_sol f b D -> - a 0 = x0 -> b 0 = x0 -> - a = b. +Definition solutions_unique := forall (f g : K -> 'rV_n) (x0 : 'rV_n), + is_sol phi Init f -> + is_sol phi Init g -> + f 0 = x0 -> g 0 = x0 -> + f = g. End solutions_unique. -Lemma existence_uniqueness_unique {K : realType} {n} (D : set 'rV[K]_n) - (f : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) - (sol : 'rV[K]_n -> K -> 'rV[K]_n) : - existence_uniqueness D f sol -> solutions_unique D f. +Section solutions_unique_lemmas. +Context {K : realType} {n : nat}. +Variables (phi : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) (Init : set 'rV[K]_n). + +Lemma existence_uniqueness_unique (sol : 'rV[K]_n -> K -> 'rV[K]_n) : + existence_uniqueness phi Init sol -> solutions_unique phi Init. Proof. -move=> solP. -move => a b x0. -move => fad fbd a0 b0. +move=> solP f g x0 solf solg f0 g0. apply/funext => x. -case : (fad) => //=. +case : (solf) => //=. move => a0D Da fa. have := solP _ a0D. case. -move => /(_ fad). +move => /(_ solf). move => a0a _. -case : (fbd) => //=. +case : (solg) => //=. move => b0D Db fb. have := solP _ b0D. case. -move => /(_ fbd). +move => /(_ solg). move => b0b _. -rewrite -b0b -a0a. -by rewrite a0 b0. +by rewrite -b0b -a0a f0 g0. Qed. -Lemma existence_uniqueness_exists {K : realType} {n} (D : set 'rV[K]_n) - (f : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) - (sol : 'rV[K]_n -> K -> 'rV[K]_n) : - existence_uniqueness D f sol -> initial_condition sol -> - forall p, p \in D -> is_sol f (sol p) D. +Lemma existence_uniqueness_exists (sol : 'rV[K]_n -> K -> 'rV[K]_n) : + existence_uniqueness phi Init sol -> initial_condition sol -> + forall p, p \in Init -> is_sol phi Init (sol p). Proof. move=> solP sol0 p pD. have H := solP (sol p). @@ -481,14 +506,19 @@ apply H. by rewrite sol0. Qed. +End solutions_unique_lemmas. + Section sphere. Context {K : realType} {n : nat}. -Definition sphere r := [set x : 'rV[K]_n.+1 | `|x| = r]. +Definition sphere r := [set x : 'rV[K]_n | `|x| = r]. -Lemma sphere_nonempty r : 0 < r -> sphere r !=set0. +Lemma sphere_nonempty r : n != 0 -> 0 < r -> sphere r !=set0. Proof. -move=> r_gt0; exists (const_mx r). +move=> n0. +move=> r_gt0. +rewrite /sphere. +exists (const_mx r). rewrite /sphere /= /normr/=. (* TODO: need lemma? *) rewrite mx_normrE/=. @@ -498,6 +528,7 @@ apply/eqP; rewrite eq_le; apply/andP; split. by move=> i _; rewrite mxE gtr0_norm. under eq_bigr do rewrite mxE gtr0_norm//. apply/le_bigmax => /=. +destruct n as [|n'] => //. exact: (ord0, ord0). Qed. @@ -522,7 +553,7 @@ apply: bounded_closed_compact. by apply/orP; left. clear v vr i. by near: M; apply: nbhs_pinfty_gt; rewrite num_real. -pose d := fun x : 'rV[K]_n.+1 => `|x| : K. +pose d := fun x : 'rV[K]_n => `|x| : K. have contd : continuous d by move=> /= z; exact: norm_continuous. rewrite [X in closed X](_ : _ = d @^-1` [set r]); last first. by apply/seteqP; split. @@ -533,57 +564,58 @@ End sphere. Section Lyapunov_stability. Context {K : realType} {n : nat}. -Variable D : set 'rV[K]_n.+1 (* TODO: n+1 -> n *). -Variable f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. -Variable sol : 'rV[K]_n.+1 -> K -> 'rV[K]_n.+1. -Hypothesis openD : open D. (* D est forcement un ouvert *) -(* see Cohen Rouhling ITP 2017 Sect 3.2 *) -Hypothesis solP : existence_uniqueness D f sol. +Let m := n.+1. +Variable phi : (K -> 'rV[K]_m) -> K -> 'rV[K]_m. +Variable Init : set 'rV[K]_m. +Variable sol : 'rV[K]_m -> K -> 'rV[K]_m. Hypothesis sol0 : initial_condition sol. +Hypothesis solP : existence_uniqueness phi Init sol. +Hypothesis openD : open Init. (* D est forcement un ouvert *) +(* see Cohen Rouhling ITP 2017 Sect 3.2 *) -Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. +Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_m) r. Let BE r : 0 < r -> B r = closed_ball 0 r. Proof. by move=> r0; rewrite /B -closed_ballE. Qed. -Variable V : 'rV[K]_n.+1 -> K. -Hypothesis V'le_0 : forall x, x \in D -> +Variable V : 'rV[K]_m -> K. +Hypothesis Vdiff : forall t : 'rV[K]_m, differentiable V t. +Hypothesis V'_le0 : forall x, x \in Init -> forall t, t >= 0 -> 'D~(sol, x) V t <= 0. -Hypothesis Vderiv : forall t : 'rV[K]_n.+1, differentiable V t. Let V_nincr a b : 0 <= a <= b -> - forall x, x \in D -> V (sol x b) <= V (sol x a). + forall x, x \in Init -> V (sol x b) <= V (sol x a). Proof. move=> /andP[a_ge0 ab] x xD. apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. - move=> y yb. apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. rewrite -derivable1_diffP. - by have [] : is_sol f (sol x) D by apply solP; rewrite sol0. + by have [] : is_sol phi Init (sol x) by apply solP; rewrite sol0. - move=> y yb. rewrite derive1E -derive_along_derive//. - + apply: V'le_0 => //. + + apply: V'_le0 => //. by move : yb; rewrite in_itv/= => /andP[/ltW]. + rewrite -derivable1_diffP. - by have [] : is_sol f (sol x) D by apply solP; rewrite sol0. + by have [] : is_sol phi Init (sol x) by apply solP; rewrite sol0. - apply: continuous_subspaceT => z. apply: continuous_comp; last exact: differentiable_continuous. apply: differentiable_continuous => //. rewrite -derivable1_diffP. - by have [] : is_sol f (sol x) D by apply solP; rewrite sol0. + by have [] : is_sol phi Init (sol x) by apply solP; rewrite sol0. - by rewrite !in_itv/= lexx (le_trans a_ge0). - by rewrite in_itv/= ab andbT. Qed. (* khalil theorem 4.1 *) (* TODO: generalize to x != 0 *) -Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) - (VDx : is_Lyapunov_candidate V D x) : - is_equilibrium_point f x D -> - equilibrium_is_stable_at D x (sol x). +Theorem Lyapunov_stability (x : 'rV[K]_m := 0) : + is_Lyapunov_candidate V Init x -> + is_equilibrium_point phi Init x -> + is_stable_at x (sol x). Proof. -move=> eq /= eps eps0. +move=> VDx eq /= eps eps0/=. move: VDx => [/= xD [Vx0 DxV]]. -have [r [r_gt0 [r_eps BrD]]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` D. +have [r [r_gt0 [r_eps BrD]]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` Init. move: xD; rewrite inE => /(open_subball openD)[r0/= r0_gt0] q. pose r := Num.min (r0 / 2) eps. have r_gt0 : 0 < r by rewrite /r lt_min eps0 divr_gt0. @@ -593,12 +625,14 @@ have [r [r_gt0 [r_eps BrD]]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` D. rewrite /ball/= sub0r normrN gtr0_norm//. by rewrite /r gt_min ltr_pdivrMr// ltr_pMr// ltr1n. by move: Brv; rewrite BE ?divr_gt0//; exact: subset_closure_half. -have alpha_min : {x : 'rV[K]_n.+1 | x \in sphere r /\ +have alpha_min : {x : 'rV[K]_m | x \in sphere r /\ forall y, y \in sphere r -> V x <= V y}. have : {within sphere r, continuous V}. apply: continuous_subspaceT => /= v. - by apply/differentiable_continuous; exact/Vderiv. - move/(EVT_min_rV (sphere_nonempty r_gt0) (@compact_sphere _ _ r)). + by apply/differentiable_continuous; exact/Vdiff. + move/(EVT_min_rV (sphere_nonempty _ r_gt0) (@compact_sphere _ _ r)). + have m0 : m != 0 by []. + move=> /(_ m0). by move=> /cid2[c sphere_r_c sphere_r_V]; exists c. pose alpha := V (sval alpha_min). have alpha_gt0 : 0 < alpha. @@ -613,7 +647,7 @@ have alpha_gt0 : 0 < alpha. by have [+ _] := svalP alpha_min; rewrite inE. have [beta /andP[beta_gt0 beta_alpha]] : exists beta, 0 < beta < alpha. by exists (alpha / 2); rewrite divr_gt0//= ltr_pdivrMr//= ltr_pMr// ltr1n. -set Omega_beta := [set x : 'rV[K]_n.+1 | B r x /\ V x <= beta]. +set Omega_beta := [set x : 'rV[K]_m | B r x /\ V x <= beta]. have Omega_beta_Br : Omega_beta `<=` (B r)°. move=> y [Bry Vybeta]. rewrite BE// interior_closed_ballE => //=. @@ -626,12 +660,12 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta phi : is_sol f phi D -> - phi 0 \in Omega_beta -> forall t, 0 <= t -> phi t \in Omega_beta. +have Df_Omega_beta h : is_sol phi Init h -> + h 0 \in Omega_beta -> forall t, 0 <= t -> h t \in Omega_beta. move=> sol_phi phi_Omega. have /= V_nincr_consequence : forall t, 0 <= t -> forall u, 0 <= u <= t -> - 'D~(sol, phi 0) V u <= 0 -> - V (sol (phi 0) t) <= V (sol (phi 0) 0) <= beta. + 'D~(sol, h 0) V u <= 0 -> + V (sol (h 0) t) <= V (sol (h 0) 0) <= beta. move=> /= t1 t10 u ut1 Vle0. apply/andP; split. move : phi_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. @@ -639,37 +673,37 @@ have Df_Omega_beta phi : is_sol f phi D -> by rewrite sol0; move: phi_Omega; rewrite inE => -[]. move=> t t0. rewrite inE; split; last first. - have : 'D~(sol, phi 0) V t <= 0. - by apply: V'le_0 => //; case: sol_phi. + have : 'D~(sol, h 0) V t <= 0. + by apply: V'_le0 => //; case: sol_phi. move/V_nincr_consequence => /(_ t). rewrite lexx t0/= => /(_ isT isT). - have -> : sol (phi 0) = phi by apply solP => //; case: sol_phi. + have -> : sol (h 0) = h by apply solP => //; case: sol_phi. by case/andP; exact: le_trans. move: phi_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. rewrite !sub0r !normrN => -[phi0r Vphi0beta]. rewrite leNgt; apply/negP => phi_t_r. - have [t1 [t1_ge0 phit1r]] : exists t0, t0 >= 0 /\ `|phi t0| = r. - have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o phi)}. + have [t1 [t1_ge0 phit1r]] : exists t0, t0 >= 0 /\ `|h t0| = r. + have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o h)}. apply: continuous_subspaceT => /= y. apply: continuous_comp; last exact: norm_continuous. apply: differentiable_continuous => //. case : (sol_phi) => _ + _ => /(_ y). by rewrite derivable1_diffP. - have : min `|phi 0| `|phi t| <= r <= max `|phi 0| `|phi t|. + have : min `|h 0| `|h t| <= r <= max `|h 0| `|h t|. by rewrite ge_min phi0r/= le_max (ltW phi_t_r) orbT. move=> /(IVT t0 norm_phi_cont)[c cI norm_phi_c]. by exists c; split => //; move/itvP: cI => ->. - have alphaVphit1 : alpha <= V (phi t1). + have alphaVphit1 : alpha <= V (h t1). rewrite {alpha_gt0 beta_alpha} /alpha; case: alpha_min => /=. by move=> y [_ +]; apply; rewrite inE. - have : beta < V (phi t1). + have : beta < V (h t1). by rewrite (lt_le_trans _ alphaVphit1)//; case/andP : beta_alpha. apply/negP; rewrite -leNgt. have := V_nincr_consequence t1 t1_ge0 t1. rewrite lexx t1_ge0 => /(_ isT). - have : 'D~(sol, phi 0) V t1 <= 0 by apply: V'le_0 => //; case: sol_phi. + have : 'D~(sol, h 0) V t1 <= 0 by apply: V'_le0 => //; case: sol_phi. move=> /[swap] /[apply]. - have -> : sol (phi 0) = phi. + have -> : sol (h 0) = h. apply solP => //;rewrite inE; apply: BrD => //. by rewrite /B /closed_ball_/= sub0r normrN. by move=> /andP[]; exact: le_trans. @@ -690,7 +724,7 @@ have [d0 d0_gt0 Vbeta] : exists2 d, d > 0 & forall x, `|x| <= d -> V x < beta. have [d d_gt0 xdV] : exists2 d : K, 0 < d & forall y, `|y - x| < d -> `|V y - V x| < beta. have /cvgrPdist_lt /(_ _ beta_gt0) : V x @[x --> nbhs x] --> V x. - exact/differentiable_continuous/Vderiv. + exact/differentiable_continuous/Vdiff. rewrite nearE /= => /nbhs_ballP[d /= d_pos xdV]. exists d => // y. move: xdV; rewrite mx_norm_ball /ball_ /= distrC => /[apply]. @@ -724,7 +758,7 @@ rewrite /B /closed_ball_/= sub0r normrN => solx0r. have : (B r)° (sol x t0). apply: Omega_beta_Br; apply/set_mem. apply: Df_Omega_beta => //. - by have [] : is_sol f (sol x) D by apply solP; rewrite sol0. + by have [] : is_sol phi Init (sol x) by apply solP; rewrite sol0. rewrite inE; split; first by rewrite /B /closed_ball_/= sub0r normrN. have : B delta (sol x 0). by rewrite /closed_ball_; apply: ltW; rewrite sub0r normrN. @@ -1252,7 +1286,7 @@ Qed. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). -Lemma equilibrium_point1 : is_equilibrium_point tilt_eqn point1 state_space_tilt. +Lemma equilibrium_point1 : is_equilibrium_point tilt_eqn state_space_tilt point1. Proof. split => //=. - rewrite inE /state_space_tilt /point1. @@ -1271,7 +1305,7 @@ split => //=. by move => n; rewrite n scaler0 mul0mx. Qed. -Lemma equilibrium_point2 : is_equilibrium_point tilt_eqn point2 state_space_tilt. +Lemma equilibrium_point2 : is_equilibrium_point tilt_eqn state_space_tilt point2. Proof. split => //. - rewrite inE /state_space_tilt /point2 /=. @@ -1386,14 +1420,7 @@ Definition V1 (zp1_z2 : 'rV[K]_6) : K := Lemma V1_is_Lyapunov_candidate : is_Lyapunov_candidate V1 [set: 'rV_6] point1. Proof. -rewrite /locposdef. (*; split; last first. - rewrite /V1. - apply/differentiableD => //; last first. - apply/differentiableM => //; apply/differentiable_norm_squared => //=. - exact/differentiable_rsubmx. - apply/differentiableM => //; apply/differentiable_norm_squared => //=. - exact/differentiable_lsubmx.*) -rewrite /V1 /point1 /locposdef; split; first by rewrite inE. +rewrite /V1 /point1; split; first by rewrite inE. split. by rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. move=> /= z_near _ z0. @@ -1465,7 +1492,7 @@ Hypothesis gamma_gt0 : 0 < gamma. Variable R : K -> 'M[K]_3. Lemma derive_zp1 (z : K) (sol : K -> 'rV_6) : - is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> 'D_1 (Left \o sol) z = - alpha1 *: Left (sol z). Proof. move=> [/= traj0 dtraj]. @@ -1474,7 +1501,7 @@ by rewrite row_mxKl => ?; rewrite derive_lsubmx//=. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. @@ -1483,7 +1510,7 @@ by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx. Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : - is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> state_space_tilt (sol t). Proof. case => sol0 dsol deriv_sol. @@ -1494,7 +1521,7 @@ Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : - is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> norm u = 1. + is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> norm u = 1. Proof. move=> dtraj. suff: state_space_tilt (row_mx (zp1 z) (z2 z)). @@ -1505,7 +1532,7 @@ Qed. Lemma angvel_sqr (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : - is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt traj -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> dtraj. @@ -1527,7 +1554,7 @@ by rewrite 2!mulNmx mulmx1 mxE. Qed. Lemma neg_spin (traj : K -> 'rV_6) (z : K) : - is_sol (tilt_eqn alpha1 gamma) traj state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt traj -> norm (Right (traj z) *m \S('e_2) *m - \S('e_2 - Right (traj z))) = norm (Right (traj z) *m \S('e_2)). Proof. @@ -1553,7 +1580,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + c2 *: (2 *: 'D_1 z2 z *m (Right (sol z))^T) 0 0. @@ -1578,7 +1605,7 @@ by rewrite mulmxA. Qed. Lemma derive_along_V1 (x : 'rV[K]_6) t sol : - is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> (forall t, differentiable (sol x) t) -> 'D~(sol, x) (V1 alpha1 gamma) t = V1dot (sol x t). Proof. @@ -1610,7 +1637,7 @@ Definition u1 (sol : K -> 'rV_6) t \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 t), 1 |-> norm w] i. Lemma V1dot_ub (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol (tilt_eqn alpha1 gamma) sol state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> forall t, V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. @@ -1644,7 +1671,7 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> sol x 0 = point1 -> \forall z \near 0^', ('D~(sol, x) (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) + @@ -1689,7 +1716,7 @@ Unshelve. all: try by end_near. Qed. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> sol x 0 = point1 -> locnegsemidef ('D~(sol, x) (V1 alpha1 gamma)) 0. Proof. @@ -1726,7 +1753,7 @@ Abort. Lemma locnegdef_derive_along_V1 sol (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> (forall t : K, state_space_tilt (sol x t)) -> sol x 0 = point1 -> locnegdef ('D~(sol, x) (V1 alpha1 gamma)) 0. @@ -1798,7 +1825,7 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn alpha1 gamma) (sol x) state_space_tilt -> + is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> (forall t, differentiable (sol x) t) -> forall t : K, 0 <= t -> 'D~(sol, x) (V1 alpha1 gamma) t <= 0. @@ -1833,36 +1860,40 @@ Context {K : realType}. Variables gamma alpha1 : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Variable D : set 'rV[K]_6. +Let phi := tilt_eqn alpha1 gamma. +Variable Init : set 'rV[K]_6. Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. -Hypothesis solP : existence_uniqueness D (tilt_eqn alpha1 gamma) sol. +Hypothesis solP : existence_uniqueness phi Init sol. Hypothesis sol0 : initial_condition sol. -Hypothesis y0 : 0 \in D. -Hypothesis y_sol : is_sol (tilt_eqn alpha1 gamma) (sol 0) D. +Hypothesis y0 : 0 \in Init. + +Notation is_sol := (is_sol phi Init). + +Hypothesis y_sol : is_sol (sol 0). Hypothesis y00 : sol 0 0 = 0. Lemma is_equilibrium_subset : - (is_equilibrium_point (tilt_eqn alpha1 gamma)) 0 state_space_tilt -> - (is_equilibrium_point (tilt_eqn alpha1 gamma)) 0 D. + is_equilibrium_point phi state_space_tilt 0 -> + is_equilibrium_point phi Init 0. Proof. -rewrite /is_equilibrium_point /is_sol inE => -[inD0 deriv tilt]. -by rewrite inE; split => //; exact/set_mem. +rewrite /is_equilibrium_point. +rewrite /is_sol/= inE => -[inD0 deriv tilt]. +by split => //; exact/set_mem. Qed. -Lemma equilibrium_zero_stable (openD : open D) (D0 : 0 \in D) - (D_in_state : D `<=` state_space_tilt) : - equilibrium_is_stable_at D point1 (sol 0). +Lemma equilibrium_zero_stable (openD : open Init) (D0 : 0 \in Init) + (D_in_state : Init `<=` state_space_tilt) : + is_stable_at point1 (sol 0). Proof. -apply: (@Lyapunov_stability K 5 D (tilt_eqn alpha1 gamma) - sol openD solP _ (V1 alpha1 gamma)). +apply: (@Lyapunov_stability K 5 phi Init sol openD solP _ (V1 alpha1 gamma)). - assumption. - move=> z zD t t0; apply: derive_along_V1_le0; [by []|by []| | |]. + apply: (is_sol_subset D_in_state). by apply solP; rewrite sol0. + move=> t1. rewrite -derivable1_diffP. - have : is_sol (tilt_eqn alpha1 gamma) (sol z) D by apply solP; rewrite sol0. + have : is_sol (sol z) by apply solP; rewrite sol0. by case. + by []. - move=> t. From 4a6bc54776f15cf50cc56d648b6bb0207f15a97f Mon Sep 17 00:00:00 2001 From: yosakaon Date: Fri, 5 Dec 2025 16:28:17 +0100 Subject: [PATCH 067/144] minor cleaning --- derive_matrix.v | 30 +++---- differential_kinematics.v | 10 +-- tilt.v | 174 +++++++++++++++++++++----------------- tilt_robot.v | 4 +- 4 files changed, 113 insertions(+), 105 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index 384e1e82..419549d7 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -694,16 +694,20 @@ End cross_product_matrix. (* [sciavicco] p.80-81 *) Section derivative_of_a_rotation_matrix. Context {R : realFieldType}. -Variable M : R -> 'M[R^o]_3. +Variable M : R -> 'M[R]_3. Definition ang_vel_mx t : 'M_3 := (M t)^T * 'D_1 M t. Definition body_ang_vel_mx t : 'M_3 := 'D_1 M t *m (M t)^T. -(* angular velocity (a free vector) *) -Definition ang_vel t := unspin (ang_vel_mx t). - Hypothesis MO : forall t, M t \is 'O[ R ]_3. + +(* [sciavicco] eqn 3.7 *) +Lemma derive1mx_ang_vel t : 'D_1 M t = M t * ang_vel_mx t. +Proof. +by rewrite /ang_vel_mx mulrA -mulmxE orthogonal_mul_tr// mul1mx. +Qed. + Hypothesis derivable_M : forall t, derivable M t 1. Lemma ang_vel_mx_is_so t : ang_vel_mx t \is 'so[ R ]_3. @@ -717,23 +721,13 @@ move=> /eqP; rewrite addr_eq0 => /eqP H. by rewrite antiE /ang_vel_mx trmx_mul trmxK H opprK. Qed. +(* angular velocity (a free vector) *) +Definition ang_vel t := unspin (ang_vel_mx t). + Lemma ang_vel_mxE t : ang_vel_mx t = \S( ang_vel t). Proof. by rewrite /ang_vel unspinK // ang_vel_mx_is_so. Qed. -(* [sciavicco] eqn 3.7 *) -Lemma derive1mx_ang_vel t : 'D_1 M t = M t * ang_vel_mx t. -Proof. -move: (ang_vel_mx_is_so t); rewrite antiE -subr_eq0 opprK => /eqP. -rewrite {1 2}/ang_vel_mx trmx_mul trmxK => /(congr1 (fun x => (M t) * x)). -rewrite mulr0 mulrDr !mulrA -{1}(orthogonal_inv (MO t)). -rewrite divrr ?orthogonal_unit // mul1r. -move=> /eqP; rewrite addr_eq0 => /eqP {1}->. -rewrite -mulrA -mulrN -mulrA; congr (_ * _). -move: (ang_vel_mx_is_so t); rewrite antiE -/(ang_vel_mx t) => /eqP ->. -by rewrite /ang_vel_mx trmx_mul trmxK mulmxE. -Qed. - -Lemma derive1mx_rot (p' : 'rV[R^o]_3 (* constant vector *)) : +Lemma derive1mx_rot (p' : 'rV[R]_3 (* constant vector *)) : let p := fun t => p' *m M t in forall t, 'D_1 p t = ang_vel t *v p t. Proof. diff --git a/differential_kinematics.v b/differential_kinematics.v index b7266426..ed2f6586 100644 --- a/differential_kinematics.v +++ b/differential_kinematics.v @@ -565,16 +565,12 @@ move/(_ t). rewrite derive_mulmx; last 2 first. exact/derivable_mxP/derivable_mx_FromTo'. exact/derivable_mxP/derivable_mx_FromTo. -rewrite derive1mx_ang_vel; last 2 first. +rewrite derive1mx_ang_vel; last first. by move=> t'; rewrite FromTo_is_O. - by move=> t'; apply/derivable_mxP/derivable_mx_FromTo. -rewrite derive1mx_ang_vel; last 2 first. +rewrite derive1mx_ang_vel; last first. by move=> t'; rewrite FromTo_is_O. - by move=> t'; apply/derivable_mxP/derivable_mx_FromTo'. -rewrite derive1mx_ang_vel; last 2 first. +rewrite derive1mx_ang_vel; last first. by move=> t'; rewrite FromTo_is_O. - move=> t'; apply/derivable_mxP. - by apply/derivable_mx_FromTo. rewrite ang_vel_mxE; last 2 first. by move=> t'; rewrite FromTo_is_O. move=> t'; apply/derivable_mxP. diff --git a/tilt.v b/tilt.v index b0f0febd..31c6f9fa 100644 --- a/tilt.v +++ b/tilt.v @@ -25,7 +25,7 @@ Require Import tilt_mathcomp tilt_analysis tilt_robot. (* ``` *) (* *) (* Reference: *) -(* - [1] *) +(* - [benallegue2023itac] *) (* https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) (* - [2]: Hassan K. Khalil, Nonlinear systems, 2002*) (******************************************************************************) @@ -228,8 +228,8 @@ rewrite mulmxE sqrspin. by rewrite [in RHS]mxE [in RHS]mxE /= -mulNrn mxE -mulNrn. Qed. -Definition posdefmx {R : realType} m (M : 'M[R]_m) : Prop := - M \is sym m R /\ forall a, eigenvalue M a -> a > 0. +Definition posdefmx {K : realType} m (M : 'M[K]_m) : Prop := + M \is sym m K /\ forall a, eigenvalue M a -> a > 0. (*From mathcomp Require Import spectral. From mathcomp Require Import complex.*) @@ -564,22 +564,21 @@ End sphere. Section Lyapunov_stability. Context {K : realType} {n : nat}. -Let m := n.+1. -Variable phi : (K -> 'rV[K]_m) -> K -> 'rV[K]_m. -Variable Init : set 'rV[K]_m. -Variable sol : 'rV[K]_m -> K -> 'rV[K]_m. +Variable phi : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. +Variable Init : set 'rV[K]_n.+1. +Variable sol : 'rV[K]_n.+1 -> K -> 'rV[K]_n.+1. Hypothesis sol0 : initial_condition sol. Hypothesis solP : existence_uniqueness phi Init sol. Hypothesis openD : open Init. (* D est forcement un ouvert *) (* see Cohen Rouhling ITP 2017 Sect 3.2 *) -Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_m) r. +Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. Let BE r : 0 < r -> B r = closed_ball 0 r. Proof. by move=> r0; rewrite /B -closed_ballE. Qed. -Variable V : 'rV[K]_m -> K. -Hypothesis Vdiff : forall t : 'rV[K]_m, differentiable V t. +Variable V : 'rV[K]_n.+1 -> K. +Hypothesis Vdiff : forall t : 'rV[K]_n.+1, differentiable V t. Hypothesis V'_le0 : forall x, x \in Init -> forall t, t >= 0 -> 'D~(sol, x) V t <= 0. @@ -608,7 +607,7 @@ apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. Qed. (* khalil theorem 4.1 *) (* TODO: generalize to x != 0 *) -Theorem Lyapunov_stability (x : 'rV[K]_m := 0) : +Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) : is_Lyapunov_candidate V Init x -> is_equilibrium_point phi Init x -> is_stable_at x (sol x). @@ -625,13 +624,13 @@ have [r [r_gt0 [r_eps BrD]]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` Init. rewrite /ball/= sub0r normrN gtr0_norm//. by rewrite /r gt_min ltr_pdivrMr// ltr_pMr// ltr1n. by move: Brv; rewrite BE ?divr_gt0//; exact: subset_closure_half. -have alpha_min : {x : 'rV[K]_m | x \in sphere r /\ +have alpha_min : {x : 'rV[K]_n.+1 | x \in sphere r /\ forall y, y \in sphere r -> V x <= V y}. have : {within sphere r, continuous V}. apply: continuous_subspaceT => /= v. by apply/differentiable_continuous; exact/Vdiff. move/(EVT_min_rV (sphere_nonempty _ r_gt0) (@compact_sphere _ _ r)). - have m0 : m != 0 by []. + have m0 : n.+1 != 0 by []. move=> /(_ m0). by move=> /cid2[c sphere_r_c sphere_r_V]; exists c. pose alpha := V (sval alpha_min). @@ -647,7 +646,7 @@ have alpha_gt0 : 0 < alpha. by have [+ _] := svalP alpha_min; rewrite inE. have [beta /andP[beta_gt0 beta_alpha]] : exists beta, 0 < beta < alpha. by exists (alpha / 2); rewrite divr_gt0//= ltr_pdivrMr//= ltr_pMr// ltr1n. -set Omega_beta := [set x : 'rV[K]_m | B r x /\ V x <= beta]. +set Omega_beta := [set x : 'rV[K]_n.+1 | B r x /\ V x <= beta]. have Omega_beta_Br : Omega_beta `<=` (B r)°. move=> y [Bry Vybeta]. rewrite BE// interior_closed_ballE => //=. @@ -836,25 +835,22 @@ Local Notation Right := (@rsubmx _ 1 3 3). Section ya. (* mesure de l'accelerometre *) Variable K : realType. -Variable v : K -> 'rV[K]_3. (* local frame of the sensor *) -Variable R : K -> 'M[K]_3. (*L -> W*) +Variable R : K -> 'M[K]_3. (* L/W *) Variable g0 : K. (*standard gravity constant*) Let w t := ang_vel R t. (* local frame of the sensor (gyroscope) *) -Let x1 t := v t. (* local frame *) Definition x2 t : 'rV_3 := 'e_2 *m R t. -Definition y_a t := - x1 t *m \S( w t) + 'D_1 x1 t + g0 *: x2 t. (* world frame *) +Definition y_a x t := - x t *m \S(w t) + 'D_1 x t + g0 *: x2 t. (* world frame *) Variable p : K -> 'rV[K]_3. -Let v1 := fun t : K => 'D_1 p t *m R t. -Definition y_a1 t := - v1 t *m \S(w t) + 'D_1 v1 t + g0 *: x2 t. +Let v := fun t : K => 'D_1 p t *m R t. Hypothesis RisSO : forall t, R t \is 'SO[K]_3. Lemma y_aE t (derivableR : forall t, derivable R t 1) (derivablep : forall t, derivable p t 1) (derivableDp : forall t, derivable ('D_1 p) t 1) : - ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t= y_a1 t . + ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t = y_a v t. Proof. rewrite mulmxDl. -rewrite /y_a1/= /v1 /= /x2. +rewrite /y_a/= /= /x2. congr +%R; last by rewrite scalemxAl. rewrite -ang_vel_mxE/=; last 2 first. move=> t0. @@ -877,7 +873,8 @@ End ya. Definition S2 {K : realType} := [set x : 'rV[K]_3 | norm x = 1]. -Section problem_statementA. +(* section III.A of [benallegue2023itac] *) +Section state_dynamics. Variable K : realType. Variable g0 : K. Variable R : K -> 'M[K]_3. @@ -909,15 +906,14 @@ rewrite -ang_vel_mxE; last 2 first. admit. rewrite -mulmxA. rewrite mulmxE. -rewrite -derive1mx_ang_vel; last 2 first. - admit. +rewrite -derive1mx_ang_vel; last first. admit. by []. Abort. -(* eqn 10 *) -Notation y_a := (y_a v R g0). -Lemma derive_x1 t : 'D_1 x1 t = x1 t *m \S(w t) + y_a t - g0 *: x2 t. +(* eqn (10/11): we write x_1 * S(w) whereas it is - S(w) * x_1 in [benallegue2023itac] *) +Notation y_a := (y_a R g0). +Lemma derive_x1 t : 'D_1 x1 t = x1 t *m \S(w t) + y_a x1 t - g0 *: x2 t. Proof. rewrite /y_a/= -addrA addrK. rewrite /x1. @@ -925,7 +921,7 @@ rewrite addrCA addrA mulNmx /= /w. by rewrite (addrC(-_)) subrr add0r. Qed. - (* eqn 11b *) + (* eqn (11b): x_2 * S(w) instead of - S(w) * x_2 in [benallegue2023itac] *) Lemma derive_x2 (t : K) : x2_dot t = x2 t *m \S( w t ). Proof. rewrite /w. @@ -939,18 +935,17 @@ have ->: 'D_1 (fun t0 : K => 'e_2 *m (R t0)) t = move => n /=. rewrite derive_mulmx//=. by rewrite derive_cst mul0mx add0r. -rewrite derive1mx_ang_vel /=; last 2 first. +rewrite derive1mx_ang_vel /=; last first. by move=> ?; rewrite rotation_sub. - by []. by rewrite mulmxA. Qed. -End problem_statementA. +End state_dynamics. -Section problem_statementB. -Variable K : realType. -Variable gamma : K. -Variable alpha1 : K. +(* section III.A in [benallegue2023itac] *) +Section two_steps_first_order_estimator. +Context {K : realType}. +Variables gamma alpha1 : K. Variable v : K -> 'rV[K]_3. Variable R : K -> 'M[K]_3. Hypothesis derivableR : forall t, derivable R t 1. @@ -960,13 +955,16 @@ Hypothesis derivable_x1_hat : forall t, derivable x1_hat t 1. Variable x2_hat : K -> 'rV[K]_3. Variable g0 : K. Hypotheses g0_eq0 : g0 != 0. -Notation y_a := (y_a v R g0). -Let x1 t := v t . -Let x2'_hat t := -(alpha1 / g0) *: (x1 t - x1_hat t). (* 12b*) +Notation y_a := (y_a R g0 v). +Let x1 t := v t. +Let x2'_hat t := - (alpha1 / g0) *: (x1 t - x1_hat t). (* eqn (12b) *) +(* we write x^_1 * S(w) instead - S(w) * x^_1 in [benallegue2023itac] *) Hypothesis eqn12a : forall t, - 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'_hat t. + 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'_hat t. (* eqn (12a) *) +(* we write x^_2 * S(...) instead of - S(...) * x^_2 + and + gamma instead of - gamma in [benallegue2023itac] *) Hypothesis eqn12c : forall t, - 'D_1 x2_hat t = x2_hat t *m \S(w t - gamma *: x2'_hat t *m \S(x2_hat t)). + 'D_1 x2_hat t = x2_hat t *m \S(w t + gamma *: x2'_hat t *m \S(x2_hat t)). (* eqn (12c) *) Hypothesis x2_hat_S2 : x2_hat 0 \in S2. Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. Hypothesis v_derivable : forall t, derivable v t 1. @@ -1004,6 +1002,8 @@ Let derivable_error1 t : derivable error1 t 1. Proof. exact: derivableB. Qed. Let derivable_error2 t : derivable error2 t 1. Proof. exact: derivableB. Qed. +(* eqn (13a) *) +(* we write p_1 * S(w) instead of - S(w) * p1 in [benallegue2023itac] *) Lemma derive_error1 t : 'D_1 error1 t = error1 t *m \S(w t) - alpha1 *: error1 t. Proof. @@ -1048,8 +1048,10 @@ transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) by rewrite error1E. Qed. +(* eqn (13b) *) +(* we write x~_2 * S(w) instead of - S(w) * x~_2 in [benallegue2023itac] *) Lemma derive_error2 t : - 'D_1 error2 t = error2 t *m \S(w t) - + 'D_1 error2 t = error2 t *m \S(w t) + gamma *: (error2 t - error1 t) *m \S(x2_hat t) ^+ 2. Proof. rewrite /error2. @@ -1057,17 +1059,23 @@ rewrite [in LHS]deriveB//. rewrite derive_x2//. rewrite -/(x2 t) -/(w t) -/(error2 t). rewrite eqn12c. -rewrite spinD spinN. +rewrite spinD. rewrite -[in LHS]scalemxAl. rewrite (spinZ gamma). -rewrite mulmxBr opprB [LHS]addrA [in LHS]addrC addrA (addrC _ (x2 t *m \S(w t))). +rewrite mulmxDr opprD [LHS]addrA. +rewrite [in LHS]addrC addrA (addrC _ (x2 t *m \S(w t))). +rewrite addrAC. rewrite -mulmxBl -/(error2 t). -congr +%R. -rewrite -scalemxAr -mulNmx -scalerN -[RHS]scalemxAl. +simpl in *. +rewrite -[in RHS]opprB. +rewrite scalerN mulNmx. +congr (_ - _). +rewrite -scalemxAr -[RHS]scalemxAl. congr (_ *: _). rewrite /error2 /error1. -rewrite (opprB _ (x2'_hat t)) -addrA (addrC (x2 t)) addrA. -rewrite subrK opprD opprK mulmxBl. +rewrite opprB addrCA. +rewrite (addrC (x2 t)) addrK. +rewrite mulmxBl. rewrite [X in _ = X + _](_ : _ = 0) ?add0r; last first. rewrite mulmxA. rewrite -(mulmxA(x2_hat t)) sqr_spin //. @@ -1087,7 +1095,8 @@ rewrite /x2 -mulmxA. by rewrite orthogonal_mul_tr ?rotation_sub// mulmx1 subrr. Qed. -Lemma derive_error1_p t : 'D_1 error1_p t = -alpha1 *: error1_p t. +(* eqn (14a) *) +Lemma derive_error1_p t : 'D_1 error1_p t = - alpha1 *: error1_p t. Proof. rewrite /error1. rewrite derive_mulmx//=; last by rewrite derivable_trmx. @@ -1103,10 +1112,12 @@ rewrite -/(w t) -mulmxA -mulmxDr trmx_mul tr_spin. by rewrite mulNmx subrr mulmx0. Qed. -Lemma derive_error2_p t : - 'D_1 error2_p t = - gamma *: (error2_p t - error1_p t) *m - \S('e_2 - error2_p t)^+2. +Definition eqn14b_rhs x1 x2 := gamma *: (x2 - x1) *m \S('e_2 - x2) ^+ 2. + +(* eqn (14b) *) +Lemma derive_error2_p t : 'D_1 error2_p t = eqn14b_rhs (error1_p t) (error2_p t). Proof. +rewrite /eqn14b_rhs. rewrite [LHS]derive_mulmx//=; last by rewrite derivable_trmx. simpl in *. rewrite derive_trmx//. @@ -1114,47 +1125,50 @@ rewrite derive1mx_ang_vel//=; last by move=> ?; rewrite rotation_sub. rewrite !ang_vel_mxE//; last by move=> ?; rewrite rotation_sub. rewrite trmx_mul mulmxA -mulmxDl. rewrite derive_error2 /=. -rewrite addrAC -/(w t) tr_spin mulmxN subrr sub0r. -rewrite -[in LHS]scalemxAl -scaleNr -[in LHS]scalemxAl. -rewrite mulmxN -scalemxAl -[in RHS]scaleNr. -congr (- _ *: _). +rewrite -/(w t) tr_spin mulmxN. +rewrite -!addrA addrC addrA subrK. +rewrite -scalemxAl. +rewrite -!scalemxAl. +congr (_ *: _). rewrite -x2_hatR. rewrite -spin_similarity ?rotationV//. rewrite trmxK. rewrite [in RHS]expr2 -mulmxE !mulmxA. +rewrite -!mulNmx opprB. congr (_ *m _ *m _). rewrite -[in RHS]mulmxA. rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. congr (_ *m _). +rewrite -/(error2 _). rewrite error2E. -rewrite mulmxBl; congr (_ - _)%R. +rewrite mulmxDl. +congr (_ + _)%R. by rewrite /error1 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. Qed. -End problem_statementB. +End two_steps_first_order_estimator. Definition state_space_tilt {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. Section tilt_eqn. -Variable K : realType. -Variable alpha1 : K. -Variable gamma : K. +Context {K : realType}. +Variables alpha1 gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. Definition tilt_eqn (f : K -> 'rV[K]_6) : K ->'rV[K]_6 := let error1_p_dot := Left \o f in - let error2_dot := Right \o f in + let error2_p_dot := Right \o f in fun t => row_mx (- alpha1 *: error1_p_dot t) - (gamma *: (error2_dot t - error1_p_dot t) *m \S('e_2 - error2_dot t) ^+ 2). + (eqn14b_rhs gamma (error1_p_dot t) (error2_p_dot t)). Definition tilt_eqn_no_time (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := let zp1_point := Left zp1_z2_point in let z2_point := Right zp1_z2_point in row_mx (- alpha1 *: zp1_point) - (gamma *: (z2_point - zp1_point) *m \S('e_2%:R - z2_point) ^+ 2). + (eqn14b_rhs gamma zp1_point z2_point). Lemma tilt_eqnE f t : tilt_eqn f t = tilt_eqn_no_time (f t). Proof. by []. Qed. @@ -1298,6 +1312,7 @@ split => //=. rewrite /=. by rewrite lsubmx_const. apply/eqP/rowP; move => i; apply/eqP. + rewrite /eqn14b_rhs. set N := (X in _ *: X *m _); have : N = 0. rewrite /N /=; apply /rowP; move => a. rewrite !mxE. @@ -1325,6 +1340,7 @@ split => //. by rewrite i3k -ltn_subRL subnn. split. by rewrite scaler_eq0 N0 eqxx orbT. + rewrite /eqn14b_rhs. rewrite -scalemxAl scalemx_eq0 gt_eqF//=. rewrite -[Left point2]/N N0 subr0. set M := (X in X *m _); rewrite -/M. @@ -1631,12 +1647,12 @@ rewrite -fctE /= !derive_along_norm_squared//=. - exact/differentiable_rsubmx. Qed. -Definition u1 (sol : K -> 'rV_6) t +Definition u1 (sol : K -> 'rV[K]_6) t (zp1 := Left \o sol) (z2 := Right \o sol) (w := z2 t *m \S('e_2)) : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 t), 1 |-> norm w] i. -Lemma V1dot_ub (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : +Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> forall t, V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. @@ -1744,9 +1760,11 @@ rewrite derive_alongMl; last 2 first. rewrite /= !derivative_derive_along_eq0; last 4 first. exact/differentiable_norm_squared/differentiable_rsubmx. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. + rewrite /eqn14b_rhs. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. exact/differentiable_norm_squared/differentiable_lsubmx. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. + rewrite /eqn14b_rhs. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. by rewrite scaler0 scaler0 add0r. Abort. @@ -1882,26 +1900,26 @@ rewrite /is_sol/= inE => -[inD0 deriv tilt]. by split => //; exact/set_mem. Qed. -Lemma equilibrium_zero_stable (openD : open Init) (D0 : 0 \in Init) - (D_in_state : Init `<=` state_space_tilt) : +Lemma equilibrium_zero_stable : + open Init -> 0 \in Init -> Init `<=` state_space_tilt -> is_stable_at point1 (sol 0). Proof. -apply: (@Lyapunov_stability K 5 phi Init sol openD solP _ (V1 alpha1 gamma)). -- assumption. -- move=> z zD t t0; apply: derive_along_V1_le0; [by []|by []| | |]. - + apply: (is_sol_subset D_in_state). - by apply solP; rewrite sol0. - + move=> t1. - rewrite -derivable1_diffP. - have : is_sol (sol z) by apply solP; rewrite sol0. - by case. - + by []. +move=> openInit Init0 Init_in_state. +apply: (@Lyapunov_stability K _ phi Init sol sol0 solP openInit (V1 alpha1 gamma)). - move=> t. apply/differentiableD => //. apply/differentiableM => //. exact/differentiable_norm_squared/differentiable_lsubmx. apply/differentiableM => //. exact/differentiable_norm_squared/differentiable_rsubmx. +- move=> z zD t t0; apply: derive_along_V1_le0; [by []|by []| | |]. + + apply: (is_sol_subset Init_in_state). + by apply solP; rewrite sol0. + + move=> t1. + rewrite -derivable1_diffP. + have : is_sol (sol z) by apply solP; rewrite sol0. + by case. +- assumption. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. rewrite /is_Lyapunov_candidate /point1 => Hpos. rewrite /V1 lsubmx_const rsubmx_const; split => //. diff --git a/tilt_robot.v b/tilt_robot.v index e57c4da4..4af60f33 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -386,11 +386,11 @@ Qed. Lemma derive_norm_squared {K : realType} n (u : K -> 'rV[K]_n) (t : K) : derivable u t 1 -> 'D_1 (fun x => norm (u x) ^+ 2) t = - 2 * ('D_1 u t *m (u t)^T)``_0. + 2 * ('D_1 u t *d u t). Proof. move=> ut1. under eq_fun do rewrite -dotmulvv. -rewrite dotmulP mxE /= mulr1n derive_dotmul// dotmulC. +rewrite derive_dotmul// dotmulC. by field. Qed. From 0e3552926b1097769837de95778896e47f6573f1 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 24 Jan 2026 17:30:46 +0900 Subject: [PATCH 068/144] trying to use the proved version of picard (wip) --- tilt.v | 598 ++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 380 insertions(+), 218 deletions(-) diff --git a/tilt.v b/tilt.v index 31c6f9fa..345645b3 100644 --- a/tilt.v +++ b/tilt.v @@ -228,25 +228,22 @@ rewrite mulmxE sqrspin. by rewrite [in RHS]mxE [in RHS]mxE /= -mulNrn mxE -mulNrn. Qed. +Section posdefmx. + Definition posdefmx {K : realType} m (M : 'M[K]_m) : Prop := M \is sym m K /\ forall a, eigenvalue M a -> a > 0. -(*From mathcomp Require Import spectral. -From mathcomp Require Import complex.*) +Lemma posdefmxP_direct {R : realType} m (M : 'M[R]_m) : + posdefmx M -> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). +Proof. +Abort. -Lemma posdefmxP {R : realType} m (M : 'M[R]_m) : - posdefmx M <-> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). +Lemma posdefmxP_converse {R : realType} m (M : 'M[R]_m) : + (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0) -> posdefmx M. Proof. -split. -(* rewrite /posdefmx => -[symM eigen_gt0] v v0. -Local Open Scope complex_scope. - pose M' := map_mx (fun r => r%:C) M. - have : M' \is normalmx. - apply: symmetric_normalmx.*) - move => [Msym eigenM] x x_neq0. - apply/eigenM/eigenvalueP. - exists x => //=. -Admitted. +Abort. + +End posdefmx. Local Open Scope classical_set_scope. @@ -272,16 +269,16 @@ Definition derive_along {R : realType} {n : nat} (t : R) : R := (jacobian1 V (f t))^T *d 'D_1 f t. -Notation "''D~(' sol , x ) f" := (derive_along f (sol x)). +Notation "''D~(' sol ) f" := (derive_along f (sol)). Section derive_along. Context {R : realType} {n : nat}. -Variable sol : 'rV[R]_n -> R -> 'rV[R]_n. +Variable sol : R -> 'rV[R]_n. (* sol represents the solutions of a differential equation *) -Lemma derive_along_derive (V : 'rV[R]_n -> R) (x0 : 'rV[R]_n) (t : R) : - differentiable V (sol x0 t) -> differentiable (sol x0) t -> - 'D~(sol, x0) V t = 'D_1 (V \o sol x0) t. +Lemma derive_along_derive (V : 'rV[R]_n -> R) (t : R) : + differentiable V (sol t) -> differentiable (sol) t -> + 'D~(sol) V t = 'D_1 (V \o sol) t. (* Warning: we are not representing the initial state at t = 0 of the trajectory x see Khalil p.114 *) Proof. @@ -308,9 +305,9 @@ under eq_fun do rewrite mxE /= mulr1n /=. exact: differentiable_comp. Qed. -Lemma derive_alongMl (f : 'rV_n -> R) (k : R) (x : 'rV[R]_n) t : - differentiable f (sol x t) -> differentiable (sol x) t -> - 'D~(sol, x) (k *: f) t = k *: 'D~(sol, x) f t. +Lemma derive_alongMl (f : 'rV_n -> R) (k : R) t : + differentiable f (sol t) -> differentiable (sol) t -> + 'D~(sol) (k *: f) t = k *: 'D~(sol) f t. Proof. move=> dfx dpx. rewrite derive_along_derive; last 2 first. @@ -324,10 +321,10 @@ congr (_ *: _). by rewrite derive_along_derive. Qed. -Lemma derive_alongD (f g : 'rV_n -> R) (x : 'rV_n) t : - differentiable f (sol x t) -> differentiable g (sol x t) -> - differentiable (sol x) t -> - 'D~(sol, x) (f + g) t = 'D~(sol, x) f t + 'D~(sol, x) g t. +Lemma derive_alongD (f g : 'rV_n -> R) t : + differentiable f (sol t) -> differentiable g (sol t) -> + differentiable (sol) t -> + 'D~(sol) (f + g) t = 'D~(sol) f t + 'D~(sol) g t. Proof. move=> dfx dgx difp. rewrite derive_along_derive; last 2 first. @@ -344,9 +341,9 @@ rewrite derive_along_derive; [|by []..]. by rewrite derive_along_derive. Qed. -Lemma derivative_derive_along_eq0 (f : 'rV_n -> R) (x : 'rV[R]_n) (t : R) : - differentiable f (sol x t) -> - 'D_1 (sol x) t = 0 -> 'D~(sol, x) f t = 0. +Lemma derivative_derive_along_eq0 (f : 'rV_n -> R) (t : R) : + differentiable f (sol t) -> + 'D_1 (sol) t = 0 -> 'D~(sol) f t = 0. Proof. move=> xt1 dtraj. rewrite /derive_along /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. @@ -354,11 +351,11 @@ by rewrite dtraj mul0mx !mxE. Qed. Lemma derive_along_norm_squared m (f : 'rV[R]_n -> 'rV_m) - (x : 'rV[R]_n) (t : R) : - differentiable f (sol x t) -> - differentiable (sol x) t -> - 'D~(sol, x) (fun y => norm (f y) ^+ 2) t = - (2 *: 'D_1 (f \o sol x) t *m (f (sol x t))^T) 0 0. + (t : R) : + differentiable f (sol t) -> + differentiable (sol) t -> + 'D~(sol) (fun y => norm (f y) ^+ 2) t = + (2 *: 'D_1 (f \o sol) t *m (f (sol t))^T) 0 0. Proof. move=> difff diffphi. rewrite derive_along_derive => //=; last exact: differentiable_norm_squared. @@ -374,27 +371,58 @@ Definition derive_along_partial {R : realType} n (V : 'rV[R]_n -> R) (a : R -> 'rV[R]_n) (t : R) : R := \sum_(i < n) (partial V (a t) i * ('D_1 a t) ``_ i). +From mathcomp Require Import sequences. + +Section picard. +Context {R : realType} {n : nat}. +Notation U := ('rV[R]_n). +Variable u0 : U. +Variable phi : U -> U. + +Variable (r : {posnum R}). +Let B := closed_ball u0 r%:num. + +Definition is_sol_autonomous (t0 t1 : R) (f : R -> U) := + f t0 = u0 /\ + {in `]t0, t1[, forall x, derivable f x 1 /\ f^`() x = phi (f x)} /\ + {within `[t0, t1], continuous f} /\ + {in `[t0, t1], forall t, closed_ball u0 r%:num (f t)}. + +Variables (k : R) . +Hypothesis k0 : 0 < k. +Hypothesis lip2 : k.-lipschitz_B phi. + +Theorem picard_lindeloeff_autonomous t0 : + exists sol delta, + delta > 0 /\ is_sol_autonomous t0 (t0 + delta) sol. +Admitted. + +End picard. + Section ode. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. -Variable phi : (K -> T) -> K -> T. +Variable phi : T -> T. + +Definition is_sol (Init : set T) (Delta : K) (r : {posnum K}) (f : K -> T) := + f 0 \in Init /\ is_sol_autonomous (f 0) phi r 0 Delta f. -Definition is_sol (Init : set T) (x : K -> T) := - [/\ x 0 \in Init, (forall t, derivable x t 1) - & forall t, 'D_1 x t = phi x t]. End ode. Section is_sol. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. -Variable phi : (K -> T) -> K -> T. +Variable phi : T -> T. +Variable r : {posnum K}. +Variable Delta : K. Lemma is_sol_subset y0 (A B : set T) (AB : A `<=` B) : - is_sol phi A y0 -> is_sol phi B y0. + is_sol phi A Delta r y0 -> is_sol phi B Delta r y0. Proof. -rewrite /is_sol inE => -[inD0 deriv tilt]; rewrite inE. -by split; [exact: AB|exact: deriv|exact: tilt]. +rewrite /is_sol inE => -[inD0 [_ [deri [cont cball]]]]; rewrite inE. +split => //. +by apply: AB. Qed. End is_sol. @@ -402,37 +430,44 @@ End is_sol. Section state_space. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. -Variable phi : (K -> T) -> K -> T. +Variable phi : T -> T. +Variable r : {posnum K}. +Variable Delta : K. -Definition state_space (Init : set T) := - [set x | exists f, is_sol phi Init f /\ exists t, x = f t ]. +Definition state_space (Init : set T) (Delta : K) := + [set x | exists f, is_sol phi Init Delta r f /\ exists t, x = f t ]. End state_space. Section equilibrium_point. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. -Variable phi : (K -> T) -> K -> T. +Variable phi : T -> T. (* was (K -> T) -> K -> T *) +Variable r : {posnum K}. Variable Init : set T. +Variable Delta : K. -Definition is_equilibrium_point (x : T) := is_sol phi Init (cst x). +Definition is_equilibrium_point (x : T) := is_sol phi Init Delta r (cst x). End equilibrium_point. Section equilibrium_point. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. -Variable phi : (K -> T) -> K -> T. +Variable phi : T -> T. +Variable r : {posnum K}. +Variable Delta : K. Lemma is_equilibrium_point_subset x (A B : set T) (AB : A `<=` B) : - is_equilibrium_point phi A x -> is_equilibrium_point phi B x. + is_equilibrium_point phi r A Delta x -> is_equilibrium_point phi r B Delta x. Proof. -rewrite /is_equilibrium_point /is_sol inE => -[inD0 deriv tilt]. -by rewrite inE; split; [exact: AB|exact: deriv|exact: tilt]. +rewrite /is_equilibrium_point /is_sol inE => -[inD0 [deriv [cont tilt]]]. +rewrite inE; split => //. +exact: AB. Qed. Definition equilibrium_points Init := - [set p : T | is_equilibrium_point phi Init p ]. + [set p : T | is_equilibrium_point phi r Init Delta p ]. End equilibrium_point. @@ -444,28 +479,35 @@ Definition is_stable_at (x : T) (z : K -> 'rV[K]_n) := forall eps, eps > 0 -> exists2 d, d > 0 & `| z 0 - x | < d -> forall t, t >= 0 -> `| z t - x | < eps. +Definition is_locally_stable_at (x : T) (Delta : K) (z : K -> 'rV[K]_n) := + forall eps, eps > 0 -> exists2 d, d > 0 & + `| z 0 - x | < d -> forall t, 0 <= t < Delta -> `| z t - x | < eps. + Definition is_asymptotically_stable_at (x : T) (z : K -> 'rV[K]_n) : Prop := exists2 d, d > 0 & `| z 0 - x | < d -> z t @[t --> +oo] --> x. End stability. -Definition existence_uniqueness {K : realType} {n} - (phi : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) (Init : set 'rV[K]_n) - (sol : 'rV[K]_n -> K -> 'rV[K]_n) := - forall y, y 0 \in Init -> is_sol phi Init y <-> sol (y 0) = y. +(* f' = phi f *) +(* phi_robot f =def= fun f t => phi t (f t) *) +(*Definition existence_uniqueness {K : realType} {n} + (phi : K -> 'rV[K]_n -> 'rV[K]_n) (Init : set 'rV[K]_n) Delta + (sol : K -> 'rV[K]_n) := + forall y, y 0 \in Init -> is_sol phi Init Delta y <-> sol (y 0) = y. +*) -Definition initial_condition {K : realType} {n} - (sol : 'rV[K]_n -> K -> 'rV[K]_n) := - forall x0, sol x0 0 = x0. +Definition initial_condition {K : realType} {n} (sol : K -> 'rV[K]_n) x0 := + sol 0 = x0. -Section solutions_unique. +(*Section solutions_unique. Context {K : realType} {n : nat}. -Variable phi : (K -> 'rV[K]_n) -> K -> 'rV[K]_n. +Variable phi : K -> 'rV[K]_n -> 'rV[K]_n. Variable Init : set 'rV[K]_n. +Variable Delta : K. Definition solutions_unique := forall (f g : K -> 'rV_n) (x0 : 'rV_n), - is_sol phi Init f -> - is_sol phi Init g -> + is_sol phi Init Delta f -> + is_sol phi Init Delta g -> f 0 = x0 -> g 0 = x0 -> f = g. @@ -473,10 +515,12 @@ End solutions_unique. Section solutions_unique_lemmas. Context {K : realType} {n : nat}. -Variables (phi : (K -> 'rV[K]_n) -> K -> 'rV[K]_n) (Init : set 'rV[K]_n). +Variables (phi : K -> 'rV[K]_n -> 'rV[K]_n) (Init : set 'rV[K]_n). +Variable Delta : K. Lemma existence_uniqueness_unique (sol : 'rV[K]_n -> K -> 'rV[K]_n) : - existence_uniqueness phi Init sol -> solutions_unique phi Init. + existence_uniqueness phi Init Delta sol -> + solutions_unique phi Init Delta. Proof. move=> solP f g x0 solf solg f0 g0. apply/funext => x. @@ -495,9 +539,9 @@ move => b0b _. by rewrite -b0b -a0a f0 g0. Qed. -Lemma existence_uniqueness_exists (sol : 'rV[K]_n -> K -> 'rV[K]_n) : - existence_uniqueness phi Init sol -> initial_condition sol -> - forall p, p \in Init -> is_sol phi Init (sol p). +Lemma existence_uniqueness_exists (sol : K -> 'rV[K]_n) : + existence_uniqueness phi Init Delta sol -> forall p, p \in Init -> + initial_condition sol p -> is_sol phi Init Delta (sol p). Proof. move=> solP sol0 p pD. have H := solP (sol p). @@ -506,7 +550,7 @@ apply H. by rewrite sol0. Qed. -End solutions_unique_lemmas. +End solutions_unique_lemmas.*) Section sphere. Context {K : realType} {n : nat}. @@ -562,55 +606,108 @@ Unshelve. all: by end_near. Qed. End sphere. +Lemma within_continuous_comp_norm {R : realType} {U : normedModType R} a y (f : R -> U) : + a <= y -> + {within `[a, y], continuous fun x => f x} -> + {within `[a, y], continuous fun x => `|f x|}. +Admitted. (* NB: from common.v *) + + Section Lyapunov_stability. Context {K : realType} {n : nat}. -Variable phi : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1. -Variable Init : set 'rV[K]_n.+1. -Variable sol : 'rV[K]_n.+1 -> K -> 'rV[K]_n.+1. -Hypothesis sol0 : initial_condition sol. -Hypothesis solP : existence_uniqueness phi Init sol. +Let U := 'rV[K]_n.+1. +Variable phi : U -> U. +Variable Init : set U. +Variable Delta : K. +Variable sol : U -> K -> U. +Let u0 : U := 0. +Hypothesis Initu0 : u0 \in Init. +Variable r' : {posnum K}. +Hypothesis solP : is_sol_autonomous u0 phi r' 0 Delta (sol u0). + Hypothesis openD : open Init. (* D est forcement un ouvert *) (* see Cohen Rouhling ITP 2017 Sect 3.2 *) Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. -Let BE r : 0 < r -> B r = closed_ball 0 r. +Let BE s : 0 < s -> B s = closed_ball 0 s. Proof. by move=> r0; rewrite /B -closed_ballE. Qed. -Variable V : 'rV[K]_n.+1 -> K. -Hypothesis Vdiff : forall t : 'rV[K]_n.+1, differentiable V t. +Variable V : U -> K. +Hypothesis Vdiff : forall t : U, differentiable V t. Hypothesis V'_le0 : forall x, x \in Init -> - forall t, t >= 0 -> 'D~(sol, x) V t <= 0. + forall t, t >= 0 -> 'D~(sol x) V t <= 0. -Let V_nincr a b : 0 <= a <= b -> - forall x, x \in Init -> V (sol x b) <= V (sol x a). +Let V_nincr a b : b < Delta -> 0 <= a <= b -> + forall x, x \in Init -> is_sol phi Init Delta r' (sol x) -> + V (sol x b) <= V (sol x a). Proof. -move=> /andP[a_ge0 ab] x xD. +move=> bDelta /andP[a_ge0 ab] x /set_mem xD solP'. apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. - move=> y yb. apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. rewrite -derivable1_diffP. - by have [] : is_sol phi Init (sol x) by apply solP; rewrite sol0. + case: solP' => /= h0Init [_ [+ _]]. + move/(_ y) /(_ _) => []. + move: yb. + rewrite inE/=. + apply: subset_itvl. + by rewrite bnd_simp ltW. + by []. - move=> y yb. rewrite derive1E -derive_along_derive//. - + apply: V'_le0 => //. + + apply: (V'_le0 (x := x)). + exact/mem_set. by move : yb; rewrite in_itv/= => /andP[/ltW]. + rewrite -derivable1_diffP. - by have [] : is_sol phi Init (sol x) by apply solP; rewrite sol0. -- apply: continuous_subspaceT => z. - apply: continuous_comp; last exact: differentiable_continuous. - apply: differentiable_continuous => //. - rewrite -derivable1_diffP. - by have [] : is_sol phi Init (sol x) by apply solP; rewrite sol0. + case: solP' => /= h0Init [_ [+ _]]. + move/(_ y) /(_ _) => []. + move: yb. + rewrite inE/=. + apply: subset_itvl. + by rewrite bnd_simp ltW. + by []. +- (* `[0, b] *) + have [b0|] := ltP 0 b; last first. + move=> b0. + have ? : b = 0. + by apply/eqP; rewrite eq_le b0 (le_trans a_ge0)//. + subst b. + rewrite set_itv1. + exact: continuous_subspace1. + apply/continuous_within_itvP => //; split. + + move=> z z0b. + apply: continuous_comp; last exact: differentiable_continuous. + apply: differentiable_continuous => //. + rewrite -derivable1_diffP. + case: solP' => /= h0Init [_ [+ _]]. + move/(_ z) /(_ _) => []. + move: z0b. + rewrite inE/=. + apply: subset_itvl. + by rewrite bnd_simp ltW. + by []. + + case: solP' => solu0u0 [_ [deri [cont _]]]. + (*have := @continuous_within_itvP K 0 b (sol x). TODO: rebase coq robot *) + admit. + + apply: cvg_at_left_filter. + apply: differentiable_continuous => //. + apply: differentiable_comp. + rewrite -derivable1_diffP. + case: solP' => /= h0Init [_ [+ _]]. + move/(_ b) /(_ _) => []. + by rewrite inE/= in_itv/= b0 bDelta. + by []. + by apply: Vdiff. - by rewrite !in_itv/= lexx (le_trans a_ge0). - by rewrite in_itv/= ab andbT. -Qed. +Admitted. -(* khalil theorem 4.1 *) (* TODO: generalize to x != 0 *) +(* khalil theorem 4.1 *) Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) : is_Lyapunov_candidate V Init x -> - is_equilibrium_point phi Init x -> - is_stable_at x (sol x). + is_equilibrium_point phi r' Init Delta x -> + is_locally_stable_at x Delta (sol x). Proof. move=> VDx eq /= eps eps0/=. move: VDx => [/= xD [Vx0 DxV]]. @@ -659,53 +756,62 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta h : is_sol phi Init h -> - h 0 \in Omega_beta -> forall t, 0 <= t -> h t \in Omega_beta. - move=> sol_phi phi_Omega. - have /= V_nincr_consequence : forall t, 0 <= t -> forall u, 0 <= u <= t -> - 'D~(sol, h 0) V u <= 0 -> - V (sol (h 0) t) <= V (sol (h 0) 0) <= beta. - move=> /= t1 t10 u ut1 Vle0. +have Df_Omega_beta : + sol x 0 \in Omega_beta -> forall t, 0 <= t < Delta -> sol x t \in Omega_beta. + move=> phi_Omega. + have /= V_nincr_consequence : forall t, 0 <= t < Delta -> forall u, 0 <= u <= t -> + 'D~(sol x) V u <= 0 -> + V (sol x t) <= V (sol x 0) <= beta. + move=> /= t1 /andP[t10 t1Delta] u ut1 Vle0. apply/andP; split. move : phi_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. - by apply: V_nincr; [rewrite lexx t10|rewrite inE; exact: BrD]. - by rewrite sol0; move: phi_Omega; rewrite inE => -[]. - move=> t t0. + apply: V_nincr. + assumption. + by rewrite lexx t10. + assumption. + split. + apply/mem_set. + by apply: BrD. + move: solP. + by case: solP => ->. + by move: phi_Omega; rewrite inE => -[Brh0 Vh0beta]. + move=> t /andP[t0 tDelta]. rewrite inE; split; last first. - have : 'D~(sol, h 0) V t <= 0. + have : 'D~(sol x) V t <= 0. by apply: V'_le0 => //; case: sol_phi. - move/V_nincr_consequence => /(_ t). - rewrite lexx t0/= => /(_ isT isT). - have -> : sol (h 0) = h by apply solP => //; case: sol_phi. - by case/andP; exact: le_trans. + have := @V_nincr_consequence t. + rewrite t0 /= tDelta => /(_ isT t). + rewrite lexx t0/= => /(_ isT). + move=> /[apply]. + by move=> /andP[/le_trans] => /[apply]. move: phi_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. rewrite !sub0r !normrN => -[phi0r Vphi0beta]. rewrite leNgt; apply/negP => phi_t_r. - have [t1 [t1_ge0 phit1r]] : exists t0, t0 >= 0 /\ `|h t0| = r. - have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o h)}. - apply: continuous_subspaceT => /= y. - apply: continuous_comp; last exact: norm_continuous. - apply: differentiable_continuous => //. - case : (sol_phi) => _ + _ => /(_ y). - by rewrite derivable1_diffP. - have : min `|h 0| `|h t| <= r <= max `|h 0| `|h t|. + have [t1 [/andP[t1_ge0 t1t] phit1r]] : exists t0, 0 <= t0 <= t/\ `|sol x t0| = r. + have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o sol x)}. + (* `[0, t] *) + apply: within_continuous_comp_norm => //. + case: solP => _ [_ [+ _]]. + apply: continuous_subspaceW. + apply: subset_itvl. + by rewrite bnd_simp ltW. + have : min `|sol x 0| `|sol x t| <= r <= max `|sol x 0| `|sol x t|. by rewrite ge_min phi0r/= le_max (ltW phi_t_r) orbT. move=> /(IVT t0 norm_phi_cont)[c cI norm_phi_c]. by exists c; split => //; move/itvP: cI => ->. - have alphaVphit1 : alpha <= V (h t1). + have alphaVphit1 : alpha <= V (sol x t1). rewrite {alpha_gt0 beta_alpha} /alpha; case: alpha_min => /=. by move=> y [_ +]; apply; rewrite inE. - have : beta < V (h t1). + have : beta < V (sol x t1). by rewrite (lt_le_trans _ alphaVphit1)//; case/andP : beta_alpha. apply/negP; rewrite -leNgt. - have := V_nincr_consequence t1 t1_ge0 t1. - rewrite lexx t1_ge0 => /(_ isT). - have : 'D~(sol, h 0) V t1 <= 0 by apply: V'_le0 => //; case: sol_phi. + have := @V_nincr_consequence t1. + rewrite t1_ge0 (le_lt_trans t1t tDelta) => /(_ isT). + move=> /(_ t1). + rewrite t1_ge0 lexx => /(_ isT). + have : 'D~(sol x) V t1 <= 0 by apply: V'_le0 => //; case: sol_phi. move=> /[swap] /[apply]. - have -> : sol (h 0) = h. - apply solP => //;rewrite inE; apply: BrD => //. - by rewrite /B /closed_ball_/= sub0r normrN. - by move=> /andP[]; exact: le_trans. + by move=> /andP[/le_trans] => /[apply]. have _ : compact Omega_beta. apply: bounded_closed_compact; rewrite /Omega_beta. - rewrite /bounded_set /= /globally. @@ -757,7 +863,6 @@ rewrite /B /closed_ball_/= sub0r normrN => solx0r. have : (B r)° (sol x t0). apply: Omega_beta_Br; apply/set_mem. apply: Df_Omega_beta => //. - by have [] : is_sol phi Init (sol x) by apply solP; rewrite sol0. rewrite inE; split; first by rewrite /B /closed_ball_/= sub0r normrN. have : B delta (sol x 0). by rewrite /closed_ball_; apply: ltW; rewrite sub0r normrN. @@ -1157,7 +1262,7 @@ Variables alpha1 gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Definition tilt_eqn (f : K -> 'rV[K]_6) : K ->'rV[K]_6 := +Definition tilt_eqn (f : K -> 'rV[K]_6) : K -> 'rV[K]_6 := let error1_p_dot := Left \o f in let error2_p_dot := Right \o f in fun t => row_mx @@ -1170,9 +1275,20 @@ Definition tilt_eqn_no_time (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := row_mx (- alpha1 *: zp1_point) (eqn14b_rhs gamma zp1_point z2_point). +Definition tilt_eqn' (x : 'rV[K]_6) : 'rV[K]_6 := + let zp1_point := Left x in + let z2_point := Right x in + row_mx (- alpha1 *: zp1_point) + (eqn14b_rhs gamma zp1_point z2_point). + +Lemma tilt_eqn'E (f : K -> 'rV[K]_6) t : + tilt_eqn' (f t) = tilt_eqn f t. +Proof. by []. Qed. + Lemma tilt_eqnE f t : tilt_eqn f t = tilt_eqn_no_time (f t). Proof. by []. Qed. +(* TODO: this does not hold, we need locally lipschitz *) Lemma tilt_eqn_no_time_lipschitz : exists k, k.-lipschitz_setT tilt_eqn_no_time. Proof. near (pinfty_nbhs K) => k. @@ -1207,8 +1323,8 @@ apply: (@le_trans _ _ (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: x0 a b|)); last first. Abort. -Lemma invariant_state_space_tilt p - (p33 : state_space tilt_eqn state_space_tilt p) : +(*Lemma invariant_state_space_tilt p + (p33 : state_space tilt_eqn' state_space_tilt p) : let y := sval (cid p33) in let t := sval (cid (svalP (cid p33)).2) in forall Delta, Delta >= 0 -> @@ -1220,27 +1336,32 @@ exists x0; split. by case: sol_y. case: cid => //= y' y'sol. case: cid => t'/= pt'. -Abort. +Abort.*) -Lemma state_space_tiltS : - state_space tilt_eqn state_space_tilt `<=` state_space_tilt. +Variable (r : {posnum K}). + +Lemma state_space_tiltS Delta : + state_space (tilt_eqn') r state_space_tilt Delta `<=` state_space_tilt. Proof. -- move=> p [y [[y0_init1]] deri y33 ] [t ->]. +- move=> p [y [[y0_init1]] [deri [cont cball]]]. rewrite /state_space_tilt. - have : derive1 (fun t=> ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. + have : derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). apply/funext => x. rewrite !derive1E. rewrite derive_mx; last first. - by auto. + apply: deri. + admit. rewrite /dotmul. under eq_fun do rewrite dotmulP /=. rewrite dotmulP. rewrite !mxE /= mulr1n. under eq_fun do rewrite !mxE /= mulr1n. rewrite !derive_dotmul/=; last 2 first. - by apply: derivableB => //=; exact : derivable_rsubmx => //=. - by apply: derivableB => //=; exact: derivable_rsubmx => //=. + apply: derivableB => //=; apply : derivable_rsubmx => //=. + admit. + apply: derivableB => //=; apply: derivable_rsubmx => //=. + admit. rewrite /dotmul /=. rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. @@ -1248,19 +1369,23 @@ Proof. have -> : 'D_1 (fun x2 : K => 'e_2 - Right (y x2)) x = - Right ('D_1 y x). rewrite deriveB /= ; last 2 first. exact: derivable_cst. - exact: derivable_rsubmx. + apply: derivable_rsubmx. + admit. rewrite derive_cst /= sub0r; congr (- _). - exact: derive_rsubmx. + apply: derive_rsubmx. + admit. rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. apply/matrixP => a b; rewrite !mxE. - by rewrite derive_mx//= ?mxE. + rewrite derive_mx//= ?mxE//. + admit. ring. have Rsu t0 : Right (y^`()%classic t0) = (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). rewrite derive1E. rewrite y33. by rewrite row_mxKr. + admit. apply/funext => t0. rewrite /dotmul. transitivity (-2 * (gamma *: (Right (y t0) - @@ -1281,6 +1406,7 @@ Proof. apply/derivable_norm_squared => //=. apply/derivableB => //=. apply/derivable_rsubmx => //. + admit. by rewrite -derive1E h. rewrite /=. move/is_derive_0_is_cst. @@ -1295,18 +1421,19 @@ Proof. move: y0_init1. rewrite inE /state_space_tilt /= => ->. by rewrite expr2 mulr1. -Qed. +Admitted. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). -Lemma equilibrium_point1 : is_equilibrium_point tilt_eqn state_space_tilt point1. +Lemma equilibrium_point1 Delta : + is_equilibrium_point (tilt_eqn') state_space_tilt Delta point1. Proof. split => //=. - rewrite inE /state_space_tilt /point1. rewrite /=. by rewrite rsubmx_const /= subr0 normeE. -- move=> t ; rewrite derive_cst /tilt_eqn /point1; apply/eqP. +- move=> t tDelta; rewrite derive_cst /tilt_eqn /point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. rewrite /=. @@ -1320,7 +1447,8 @@ split => //=. by move => n; rewrite n scaler0 mul0mx. Qed. -Lemma equilibrium_point2 : is_equilibrium_point tilt_eqn state_space_tilt point2. +Lemma equilibrium_point2 Delta : + is_equilibrium_point (tilt_eqn') state_space_tilt Delta point2. Proof. split => //. - rewrite inE /state_space_tilt /point2 /=. @@ -1329,7 +1457,7 @@ split => //. rewrite -scalerBl normZ normeE mulr1 distrC. rewrite [X in _ - X](_:1 = 1%:R) //. by rewrite -natrB //= normr1. -- move => t. rewrite derive_cst; apply/eqP. +- move => t tDelta. rewrite derive_cst; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). have N0 : N = 0. @@ -1420,6 +1548,39 @@ rewrite char_poly_fact hornerM !hornerXsubC. by rewrite mulf_eq0 => /orP[|]; rewrite subr_eq0 => /eqP ->; rewrite divr_gt0. Qed. +Lemma u2_quadratic_form_gt0 (v : 'rV_2) : + v != 0 -> 0 < (v *m u2 *m v^T) 0 0. +Proof. +move=> v0. +rewrite !(mxE,sum2E,mulr1)/= !mulrDl -!expr2. +rewrite [ltRHS](_ : _ = v``_0 ^+ 2 - v``_1 * v``_0 + v``_1 ^+ 2); last first. + rewrite -!addrA; congr +%R. + rewrite !addrA; congr +%R. + rewrite (mulrC _ v``_0) -mulrA -mulrDr. + rewrite mulrC -mulNr; congr *%R. + rewrite mulrC -mulrDr -mulr2n. + rewrite mulNr; congr (- _). + rewrite -(mulr_natl v``_1). + by rewrite mulrA mulVf// ?mul1r. +rewrite [ltRHS](_ : _ = (v``_0 - 2^-1 * v``_1) ^+ 2 + 3 / 4 * v``_1 ^+ 2); last first. + rewrite sqrrB -!addrA; congr +%R. + rewrite -mulNrn mulrCA -(mulr_natl (- _) 2) mulrN !mulrA divff ?mul1r//. + rewrite mulrC; congr +%R. + rewrite -mulrA -expr2 exprMn -mulrDl. + rewrite (expr2 2^-1). + rewrite -invfM -div1r -natrM -mulrDl. + by rewrite nat1r divff// mul1r. +rewrite ltNge le_eqVlt negb_or -leNgt addr_ge0 ?(sqr_ge0,mulr_ge0)// andbT. +rewrite paddr_eq0 ?(sqr_ge0,mulr_ge0)//. +apply/negP => /andP[]; rewrite sqrf_eq0 => /[swap]. +rewrite mulf_eq0/= sqrf_eq0 mulf_eq0 invr_eq0 !pnatr_eq0/= => /eqP v10. +rewrite v10 mulr0 subr0 => /eqP v00. +move/negP : v0; apply. +apply/eqP/rowP => -[[i|[j|//]]]; rewrite !mxE//. +by rewrite (_ : Ordinal _ = 0)//; exact/val_inj. +by rewrite (_ : Ordinal _ = 1)//; exact/val_inj. +Qed. + End u2. Section V1. @@ -1505,39 +1666,40 @@ Variable alpha1 : K. Variable gamma : K. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. -Variable R : K -> 'M[K]_3. +(*Variable R : K -> 'M[K]_3.*) +Variable Delta : K. Lemma derive_zp1 (z : K) (sol : K -> 'rV_6) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> 'D_1 (Left \o sol) z = - alpha1 *: Left (sol z). Proof. move=> [/= traj0 dtraj]. -move=> /(_ z)/(congr1 Left). +(*move=> /(_ z)/(congr1 Left). by rewrite row_mxKl => ?; rewrite derive_lsubmx//=. -Qed. +Qed.*) Admitted. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. move=> [/= traj0 dtraj]. -by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx. -Qed. +(*by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx. +Qed.*) Admitted. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> state_space_tilt (sol t). Proof. case => sol0 dsol deriv_sol. apply: (@state_space_tiltS _ alpha1 gamma) => //=. exists sol; split => //. -by exists t. -Qed. +(*by exists t. +Qed.*) Admitted. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> norm u = 1. + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> norm u = 1. Proof. move=> dtraj. suff: state_space_tilt (row_mx (zp1 z) (z2 z)). @@ -1548,7 +1710,7 @@ Qed. Lemma angvel_sqr (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt traj -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta traj -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> dtraj. @@ -1570,7 +1732,7 @@ by rewrite 2!mulNmx mulmx1 mxE. Qed. Lemma neg_spin (traj : K -> 'rV_6) (z : K) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt traj -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta traj -> norm (Right (traj z) *m \S('e_2) *m - \S('e_2 - Right (traj z))) = norm (Right (traj z) *m \S('e_2)). Proof. @@ -1596,7 +1758,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + c2 *: (2 *: 'D_1 z2 z *m (Right (sol z))^T) 0 0. @@ -1621,9 +1783,9 @@ by rewrite mulmxA. Qed. Lemma derive_along_V1 (x : 'rV[K]_6) t sol : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> (forall t, differentiable (sol x) t) -> - 'D~(sol, x) (V1 alpha1 gamma) t = V1dot (sol x t). + 'D~(sol x(*, x*)) (V1 alpha1 gamma) t = V1dot (sol x t). Proof. rewrite /tilt_eqn => tilt_eqnx dif1. rewrite /V1 derive_alongD; last 3 first. @@ -1653,7 +1815,7 @@ Definition u1 (sol : K -> 'rV[K]_6) t \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 t), 1 |-> norm w] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt sol -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> forall t, V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. @@ -1687,11 +1849,11 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> sol x 0 = point1 -> \forall z \near 0^', - ('D~(sol, x) (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) + - 'D~(sol, x) (fun x => norm (Right x) ^+ 2 / (2 * gamma))) z <= 0. + ('D~(sol x) (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) + + 'D~(sol x) (fun x => norm (Right x) ^+ 2 / (2 * gamma))) z <= 0. Proof. move=> dtraj traj0. rewrite fctE !invfM /=. @@ -1700,11 +1862,13 @@ under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. move: dtraj => [H0 Hderiv Htilt]. have Hz_derivable : derivable (sol x) z 1. - by apply: Hderiv. + apply: Hderiv. + admit. rewrite derive_alongMl; last 2 first. exact/differentiable_norm_squared/differentiable_lsubmx. apply derivable1_diffP. - exact: Hderiv. + apply: Hderiv. + admit. rewrite derive_alongMl; last 2 first. exact/differentiable_norm_squared/differentiable_rsubmx. exact/derivable1_diffP. @@ -1721,20 +1885,16 @@ pose u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). exact: V1dot_ub. -have := @posdefmxu2 K. -rewrite posdefmxP => def. have [->|H] := eqVneq u1 0. by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. -have Hpos := def u1 H. -rewrite -oppr_ge0 -oppr_le0 opprK ltW//. -by rewrite -oppr_gt0 mulNmx !mulNmx mxE opprK Hpos. -Unshelve. all: try by end_near. Qed. +by rewrite leNgt 2!mulNmx mxE oppr_gt0 -leNgt ltW// u2_quadratic_form_gt0. +Unshelve. all: try by end_near. Admitted. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> sol x 0 = point1 -> - locnegsemidef ('D~(sol, x) (V1 alpha1 gamma)) 0. + locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. move=> [y033] dy dtraj traj0. rewrite /locnegsemidef /V1. @@ -1743,38 +1903,39 @@ rewrite derive_alongD /=; last 3 first. exact/differentiable_norm_squared/differentiable_lsubmx. apply: differentiableM; last exact: differentiable_cst. exact/differentiable_norm_squared/differentiable_rsubmx. - exact/derivable1_diffP. + apply/derivable1_diffP. + admit. split; last first. near=> z. - rewrite derive_along_derive //; last exact/derivable1_diffP. + rewrite derive_along_derive //; last first. + apply/derivable1_diffP. + admit. admit. (* TODO: lynda *) admit. (* TODO: lynda *) under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. rewrite derive_alongMl; last 2 first. exact/differentiable_norm_squared/differentiable_lsubmx. - exact/derivable1_diffP. -rewrite derive_alongMl; last 2 first. - exact/differentiable_norm_squared/differentiable_rsubmx. - exact/derivable1_diffP. -rewrite /= !derivative_derive_along_eq0; last 4 first. - exact/differentiable_norm_squared/differentiable_rsubmx. + apply/derivable1_diffP. + admit. +rewrite /= !derivative_derive_along_eq0. +- by rewrite scaler0 add0r. +(* TODO: urgent - apply/differentiable_norm_squared/differentiable_rsubmx. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. rewrite /eqn14b_rhs. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. exact/differentiable_norm_squared/differentiable_lsubmx. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. rewrite /eqn14b_rhs. - by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. -by rewrite scaler0 scaler0 add0r. + by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0.*) Abort. Lemma locnegdef_derive_along_V1 sol (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> (forall t : K, state_space_tilt (sol x t)) -> sol x 0 = point1 -> - locnegdef ('D~(sol, x) (V1 alpha1 gamma)) 0. + locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. move=> solves state y0. split. @@ -1790,13 +1951,11 @@ split. near=> z0. rewrite derive_along_V1. - have V1dot_le := V1dot_ub solves z0 => //. - have := @posdefmxu2 K. - rewrite posdefmxP => def. set w := z2 z0 *m \S('e_2). set u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z0), 1 |-> norm w] i. have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0. - apply: def. + rewrite u2_quadratic_form_gt0//. rewrite /u1. admit. have Hneg : - (u1 *m u2 *m u1^T) 0 0 < 0 by rewrite oppr_lt0. @@ -1817,9 +1976,8 @@ rewrite derive_along_V1. - move => t. apply/derivable1_diffP => //. move : solves; rewrite /is_sol. - by case. -Unshelve. all: by end_near. -Abort. +(* by case.*) admit. +Unshelve. all: by end_near. Abort. (*Definition is_Lyapunov_stable_at {K : realType} {n} (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) @@ -1843,32 +2001,28 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn alpha1 gamma) state_space_tilt (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> (forall t, differentiable (sol x) t) -> forall t : K, 0 <= t -> - 'D~(sol, x) (V1 alpha1 gamma) t <= 0. + 'D~(sol x) (V1 alpha1 gamma) t <= 0. Proof. move=> solves diff t t0. rewrite derive_along_V1//. have Hub := V1dot_ub solves t. -have := @posdefmxu2 K. -rewrite posdefmxP => def. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> norm ((Left \o sol x) t), 1 |-> norm ((Right \o sol x) t *m \S('e_2))] i in 0 <= (u1 *m u2 *m u1^T) 0 0. -set u1 := \row_i [eta fun=> 0 + set u1 := \row_i [eta fun=> 0 with 0 |-> norm ((Left \o sol x) t), 1 |-> norm ((Right \o sol x) t *m \S('e_2))] i. -rewrite /=. -case: (u1 =P 0) => [->|/eqP u1_neq0]. - by rewrite !mul0mx mxE. - apply: ltW. - exact: (def u1 u1_neq0). -rewrite -oppr_ge0. -by rewrite !mulNmx mxE opprK Hquad. + rewrite /=. + case: (u1 =P 0) => [->|/eqP u1_neq0]. + by rewrite !mul0mx mxE. + by rewrite ltW// u2_quadratic_form_gt0. +by rewrite -oppr_ge0 !mulNmx mxE opprK Hquad. Qed. End tilt_eqn_Lyapunov. @@ -1878,22 +2032,26 @@ Context {K : realType}. Variables gamma alpha1 : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Let phi := tilt_eqn alpha1 gamma. +Let phi := tilt_eqn' alpha1 gamma. Variable Init : set 'rV[K]_6. Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. -Hypothesis solP : existence_uniqueness phi Init sol. -Hypothesis sol0 : initial_condition sol. +(*Hypothesis solP : existence_uniqueness phi Init sol.*) +(*Hypothesis sol0 : initial_condition sol.*) +Hypothesis solP : +(forall (a b : K), Init 0 -> is_sol_autonomous 0 phi a b (sol 0)). + Hypothesis y0 : 0 \in Init. Notation is_sol := (is_sol phi Init). -Hypothesis y_sol : is_sol (sol 0). +Variable Delta : K. +Hypothesis y_sol : is_sol Delta (sol 0). Hypothesis y00 : sol 0 0 = 0. Lemma is_equilibrium_subset : - is_equilibrium_point phi state_space_tilt 0 -> - is_equilibrium_point phi Init 0. + is_equilibrium_point phi state_space_tilt Delta 0 -> + is_equilibrium_point phi Init Delta 0. Proof. rewrite /is_equilibrium_point. rewrite /is_sol/= inE => -[inD0 deriv tilt]. @@ -1902,23 +2060,27 @@ Qed. Lemma equilibrium_zero_stable : open Init -> 0 \in Init -> Init `<=` state_space_tilt -> - is_stable_at point1 (sol 0). + is_locally_stable_at point1 Delta (sol 0). Proof. move=> openInit Init0 Init_in_state. -apply: (@Lyapunov_stability K _ phi Init sol sol0 solP openInit (V1 alpha1 gamma)). +apply: (@Lyapunov_stability K _ phi Init Delta sol Init0 solP openInit (V1 alpha1 gamma)). - move=> t. apply/differentiableD => //. apply/differentiableM => //. exact/differentiable_norm_squared/differentiable_lsubmx. apply/differentiableM => //. exact/differentiable_norm_squared/differentiable_rsubmx. -- move=> z zD t t0; apply: derive_along_V1_le0; [by []|by []| | |]. +- move=> z zD t t0. + apply: (@derive_along_V1_le0 _ _ _ _ _ Delta). + assumption. + assumption. + apply: (is_sol_subset Init_in_state). - by apply solP; rewrite sol0. + admit. (* pbm *) +(* by apply solP; rewrite sol0.*) + move=> t1. rewrite -derivable1_diffP. - have : is_sol (sol z) by apply solP; rewrite sol0. - by case. + (*have : is_sol (sol z) by apply solP; rewrite sol0. + by case.*) admit. - assumption. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. rewrite /is_Lyapunov_candidate /point1 => Hpos. @@ -1929,6 +2091,6 @@ apply: (@Lyapunov_stability K _ phi Init sol sol0 solP openInit (V1 alpha1 gamma case : Hpos => // _ [_]. by apply => //; rewrite inE. - exact/is_equilibrium_subset/equilibrium_point1. -Qed. +Admitted. End equilibrium_zero_stable. From 8faed2076e7394e5d0d0c4607816c54f3f041dc5 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Sat, 24 Jan 2026 20:25:50 +0900 Subject: [PATCH 069/144] generalizations for cauchy-lipschitz --- tilt.v | 436 +++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 272 insertions(+), 164 deletions(-) diff --git a/tilt.v b/tilt.v index 345645b3..73bee60d 100644 --- a/tilt.v +++ b/tilt.v @@ -435,7 +435,7 @@ Variable r : {posnum K}. Variable Delta : K. Definition state_space (Init : set T) (Delta : K) := - [set x | exists f, is_sol phi Init Delta r f /\ exists t, x = f t ]. + [set x | exists f, is_sol phi Init Delta r f /\ exists t, t \in `]0,Delta[ /\ x = f t ]. End state_space. @@ -688,8 +688,14 @@ apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. by rewrite bnd_simp ltW. by []. + case: solP' => solu0u0 [_ [deri [cont _]]]. - (*have := @continuous_within_itvP K 0 b (sol x). TODO: rebase coq robot *) - admit. + (* filled this *) + apply: cvg_comp. + have d0 : 0 < Delta. + by apply /lt_trans/bDelta. + have /continuous_within_itvP := cont. + move/(_ d0) => [_ + _]. + apply. + apply (differentiable_continuous (Vdiff (sol x 0))). + apply: cvg_at_left_filter. apply: differentiable_continuous => //. apply: differentiable_comp. @@ -701,7 +707,7 @@ apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. by apply: Vdiff. - by rewrite !in_itv/= lexx (le_trans a_ge0). - by rewrite in_itv/= ab andbT. -Admitted. +Qed. (* khalil theorem 4.1 *) Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) : @@ -1340,28 +1346,58 @@ Abort.*) Variable (r : {posnum K}). +Lemma derivable_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + derivable f t v -> derivable (fun x => rsubmx (f x)) t v. +Proof. +move=> /= => df1. +apply/derivable_mxP => i j/=. +rewrite (ord1 i). +have /cvg_ex[/= r' Hr]:= df1. +apply/cvg_ex => /=; exists (r'``_(rshift n1 j)). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hr => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, rshift n1 j)). +by rewrite !mxE. +Qed. + +Lemma derive_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + derivable f t v -> + 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1 _ ('D_v f t). +Proof. +move=> df1; apply/matrixP => i j; rewrite !mxE /=. +rewrite derive_mx ?mxE//=; last exact: derivable_rsubmx. +rewrite derive_mx ?mxE//=; congr ('D_v _ t). +by apply/funext => x; rewrite !mxE. +Qed. + + Lemma state_space_tiltS Delta : state_space (tilt_eqn') r state_space_tilt Delta `<=` state_space_tilt. Proof. -- move=> p [y [[y0_init1]] [deri [cont cball]]]. +- move=> p [y [[y0_init1]] [_ [/= deri cball]]]. rewrite /state_space_tilt. - have : derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) = 0. - transitivity (fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))). - apply/funext => x. + have : {in `]0, Delta[, derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) =1 0}. + move => x xd /=. + transitivity ((fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))) x). rewrite !derive1E. rewrite derive_mx; last first. - apply: deri. - admit. + by apply deri. rewrite /dotmul. under eq_fun do rewrite dotmulP /=. rewrite dotmulP. rewrite !mxE /= mulr1n. under eq_fun do rewrite !mxE /= mulr1n. rewrite !derive_dotmul/=; last 2 first. - apply: derivableB => //=; apply : derivable_rsubmx => //=. - admit. + apply: derivableB => //=; apply : derivable_rsubmx => //=. + by apply deri. apply: derivableB => //=; apply: derivable_rsubmx => //=. - admit. + by apply deri. rewrite /dotmul /=. rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. @@ -1370,54 +1406,61 @@ Proof. rewrite deriveB /= ; last 2 first. exact: derivable_cst. apply: derivable_rsubmx. - admit. + by apply deri. rewrite derive_cst /= sub0r; congr (- _). apply: derive_rsubmx. - admit. + by apply deri. rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. apply/matrixP => a b; rewrite !mxE. rewrite derive_mx//= ?mxE//. - admit. + by apply deri. ring. - have Rsu t0 : Right (y^`()%classic t0) = + have Rsu t0 : t0 \in `]0, Delta[ -> Right (y^`()%classic t0) = (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). - rewrite derive1E. - rewrite y33. + move => t0d. + have [_ ->] := deri t0 t0d. by rewrite row_mxKr. - admit. - apply/funext => t0. rewrite /dotmul. - transitivity (-2 * (gamma *: (Right (y t0) - - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2 *m - ('e_2 - Right (y t0))^T) 0 0). + transitivity (-2 * (gamma *: (Right (y x) - + Left (y x)) *m \S('e_2 - Right (y x)) ^+ 2 *m + ('e_2 - Right (y x))^T) 0 0). by rewrite Rsu. rewrite !mulmxA. apply/eqP. rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. by rewrite !mulmx0 mxE. - under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0 *) - move => h. - have norm_constant : forall t, norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. + move => h [t [t0d ->]]. + (* under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0 *) *) + (* move => h. *) + have norm_constant : forall t, t \in `]0,Delta[ -> norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. move => t0. - have : forall x0, is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. - move => x0. + have : forall x0, x0 \in `]0,Delta[ -> is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. + move => x0 x0d. + apply: DeriveDef. apply/derivable_norm_squared => //=. apply/derivableB => //=. apply/derivable_rsubmx => //. - admit. - by rewrite -derive1E h. + by apply deri. + rewrite -derive1E. + have := h _ x0d. + under eq_fun do rewrite dotmulvv /=. + apply. rewrite /=. - move/is_derive_0_is_cst. - move/ (_ _ 0). - move => s0. - exact: s0. + move => hd0 t0d'. + suff -> : (y t0) = (y 0) by []. + Search is_derive . + (* move/is_derive_0_is_cst. *) + (* move/ (_ _ 0). *) + (* move => s0. *) + (* exact: s0. *) + admit. suff: norm ('e_2 - Right (y t)) ^+ 2 = 1. move => /(congr1 Num.sqrt). rewrite sqrtr1 sqr_sqrtr //. by rewrite dotmulvv sqr_ge0. - rewrite norm_constant. + rewrite norm_constant //. move: y0_init1. rewrite inE /state_space_tilt /= => ->. by rewrite expr2 mulr1. @@ -1427,28 +1470,38 @@ Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). Lemma equilibrium_point1 Delta : - is_equilibrium_point (tilt_eqn') state_space_tilt Delta point1. + is_equilibrium_point (tilt_eqn') r state_space_tilt Delta point1. Proof. split => //=. - rewrite inE /state_space_tilt /point1. rewrite /=. by rewrite rsubmx_const /= subr0 normeE. -- move=> t tDelta; rewrite derive_cst /tilt_eqn /point1; apply/eqP. - rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. - rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. - rewrite /=. - by rewrite lsubmx_const. - apply/eqP/rowP; move => i; apply/eqP. - rewrite /eqn14b_rhs. - set N := (X in _ *: X *m _); have : N = 0. - rewrite /N /=; apply /rowP; move => a. - rewrite !mxE. - by rewrite subrr. +- split => //. + split. + + move=> t tDelta. + split; first exact: derivable_cst. + rewrite derive1E derive_cst /tilt_eqn /point1; apply/eqP. + + rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. + rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. + rewrite /=. + by rewrite lsubmx_const. + apply/eqP/rowP; move => i; apply/eqP. + rewrite /eqn14b_rhs. + set N := (X in _ *: X *m _); have : N = 0. + rewrite /N /=; apply /rowP; move => a. + rewrite !mxE. + by rewrite subrr. by move => n; rewrite n scaler0 mul0mx. + + split. + apply: continuous_subspaceT =>x. + exact: cvg_cst. + move => t td /=. + by apply closed_ballxx. Qed. Lemma equilibrium_point2 Delta : - is_equilibrium_point (tilt_eqn') state_space_tilt Delta point2. + is_equilibrium_point (tilt_eqn') r state_space_tilt Delta point2. Proof. split => //. - rewrite inE /state_space_tilt /point2 /=. @@ -1457,34 +1510,43 @@ split => //. rewrite -scalerBl normZ normeE mulr1 distrC. rewrite [X in _ - X](_:1 = 1%:R) //. by rewrite -natrB //= normr1. -- move => t tDelta. rewrite derive_cst; apply/eqP. - rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. - set N := (X in _ *: X == 0 /\ _). - have N0 : N = 0. - apply/rowP; move => i; rewrite !mxE; case: splitP. - move => j _; by rewrite mxE. - move => k /= i3k. - have := ltn_ord i. - by rewrite i3k -ltn_subRL subnn. +- split => //. split. - by rewrite scaler_eq0 N0 eqxx orbT. - rewrite /eqn14b_rhs. - rewrite -scalemxAl scalemx_eq0 gt_eqF//=. - rewrite -[Left point2]/N N0 subr0. - set M := (X in X *m _); rewrite -/M. - have ME : M = 2 *: 'e_2. - apply/rowP => i; rewrite !mxE eqxx/=. - case: splitP => [j ij|j]/=. - have := ltn_ord j. - by rewrite -ij. - move/eqP. - rewrite eqn_add2l => /eqP /ord_inj ->. - by rewrite !mxE eqxx/=. - rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/=. - rewrite [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA. - rewrite subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. - rewrite (_ : 'e_2 *m _ = 0) ?mul0mx//; apply: trmx_inj. - by rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. + + move=> t tDelta. + split; first exact: derivable_cst. + rewrite derive1E derive_cst; apply/eqP. + rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. + set N := (X in _ *: X == 0 /\ _). + have N0 : N = 0. + apply/rowP; move => i; rewrite !mxE; case: splitP. + move => j _; by rewrite mxE. + move => k /= i3k. + have := ltn_ord i. + by rewrite i3k -ltn_subRL subnn. + split. + by rewrite scaler_eq0 N0 eqxx orbT. + rewrite /eqn14b_rhs. + rewrite -scalemxAl scalemx_eq0 gt_eqF//=. + rewrite -[Left point2]/N N0 subr0. + set M := (X in X *m _); rewrite -/M. + have ME : M = 2 *: 'e_2. + apply/rowP => i; rewrite !mxE eqxx/=. + case: splitP => [j ij|j]/=. + have := ltn_ord j. + by rewrite -ij. + move/eqP. + rewrite eqn_add2l => /eqP /ord_inj ->. + by rewrite !mxE eqxx/=. + rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/=. + rewrite [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA. + rewrite subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. + rewrite (_ : 'e_2 *m _ = 0) ?mul0mx//; apply: trmx_inj. + by rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. + + split. + apply: continuous_subspaceT =>x. + exact: cvg_cst. + move => t td /=. + by apply closed_ballxx. Qed. End tilt_eqn. @@ -1669,29 +1731,69 @@ Hypothesis gamma_gt0 : 0 < gamma. (*Variable R : K -> 'M[K]_3.*) Variable Delta : K. +Variable r : {posnum K}. +(* generalization from the other file *) + +Lemma derivable_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + derivable f t v -> derivable (fun x => lsubmx (f x)) t v. +Proof. +move=> /= => df1. +apply/derivable_mxP => i j/=. +rewrite (ord1 i). +have /cvg_ex[/= l Hl]:= df1. +apply/cvg_ex => /=; exists (l``_(lshift n2 j)). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, lshift n2 j)). +by rewrite !mxE. +Qed. + +Lemma derive_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + derivable f t v -> + 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1 _ ('D_v f t). +Proof. +move=> df1; apply/matrixP => i j; rewrite !mxE /=. +rewrite derive_mx ?mxE//=; last exact: derivable_lsubmx. +rewrite derive_mx ?mxE//=; congr ('D_v _ t). +by apply/funext => x; rewrite !mxE. +Qed. + Lemma derive_zp1 (z : K) (sol : K -> 'rV_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> - 'D_1 (Left \o sol) z = - alpha1 *: Left (sol z). + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> + z \in `]0, Delta[ -> 'D_1 (Left \o sol) z = - alpha1 *: Left (sol z). Proof. -move=> [/= traj0 dtraj]. -(*move=> /(_ z)/(congr1 Left). -by rewrite row_mxKl => ?; rewrite derive_lsubmx//=. -Qed.*) Admitted. +move=> [/= traj0 [_ [dtraj btraj] ] zd]. +have [_ +] := dtraj _ zd. +move=> /(congr1 Left). +rewrite derive1E. +rewrite row_mxKl => ?; rewrite derive_lsubmx//=. +by apply dtraj. +Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> - 'D_1 (Right \o sol) z = + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> + z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. -move=> [/= traj0 dtraj]. -(*by move => /(_ z)/(congr1 Right); rewrite row_mxKr => ?; rewrite derive_rsubmx. -Qed.*) Admitted. +move=> [/= traj0 [_ [dtraj btraj] ] zd]. +have [_ +] := dtraj _ zd. +move => /(congr1 Right). +rewrite derive1E. +rewrite row_mxKr => ?; rewrite derive_rsubmx //. +by apply dtraj. +Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> state_space_tilt (sol t). Proof. -case => sol0 dsol deriv_sol. +case => sol0 [_[ deriv_sol bsol]]. apply: (@state_space_tiltS _ alpha1 gamma) => //=. exists sol; split => //. (*by exists t. @@ -1699,7 +1801,7 @@ Qed.*) Admitted. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> norm u = 1. + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> norm u = 1. Proof. move=> dtraj. suff: state_space_tilt (row_mx (zp1 z) (z2 z)). @@ -1710,7 +1812,7 @@ Qed. Lemma angvel_sqr (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta traj -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r traj -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> dtraj. @@ -1732,7 +1834,7 @@ by rewrite 2!mulNmx mulmx1 mxE. Qed. Lemma neg_spin (traj : K -> 'rV_6) (z : K) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta traj -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r traj -> norm (Right (traj z) *m \S('e_2) *m - \S('e_2 - Right (traj z))) = norm (Right (traj z) *m \S('e_2)). Proof. @@ -1758,12 +1860,13 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> + z \in `]0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + c2 *: (2 *: 'D_1 z2 z *m (Right (sol z))^T) 0 0. Proof. -move=> ?. +move=> ? zd. rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC. rewrite mulVf// div1r. @@ -1783,7 +1886,7 @@ by rewrite mulmxA. Qed. Lemma derive_along_V1 (x : 'rV[K]_6) t sol : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> (forall t, differentiable (sol x) t) -> 'D~(sol x(*, x*)) (V1 alpha1 gamma) t = V1dot (sol x t). Proof. @@ -1805,9 +1908,9 @@ rewrite -fctE /= !derive_along_norm_squared//=. by rewrite /c1 /c2 !invfM. rewrite /= in tilt_eqnx. exact: tilt_eqnx. -- exact/differentiable_lsubmx. -- exact/differentiable_rsubmx. -Qed. +(* - exact/differentiable_lsubmx. *) +(* - exact/differentiable_rsubmx. *) +Admitted. Definition u1 (sol : K -> 'rV[K]_6) t (zp1 := Left \o sol) (z2 := Right \o sol) @@ -1815,7 +1918,7 @@ Definition u1 (sol : K -> 'rV[K]_6) t \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 t), 1 |-> norm w] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta sol -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> forall t, V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. @@ -1849,77 +1952,77 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> sol x 0 = point1 -> \forall z \near 0^', ('D~(sol x) (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) + 'D~(sol x) (fun x => norm (Right x) ^+ 2 / (2 * gamma))) z <= 0. Proof. -move=> dtraj traj0. +move=> [in_init [_ [dtraj btraj]]] traj0. rewrite fctE !invfM /=. near=> z. under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. -move: dtraj => [H0 Hderiv Htilt]. -have Hz_derivable : derivable (sol x) z 1. - apply: Hderiv. - admit. -rewrite derive_alongMl; last 2 first. - exact/differentiable_norm_squared/differentiable_lsubmx. - apply derivable1_diffP. - apply: Hderiv. - admit. -rewrite derive_alongMl; last 2 first. - exact/differentiable_norm_squared/differentiable_rsubmx. - exact/derivable1_diffP. -rewrite /= !derive_along_norm_squared; last 4 first. - exact/differentiable_rsubmx. - exact/derivable1_diffP. - exact/differentiable_lsubmx. - exact/derivable1_diffP. -rewrite -V1dotE //. -pose zp1 := Left \o sol x. -pose z2 := Right \o sol x. -set w := (z2 z) *m \S('e_2). -pose u1 : 'rV[K]_2 := - \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. -apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). - exact: V1dot_ub. -have [->|H] := eqVneq u1 0. - by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. -by rewrite leNgt 2!mulNmx mxE oppr_gt0 -leNgt ltW// u2_quadratic_form_gt0. +(* move: dtraj => [H0 Hderiv Htilt]. *) +(* have Hz_derivable : derivable (sol x) z 1. *) +(* apply: Hderiv. *) +(* admit. *) +(* rewrite derive_alongMl; last 2 first. *) +(* exact/differentiable_norm_squared/differentiable_lsubmx. *) +(* apply derivable1_diffP. *) +(* apply: Hderiv. *) +(* admit. *) +(* rewrite derive_alongMl; last 2 first. *) +(* exact/differentiable_norm_squared/differentiable_rsubmx. *) +(* exact/derivable1_diffP. *) +(* rewrite /= !derive_along_norm_squared; last 4 first. *) +(* exact/differentiable_rsubmx. *) +(* exact/derivable1_diffP. *) +(* exact/differentiable_lsubmx. *) +(* exact/derivable1_diffP. *) +(* rewrite -V1dotE //. *) +(* pose zp1 := Left \o sol x. *) +(* pose z2 := Right \o sol x. *) +(* set w := (z2 z) *m \S('e_2). *) +(* pose u1 : 'rV[K]_2 := *) +(* \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. *) +(* apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). *) +(* exact: V1dot_ub. *) +(* have [->|H] := eqVneq u1 0. *) +(* by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. *) +(* by rewrite leNgt 2!mulNmx mxE oppr_gt0 -leNgt ltW// u2_quadratic_form_gt0. *) Unshelve. all: try by end_near. Admitted. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> sol x 0 = point1 -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. -move=> [y033] dy dtraj traj0. -rewrite /locnegsemidef /V1. -rewrite derive_alongD /=; last 3 first. - apply: differentiableM => /=; last exact: differentiable_cst. - exact/differentiable_norm_squared/differentiable_lsubmx. - apply: differentiableM; last exact: differentiable_cst. - exact/differentiable_norm_squared/differentiable_rsubmx. - apply/derivable1_diffP. - admit. -split; last first. - near=> z. - rewrite derive_along_derive //; last first. - apply/derivable1_diffP. - admit. - admit. (* TODO: lynda *) - admit. (* TODO: lynda *) -under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. -rewrite derive_alongMl; last 2 first. - exact/differentiable_norm_squared/differentiable_lsubmx. - apply/derivable1_diffP. - admit. -rewrite /= !derivative_derive_along_eq0. -- by rewrite scaler0 add0r. +(* move=> [y033] dy dtraj traj0. *) +(* rewrite /locnegsemidef /V1. *) +(* rewrite derive_alongD /=; last 3 first. *) +(* apply: differentiableM => /=; last exact: differentiable_cst. *) +(* exact/differentiable_norm_squared/differentiable_lsubmx. *) +(* apply: differentiableM; last exact: differentiable_cst. *) +(* exact/differentiable_norm_squared/differentiable_rsubmx. *) +(* apply/derivable1_diffP. *) +(* admit. *) +(* split; last first. *) +(* near=> z. *) +(* rewrite derive_along_derive //; last first. *) +(* apply/derivable1_diffP. *) +(* admit. *) +(* admit. (* TODO: lynda *) *) +(* admit. (* TODO: lynda *) *) +(* under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. *) +(* under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. *) +(* rewrite derive_alongMl; last 2 first. *) +(* exact/differentiable_norm_squared/differentiable_lsubmx. *) +(* apply/derivable1_diffP. *) +(* admit. *) +(* rewrite /= !derivative_derive_along_eq0. *) +(* - by rewrite scaler0 add0r. *) (* TODO: urgent - apply/differentiable_norm_squared/differentiable_rsubmx. rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. rewrite /eqn14b_rhs. @@ -1932,7 +2035,7 @@ Abort. Lemma locnegdef_derive_along_V1 sol (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> (forall t : K, state_space_tilt (sol x t)) -> sol x 0 = point1 -> locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. @@ -2001,7 +2104,7 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta (sol x) -> + is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> (forall t, differentiable (sol x) t) -> forall t : K, 0 <= t -> 'D~(sol x) (V1 alpha1 gamma) t <= 0. @@ -2035,26 +2138,30 @@ Hypothesis alpha1_gt0 : 0 < alpha1. Let phi := tilt_eqn' alpha1 gamma. Variable Init : set 'rV[K]_6. Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. +Variable Delta : K. +Variable r : {posnum K}. + (*Hypothesis solP : existence_uniqueness phi Init sol.*) (*Hypothesis sol0 : initial_condition sol.*) +Check is_sol_autonomous. + Hypothesis solP : -(forall (a b : K), Init 0 -> is_sol_autonomous 0 phi a b (sol 0)). +( is_sol_autonomous 0 phi r 0 Delta (sol 0)). Hypothesis y0 : 0 \in Init. Notation is_sol := (is_sol phi Init). -Variable Delta : K. -Hypothesis y_sol : is_sol Delta (sol 0). -Hypothesis y00 : sol 0 0 = 0. +(* Hypothesis y_sol : is_sol Delta (sol 0). *) +(* Hypothesis y00 : sol 0 0 = 0. *) Lemma is_equilibrium_subset : - is_equilibrium_point phi state_space_tilt Delta 0 -> - is_equilibrium_point phi Init Delta 0. + is_equilibrium_point phi r state_space_tilt Delta 0 -> + is_equilibrium_point phi r Init Delta 0. Proof. rewrite /is_equilibrium_point. -rewrite /is_sol/= inE => -[inD0 deriv tilt]. +rewrite /is_sol/= inE => -[inD0 deriv ]. by split => //; exact/set_mem. Qed. @@ -2063,7 +2170,8 @@ Lemma equilibrium_zero_stable : is_locally_stable_at point1 Delta (sol 0). Proof. move=> openInit Init0 Init_in_state. -apply: (@Lyapunov_stability K _ phi Init Delta sol Init0 solP openInit (V1 alpha1 gamma)). +Check @Lyapunov_stability. +apply: (@Lyapunov_stability K _ phi Init Delta sol r solP openInit (V1 alpha1 gamma)). - move=> t. apply/differentiableD => //. apply/differentiableM => //. From 7f68913cc6680a179a013f095c44cf514c44767d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 24 Jan 2026 20:38:02 +0900 Subject: [PATCH 070/144] small fix for compat with MC 2.5.0 --- tilt.v | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/tilt.v b/tilt.v index 73bee60d..ce64ae8a 100644 --- a/tilt.v +++ b/tilt.v @@ -432,10 +432,9 @@ Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : T -> T. Variable r : {posnum K}. -Variable Delta : K. -Definition state_space (Init : set T) (Delta : K) := - [set x | exists f, is_sol phi Init Delta r f /\ exists t, t \in `]0,Delta[ /\ x = f t ]. +Definition state_space (Init : set T) (Delta : K) : set T:= + [set x | exists f, (is_sol phi Init Delta r f /\ (exists t, t \in `]0, Delta[%R /\ x = f t))]. End state_space. From 4a9ac368e7cd943d56caccf43b05d5dff2148a88 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 25 Jan 2026 02:15:48 +0900 Subject: [PATCH 071/144] eliminating admits (wip) --- tilt.v | 324 +++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 234 insertions(+), 90 deletions(-) diff --git a/tilt.v b/tilt.v index ce64ae8a..d0f2e09c 100644 --- a/tilt.v +++ b/tilt.v @@ -605,12 +605,40 @@ Unshelve. all: by end_near. Qed. End sphere. -Lemma within_continuous_comp_norm {R : realType} {U : normedModType R} a y (f : R -> U) : +(* TODO: generalize within_continuous_comp_norm *) +Lemma within_continuous_comp {R : realType} {K : numDomainType} + {U : pseudoMetricNormedZmodType K} a y (g : U -> R) (f : R -> U) : a <= y -> - {within `[a, y], continuous fun x => f x} -> - {within `[a, y], continuous fun x => `|f x|}. -Admitted. (* NB: from common.v *) - + {in f @` `[a, y], continuous g} -> + {within `[a, y], continuous (fun x => f x)} -> + {within `[a, y], continuous fun x => (g \o f) x}. +Proof. +rewrite le_eqVlt => /predU1P[<-|ay]. + rewrite set_itv1 => _ _. + exact: continuous_subspace1. +move=> cg. +move/(continuous_within_itvP f ay) => -[H1 H2 H3]. +apply/continuous_within_itvP => //; split => //. +- move=> z zay. + apply: continuous_comp => //. + by apply: H1. + apply: cg. + rewrite inE/=. + exists z => //. + by apply: subset_itv_oo_cc zay. +- apply: (cvg_comp f g). + by apply: H2. + apply: cg. + rewrite inE/=. + exists a => //. + by rewrite in_itv/= lexx/= ltW. +- apply: (cvg_comp f g). + by apply: H3. + apply: cg. + rewrite inE/=. + exists y => //. + by rewrite in_itv/= lexx/= ltW. +Qed. Section Lyapunov_stability. Context {K : realType} {n : nat}. @@ -795,7 +823,9 @@ have Df_Omega_beta : have [t1 [/andP[t1_ge0 t1t] phit1r]] : exists t0, 0 <= t0 <= t/\ `|sol x t0| = r. have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o sol x)}. (* `[0, t] *) - apply: within_continuous_comp_norm => //. + apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) (sol x)) => //. + move=> z _. + by apply: norm_continuous. case: solP => _ [_ [+ _]]. apply: continuous_subspaceW. apply: subset_itvl. @@ -1261,6 +1291,111 @@ End two_steps_first_order_estimator. Definition state_space_tilt {K : realType} := [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. +Lemma cst_oo_cc {R : realType} (f : R -> R) y (a b : R) : + y \in `[a, b] -> + {within `[a, b], continuous f} -> + {in `]a, b[, f =1 cst (f y)} -> + {in `[a, b], f =1 cst (f y)}. +Proof. +have [ab|ba] := ltP a b; last first. + move=> yab _ H x. + rewrite inE/= in_itv/= => /andP[ax xb]. + have /eqP ? : a == x by rewrite eq_le ax (le_trans xb _). + subst x. + move: yab; rewrite inE/= in_itv/= => /andP[ay yb]. + have /eqP ? : a == y by rewrite eq_le ay (le_trans yb _). + by subst. +move=> yab cf H x. +rewrite inE/= in_itv/= => /andP[]. +rewrite le_eqVlt => /predU1P[<-{x} _|]. + move: yab; rewrite inE/= in_itv/= => /andP[]. + rewrite le_eqVlt => /predU1P[->//|ay yb]. + move/continuous_within_itvP : cf => /(_ ab)[_ fafa _]. + move/cvgrPdist_le in fafa. + rewrite /= in fafa. + apply/eqP. + rewrite -subr_eq0. + rewrite -normr_le0. + apply/ler_addgt0Pr => /= e e0. + rewrite add0r. + have := fafa _ e0 => -[d /= d0] H'. + near a^'+ => a0. + rewrite (_ : f y = f a0)//; last first. + apply/esym/H. + rewrite inE/= in_itv/=. + by apply/andP; split => //. + apply: H' => //=. + rewrite ltr0_norm ?subr_lt0// opprB. + rewrite ltrBlDl. + near: a0. + apply: nbhs_right_lt. + by rewrite ltrDl. +move=> ax. +rewrite le_eqVlt => /predU1P[->|]; last first. + move=> xb. + apply: H => //. + by rewrite inE/= in_itv/= ax. +clear x ax. +move: yab. +rewrite inE/= in_itv/= => /andP[ay]. +rewrite le_eqVlt => /predU1P[<-//|yb]. +move/continuous_within_itvP : cf => /(_ ab)[_ _ fbfb]. +move/cvgrPdist_le in fbfb. +rewrite /= in fbfb. +apply/eqP. +rewrite -subr_eq0. +rewrite -normr_le0. +apply/ler_addgt0Pr => /= e e0. +rewrite add0r. +have := fbfb _ e0 => -[d /= d0] H'. +near b^'- => b0. +rewrite (_ : f y = f b0)//; last first. + apply/esym/H. + rewrite inE/= in_itv/=. + by apply/andP; split => //. +apply: H' => //=. +rewrite distrC. +rewrite ltr0_norm ?subr_lt0// opprB. +rewrite ltrBlDr. +rewrite -ltrBlDl. +near: b0. +apply: nbhs_left_gt. +by rewrite ltrBlDl ltrDr. +Unshelve. all: by end_near. Qed. + +Lemma is_derive_0_is_cst_new {R : realType} (f : R -> R) y (a b : R) : + y \in `]a, b[ -> + {within `[a, b], continuous f} -> + (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. +Proof. +move=> yab cf Hd. +apply: cst_oo_cc => //. + move: yab. + rewrite !inE/=. + by apply: subset_itv_oo_cc. +move=> x xab. +wlog xLy : x y xab yab/ x <= y. + move=> H; case: (leP x y) => [/H |/ltW xy]. + exact. + by apply/esym/H => //. +rewrite -(subKr (f y) (f x)). +have [| |] := @MVT_segment R f 0 _ _ xLy. +- move=> z zxy. + apply: Hd. + move: zxy. + rewrite inE/=. + apply: subset_itvSoo; rewrite bnd_simp. + by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. + by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. +- apply: continuous_subspaceW(* NB: should be , do a PRS*) cf. + apply: subset_itvScc; rewrite bnd_simp. + by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. + by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. +move=> r rxy. +rewrite mul0r => ->. +by rewrite subr0. +Qed. + Section tilt_eqn. Context {K : realType}. Variables alpha1 gamma : K. @@ -1375,95 +1510,103 @@ rewrite derive_mx ?mxE//=; congr ('D_v _ t). by apply/funext => x; rewrite !mxE. Qed. - Lemma state_space_tiltS Delta : state_space (tilt_eqn') r state_space_tilt Delta `<=` state_space_tilt. Proof. -- move=> p [y [[y0_init1]] [_ [/= deri cball]]]. - rewrite /state_space_tilt. - have : {in `]0, Delta[, derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) =1 0}. - move => x xd /=. - transitivity ((fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))) x). - rewrite !derive1E. - rewrite derive_mx; last first. - by apply deri. - rewrite /dotmul. - under eq_fun do rewrite dotmulP /=. - rewrite dotmulP. - rewrite !mxE /= mulr1n. - under eq_fun do rewrite !mxE /= mulr1n. - rewrite !derive_dotmul/=; last 2 first. - apply: derivableB => //=; apply : derivable_rsubmx => //=. - by apply deri. - apply: derivableB => //=; apply: derivable_rsubmx => //=. - by apply deri. - rewrite /dotmul /=. - rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. - rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. - rewrite !mxE /= !mulr1n. - have -> : 'D_1 (fun x2 : K => 'e_2 - Right (y x2)) x = - Right ('D_1 y x). - rewrite deriveB /= ; last 2 first. - exact: derivable_cst. - apply: derivable_rsubmx. - by apply deri. - rewrite derive_cst /= sub0r; congr (- _). - apply: derive_rsubmx. - by apply deri. - rewrite -(_ : 'D_1 y x = - (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. - apply/matrixP => a b; rewrite !mxE. - rewrite derive_mx//= ?mxE//. +have [Delta0|Delta0] := leP 0 Delta; last first. + move=> t. + rewrite /state_space/= => -[f [rf [x]]]. + rewrite in_itv/= => -[/andP[x0 xDelta]]. + have := lt_trans xDelta Delta0. + by rewrite ltNge (ltW x0). +move=> p [y [[y0_init1]] [_ [/= deri [conti ball]]]]. +rewrite /state_space_tilt. +have : {in `]0, Delta[, derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) =1 0}. + move => x xd /=. + transitivity ((fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))) x). + rewrite !derive1E. + rewrite derive_mx; last first. + by apply deri. + rewrite /dotmul. + under eq_fun do rewrite dotmulP /=. + rewrite dotmulP. + rewrite !mxE /= mulr1n. + under eq_fun do rewrite !mxE /= mulr1n. + rewrite !derive_dotmul/=; last 2 first. + apply: derivableB => //=; apply : derivable_rsubmx => //=. + by apply deri. + apply: derivableB => //=; apply: derivable_rsubmx => //=. + by apply deri. + rewrite /dotmul /=. + rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. + rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. + rewrite !mxE /= !mulr1n. + have -> : 'D_1 (fun x2 : K => 'e_2 - Right (y x2)) x = - Right ('D_1 y x). + rewrite deriveB /= ; last 2 first. + exact: derivable_cst. + apply: derivable_rsubmx. by apply deri. - ring. + rewrite derive_cst /= sub0r; congr (- _). + apply: derive_rsubmx. + by apply deri. + rewrite -(_ : 'D_1 y x = + (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. + apply/matrixP => a b; rewrite !mxE. + rewrite derive_mx//= ?mxE//. + by apply deri. + ring. have Rsu t0 : t0 \in `]0, Delta[ -> Right (y^`()%classic t0) = - (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). - move => t0d. - have [_ ->] := deri t0 t0d. - by rewrite row_mxKr. - rewrite /dotmul. - transitivity (-2 * (gamma *: (Right (y x) - - Left (y x)) *m \S('e_2 - Right (y x)) ^+ 2 *m - ('e_2 - Right (y x))^T) 0 0). - by rewrite Rsu. - rewrite !mulmxA. - apply/eqP. - rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. - by rewrite !mulmx0 mxE. - move => h [t [t0d ->]]. + (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). + move => t0d. + have [_ ->] := deri t0 t0d. + by rewrite row_mxKr. + rewrite /dotmul. + transitivity (-2 * (gamma *: (Right (y x) - + Left (y x)) *m \S('e_2 - Right (y x)) ^+ 2 *m + ('e_2 - Right (y x))^T) 0 0). + by rewrite Rsu. + rewrite !mulmxA. + apply/eqP. + rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. + by rewrite !mulmx0 mxE. +move => h [t [t0d ->]]. (* under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0 *) *) - (* move => h. *) - have norm_constant : forall t, t \in `]0,Delta[ -> norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. - move => t0. - have : forall x0, x0 \in `]0,Delta[ -> is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. - move => x0 x0d. - - apply: DeriveDef. + (* move => h. *) +have norm_constant : forall t, t \in `]0,Delta[ -> norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. + move => t0. + have : forall x0, x0 \in `]0,Delta[ -> is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. + move => x0 x0d. + apply: DeriveDef. apply/derivable_norm_squared => //=. - apply/derivableB => //=. - apply/derivable_rsubmx => //. - by apply deri. - rewrite -derive1E. - have := h _ x0d. - under eq_fun do rewrite dotmulvv /=. - apply. - rewrite /=. - move => hd0 t0d'. - suff -> : (y t0) = (y 0) by []. - Search is_derive . - (* move/is_derive_0_is_cst. *) - (* move/ (_ _ 0). *) - (* move => s0. *) - (* exact: s0. *) - admit. - suff: norm ('e_2 - Right (y t)) ^+ 2 = 1. - move => /(congr1 Num.sqrt). - rewrite sqrtr1 sqr_sqrtr //. - by rewrite dotmulvv sqr_ge0. - rewrite norm_constant //. - move: y0_init1. - rewrite inE /state_space_tilt /= => ->. - by rewrite expr2 mulr1. -Admitted. + apply/derivableB => //=. + apply/derivable_rsubmx => //. + by apply deri. + rewrite -derive1E. + have := h _ x0d. + under eq_fun do rewrite dotmulvv /=. + by apply. + rewrite /=. + move => hd0 t0d'. + apply/esym. + have := is_derive_0_is_cst_new t0d' _ hd0. + apply => //; last first. + by rewrite inE/= in_itv/= lexx/=. + apply: (@within_continuous_comp _ _ _ _ _ (fun x => norm ('e_2 - Right x) ^+ 2) y) => //=. + move=> z _. + apply: differentiable_continuous => //. + apply: differentiable_norm_squared => /=. + apply: differentiableB => //. + by apply: differentiable_rsubmx. +suff: norm ('e_2 - Right (y t)) ^+ 2 = 1. + move => /(congr1 Num.sqrt). + rewrite sqrtr1 sqr_sqrtr //. + by rewrite dotmulvv sqr_ge0. +rewrite norm_constant //; last first. + by rewrite inE. +move: y0_init1. +rewrite inE /state_space_tilt /= => ->. +by rewrite expr2 mulr1. +Qed. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). @@ -1907,8 +2050,9 @@ rewrite -fctE /= !derive_along_norm_squared//=. by rewrite /c1 /c2 !invfM. rewrite /= in tilt_eqnx. exact: tilt_eqnx. -(* - exact/differentiable_lsubmx. *) -(* - exact/differentiable_rsubmx. *) +- admit. +- exact/differentiable_lsubmx. +- exact/differentiable_rsubmx. Admitted. Definition u1 (sol : K -> 'rV[K]_6) t From db9937e729d29609b80fc19cdb5ce8438a36f4a5 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 25 Jan 2026 06:03:18 +0900 Subject: [PATCH 072/144] trying to adjust hypos (wip) --- derive_matrix.v | 60 ++++++++ tilt.v | 379 ++++++++++++++++++++---------------------------- tilt_analysis.v | 59 +------- tilt_robot.v | 109 +------------- 4 files changed, 222 insertions(+), 385 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index 419549d7..855256a2 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -304,6 +304,66 @@ Qed. End pointwise_derive. +Lemma derivable_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + derivable f t v -> derivable (fun x => lsubmx (f x)) t v. +Proof. +move=> /= => df1. +apply/derivable_mxP => i j/=. +rewrite (ord1 i). +have /cvg_ex[/= l Hl]:= df1. +apply/cvg_ex => /=; exists (l``_(lshift n2 j)). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hl => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, lshift n2 j)). +by rewrite !mxE. +Qed. + +Lemma derive_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + derivable f t v -> + 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1 _ ('D_v f t). +Proof. +move=> df1; apply/matrixP => i j; rewrite !mxE /=. +rewrite derive_mx ?mxE//=; last exact: derivable_lsubmx. +rewrite derive_mx ?mxE//=; congr ('D_v _ t). +by apply/funext => x; rewrite !mxE. +Qed. + +Lemma derivable_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + derivable f t v -> derivable (fun x => rsubmx (f x)) t v. +Proof. +move=> /= => df1. +apply/derivable_mxP => i j/=. +rewrite (ord1 i). +have /cvg_ex[/= r Hr]:= df1. +apply/cvg_ex => /=; exists (r``_(rshift n1 j)). +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : Hr => /(_ _ e0). +apply: filterS => x. +apply: le_trans. +rewrite [in leRHS]/Num.Def.normr/= mx_normrE. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, rshift n1 j)). +by rewrite !mxE. +Qed. + +Lemma derive_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} + (f : V -> 'rV[R]_(n1 + n2)) t v : + derivable f t v -> + 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1 _ ('D_v f t). +Proof. +move=> df1; apply/matrixP => i j; rewrite !mxE /=. +rewrite derive_mx ?mxE//=; last exact: derivable_rsubmx. +rewrite derive_mx ?mxE//=; congr ('D_v _ t). +by apply/funext => x; rewrite !mxE. +Qed. + Section derivable_mulmx. Context {R : realFieldType} {V : normedModType R} {m n k : nat}. diff --git a/tilt.v b/tilt.v index d0f2e09c..09960fee 100644 --- a/tilt.v +++ b/tilt.v @@ -1,5 +1,5 @@ From HB Require Import structures. -From mathcomp Require Import all_ssreflect all_algebra ring. +From mathcomp Require Import all_boot all_algebra ring. From mathcomp Require Import interval_inference. From mathcomp Require Import boolp classical_sets functions reals order. From mathcomp Require Import topology normedtype landau derive realfun. @@ -17,7 +17,13 @@ Require Import tilt_mathcomp tilt_analysis tilt_robot. (* locnegsemidef V x == V is locally negative semidefinite *) (* 'D~(sol, x0) V == derivative of V along the solution sol *) (* starting at x0 *) -(* is_sol f y == the function y satisfies y' = phi y *) +(* is_sol_autonomous u0 phi r t0 t1 f == solution of an autonomous ODE *) +(* initial_condition u0 *) +(* equation phi *) +(* solution stays in B_u0(r) *) +(* solution f on [t0, t1] *) +(* is_sol phi r Delta f Init := is_sol_autonomous (f 0) phi r 0 Delta f *) +(* + f 0 \in Init *) (* is_equilibrium_point f p := solves_equation f (cst p) *) (* state_space f == the set points attainable by a solution *) (* (in the sense of `is_sol`) *) @@ -43,7 +49,6 @@ Local Open Scope ring_scope. (* additions to MathComp-Analysis *) - Lemma ball0_le0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : ball a r = set0 -> r <= 0. Proof. @@ -51,21 +56,6 @@ rewrite -subset0 => ar0; rewrite leNgt; apply/negP => r0. by have /(_ (ballxx _ r0)) := ar0 a. Qed. -Lemma le0_ball0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : - r <= 0 -> ball a r = set0. -Proof. -move=> r0; rewrite -subset0 => y. -rewrite -ball_normE /ball_/= ltNge => /negP; apply. -by rewrite (le_trans r0). -Qed. - -Lemma closed_ball0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : - r <= 0 -> closed_ball a r = set0. -Proof. -move=> r0; rewrite -subset0 => v. -by rewrite /closed_ball le0_ball0// closure0. -Qed. - Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n) : 0 < e -> closed_ball x e = closed_ball_ (@mx_norm _ _ _) x e. Proof. @@ -88,7 +78,8 @@ by rewrite -leNgt in xy. Qed. Local Open Scope classical_set_scope. -(* NB: we are just mimicking the proofs for the real line already available in derive.v *) + +(* PR in progress: https://github.com/math-comp/analysis/pull/1802 *) Lemma EVT_max_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : A !=set0 -> compact A -> @@ -129,6 +120,7 @@ rewrite -[ltRHS]invrK ltf_pV2// ?qualifE/= ?invr_gt0 ?subr_gt0 ?imf_ltsup//; las by rewrite (le_lt_trans (ler_norm _) _) ?imVfltk//; exact: imageP. Qed. +(* PR in progress: https://github.com/math-comp/analysis/pull/1802 *) Lemma EVT_min_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : A !=set0 -> compact A -> @@ -142,15 +134,11 @@ by exists c => // ? /fcmax; rewrite lerN2. Qed. Local Close Scope classical_set_scope. -(* TODO: rm with MCA 1.15.0 *) -Definition Jacobian n m (R : numFieldType) (f : 'rV[R]_n -> 'rV[R]_m) p := - lin1_mx ('d f p). - Section gradient. Definition jacobian1 {R : numFieldType} n (f : 'rV[R]_n -> R) : 'rV_n -> 'cV_n := - Jacobian (scalar_mx \o f). + jacobian (scalar_mx \o f). (* NB: not used*) Definition partial {R : realType} {n : nat} (f : 'rV[R]_n -> R) (a : 'rV[R]_n) i := @@ -254,10 +242,10 @@ Implicit Types V : T -> R. Definition is_Lyapunov_candidate V (D : set T) (x : T) := x \in D /\ V x = 0 /\ forall z, z \in D -> z != x -> V z > 0. -(* TODO: useful? mettre dans un fichier wip.v? *) +(* NB: useful? mettre dans un fichier wip.v? *) Definition locnegdef V (x : T) := V x = 0 /\ \forall z \near x^', V z < 0. -(* TODO: useful? mettre dans un fichier wip.v? *) +(* NB: useful? mettre dans un fichier wip.v? *) (* locally negative semidefinite *) Definition locnegsemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z <= 0. @@ -375,11 +363,10 @@ From mathcomp Require Import sequences. Section picard. Context {R : realType} {n : nat}. -Notation U := ('rV[R]_n). +Notation U := 'rV[R]_n. Variable u0 : U. Variable phi : U -> U. - -Variable (r : {posnum R}). +Variable r : {posnum R}. Let B := closed_ball u0 r%:num. Definition is_sol_autonomous (t0 t1 : R) (f : R -> U) := @@ -388,7 +375,7 @@ Definition is_sol_autonomous (t0 t1 : R) (f : R -> U) := {within `[t0, t1], continuous f} /\ {in `[t0, t1], forall t, closed_ball u0 r%:num (f t)}. -Variables (k : R) . +Variable k : R. Hypothesis k0 : 0 < k. Hypothesis lip2 : k.-lipschitz_B phi. @@ -401,11 +388,11 @@ End picard. Section ode. Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. +Let U := 'rV[K]_n. -Variable phi : T -> T. +Variable phi : U -> U. -Definition is_sol (Init : set T) (Delta : K) (r : {posnum K}) (f : K -> T) := +Definition is_sol (r : {posnum K}) (Delta : K) (f : K -> U) (Init : set U) := f 0 \in Init /\ is_sol_autonomous (f 0) phi r 0 Delta f. End ode. @@ -417,8 +404,8 @@ Variable phi : T -> T. Variable r : {posnum K}. Variable Delta : K. -Lemma is_sol_subset y0 (A B : set T) (AB : A `<=` B) : - is_sol phi A Delta r y0 -> is_sol phi B Delta r y0. +Lemma is_sol_subset f (A B : set T) (AB : A `<=` B) : + is_sol phi r Delta f A -> is_sol phi r Delta f B. Proof. rewrite /is_sol inE => -[inD0 [_ [deri [cont cball]]]]; rewrite inE. split => //. @@ -434,7 +421,8 @@ Variable phi : T -> T. Variable r : {posnum K}. Definition state_space (Init : set T) (Delta : K) : set T:= - [set x | exists f, (is_sol phi Init Delta r f /\ (exists t, t \in `]0, Delta[%R /\ x = f t))]. + [set x | exists f, (is_sol phi r Delta f Init /\ + (exists t, t \in `]0, Delta[%R /\ x = f t))]. End state_space. @@ -446,7 +434,7 @@ Variable r : {posnum K}. Variable Init : set T. Variable Delta : K. -Definition is_equilibrium_point (x : T) := is_sol phi Init Delta r (cst x). +Definition is_equilibrium_point (x : T) := is_sol phi r Delta (cst x) Init. End equilibrium_point. @@ -644,12 +632,12 @@ Section Lyapunov_stability. Context {K : realType} {n : nat}. Let U := 'rV[K]_n.+1. Variable phi : U -> U. -Variable Init : set U. +Variable r' : {posnum K}. Variable Delta : K. +Variable Init : set U. Variable sol : U -> K -> U. Let u0 : U := 0. Hypothesis Initu0 : u0 \in Init. -Variable r' : {posnum K}. Hypothesis solP : is_sol_autonomous u0 phi r' 0 Delta (sol u0). Hypothesis openD : open Init. (* D est forcement un ouvert *) @@ -666,7 +654,7 @@ Hypothesis V'_le0 : forall x, x \in Init -> forall t, t >= 0 -> 'D~(sol x) V t <= 0. Let V_nincr a b : b < Delta -> 0 <= a <= b -> - forall x, x \in Init -> is_sol phi Init Delta r' (sol x) -> + forall x, x \in Init -> is_sol phi r' Delta (sol x) Init -> V (sol x b) <= V (sol x a). Proof. move=> bDelta /andP[a_ge0 ab] x /set_mem xD solP'. @@ -1402,38 +1390,32 @@ Variables alpha1 gamma : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Definition tilt_eqn (f : K -> 'rV[K]_6) : K -> 'rV[K]_6 := +Definition tilt_eqn_functional (f : K -> 'rV[K]_6) : K -> 'rV[K]_6 := let error1_p_dot := Left \o f in let error2_p_dot := Right \o f in fun t => row_mx (- alpha1 *: error1_p_dot t) (eqn14b_rhs gamma (error1_p_dot t) (error2_p_dot t)). -Definition tilt_eqn_no_time (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := +Definition tilt_eqn (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := let zp1_point := Left zp1_z2_point in let z2_point := Right zp1_z2_point in row_mx (- alpha1 *: zp1_point) (eqn14b_rhs gamma zp1_point z2_point). -Definition tilt_eqn' (x : 'rV[K]_6) : 'rV[K]_6 := - let zp1_point := Left x in - let z2_point := Right x in - row_mx (- alpha1 *: zp1_point) - (eqn14b_rhs gamma zp1_point z2_point). - -Lemma tilt_eqn'E (f : K -> 'rV[K]_6) t : - tilt_eqn' (f t) = tilt_eqn f t. +Lemma tilt_eqnE (f : K -> 'rV[K]_6) t : + tilt_eqn (f t) = tilt_eqn_functional f t. Proof. by []. Qed. -Lemma tilt_eqnE f t : tilt_eqn f t = tilt_eqn_no_time (f t). +Lemma tilt_eqn_functionalE f t : tilt_eqn_functional f t = tilt_eqn (f t). Proof. by []. Qed. (* TODO: this does not hold, we need locally lipschitz *) -Lemma tilt_eqn_no_time_lipschitz : exists k, k.-lipschitz_setT tilt_eqn_no_time. +Lemma tilt_eqn_lipschitz : exists k, k.-lipschitz_setT tilt_eqn. Proof. near (pinfty_nbhs K) => k. exists k => -[/= x x0] _. -rewrite /tilt_eqn_no_time. +rewrite /tilt_eqn. set fx := row_mx (- alpha1 *: Left x) (gamma *: (Right x - Left x) *m \S('e_2 - Right x) ^+ 2). set fy := row_mx (- alpha1 *: Left x0) @@ -1480,38 +1462,8 @@ Abort.*) Variable (r : {posnum K}). -Lemma derivable_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - derivable f t v -> derivable (fun x => rsubmx (f x)) t v. -Proof. -move=> /= => df1. -apply/derivable_mxP => i j/=. -rewrite (ord1 i). -have /cvg_ex[/= r' Hr]:= df1. -apply/cvg_ex => /=; exists (r'``_(rshift n1 j)). -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hr => /(_ _ e0). -apply: filterS => x. -apply: le_trans. -rewrite [in leRHS]/Num.Def.normr/= mx_normrE. -apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, rshift n1 j)). -by rewrite !mxE. -Qed. - -Lemma derive_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - derivable f t v -> - 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1 _ ('D_v f t). -Proof. -move=> df1; apply/matrixP => i j; rewrite !mxE /=. -rewrite derive_mx ?mxE//=; last exact: derivable_rsubmx. -rewrite derive_mx ?mxE//=; congr ('D_v _ t). -by apply/funext => x; rewrite !mxE. -Qed. - Lemma state_space_tiltS Delta : - state_space (tilt_eqn') r state_space_tilt Delta `<=` state_space_tilt. + state_space tilt_eqn r state_space_tilt Delta `<=` state_space_tilt. Proof. have [Delta0|Delta0] := leP 0 Delta; last first. move=> t. @@ -1612,21 +1564,18 @@ Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). Lemma equilibrium_point1 Delta : - is_equilibrium_point (tilt_eqn') r state_space_tilt Delta point1. + is_equilibrium_point tilt_eqn r state_space_tilt Delta point1. Proof. -split => //=. -- rewrite inE /state_space_tilt /point1. - rewrite /=. +split. +- rewrite inE /state_space_tilt /point1/=. by rewrite rsubmx_const /= subr0 normeE. -- split => //. +- split => //=. split. - + move=> t tDelta. + + move=> t t0Delta. split; first exact: derivable_cst. - rewrite derive1E derive_cst /tilt_eqn /point1; apply/eqP. - - rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. split. - rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP; move => i. - rewrite /=. + rewrite derive1E derive_cst /tilt_eqn_functional /point1; apply/eqP. + rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP; split. + rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP => i. by rewrite lsubmx_const. apply/eqP/rowP; move => i; apply/eqP. rewrite /eqn14b_rhs. @@ -1634,18 +1583,18 @@ split => //=. rewrite /N /=; apply /rowP; move => a. rewrite !mxE. by rewrite subrr. - by move => n; rewrite n scaler0 mul0mx. - + split. - apply: continuous_subspaceT =>x. - exact: cvg_cst. - move => t td /=. - by apply closed_ballxx. + by move => n; rewrite n scaler0 mul0mx. + + split. + apply: continuous_subspaceT =>x. + exact: cvg_cst. + move => t td /=. + by apply closed_ballxx. Qed. Lemma equilibrium_point2 Delta : - is_equilibrium_point (tilt_eqn') r state_space_tilt Delta point2. + is_equilibrium_point tilt_eqn r state_space_tilt Delta point2. Proof. -split => //. +split. - rewrite inE /state_space_tilt /point2 /=. rewrite row_mxKr. rewrite -[X in X - _ ]scale1r. @@ -1654,7 +1603,7 @@ split => //. by rewrite -natrB //= normr1. - split => //. split. - + move=> t tDelta. + + move=> t t0Delta. split; first exact: derivable_cst. rewrite derive1E derive_cst; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. @@ -1664,7 +1613,7 @@ split => //. move => j _; by rewrite mxE. move => k /= i3k. have := ltn_ord i. - by rewrite i3k -ltn_subRL subnn. + by rewrite i3k -ltn_subRL subnn. split. by rewrite scaler_eq0 N0 eqxx orbT. rewrite /eqn14b_rhs. @@ -1842,23 +1791,23 @@ Definition hurwitz n (A : 'M[K]_n) : Prop := (* thm 4.7 p139 + fact: it is exponentially stable*) Definition locally_exponentially_stable_at n (eqn : 'rV[K]_n -> 'rV[K]_n) (point : 'rV[K]_n) : Prop := - hurwitz (Jacobian eqn point). + hurwitz (jacobian eqn point). Lemma tilt_eqn_is_locally_exponentially_stable_at_0 alpha1 gamma : - locally_exponentially_stable_at (tilt_eqn_no_time alpha1 gamma) point1. + locally_exponentially_stable_at (tilt_eqn alpha1 gamma) point1. Proof. rewrite /locally_exponentially_stable_at /jacobian /hurwitz. move => a. move/eigenvalueP => [u] /[swap] u0 H. -have a_eigen : eigenvalue (jacobian (tilt_eqn_no_time alpha1 gamma) point1) a. +have a_eigen : eigenvalue (jacobian (tilt_eqn alpha1 gamma) point1) a. apply/eigenvalueP. exists u. exact: H. exact: u0. -have : root (char_poly (jacobian (tilt_eqn_no_time alpha1 gamma) point1)) a. +have : root (char_poly (jacobian (tilt_eqn alpha1 gamma) point1)) a. rewrite -eigenvalue_root_char. exact : a_eigen. -rewrite /tilt_eqn_no_time /jacobian. +rewrite /tilt_eqn /jacobian. Abort. End hurwitz. @@ -1870,100 +1819,75 @@ Variable alpha1 : K. Variable gamma : K. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. -(*Variable R : K -> 'M[K]_3.*) -Variable Delta : K. - +Let phi := tilt_eqn alpha1 gamma. Variable r : {posnum K}. -(* generalization from the other file *) - -Lemma derivable_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - derivable f t v -> derivable (fun x => lsubmx (f x)) t v. -Proof. -move=> /= => df1. -apply/derivable_mxP => i j/=. -rewrite (ord1 i). -have /cvg_ex[/= l Hl]:= df1. -apply/cvg_ex => /=; exists (l``_(lshift n2 j)). -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hl => /(_ _ e0). -apply: filterS => x. -apply: le_trans. -rewrite [in leRHS]/Num.Def.normr/= mx_normrE. -apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, lshift n2 j)). -by rewrite !mxE. -Qed. - -Lemma derive_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - derivable f t v -> - 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1 _ ('D_v f t). -Proof. -move=> df1; apply/matrixP => i j; rewrite !mxE /=. -rewrite derive_mx ?mxE//=; last exact: derivable_lsubmx. -rewrite derive_mx ?mxE//=; congr ('D_v _ t). -by apply/funext => x; rewrite !mxE. -Qed. +Variable Delta : K. Lemma derive_zp1 (z : K) (sol : K -> 'rV_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> + is_sol phi r Delta sol state_space_tilt -> z \in `]0, Delta[ -> 'D_1 (Left \o sol) z = - alpha1 *: Left (sol z). Proof. -move=> [/= traj0 [_ [dtraj btraj] ] zd]. -have [_ +] := dtraj _ zd. +move=> [/= traj0 [_ [deri [conti cball]]] z0Delta]. +have [derivable_sol +] := deri _ z0Delta. move=> /(congr1 Left). -rewrite derive1E. -rewrite row_mxKl => ?; rewrite derive_lsubmx//=. -by apply dtraj. -Qed. +by rewrite derive1E row_mxKl => ?; rewrite derive_lsubmx. +Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> + is_sol phi r Delta sol state_space_tilt -> z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. -move=> [/= traj0 [_ [dtraj btraj] ] zd]. -have [_ +] := dtraj _ zd. +move=> [/= traj0 [_ [deriv [conti cball]]] z0Delta]. +have [derivable_sol +] := deriv _ z0Delta. move => /(congr1 Right). rewrite derive1E. -rewrite row_mxKr => ?; rewrite derive_rsubmx //. -by apply dtraj. +by rewrite row_mxKr => ?; rewrite derive_rsubmx. Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> + t \in `[0, Delta[%R -> + is_sol phi r Delta sol state_space_tilt -> state_space_tilt (sol t). Proof. -case => sol0 [_[ deriv_sol bsol]]. -apply: (@state_space_tiltS _ alpha1 gamma) => //=. -exists sol; split => //. -(*by exists t. -Qed.*) Admitted. +move=> t0Delta. +case => sol0 [_ [deriv_sol [csol cball]]]. +move: t0Delta. +rewrite in_itv/= => /andP[]. +rewrite le_eqVlt => /predU1P[<- Delta0|t0 tDelta]. + exact/set_mem. +apply: (@state_space_tiltS _ alpha1 gamma r Delta) => //=. +exists sol; split => //=. +exists t; split => //. +by rewrite in_itv/= t0. +Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> norm u = 1. + z \in `[0, Delta[%R -> + is_sol phi r Delta sol state_space_tilt -> norm u = 1. Proof. -move=> dtraj. +move=> z0Delta dtraj. suff: state_space_tilt (row_mx (zp1 z) (z2 z)). by rewrite /state_space_tilt/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. -exact: is_sol_state_space_tilt. +by apply: is_sol_state_space_tilt => //. Qed. -Lemma angvel_sqr (traj : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (traj r) : 'rV_3) +Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r traj -> + z \in `[0, Delta[%R -> + is_sol phi r Delta sol state_space_tilt -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. -move=> dtraj. +move=> z0Delta dtraj. rewrite /dotmul !trmx_mul !tr_spin !mulNmx mulmxN opprK mulmxN !dotmulP. have key_ortho : (z2 z *m \S('e_2)) *d u = 0. by rewrite dotmulC; exact/ortho_spin. rewrite key_ortho expr2. rewrite [in RHS]mxE. -rewrite [X in _ = - (w *m (\S('e_2) *m (z2 z)^T)) 0 0 * (u *d u)%:M 0 0 - 0%:M 0 0 * X]mxE mulr1n mulr0 subr0/=. +rewrite [X in _ = - (w *m (\S('e_2) *m (z2 z)^T)) 0 0 * (u *d u)%:M 0 0 - 0%:M 0 0 * X]mxE. +rewrite mulr1n mulr0 subr0/=. rewrite /u -/w /dotmul. have Hw_ortho : (w *d u) = 0 by rewrite /u dotmulC ortho_spin. rewrite !mulmxA dotmulP dotmulvv norm_e2z2 // expr2 mulr1. @@ -1975,23 +1899,26 @@ rewrite [in LHS]mulmxBr mulmxA wu0 sub0r. by rewrite 2!mulNmx mulmx1 mxE. Qed. -Lemma neg_spin (traj : K -> 'rV_6) (z : K) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r traj -> - norm (Right (traj z) *m \S('e_2) *m - \S('e_2 - Right (traj z))) = - norm (Right (traj z) *m \S('e_2)). +Lemma neg_spin (sol : K -> 'rV_6) (z : K) : + z \in `[0, Delta[%R -> + is_sol phi r Delta sol state_space_tilt-> + norm (Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))) = + norm (Right (sol z) *m \S('e_2)). Proof. +move=> z0Delta. move=> dtraj. rewrite mulmxN normN. -pose zp1 := fun r => Left (traj r). -pose z2 := fun r => Right (traj r). +pose zp1 := fun r => Left (sol r). +pose z2 := fun r => Right (sol r). set w := (z2 z) *m \S('e_2). -have Gamma1_traj t : state_space_tilt (traj t) by apply/is_sol_state_space_tilt. +have Gamma1_traj : state_space_tilt (sol z). + by apply/is_sol_state_space_tilt. rewrite /norm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. -have Hnorm_sq : norm (w *m \S('e_2 - Right (traj z))) ^+ 2 = norm w ^+ 2. +have Hnorm_sq : norm (w *m \S('e_2 - Right (sol z))) ^+ 2 = norm w ^+ 2. rewrite -!dotmulvv angvel_sqr// !dotmulvv norm_e2z2//=. rewrite -!dotmulvv expr2 !mul1r mulr1. - have -> : w *d ('e_2 - Right (traj z)) = 0 by rewrite dotmulC ortho_spin. + have -> : w *d ('e_2 - Right (sol z)) = 0 by rewrite dotmulC ortho_spin. by rewrite expr2 mul0r subr0. rewrite !normr_norm. by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?norm_ge0. @@ -2002,7 +1929,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> + is_sol phi r Delta sol state_space_tilt -> z \in `]0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + @@ -2027,12 +1954,13 @@ rewrite tr_sqr_spin. by rewrite mulmxA. Qed. -Lemma derive_along_V1 (x : 'rV[K]_6) t sol : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> +Lemma derive_along_V1 (x : 'rV[K]_6) t (sol : 'rV_6 -> K -> 'rV_6) : + t \in `]0, Delta[ -> + is_sol phi r Delta (sol x) state_space_tilt -> (forall t, differentiable (sol x) t) -> - 'D~(sol x(*, x*)) (V1 alpha1 gamma) t = V1dot (sol x t). + 'D~(sol x) (V1 alpha1 gamma) t = V1dot (sol x t). Proof. -rewrite /tilt_eqn => tilt_eqnx dif1. +move=> t0Delta tilt_eqnx dif1. rewrite /V1 derive_alongD; last 3 first. apply/differentiableM => //=. exact/differentiable_norm_squared/differentiable_lsubmx. @@ -2050,10 +1978,10 @@ rewrite -fctE /= !derive_along_norm_squared//=. by rewrite /c1 /c2 !invfM. rewrite /= in tilt_eqnx. exact: tilt_eqnx. -- admit. +- assumption. - exact/differentiable_lsubmx. - exact/differentiable_rsubmx. -Admitted. +Qed. Definition u1 (sol : K -> 'rV[K]_6) t (zp1 := Left \o sol) (z2 := Right \o sol) @@ -2061,11 +1989,11 @@ Definition u1 (sol : K -> 'rV[K]_6) t \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 t), 1 |-> norm w] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r sol -> - forall t, + is_sol phi r Delta sol state_space_tilt -> + forall t, t \in `[0, Delta[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. -move=> dtraj z. +move=> dtraj z z0Delta. set w := z2 z *m \S('e_2). rewrite /V1dot. rewrite mxE norm_spin mxE addrA expr2 mulmxA. @@ -2094,8 +2022,8 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) -Lemma derive_along_Left_Right_le0 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> +Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : + is_sol phi r Delta (sol x) state_space_tilt -> sol x 0 = point1 -> \forall z \near 0^', ('D~(sol x) (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) + @@ -2134,11 +2062,11 @@ under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. (* have [->|H] := eqVneq u1 0. *) (* by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. *) (* by rewrite leNgt 2!mulNmx mxE oppr_gt0 -leNgt ltW// u2_quadratic_form_gt0. *) -Unshelve. all: try by end_near. Admitted. +Unshelve. all: try by end_near. Abort. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> + is_sol phi r Delta (sol x) state_space_tilt -> sol x 0 = point1 -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. @@ -2176,9 +2104,9 @@ Proof. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0.*) Abort. -Lemma locnegdef_derive_along_V1 sol (x : 'rV[K]_6) +Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> + is_sol phi r Delta (sol x) state_space_tilt -> (forall t : K, state_space_tilt (sol x t)) -> sol x 0 = point1 -> locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. @@ -2196,7 +2124,9 @@ split. exact/differentiable_norm_squared/differentiable_lsubmx. near=> z0. rewrite derive_along_V1. -- have V1dot_le := V1dot_ub solves z0 => //. +- have z00Delta : z0 \in `[0, Delta[%R. + admit. + have V1dot_le := V1dot_ub solves z00Delta => //. set w := z2 z0 *m \S('e_2). set u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z0), 1 |-> norm w] i. @@ -2218,11 +2148,14 @@ rewrite derive_along_V1. rewrite mxE/=. apply/eqP => Habs. admit. +- admit. - by []. - move => t. apply/derivable1_diffP => //. move : solves; rewrite /is_sol. -(* by case.*) admit. + case => _ [_ [deri [conti cball]]]. + apply deri. + admit. Unshelve. all: by end_near. Abort. (*Definition is_Lyapunov_stable_at {K : realType} {n} @@ -2247,14 +2180,15 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 sol (x : 'rV[K]_6) : - is_sol (tilt_eqn' alpha1 gamma) state_space_tilt Delta r (sol x) -> + is_sol phi r Delta (sol x) state_space_tilt -> (forall t, differentiable (sol x) t) -> - forall t : K, 0 <= t -> + forall t : K, 0 <= t < Delta -> 'D~(sol x) (V1 alpha1 gamma) t <= 0. Proof. move=> solves diff t t0. rewrite derive_along_V1//. -have Hub := V1dot_ub solves t. +have t0Delta : t \in `[0, Delta[%R by rewrite in_itv/=. +have Hub := V1dot_ub solves t0Delta. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> norm ((Left \o sol x) t), @@ -2269,7 +2203,7 @@ have Hquad : let u1 := \row_i [eta fun=> 0 by rewrite !mul0mx mxE. by rewrite ltW// u2_quadratic_form_gt0. by rewrite -oppr_ge0 !mulNmx mxE opprK Hquad. -Qed. +Admitted. End tilt_eqn_Lyapunov. @@ -2278,24 +2212,16 @@ Context {K : realType}. Variables gamma alpha1 : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Let phi := tilt_eqn' alpha1 gamma. +Let phi := tilt_eqn alpha1 gamma. Variable Init : set 'rV[K]_6. Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. Variable Delta : K. Variable r : {posnum K}. -(*Hypothesis solP : existence_uniqueness phi Init sol.*) -(*Hypothesis sol0 : initial_condition sol.*) -Check is_sol_autonomous. - -Hypothesis solP : -( is_sol_autonomous 0 phi r 0 Delta (sol 0)). - +Hypothesis solP : is_sol_autonomous 0 phi r 0 Delta (sol 0). Hypothesis y0 : 0 \in Init. -Notation is_sol := (is_sol phi Init). - (* Hypothesis y_sol : is_sol Delta (sol 0). *) (* Hypothesis y00 : sol 0 0 = 0. *) @@ -2313,34 +2239,39 @@ Lemma equilibrium_zero_stable : is_locally_stable_at point1 Delta (sol 0). Proof. move=> openInit Init0 Init_in_state. -Check @Lyapunov_stability. -apply: (@Lyapunov_stability K _ phi Init Delta sol r solP openInit (V1 alpha1 gamma)). +apply: (@Lyapunov_stability K _ phi r Delta Init sol solP openInit (V1 alpha1 gamma)). - move=> t. - apply/differentiableD => //. - apply/differentiableM => //. + apply/differentiableD => //=. + apply/differentiableM => //=. exact/differentiable_norm_squared/differentiable_lsubmx. - apply/differentiableM => //. + apply/differentiableM => //=. exact/differentiable_norm_squared/differentiable_rsubmx. - move=> z zD t t0. - apply: (@derive_along_V1_le0 _ _ _ _ _ Delta). - assumption. - assumption. - + apply: (is_sol_subset Init_in_state). + apply: (@derive_along_V1_le0 _ _ _ _ _ r Delta sol). + + assumption. + + assumption. + + apply: (@is_sol_subset _ _ _ _ Delta _ _ _ Init_in_state). + split. + admit. + rewrite -/phi. admit. (* pbm *) -(* by apply solP; rewrite sol0.*) - + move=> t1. + + move=> /= t1. rewrite -derivable1_diffP. + case: solP => _/= [+ _]. + move/(_ t1) => H. (*have : is_sol (sol z) by apply solP; rewrite sol0. by case.*) admit. -- assumption. +- rewrite t0/=. + admit. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. rewrite /is_Lyapunov_candidate /point1 => Hpos. rewrite /V1 lsubmx_const rsubmx_const; split => //. split. by rewrite !expr2 !norm0 !mulr0 !mul0r add0r. move=> z zin z_neq0. - case : Hpos => // _ [_]. - by apply => //; rewrite inE. + case : Hpos => // _ [V1_eq0 V1_gt0]. + apply: V1_gt0 => //. + by rewrite inE. - exact/is_equilibrium_subset/equilibrium_point1. Admitted. diff --git a/tilt_analysis.v b/tilt_analysis.v index 841c33c8..1e699600 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -134,35 +134,7 @@ under eq_fun do rewrite -dotmulvv. exact: differentiable_dotmul. Qed.*) (* this one too *) -(*Lemma derivable_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - (forall x, derivable f x v) -> derivable (fun x => rsubmx (f x)) t v. -Proof. -move=> /= => df1. -apply/derivable_mxP => i j/=. -rewrite (ord1 i). -have /cvg_ex[/= r Hr]:= df1 t. -apply/cvg_ex => /=; exists (r``_(rshift n1 j)). -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hr => /(_ _ e0). -apply: filterS => x. -apply: le_trans. -rewrite [in leRHS]/Num.Def.normr/= mx_normrE. -apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, rshift n1 j)). -by rewrite !mxE. -Qed.*) -(*Lemma derive_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - (forall x, derivable f x v) -> - 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1 _ ('D_v f t). -Proof. -move=> df1; apply/matrixP => i j; rewrite !mxE /=. -rewrite derive_mx ?mxE//=; last exact: derivable_rsubmx. -rewrite derive_mx ?mxE//=; congr ('D_v _ t). -by apply/funext => x; rewrite !mxE. -Qed.*) (*DONE*) Lemma differentiable_rsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : differentiable (@rsubmx R 1 n1 n2) t. @@ -183,6 +155,7 @@ apply: (le_lt_trans _ (uv i (rshift n1 j))). by rewrite !mxE. Qed. (*DONE*) + Lemma differentiable_rsubmx {R : realFieldType} (V : normedModType R) {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t : (forall x, differentiable f x) -> @@ -192,36 +165,7 @@ move=> /= => df1. apply: differentiable_comp => //. exact: differentiable_rsubmx0. Qed. -(*TODO*) -Lemma derivable_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - (forall x, derivable f x v) -> derivable (fun x => lsubmx (f x)) t v. -Proof. -move=> /= => df1. -apply/derivable_mxP => i j/=. -rewrite (ord1 i). -have /cvg_ex[/= l Hl]:= df1 t. -apply/cvg_ex => /=; exists (l``_(lshift n2 j)). -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hl => /(_ _ e0). -apply: filterS => x. -apply: le_trans. -rewrite [in leRHS]/Num.Def.normr/= mx_normrE. -apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, lshift n2 j)). -by rewrite !mxE. -Qed. -Lemma derive_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - (forall x, derivable f x v) -> - 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1 _ ('D_v f t). -Proof. -move=> df1; apply/matrixP => i j; rewrite !mxE /=. -rewrite derive_mx ?mxE//=; last exact: derivable_lsubmx. -rewrite derive_mx ?mxE//=; congr ('D_v _ t). -by apply/funext => x; rewrite !mxE. -Qed. (*DONE*) Lemma differentiable_lsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : differentiable (@lsubmx R 1 n1 n2) t. @@ -259,6 +203,7 @@ rewrite -[in RHS]deriveE; last first. by []. rewrite derive_lsubmx//. Abort.*) + (*DONE*) Lemma differentiable_lsubmx {R : realFieldType} (V : normedModType R) {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t : diff --git a/tilt_robot.v b/tilt_robot.v index 4af60f33..5a12a046 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -114,55 +114,6 @@ Proof. by rewrite dotmulBl dotmulC dotmulspin1 dotmulC dotmulspin2 subr0. Qed. Lemma norm_squared {R : rcfType} n (u : 'rV[R]_n) : (u *m (u)^T) 0 0 = norm u ^+2. Proof. by rewrite -dotmulvv /dotmul. Qed. - (* TODO in tilt_analysis.v *) -Lemma derivable_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - (forall x, derivable f x v) -> derivable (fun x => rsubmx (f x)) t v. -Proof. -move=> /= => df1. -apply/derivable_mxP => i j/=. -rewrite (ord1 i). -have /cvg_ex[/= r Hr]:= df1 t. -apply/cvg_ex => /=; exists (r``_(rshift n1 j)). -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hr => /(_ _ e0). -apply: filterS => x. -apply: le_trans. -rewrite [in leRHS]/Num.Def.normr/= mx_normrE. -apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, rshift n1 j)). -by rewrite !mxE. -Qed. - -Lemma derive_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - (forall x, derivable f x v) -> - 'D_v (fun x => rsubmx (f x)) t = @rsubmx _ _ n1 _ ('D_v f t). -Proof. -move=> df1; apply/matrixP => i j; rewrite !mxE /=. -rewrite derive_mx ?mxE//=; last exact: derivable_rsubmx. -rewrite derive_mx ?mxE//=; congr ('D_v _ t). -by apply/funext => x; rewrite !mxE. -Qed. - -Lemma differentiable_rsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : - differentiable (@rsubmx R 1 n1 n2) t. -Proof. -have lin_rsubmx : linear (@rsubmx R 1 n1 n2). - move=> a b c. - by rewrite linearD//= linearZ. -pose build_lin_rsubmx := GRing.isLinear.Build _ _ _ _ _ lin_rsubmx. -pose Rsubmx : {linear 'rV[R^o]_(n1 + n2) -> 'rV[R^o]_n2} := HB.pack (@rsubmx R _ _ _) build_lin_rsubmx. -apply: (@linear_differentiable _ _ _ Rsubmx). -move=> /= u A /=. -move/nbhs_ballP=> [e /= e0 eA]. -apply/nbhs_ballP; exists e => //= v [? uv]. -apply: eA; split => //. -(* TODO: lemma *) -move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. -apply: (le_lt_trans _ (uv i (rshift n1 j))). -by rewrite !mxE. -Qed. Global Instance is_diff_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} (f df : V -> 'rV[R]_(n1 + n2)) t : @@ -181,64 +132,14 @@ rewrite -[in RHS]deriveE; last first. rewrite derive_rsubmx//. Abort. -Lemma differentiable_rsubmx {R : realFieldType} (V : normedModType R) {n1 n2} +Lemma differentiable_rsubmx_comp {R : realFieldType} (V : normedModType R) {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t : (forall x, differentiable f x) -> differentiable (fun x => rsubmx (f x)) t. Proof. move=> /= => df1. apply: differentiable_comp => //. -exact: differentiable_rsubmx0. -Qed. - -Lemma derivable_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - (forall x, derivable f x v) -> derivable (fun x => lsubmx (f x)) t v. -Proof. -move=> /= => df1. -apply/derivable_mxP => i j/=. -rewrite (ord1 i). -have /cvg_ex[/= l Hl]:= df1 t. -apply/cvg_ex => /=; exists (l``_(lshift n2 j)). -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hl => /(_ _ e0). -apply: filterS => x. -apply: le_trans. -rewrite [in leRHS]/Num.Def.normr/= mx_normrE. -apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, lshift n2 j)). -by rewrite !mxE. -Qed. - -Lemma derive_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t v : - (forall x, derivable f x v) -> - 'D_v (fun x => lsubmx (f x)) t = @lsubmx _ _ n1 _ ('D_v f t). -Proof. -move=> df1; apply/matrixP => i j; rewrite !mxE /=. -rewrite derive_mx ?mxE//=; last exact: derivable_lsubmx. -rewrite derive_mx ?mxE//=; congr ('D_v _ t). -by apply/funext => x; rewrite !mxE. -Qed. - -Lemma differentiable_lsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : - differentiable (@lsubmx R 1 n1 n2) t. -Proof. -have lin_lsubmx : linear (@lsubmx R 1 n1 n2). - move=> a b c. - by rewrite linearD//= linearZ. -pose build_lin_lsubmx := GRing.isLinear.Build _ _ _ _ _ lin_lsubmx. -pose Lsubmx : {linear 'rV[R^o]_(n1 + n2) -> 'rV[R^o]_n1} := - HB.pack (@lsubmx R _ _ _) build_lin_lsubmx. -apply: (@linear_differentiable _ _ _ Lsubmx). -move=> /= u A /=. -move/nbhs_ballP=> [e /= e0 eA]. -apply/nbhs_ballP; exists e => //= v [? uv]. -apply: eA; split => //. -(* TODO: lemma *) -move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. -apply: (le_lt_trans _ (uv i (lshift n2 j))). -by rewrite !mxE. +exact: differentiable_rsubmx. Qed. (*Global Instance is_diff_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} @@ -258,7 +159,7 @@ rewrite -[in RHS]deriveE; last first. rewrite derive_lsubmx//. Abort.*) -Lemma differentiable_lsubmx {R : realFieldType} (V : normedModType R) {n1 n2} +Lemma differentiable_lsubmx_comp {R : realFieldType} (V : normedModType R) {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t : (forall x, differentiable f x) -> differentiable (fun x => lsubmx (f x)) t. @@ -329,8 +230,8 @@ rewrite jj1 => /(congr1 val) => /= /eqP. by rewrite eqn_add2l => /eqP /val_inj. Qed. - -Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. +Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : + char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. Proof. set P := (RHS). apply/polyP => -[|[|[|i]]]; last first. From 3f7a84572f2b37a086c1117e1e57ca06c27a9754 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 25 Jan 2026 19:02:26 +0900 Subject: [PATCH 073/144] fix stability def --- tilt.v | 401 ++++++++++++++++++++++++++++++++------------------------- 1 file changed, 225 insertions(+), 176 deletions(-) diff --git a/tilt.v b/tilt.v index 09960fee..45dd1925 100644 --- a/tilt.v +++ b/tilt.v @@ -17,12 +17,11 @@ Require Import tilt_mathcomp tilt_analysis tilt_robot. (* locnegsemidef V x == V is locally negative semidefinite *) (* 'D~(sol, x0) V == derivative of V along the solution sol *) (* starting at x0 *) -(* is_sol_autonomous u0 phi r t0 t1 f == solution of an autonomous ODE *) +(* is_sol_autonomous u0 phi t0 t1 f == solution of an autonomous ODE *) (* initial_condition u0 *) (* equation phi *) -(* solution stays in B_u0(r) *) (* solution f on [t0, t1] *) -(* is_sol phi r Delta f Init := is_sol_autonomous (f 0) phi r 0 Delta f *) +(* is_sol phi Delta f Init := is_sol_autonomous (f 0) phi 0 Delta f *) (* + f 0 \in Init *) (* is_equilibrium_point f p := solves_equation f (cst p) *) (* state_space f == the set points attainable by a solution *) @@ -369,11 +368,13 @@ Variable phi : U -> U. Variable r : {posnum R}. Let B := closed_ball u0 r%:num. +Definition stays_in_ball (t0 t1 : R) (f : R -> U) := + {in `[t0, t1], forall t, closed_ball u0 r%:num (f t)}. + Definition is_sol_autonomous (t0 t1 : R) (f : R -> U) := f t0 = u0 /\ {in `]t0, t1[, forall x, derivable f x 1 /\ f^`() x = phi (f x)} /\ - {within `[t0, t1], continuous f} /\ - {in `[t0, t1], forall t, closed_ball u0 r%:num (f t)}. + {within `[t0, t1], continuous f}. Variable k : R. Hypothesis k0 : 0 < k. @@ -392,8 +393,8 @@ Let U := 'rV[K]_n. Variable phi : U -> U. -Definition is_sol (r : {posnum K}) (Delta : K) (f : K -> U) (Init : set U) := - f 0 \in Init /\ is_sol_autonomous (f 0) phi r 0 Delta f. +Definition is_sol (Delta : K) (f : K -> U) (Init : set U) := + f 0 \in Init /\ is_sol_autonomous (f 0) phi 0 Delta f. End ode. @@ -401,13 +402,12 @@ Section is_sol. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : T -> T. -Variable r : {posnum K}. Variable Delta : K. Lemma is_sol_subset f (A B : set T) (AB : A `<=` B) : - is_sol phi r Delta f A -> is_sol phi r Delta f B. + is_sol phi Delta f A -> is_sol phi Delta f B. Proof. -rewrite /is_sol inE => -[inD0 [_ [deri [cont cball]]]]; rewrite inE. +rewrite /is_sol inE => -[inD0 [_ [deri cont]]]; rewrite inE. split => //. by apply: AB. Qed. @@ -418,11 +418,14 @@ Section state_space. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : T -> T. -Variable r : {posnum K}. -Definition state_space (Init : set T) (Delta : K) : set T:= - [set x | exists f, (is_sol phi r Delta f Init /\ - (exists t, t \in `]0, Delta[%R /\ x = f t))]. +Definition state_space (Init : set T) : set T := + [set x | exists f Delta, (is_sol phi Delta f Init /\ + (exists t, t \in `[0, Delta]%R /\ x = f t))]. + +(*Definition state_space (Init : set T) (Delta : K) : set T:= + [set x | exists f, (is_sol phi Delta f Init /\ + (exists t, t \in `]0, Delta[%R /\ x = f t))].*) End state_space. @@ -430,11 +433,11 @@ Section equilibrium_point. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : T -> T. (* was (K -> T) -> K -> T *) -Variable r : {posnum K}. Variable Init : set T. Variable Delta : K. -Definition is_equilibrium_point (x : T) := is_sol phi r Delta (cst x) Init. +Definition is_equilibrium_point (x : T) := + forall Delta, is_sol phi Delta (cst x) Init. End equilibrium_point. @@ -442,32 +445,34 @@ Section equilibrium_point. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : T -> T. -Variable r : {posnum K}. -Variable Delta : K. Lemma is_equilibrium_point_subset x (A B : set T) (AB : A `<=` B) : - is_equilibrium_point phi r A Delta x -> is_equilibrium_point phi r B Delta x. + is_equilibrium_point phi A x -> is_equilibrium_point phi B x. Proof. -rewrite /is_equilibrium_point /is_sol inE => -[inD0 [deriv [cont tilt]]]. +rewrite /is_equilibrium_point /is_sol inE => H Delta. +have [inD0 [deriv [cont tilt]]] := H Delta. rewrite inE; split => //. exact: AB. Qed. Definition equilibrium_points Init := - [set p : T | is_equilibrium_point phi r Init Delta p ]. + [set p : T | is_equilibrium_point phi Init p ]. End equilibrium_point. Section stability. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. +Variable phi : T -> T. +Variable Init : set T. Definition is_stable_at (x : T) (z : K -> 'rV[K]_n) := forall eps, eps > 0 -> exists2 d, d > 0 & `| z 0 - x | < d -> forall t, t >= 0 -> `| z t - x | < eps. -Definition is_locally_stable_at (x : T) (Delta : K) (z : K -> 'rV[K]_n) := +Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & + forall (z : K -> 'rV[K]_n) (Delta : K), is_sol phi Delta z Init -> `| z 0 - x | < d -> forall t, 0 <= t < Delta -> `| z t - x | < eps. Definition is_asymptotically_stable_at (x : T) (z : K -> 'rV[K]_n) : Prop := @@ -628,41 +633,28 @@ apply/continuous_within_itvP => //; split => //. by rewrite in_itv/= lexx/= ltW. Qed. -Section Lyapunov_stability. +Section Lyapunov_stability0. Context {K : realType} {n : nat}. Let U := 'rV[K]_n.+1. Variable phi : U -> U. -Variable r' : {posnum K}. Variable Delta : K. -Variable Init : set U. -Variable sol : U -> K -> U. -Let u0 : U := 0. -Hypothesis Initu0 : u0 \in Init. -Hypothesis solP : is_sol_autonomous u0 phi r' 0 Delta (sol u0). - -Hypothesis openD : open Init. (* D est forcement un ouvert *) -(* see Cohen Rouhling ITP 2017 Sect 3.2 *) - -Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. - -Let BE s : 0 < s -> B s = closed_ball 0 s. -Proof. by move=> r0; rewrite /B -closed_ballE. Qed. +Variable u0 : U. +Variable sol : K -> U. +Hypothesis solP : is_sol_autonomous u0 phi 0 Delta sol. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall x, x \in Init -> - forall t, t >= 0 -> 'D~(sol x) V t <= 0. +Hypothesis V'_le0 : forall t, 0 <= t < Delta -> 'D~(sol) V t <= 0. -Let V_nincr a b : b < Delta -> 0 <= a <= b -> - forall x, x \in Init -> is_sol phi r' Delta (sol x) Init -> - V (sol x b) <= V (sol x a). +Lemma V_nincr a b : b < Delta -> 0 <= a <= b -> + V (sol b) <= V (sol a). Proof. -move=> bDelta /andP[a_ge0 ab] x /set_mem xD solP'. -apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. +move=> bDelta /andP[a_ge0 ab]. +apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. - move=> y yb. apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. rewrite -derivable1_diffP. - case: solP' => /= h0Init [_ [+ _]]. + case: solP => /= h0Init [+ _]. move/(_ y) /(_ _) => []. move: yb. rewrite inE/=. @@ -671,11 +663,11 @@ apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. by []. - move=> y yb. rewrite derive1E -derive_along_derive//. - + apply: (V'_le0 (x := x)). - exact/mem_set. - by move : yb; rewrite in_itv/= => /andP[/ltW]. + + apply: V'_le0. + move : yb; rewrite in_itv/= => /andP[/ltW ->/= /lt_le_trans]; apply. + exact: ltW. + rewrite -derivable1_diffP. - case: solP' => /= h0Init [_ [+ _]]. + case: solP => /= h0Init [+ _]. move/(_ y) /(_ _) => []. move: yb. rewrite inE/=. @@ -695,14 +687,14 @@ apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. apply: continuous_comp; last exact: differentiable_continuous. apply: differentiable_continuous => //. rewrite -derivable1_diffP. - case: solP' => /= h0Init [_ [+ _]]. + case: solP => /= h0Init [+ _]. move/(_ z) /(_ _) => []. move: z0b. rewrite inE/=. apply: subset_itvl. by rewrite bnd_simp ltW. by []. - + case: solP' => solu0u0 [_ [deri [cont _]]]. + + case: solP => solu0u0 [deri cont]. (* filled this *) apply: cvg_comp. have d0 : 0 < Delta. @@ -710,12 +702,12 @@ apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. have /continuous_within_itvP := cont. move/(_ d0) => [_ + _]. apply. - apply (differentiable_continuous (Vdiff (sol x 0))). + apply (differentiable_continuous (Vdiff (sol 0))). + apply: cvg_at_left_filter. apply: differentiable_continuous => //. apply: differentiable_comp. rewrite -derivable1_diffP. - case: solP' => /= h0Init [_ [+ _]]. + case: solP => /= h0Init [+ _]. move/(_ b) /(_ _) => []. by rewrite inE/= in_itv/= b0 bDelta. by []. @@ -724,11 +716,34 @@ apply: (@ler0_derive1_le_cc _ (V \o sol x) 0 b) => //=. - by rewrite in_itv/= ab andbT. Qed. +End Lyapunov_stability0. + +Section Lyapunov_stability. +Context {K : realType} {n : nat}. +Let U := 'rV[K]_n.+1. +Variable phi : U -> U. +Variable Init : set U. +Let u0 : U := 0. +Hypothesis Initu0 : u0 \in Init. + +Hypothesis openD : open Init. (* D est forcement un ouvert *) +(* see Cohen Rouhling ITP 2017 Sect 3.2 *) + +Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. + +Let BE s : 0 < s -> B s = closed_ball 0 s. +Proof. by move=> r0; rewrite /B -closed_ballE. Qed. + +Variable V : U -> K. +Hypothesis Vdiff : forall t : U, differentiable V t. +Hypothesis V'_le0 : forall Delta sol, is_sol phi Delta sol Init -> + forall t, 0 <= t < Delta -> 'D~(sol) V t <= 0. + (* khalil theorem 4.1 *) Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) : is_Lyapunov_candidate V Init x -> - is_equilibrium_point phi r' Init Delta x -> - is_locally_stable_at x Delta (sol x). + is_equilibrium_point phi Init x -> + is_locally_stable_at phi Init x. Proof. move=> VDx eq /= eps eps0/=. move: VDx => [/= xD [Vx0 DxV]]. @@ -777,29 +792,32 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta : - sol x 0 \in Omega_beta -> forall t, 0 <= t < Delta -> sol x t \in Omega_beta. - move=> phi_Omega. +have Df_Omega_beta Delta sol : + is_sol phi Delta sol Init -> + sol 0 \in Omega_beta -> forall t, 0 <= t < Delta -> sol t \in Omega_beta. + move=> solP phi_Omega. have /= V_nincr_consequence : forall t, 0 <= t < Delta -> forall u, 0 <= u <= t -> - 'D~(sol x) V u <= 0 -> - V (sol x t) <= V (sol x 0) <= beta. + 'D~(sol) V u <= 0 -> + V (sol t) <= V (sol 0) <= beta. move=> /= t1 /andP[t10 t1Delta] u ut1 Vle0. apply/andP; split. move : phi_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. - apply: V_nincr. + apply: (@V_nincr _ _ phi Delta (sol 0) sol solP.2). assumption. - by rewrite lexx t10. + move=> /= t t0. + apply: V'_le0. + exact: solP. + assumption. + assumption. + rewrite lexx/=. assumption. - split. - apply/mem_set. - by apply: BrD. - move: solP. - by case: solP => ->. by move: phi_Omega; rewrite inE => -[Brh0 Vh0beta]. move=> t /andP[t0 tDelta]. rewrite inE; split; last first. - have : 'D~(sol x) V t <= 0. - by apply: V'_le0 => //; case: sol_phi. + have : 'D~(sol) V t <= 0. + apply: V'_le0 => //. + exact: solP. + by rewrite t0/=. have := @V_nincr_consequence t. rewrite t0 /= tDelta => /(_ isT t). rewrite lexx t0/= => /(_ isT). @@ -808,31 +826,34 @@ have Df_Omega_beta : move: phi_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. rewrite !sub0r !normrN => -[phi0r Vphi0beta]. rewrite leNgt; apply/negP => phi_t_r. - have [t1 [/andP[t1_ge0 t1t] phit1r]] : exists t0, 0 <= t0 <= t/\ `|sol x t0| = r. - have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o sol x)}. + have [t1 [/andP[t1_ge0 t1t] phit1r]] : exists t0, 0 <= t0 <= t/\ `|sol t0| = r. + have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o sol)}. (* `[0, t] *) - apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) (sol x)) => //. + apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) (sol)) => //. move=> z _. by apply: norm_continuous. - case: solP => _ [_ [+ _]]. + case: solP => sol0init [_ [_]]. apply: continuous_subspaceW. apply: subset_itvl. by rewrite bnd_simp ltW. - have : min `|sol x 0| `|sol x t| <= r <= max `|sol x 0| `|sol x t|. + have : min `|sol 0| `|sol t| <= r <= max `|sol 0| `|sol t|. by rewrite ge_min phi0r/= le_max (ltW phi_t_r) orbT. move=> /(IVT t0 norm_phi_cont)[c cI norm_phi_c]. by exists c; split => //; move/itvP: cI => ->. - have alphaVphit1 : alpha <= V (sol x t1). + have alphaVphit1 : alpha <= V (sol t1). rewrite {alpha_gt0 beta_alpha} /alpha; case: alpha_min => /=. by move=> y [_ +]; apply; rewrite inE. - have : beta < V (sol x t1). + have : beta < V (sol t1). by rewrite (lt_le_trans _ alphaVphit1)//; case/andP : beta_alpha. apply/negP; rewrite -leNgt. have := @V_nincr_consequence t1. rewrite t1_ge0 (le_lt_trans t1t tDelta) => /(_ isT). move=> /(_ t1). rewrite t1_ge0 lexx => /(_ isT). - have : 'D~(sol x) V t1 <= 0 by apply: V'_le0 => //; case: sol_phi. + have : 'D~(sol) V t1 <= 0. + apply: V'_le0. + exact: solP. + by rewrite t1_ge0/= (le_lt_trans _ tDelta). move=> /[swap] /[apply]. by move=> /andP[/le_trans] => /[apply]. have _ : compact Omega_beta. @@ -872,24 +893,29 @@ have B_delta_Omega_beta : B delta `<=` Omega_beta. rewrite /B /closed_ball_/= sub0r normrN => vdelta. split; last exact/ltW/deltaV. by rewrite (le_trans vdelta)// /delta ge_min lexx orbT. -have _ : (B delta) (sol x 0) -> +(*have _ : (B delta) (sol x 0) -> forall t, t >= 0 -> sol x t \in Omega_beta -> (B r) (sol x t). - by move => ball0 t1 t1_ge0; rewrite /Omega_beta inE => -[]. -rewrite /x !subr0. -exists delta => // sol0_delta t0 t0_ge0. + by move => ball0 t1 t1_ge0; rewrite /Omega_beta inE => -[].*) +rewrite /x. +exists delta => //. +move=> sol Delta' solP sol_delta t0 t0_ge0. rewrite subr0. -have : sol x 0 \in Omega_beta. +have : sol 0 \in Omega_beta. rewrite inE; apply: B_delta_Omega_beta. - by rewrite /B /closed_ball_/= sub0r normrN; apply/ltW; exact: sol0_delta. + rewrite /B /closed_ball_/= sub0r normrN; apply/ltW. + by rewrite subr0 in sol_delta. rewrite inE => -[+ _]. rewrite /B /closed_ball_/= sub0r normrN => solx0r. -have : (B r)° (sol x t0). +have : (B r)° (sol t0). apply: Omega_beta_Br; apply/set_mem. apply: Df_Omega_beta => //. + exact: solP. rewrite inE; split; first by rewrite /B /closed_ball_/= sub0r normrN. - have : B delta (sol x 0). - by rewrite /closed_ball_; apply: ltW; rewrite sub0r normrN. + have : B delta (sol 0). + rewrite /closed_ball_; apply: ltW; rewrite sub0r normrN. + by rewrite subr0 in sol_delta. by move/B_delta_Omega_beta => []. + assumption. rewrite BE//= interior_closed_ballE//=. rewrite mx_norm_ball /ball_/= sub0r normrN => /lt_le_trans; exact. Unshelve. all: by end_near. Qed. @@ -1384,6 +1410,30 @@ rewrite mul0r => ->. by rewrite subr0. Qed. +Lemma is_derive_0_is_cst_new' {R : realType} (f : R -> R) y (a b : R) : + y \in `[a, b] -> + {within `[a, b], continuous f} -> + (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. +Proof. +move => yab cont d x xab /=. +have : (a <= b). + move: xab. + rewrite inE/=in_itv/= => /andP[]. + by apply le_trans. +rewrite le_eqVlt => /predU1P[ab|ab]. +suff [-> ->] : b = x /\ b = y by []. +split;apply /eqP;rewrite eq_le. +by move : xab;rewrite !ab !inE/=!in_itv/=. +by move : yab;rewrite !ab !inE/=!in_itv/=. +suff [-> ->] : f x = f ((a + b) / 2) /\ f y = f ((a+b )/2) by []. +have ab2: (a+b)/2 \in `]a,b[. + rewrite inE/=in_itv/=. + apply/andP;split. + by rewrite ltr_pdivlMr // mulrDr mulr1 ler_ltD //. + rewrite ltr_pdivrMr // mulrDr mulr1 ltr_leD //. +by split;apply /is_derive_0_is_cst_new. +Qed. + Section tilt_eqn. Context {K : realType}. Variables alpha1 gamma : K. @@ -1460,18 +1510,18 @@ case: cid => //= y' y'sol. case: cid => t'/= pt'. Abort.*) -Variable (r : {posnum K}). - -Lemma state_space_tiltS Delta : - state_space tilt_eqn r state_space_tilt Delta `<=` state_space_tilt. +Lemma state_space_tiltS : + state_space tilt_eqn state_space_tilt `<=` state_space_tilt. Proof. +move => p [y [Delta [[y0_init1 [/=_ [deri conti]] ]]]]. + have [Delta0|Delta0] := leP 0 Delta; last first. - move=> t. - rewrite /state_space/= => -[f [rf [x]]]. + rewrite /state_space/= => -[t [rt x]]. + move : rt. rewrite in_itv/= => -[/andP[x0 xDelta]]. - have := lt_trans xDelta Delta0. - by rewrite ltNge (ltW x0). -move=> p [y [[y0_init1]] [_ [/= deri [conti ball]]]]. + have := le_lt_trans xDelta Delta0. + by rewrite ltNge x0. +(* move=> p [y [[y0_init1]] [_ [/= deri [conti ball]]]]. *) rewrite /state_space_tilt. have : {in `]0, Delta[, derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) =1 0}. move => x xd /=. @@ -1524,7 +1574,7 @@ have : {in `]0, Delta[, derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right move => h [t [t0d ->]]. (* under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0 *) *) (* move => h. *) -have norm_constant : forall t, t \in `]0,Delta[ -> norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. +have norm_constant : forall t, t \in `[0,Delta] -> norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. move => t0. have : forall x0, x0 \in `]0,Delta[ -> is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. move => x0 x0d. @@ -1540,7 +1590,7 @@ have norm_constant : forall t, t \in `]0,Delta[ -> norm ('e_2 - Right (y t))^+2 rewrite /=. move => hd0 t0d'. apply/esym. - have := is_derive_0_is_cst_new t0d' _ hd0. + have := is_derive_0_is_cst_new' t0d' _ hd0. apply => //; last first. by rewrite inE/= in_itv/= lexx/=. apply: (@within_continuous_comp _ _ _ _ _ (fun x => norm ('e_2 - Right x) ^+ 2) y) => //=. @@ -1563,8 +1613,8 @@ Qed. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). -Lemma equilibrium_point1 Delta : - is_equilibrium_point tilt_eqn r state_space_tilt Delta point1. +Lemma equilibrium_point1 : + is_equilibrium_point tilt_eqn state_space_tilt point1. Proof. split. - rewrite inE /state_space_tilt /point1/=. @@ -1584,15 +1634,12 @@ split. rewrite !mxE. by rewrite subrr. by move => n; rewrite n scaler0 mul0mx. - + split. - apply: continuous_subspaceT =>x. - exact: cvg_cst. - move => t td /=. - by apply closed_ballxx. + + apply: continuous_subspaceT =>x. + exact: cvg_cst. Qed. -Lemma equilibrium_point2 Delta : - is_equilibrium_point tilt_eqn r state_space_tilt Delta point2. +Lemma equilibrium_point2 : + is_equilibrium_point tilt_eqn state_space_tilt point2. Proof. split. - rewrite inE /state_space_tilt /point2 /=. @@ -1633,11 +1680,8 @@ split. rewrite subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. rewrite (_ : 'e_2 *m _ = 0) ?mul0mx//; apply: trmx_inj. by rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. - + split. - apply: continuous_subspaceT =>x. - exact: cvg_cst. - move => t td /=. - by apply closed_ballxx. + + apply: continuous_subspaceT =>x. + exact: cvg_cst. Qed. End tilt_eqn. @@ -1820,25 +1864,24 @@ Variable gamma : K. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. Let phi := tilt_eqn alpha1 gamma. -Variable r : {posnum K}. Variable Delta : K. Lemma derive_zp1 (z : K) (sol : K -> 'rV_6) : - is_sol phi r Delta sol state_space_tilt -> + is_sol phi Delta sol state_space_tilt -> z \in `]0, Delta[ -> 'D_1 (Left \o sol) z = - alpha1 *: Left (sol z). Proof. -move=> [/= traj0 [_ [deri [conti cball]]] z0Delta]. +move=> [/= traj0 [_ [deri conti]] z0Delta]. have [derivable_sol +] := deri _ z0Delta. move=> /(congr1 Left). by rewrite derive1E row_mxKl => ?; rewrite derive_lsubmx. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - is_sol phi r Delta sol state_space_tilt -> + is_sol phi Delta sol state_space_tilt -> z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. -move=> [/= traj0 [_ [deriv [conti cball]]] z0Delta]. +move=> [/= traj0 [_ [deriv conti]] z0Delta]. have [derivable_sol +] := deriv _ z0Delta. move => /(congr1 Right). rewrite derive1E. @@ -1847,25 +1890,26 @@ Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : t \in `[0, Delta[%R -> - is_sol phi r Delta sol state_space_tilt -> + is_sol phi Delta sol state_space_tilt -> state_space_tilt (sol t). Proof. move=> t0Delta. -case => sol0 [_ [deriv_sol [csol cball]]]. +case => sol0 [_ [deriv_sol csol]]. move: t0Delta. rewrite in_itv/= => /andP[]. rewrite le_eqVlt => /predU1P[<- Delta0|t0 tDelta]. exact/set_mem. -apply: (@state_space_tiltS _ alpha1 gamma r Delta) => //=. -exists sol; split => //=. +apply: (@state_space_tiltS _ alpha1 gamma) => //=. +exists sol. +exists Delta; split => //=. exists t; split => //. -by rewrite in_itv/= t0. +by rewrite in_itv/= (ltW t0) (ltW tDelta). Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - is_sol phi r Delta sol state_space_tilt -> norm u = 1. + is_sol phi Delta sol state_space_tilt -> norm u = 1. Proof. move=> z0Delta dtraj. suff: state_space_tilt (row_mx (zp1 z) (z2 z)). @@ -1877,7 +1921,7 @@ Qed. Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - is_sol phi r Delta sol state_space_tilt -> + is_sol phi Delta sol state_space_tilt -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> z0Delta dtraj. @@ -1901,7 +1945,7 @@ Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : z \in `[0, Delta[%R -> - is_sol phi r Delta sol state_space_tilt-> + is_sol phi Delta sol state_space_tilt-> norm (Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))) = norm (Right (sol z) *m \S('e_2)). Proof. @@ -1929,7 +1973,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol phi r Delta sol state_space_tilt -> + is_sol phi Delta sol state_space_tilt -> z \in `]0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + @@ -1954,11 +1998,11 @@ rewrite tr_sqr_spin. by rewrite mulmxA. Qed. -Lemma derive_along_V1 (x : 'rV[K]_6) t (sol : 'rV_6 -> K -> 'rV_6) : +Lemma derive_along_V1 t (sol : K -> 'rV_6) : t \in `]0, Delta[ -> - is_sol phi r Delta (sol x) state_space_tilt -> - (forall t, differentiable (sol x) t) -> - 'D~(sol x) (V1 alpha1 gamma) t = V1dot (sol x t). + is_sol phi Delta sol state_space_tilt -> + (forall t, t \in `]0, Delta[ -> differentiable sol t) -> + 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0Delta tilt_eqnx dif1. rewrite /V1 derive_alongD; last 3 first. @@ -1969,10 +2013,12 @@ rewrite /V1 derive_alongD; last 3 first. exact: dif1. under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. -rewrite derive_alongMl => //; last first. +rewrite derive_alongMl => //; last 2 first. exact/differentiable_norm_squared/differentiable_lsubmx. -rewrite derive_alongMl => //; last first. + by apply: dif1. +rewrite derive_alongMl => //; last 2 first. exact/differentiable_norm_squared/differentiable_rsubmx. + by apply: dif1. rewrite -fctE /= !derive_along_norm_squared//=. - rewrite V1dotE. by rewrite /c1 /c2 !invfM. @@ -1980,7 +2026,9 @@ rewrite -fctE /= !derive_along_norm_squared//=. exact: tilt_eqnx. - assumption. - exact/differentiable_lsubmx. + by apply: dif1. - exact/differentiable_rsubmx. + by apply: dif1. Qed. Definition u1 (sol : K -> 'rV[K]_6) t @@ -1989,7 +2037,7 @@ Definition u1 (sol : K -> 'rV[K]_6) t \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 t), 1 |-> norm w] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol phi r Delta sol state_space_tilt -> + is_sol phi Delta sol state_space_tilt -> forall t, t \in `[0, Delta[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. @@ -2023,7 +2071,7 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : - is_sol phi r Delta (sol x) state_space_tilt -> + is_sol phi Delta (sol x) state_space_tilt -> sol x 0 = point1 -> \forall z \near 0^', ('D~(sol x) (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) + @@ -2066,7 +2114,7 @@ Unshelve. all: try by end_near. Abort. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - is_sol phi r Delta (sol x) state_space_tilt -> + is_sol phi Delta (sol x) state_space_tilt -> sol x 0 = point1 -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. @@ -2106,7 +2154,7 @@ Abort. Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - is_sol phi r Delta (sol x) state_space_tilt -> + is_sol phi Delta (sol x) state_space_tilt -> (forall t : K, state_space_tilt (sol x t)) -> sol x 0 = point1 -> locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. @@ -2150,12 +2198,11 @@ rewrite derive_along_V1. admit. - admit. - by []. -- move => t. +- move => t t0Delta. apply/derivable1_diffP => //. move : solves; rewrite /is_sol. - case => _ [_ [deri [conti cball]]]. - apply deri. - admit. + case => _ [_ [deri conti]]. + by apply deri. Unshelve. all: by end_near. Abort. (*Definition is_Lyapunov_stable_at {K : realType} {n} @@ -2179,31 +2226,37 @@ split. (*- by move=> traj1 ? ?; exact: V1_point_is_lnsd. Qed.*) Abort.*) -Lemma derive_along_V1_le0 sol (x : 'rV[K]_6) : - is_sol phi r Delta (sol x) state_space_tilt -> - (forall t, differentiable (sol x) t) -> - forall t : K, 0 <= t < Delta -> - 'D~(sol x) (V1 alpha1 gamma) t <= 0. +Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : + is_sol phi Delta sol state_space_tilt -> + (forall t, 0 < t < Delta -> differentiable sol t) -> + forall t : K, 0 < t < Delta -> + 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. move=> solves diff t t0. -rewrite derive_along_V1//. -have t0Delta : t \in `[0, Delta[%R by rewrite in_itv/=. +rewrite derive_along_V1//; last 2 first. + by rewrite inE/= in_itv/=. + move=> t1 t10Delta. + apply: diff => //. + by rewrite inE/= in_itv/= in t10Delta. +have t0Delta : t \in `[0, Delta[%R. + rewrite in_itv/=. + by move/andP : t0 => [] /ltW -> ->. have Hub := V1dot_ub solves t0Delta. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 - with 0 |-> norm ((Left \o sol x) t), - 1 |-> norm ((Right \o sol x) t *m \S('e_2))] + with 0 |-> norm ((Left \o sol) t), + 1 |-> norm ((Right \o sol) t *m \S('e_2))] i in 0 <= (u1 *m u2 *m u1^T) 0 0. set u1 := \row_i [eta fun=> 0 - with 0 |-> norm ((Left \o sol x) t), - 1 |-> norm ((Right \o sol x) t *m \S('e_2))] + with 0 |-> norm ((Left \o sol) t), + 1 |-> norm ((Right \o sol) t *m \S('e_2))] i. rewrite /=. case: (u1 =P 0) => [->|/eqP u1_neq0]. by rewrite !mul0mx mxE. by rewrite ltW// u2_quadratic_form_gt0. by rewrite -oppr_ge0 !mulNmx mxE opprK Hquad. -Admitted. +Qed. End tilt_eqn_Lyapunov. @@ -2214,11 +2267,6 @@ Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. Let phi := tilt_eqn alpha1 gamma. Variable Init : set 'rV[K]_6. -Variable sol : 'rV[K]_6 -> K -> 'rV[K]_6. -Variable Delta : K. -Variable r : {posnum K}. - -Hypothesis solP : is_sol_autonomous 0 phi r 0 Delta (sol 0). Hypothesis y0 : 0 \in Init. @@ -2226,43 +2274,44 @@ Hypothesis y0 : 0 \in Init. (* Hypothesis y00 : sol 0 0 = 0. *) Lemma is_equilibrium_subset : - is_equilibrium_point phi r state_space_tilt Delta 0 -> - is_equilibrium_point phi r Init Delta 0. + is_equilibrium_point phi state_space_tilt 0 -> + is_equilibrium_point phi Init 0. Proof. -rewrite /is_equilibrium_point. -rewrite /is_sol/= inE => -[inD0 deriv ]. -by split => //; exact/set_mem. +rewrite /is_equilibrium_point => H Delta0. +have [inD0 about_sol] := H Delta0. +by split => //. Qed. Lemma equilibrium_zero_stable : open Init -> 0 \in Init -> Init `<=` state_space_tilt -> - is_locally_stable_at point1 Delta (sol 0). + is_locally_stable_at phi Init point1. Proof. move=> openInit Init0 Init_in_state. -apply: (@Lyapunov_stability K _ phi r Delta Init sol solP openInit (V1 alpha1 gamma)). +apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). - move=> t. apply/differentiableD => //=. apply/differentiableM => //=. exact/differentiable_norm_squared/differentiable_lsubmx. apply/differentiableM => //=. exact/differentiable_norm_squared/differentiable_rsubmx. -- move=> z zD t t0. - apply: (@derive_along_V1_le0 _ _ _ _ _ r Delta sol). +- move=> Delta sol solP t t0. + case: solP => sol0Init solP. + apply: (@derive_along_V1_le0 _ _ _ _ _ Delta sol). + assumption. + assumption. - + apply: (@is_sol_subset _ _ _ _ Delta _ _ _ Init_in_state). + + rewrite -/phi. + apply: (@is_sol_subset _ _ _ Delta _ _ _ Init_in_state). split. - admit. - rewrite -/phi. - admit. (* pbm *) - + move=> /= t1. + assumption. + assumption. + + move=> /= t1 t10Delta. rewrite -derivable1_diffP. - case: solP => _/= [+ _]. - move/(_ t1) => H. - (*have : is_sol (sol z) by apply solP; rewrite sol0. - by case.*) admit. -- rewrite t0/=. - admit. + case: solP => _ [deri _]. + apply deri. + by rewrite inE/= in_itv/=. + + case/andP : t0 => t0 tDelta. + rewrite tDelta andbT. + admit. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. rewrite /is_Lyapunov_candidate /point1 => Hpos. rewrite /V1 lsubmx_const rsubmx_const; split => //. From dc3234f698a331a68ed16f6857691eefa29ffc40 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 25 Jan 2026 21:36:54 +0900 Subject: [PATCH 074/144] adjust intervals and qed --- tilt.v | 170 ++++++++++++++++++++++++++++----------------------------- 1 file changed, 84 insertions(+), 86 deletions(-) diff --git a/tilt.v b/tilt.v index 45dd1925..493aa407 100644 --- a/tilt.v +++ b/tilt.v @@ -11,28 +11,28 @@ Require Import tilt_mathcomp tilt_analysis tilt_robot. (* # Tentative formalization of [1] *) (* *) (* ``` *) -(* posdefmx M == M is definite positive *) -(* locposdef V x == V is locally positive definite at x *) -(* is_Lyapunov_candidate V := locposdef V *) -(* locnegsemidef V x == V is locally negative semidefinite *) -(* 'D~(sol, x0) V == derivative of V along the solution sol *) -(* starting at x0 *) -(* is_sol_autonomous u0 phi t0 t1 f == solution of an autonomous ODE *) -(* initial_condition u0 *) -(* equation phi *) -(* solution f on [t0, t1] *) -(* is_sol phi Delta f Init := is_sol_autonomous (f 0) phi 0 Delta f *) -(* + f 0 \in Init *) -(* is_equilibrium_point f p := solves_equation f (cst p) *) -(* state_space f == the set points attainable by a solution *) -(* (in the sense of `is_sol`) *) +(* posdefmx M == M is definite positive *) +(* locposdef V x == V is locally positive definite at x *) +(* is_Lyapunov_candidate V := locposdef V *) +(* locnegsemidef V x == V is locally negative semidefinite *) +(* 'D~(sol, x0) V == derivative of V along the solution sol *) +(* starting at x0 *) +(* is_sol_autonomous u0 phi t0 t1 f == solution of an autonomous ODE *) +(* initial_condition u0 *) +(* equation phi *) +(* solution f on [t0, t1] *) +(* is_sol phi Delta f Init := is_sol_autonomous (f 0) phi 0 Delta f *) +(* + f 0 \in Init *) +(* is_equilibrium_point f p := solves_equation f (cst p) *) +(* state_space f == the set points attainable by a solution *) +(* (in the sense of `is_sol`) *) (* is_Lyapunov_stable_at f V x == Lyapunov stability *) (* ``` *) (* *) (* Reference: *) (* - [benallegue2023itac] *) (* https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) -(* - [2]: Hassan K. Khalil, Nonlinear systems, 2002*) +(* - [2]: Hassan K. Khalil, Nonlinear systems, 2002 *) (******************************************************************************) Reserved Notation "''D~(' sol , x ) f" (at level 10, sol, x, f at next level, @@ -261,15 +261,15 @@ Notation "''D~(' sol ) f" := (derive_along f (sol)). Section derive_along. Context {R : realType} {n : nat}. Variable sol : R -> 'rV[R]_n. -(* sol represents the solutions of a differential equation *) +(* sol represents a solution of a differential equation *) Lemma derive_along_derive (V : 'rV[R]_n -> R) (t : R) : - differentiable V (sol t) -> differentiable (sol) t -> + differentiable V (sol t) -> differentiable sol t -> 'D~(sol) V t = 'D_1 (V \o sol) t. -(* Warning: we are not representing the initial state at t = 0 of the trajectory x +(* Warning: we are not representing the initial state at t = 0 of the trajectory sol see Khalil p.114 *) Proof. -move => dif1 dif2. +move=> dif1 dif2. rewrite /derive_along /=. rewrite /jacobian1. rewrite /jacobian. @@ -277,31 +277,30 @@ rewrite /dotmul. rewrite -trmx_mul. rewrite mul_rV_lin1. rewrite mxE. -rewrite -deriveE => //=; last first. - apply: differentiable_comp => //=. +rewrite -deriveE=> /=; last first. + apply: differentiable_comp => //. exact/differentiable_scalar_mx. rewrite derive_mx /=; last first. - apply: derivable_scalar_mx => //=. + apply: derivable_scalar_mx => //. exact: diff_derivable. rewrite mxE. -rewrite [in RHS]deriveE => //=. -rewrite [in RHS]diff_comp => //=. -rewrite -![in RHS]deriveE => //=. -under eq_fun do rewrite mxE /= mulr1n /=. - by []. -exact: differentiable_comp. +rewrite [in RHS]deriveE/=; last first. + exact: differentiable_comp. +rewrite [in RHS]diff_comp//=. +do 2 (rewrite -[in RHS]deriveE; last by []). +by under eq_fun do rewrite mxE /= mulr1n /=. Qed. Lemma derive_alongMl (f : 'rV_n -> R) (k : R) t : - differentiable f (sol t) -> differentiable (sol) t -> + differentiable f (sol t) -> differentiable sol t -> 'D~(sol) (k *: f) t = k *: 'D~(sol) f t. Proof. move=> dfx dpx. rewrite derive_along_derive; last 2 first. exact: differentiable_comp. by []. -rewrite deriveZ/=; last first => //=. - apply: diff_derivable => //=. +rewrite deriveZ/=; last first. + apply: diff_derivable => /=. rewrite -fctE. exact: differentiable_comp. congr (_ *: _). @@ -310,7 +309,7 @@ Qed. Lemma derive_alongD (f g : 'rV_n -> R) t : differentiable f (sol t) -> differentiable g (sol t) -> - differentiable (sol) t -> + differentiable sol t -> 'D~(sol) (f + g) t = 'D~(sol) f t + 'D~(sol) g t. Proof. move=> dfx dgx difp. @@ -319,10 +318,10 @@ rewrite derive_along_derive; last 2 first. by []. rewrite deriveD/=; last 2 first. apply: diff_derivable => //. - rewrite -fctE . + rewrite -fctE. exact: differentiable_comp. apply: diff_derivable => //. - rewrite -fctE . + rewrite -fctE. exact: differentiable_comp. rewrite derive_along_derive; [|by []..]. by rewrite derive_along_derive. @@ -330,22 +329,21 @@ Qed. Lemma derivative_derive_along_eq0 (f : 'rV_n -> R) (t : R) : differentiable f (sol t) -> - 'D_1 (sol) t = 0 -> 'D~(sol) f t = 0. + 'D_1 sol t = 0 -> 'D~(sol) f t = 0. Proof. -move=> xt1 dtraj. +move=> df dsol0. rewrite /derive_along /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. -by rewrite dtraj mul0mx !mxE. +by rewrite dsol0 mul0mx !mxE. Qed. -Lemma derive_along_norm_squared m (f : 'rV[R]_n -> 'rV_m) - (t : R) : +Lemma derive_along_norm_squared m (f : 'rV[R]_n -> 'rV[R]_m) (t : R) : differentiable f (sol t) -> - differentiable (sol) t -> + differentiable sol t -> 'D~(sol) (fun y => norm (f y) ^+ 2) t = (2 *: 'D_1 (f \o sol) t *m (f (sol t))^T) 0 0. Proof. move=> difff diffphi. -rewrite derive_along_derive => //=; last exact: differentiable_norm_squared. +rewrite derive_along_derive//; last exact: differentiable_norm_squared. rewrite fctE derive_norm_squared //=; last first. by apply: diff_derivable=> //=; exact: differentiable_comp. by rewrite mulrDl mul1r scalerDl scale1r mulmxDl [in RHS]mxE. @@ -394,7 +392,7 @@ Let U := 'rV[K]_n. Variable phi : U -> U. Definition is_sol (Delta : K) (f : K -> U) (Init : set U) := - f 0 \in Init /\ is_sol_autonomous (f 0) phi 0 Delta f. + f 0 \in Init /\ is_sol_autonomous (f 0) phi 0 Delta f. End ode. @@ -404,9 +402,11 @@ Let T := 'rV[K]_n. Variable phi : T -> T. Variable Delta : K. -Lemma is_sol_subset f (A B : set T) (AB : A `<=` B) : +Lemma is_sol_subset f (A B : set T) : + A `<=` B -> is_sol phi Delta f A -> is_sol phi Delta f B. Proof. +move=> AB. rewrite /is_sol inE => -[inD0 [_ [deri cont]]]; rewrite inE. split => //. by apply: AB. @@ -423,10 +423,6 @@ Definition state_space (Init : set T) : set T := [set x | exists f Delta, (is_sol phi Delta f Init /\ (exists t, t \in `[0, Delta]%R /\ x = f t))]. -(*Definition state_space (Init : set T) (Delta : K) : set T:= - [set x | exists f, (is_sol phi Delta f Init /\ - (exists t, t \in `]0, Delta[%R /\ x = f t))].*) - End state_space. Section equilibrium_point. @@ -446,18 +442,20 @@ Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : T -> T. -Lemma is_equilibrium_point_subset x (A B : set T) (AB : A `<=` B) : - is_equilibrium_point phi A x -> is_equilibrium_point phi B x. +Definition equilibrium_points A := + [set p : T | is_equilibrium_point phi A p ]. + +Lemma equilibrium_points_subset (A B : set T) : + A `<=` B -> + equilibrium_points A `<=` equilibrium_points B. Proof. -rewrite /is_equilibrium_point /is_sol inE => H Delta. +move=> AB x. +rewrite /equilibrium_points/= /is_equilibrium_point /is_sol inE => H Delta. have [inD0 [deriv [cont tilt]]] := H Delta. rewrite inE; split => //. exact: AB. Qed. -Definition equilibrium_points Init := - [set p : T | is_equilibrium_point phi Init p ]. - End equilibrium_point. Section stability. @@ -473,7 +471,7 @@ Definition is_stable_at (x : T) (z : K -> 'rV[K]_n) := Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & forall (z : K -> 'rV[K]_n) (Delta : K), is_sol phi Delta z Init -> - `| z 0 - x | < d -> forall t, 0 <= t < Delta -> `| z t - x | < eps. + `| z 0 - x | < d -> forall t, 0 < t < Delta -> `| z t - x | < eps. Definition is_asymptotically_stable_at (x : T) (z : K -> 'rV[K]_n) : Prop := exists2 d, d > 0 & `| z 0 - x | < d -> z t @[t --> +oo] --> x. @@ -644,7 +642,7 @@ Hypothesis solP : is_sol_autonomous u0 phi 0 Delta sol. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall t, 0 <= t < Delta -> 'D~(sol) V t <= 0. +Hypothesis V'_le0 : forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. Lemma V_nincr a b : b < Delta -> 0 <= a <= b -> V (sol b) <= V (sol a). @@ -664,7 +662,7 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. - move=> y yb. rewrite derive1E -derive_along_derive//. + apply: V'_le0. - move : yb; rewrite in_itv/= => /andP[/ltW ->/= /lt_le_trans]; apply. + move : yb; rewrite in_itv/= => /andP[->/= /lt_le_trans]; apply. exact: ltW. + rewrite -derivable1_diffP. case: solP => /= h0Init [+ _]. @@ -737,7 +735,7 @@ Proof. by move=> r0; rewrite /B -closed_ballE. Qed. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. Hypothesis V'_le0 : forall Delta sol, is_sol phi Delta sol Init -> - forall t, 0 <= t < Delta -> 'D~(sol) V t <= 0. + forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. (* khalil theorem 4.1 *) Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) : @@ -794,9 +792,9 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. stays in Omega_beta for all t >= 0 *) have Df_Omega_beta Delta sol : is_sol phi Delta sol Init -> - sol 0 \in Omega_beta -> forall t, 0 <= t < Delta -> sol t \in Omega_beta. + sol 0 \in Omega_beta -> forall t, 0 < t < Delta -> sol t \in Omega_beta. move=> solP phi_Omega. - have /= V_nincr_consequence : forall t, 0 <= t < Delta -> forall u, 0 <= u <= t -> + have /= V_nincr_consequence : forall t, 0 < t < Delta -> forall u, 0 <= u <= t -> 'D~(sol) V u <= 0 -> V (sol t) <= V (sol 0) <= beta. move=> /= t1 /andP[t10 t1Delta] u ut1 Vle0. @@ -809,8 +807,7 @@ have Df_Omega_beta Delta sol : exact: solP. assumption. assumption. - rewrite lexx/=. - assumption. + by rewrite lexx/= (ltW t10). by move: phi_Omega; rewrite inE => -[Brh0 Vh0beta]. move=> t /andP[t0 tDelta]. rewrite inE; split; last first. @@ -820,7 +817,7 @@ have Df_Omega_beta Delta sol : by rewrite t0/=. have := @V_nincr_consequence t. rewrite t0 /= tDelta => /(_ isT t). - rewrite lexx t0/= => /(_ isT). + rewrite lexx (ltW t0)/= => /(_ isT). move=> /[apply]. by move=> /andP[/le_trans] => /[apply]. move: phi_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. @@ -830,6 +827,7 @@ have Df_Omega_beta Delta sol : have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o sol)}. (* `[0, t] *) apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) (sol)) => //. + exact: ltW. move=> z _. by apply: norm_continuous. case: solP => sol0init [_ [_]]. @@ -838,7 +836,7 @@ have Df_Omega_beta Delta sol : by rewrite bnd_simp ltW. have : min `|sol 0| `|sol t| <= r <= max `|sol 0| `|sol t|. by rewrite ge_min phi0r/= le_max (ltW phi_t_r) orbT. - move=> /(IVT t0 norm_phi_cont)[c cI norm_phi_c]. + move=> /(IVT (ltW t0) norm_phi_cont)[c cI norm_phi_c]. by exists c; split => //; move/itvP: cI => ->. have alphaVphit1 : alpha <= V (sol t1). rewrite {alpha_gt0 beta_alpha} /alpha; case: alpha_min => /=. @@ -846,14 +844,15 @@ have Df_Omega_beta Delta sol : have : beta < V (sol t1). by rewrite (lt_le_trans _ alphaVphit1)//; case/andP : beta_alpha. apply/negP; rewrite -leNgt. + move: t1_ge0; rewrite le_eqVlt => /predU1P[<-//|t10]. have := @V_nincr_consequence t1. - rewrite t1_ge0 (le_lt_trans t1t tDelta) => /(_ isT). + rewrite t10 (le_lt_trans t1t tDelta) => /(_ isT). move=> /(_ t1). - rewrite t1_ge0 lexx => /(_ isT). + rewrite (ltW t10) lexx => /(_ isT). have : 'D~(sol) V t1 <= 0. apply: V'_le0. exact: solP. - by rewrite t1_ge0/= (le_lt_trans _ tDelta). + by rewrite t10/= (le_lt_trans _ tDelta). move=> /[swap] /[apply]. by move=> /andP[/le_trans] => /[apply]. have _ : compact Omega_beta. @@ -1859,21 +1858,22 @@ End hurwitz. Section tilt_eqn_Lyapunov. Local Open Scope classical_set_scope. Context {K : realType}. -Variable alpha1 : K. -Variable gamma : K. -Hypothesis alpha1_gt0 : 0 < alpha1. -Hypothesis gamma_gt0 : 0 < gamma. +Variables alpha1 gamma : K. +Hypotheses (alpha1_gt0 : 0 < alpha1) (gamma_gt0 : 0 < gamma). Let phi := tilt_eqn alpha1 gamma. Variable Delta : K. -Lemma derive_zp1 (z : K) (sol : K -> 'rV_6) : +Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : is_sol phi Delta sol state_space_tilt -> - z \in `]0, Delta[ -> 'D_1 (Left \o sol) z = - alpha1 *: Left (sol z). + t \in `]0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. -move=> [/= traj0 [_ [deri conti]] z0Delta]. -have [derivable_sol +] := deri _ z0Delta. +move=> [/= sol0in [_ [deri conti]] t0Delta]. +have [derivable_sol] := deri _ t0Delta. move=> /(congr1 Left). -by rewrite derive1E row_mxKl => ?; rewrite derive_lsubmx. +rewrite derive1E. +rewrite row_mxKl. +move=> <-. +by rewrite derive_lsubmx. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : @@ -2268,28 +2268,26 @@ Hypothesis alpha1_gt0 : 0 < alpha1. Let phi := tilt_eqn alpha1 gamma. Variable Init : set 'rV[K]_6. -Hypothesis y0 : 0 \in Init. - (* Hypothesis y_sol : is_sol Delta (sol 0). *) (* Hypothesis y00 : sol 0 0 = 0. *) -Lemma is_equilibrium_subset : +Lemma is_equilibrium_subset : 0 \in Init -> is_equilibrium_point phi state_space_tilt 0 -> is_equilibrium_point phi Init 0. Proof. +move=> Init0. rewrite /is_equilibrium_point => H Delta0. have [inD0 about_sol] := H Delta0. -by split => //. +by split. Qed. Lemma equilibrium_zero_stable : - open Init -> 0 \in Init -> Init `<=` state_space_tilt -> + 0 \in Init -> open Init -> Init `<=` state_space_tilt -> is_locally_stable_at phi Init point1. Proof. -move=> openInit Init0 Init_in_state. +move=> Init0 openInit Init_in_state. apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). -- move=> t. - apply/differentiableD => //=. +- move=> t; apply/differentiableD => //=. apply/differentiableM => //=. exact/differentiable_norm_squared/differentiable_lsubmx. apply/differentiableM => //=. @@ -2311,7 +2309,7 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). by rewrite inE/= in_itv/=. + case/andP : t0 => t0 tDelta. rewrite tDelta andbT. - admit. + assumption. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. rewrite /is_Lyapunov_candidate /point1 => Hpos. rewrite /V1 lsubmx_const rsubmx_const; split => //. @@ -2322,6 +2320,6 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). apply: V1_gt0 => //. by rewrite inE. - exact/is_equilibrium_subset/equilibrium_point1. -Admitted. +Qed. End equilibrium_zero_stable. From 389d328b51b473e9dbc69c5246dd7984732a48db Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Tue, 27 Jan 2026 20:19:08 +0900 Subject: [PATCH 075/144] tilt is locally lipschitz (wip) --- tilt.v | 239 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 235 insertions(+), 4 deletions(-) diff --git a/tilt.v b/tilt.v index 493aa407..368aa2b0 100644 --- a/tilt.v +++ b/tilt.v @@ -394,6 +394,17 @@ Variable phi : U -> U. Definition is_sol (Delta : K) (f : K -> U) (Init : set U) := f 0 \in Init /\ is_sol_autonomous (f 0) phi 0 Delta f. +Definition is_global_sol (f : K -> U) (Init : set U) := + f 0 \in Init /\ forall x , derivable f x 1 /\ f^`() x = phi (f x). + +Lemma global_sol_sol f Init : is_global_sol f Init -> forall Delta, is_sol Delta f Init. +Proof. + move => [init0 /= solP] Delta. + do 3 split =>//. + apply: derivable_within_continuous. + move => x _. + apply solP. +Qed. End ode. Section is_sol. @@ -464,20 +475,46 @@ Let T := 'rV[K]_n. Variable phi : T -> T. Variable Init : set T. -Definition is_stable_at (x : T) (z : K -> 'rV[K]_n) := - forall eps, eps > 0 -> exists2 d, d > 0 & - `| z 0 - x | < d -> forall t, t >= 0 -> `| z t - x | < eps. - Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & forall (z : K -> 'rV[K]_n) (Delta : K), is_sol phi Delta z Init -> `| z 0 - x | < d -> forall t, 0 < t < Delta -> `| z t - x | < eps. +(* assuming solution exists for all time *) +Definition is_stable_at (x : T) := + forall eps, eps > 0 -> exists2 d, d > 0 & + forall (z : K -> 'rV[K]_n), is_global_sol phi z Init -> + `| z 0 - x | < d -> forall t, 0 < t -> `| z t - x | < eps. + +Lemma locally_stable_stable x : is_locally_stable_at x -> is_stable_at x. +Proof. +move => lstable e e0. +move /(_ _ e0) : lstable => [d d0 stable]. +exists d => // z zglob zd t t0. +apply (stable _ (t+1)) => //. +by apply global_sol_sol. +rewrite t0/=. +by rewrite ltrDl. +Qed. + Definition is_asymptotically_stable_at (x : T) (z : K -> 'rV[K]_n) : Prop := exists2 d, d > 0 & `| z 0 - x | < d -> z t @[t --> +oo] --> x. End stability. +Section bounded. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : T -> T. +(* Variable sol : K->T. *) +Variable Init : set T. +Variable x0 : T. +(* Hypothesis solP: is_sol phi Delta sol Init. *) +(* Lemma stable_bounded : is_locally_stable_at phi Init x0 -> forall eps, exists d, forall u0 Delta sol, `|u0 - x0| <= d -> is_sol_autonomous u0 phi 0 Delta sol -> forall t, 0<=t<=Delta -> `|sol t - x0| <= eps. *) +(* Proof. *) +(* move => stable eps. *) +(* have := *) +End bounded. (* f' = phi f *) (* phi_robot f =def= fun f t => phi t (f t) *) (*Definition existence_uniqueness {K : realType} {n} @@ -1494,6 +1531,200 @@ apply: (@le_trans _ _ (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: x0 a b|)); last first. Abort. +(* Todo: Maybe useful generally? (PR) *) +Lemma norm_rowmx {m n1 n2 : nat} (A1 : matrix K m.+1 n1.+1) (A2 : matrix K m.+1 n2.+1) : `|row_mx A1 A2| = max `|A1| `|A2|. +Proof. +rewrite /Num.norm/=. +rewrite !mx_normrE. +apply/eqP; rewrite eq_le; apply/andP; split. +- apply: bigmax_le => /=. + rewrite le_max;apply /orP;left. + apply/le_trans/(le_bigmax _ _ (ord0,ord0) ). + by apply normr_ge0. + move => [i j] _. + rewrite /=. + rewrite le_max;apply /orP. + rewrite mxE. + case: (splitP j) => j1 h1. + left;exact: (le_bigmax _ _ (i, j1)). + right;exact: (le_bigmax _ _ (i, j1)). +rewrite ge_max;apply /andP;split. + apply: bigmax_le => /=. + apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, ord0)). + exact: normr_ge0. + move => [i j] _. + rewrite /=. + rewrite -(row_mxEl _ A2). + exact: (le_bigmax _ _ (i, lshift n2.+1 j)). +apply: bigmax_le => /=. +apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, ord0)). + exact: normr_ge0. +move => [i j] _. +rewrite /=. +rewrite -(row_mxEr A1). +exact: (le_bigmax _ _ (i, rshift n1.+1 j)). +Qed. + +Lemma left_sub (x y : 'rV[K]_6) : Left x - Left y = Left (x -y). +Proof. + rewrite /Left. + apply/matrixP => i j. + by rewrite !mxE. +Qed. + +Lemma right_sub (x y : 'rV[K]_6) : Right x - Right y = Right (x -y). +Proof. + rewrite /Left. + apply/matrixP => i j. + by rewrite !mxE. +Qed. +Lemma left_norm_le (x : 'rV[K]_6) : `|Left x| <= `|x|. +Proof. +rewrite /Num.norm/=. +rewrite !mx_normrE. +apply: bigmax_le. + by apply/le_trans/(le_bigmax _ _ (ord0,ord0) );apply normr_ge0. + move => [i j] _. + rewrite /=. + rewrite mxE. + exact: (le_bigmax _ _ (i, lshift 3 j)). +Qed. + +Lemma right_norm_le (x : 'rV[K]_6) : `|Right x| <= `|x|. +Proof. +rewrite /Num.norm/=. +rewrite !mx_normrE. +apply: bigmax_le. + by apply/le_trans/(le_bigmax _ _ (ord0,ord0) );apply normr_ge0. + move => [i j] _. + rewrite /=. + rewrite mxE. + exact: (le_bigmax _ _ (i, rshift 3 j)). +Qed. + +(*Todo: This also seems useful in general (PR) *) +Lemma mx_norm_mul {m n p} (A : matrix K m.+1 n.+1) (B : 'M_(n.+1, p.+1)) : + mx_norm (A *m B) <= (n.+1)%:R * mx_norm A * mx_norm B. +Proof. + rewrite !mx_normrE. + apply: bigmax_le. + rewrite -mulrA. + apply mulr_ge0 => //. + by apply mulr_ge0; apply/le_trans/(le_bigmax _ _ (ord0,ord0) );apply normr_ge0. + move => [i j] _. + rewrite /=. + rewrite mxE. + apply: le_trans; first by apply ler_norm_sum. + rewrite /=. +Admitted. + +Lemma mx_norm_sq {n} (A : matrix K n.+1 n.+1) : `|A^+2| <= (n.+1)%:R* `|A|^+2. +Proof. + rewrite !expr2 mulrA. + exact: mx_norm_mul. +Qed. + +Lemma closed_ball_bounded {n} (x y : 'rV[K]_n) r: 0 < r -> closed_ball x r y -> `|y| <= `|x| + r. +Proof. +move => r0. +rewrite closed_ballE//. +rewrite /closed_ball_/=. +move => dxy. +rewrite ler_distlCDr //. +by apply: (le_trans (ler_dist_dist _ _)). +Qed. + +Lemma tilt_eqn_locally_lipschitz : forall x, exists (r k : {posnum K}), k%:num.-lipschitz_(closed_ball x r%:num) tilt_eqn. +Proof. +move => /= x. +rewrite /tilt_eqn. +(* near (pinfty_nbhs K) => k'. *) +(* exists k' => -[/= x x0] _. *) +(* rewrite /tilt_eqn. *) +exists (PosNum ltr01). +near (pinfty_nbhs K) => k. +have k0 : (0 < k) by []. +exists (PosNum k0) => /= => -[/= x0 x1] [x0B x1B]. + +rewrite (opp_row_mx (n1:=3)) (add_row_mx (n1:=3)). +rewrite !scaleNr opprK/=. +rewrite addrC -scalerBr. +rewrite /eqn14b_rhs. +rewrite -!scalemxAl -scalerBr. +rewrite (norm_rowmx (m:=0) (n1:=2) (n2:=2)). +rewrite ge_max;apply /andP;split. +- rewrite mx_normZ. + rewrite left_sub. + apply: ler_pM; try by apply normr_ge0. + by []. + rewrite distrC. + by apply /le_trans/left_norm_le. +- rewrite mx_normZ. + set a := (Right x0 - Left x0). + set b := (Right x1 - Left x1). + set c := \S('e_2 - Right x0) ^+ 2. + set d := \S('e_2 - Right x1) ^+ 2. + have abound : `|a| <= 2 * (`|x| + 1). + rewrite /a. + apply: (le_trans (ler_normB _ _ )). + rewrite mulrDl lerD // mul1r. + apply : (le_trans (right_norm_le _)). + by apply closed_ball_bounded. + apply : (le_trans (left_norm_le _)). + by apply closed_ball_bounded. + (* todo: find some bound and show *) + have dbound : `|d| <= `|\S('e_2)| + (1 + `|x|)^+2. + rewrite /d. + rewrite skew.sqr_spin. + apply: (le_trans (ler_normB _ _)). + apply lerD;last first. + rewrite scalemx1. + admit. + admit. + rewrite -ler_pdivlMl; last by rewrite normr_gt0 lt0r_neq0. + rewrite -(subrKA (a *m d) (a *m c )) (le_trans (ler_normD _ _))//. + (* why is this so slow?*) + rewrite -mulmxBr. + rewrite -(@mulmxBl K 1 3 3 a b d). + rewrite (splitr `|gamma|^-1 ) mulrDl lerD //. + + apply: le_trans. + apply: mx_norm_mul. + admit. + + apply: le_trans. + apply: mx_norm_mul. + have -> : (a - b) = (Right x0 - Right x1) + (Left x1 - Left x0). + admit. + rewrite mulrC. + apply (@le_trans _ _ (`| d| * (6 * `|x0 - x1|))). + apply ler_pM => //. + apply: (normr_ge0 d). + apply mulr_ge0 => //. + apply: (normr_ge0 (Right x0 - _ + (_ - _))). + have -> : (6 : K) = (3 * 2) by ring. + rewrite -mulrA. + apply ler_pM => //. + apply: (normr_ge0 (Right x0 - _ + (_ - _))). + apply (le_trans (ler_normD (Right x0 - _) _)). + rewrite mulrDl lerD // mul1r. + by rewrite right_sub;apply right_norm_le. + by rewrite distrC left_sub; apply left_norm_le. + rewrite -invrM; last 2 first. + by rewrite unitfE. + rewrite unitfE. + apply lt0r_neq0. + by rewrite normr_gt0 lt0r_neq0. + apply: (le_trans (ler_pM _ _ dbound (lexx _ ))). + apply normr_ge0. + apply mulr_ge0 => //. + rewrite ler_pdivlMl; last first. + apply mulr_gt0 => //. + by rewrite normr_gt0 lt0r_neq0. + rewrite !mulrA. + apply ler_pM => //. +Abort. + (*Lemma invariant_state_space_tilt p (p33 : state_space tilt_eqn' state_space_tilt p) : let y := sval (cid p33) in From dad198babd8bc4b66953a9c3530cce7aef33ffa6 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Tue, 27 Jan 2026 21:00:14 +0900 Subject: [PATCH 076/144] matrix norm submultiplicative --- tilt.v | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/tilt.v b/tilt.v index 368aa2b0..7666f7c1 100644 --- a/tilt.v +++ b/tilt.v @@ -1618,7 +1618,23 @@ Proof. rewrite mxE. apply: le_trans; first by apply ler_norm_sum. rewrite /=. -Admitted. + have le_inside :forall i0, `|A i i0 * B i0 j| <= `| A | * `|B|. + move => k. + rewrite normrM. + rewrite /Num.norm/= !mx_normrE. + apply ler_pM. + exact: normr_ge0. + exact: normr_ge0. + apply: (le_bigmax _ _ (i,k)). + apply: (le_bigmax _ _ (k,j)). + rewrite -mulrA. + apply : (@le_trans _ _ (\sum_(i0 < n.+1) `|A| * `|B|)). + apply: ler_sum => k _; apply le_inside. + rewrite mulr_natl. + rewrite big_const_ord. + rewrite iter_addr_0. + by rewrite /Num.norm/= !mx_normrE. +Qed. Lemma mx_norm_sq {n} (A : matrix K n.+1 n.+1) : `|A^+2| <= (n.+1)%:R* `|A|^+2. Proof. From ce4312441ebef768a19f7400dd4c0e3de263ecde Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Wed, 28 Jan 2026 15:55:40 +0900 Subject: [PATCH 077/144] tilt is locally lipschitz --- tilt.v | 170 ++++++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 144 insertions(+), 26 deletions(-) diff --git a/tilt.v b/tilt.v index 7666f7c1..9cf7fc89 100644 --- a/tilt.v +++ b/tilt.v @@ -1606,8 +1606,9 @@ Qed. (*Todo: This also seems useful in general (PR) *) Lemma mx_norm_mul {m n p} (A : matrix K m.+1 n.+1) (B : 'M_(n.+1, p.+1)) : - mx_norm (A *m B) <= (n.+1)%:R * mx_norm A * mx_norm B. + `|(A *m B)| <= (n.+1)%:R * `| A| * `|B|. Proof. + rewrite /Num.norm/=. rewrite !mx_normrE. apply: bigmax_le. rewrite -mulrA. @@ -1636,12 +1637,13 @@ Proof. by rewrite /Num.norm/= !mx_normrE. Qed. -Lemma mx_norm_sq {n} (A : matrix K n.+1 n.+1) : `|A^+2| <= (n.+1)%:R* `|A|^+2. +Lemma mx_norm_sq_le {n} (A : matrix K n.+1 n.+1) : `|A^+2| <= (n.+1)%:R* `|A|^+2. Proof. rewrite !expr2 mulrA. exact: mx_norm_mul. Qed. + Lemma closed_ball_bounded {n} (x y : 'rV[K]_n) r: 0 < r -> closed_ball x r y -> `|y| <= `|x| + r. Proof. move => r0. @@ -1651,6 +1653,96 @@ move => dxy. rewrite ler_distlCDr //. by apply: (le_trans (ler_dist_dist _ _)). Qed. +Local Lemma euclidean_norm_mxnorm {n} (x : 'rV[K]_n.+1) : (norm x)^+2 <= n.+1%:R* `|x| ^ 2. +Proof. +rewrite sqr_norm /=. +have le_inside :forall i, x``_i^+2 <= `| x |^+2. + move => i. + rewrite -sqr_normr. + suff h : `|x``_i| <= `|x| by apply ler_pM => //; apply normr_ge0. + rewrite {2}/Num.norm/= !mx_normrE /=. + exact: (le_bigmax _ _ (ord0,i)). +apply : (@le_trans _ _ (\sum_(i0 < n.+1) `|x|^+2 )). +apply: ler_sum => k _; apply le_inside. +by rewrite big_const_ord mulr_natl iter_addr_0. +Qed. + +Lemma mx_norm1 {n} : `|(1 : matrix K n.+1 n.+1)| = 1. +Proof. +rewrite /Num.norm/= !mx_normrE. +apply/eqP; rewrite eq_le; apply/andP; split. +- apply: bigmax_le => //. + move => i _. + rewrite mxE /=. + case: eqP => /= _. + by rewrite normr1. + by rewrite normr0. +rewrite -normr1. +have ->: ((1 : K) = ((1 : matrix K n.+1 n.+1) ord0 ord0)) by rewrite mxE. +exact: (le_bigmax _ _ (ord0, ord0)). +Qed. +Local Lemma I3_cases (i : 'I_3) : i = 0 \/ i = 1 \/ i = 2. +Proof. +case: i => m hm. +have : m = 0 \/ m = 1 \/ m = 2. +case: m hm => [|[|[|m]]] //=; by [left| right;left | right;right]. +by case=> [h|[h|h]];[left|right;left|right;right];apply/val_inj. +Qed. + +Lemma spin_le_norm (x : 'rV[K]_3) : `|\S(x)| <= `|x|. +Proof. +rewrite {1}/Num.norm/= !mx_normrE. +apply: bigmax_le. +apply normr_ge0. +move => [i j] _. +have [->|[->|->]] := I3_cases i;have [->|[->|->]] := I3_cases j => //=. +all: rewrite ?spinii ?spin01 ?spin02 ?spin10 ?spin12 ?spin20 ?spin21 + ?normr0 ?normrN ?normr_ge0 // {2}/Num.norm/= !mx_normrE;exact : (le_bigmax _ _ (0,_)). +Qed. + +Lemma spin_sq_norm_bound (x : 'rV[K]_3) : `|\S(x)^+2| <= 3* `|x|^+2. +Proof. + apply: (le_trans (mx_norm_sq_le _)). + apply ler_pM => //. + suff h : `|\S(x)| <= `|x| by apply ler_pM. + exact: spin_le_norm. +Qed. + +Lemma spin_sq_dist_bound (x y: 'rV[K]_3) : `|\S(x)^+2 - \S(y)^+2| <= 3 * (`|x|+`|y|)* `|x-y|. +Proof. +have -> : \S(x) ^+ 2 - \S(y) ^+ 2 = \S(x) *m (\S(x) - \S(y)) + (\S(x) - \S(y)) *m \S(y). + by rewrite mulmxBr mulmxBl addrA subrK. +rewrite mulrDr mulrDl. +apply: (le_trans (ler_normD _ _)). +rewrite -spinN -spinD. +apply: lerD. + apply: (le_trans (mx_norm_mul _ _)). + apply : ler_pM => //. + apply : ler_pM => //. + exact: spin_le_norm. + exact: spin_le_norm. +rewrite -mulrA (mulrC `|y|) mulrA. +apply: (le_trans (mx_norm_mul _ _)). +apply : ler_pM => //. +apply : ler_pM => //. +exact: spin_le_norm. +exact: spin_le_norm. +Qed. + +(* Lemma spin_sq_norm_bound (x : 'rV[K]_3) : `|\S(x)^+2| <= 4* `|x|^+2. *) +(* Proof. *) +(* have -> : 4* `|x|^+2 = `|x|^+2 + 3* `|x|^+2 by ring. *) +(* rewrite skew.sqr_spin. *) +(* apply: (le_trans (ler_normB _ _)). *) +(* apply lerD. *) +(* apply: (le_trans (mx_norm_mul _ _)). *) +(* rewrite norm_trmx. *) +(* by rewrite mul1r. *) +(* rewrite mx_normZ. *) +(* rewrite mx_norm1 mulr1. *) +(* rewrite normrM normr_norm. *) +(* exact: euclidean_norm_mxnorm. *) +(* Qed. *) Lemma tilt_eqn_locally_lipschitz : forall x, exists (r k : {posnum K}), k%:num.-lipschitz_(closed_ball x r%:num) tilt_eqn. Proof. @@ -1690,47 +1782,72 @@ rewrite ge_max;apply /andP;split. by apply closed_ball_bounded. apply : (le_trans (left_norm_le _)). by apply closed_ball_bounded. - (* todo: find some bound and show *) - have dbound : `|d| <= `|\S('e_2)| + (1 + `|x|)^+2. - rewrite /d. - rewrite skew.sqr_spin. + (* todo: find some bound and show *) + have sbound x' : closed_ball x 1 x' -> `|'e_2 - Right x'| <= 2+`|x|. + move => cb. apply: (le_trans (ler_normB _ _)). - apply lerD;last first. - rewrite scalemx1. - admit. - admit. + have -> : 2 + `|x| = 1+(1+`|x|) by ring. + apply lerD. + rewrite /Num.norm /= mx_normrE. + apply: bigmax_le => //. + move => i _. + rewrite mxE /=. + case: eqP=> /= _;last by rewrite normr0. + case:eqP => /= _;last by rewrite normr0. + by rewrite normr1. + apply: (le_trans (right_norm_le _)). + rewrite addrC. + by apply closed_ball_bounded. + have dbound : `|d| <= 3* (2 + `|x|)^+2. + rewrite /d. + apply: (le_trans (spin_sq_norm_bound _)). + apply ler_pM => //. + suff h : `|'e_2 - Right x1| <= 2 + `|x|. + by apply ler_pM => //; apply normr_ge0. + by apply sbound. rewrite -ler_pdivlMl; last by rewrite normr_gt0 lt0r_neq0. rewrite -(subrKA (a *m d) (a *m c )) (le_trans (ler_normD _ _))//. (* why is this so slow?*) rewrite -mulmxBr. rewrite -(@mulmxBl K 1 3 3 a b d). - rewrite (splitr `|gamma|^-1 ) mulrDl lerD //. - + apply: le_trans. - apply: mx_norm_mul. - admit. + rewrite (splitr `|gamma|^-1) mulrDl. + rewrite -invrM; last 2 first. + by rewrite unitfE. + rewrite unitfE. + apply lt0r_neq0. + by rewrite normr_gt0 lt0r_neq0. + rewrite lerD //. + + apply: (le_trans (mx_norm_mul _ _)). + have h0 := spin_sq_dist_bound ('e_2 - Right x0) ('e_2 - Right x1). + apply : (le_trans (ler_pM _ _ (le_refl _) h0)) => //. + have -> : 'e_2 - Right x0 - ('e_2 - Right x1) = Right x1 - Right x0. + by rewrite opprB addrC addrA subrK. + rewrite !mulrA. + apply ler_pM => //; last by rewrite distrC right_sub;exact: right_norm_le. + rewrite (mulrC 3) -!mulrA. + apply : (le_trans (ler_pM _ _ abound (le_refl _))) => //. + rewrite !mulrA. + rewrite ler_pdivlMl; last first. + apply mulr_gt0 => //. + by rewrite normr_gt0 lt0r_neq0. + rewrite !mulrA. + suff h : `|'e_2 - Right x0| + `|'e_2 - Right x1| <= 2 * (2 + `|x|). + by apply: (le_trans (ler_pM _ _ (le_refl _) h)) => //. + rewrite mulrDl mul1r. + by apply lerD; apply sbound. + apply: le_trans. apply: mx_norm_mul. - have -> : (a - b) = (Right x0 - Right x1) + (Left x1 - Left x0). - admit. + rewrite opprB -addrA (addrC (-Left x0)) addrA (addrC (Left x1)) addrA -(addrA (Right x0 - _)). rewrite mulrC. apply (@le_trans _ _ (`| d| * (6 * `|x0 - x1|))). apply ler_pM => //. - apply: (normr_ge0 d). - apply mulr_ge0 => //. - apply: (normr_ge0 (Right x0 - _ + (_ - _))). have -> : (6 : K) = (3 * 2) by ring. rewrite -mulrA. apply ler_pM => //. - apply: (normr_ge0 (Right x0 - _ + (_ - _))). apply (le_trans (ler_normD (Right x0 - _) _)). rewrite mulrDl lerD // mul1r. by rewrite right_sub;apply right_norm_le. by rewrite distrC left_sub; apply left_norm_le. - rewrite -invrM; last 2 first. - by rewrite unitfE. - rewrite unitfE. - apply lt0r_neq0. - by rewrite normr_gt0 lt0r_neq0. apply: (le_trans (ler_pM _ _ dbound (lexx _ ))). apply normr_ge0. apply mulr_ge0 => //. @@ -1739,7 +1856,8 @@ rewrite ge_max;apply /andP;split. by rewrite normr_gt0 lt0r_neq0. rewrite !mulrA. apply ler_pM => //. -Abort. +Unshelve. all: by end_near. Qed. + (*Lemma invariant_state_space_tilt p (p33 : state_space tilt_eqn' state_space_tilt p) : From c92fbbe878a2fee049c452ae7f4e99c34c31006d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 29 Jan 2026 01:11:39 +0900 Subject: [PATCH 078/144] enorm --- dh.v | 36 +-- differential_kinematics.v | 2 +- euclidean.v | 202 +++++++------- frame.v | 74 ++--- octonion.v | 8 +- quaternion.v | 76 +++--- rigid.v | 34 +-- rot.v | 195 ++++++------- scara.v | 16 +- screw.v | 112 ++++---- skew.v | 51 ++-- ssr_ext.v | 6 + tilt.v | 559 ++++++++------------------------------ tilt_analysis.v | 249 ++++++++++------- tilt_mathcomp.v | 35 +-- tilt_robot.v | 225 ++++++++++----- vec_angle.v | 262 +++++++++--------- 17 files changed, 968 insertions(+), 1174 deletions(-) diff --git a/dh.v b/dh.v index 9aa12bd9..46adb9b4 100644 --- a/dh.v +++ b/dh.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. From mathcomp Require Import realalg complex fingroup perm. @@ -54,7 +54,7 @@ Implicit Types l : Line.t T. Definition normalized_plucker_direction l := let p1 := \pt( l ) in let p2 := \pt2( l ) in - (norm (p2 - p1))^-1 *: (p2 - p1). + (`|p2 - p1|_e)^-1 *: (p2 - p1). Lemma normalized_plucker_directionP (l : Line.t T) : \vec( l ) != 0 -> let e := normalized_plucker_direction l in e *d e == 1. @@ -62,8 +62,8 @@ Proof. move=> l0 /=. rewrite /normalized_plucker_direction dotmulZv dotmulvZ dotmulvv. rewrite -Line.vectorE. -rewrite mulrA mulrAC expr2 mulrA mulVr ?unitfE ?norm_eq0 // mul1r. -by rewrite divrr // unitfE norm_eq0. +rewrite mulrA mulrAC expr2 mulrA mulVr ?unitfE ?enorm_eq0// mul1r. +by rewrite divrr // unitfE enorm_eq0. Qed. Definition normalized_plucker_position l := @@ -88,22 +88,22 @@ Lemma normalized_pluckerP l : let p1 := \pt( l ) in let p2 := \pt2( l ) in \vec( l ) != 0 -> - plucker_of_line l = norm (p2 - p1) *: normalized_plucker l. + plucker_of_line l = `|p2 - p1|_e *: normalized_plucker l. Proof. move=> p1 p2 l0. rewrite /normalized_plucker /normalized_plucker_direction /normalized_plucker_position. rewrite -/p1 -/p2 (linearZr_LR crossmul) -scale_row_mx scalerA. -by rewrite divrr ?scale1r // unitfE norm_eq0 /p2 -Line.vectorE. +by rewrite divrr ?scale1r // unitfE enorm_eq0 /p2 -Line.vectorE. Qed. Lemma plucker_of_lineE l (l0 : \vec( l ) != 0) : - plucker_of_line l = norm (\pt2( l ) - \pt( l )) *: + plucker_of_line l = `|\pt2( l ) - \pt( l )|_e *: (Plucker.mkArray (normalized_plucker_directionP l0) (normalized_plucker_positionP l) : 'M__). Proof. rewrite /plucker_of_line /plucker_array_mx /=. rewrite /normalized_plucker_direction /normalized_plucker_position. rewrite (linearZr_LR crossmul) -scale_row_mx. -by rewrite scalerA divrr ?scale1r // unitfE norm_eq0 -Line.vectorE. +by rewrite scalerA divrr ?scale1r // unitfE enorm_eq0 -Line.vectorE. Qed. Definition plucker_eqn p l := @@ -218,14 +218,14 @@ have H1 : From1To0 0 2%:R = 0. by rewrite !rowframeE. have [H2a H2b] : From1To0 0 0 ^+ 2 + From1To0 0 1 ^+ 2 = 1 /\ From1To0 1 2%:R ^+ 2 + From1To0 2%:R 2%:R ^+ 2 = 1. - move: (norm_row_of_O (FromTo_is_O F1 F0) 0) => /= /(congr1 (fun x => x ^+ 2)). + move: (enorm_row_of_O (FromTo_is_O F1 F0) 0) => /= /(congr1 (fun x => x ^+ 2)). rewrite expr1n -dotmulvv dotmulE sum3E [_ 0 2%:R]mxE. move: (H1); rewrite {1}/From1To0 -lock => ->. rewrite mulr0 addr0 -!expr2 => H1a. split. rewrite [_ 0 0]mxE [_ 0 1]mxE in H1a. by rewrite /From1To0 -lock. - move: (norm_col_of_O (FromTo_is_O F1 F0) 2%:R) => /= /(congr1 (fun x => x ^+ 2)). + move: (enorm_col_of_O (FromTo_is_O F1 F0) 2%:R) => /= /(congr1 (fun x => x ^+ 2)). rewrite expr1n -dotmulvv dotmulE sum3E 2![_ 0 0]mxE. move: (H1); rewrite {1}/From1To0 -lock => ->. by rewrite mulr0 add0r -!expr2 tr_col [_ 0 1]mxE [_ 0 2%:R]mxE /From1To0 -lock !mxE. @@ -256,8 +256,8 @@ move: (H22); rewrite {1}/From1To0 -lock => ->. rewrite 2![_ 0 2%:R]mxE => /eqP. rewrite addr_eq0 => /eqP H10_H20. -move: (norm_col_of_O (FromTo_is_O F1 F0) 1) => /= /(congr1 (fun x => x ^+ 2)). -rewrite expr1n sqr_norm sum3E tr_col [_ 0 0]mxE [_ 1 0]mxE. +move: (enorm_col_of_O (FromTo_is_O F1 F0) 1) => /= /(congr1 (fun x => x ^+ 2)). +rewrite expr1n sqr_enorm sum3E tr_col [_ 0 0]mxE [_ 1 0]mxE. move: (H01); rewrite {1}/From1To0 -lock => ->. rewrite [_ 0 1]mxE [_ 1 1]mxE [_ 0 2%:R]mxE [_ 1 2%:R]mxE. move/eqP. rewrite -addrA eq_sym addrC -subr_eq -cos2sin2. move/eqP. @@ -266,8 +266,8 @@ rewrite mulrDr -(@exprMn _ _ (sin alpha) (_ 1 1)) (mulrC _ (_ 1 1)) H11_H21. rewrite sqrrN exprMn [in X in _ = X -> _](mulrC (sin alpha ^+ 2)). rewrite -mulrDr cos2Dsin2 mulr1 => /esym sqr_H21. -move: (norm_col_of_O (FromTo_is_O F1 F0) 0) => /= /(congr1 (fun x => x ^+ 2)). -rewrite sqr_norm sum3E 2![_ 0 0]mxE. +move: (enorm_col_of_O (FromTo_is_O F1 F0) 0) => /= /(congr1 (fun x => x ^+ 2)). +rewrite sqr_enorm sum3E 2![_ 0 0]mxE. move: (H00); rewrite {1}/From1To0 -lock => ->. rewrite expr1n [_ 0 1]mxE [_ 1 0]mxE [_ 0 2%:R]mxE [_ 2%:R 0]mxE. move=> H10_H20_save; move: (H10_H20_save). @@ -296,8 +296,8 @@ have H4 : From1To0 = dh_rot theta alpha. move/eqP : (sa0) => /sin0cos1 /eqP. rewrite eqr_norml ler01 andbT. - move: (norm_row_of_O (FromTo_is_O F1 F0) 1) => /= /(congr1 (fun x => x ^+ 2)). - rewrite expr1n sqr_norm sum3E [_ 0 0]mxE [_ 0 1]mxE [_ 0 2%:R]mxE. + move: (enorm_row_of_O (FromTo_is_O F1 F0) 1) => /= /(congr1 (fun x => x ^+ 2)). + rewrite expr1n sqr_enorm sum3E [_ 0 0]mxE [_ 0 1]mxE [_ 0 2%:R]mxE. move: (H12); rewrite {1}/From1To0 -lock => ->; rewrite (eqP sa0) expr0n addr0. move=> H10_H11. @@ -457,7 +457,7 @@ Variable T : rcfType. Let vector := 'rV[T]_3. Record t := mk { vaxis : vector ; - norm_vaxis : norm vaxis = 1 ; + norm_vaxis : `|vaxis|_e = 1 ; angle : T (* between to successive X axes *) }. End joint. End Joint. @@ -530,7 +530,7 @@ Definition link_offset (frames : frame ^ n.+1) (links : link ^ n.+1) (i : 'I_n) let: (o_succi, x_succi) := let f := frames succi in (\o{f}, f~i) in let: (o_i, x_i, z_i) := let f := frames i' in (\o{f}, f~i, f~k) in if intersection (zaxis (frames i')) (xaxis (frames succi)) is some o'_i then - (norm (o'_i - o_i)(*the Zi-coordiante of o'_i*) == Link.offset (links i')) && + (`|o'_i - o_i|_e(*the Zi-coordiante of o'_i*) == Link.offset (links i')) && (`| Link.offset (links i') | == distance_between_lines (xaxis (frames i')) (xaxis (frames succi))) else false (* should not happen since Zi always intersects Xi.+1 (see condidion 2.) *). diff --git a/differential_kinematics.v b/differential_kinematics.v index ed2f6586..8d7fa48e 100644 --- a/differential_kinematics.v +++ b/differential_kinematics.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat. From mathcomp Require Import interval_inference. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. diff --git a/euclidean.v b/euclidean.v index c4ddf1da..ed35b7d3 100644 --- a/euclidean.v +++ b/euclidean.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. From mathcomp Require Import sesquilinear. @@ -26,7 +26,7 @@ Require Import ssr_ext. (* ``` *) (* u *d w == the dot-product of the vectors u and v, i.e., the only *) (* component of the 1x1-matrix u * v^T *) -(* norm u == the norm of vector u, i.e., the square root of u *d u *) +(* enorm u == the norm of vector u, i.e., the square root of u *d u *) (* normalize u == scales vector u to be of unit norm *) (* A _|_ B == A and B are normal *) (* 'O[T]_n == the type of orthogonal matrices of size n *) @@ -269,62 +269,64 @@ HB.instance Definition _ := Check @dotmul _ _ : {symmetric 'rV[T]_n}. -Let neq0_norm_gt0 (u : 'rV[T]_n) : u != 0 -> 0 < dotmul u u. +Let neq0_enorm_gt0 (u : 'rV[T]_n) : u != 0 -> 0 < dotmul u u. Proof. move=> u0. by rewrite lt_neqAle eq_sym dotmulvv0 u0 le0dotmul. Qed. -HB.instance Definition _ := isDotProduct.Build _ _ (@dotmul T n) neq0_norm_gt0. +HB.instance Definition _ := isDotProduct.Build _ _ (@dotmul T n) neq0_enorm_gt0. End dot_product. -Section norm. +Section euclidean_norm. Context {T : rcfType} {n : nat}. Implicit Types u v : 'rV[T]_n. Local Notation "''[' u , v ]" := (dotmul u v) : ring_scope. Local Notation "''[' u ]" := '[u, u]%R : ring_scope. -Definition norm u : T := Num.sqrt '[u]. +Definition enorm u : T := Num.sqrt '[u]. -Lemma normN u : norm (- u) = norm u. +Local Notation "`| x |_e" := (enorm x). + +Lemma enormN u : `| - u |_e = enorm u. Proof. -by rewrite /norm (@hnormN T false idfun). +by rewrite /enorm (@hnormN T false idfun). Qed. -Lemma norm0 : norm 0 = 0. -Proof. by rewrite /norm dotmul0v sqrtr0. Qed. +Lemma enorm0 : `| 0 |_e = 0. +Proof. by rewrite /enorm dotmul0v sqrtr0. Qed. -Lemma norm_delta_mx i : norm 'e_i = 1. -Proof. by rewrite /norm /dotmul trmx_delta mul_delta_mx mxE !eqxx sqrtr1. Qed. +Lemma enorm_delta_mx i : `| 'e_i |_e = 1. +Proof. by rewrite /enorm /dotmul trmx_delta mul_delta_mx mxE !eqxx sqrtr1. Qed. -Lemma norm_ge0 u : norm u >= 0. -Proof. by apply sqrtr_ge0. Qed. -Hint Resolve norm_ge0 : core. +Lemma enorm_ge0 u : `| u |_e >= 0. +Proof. exact: sqrtr_ge0. Qed. +Hint Resolve enorm_ge0 : core. -Lemma normr_norm u : `|norm u| = norm u. +Lemma normr_enorm u : `| `| u |_e | = `| u |_e. Proof. by rewrite ger0_norm. Qed. -Lemma norm_eq0 u : (norm u == 0) = (u == 0). +Lemma enorm_eq0 u : (`| u |_e == 0) = (u == 0). Proof. by rewrite -sqrtr0 eqr_sqrt // ?dotmulvv0 // le0dotmul. Qed. -Lemma norm_gt0 u : (0 < norm u) = (u != 0). -Proof. by rewrite lt_neqAle norm_ge0 andbT eq_sym norm_eq0. Qed. +Lemma enorm_gt0 u : (0 < `| u |_e ) = (u != 0). +Proof. by rewrite lt_neqAle enorm_ge0 andbT eq_sym enorm_eq0. Qed. -Lemma normZ (k : T) u : norm (k *: u) = `|k| * norm u. +Lemma enormZ (k : T) u : `| k *: u |_e = `| k | * `| u |_e. Proof. -by rewrite /norm dotmulvZ dotmulZv mulrA sqrtrM -expr2 ?sqrtr_sqr // sqr_ge0. +by rewrite /enorm dotmulvZ dotmulZv mulrA sqrtrM -expr2 ?sqrtr_sqr // sqr_ge0. Qed. -Lemma dotmulvv u : u *d u = norm u ^+ 2. +Lemma dotmulvv u : u *d u = `| u |_e ^+ 2. Proof. -rewrite /norm [_ ^+ _]sqr_sqrtr // dotmulE sumr_ge0 //. +rewrite /enorm [_ ^+ _]sqr_sqrtr // dotmulE sumr_ge0 //. by move=> i _; rewrite sqr_ge0. Qed. Lemma polarization_identity v u : - v *d u = 1 / 4%:R * (norm (v + u) ^+ 2 - norm (v - u) ^+ 2). + v *d u = 1 / 4%:R * (`|v + u|_e ^+ 2 - `|v - u|_e ^+ 2). Proof. apply: (@mulrI _ 4%:R); first exact: pnatf_unit. rewrite [in RHS]mulrA div1r divrr ?pnatf_unit // mul1r. @@ -335,74 +337,75 @@ rewrite opprD (addrCA (u *d u)) subrr addr0. by rewrite opprD addrA subrr add0r dotmulvN -mulNrn opprK. Qed. -Lemma sqr_norm u : norm u ^+ 2 = \sum_i u``_i ^+ 2. -Proof. rewrite -dotmulvv dotmulE; apply/eq_bigr => /= i _; by rewrite expr2. Qed. +Lemma sqr_enorm u : `| u |_e ^+ 2 = \sum_i u``_i ^+ 2. +Proof. by rewrite -dotmulvv dotmulE; apply/eq_bigr => /= i _; rewrite expr2. Qed. -Lemma mxtrace_tr_mul u : \tr (u^T *m u) = norm u ^+ 2. +Lemma mxtrace_tr_mul u : \tr (u^T *m u) = `| u |_e ^+ 2. Proof. -rewrite /mxtrace sqr_norm; apply/eq_bigr => /= i _; by rewrite mulmx_trE -expr2. +by rewrite /mxtrace sqr_enorm; apply/eq_bigr => /= i _; rewrite mulmx_trE -expr2. Qed. -Section norm1. - +Section enorm1. Variable u : 'rV[T]_n. -Hypothesis u1 : norm u = 1. +Hypothesis u1 : `| u |_e = 1. Lemma norm1_neq0 : u != 0. -Proof. move: u1; rewrite -norm_eq0 => ->; exact: oner_neq0. Qed. +Proof. move: u1; rewrite -enorm_eq0 => ->; exact: oner_neq0. Qed. Lemma dotmul1 : u *m u^T = 1. Proof. by rewrite dotmulP dotmulvv u1 expr1n. Qed. -End norm1. +End enorm1. -End norm. +End euclidean_norm. -Section normalize. +Notation "`| x |_e" := (enorm x). +Section normalize. Variables (T : rcfType) (n : nat). Implicit Type u v : 'rV[T]_3. -Definition normalize v := (norm v)^-1 *: v. +Definition normalize v := (`| v |_e)^-1 *: v. Lemma normalize0 : normalize 0 = 0. Proof. by rewrite /normalize scaler0. Qed. Lemma normalizeN u : normalize (- u) = - normalize u. -Proof. by rewrite /normalize normN scalerN. Qed. +Proof. by rewrite /normalize enormN scalerN. Qed. -Lemma normalizeI v : norm v = 1 -> normalize v = v. +Lemma normalizeI v : `| v |_e = 1 -> normalize v = v. Proof. by move=> v1; rewrite /normalize v1 invr1 scale1r. Qed. -Lemma norm_normalize v : v != 0 -> norm (normalize v) = 1. +Lemma norm_normalize v : v != 0 -> `| normalize v |_e = 1. Proof. -move=> v0; rewrite normZ ger0_norm; last by rewrite invr_ge0 // norm_ge0. -by rewrite mulVr // unitfE norm_eq0. +move=> v0; rewrite enormZ ger0_norm; last by rewrite invr_ge0// enorm_ge0. +by rewrite mulVr// unitfE enorm_eq0. Qed. Lemma normalize_eq0 v : (normalize v == 0) = (v == 0). Proof. apply/idP/idP => [|/eqP ->]; last by rewrite normalize0. case/boolP : (v == 0) => [//| /norm_normalize]. -rewrite -norm_eq0 => -> /negPn; by rewrite oner_neq0. +by rewrite -enorm_eq0 => -> /negPn; rewrite oner_neq0. Qed. -Lemma norm_scale_normalize u : norm u *: normalize u = u. +Lemma norm_scale_normalize u : `| u |_e *: normalize u = u. Proof. -case/boolP : (u == 0) => [/eqP -> {u}|u0]; first by rewrite norm0 scale0r. -by rewrite /normalize scalerA divrr ?scale1r // unitfE norm_eq0. +have [->|u0] := eqVneq u 0; first by rewrite enorm0 scale0r. +by rewrite /normalize scalerA divrr ?scale1r // unitfE enorm_eq0. Qed. -Lemma normalizeZ u (u0 : u != 0) k (k0 : 0 < k) : normalize (k *: u) = normalize u. +Lemma normalizeZ u (u0 : u != 0) k (k0 : 0 < k) : + normalize (k *: u) = normalize u. Proof. -rewrite {1}/normalize normZ gtr0_norm // invrM ?unitfE ?gt_eqF // ?norm_gt0 //. +rewrite {1}/normalize enormZ gtr0_norm // invrM ?unitfE ?gt_eqF ?enorm_gt0//. by rewrite scalerA -mulrA mulVr ?mulr1 ?unitfE ?gt_eqF. Qed. (* NB: not used *) -Lemma dotmul_normalize_norm u : u *d normalize u = norm u. +Lemma dotmul_normalize_enorm u : u *d normalize u = `| u |_e. Proof. -case/boolP : (u == 0) => [/eqP ->{u}|u0]; first by rewrite norm0 dotmul0v. +have [->|u0] := eqVneq u 0; first by rewrite enorm0 dotmul0v. rewrite -{1}(norm_scale_normalize u) dotmulZv dotmulvv norm_normalize //. by rewrite expr1n mulr1. Qed. @@ -411,9 +414,9 @@ Lemma dotmul_normalize u v : (normalize u *d v == 0) = (u *d v == 0). Proof. case/boolP : (u == 0) => [/eqP ->|u0]; first by rewrite normalize0. apply/idP/idP. - rewrite /normalize dotmulZv mulf_eq0 => /orP [|//]. - by rewrite invr_eq0 norm_eq0 (negbTE u0). -rewrite /normalize dotmulZv => /eqP ->; by rewrite mulr0. + rewrite /normalize dotmulZv mulf_eq0 => /orP[|//]. + by rewrite invr_eq0 enorm_eq0 (negbTE u0). +by rewrite /normalize dotmulZv => /eqP ->; rewrite mulr0. Qed. End normalize. @@ -686,23 +689,25 @@ rewrite -subr_eq0 -{1}(scale1r (v *m _)) -scalerBl scaler_eq0 => /orP []. by rewrite dotmul_conjc_eq0 (negbTE v0). Qed. -Lemma norm_row_of_O (T : rcfType) n M : M \is 'O[T]_n.+1 -> forall i, norm (row i M) = 1. +Lemma enorm_row_of_O (T : rcfType) n M : M \is 'O[T]_n.+1 -> + forall i, `|row i M|_e = 1. Proof. move=> MSO i. -apply/eqP; rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr1n; apply/eqP. -rewrite -dotmulvv; move/orthogonalP : MSO => /(_ i i) ->; by rewrite eqxx. +apply/eqP; rewrite -(@eqrXn2 _ 2) ?enorm_ge0// expr1n; apply/eqP. +by rewrite -dotmulvv; move/orthogonalP : MSO => /(_ i i) ->; rewrite eqxx. Qed. Lemma dot_row_of_O (T : pzRingType) n M : M \is 'O[T]_n.+1 -> forall i j, row i M *d row j M = (i == j)%:R. Proof. by move/orthogonalP. Qed. -Lemma norm_col_of_O (T : rcfType) n M : M \is 'O[T]_n.+1 -> forall i, norm (col i M)^T = 1. +Lemma enorm_col_of_O (T : rcfType) n M : M \is 'O[T]_n.+1 -> + forall i, `| (col i M)^T |_e = 1. Proof. move=> MSO i. apply/eqP. -rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr1n -dotmulvv tr_col dotmulvv. -by rewrite norm_row_of_O ?expr1n // orthogonalV. +rewrite -(@eqrXn2 _ 2) ?enorm_ge0// expr1n -dotmulvv tr_col dotmulvv. +by rewrite enorm_row_of_O ?expr1n// orthogonalV. Qed. Lemma orth_preserves_sqr_norm (T : comPzRingType) n M : M \is 'O[T]_n.+1 -> @@ -732,23 +737,25 @@ by rewrite eqr_pMn2r // => /eqP. Qed. Lemma orth_preserves_norm (T : rcfType) n M : M \is 'O[T]_n.+1 -> - {mono (fun u => u *m M) : x / norm x }. -Proof. move=> HM v; by rewrite /norm (proj2 (orth_preserves_dotmul M) HM). Qed. + {mono (fun u => u *m M) : x / `| x |_e }. +Proof. move=> HM v; by rewrite /enorm (proj2 (orth_preserves_dotmul M) HM). Qed. -Lemma Oij_ub (T : rcfType) n (M : 'M[T]_n.+1) : M \is 'O[T]_n.+1 -> forall i j, `| M i j | <= 1. +Lemma Oij_ub (T : rcfType) n (M : 'M[T]_n.+1) : M \is 'O[T]_n.+1 -> + forall i j, `| M i j | <= 1. Proof. -move=> /norm_row_of_O MO i j; rewrite leNgt; apply/negP => abs. +move=> /enorm_row_of_O MO i j; rewrite leNgt; apply/negP => abs. move: (MO i) => /(congr1 (fun x => x ^+ 2)); apply/eqP. -rewrite gt_eqF // sqr_norm (bigD1 j) //= !mxE -(addr0 (1 ^+ 2)) ltr_leD //. +rewrite gt_eqF // sqr_enorm (bigD1 j) //= !mxE -(addr0 (1 ^+ 2)) ltr_leD //. by rewrite -(sqr_normr (M _ _)) ltrXn2r. rewrite sumr_ge0 // => k ij; by rewrite sqr_ge0. Qed. -Lemma O_tr_idmx (T : rcfType) n (M : 'M[T]_n.+1) : M \is 'O[T]_n.+1 -> \tr M = n.+1%:R -> M = 1. +Lemma O_tr_idmx (T : rcfType) n (M : 'M[T]_n.+1) : M \is 'O[T]_n.+1 -> + \tr M = n.+1%:R -> M = 1. Proof. -move=> MO; move: (MO) => /norm_row_of_O MO' tr3. -have Mdiag : forall i, M i i = 1. - move=> i; apply/eqP/negPn/negP => Mii; move: tr3; apply/eqP. +move=> MO; move: (MO) => /enorm_row_of_O MO' tr3. +have Mdiag i : M i i = 1. + apply/eqP/negPn/negP => Mii; move: tr3; apply/eqP. rewrite lt_eqF // /mxtrace. rewrite (bigD1 i) //=. rewrite (eq_bigr (fun i : 'I_n.+1 => M (inord i) (inord i))); last first. @@ -763,7 +770,7 @@ have Mdiag : forall i, M i i = 1. apply/matrixP => i j; rewrite !mxE. case/boolP : (i == j) => [/eqP ->|ij]; first by move : Mdiag => /(_ j). move: (MO' i) => /(congr1 (fun x => x ^+ 2)). -rewrite expr1n sqr_norm (bigD1 i) //= mxE. +rewrite expr1n sqr_enorm (bigD1 i) //= mxE. move: Mdiag => /(_ i) -> /eqP. rewrite expr1n addrC eq_sym -subr_eq subrr eq_sym psumr_eq0 /=; last first. by move=> *; rewrite sqr_ge0. @@ -933,8 +940,8 @@ Proof. by rewrite e2row row3Z mulr1 mulr0. Qed. End row3. -Lemma norm_row3z (T : rcfType) (z : T) : norm (row3 0 0 z) = `|z|. -Proof. by rewrite /norm dotmulE sum3E !mxE /= ?(mul0r,add0r) sqrtr_sqr. Qed. +Lemma enorm_row3z (T : rcfType) (z : T) : `|row3 0 0 z|_e = `|z|. +Proof. by rewrite /enorm dotmulE sum3E !mxE /= ?(mul0r,add0r) sqrtr_sqr. Qed. Section col_mx2. Variable (T : pzRingType). @@ -1450,10 +1457,10 @@ Section norm3. Variable T : rcfType. Implicit Types u : 'rV[T]_3. -Lemma norm_crossmul' u v : - (norm (u *v v)) ^+ 2 = (norm u * norm v) ^+ 2 - (u *d v) ^+ 2. +Lemma enorm_crossmul' u v : + `| u *v v |_e ^+ 2 = (`| u |_e * `| v |_e) ^+ 2 - (u *d v) ^+ 2. Proof. -rewrite sqr_norm sum3E crossmulE /SimplFunDelta /= !mxE /=. +rewrite sqr_enorm sum3E crossmulE /SimplFunDelta /= !mxE /=. transitivity (((u``_0)^+2 + (u``_1)^+2 + (u``_2%:R)^+2) * ((v``_0)^+2 + (v``_1)^+2 + (v``_2%:R)^+2) - (u``_0 * v``_0 + u``_1 * v``_1 + u``_2%:R * v``_2%:R)^+2). @@ -1516,40 +1523,41 @@ transitivity (((u``_0)^+2 + (u``_1)^+2 + (u``_2%:R)^+2) rewrite -!mulNrn !mulr2n !opprD. rewrite addrC -!addrA; congr (_ + _). by rewrite addrCA. -rewrite exprMn -(sum3E (fun i => u``_i ^+ 2)) -(sum3E (fun i => v``_i ^+ 2)) -2!sqr_norm; congr (_ - _ ^+ 2). +rewrite exprMn -(sum3E (fun i => u``_i ^+ 2)) -(sum3E (fun i => v``_i ^+ 2)) -2!sqr_enorm; congr (_ - _ ^+ 2). by rewrite dotmulE sum3E. Qed. -Lemma orth_preserves_norm_crossmul M : M \is 'O[T]_3 -> - {mono (fun u => u *m M) : x y / norm (x *v y)}. +Lemma orth_preserves_enorm_crossmul M : M \is 'O[T]_3 -> + {mono (fun u => u *m M) : x y / `| x *v y |_e}. Proof. move=> MO u v. -by rewrite -[in RHS](orth_preserves_norm MO) mulmxr_crossmulr // normZ orthogonal_det // mul1r. +by rewrite -[in RHS](orth_preserves_norm MO) mulmxr_crossmulr // enormZ orthogonal_det // mul1r. Qed. -Lemma norm_crossmul_normal u v : u *d v = 0 -> - norm u = 1 -> norm v = 1 -> norm (u *v v) = 1. +Lemma enorm_crossmul_normal u v : u *d v = 0 -> + `| u |_e = 1 -> `| v |_e = 1 -> `| u *v v |_e = 1. Proof. move=> uv0 u1 v1; apply/eqP. -rewrite -(@eqrXn2 _ 2) // ?norm_ge0 //. -by rewrite norm_crossmul' u1 v1 uv0 expr0n /= subr0 mulr1 // norm_ge0. +rewrite -(@eqrXn2 _ 2) ?enorm_ge0//. +by rewrite enorm_crossmul' u1 v1 uv0 expr0n /= subr0 mulr1 // norm_ge0. Qed. -Lemma dotmul_eq0_crossmul_neq0 (u v : 'rV[T]_3) : u != 0 -> v != 0 -> u *d v == 0 -> u *v v != 0. +Lemma dotmul_eq0_crossmul_neq0 (u v : 'rV[T]_3) : u != 0 -> v != 0 -> + u *d v == 0 -> u *v v != 0. Proof. move=> u0 v0 uv0. -rewrite -norm_eq0 -(@eqrXn2 _ 2) // ?norm_ge0 // exprnP expr0n -exprnP. -rewrite norm_crossmul' (eqP uv0) expr0n subr0 -expr0n eqrXn2 //. -by rewrite mulf_eq0 negb_or 2!norm_eq0 u0. -by rewrite mulr_ge0 // ?norm_ge0. +rewrite -enorm_eq0 -(@eqrXn2 _ 2) ?enorm_ge0// exprnP expr0n -exprnP. +rewrite enorm_crossmul' (eqP uv0) expr0n subr0 -expr0n eqrXn2 //. + by rewrite mulf_eq0 negb_or 2!enorm_eq0 u0. +by rewrite mulr_ge0 ?enorm_ge0. Qed. End norm3. Section properties_of_canonical_vectors. -Lemma normeE (T : rcfType) i : norm ('e_i : 'rV_3) = 1 :> T. -Proof. by rewrite norm_delta_mx. Qed. +Lemma enormeE (T : rcfType) i : `| 'e_i : 'rV_3 |_e = 1 :> T. +Proof. by rewrite enorm_delta_mx. Qed. Variable T : comPzRingType. @@ -1599,8 +1607,8 @@ End properties_of_canonical_vectors. Lemma orthogonal3P (T : rcfType) (M : 'M[T]_3) : reflect (M \is 'O[T]_3) - [&& norm (row 0 M) == 1, norm (row 1 M) == 1, norm (row 2%:R M) == 1, - row 0 M *d row 1 M == 0, row 0 M *d row 2%:R M == 0 & row 1 M *d row 2%:R M == 0]. + [&& `|row 0 M|_e == 1, `|row 1 M|_e == 1, `|row 2 M|_e == 1, + row 0 M *d row 1 M == 0, row 0 M *d row 2 M == 0 & row 1 M *d row 2 M == 0]. Proof. apply (iffP idP). - case/and6P => /eqP ni /eqP nj /eqP nk /eqP xy0 /eqP xz0 /eqP yz0 /=. @@ -1612,20 +1620,20 @@ apply (iffP idP). + case/boolP : (j == 0) => [|/ifnot0P/orP[]]/eqP->; by [rewrite dotmulC xz0 | rewrite dotmulC yz0 | rewrite dotmulvv nk expr1n]. - move/orthogonalP => H; apply/and6P; split; first [ - by rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr1n -dotmulvv H | + by rewrite -(@eqrXn2 _ 2) ?enorm_ge0// expr1n -dotmulvv H | by rewrite H ]. Qed. Lemma rotation3P (T : rcfType) (M : 'M[T]_3) : reflect (M \is 'SO[T]_3) - [&& norm (row 0 M) == 1, norm (row 1 M) == 1, - row 0 M *d row 1 M == 0 & row 2%:R M == row 0 M *v row 1 M]. + [&& `|row 0 M|_e == 1, `|row 1 M|_e == 1, + row 0 M *d row 1 M == 0 & row 2 M == row 0 M *v row 1 M]. Proof. apply (iffP idP). - case/and4P => /eqP ni /eqP nj /eqP xy0 /eqP zxy0 /=. rewrite rotationE; apply/andP; split. apply/orthogonal3P. - rewrite ni nj /= zxy0 norm_crossmul_normal // xy0 !eqxx /= dot_crossmulC. + rewrite ni nj /= zxy0 enorm_crossmul_normal // xy0 !eqxx /= dot_crossmulC. by rewrite (@liexx _ (vec3 T)) dotmul0v dot_crossmulCA (@liexx _ (vec3 T)) dotmulv0 !eqxx. rewrite -(col_mx3_row M) -crossmul_triple zxy0 double_crossmul dotmulvv nj expr1n. by rewrite scale1r (dotmulC (row 1 M)) xy0 scale0r subr0 dotmulvv ni expr1n. @@ -1635,18 +1643,18 @@ apply (iffP idP). Qed. Lemma SO_icrossj (T : rcfType) (r : 'M[T]_3) : r \is 'SO[T]_3 -> - row 0 r *v row 1 r = row 2%:R r. + row 0 r *v row 1 r = row 2 r. Proof. by case/rotation3P/and4P => _ _ _ /eqP ->. Qed. Lemma SO_icrossk (T : rcfType) (r : 'M[T]_3) : r \is 'SO[T]_3 -> - row 0 r *v row 2%:R r = - row 1 r. + row 0 r *v row 2 r = - row 1 r. Proof. case/rotation3P/and4P => /eqP H1 _ /eqP H3 /eqP ->. by rewrite double_crossmul H3 scale0r add0r dotmulvv H1 expr1n scale1r. Qed. Lemma SO_jcrossk (T : rcfType) (r : 'M[T]_3) : r \is 'SO[T]_3 -> - row 1 r *v row 2%:R r = row 0 r. + row 1 r *v row 2 r = row 0 r. Proof. case/rotation3P/and4P => _ /eqP H1 /eqP H3 /eqP ->. by rewrite double_crossmul dotmulvv H1 expr1n scale1r dotmulC H3 scale0r subr0. diff --git a/frame.v b/frame.v index 9e266b08..bab1a344 100644 --- a/frame.v +++ b/frame.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. @@ -57,9 +57,9 @@ Record t : Type := mk { i : 'rV[T]_3 ; j : 'rV[T]_3 ; k : 'rV[T]_3 ; - normi : norm i = 1 ; - normj : norm j = 1 ; - normk : norm k = 1 ; + normi : `|i|_e = 1 ; + normj : `|j|_e = 1 ; + normk : `|k|_e = 1 ; idotj : i *d j = 0 ; jdotk : j *d k = 0 ; idotk : i *d k = 0 @@ -102,8 +102,8 @@ Let vector := 'rV[T]_3. Implicit Types p : 'rV[T]_3. Variable f : noframe T. -Lemma noframe_norm (k : 'I_3) : norm f|,k = 1. -Proof. by rewrite rowframeE; apply norm_row_of_O; case: f. Qed. +Lemma noframe_norm (k : 'I_3) : `| f|,k |_e = 1. +Proof. by rewrite rowframeE; apply enorm_row_of_O; case: f. Qed. Lemma noframe_idotj : f~i *d f~j = 0. Proof. by rewrite !rowframeE; apply/orthogonalP; case: f. Qed. @@ -124,9 +124,9 @@ Proof. apply/orthogonal_unit. by case: f. Qed. Lemma noframe_inv : (matrix_of_noframe f)^-1 = f^T. Proof. rewrite -orthogonal_inv //; by case: f. Qed. -Lemma norm_icrossj : norm (f~i *v f~j) = 1. +Lemma norm_icrossj : `|f~i *v f~j|_e = 1. Proof. -by rewrite norm_crossmul_normal // ?idotj // ?normi // normj. +by rewrite enorm_crossmul_normal // ?idotj // ?normi // normj. Qed. Definition noframe_sgn := \det f. @@ -447,7 +447,7 @@ Qed. Module Base1. Section base1. Variables (T : realType) (i : 'rV[T]_3). -Hypothesis normi : norm i = 1. +Hypothesis normi : `|i|_e = 1. Definition j := if colinear i 'e_0 then 'e_1 else normalize (normalcomp 'e_0 i). @@ -458,7 +458,7 @@ Proof. rewrite /j; case: ifPn => [|_]; last first. by rewrite dotmulvZ -{3}(normalizeI normi) dotmul_orthogonalize mulr0. case/colinearP => [| [_ [k ->]]]. - by rewrite -norm_eq0 norm_delta_mx (negbTE (oner_neq0 _)). + by rewrite -enorm_eq0 enorm_delta_mx (negbTE (oner_neq0 _)). by rewrite dotmulZv dote2 mulr0. Qed. @@ -468,16 +468,16 @@ Proof. by rewrite /k dot_crossmulC (@liexx _ (vec3 T)) dotmul0v. Qed. Lemma jdotk : j *d k = 0. Proof. by rewrite /k dot_crossmulCA (@liexx _ (vec3 T)) dotmulv0. Qed. -Lemma normj : norm j = 1. +Lemma normj : `| j |_e = 1. Proof. -rewrite /j; case: ifPn => iVi; first by rewrite norm_delta_mx. +rewrite /j; case: ifPn => iVi; first by rewrite enorm_delta_mx. rewrite norm_normalize //; apply: contra iVi. -by rewrite normalcomp_colinear // ?norm1_neq0 // colinear_sym. +by rewrite normalcomp_colinear ?norm1_neq0// colinear_sym. Qed. -Lemma normk : norm k = 1. +Lemma normk : `| k |_e = 1. Proof. -by rewrite /k norm_crossmul_normal // ?norm_normalize// ?normj// idotj // mulr0. +by rewrite /k enorm_crossmul_normal // ?norm_normalize// ?normj// idotj // mulr0. Qed. Definition M := col_mx3 i j k. @@ -522,7 +522,7 @@ Qed. End base1_lemmas. End Base1. -Canonical base1_is_noframe (T : realType) (u : 'rV[T]_3) (u1 : norm u = 1) := +Canonical base1_is_noframe (T : realType) (u : 'rV[T]_3) (u1 : `|u|_e = 1) := NOFrameInterface.mk u1 (Base1.normj u1) (Base1.normk u1) (Base1.idotj u1) (Base1.jdotk u) (Base1.idotk u). @@ -536,9 +536,9 @@ Definition i := if u == 0 then 'e_0 else normalize u. Definition j := if u == 0 then 'e_1 else Base1.j i. Definition k := if u == 0 then 'e_2%:R else Base1.k i. -Lemma normi : norm i = 1. +Lemma normi : `| i |_e = 1. Proof. -rewrite /i; case: ifP => [_|/eqP/eqP ?]; by rewrite ?normeE // norm_normalize. +rewrite /i; case: ifP => [_|/eqP/eqP ?]; by rewrite ?enormeE// norm_normalize. Qed. Parameter frame : 'rV[T]_3 -> frame T. @@ -560,10 +560,10 @@ Qed. Lemma frame0E (u0 : u != 0) : (frame u)~i = normalize u. Proof. by rewrite -iE /i (negbTE u0). Qed. -Lemma normj : norm j = 1. -Proof. by rewrite jE rowframeE norm_row_of_O // NOFrame.MO. Qed. -Lemma normk : norm k = 1. -Proof. by rewrite kE rowframeE norm_row_of_O // NOFrame.MO. Qed. +Lemma normj : `| j |_e = 1. +Proof. by rewrite jE rowframeE enorm_row_of_O // NOFrame.MO. Qed. +Lemma normk : `| k |_e = 1. +Proof. by rewrite kE rowframeE enorm_row_of_O // NOFrame.MO. Qed. Lemma idotj : i *d j = 0. Proof. by rewrite iE jE !rowframeE dot_row_of_O // NOFrame.MO. Qed. @@ -689,7 +689,7 @@ Qed. End scalar_neg. End scalar. -Lemma j_tr_mul (v : 'rV[T]_3) (v1 : norm v = 1) : j v *m v^T = 0. +Lemma j_tr_mul (v : 'rV[T]_3) (v1 : `| v |_e = 1) : j v *m v^T = 0. Proof. rewrite /j (negbTE (norm1_neq0 v1)) /Base1.j. case: ifPn => [|_]. @@ -703,7 +703,7 @@ rewrite -scalemxAl scaler_eq0 {2}/i (negbTE (norm1_neq0 v1)) normalizeI //. by rewrite normalcomp_mul_tr // orbT. Qed. -Lemma k_tr_mul (v : 'rV[T]_3) (v1 : norm v = 1) : k v *m v^T *m v = 0. +Lemma k_tr_mul (v : 'rV[T]_3) (v1 : `| v |_e = 1) : k v *m v^T *m v = 0. Proof. rewrite /k (negbTE (norm1_neq0 v1)) /Base1.k /Base1.j. case: ifPn => [|_]. @@ -832,12 +832,12 @@ Qed. End FromTo_properties. (* TODO: move? *) -Lemma sqr_norm_frame (T : realType) (a : frame T) (v : 'rV[T]_3) : - norm v ^+ 2 = \sum_(i < 3) (v *d (a |, i%:R))^+2. +Lemma sqr_enorm_frame (T : realType) (a : frame T) (v : 'rV[T]_3) : + `| v |_e ^+ 2 = \sum_(i < 3) (v *d (a |, i%:R))^+2. Proof. -have H : norm v = norm (v *m (can_frame T) _R^ a). +have H : `| v |_e = `| v *m (can_frame T) _R^ a |_e. by rewrite orth_preserves_norm // FromTo_is_O. -rewrite H sqr_norm [in LHS]sum3E [in RHS]sum3E; congr (_ ^+ 2 + _ ^+ 2 + _ ^+ 2); +rewrite H sqr_enorm [in LHS]sum3E [in RHS]sum3E; congr (_ ^+ 2 + _ ^+ 2 + _ ^+ 2); by rewrite FromTo_from_can mxE_dotmul_row_col -tr_row trmxK row_id NOFrame.rowframeE. Qed. @@ -963,22 +963,22 @@ Definition t := (i, j, k). Let ac : a != c. Proof. by apply: contra abc => /eqP ->; rewrite subrr /colinear linear0r. Qed. -Lemma normi : norm i = 1. +Lemma normi : `| i |_e = 1. Proof. by rewrite /i norm_normalize // subr_eq0 eq_sym. Qed. Lemma i_neq0 : i != 0. -Proof. by rewrite -norm_eq0 normi oner_neq0. Qed. +Proof. by rewrite -enorm_eq0 normi oner_neq0. Qed. -Lemma normj : norm j = 1. +Lemma normj : `| j |_e = 1. Proof. rewrite /j norm_normalize // normalcomp_colinear; last first. - by rewrite -norm_eq0 normi oner_neq0. -apply: contra (abc); rewrite colinearvZ invr_eq0 norm_eq0 subr_eq0. + by rewrite -enorm_eq0 normi oner_neq0. +apply: contra (abc); rewrite colinearvZ invr_eq0 enorm_eq0 subr_eq0. by rewrite eq_sym (negPf ab) /= colinear_sym. Qed. Lemma j_neq0 : j != 0. -Proof. by rewrite -norm_eq0 normj oner_neq0. Qed. +Proof. by rewrite -enorm_eq0 normj oner_neq0. Qed. Lemma idotj : i *d j = 0. Proof. by rewrite /= /i /j dotmulZv dotmulvZ dotmul_orthogonalize 2!mulr0. Qed. @@ -989,11 +989,11 @@ Proof. by rewrite /k dot_crossmulCA (@liexx _ (vec3 T)) dotmulv0. Qed. Lemma idotk : i *d k = 0. Proof. by rewrite /k dot_crossmulC (@liexx _ (vec3 T)) dotmul0v. Qed. -Lemma normk : norm k = 1. -Proof. by rewrite norm_crossmul_normal // ?normi // ?normj // idotj. Qed. +Lemma normk : `| k |_e = 1. +Proof. by rewrite enorm_crossmul_normal // ?normi // ?normj // idotj. Qed. Lemma k_neq0 : k != 0. -Proof. by rewrite -norm_eq0 normk oner_neq0. Qed. +Proof. by rewrite -enorm_eq0 normk oner_neq0. Qed. Lemma is_O : col_mx3 i j k \is 'O[T]_3. Proof. diff --git a/octonion.v b/octonion.v index 919c7a2f..99a8eeb9 100644 --- a/octonion.v +++ b/octonion.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. @@ -862,8 +862,8 @@ apply/eqP; rewrite eq_oct; apply/andP; split; apply/eqP. rewrite [in LHS]/= scaleoctE /=. rewrite !{1}(linear0, mul0r, mulr0, sub0r, add0r, subr0). rewrite [a.1 + _^*q]addrC addrK -scalerA addr0 -conjqE !mulrA !conjq_comm. - rewrite !conjqP /sqrq /= norm0 !expr0n expr1n /= !add0r !addr0. - rewrite !normeE !mul1r expr1n mul1r -3!opprD addrA -!mulr2n scalerN. + rewrite !conjqP /sqrq /= enorm0 !expr0n expr1n /= !add0r !addr0. + rewrite !enormeE !mul1r expr1n mul1r -3!opprD addrA -!mulr2n scalerN. rewrite -mulrnA -scaler_nat !scalerA -scalerBl. rewrite -{1}[3%:R^-1]mulr1 -mulrA -mulrBr natrM mulrA mulNr. rewrite mulVf ?(eqr_nat _ _ 0) //. @@ -874,7 +874,7 @@ apply: etrans (_ : -(2%:R / 3%:R) *: a.2 + -(1 / 3%:R) *: a.2 = _). rewrite -scalerDl -opprD -mulrDl -(natrD _ _ 1) mulfV ?scaleN1r //. by rewrite (eqr_nat _ _ 0). congr (_ + _). - rewrite 3!addr0 -scalerA -!{1}mulrA !{1}conjqP /sqrq !normeE /= + rewrite 3!addr0 -scalerA -!{1}mulrA !{1}conjqP /sqrq !enormeE /= !expr0n !expr1n /=. rewrite !add0r !mul1r !mulr1 mulrC -mulrN -scalerA. rewrite -addrA -!mulr2n -mulrnA -scaler_nat !scalerA natrM mulrA. diff --git a/quaternion.v b/quaternion.v index 51a9c5cb..de7d5c94 100644 --- a/quaternion.v +++ b/quaternion.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_boot order ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. @@ -480,23 +480,23 @@ Section quaternion1. Variable R : realType. Implicit Types x y : quat R. -Definition sqrq x := x.1 ^+ 2 + norm (x.2) ^+ 2. +Definition sqrq x := x.1 ^+ 2 + `|x.2|_e ^+ 2. -Lemma sqrq0 : sqrq 0 = 0. Proof. by rewrite /sqrq norm0 expr0n add0r. Qed. +Lemma sqrq0 : sqrq 0 = 0. Proof. by rewrite /sqrq enorm0 expr0n add0r. Qed. Lemma sqrq_ge0 x : 0 <= sqrq x. Proof. by rewrite addr_ge0 // sqr_ge0. Qed. Lemma sqrq_eq0 x : (sqrq x == 0) = (x == 0). Proof. -rewrite /sqrq paddr_eq0 ?sqr_ge0// !sqrf_eq0 norm_eq0 -xpair_eqE. +rewrite /sqrq paddr_eq0 ?sqr_ge0// !sqrf_eq0 enorm_eq0 -xpair_eqE. by rewrite -surjective_pairing. Qed. Lemma sqrqN x : sqrq (- x) = sqrq x. -Proof. by rewrite /sqrq /= normN sqrrN. Qed. +Proof. by rewrite /sqrq /= enormN sqrrN. Qed. Lemma sqrq_conj x : sqrq (x ^*q) = sqrq x. -Proof. by rewrite /sqrq normN. Qed. +Proof. by rewrite /sqrq enormN. Qed. Lemma conjqP x : x * x^*q = (sqrq x)%:q. Proof. @@ -524,11 +524,11 @@ Proof. apply/eqP; rewrite eq_quat; apply/andP; split; apply/eqP. rewrite [in LHS]/= scaleqE /=. rewrite !(mul0r,mulr0,addr0) scale0r !add0r !dotmulDl. - rewrite dotmulZv dotmulvv normeE expr1n mulr1 dotmulC + rewrite dotmulZv dotmulvv enormeE expr1n mulr1 dotmulC dot_crossmulC (@liexx _ (vec3 R)) dotmul0v addr0. - rewrite subrr add0r dotmulZv dotmulvv normeE expr1n mulr1 + rewrite subrr add0r dotmulZv dotmulvv enormeE expr1n mulr1 dotmulC dot_crossmulC (@liexx _ (vec3 R)) . - rewrite dotmul0v addr0 dotmulZv dotmulvv normeE expr1n mulr1 + rewrite dotmul0v addr0 dotmulZv dotmulvv enormeE expr1n mulr1 opprD addrA dotmulC dot_crossmulC. rewrite (@liexx _ (vec3 R)) dotmul0v subr0 -opprD mulrN mulNr opprK -mulr2n -(mulr_natl x.1) mulrA. @@ -536,13 +536,13 @@ apply/eqP; rewrite eq_quat; apply/andP; split; apply/eqP. rewrite /= !(mul0r,scale0r,add0r,addr0). rewrite [_ *v 'e_0](@lieC _ (vec3 R)) /= ['e_0 *v _]linearD /=. rewrite ['e_0 *v (x.1 *: _)]linearZ /= (@liexx _ (vec3 R)) . -rewrite scaler0 add0r double_crossmul dotmulvv normeE expr1n scale1r. +rewrite scaler0 add0r double_crossmul dotmulvv enormeE expr1n scale1r. rewrite [_ *v 'e_1](@lieC _ (vec3 R)) /= ['e_1 *v _]linearD /=. rewrite ['e_1 *v (x.1 *: _)]linearZ /= (@liexx _ (vec3 R)) . -rewrite scaler0 add0r double_crossmul dotmulvv normeE expr1n scale1r. +rewrite scaler0 add0r double_crossmul dotmulvv enormeE expr1n scale1r. rewrite [_ *v 'e_2%:R](@lieC _ (vec3 R)) /= ['e_2%:R *v _]linearD /=. rewrite ['e_2%:R *v (x.1 *: _)]linearZ /= (@liexx _ (vec3 R)). -rewrite scaler0 add0r double_crossmul dotmulvv normeE expr1n scale1r. +rewrite scaler0 add0r double_crossmul dotmulvv enormeE expr1n scale1r. rewrite [X in _ = - _ *: X](_ : _ = 2%:R *:x.2). by rewrite scalerA mulNr div1r mulVr ?unitfE ?pnatr_eq0 // scaleN1r. rewrite !opprB (addrCA _ x.2). @@ -626,10 +626,10 @@ Lemma invqE x : x^-1 = invq x. Proof. by done. Qed. Definition normq x := Num.sqrt (sqrq x). Lemma normq0 : normq 0 = 0. -Proof. by rewrite /normq /sqrq expr0n /= norm0 add0r expr0n sqrtr0. Qed. +Proof. by rewrite /normq /sqrq expr0n /= enorm0 add0r expr0n sqrtr0. Qed. Lemma normqc x : normq x^*q = normq x. -Proof. by rewrite /normq /sqrq /= normN. Qed. +Proof. by rewrite /normq /sqrq /= enormN. Qed. Lemma normqE x : (normq x ^+ 2)%:q = x^*q * x. Proof. @@ -643,9 +643,9 @@ Proof. by apply sqrtr_ge0. Qed. Lemma normq_eq0 x : (normq x == 0) = (x == 0). Proof. by rewrite /normq -{1}sqrtr0 eqr_sqrt ?sqrq_ge0// sqrq_eq0. Qed. -Lemma normq_vector (u : 'rV[R]_3) : normq u%:v = norm u. +Lemma normq_vector (u : 'rV[R]_3) : normq u%:v = `|u|_e. Proof. -by rewrite /normq /sqrq /= expr0n add0r sqrtr_sqr ger0_norm ?norm_ge0. +by rewrite /normq /sqrq /= expr0n add0r sqrtr_sqr ger0_norm ?enorm_ge0. Qed. Lemma normqM x y : normq (x * y) = normq x * normq y. @@ -659,7 +659,7 @@ Qed. Lemma normqZ (k : R) x : normq (k *: x) = `|k| * normq x. Proof. -by rewrite /normq /sqrq /= normZ 2!exprMn sqr_normr -mulrDr sqrtrM ?sqr_ge0 // +by rewrite /normq /sqrq /= enormZ 2!exprMn sqr_normr -mulrDr sqrtrM ?sqr_ge0 // sqrtr_sqr. Qed. @@ -688,7 +688,7 @@ Definition lequat x y := (x.2 == y.2) && (x.1 <= y.1). Lemma lequat_normD x y : lequat (normQ (x + y)) (normQ x + normQ y). Proof. -rewrite /lequat /= add0r eqxx andTb /normq /sqrq !sqr_norm !sum3E /= !mxE. +rewrite /lequat /= add0r eqxx andTb /normq /sqrq !sqr_enorm !sum3E /= !mxE. pose X := nth 0 [:: x.1; x _i; x _j; x _k]. pose Y := nth 0 [:: y.1; y _i; y _j; y _k]. suff: Num.sqrt (\sum_(i < 4) (X i + Y i)^+2) <= @@ -778,12 +778,12 @@ apply/idP/idP. rewrite /lequat /=. case/andP => /eqP<- x0Ly0. apply/eqP; congr mkQuat; rewrite ?subrr ?expr0n ?addr0 //=. - rewrite norm0 expr0n addr0 sqrtr_sqr. + rewrite enorm0 expr0n addr0 sqrtr_sqr. by apply/eqP; rewrite -ger0_def subr_ge0. case/eqP => /eqP H H1. move: (sym_equal H1) H => /subr0_eq->. rewrite /lequat /= eqxx /=. -by rewrite subrr norm0 expr0n addr0 sqrtr_sqr -ger0_def subr_ge0. +by rewrite subrr enorm0 expr0n addr0 sqrtr_sqr -ger0_def subr_ge0. Qed. Lemma ltquat_def x y : ltquat x y = (y != x) && lequat x y. @@ -824,7 +824,7 @@ Lemma invuq_proof x : x \is uquat -> normq (x^-1) == 1. Proof. by move=> ux; rewrite invq_uquat // normqc. Qed. Lemma cos_atan_uquat x : x \is uquat -> x \isn't pureq -> - let a := atan (norm x.2 / x.1) in cos a ^+ 2 = x.1 ^+ 2. + let a := atan (`|x.2|_e / x.1) in cos a ^+ 2 = x.1 ^+ 2. Proof. move=> ux q00 a. rewrite cos_atan exprMn [x.1 ^-1 ^+2]exprVn. @@ -835,7 +835,7 @@ by rewrite -exprVn sqrtr_sqr normfV invrK sqr_normr. Qed. Lemma sin_atan_uquat x : x \is uquat -> x \isn't pureq -> - let a := atan (norm x.2 / x.1) in sin a ^+ 2 = norm x.2 ^+ 2. + let a := atan (`|x.2|_e / x.1) in sin a ^+ 2 = `|x.2|_e ^+ 2. Proof. move=> ux q00 a. rewrite /a sqr_sin_atan. @@ -861,7 +861,7 @@ by have := pureq_conj u%:v; rewrite qualifE /= eqxx => /esym/eqP ->; Simp.r. Qed. Lemma conjugationE x u : conjugation x u = - ((x.1 ^+ 2 - norm x.2 ^+ 2) *: u + + ((x.1 ^+ 2 - `|x.2|_e ^+ 2) *: u + ((x.2 *d u) *: x.2) *+ 2 + (x.1 *: (x.2 *v u)) *+ 2)%:v. Proof. @@ -891,7 +891,7 @@ move=> xu; rewrite /conjugation quat_vectZ -scalerAr -scalerAl. by rewrite -/(conjugation x x.2) conjugation_uquat. Qed. -Lemma norm_conjugation x u : x \is uquat -> normq (conjugation x u) = norm u. +Lemma norm_conjugation x u : x \is uquat -> normq (conjugation x u) = `|u|_e. Proof. rewrite qualifE => /eqP x1; rewrite /conjugation 2!normqM normqc x1; Simp.r. by rewrite normq_vector. @@ -914,18 +914,18 @@ Proof. by rewrite /quat_of_polar cospi sinpi scale0r. Qed. Lemma quat_of_polarpihalf v : quat_of_polar (pi / 2%:R) v = v%:v. Proof. by rewrite /quat_of_polar cos_pihalf sin_pihalf scale1r. Qed. -Lemma uquat_of_polar a v (v1 : norm v = 1) : quat_of_polar a v \is uquat. +Lemma uquat_of_polar a v (v1 : `|v|_e = 1) : quat_of_polar a v \is uquat. Proof. -by rewrite uquatE /quat_of_polar /sqrq /= normZ v1 mulr1 sqr_normr cos2Dsin2. +by rewrite uquatE /quat_of_polar /sqrq /= enormZ v1 mulr1 sqr_normr cos2Dsin2. Qed. Definition quat_rot x v : 'rV[R]_3 := (conjugation x v).2. -Lemma conjugation_quat_of_polar_axis v a : norm v = 1 -> +Lemma conjugation_quat_of_polar_axis v a : `|v|_e = 1 -> quat_rot (quat_of_polar a v) v = v. Proof. move=> v1. -rewrite /quat_rot conjugationE /= normZ exprMn v1 expr1n mulr1 sqr_normr. +rewrite /quat_rot conjugationE /= enormZ exprMn v1 expr1n mulr1 sqr_normr. rewrite dotmulZv dotmulvv v1 expr1n mulr1 linearZl_LR (@liexx _ (vec3 R)) /= 2!scaler0 mul0rn. rewrite addr0 scalerA -expr2 mulr2n scalerBl addrA subrK -scalerDl cos2Dsin2. by rewrite scale1r. @@ -937,8 +937,8 @@ Lemma conjugation_quat_of_polar_frame_j (f : frame R) a : quat_rot (quat_of_polar a f~i) f~j = cos (a *+ 2) *: f~j + sin (a *+ 2) *: f~k. Proof. -rewrite /quat_rot conjugationE /= normZ noframe_norm mulr1 sqr_normr dotmulZv. -have v0 : f~i != 0 by rewrite -norm_eq0 noframe_norm oner_neq0. +rewrite /quat_rot conjugationE /= enormZ noframe_norm mulr1 sqr_normr dotmulZv. +have v0 : f~i != 0 by rewrite -enorm_eq0 noframe_norm oner_neq0. rewrite (noframe_idotj f) mulr0 scale0r mul0rn addr0 linearZl_LR /=. rewrite (frame_icrossj f) scalerA [in RHS]mulr2n cosD sinD -!expr2. by congr (_ + _); rewrite (mulrC (sin a)) -mulr2n -scalerMnl. @@ -948,8 +948,8 @@ Lemma conjugation_quat_of_polar_frame_k (f : frame R) a : quat_rot (quat_of_polar a f~i) f~k = - sin (a *+ 2) *: f~j + cos (a *+ 2) *: f~k. Proof. -rewrite /quat_rot conjugationE /= normZ noframe_norm mulr1 sqr_normr dotmulZv. -have v0 : f~i != 0 by rewrite -norm_eq0 noframe_norm oner_neq0. +rewrite /quat_rot conjugationE /= enormZ noframe_norm mulr1 sqr_normr dotmulZv. +have v0 : f~i != 0 by rewrite -enorm_eq0 noframe_norm oner_neq0. rewrite (noframe_idotk f) mulr0 scale0r mul0rn addr0 linearZl_LR /=. rewrite (frame_icrossk f) 2!scalerN scalerA sinD cosD -!expr2 addrC scaleNr. by congr (_ + _); rewrite (mulrC (sin a)) -mulr2n -scalerMnl mulNrn. @@ -960,18 +960,18 @@ Definition polar_of_quat x : (R * 'rV_3)%type := if x.1 == 1 then (0, 'e_1) else (pi, 'e_1) else if x.1 == 0 then (pi / 2%:R, x.2) else let: u := normalize x.2 in - let: a := atan (norm x.2 / x.1) in + let: a := atan (`|x.2|_e / x.1) in if 0 < x.1 then (a, u) else (a + pi, u). Lemma polar_of_quat0 : polar_of_quat 0 = (pi, 'e_1). Proof. by rewrite /polar_of_quat eqxx eq_sym oner_eq0. Qed. -Lemma norm_polar_of_quat x : x \is uquat -> norm (polar_of_quat x).2 = 1. +Lemma norm_polar_of_quat x : x \is uquat -> `|(polar_of_quat x).2|_e = 1. Proof. case: x => a0 a1; rewrite /= qualifE /polar_of_quat /normq /sqrq /=. -have [/eqP ->|a10] := ifPn; first by case: ifPn; rewrite norm_delta_mx. +have [/eqP ->|a10] := ifPn; first by case: ifPn; rewrite enorm_delta_mx. case: (sgzP a0) => [-> /eqP| |]; try by rewrite norm_normalize. -by rewrite expr0n add0r sqrtr_sqr ger0_norm // norm_ge0. +by rewrite expr0n add0r sqrtr_sqr ger0_norm // enorm_ge0. Qed. Lemma polar_of_quatK x : x \is uquat -> @@ -979,7 +979,7 @@ Lemma polar_of_quatK x : x \is uquat -> Proof. case: x => a0 a1; rewrite /= qualifE /polar_of_quat /normq /sqrq /=. have [->|/eqP a1N u1] := a1 =P 0. - rewrite norm0 expr0n addr0 sqrtr_sqr; have [?/eqP->|?|_] := ltrgt0P a0. + rewrite enorm0 expr0n addr0 sqrtr_sqr; have [?/eqP->|?|_] := ltrgt0P a0. - by rewrite eqxx quat_of_polar01. - by rewrite eqr_oppLR => /eqP ->; rewrite eqrNxx oner_eq0 quat_of_polarpi1. - by rewrite eq_sym oner_eq0. @@ -1015,7 +1015,7 @@ Qed. HB.instance Definition _ x := @GRing.isLinear.Build _ _ _ _ _ (quat_rot_is_linear x). -Lemma quat_rot_isRot_polar v a : norm v = 1 -> +Lemma quat_rot_isRot_polar v a : `|v|_e = 1 -> isRot (a *+2) v (quat_rot (quat_of_polar a v)). Proof. move=> v1 /=. diff --git a/rigid.v b/rigid.v index 886bc1c6..10c03d7f 100644 --- a/rigid.v +++ b/rigid.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. @@ -66,7 +66,7 @@ Section isometry. Variables (T : rcfType) (n : nat). Record t := mk { f :> 'rV[T]_n -> 'rV[T]_n ; - P : {mono f : a b / norm (a - b)} }. + P : {mono f : a b / `|a - b|_e} }. End isometry. End Iso. @@ -92,17 +92,17 @@ Section central_isometry_n. Variable (T : rcfType) (n : nat). Implicit Types f : 'CIso[T]_n. -Lemma central_isometry_preserves_norm f : {mono f : x / norm x}. +Lemma central_isometry_preserves_enorm f : {mono f : x / `|x|_e}. Proof. by case: f => f f0 p; rewrite -(subr0 (f p)) -f0 Iso.P subr0. Qed. (* [oneill] first part of lemma 1.6, p.100 *) Lemma central_isometry_preserves_dotmul f : {mono f : u v / u *d v}. Proof. case: f => f f0 a b. -have /eqP : norm (f a - f b) = norm (a - b) by rewrite (Iso.P f). -rewrite /norm eqr_sqrt ?le0dotmul // !dotmulDl !dotmulDr !dotmulvv !normN. -rewrite !(central_isometry_preserves_norm (CIso.mk f0)) !addrA. -rewrite 2!(addrC _ (norm b ^+ 2)) => /eqP/addrI. +have /eqP : `|f a - f b|_e = `|a - b|_e by rewrite (Iso.P f). +rewrite /enorm eqr_sqrt ?le0dotmul // !dotmulDl !dotmulDr !dotmulvv !enormN. +rewrite !(central_isometry_preserves_enorm (CIso.mk f0)) !addrA. +rewrite 2!(addrC _ (`|b|_e ^+ 2)) => /eqP/addrI. rewrite -2!addrA => /addrI. rewrite -(dotmulC (f a)) dotmulvN -(dotmulC a) dotmulvN -2!mulr2n => /eqP. rewrite -mulr_natr -[in X in _ == X -> _]mulr_natr 2!mulNr eqr_opp. @@ -121,7 +121,7 @@ Local Open Scope frame_scope. Definition frame_central_iso f (F : noframe T) : noframe T. apply: (@NOFrame.mk _ (col_mx3 (f F~i) (f F~j) (f F~k))). apply/orthogonal3P. -by rewrite !rowK /= 3!central_isometry_preserves_norm 3!noframe_norm +by rewrite !rowK /= 3!central_isometry_preserves_enorm 3!noframe_norm 3!central_isometry_preserves_dotmul idotj noframe_idotk jdotk !eqxx. Defined. @@ -165,7 +165,7 @@ Lemma trans_ortho_of_iso f : Proof. set m := f 0. set Tm1f := fun x => f x - m. -have Tm1f_is_iso : {mono Tm1f : a b / norm (a - b)}. +have Tm1f_is_iso : {mono Tm1f : a b / `|a - b|_e}. move=> ? ?; by rewrite /Tm1f -addrA opprB 2!addrA subrK (Iso.P f). have Tm1f0 : Tm1f 0 = 0 by rewrite /Tm1f subrr. set c := @CIso.mk _ _ (Iso.mk Tm1f_is_iso) Tm1f0. @@ -288,7 +288,7 @@ Lemma dmapE f (u : vector) b a : Proof. move=> uab; by rewrite /dmap /= uab img_vec_iso. Qed. Lemma derivative_map_preserves_length f : - {mono (fun x : vector => f`* x) : u v / norm (u - v)}. + {mono (fun x : vector => f`* x) : u v / `|u - v|_e}. Proof. move=> u v; rewrite /dmap /= -(mulmxBl u v (ortho_of_iso f)). by rewrite orth_preserves_norm // ortho_of_iso_is_O. @@ -354,7 +354,7 @@ apply (@NOFrame.mk _ (col_mx3 e1 e2 e3)). apply/orthogonal3P; rewrite !rowK /=. do 3! rewrite orth_preserves_norm ?ortho_of_iso_is_O //. rewrite /u1p /u2p /u3p. - rewrite !rowframeE !rowE !mulmx1 3!normeE !eqxx /=. + rewrite !rowframeE !rowE !mulmx1 3!enormeE !eqxx /=. rewrite !(proj2 (orth_preserves_dotmul _)) ?ortho_of_iso_is_O //. rewrite /u1p /u2p /u3p. by rewrite !rowframeE /= !rowE ?mulmx1 !dote2 //= eqxx. @@ -1003,8 +1003,8 @@ Qed. End euclidean_motion. -Lemma motion_vector_preserves_norm (T : realType) (m : t T) : - {mono (motion_vector m) : u / norm u}. +Lemma motion_vector_preserves_enorm (T : realType) (m : t T) : + {mono (motion_vector m) : u / `|u|_e}. Proof. move=> ?; rewrite motion_vectorE orth_preserves_norm // rotation_sub //. exact: rotP. @@ -1028,8 +1028,8 @@ case/boolP : (Aa.angle M == 0) => a0. transitivity (u *m M); last first. (* TODO: lemma? *) by rewrite motion_pointE /= (mul_mx_row u) mulmx0 add_row_mx addr0 add0r to_hpointK. -have w1 : norm w = 1. - by rewrite /w aaxis_of // ?Aa.vaxis_neq0 // norm_normalize // Aa.vaxis_neq0. +have w1 : `|w|_e = 1. + by rewrite /w aaxis_of ?Aa.vaxis_neq0// norm_normalize // Aa.vaxis_neq0. rewrite rodriguesP //; congr (_ *m _) => {u}. by rewrite (angle_axis_eskew_old MSO) // Aa.vaxis_neq0. Qed. @@ -1091,11 +1091,11 @@ by rewrite mul_mx_row mulmx0 add_row_mx add0r to_hpointK. Qed. Lemma SE_preserves_length m : - {mono (EuclideanMotion.motion_point m) : a b / norm (a - b)}. + {mono (EuclideanMotion.motion_point m) : a b / `|a - b|_e}. Proof. move=> m0 m1. rewrite EuclideanMotion.motion_pointB. -by rewrite EuclideanMotion.motion_vector_preserves_norm. +by rewrite EuclideanMotion.motion_vector_preserves_enorm. Qed. Lemma ortho_of_isoE m : diff --git a/rot.v b/rot.v index 9a22b759..6d57b773 100644 --- a/rot.v +++ b/rot.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From Stdlib Require Import NsatzTactic. From mathcomp Require Import all_boot order ssralg ssrint ssrnum rat poly. @@ -155,8 +155,8 @@ Lemma rot2d M : M \is 'SO[T]_2 -> {a | - pi < a <= pi & M = RO a}. Proof. move=> MSO. move: (MSO); rewrite rotationE => /andP[MO _]. -case: (norm1_cossin (norm_row_of_O MO 0)); rewrite !mxE => a [a1 a2]. -case: (norm1_cossin (norm_row_of_O MO 1)); rewrite !mxE => b [b1 b2]. +case: (enorm1_cossin (enorm_row_of_O MO 0)); rewrite !mxE => a [a1 a2]. +case: (enorm1_cossin (enorm_row_of_O MO 1)); rewrite !mxE => b [b1 b2]. move/orthogonalP : (MO) => /(_ 0 1) /=. rewrite dotmulE sum2E !mxE a1 a2 b1 b2 -cosB => cE. have : `|sin (a - b)| = 1 by apply: cos0sin1. @@ -195,8 +195,8 @@ Lemma rot2d' M : { - pi < a <= pi /\ M = RO' a}}. Proof. move=> MO. -case: (norm1_cossin (norm_row_of_O MO 0)); rewrite !mxE => a [a1 a2]. -case: (norm1_cossin (norm_row_of_O MO 1)); rewrite !mxE => b [b1 b2]. +case: (enorm1_cossin (enorm_row_of_O MO 0)); rewrite !mxE => a [a1 a2]. +case: (enorm1_cossin (enorm_row_of_O MO 1)); rewrite !mxE => b [b1 b2]. move/orthogonalP : (MO) => /(_ 0 1) /=. rewrite dotmulE sum2E !mxE a1 a2 b1 b2 -cosB. have HM : M = col_mx2 (row2 (cos a) (sin a)) (row2 (cos b) (sin b)). @@ -295,9 +295,9 @@ Definition Ry a := col_mx3 Lemma Ry_is_SO a : Ry a \is 'SO[T]_3. Proof. apply/rotation3P/and4P; split. -- rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr1n. +- rewrite -(@eqrXn2 _ 2) // ?enorm_ge0 // expr1n. by rewrite -dotmulvv dotmulE sum3E !mxE /= mulr0 addr0 -2!expr2 sqrrN cos2Dsin2. -- rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr1n. +- rewrite -(@eqrXn2 _ 2) // ?enorm_ge0 // expr1n. by rewrite -dotmulvv dotmulE sum3E !mxE /= mulr0 addr0 add0r mulr1. - by rewrite 2!rowK /= dotmulE sum3E !mxE /= !mulr0 mul0r !add0r. - rewrite 3!rowK /= crossmulE !mxE /=. by Simp.r. @@ -333,9 +333,9 @@ Qed. Lemma Rz_is_SO a : Rz a \is 'SO[T]_3. Proof. apply/rotation3P/and4P; split. -- rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr1n. +- rewrite -(@eqrXn2 _ 2) ?enorm_ge0// expr1n. by rewrite -dotmulvv dotmulE sum3E !mxE /= mulr0 addr0 -2!expr2 cos2Dsin2. -- rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr1n. +- rewrite -(@eqrXn2 _ 2) ?enorm_ge0// expr1n. - by rewrite -dotmulvv dotmulE sum3E !mxE /= mulr0 addr0 mulrN mulNr opprK addrC cos2Dsin2. - by rewrite 2!rowK /= dotmulE sum3E !mxE /= mulrN mulr0 addr0 addrC mulrC subrr. - rewrite 3!rowK /= crossmulE !mxE /=. Simp.r. by rewrite -!expr2 cos2Dsin2 e2row. @@ -406,7 +406,7 @@ by rewrite cos0 sin0 mulmx1 scale0r addr0 scale1r. by rewrite mulmx1 sin0 cos0 scaleNr scale0r oppr0 add0r scale1r. Qed. -Lemma isRotpi (u1 : norm u = 1) : isRot pi u (mx_lin1 (u^T *m u *+ 2 - 1)). +Lemma isRotpi (u1 : `|u|_e = 1) : isRot pi u (mx_lin1 (u^T *m u *+ 2 - 1)). Proof. apply/isRotP; split => /=. - by rewrite mulmxBr mulmx1 mulr2n mulmxDr mulmxA dotmul1 // ?mul1mx addrK. @@ -569,8 +569,8 @@ have cd : k *m M = c *: j + d *: k. by rewrite {1}(orthogonal_expansion (Base.frame e) (k *m M)) dotmulC iMk scale0r add0r. have H1 : a ^+ 2 + b ^+ 2 = 1. - move/eqP: (norm_row_of_O (NOFrame.MO (Base.frame e)) 1). - rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr1n -dotmulvv. + move/eqP: (enorm_row_of_O (NOFrame.MO (Base.frame e)) 1). + rewrite -(@eqrXn2 _ 2) ?enorm_ge0// expr1n -dotmulvv. rewrite -(proj2 (orth_preserves_dotmul M) (rotation_sub MSO)). rewrite -rowframeE ab dotmulDr 2!dotmulDl 4!dotmulvZ 4!dotmulZv 2!dotmulvv. by rewrite normj // normk // !(expr1n,mulr1) -!expr2 dotmulC jdotk // !(mulr0,add0r,addr0) => /eqP. @@ -580,8 +580,8 @@ have H2 : a * c + b * d = 0. rewrite dotmulDr 2!dotmulDl 4!dotmulvZ 4!dotmulZv 2!dotmulvv normj // normk //. by rewrite expr1n !mulr1 dotmulC jdotk // 4!mulr0 add0r addr0 mulrC (mulrC d) => /eqP. have H3 : c ^+ 2 + d ^+ 2 = 1. - move/eqP: (norm_row_of_O (NOFrame.MO (Base.frame e)) 2%:R). - rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr1n -dotmulvv. + move/eqP: (enorm_row_of_O (NOFrame.MO (Base.frame e)) 2%:R). + rewrite -(@eqrXn2 _ 2) ?enorm_ge0// expr1n -dotmulvv. rewrite -(proj2 (orth_preserves_dotmul M) (rotation_sub MSO)) -!rowframeE -/k cd. rewrite dotmulDr 2!dotmulDl 4!dotmulvZ 4!dotmulZv 2!dotmulvv normj // normk //. by rewrite expr1n 2!mulr1 -2!expr2 dotmulC jdotk // !(mulr0,addr0,add0r) => /eqP. @@ -694,7 +694,7 @@ Qed. Local Notation "'`e^(' a ',' w ')'" := (emx3 a \S( w )). -Lemma eskew_pi w : norm w = 1 -> `e^(pi, w) = w^T *m w *+ 2 - 1. +Lemma eskew_pi w : `| w |_e = 1 -> `e^(pi, w) = w^T *m w *+ 2 - 1. Proof. move=> w1. rewrite /emx3 sinpi scale0r addr0 cospi opprK -(natrD _ 1 1). @@ -704,7 +704,7 @@ by rewrite (_ : 1%:A = 1) // ?subrCA ?subrr ?addr0 // -idmxE scale1r. Qed. Lemma eskew_pi' w a : - norm w = 1 -> cos a = -1 -> sin a = 0 -> `e^(a, w) = w^T *m w *+ 2 - 1. + `| w |_e = 1 -> cos a = -1 -> sin a = 0 -> `e^(a, w) = w^T *m w *+ 2 - 1. Proof. move=> w1 Hs Hc. rewrite /emx3 Hs Hc scale0r addr0 opprK -(natrD _ 1 1). @@ -725,10 +725,10 @@ Qed. Lemma tr_eskew a w : `e^(a, w)^T = `e^(a, - w). Proof. by rewrite tr_emx3 tr_spin /emx3 spinN. Qed. -Lemma eskewM a b w : norm w = 1 -> `e^(a, w) * `e^(b, w) = `e^(a + b, w). +Lemma eskewM a b w : `| w |_e = 1 -> `e^(a, w) * `e^(b, w) = `e^(a + b, w). Proof. move=> w1; by rewrite emx3M // spin3 w1 expr1n scaleN1r. Qed. -Lemma trace_eskew a w : norm w = 1 -> \tr `e^(a, w) = 1 + 2%:R * cos a. +Lemma trace_eskew a w : `| w |_e = 1 -> \tr `e^(a, w) = 1 + 2%:R * cos a. Proof. move=> w1. rewrite 2!mxtraceD !mxtraceZ /= mxtrace1. @@ -753,7 +753,7 @@ Definition angle_axis_rot a u := (u``_1 * u``_2%:R * va - u``_0 * sa) (u``_2%:R ^+2 * va + ca)). -Lemma eskewE a u : norm u = 1 -> `e^(a, u) = angle_axis_rot a u. +Lemma eskewE a u : `| u |_e = 1 -> `e^(a, u) = angle_axis_rot a u. Proof. pose va := 1 - cos a. pose ca := cos a. pose sa := sin a. move=> w1; apply/matrix3P/and9P; split; apply/eqP. @@ -792,18 +792,18 @@ move=> w1; apply/matrix3P/and9P; split; apply/eqP. by rewrite /va opprB addrC subrK. Qed. -Lemma eskew_is_O a u : norm u = 1 -> `e^(a, u) \is 'O[T]_3. +Lemma eskew_is_O a u : `| u |_e = 1 -> `e^(a, u) \is 'O[T]_3. Proof. move=> u1. by rewrite orthogonalE tr_emx3 tr_spin inv_emx3 // exp_spin u1 expr1n scaleN1r. Qed. -Lemma rank_eskew a w : norm w = 1 -> \rank `e^(a, w) = 3%N. +Lemma rank_eskew a w : `| w |_e = 1 -> \rank `e^(a, w) = 3%N. Proof. move=> w1; by rewrite mxrank_unit // orthogonal_unit // eskew_is_O. Qed. -Lemma det_eskew a w : norm w = 1 -> \det `e^(a, w) = 1. +Lemma det_eskew a w : `| w |_e = 1 -> \det `e^(a, w) = 1. Proof. move=> w1. move/orthogonal_det/eqP : (eskew_is_O (a / 2%:R) w1). @@ -812,7 +812,7 @@ rewrite mulmxE emx3M; last by rewrite spin3 w1 expr1n scaleN1r. by move/eqP; rewrite -splitr. Qed. -Lemma eskew_is_SO a w : norm w = 1 -> `e^(a, w) \is 'SO[T]_3. +Lemma eskew_is_SO a w : `| w |_e = 1 -> `e^(a, w) \is 'SO[T]_3. Proof. by move=> w1; rewrite rotationE eskew_is_O //= det_eskew. Qed. Definition expi a := (cos a +i* sin a)%C. @@ -828,7 +828,7 @@ Proof. by rewrite /expi cos0 sin0. Qed. Definition eskew_eigenvalues a : seq T[i] := [:: 1; expi a; expi (- a)]. -Lemma eigenvalue_ekew a w : norm w = 1 -> +Lemma eigenvalue_ekew a w : `| w |_e = 1 -> eigenvalue (map_mx (fun x => x%:C%C) `e^(a, w)) =1 [pred k | k \in eskew_eigenvalues a]. Proof. @@ -876,7 +876,7 @@ Qed. Lemma Rz_eskew a : Rz a = `e^(a, 'e_2%:R). Proof. -rewrite /Rz eskewE /angle_axis_rot ?norm_delta_mx //. +rewrite /Rz eskewE /angle_axis_rot ?enorm_delta_mx //. rewrite !mxE /= expr0n /=. Simp.r. by rewrite expr1n mul1r subrK -e2row. Qed. @@ -891,7 +891,7 @@ Qed. Section rodrigues_formula. Definition rodrigues u a w := - u - (1 - cos a) *: (norm w ^+ 2 *: u) + (1 - cos a) * (u *d w) *: w + sin a *: (w *v u). + u - (1 - cos a) *: (`|w|_e ^+ 2 *: u) + (1 - cos a) * (u *d w) *: w + sin a *: (w *v u). Lemma rodriguesP u a w : rodrigues u a w = u *m `e^(a, w). Proof. @@ -909,7 +909,7 @@ Qed. Definition rodrigues_unit u a w := cos a *: u + (1 - cos a) * (u *d w) *: w + sin a *: (w *v u). -Lemma rodrigues_unitP u a w : norm w = 1 -> rodrigues_unit u a w = u *m `e^(a, w). +Lemma rodrigues_unitP u a w : `|w|_e = 1 -> rodrigues_unit u a w = u *m `e^(a, w). Proof. move=> w1; rewrite -(rodriguesP u a w). rewrite /rodrigues /rodrigues_unit w1 expr1n scale1r; congr (_ + _ + _). @@ -924,7 +924,7 @@ move=> w0. pose f := Base.frame w. apply/isRotP; split => /=. - rewrite -rodriguesP // /rodrigues (norm_normalize w0) expr1n scale1r. - rewrite dotmul_normalize_norm scalerA -mulrA divrr ?mulr1 ?unitfE ?norm_eq0 //. + rewrite dotmul_normalize_enorm scalerA -mulrA divrr ?mulr1 ?unitfE ?enorm_eq0//. by rewrite subrK (linearZl_LR _ w)/= (@liexx _ (vec3 T)) 2!scaler0 addr0. - rewrite -rodriguesP // /rodrigues dotmulC norm_normalize // expr1n scale1r. rewrite (_ : normalize w = Base.i w) (*NB: lemma?*); last by rewrite /Base.i (negbTE w0). @@ -939,10 +939,11 @@ apply/isRotP; split => /=. by rewrite -/(Base.i w) Base.icrossk // scalerN scaleNr. Qed. -Lemma isRot_eskew a w w' : normalize w' = w -> norm w = 1 -> isRot a w' (mx_lin1 `e^(a, w)). +Lemma isRot_eskew a w w' : normalize w' = w -> `|w|_e = 1 -> + isRot a w' (mx_lin1 `e^(a, w)). Proof. move=> <- w1. -by rewrite isRot_eskew_normalize // -normalize_eq0 -norm_eq0 w1 oner_eq0. +by rewrite isRot_eskew_normalize // -normalize_eq0 -enorm_eq0 w1 oner_eq0. Qed. Lemma eskew_is_onto_SO M : M \is 'SO[T]_3 -> @@ -952,12 +953,12 @@ move=> MSO. set w : vector := normalize _. case: (SO_isRot MSO) => a aB Ha. exists a => //. -apply: (@same_isRot _ _ _ _ _ (norm (vaxis_euler M)) _ _ _ _ Ha); last first. +apply: (@same_isRot _ _ _ _ _ `|vaxis_euler M|_e _ _ _ _ Ha); last first. apply (@isRot_eskew _ _ w). by rewrite normalizeI // norm_normalize // vaxis_euler_neq0. by rewrite norm_normalize // vaxis_euler_neq0. by rewrite norm_scale_normalize. -by rewrite norm_gt0 vaxis_euler_neq0. +by rewrite enorm_gt0 vaxis_euler_neq0. by rewrite vaxis_euler_neq0. Qed. @@ -967,7 +968,7 @@ Section alternative_definition_of_eskew. Definition eskew_unit (a : T) (e : 'rV[T]_3) := e^T *m e + (cos a) *: (1 - e^T *m e) + sin a *: \S( e ). -Lemma eskew_unitE w (a : T) : norm w = 1 -> eskew_unit a w = `e^(a, w). +Lemma eskew_unitE w (a : T) : `| w |_e = 1 -> eskew_unit a w = `e^(a, w). Proof. move=> w1. rewrite /eskew_unit /emx3 addrAC sqr_spin -addrA addrCA. @@ -980,7 +981,7 @@ Qed. Local Open Scope frame_scope. (* TODO: move? *) -Lemma normalcomp_double_crossmul p (e : 'rV[T]_3) : norm e = 1 -> +Lemma normalcomp_double_crossmul p (e : 'rV[T]_3) : `| e |_e = 1 -> normalcomp p e *v ((Base.frame e)|,2%:R *v (Base.frame e)|,1) = e *v p. Proof. move=> u1. @@ -992,7 +993,7 @@ rewrite crossmul_axialcomp add0r (@lieC _ (vec3 T)) /=. by rewrite (linearNl _ (normalcomp p e))/= opprK. Qed. -Lemma normalcomp_mulO' a Q u p : norm u = 1 -> isRot a u (mx_lin1 Q) -> +Lemma normalcomp_mulO' a Q u p : `| u |_e = 1 -> isRot a u (mx_lin1 Q) -> normalcomp p u *m Q = cos a *: normalcomp p u + sin a *: (u *v p). Proof. move=> u1 H. @@ -1015,7 +1016,7 @@ by rewrite -double_crossmul normalcomp_double_crossmul. Qed. (* [angeles] p.42, eqn 2.49 *) -Lemma isRot_eskew_unit_inv a Q u : norm u = 1 -> +Lemma isRot_eskew_unit_inv a Q u : `| u |_e = 1 -> isRot a u (mx_lin1 Q) -> Q = eskew_unit a u. Proof. move=> u1 H; apply/eqP/mulmxP => p. @@ -1056,7 +1057,7 @@ Lemma isRot_pi_inv (R : 'M[T]_3) u : Proof. move=> u0 H. have /isRot_eskew_unit_inv {H} : isRot pi (normalize u) (mx_lin1 R). - by rewrite isRotZ // invr_gt0 norm_gt0. + by rewrite isRotZ // invr_gt0 enorm_gt0. rewrite norm_normalize // => /(_ erefl) ->. by rewrite eskew_unitE ?norm_normalize // eskew_pi // norm_normalize. Qed. @@ -1086,7 +1087,7 @@ Qed. (* reflection w.r.t. plan of normal u *) -Lemma anglepi (n : vector) (n1 : norm n = 1) : +Lemma anglepi (n : vector) (n1 : `| n |_e = 1) : angle (n^T *m n *+ 2 - 1) = pi. Proof. rewrite /angle mxtraceD linearN /= mxtrace1 mulr2n linearD /=. @@ -1124,14 +1125,14 @@ case/eskew_is_onto_SO : (MSO) => a aB Ma. move: (Msym). rewrite {1}Ma /emx3. rewrite symE !linearD /= trmx1 /= !linearZ /= sqr_spin !linearD /=. -do 2 rewrite (linearN _ (norm (normalize (vaxis_euler M)) ^+ 2)%:A)/=. -rewrite (linearN _ (norm (normalize (vaxis_euler M)) ^+ 2)%:A^T)/=. +do 2 rewrite (linearN _ (`|normalize (vaxis_euler M)|_e ^+ 2)%:A)/=. +rewrite (linearN _ (`|normalize (vaxis_euler M)|_e ^+ 2)%:A^T)/=. rewrite trmx_mul trmxK scalemx1 tr_scalar_mx tr_spin. rewrite !addrA subr_eq subrK. rewrite [in X in _ == X]addrC -subr_eq0 !addrA !opprD !addrA addrK. rewrite scalerN opprK -addrA addrCA !addrA (addrC _ 1) subrr add0r. rewrite -mulr2n scalerMnl scaler_eq0 mulrn_eq0 /=. -rewrite -spin0 spin_inj -norm_eq0 norm_normalize ?vaxis_euler_neq0 // oner_eq0 orbF. +rewrite -spin0 spin_inj -enorm_eq0 norm_normalize ?vaxis_euler_neq0 // oner_eq0 orbF. move=> /eqP Hs. have := sin0cos1 Hs; case: (ler0P (cos a)) => _ Hc; move: Ma; last first. by rewrite emx30M' // => ->; rewrite angle1; left. @@ -1177,7 +1178,7 @@ rewrite subrr add0r -(mulr_natr (cos a)) -mulrA divrr ?unitfE ?pnatr_eq0 // mulr split => Ha; by [rewrite cosK | rewrite cosKN]. Qed. -Lemma angle_eskew a u : norm u = 1 -> 0 <= a <= pi -> angle `e^(a, u) = a. +Lemma angle_eskew a u : `|u|_e = 1 -> 0 <= a <= pi -> angle `e^(a, u) = a. Proof. move=> u1 Ha. rewrite /angle trace_eskew // addrAC subrr add0r. @@ -1322,7 +1323,7 @@ by rewrite ?(acos_ge0, acos_lepi) // tr_interval. Qed. Lemma vaxis_eskew a (w : vector) : - sin a != 0 -> 0 <= a <= pi -> norm w = 1 -> vaxis `e^(a, w) = w. + sin a != 0 -> 0 <= a <= pi -> `|w|_e = 1 -> vaxis `e^(a, w) = w. Proof. move=> sphi Ha w1; rewrite /vaxis angle_eskew //. case: eqP => [aE|/eqP aD]; first by move: (sphi); rewrite aE sinpi eqxx. @@ -1359,7 +1360,7 @@ Let vector := 'rV[T]_3. Definition log_rot (M : 'M[T]_3) : T * 'rV[T]_3 := (Aa.angle M, Aa.vaxis M). Lemma log_exp_eskew (a : T) (w : 'rV[T]_3) : - sin a != 0 -> 0 <= a <= pi -> norm w = 1 -> log_rot `e^(a, w) = (a, w). + sin a != 0 -> 0 <= a <= pi -> `|w|_e = 1 -> log_rot `e^(a, w) = (a, w). Proof. move=> ? ? ?; congr pair; by [rewrite Aa.angle_eskew | rewrite Aa.vaxis_eskew]. Qed. @@ -1381,7 +1382,7 @@ case/boolP : (Aa.angle M == 0) => [/eqP H|a0]. case/boolP : (Aa.angle M == pi) => [/eqP H|api]. rewrite H eskew_pi ?norm_normalize // /Aa.vaxis H eqxx ?vaxis_euler_neq0 //. exact: Aa.SO_pi_reflection. -(* +(* have sina0 : sin (Aa.angle M) != 0. apply: contra a0 => /eqP/sin0_inv [->//|/eqP]; by rewrite (negbTE api). *) @@ -1389,9 +1390,9 @@ set w : 'rV_3 := normalize _. have [a /andP[a_gtNpi a_lepi] Rota] := SO_isRot MSO. have {}Rota : isRot a (normalize (vaxis_euler M)) (mx_lin1 M). rewrite (isRotZ a _ (vaxis_euler_neq0 MSO)) //. - by rewrite invr_gt0 norm_gt0 vaxis_euler_neq0. + by rewrite invr_gt0 enorm_gt0 vaxis_euler_neq0. have w0 : normalize (vaxis_euler M) != 0 by rewrite normalize_eq0 vaxis_euler_neq0. -have w1 : norm w = 1 by rewrite norm_normalize // Aa.vaxis_neq0. +have w1 : `|w|_e = 1 by rewrite norm_normalize // Aa.vaxis_neq0. case: (leP 0 a) => Ha. - have aB1 : 0 <= a <= pi by rewrite Ha a_lepi. move: (Aa.isRot_angle w0 aB1 Rota) => a_angle_of_rot. @@ -1405,8 +1406,8 @@ case: (leP 0 a) => Ha. have k0 : 0 < k. rewrite /k invr_gt0 pmulrn_lgt0 // lt_neqAle eq_sym sina0 /=. by apply: sin_ge0_pi. - have Hn : normalize (vaxis_euler M) = - ((sin a *+ 2) * k) *: (norm (Aa.vaxis M) *: w). + have Hn : normalize (vaxis_euler M) = + ((sin a *+ 2) * k) *: (`|Aa.vaxis M|_e *: w). rewrite -(norm_scale_normalize (normalize (vaxis_euler M))). rewrite norm_normalize ?vaxis_euler_neq0 // w'axial. rewrite scale1r {2}/k divff ?mulrn_eq0 // scale1r. @@ -1415,8 +1416,8 @@ case: (leP 0 a) => Ha. rewrite pmulr_rgt0 // pmulrn_lgt0 // lt_neqAle eq_sym sina0. by rewrite sin_ge0_pi. rewrite -a_angle_of_rot isRot_eskew //. - rewrite normalizeZ ?normalizeI // -?norm_eq0 ?w1 ?oner_neq0 //. - by rewrite norm_gt0 ?Aa.vaxis_neq0. + rewrite normalizeZ ?normalizeI // -?enorm_eq0 ?w1 ?oner_neq0 //. + by rewrite enorm_gt0 ?Aa.vaxis_neq0. have aB1 : - pi <= a <= 0 by rewrite (ltW a_gtNpi) ltW. move: (Aa.isRot_angleN w0 aB1 Rota) => a_angle_of_rot. have : M \in unitmx by rewrite orthogonal_unit // rotation_sub // -rotationV. @@ -1434,7 +1435,7 @@ have sa_gt0 : 0 < sin (Aa.angle M). by rewrite -oppr_gt0 -sinN sin_gt0_pi // oppr_cp0 Ha ltrNl. have se_neq0 : sin (Aa.angle M) != 0 by case: ltgtP sa_gt0. have k0 : 0 < k by rewrite /k invr_gt0 pmulrn_lgt0. -apply: (@same_isRot _ _ _ _ (- norm (Aa.vaxis M) *: w) ((sin (Aa.angle M) *+ 2) * k) w0 _ (- Aa.angle M)). +apply: (@same_isRot _ _ _ _ (- `|Aa.vaxis M|_e *: w) ((sin (Aa.angle M) *+ 2) * k) w0 _ (- Aa.angle M)). - by rewrite pmulr_rgt0 // pmulrn_lgt0. - rewrite -(norm_scale_normalize (normalize (vaxis_euler M))) //. rewrite norm_normalize ?vaxis_euler_neq0 // w'axial //. @@ -1443,8 +1444,8 @@ apply: (@same_isRot _ _ _ _ (- norm (Aa.vaxis M) *: w) ((sin (Aa.angle M) *+ 2) by rewrite tr_axial scalerN. - by rewrite -a_angle_of_rot //. rewrite isRotZN; first by rewrite opprK isRot_eskew // normalizeI. - by rewrite -norm_eq0 w1 oner_neq0. -by rewrite oppr_lt0 norm_gt0 // Aa.vaxis_neq0. + by rewrite -enorm_eq0 w1 oner_neq0. +by rewrite oppr_lt0 enorm_gt0 // Aa.vaxis_neq0. Qed. Lemma angle_axis_isRot (Q : 'M[T]_3) : axial Q != 0 -> @@ -1471,7 +1472,7 @@ rewrite {3}H isRotZ; last 2 first. rewrite invr_eq0 mulrn_eq0 /=. suff : 0 < sin (Aa.angle Q) by case: ltgtP. by apply: sin_gt0_pi. - by rewrite invr_gt0 norm_gt0. + by rewrite invr_gt0 enorm_gt0. exact: isRot_eskew_normalize. Qed. @@ -1484,7 +1485,7 @@ Let vector := 'rV[T]_3. Record angle_axis := AngleAxis { angle_axis_val : T * vector ; - _ : norm (angle_axis_val.2) == 1 }. + _ : `|angle_axis_val.2|_e == 1 }. HB.instance Definition _ := [isSub for angle_axis_val]. (*Canonical angle_axis_subType := [subType for angle_axis_val].*) @@ -1492,20 +1493,20 @@ HB.instance Definition _ := [isSub for angle_axis_val]. Definition aangle (a : angle_axis) := (val a).1. Definition aaxis (a : angle_axis) := (val a).2. -Lemma norm_axis a : norm (aaxis a) = 1. +Lemma enorm_axis a : `|aaxis a|_e = 1. Proof. by case: a => *; apply/eqP. Qed. -Fact norm_e1_subproof : norm (@delta_mx T _ 3 0 0) == 1. -Proof. by rewrite norm_delta_mx. Qed. +Fact enorm_e1_subproof : `|@delta_mx T _ 3 0 0|_e == 1. +Proof. by rewrite enorm_delta_mx. Qed. Definition angle_axis_of (a : T) (v : vector) := - insubd (@AngleAxis (a,_) norm_e1_subproof) (a, normalize v). + insubd (@AngleAxis (a,_) enorm_e1_subproof) (a, normalize v). Lemma aaxis_of (a : T) (v : vector) : v != 0 -> aaxis (angle_axis_of a v) = normalize v. Proof. move=> v_neq0 /=; rewrite /angle_axis_of /aaxis val_insubd /=. -by rewrite normZ normfV normr_norm mulVf ?norm_eq0 // eqxx. +by rewrite enormZ normfV normr_enorm mulVf ?enorm_eq0// eqxx. Qed. Lemma aangle_of (a : T) (v : vector) : aangle (angle_axis_of a v) = a. @@ -1537,35 +1538,35 @@ Hypothesis MO : M \is 'O[T]_3. Lemma sqr_Mi0E i : M i 1 ^+ 2 + M i 2%:R ^+ 2 = 1 - M i 0 ^+ 2. Proof. -move/norm_row_of_O : MO => /(_ i)/(congr1 (fun x => x ^+ 2)). +move/enorm_row_of_O : MO => /(_ i)/(congr1 (fun x => x ^+ 2)). rewrite -dotmulvv dotmulE sum3E !mxE -!expr2 expr1n => /eqP. by rewrite -addrA addrC eq_sym -subr_eq => /eqP <-. Qed. Lemma sqr_Mi1E i : M i 0 ^+ 2 + M i 2%:R ^+ 2 = 1 - M i 1 ^+ 2. Proof. -move/norm_row_of_O : MO => /(_ i)/(congr1 (fun x => x ^+ 2)). +move/enorm_row_of_O : MO => /(_ i)/(congr1 (fun x => x ^+ 2)). rewrite -dotmulvv dotmulE sum3E !mxE -!expr2 expr1n => /eqP. by rewrite addrAC eq_sym -subr_eq => /eqP <-. Qed. Lemma sqr_Mi2E i : M i 0 ^+ 2 + M i 1 ^+ 2 = 1 - M i 2%:R ^+ 2. Proof. -move/norm_row_of_O : MO => /(_ i)/(congr1 (fun x => x ^+ 2)). +move/enorm_row_of_O : MO => /(_ i)/(congr1 (fun x => x ^+ 2)). rewrite -dotmulvv dotmulE sum3E !mxE -!expr2 expr1n => /eqP. by rewrite eq_sym -subr_eq => /eqP <-. Qed. Lemma sqr_M2jE j : M 0 j ^+ 2 + M 1 j ^+ 2 = 1 - M 2%:R j ^+ 2. Proof. -move/norm_col_of_O : MO => /(_ j)/(congr1 (fun x => x ^+ 2)). +move/enorm_col_of_O : MO => /(_ j)/(congr1 (fun x => x ^+ 2)). rewrite -dotmulvv dotmulE sum3E !mxE -!expr2 expr1n => /eqP. by rewrite eq_sym -subr_eq => /eqP <-. Qed. Lemma sqr_M0jE j : M 1 j ^+ 2 + M 2%:R j ^+ 2 = 1 - M 0 j ^+ 2. Proof. -move/norm_col_of_O : MO => /(_ j)/(congr1 (fun x => x ^+ 2)). +move/enorm_col_of_O : MO => /(_ j)/(congr1 (fun x => x ^+ 2)). rewrite -dotmulvv dotmulE sum3E !mxE -!expr2 expr1n => /eqP. by rewrite -addrA addrC eq_sym -subr_eq => /eqP <-. Qed. @@ -1618,7 +1619,7 @@ Local Open Scope frame_scope. (* two orthogonal vectors belonging to the plan (y,z) projected on y and z *) Lemma exists_rotation_angle (F : frame T) (u v : 'rV[T]_3) : - norm u = 1 -> norm v = 1 -> u *d v = 0 -> u *v v = F|,0 -> + `|u|_e = 1 -> `|v|_e = 1 -> u *d v = 0 -> u *v v = F|,0 -> { w : T | [/\ - pi < w <= pi, u = cos w *: (F|,1) + sin w *: (F|,2%:R) & v = - sin w *: (F|,1) + cos w *: (F|,2%:R)] }. @@ -1643,7 +1644,7 @@ case/boolP : (u *d F|,2%:R == 0) => [/eqP|] u2. rewrite (orthogonal_expansion F u) (orthogonal_expansion F v). rewrite u2 u0 v0 v1 !(scale0r,addr0,add0r). have [/eqP u1 | /eqP u1] : {u *d F |, 1 == 1} + {u *d F|,1 == -1}. - move: normu => /(congr1 (fun x => x ^+ 2)); rewrite (sqr_norm_frame F u). + move: normu => /(congr1 (fun x => x ^+ 2)); rewrite (sqr_enorm_frame F u). rewrite sum3E u0 u2 expr0n add0r addr0 expr1n => /eqP. by rewrite sqrf_eq1 => /Bool.orb_true_elim. - have v2 : v *d F|,2%:R = 1. @@ -1652,7 +1653,7 @@ case/boolP : (u *d F|,2%:R == 0) => [/eqP|] u2. rewrite {1}(orthogonal_expansion F v) v0 v1 !(scale0r,add0r). rewrite (linearZr_LR _ F|,1)/=. rewrite (frame_jcrossk F) => /scaler_eq1; apply. - by rewrite -norm_eq0 noframe_norm oner_eq0. + by rewrite -enorm_eq0 noframe_norm oner_eq0. rewrite v2 u1 !scale1r; by left. - have v2 : v *d F|,2%:R = -1. move: uva0. @@ -1661,7 +1662,7 @@ case/boolP : (u *d F|,2%:R == 0) => [/eqP|] u2. rewrite (linearNl _ _ F|,1)/=. rewrite (linearZr_LR _ _ (v *d F|,2))/=. rewrite (frame_jcrossk F) -scaleNr => /scaler_eqN1; apply. - by rewrite -norm_eq0 noframe_norm oner_eq0. + by rewrite -enorm_eq0 noframe_norm oner_eq0. rewrite v2 u1 !scaleN1r; by right. have pi2B : - pi < (pi : T) / 2%:R <= pi. rewrite lter_pdivlMr ?ltr0n // ler_pdivrMr ?ltr0n //. @@ -1674,7 +1675,7 @@ have piN2B : - pi < - ((pi : T) / 2%:R) <= pi. case/boolP : (u *d F|,1 == 0) => [/eqP|] u1. have {u2}[/eqP u2|/eqP u2] : {u *d F|,2%:R == 1} + {u *d F|,2%:R == -1}. move: normu => /(congr1 (fun x => x ^+ 2)). - rewrite (sqr_norm_frame F u) sum3E u0 u1 expr0n !add0r expr1n => /eqP. + rewrite (sqr_enorm_frame F u) sum3E u0 u1 expr0n !add0r expr1n => /eqP. by rewrite sqrf_eq1 => /Bool.orb_true_elim. + have v1 : v *d F|,1%:R = -1. move: uva0. @@ -1683,10 +1684,10 @@ case/boolP : (u *d F|,1 == 0) => [/eqP|] u1. rewrite (linearDr _ F|,2)/=. rewrite (linearZr_LR _ _ (v *d F|,1)) /= (@lieC _ (vec3 T)) /= (frame_jcrossk F). rewrite (linearZr_LR _ _ (v *d F|,2)) /= (@liexx _ (vec3 T)) scaler0 addr0 scalerN -scaleNr => /scaler_eqN1; apply. - by rewrite -norm_eq0 noframe_norm oner_eq0. + by rewrite -enorm_eq0 noframe_norm oner_eq0. have v2 : v *d F|,2%:R = 0. move: normv => /(congr1 (fun x => x ^+ 2)). - rewrite expr1n (sqr_norm_frame F) sum3E v1 v0 expr0n add0r sqrrN expr1n => /eqP. + rewrite expr1n (sqr_enorm_frame F) sum3E v1 v0 expr0n add0r sqrrN expr1n => /eqP. by rewrite eq_sym addrC -subr_eq subrr eq_sym sqrf_eq0 => /eqP. exists (pi / 2%:R). rewrite cos_pihalf sin_pihalf !(scale0r,add0r,scale1r,scaleN1r,addr0). @@ -1702,10 +1703,10 @@ case/boolP : (u *d F|,1 == 0) => [/eqP|] u1. rewrite (linearZr_LR _ _ (v *d F|,2))/=. rewrite /= (@liexx _ (vec3 T)) scaler0 subr0. rewrite -scalerN (@lieC _ (vec3 T)) /= opprK (frame_jcrossk F) => /scaler_eq1; apply. - by rewrite -norm_eq0 noframe_norm oner_eq0. + by rewrite -enorm_eq0 noframe_norm oner_eq0. have v2 : v *d F|,2%:R = 0. move: normv => /(congr1 (fun x => x ^+ 2)). - rewrite expr1n (sqr_norm_frame F) sum3E v1 v0 expr0n add0r expr1n => /eqP. + rewrite expr1n (sqr_enorm_frame F) sum3E v1 v0 expr0n add0r expr1n => /eqP. by rewrite eq_sym addrC -subr_eq subrr eq_sym sqrf_eq0 => /eqP. exists (- (pi / 2%:R)). rewrite cosN sinN cos_pihalf sin_pihalf ?(scale0r,add0r,scale1r,scaleN1r,addr0,opprK). @@ -1720,10 +1721,10 @@ have f2D0 : F|,2%:R != 0 by apply: contra u2 => /eqP->; rewrite dotmulv0. have [w [wB Hw1 Hw2]] : {w : T | [/\ - pi < w <= pi, u *d F|,1 = cos w & (u *d F|,2%:R) = sin w]}. apply: sqrD1_cossin. - move/(congr1 (fun x => norm x)) : Hr2. + move/(congr1 (fun x => `|x|_e)) : Hr2. rewrite normu. move/(congr1 (fun x => x ^+ 2)). - rewrite expr1n normD !normZ ?noframe_norm !mulr1. + rewrite expr1n enormD !enormZ ?noframe_norm !mulr1. rewrite (_ : cos _ = 0); last first. case: (lerP 0 (u *d F|,2%:R)). rewrite le_eqVlt eq_sym (negbTE u2) /= => {}u2. @@ -1777,16 +1778,16 @@ have <- : v *d F|,1 = - sin w. rewrite -Hw2 2!dotmul_cos normu 2!noframe_norm mul1r normv mulr1. rewrite [in LHS]mul1r [in RHS]mul1r ?opprK H'. rewrite [in RHS]cos_vec_anglevN ?opprK; [by [] | | ]. - by rewrite -norm_eq0 normv oner_neq0. - by rewrite -norm_eq0 noframe_norm oner_neq0. + by rewrite -enorm_eq0 normv oner_neq0. + by rewrite -enorm_eq0 noframe_norm oner_neq0. have <- : v *d F|,2%:R = cos w. by rewrite -Hw1 2!dotmul_cos normu 2!noframe_norm mul1r normv mulr1 H. by []. Qed. Lemma euler_angles_zyx_RO (a1 a2 u v : 'rV[T]_3) w1 k k' : - norm u = 1 -> norm v = 1 -> u *d v = 0 -> - norm a1 = 1 -> norm a2 = 1 -> a1 *d a2 = 0 -> + `|u|_e = 1 -> `|v|_e = 1 -> u *d v = 0 -> + `|a1|_e = 1 -> `|a2|_e = 1 -> a1 *d a2 = 0 -> u = k *: a1 + k' *: a2 -> v = - k' *: a1 + k *: a2 -> cos w1 = a1 *d u -> @@ -1870,8 +1871,8 @@ transitivity (row_mx (col 0 R) (row_mx a2 a3) *m Rx w1). r2^T = cos w *: (a |, 1) + sin w *: (a |, 2%:R) & r3^T = - sin w *: (a |, 1) + cos w *: (a |, 2%:R)] }. apply: exists_rotation_angle. - by rewrite tr_col norm_row_of_O // rotation_sub // rotationV. - by rewrite tr_col norm_row_of_O // rotation_sub // rotationV. + by rewrite tr_col enorm_row_of_O// rotation_sub// rotationV. + by rewrite tr_col enorm_row_of_O// rotation_sub// rotationV. rewrite 2!tr_col. by move: RSO; rewrite -rotationV => /rotation_sub/orthogonalP ->. rewrite frame_of_SO_i -tr_col -/a1 Ha1 !tr_col. @@ -1894,8 +1895,8 @@ transitivity (row_mx (col 0 R) (row_mx a2 a3) *m Rx w1). by move: RSO; rewrite -rotationV => /rotation_sub/orthogonal3P/and6P[_ /eqP]. by move: RSO; rewrite -rotationV => /rotation_sub/orthogonal3P/and6P[_ _ /eqP]. move: RSO; by rewrite -rotationV => /rotation_sub/orthogonal3P/and6P[_ _ _ _ _ /eqP]. - by rewrite tr_col norm_row_of_O // rotation_sub // rotationV Rzy_is_SO. - by rewrite tr_col norm_row_of_O // rotation_sub // rotationV Rzy_is_SO. + by rewrite tr_col enorm_row_of_O// rotation_sub// rotationV Rzy_is_SO. + by rewrite tr_col enorm_row_of_O// rotation_sub// rotationV Rzy_is_SO. move: (Rzy_is_SO w3 w2). rewrite -rotationV => /rotation_sub/orthogonal3P/and6P[_ _ _ _ _ /eqP]. by rewrite !tr_col. @@ -1904,14 +1905,14 @@ transitivity (row_mx (col 0 R) (row_mx a2 a3) *m Rx w1). by rewrite -Ha1 row_mx_colE. Qed. -Lemma Rz_rotation_exists (u : 'rV[T]_3) : norm u = 1 -> +Lemma Rz_rotation_exists (u : 'rV[T]_3) : `|u|_e = 1 -> u != 'e_2%:R -> u != - 'e_2%:R -> let n : 'rV_3 := normalize ('e_2%:R *v u) in {phi | isRot phi 'e_2%:R (mx_lin1 (Rz phi)) & 'e_0 *m Rz phi = n}. Proof. move=> u1 H1 H2 n. exists (if 0 <= u``_0 then vec_angle n 'e_0 else - vec_angle n 'e_0). - by rewrite Rz_eskew isRot_eskew // ?normalizeI // ?norm_delta_mx. + by rewrite Rz_eskew isRot_eskew ?normalizeI ?enorm_delta_mx. rewrite {1}e0row /Rz mulmx_row3_col3 ?(scale0r,scale1r,addr0). rewrite [in RHS]/n crossmulE. rewrite (_ : 'e_2%:R 0 1 = 0) ?(mul0r,add0r); last by rewrite mxE. @@ -1919,9 +1920,9 @@ rewrite (_ : 'e_2%:R 0 0 = 0) ?(mul0r,subrr,subr0); last by rewrite mxE. rewrite (_ : 'e_2%:R 0 2%:R = 1) ?mul1r; last by rewrite mxE. have ? : 'e_2%:R *v u != 0. apply/colinearP; case. - by rewrite -norm_eq0 u1 // oner_eq0. + by rewrite -enorm_eq0 u1 // oner_eq0. case=> _ [k Hk]; have k1 : `|k| = 1. - move: Hk => /(congr1 (@norm _ _)); rewrite normZ u1 mulr1 norm_delta_mx. + move: Hk => /(congr1 (@enorm _ _)); rewrite enormZ u1 mulr1 enorm_delta_mx. by move->. case: (lerP k 0) => k0; move: k1 Hk. rewrite ler0_norm // -{2}(opprK k) => ->; rewrite scaleN1r. @@ -1929,13 +1930,13 @@ have ? : 'e_2%:R *v u != 0. by rewrite gtr0_norm // => ->; rewrite scale1r => /esym; apply/eqP. rewrite /normalize row3Z mulr0; congr row3. - transitivity (n *d 'e_0). - rewrite dotmul_cos norm_normalize ?mul1r ?norm_delta_mx ?mul1r //. + rewrite dotmul_cos norm_normalize ?mul1r ?enorm_delta_mx ?mul1r //. case: ifP => //; by rewrite cosN. by rewrite -coorE /n crossmulE /normalize row3Z !mxE /= ?(mulr0,mul0r,add0r,mul1r,subr0,oppr0). -- transitivity (if 0 <= u``_0 then norm (n *v 'e_0) else - norm (n *v 'e_0)). - rewrite norm_crossmul norm_normalize ?mul1r // norm_delta_mx mul1r. - rewrite ger0_norm // ?sin_vec_angle_ge0 // -?norm_eq0 ?norm_normalize ?oner_neq0 // - ?norm_delta_mx ?oner_neq0 //. +- transitivity (if 0 <= u``_0 then `|n *v 'e_0|_e else - `|n *v 'e_0|_e). + rewrite enorm_crossmul norm_normalize ?mul1r // enorm_delta_mx mul1r. + rewrite ger0_norm // ?sin_vec_angle_ge0 // -?enorm_eq0 ?norm_normalize ?oner_neq0 // + ?enorm_delta_mx ?oner_neq0 //. case: ifPn => //; by rewrite sinN. rewrite /n /normalize crossmulE. rewrite (_ : 'e_0%:R 0 2%:R = 0) ?(mulr0,subr0,add0r); last by rewrite mxE. @@ -1946,12 +1947,12 @@ rewrite /normalize row3Z mulr0; congr row3. rewrite (_ : 'e_2%:R 0 0 = 0) ?(mul0r,subrr,subr0); last by rewrite mxE. rewrite (_ : 'e_2%:R 0 2%:R = 1) ?(mul1r); last by rewrite mxE. rewrite !mxE mulr0 /=. - rewrite -{2 3 5 6}(oppr0) -row3N normN. + rewrite -{2 3 5 6}(oppr0) -row3N enormN. rewrite [in LHS]mulrC -{2 3 5 6}(mulr0 (u``_0)) -row3Z. - rewrite normZ mulrC norm_row3z ger0_norm ?invr_ge0 ?norm_ge0 //. + rewrite enormZ mulrC enorm_row3z ger0_norm ?invr_ge0 ?enorm_ge0//. case: ifPn => R20. - by rewrite ger0_norm. - - by rewrite ltr0_norm ?ltNge // mulrN opprK. + - by rewrite ltr0_norm ?ltNge// mulrN opprK. Qed. End euler_angles_existence. diff --git a/scara.v b/scara.v index 26db53e6..ef544782 100644 --- a/scara.v +++ b/scara.v @@ -1,5 +1,5 @@ -(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) -From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) +From mathcomp Require Import all_boot ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. From mathcomp Require Import realalg complex fingroup perm. From mathcomp Require Import sesquilinear. @@ -120,7 +120,7 @@ rewrite /t1 /rjoint_twist. rewrite (linearNl _ q1)/=. rewrite (linear0r _ w1)/=. rewrite oppr0 etwist_Rz; last first. - by rewrite -norm_eq0 normeE oner_eq0. + by rewrite -enorm_eq0 enormeE oner_eq0. by rewrite -Rz_eskew. Qed. @@ -128,11 +128,11 @@ Qed. Lemma point_axis_twist (d : R) : \pt( axis \T((- 'e_2%:R *v row3 d 0 0), 'e_2%:R) ) = row3 d 0 0. Proof. -rewrite {1}/axis ang_tcoorE (negbTE (norm1_neq0 (normeE _ _))) /=. -rewrite normeE expr1n invr1 scale1r lin_tcoorE. +rewrite {1}/axis ang_tcoorE (negbTE (norm1_neq0 (enormeE _ _))) /=. +rewrite enormeE expr1n invr1 scale1r lin_tcoorE. rewrite (linearNl _ ((row3 d)``_0))/=. rewrite (linearNr _ ('e_2))/=. -rewrite double_crossmul dotmulvv normeE expr1n scale1r /w2 /q2 e2row. +rewrite double_crossmul dotmulvv enormeE expr1n scale1r /w2 /q2 e2row. rewrite dotmulE sum3E !mxE /=. by Simp.r. Qed. @@ -140,8 +140,8 @@ Lemma S2_helper th d : `e$(th, \T(- w2 *v row3 d 0 0, w2)) = hom (Rz th) (row3 (d * (1 - cos th)) (- d * sin th) 0). Proof. -rewrite etwistE (negbTE (norm1_neq0 (normeE _ _))). -rewrite pitch_perp ?normeE // mulr0 scale0r add0r. +rewrite etwistE (negbTE (norm1_neq0 (enormeE _ _))). +rewrite pitch_perp ?enormeE// mulr0 scale0r add0r. rewrite point_axis_twist -Rz_eskew; congr hom. rewrite mulmxBr mulmx1 mulmx_row3_col3 !scale0r !addr0 row3Z row3N row3D. Simp.r. diff --git a/screw.v b/screw.v index 3354f68b..a0cdfd39 100644 --- a/screw.v +++ b/screw.v @@ -1,4 +1,4 @@ -(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. From mathcomp Require Import all_boot order ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. @@ -56,7 +56,7 @@ Local Open Scope ring_scope. (* TODO: move? *) Lemma mulmx_tr_uvect (T : rcfType) (w : 'rV[T]_3) : - norm w = 1 -> (w^T *m w) ^+ 2 = w^T *m w. + `|w|_e = 1 -> (w^T *m w) ^+ 2 = w^T *m w. Proof. move=> w1; rewrite expr2 -mulmxE -mulmxA (mulmxA w) dotmulP dotmulvv w1 expr1n. by rewrite mul1mx. @@ -625,7 +625,7 @@ rewrite /wedge Twist.ang_of Twist.lin_of spin0. by rewrite -idmxE (@scalar_mx_block _ 3 1 1) (add_block_mx 1 0 0 1 0 _ v) !(addr0,add0r). Qed. -Lemma p41eq234 w v : norm w = 1 -> +Lemma p41eq234 w v : `|w|_e = 1 -> let g := rigid_trans w v in let h := w *d v in g^-1 *m wedge \T(v, w) *m g = wedge \T(h *: w, w). @@ -653,7 +653,7 @@ rewrite !mulrA divrr ?rigid_trans_unit // mul1r -mulrA. by rewrite divrr ?mulr1 // rigid_trans_unit. Qed. -Lemma p42eq2 w v : norm w = 1 -> +Lemma p42eq2 w v : `|w|_e = 1 -> let g := rigid_trans w v in let e' := g^-1 *m wedge \T(v, w) *m g in forall k, e' ^+ k.+2 = block_mx (\S( w ) ^+ k.+2) 0 0 0. @@ -673,7 +673,7 @@ rewrite exprS mulmxA spinE. by rewrite (linearZr_LR _ w)/= (@liexx _ (vec3 T)) scaler0 mul0mx. Qed. -Lemma emx2_twist w v a : norm w = 1 -> +Lemma emx2_twist w v a : `|w|_e = 1 -> let g := rigid_trans w v in let h := w *d v in emx (a *: wedge \T(v, w) ) 2 = g *m hom (emx (a *: \S( w)) 2) (h *: (a *: w)) *m g^-1. @@ -696,7 +696,7 @@ rewrite (linearZl_LR _ (v *v w))/= -scalerDr; congr (_ *: _). by rewrite double_crossmul dotmulvv w1 expr1n scale1r -/h addrCA subrr addr0. Qed. -Lemma p42eq3 w v a : norm w = 1 -> +Lemma p42eq3 w v a : `|w|_e = 1 -> let g := rigid_trans w v in let h := w *d v in let e' := g^-1 *m wedge \T(v, w) *m g in @@ -720,7 +720,7 @@ Definition hom_twist (t : twist T) (a : T) e : 'M[T]_4 := if w == 0 then hom 1 (a *: v) else - hom e ((norm w)^-2 *: ((w *v v) *m (1 - e) + (a *: v) *m (w^T *m w))). + hom e ((`|w|_e) ^- 2 *: ((w *v v) *m (1 - e) + (a *: v) *m (w^T *m w))). (* [murray] eqn 2.36, p.42 *) Definition emx_twist a t k : 'M_4 := @@ -738,9 +738,9 @@ case/boolP : (w == 0) => [/eqP ->|w0]. rewrite tcoorZ /= scaler0 emx_twist0E. by rewrite /emx_twist /hom_twist ang_tcoorE eqxx lin_tcoorE. set w' : 'rV_3 := a *: w. -rewrite -(norm_scale_normalize w) (_ : v = (norm w) *: ((norm w)^-1 *: v)); last first. - by rewrite scalerA divrr ?scale1r // unitfE norm_eq0. -rewrite -(tcoorZ (norm w) ((norm w)^-1 *: v) (normalize w)). +rewrite -(norm_scale_normalize w) (_ : v = `|w|_e *: ((`|w|_e)^-1 *: v)); last first. + by rewrite scalerA divrr ?scale1r // unitfE enorm_eq0. +rewrite -(tcoorZ `|w|_e ((`|w|_e)^-1 *: v) (normalize w)). rewrite scalerA p42eq235 p42eq3; last by rewrite norm_normalize. rewrite -mulmxE. rewrite {1}/rigid_trans mulmxE homM mul1r. @@ -762,19 +762,19 @@ rewrite (linearZl_LR _ w) /=. rewrite [in X in _ + _ + X = _]scalerN. rewrite [in X in _ + _ + X]scalerA. rewrite -[in LHS]scalemxAl -scalerDr -scalerBr; congr (_ *: _). - by rewrite -invrM ?unitfE ?norm_eq0. + by rewrite -invrM ?unitfE ?enorm_eq0. rewrite -/w' /= [in X in _ = X + _]mulmxBr mulmx1. rewrite -[in RHS]addrA [in RHS]addrC; congr (_ + _ + _). - rewrite lin_tcoorE (@lieC _ (vec3 T)) mulNmx. - by rewrite scalerA divrr ?scale1r // ?unitfE ?norm_eq0. + by rewrite scalerA divrr ?scale1r ?unitfE ?enorm_eq0. - rewrite lin_tcoorE. - rewrite (scalerA (norm w)) divrr ?scale1r ?unitfE ?norm_eq0 //. + rewrite (scalerA `|w|_e) divrr ?scale1r ?unitfE ?enorm_eq0//. rewrite -scalemxAl. rewrite mulmxA. rewrite dotmulP mul_scalar_mx dotmulC. by rewrite scalerA mulrC -scalerA. - rewrite (@lieC _ (vec3 T)) opprK; congr (_ *v _). - by rewrite lin_tcoorE scalerA divrr ?scale1r ?lin_of_twistE // unitfE norm_eq0. + by rewrite lin_tcoorE scalerA divrr ?scale1r ?lin_of_twistE // unitfE enorm_eq0. Qed. (* [murray] proposition 2.8, p. 41 *) @@ -805,16 +805,16 @@ Local Notation "'`e$(' a ',' t ')'" := (etwist a t) (format "'`e$(' a ',' t ')' Lemma etwistv0 (a : T) : `e$(a, \T(0, 0)) = hom 1 0. Proof. by rewrite /etwist ang_tcoorE /hom_twist ang_tcoorE eqxx lin_tcoorE scaler0. Qed. -Lemma etwist_is_SE (t : twist T) a : norm \w( t ) = 1 -> `e$(a, t) \is 'SE3[T]. +Lemma etwist_is_SE (t : twist T) a : `|\w( t )|_e = 1 -> `e$(a, t) \is 'SE3[T]. Proof. move=> w1. by rewrite /etwist /hom_twist (negbTE (norm1_neq0 w1)) hom_is_SE // eskew_is_SO. Qed. Definition etwist_is_onto_SE_mat (a : T) w := - (a * norm w ^+ 2)%:A - + ((1 - cos a) * norm w ^+2) *: \S(w) - + (a - sin a) *: \S(w)^+2. + (a * `|w|_e ^+ 2)%:A + + ((1 - cos a) * `|w|_e ^+ 2) *: \S(w) + + (a - sin a) *: \S(w) ^+ 2. (*******************STOP*****************************) Definition etwist_is_onto_SE_mat_inv (a : T) w := @@ -822,8 +822,8 @@ Definition etwist_is_onto_SE_mat_inv (a : T) w := - 2%:R^-1 *: \S(w) + (a^-1 - 2%:R^-1 * cot (a / 2%:R)) *: \S(w) ^+ 2. -Lemma etwist_is_onto_SE_matP a w - (aB : - pi < a <= pi) (a0 : a != 0) (w1 : norm w = 1) : +Lemma etwist_is_onto_SE_matP a w + (aB : - pi < a <= pi) (a0 : a != 0) (w1 : `|w|_e = 1) : etwist_is_onto_SE_mat_inv a w * etwist_is_onto_SE_mat a w = 1. Proof. rewrite /etwist_is_onto_SE_mat /etwist_is_onto_SE_mat_inv. @@ -903,11 +903,11 @@ Lemma etwist_is_onto_SE (f : 'M[T]_4) : f \is 'SE3[T] -> Proof. set p := trans_of_hom f. case/boolP: (rot_of_hom f == 1) => rotf fSE. -case/boolP : ((norm p) == 0) => p0. +case/boolP : (`|p|_e == 0) => p0. exists \T(p, 0), 1. rewrite /etwist /hom_twist ang_tcoorE eqxx lin_tcoorE. by rewrite scale1r (SE3E fSE) (eqP rotf). - exists \T((norm p)^-1 *: p, 0), (norm p). + exists \T((`|p|_e)^-1 *: p, 0), `|p|_e. rewrite /etwist /hom_twist ang_tcoorE eqxx /= lin_tcoorE. rewrite scalerA divff //. by rewrite scale1r (SE3E fSE) (eqP rotf). @@ -917,7 +917,7 @@ have a0 : a != 0. apply: contra rotf => /eqP. rewrite fexp_skew => ->; by rewrite emx30M. set A : 'M_3 := \S(w) *m (1 - rot_of_hom f) + a *: (w^T *m w). -suff [v Hv] : { v | p = (norm w)^-2 *: (v *m A) }. +suff [v Hv] : { v | p = (`|w|_e) ^- 2 *: (v *m A) }. exists \T(v, w), a. rewrite (SE3E fSE) /etwist /hom_twist ang_tcoorE. have /negbTE -> : w != 0 by rewrite normalize_eq0 vaxis_euler_neq0 // rot_of_hom_is_SO. @@ -944,9 +944,9 @@ have HA : A = etwist_is_onto_SE_mat a w. by rewrite scaleNr scalerN opprK scalerA. suff : { A' : 'M_3 | A' * A = 1 }. case => A' AA'. - exists ((norm w) ^+2 *: p *m A'). + exists ((`|w|_e) ^+ 2 *: p *m A'). rewrite -mulmxA mulmxE AA' mulmx1 scalerA. - rewrite mulrC divrr ?scale1r // unitfE expf_eq0 /= norm_eq0. + rewrite mulrC divrr ?scale1r // unitfE expf_eq0 /= enorm_eq0. apply: contra rotf; rewrite fexp_skew => /eqP ->. by rewrite spin0 emx3a0. (* NB: corresponds to [murray], exercise 9, p.75 *) @@ -991,11 +991,11 @@ Definition w : vector := 'e_2%:R. Let A_inv := etwist_is_onto_SE_mat_inv a w. -Definition v := ((norm w)^+2 *: P20) *m A_inv. +Definition v := ((`|w|_e) ^+ 2 *: P20) *m A_inv. Lemma vP : v = row3 ((a1 + a2) * sin a / (2%:R * (1 - cos a))) (- (a1 - a2) / 2%:R) 0 :> vector. Proof. -rewrite /v normeE expr1n scale1r /P20. +rewrite /v enormeE expr1n scale1r /P20. rewrite /A_inv /etwist_is_onto_SE_mat_inv. rewrite mulmxDr mulmxBr. rewrite mul_mx_scalar row3Z mulr0. @@ -1055,7 +1055,7 @@ Definition screw_motion s (p : point) : 'rV_3 := let p0 := \pt( l ) in let w := \vec( l ) in p0 + (p - p0) *m `e^(a, w) + (h * a) *: w. -Lemma screw_motionE s (p : point) (w1 : norm \vec( Screw.l s) = 1) : +Lemma screw_motionE s (p : point) (w1 : `| \vec( Screw.l s) |_e = 1) : let l := Screw.l s in let a := Screw.a s in let h := Screw.h s in let q := \pt( l ) in let w := \vec( l ) in screw_motion s p = EuclideanMotion.motion_point @@ -1116,7 +1116,7 @@ rewrite [in X in _ = _ *: (X + _)]mulmxBl. rewrite opprB -addrA. rewrite scalerDr. rewrite -[in X in _ = X + _]scalemxAl scalerA [in X in _ = X + _]mulrC divrr ?scale1r; last first. - by rewrite unitfE expf_eq0 /= norm_eq0. + by rewrite unitfE expf_eq0 /= enorm_eq0. congr (_ + _). rewrite -[in X in _ = _ *: (_ + X)]scalemxAl. rewrite mulmxDl. @@ -1127,7 +1127,7 @@ rewrite scalerDr. rewrite 2!scalerA. rewrite [in X in _ = X + _]mulrA. rewrite [in X in _ = X + _]mulrC. -rewrite -(mulrA (a * h)) divrr ?mulr1; last by rewrite unitfE expf_eq0 /= norm_eq0. +rewrite -(mulrA (a * h)) divrr ?mulr1; last by rewrite unitfE expf_eq0 /= enorm_eq0. rewrite mulrC -[LHS]addr0. congr (_ + _). rewrite mulmxBr mulmx1. @@ -1156,7 +1156,7 @@ Definition axis (t : twist T) : Line.t T := if w == 0 then Line.mk 0 v else - Line.mk ((norm w)^-2 *: (w *v v)) w. + Line.mk ((`|w|_e) ^- 2 *: (w *v v)) w. Lemma point_axis_nolin w : w != 0 -> \pt( axis \T(0, w) ) = 0. Proof. @@ -1167,7 +1167,7 @@ Qed. (* [murray] 2.42, p.47 *) Definition pitch (t : twist T) : T := let w := \w( t ) in let v := \v( t ) in - (norm w)^-2 *: v *d w. + (`|w|_e) ^- 2 *: v *d w. Lemma pitch_nolin (w : 'rV[T]_3) : pitch \T(0, w) = 0. Proof. by rewrite /pitch ang_tcoorE lin_tcoorE scaler0 dotmul0v. Qed. @@ -1176,7 +1176,7 @@ Definition rjoint_twist (w : vector) (q : point) := \T(- w *v q, w). Definition pjoint_twist (v : vector) := \T(v, 0). -Lemma pitch_perp (w u : 'rV[T]_3) : norm w = 1 -> pitch (rjoint_twist w u) = 0. +Lemma pitch_perp (w u : 'rV[T]_3) : `|w|_e = 1 -> pitch (rjoint_twist w u) = 0. Proof. move=> w1; rewrite /pitch ang_tcoorE lin_tcoorE w1 expr1n invr1 scale1r. rewrite (@lieC _ (vec3 T))/=. @@ -1186,34 +1186,34 @@ Qed. (* [murray] 2.44, p.48 *) Definition magnitude (t : twist T) : T := let w := \w( t ) in let v := \v( t ) in - if w == 0 then norm v else norm w. + if w == 0 then `|v|_e else `|w|_e. Lemma magnitudeZ (t : twist T) a : 0 < a -> magnitude ((a *: t) : 'M__) = a * magnitude t. Proof. move=> a_gt0. rewrite /magnitude. -case/boolP : (a == 0) => [/eqP ->|a0]. - by rewrite scale0r mul0r ang_tcoor0 eqxx lin_tcoor0 norm0. +have [->|a0] := eqVneq a 0. + by rewrite scale0r mul0r ang_tcoor0 eqxx lin_tcoor0 enorm0. rewrite ang_tcoorZ scaler_eq0 (negbTE a0) /=. case: ifPn => M0. - by rewrite lin_tcoorZ normZ gtr0_norm. -by rewrite normZ gtr0_norm. + by rewrite lin_tcoorZ enormZ gtr0_norm. +by rewrite enormZ gtr0_norm. Qed. (* unit twist: [murray] p.49 (p.48 also) *) Definition utwist (t : twist T) := (magnitude t == 1). Lemma utwistE (t : twist T) : utwist t = - (norm \w( t ) == 1) || ((norm \w( t ) == 0) && (norm \v( t ) == 1)). + (`| \w( t ) |_e == 1) || ((`| \w( t ) |_e == 0) && (`| \v( t ) |_e == 1)). Proof. apply/idP/idP. - rewrite /utwist /magnitude. - case: ifPn => [/eqP -> ->|w0 ->]; by rewrite norm_eq0 ?eqxx /= ?orbT. + case: ifPn => [/eqP -> ->|w0 ->]; by rewrite enorm_eq0 ?eqxx /= ?orbT. - case/orP => [w1|/andP[w0 v1]]. rewrite /utwist /magnitude; case: ifPn => [w0| //]. - by rewrite (eqP w0) norm0 eq_sym (negbTE (@oner_neq0 _)) in w1. - by rewrite /utwist /magnitude -{1}norm_eq0 w0. + by rewrite (eqP w0) enorm0 eq_sym (negbTE (@oner_neq0 _)) in w1. + by rewrite /utwist /magnitude -{1}enorm_eq0 w0. Qed. (* [murray] p. 48 @@ -1281,7 +1281,7 @@ congr hom. rewrite lin_tcoorE. rewrite -scalemxAl mulmxA dotmulP scalemxAl scalerDr -scalemxAl. rewrite (scalerA _ a) (mulrC _ a). -rewrite -(scalerA a (norm w ^+ 2)^-1). +rewrite -(scalerA a (`|w|_e ^+ 2)^-1). rewrite mul_scalar_mx (scalerA _ (v *d w) w) -(dotmulZv v _ w). rewrite (_ : _ *d _ = pitch \T(v, w)); last by rewrite /pitch lin_tcoorE ang_tcoorE. rewrite addrC. @@ -1322,7 +1322,7 @@ Let vaxis0 : Aa.vaxis Q != 0. Proof. by rewrite /Aa.vaxis (negbTE api) scaler_eq0 negb_or w0 andbT invr_eq0 mulrn_eq0. Qed. -Let w1 : norm w = 1. Proof. by rewrite norm_normalize. Qed. +Let w1 : `|w|_e = 1. Proof. by rewrite norm_normalize. Qed. (* [angeles] theorem 3.2.1, p.97: the displacements of all the points of the body have the same projection onto e *) @@ -1343,32 +1343,32 @@ Qed. Definition axialdisp p := axialcomp (displacement f p) w. -Lemma axialdispE p : axialdisp p = d0 *: ((norm w)^-2 *: w). +Lemma axialdispE p : axialdisp p = d0 *: ((`|w|_e) ^- 2 *: w). Proof. rewrite /axialdisp /axialcomp dotmulC dotmulvZ displacement_proj mulrC -scalerA. -by rewrite (scalerA (norm w)^-1) -expr2 exprVn. +by rewrite (scalerA (`|w|_e)^-1) -expr2 exprVn. Qed. Definition normdisp p := normalcomp (displacement f p) w. Lemma decomp_displacement p : - norm (displacement f p) ^+ 2 = norm (d0 *: (norm w ^- 2 *: w)) ^+2 + norm (normdisp p) ^+ 2. + `|displacement f p|_e ^+ 2 = `|d0 *: (`|w|_e ^- 2 *: w)|_e ^+2 + `|normdisp p|_e ^+ 2. Proof. -rewrite (axialnormalcomp (displacement f p) w) normD -dotmul_cos axialnormal // mul0rn addr0. +rewrite (axialnormalcomp (displacement f p) w) enormD -dotmul_cos axialnormal // mul0rn addr0. by rewrite -/(normdisp p) -/(axialdisp p) axialdispE. Qed. -Lemma MozziChasles_helper p : norm (displacement f p) = d0 -> normdisp p = 0. +Lemma MozziChasles_helper p : `|displacement f p|_e = d0 -> normdisp p = 0. Proof. move=> Hp. -have := lexx (norm (d0 *: w) ^+ 2). -rewrite {1}normZ w1 mulr1 sqr_normr -{1}Hp decomp_displacement -lerBDl. +have := lexx (`|d0 *: w|_e ^+ 2). +rewrite {1}enormZ w1 mulr1 sqr_normr -{1}Hp decomp_displacement -lerBDl. rewrite w1 expr1n invr1 scale1r. -by rewrite subrr le_eqVlt ltNge sqr_ge0 orbF sqrf_eq0 norm_eq0 => /eqP. +by rewrite subrr le_eqVlt ltNge sqr_ge0 orbF sqrf_eq0 enorm_eq0 => /eqP. Qed. (* [angeles] theorem 3.2.2, p.97 *) -Lemma MozziChasles p : norm (displacement f p) = d0 -> +Lemma MozziChasles p : `|displacement f p|_e = d0 -> colinear (displacement f p) w. Proof. move=> H. @@ -1445,8 +1445,8 @@ rewrite /Aa.vaxis. rewrite (negbTE api). by rewrite scaler_eq0 negb_or w0 andbT invr_eq0 mulrn_eq0. Qed. -Let w1 : norm w = 1. -Proof. rewrite norm_normalize //. Qed. +Let w1 : `|w|_e = 1. +Proof. by rewrite norm_normalize. Qed. Lemma wTwQN1 : (w^T *m w) *m (Q - 1)^T = 0. Proof. @@ -1582,7 +1582,7 @@ Qed. (* [angeles] Sect. 3.2.1 (the screw of a rigid-body motion) *) Lemma screw_axis_pointE p0 q : p0 *d w = 0 (* p0 is the closed point to the origin *) -> - norm (displacement f p0) = d0 f -> + `|displacement f p0|_e = d0 f -> p0 = screw_axis_point f q. Proof. move=> p0e0 fp0e0. diff --git a/skew.v b/skew.v index 35add614..affd9052 100644 --- a/skew.v +++ b/skew.v @@ -1,6 +1,6 @@ -(* coq-robot (c) 2025 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) From HB Require Import structures. -From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. +From mathcomp Require Import all_boot ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. From mathcomp Require Import sesquilinear. From mathcomp Require Import realalg complex finset fingroup perm ring. @@ -537,7 +537,7 @@ Let vector := 'rV[R]_3. Implicit Types u : vector. Implicit Types M : 'M[R]_3. -Lemma sqr_spin u : \S( u ) ^+ 2 = u^T *m u - (norm u ^+ 2)%:A. +Lemma sqr_spin u : \S( u ) ^+ 2 = u^T *m u - (`|u|_e ^+ 2)%:A. Proof. apply (symP (sqr_spin_is_sym u)); last move=> i j. rewrite rpredD//= ?mul_tr_vec_sym//. @@ -560,18 +560,18 @@ case/boolP : (i == 0) => [/eqP-> _|/ifnot0P/orP[]/eqP->]. by rewrite -eqr_opp 2!opprB opprK eq_sym subr_eq -dotmulvv dotmulE sum3E -!expr2. Qed. -Lemma spin3 u : \S( u ) ^+ 3 = - (norm u) ^+ 2 *: \S( u ). +Lemma spin3 u : \S( u ) ^+ 3 = - `|u|_e ^+ 2 *: \S( u ). Proof. rewrite exprS sqr_spin mulrBr -mulmxE mulmxA spin_mul_tr mul0mx add0r. by rewrite scalemx1 mul_mx_scalar scaleNr. Qed. -Lemma exp_spin u n : \S( u ) ^+ n.+3 = - (norm u) ^+ 2 *: \S( u ) ^+ n.+1. +Lemma exp_spin u n : \S( u ) ^+ n.+3 = - `|u|_e ^+ 2 *: \S( u ) ^+ n.+1. Proof. -elim: n => [|n IH]; by [rewrite expr1 spin3|rewrite exprS IH -scalerAr -exprS]. +by elim: n => [|n IH]; [rewrite expr1 spin3|rewrite exprS IH -scalerAr -exprS]. Qed. -Lemma mxtrace_sqr_spin u : \tr (\S( u ) ^+ 2) = - (2%:R * (norm u) ^+ 2). +Lemma mxtrace_sqr_spin u : \tr (\S( u ) ^+ 2) = - (2%:R * `|u|_e ^+ 2). Proof. rewrite sqr_spin linearD /= mxtrace_tr_mul linearN /= linearZ /=; apply/eqP. by rewrite !mxtrace_scalar subr_eq addrC mulrC -mulrBl -natrB // mul1r. @@ -596,18 +596,18 @@ case: i => [] [] // [] // i _ /=. by rewrite !mxE; Simp.ord. Qed. -Lemma char_poly_spin u : char_poly \S( u ) = 'X^3 + norm u ^+2 *: 'X. +Lemma char_poly_spin u : char_poly \S( u ) = 'X^3 + `|u|_e ^+2 *: 'X. Proof. rewrite char_poly3 det_spin subr0 trace_anti ?spin_is_so //. rewrite scale0r subr0 expr0n add0r mulrN mxtrace_sqr_spin mulrN opprK. by rewrite mulrA div1r mulVr ?unitfE ?pnatr_eq0 // mul1r. Qed. -Definition spin_eigenvalues u : seq R[i] := [:: 0; 0 +i* norm u ; 0 -i* norm u]%C. +Definition spin_eigenvalues u : seq R[i] := [:: 0; 0 +i* `|u|_e ; 0 -i* `|u|_e]%C. Ltac eigenvalue_spin_eval_poly := rewrite /map_poly horner_poly size_polyDl; [ | - by rewrite size_polyXn size_scale ?size_polyX // sqrf_eq0 norm_eq0]; + by rewrite size_polyXn size_scale ?size_polyX // sqrf_eq0 enorm_eq0]; rewrite size_polyXn sum4E !(coefD,coefXn,coefZ,coefX,expr0,expr1) !(mulr0,mul0r,mul1r,add0r,addr0,mul1r). @@ -632,9 +632,10 @@ case: ifPn => [|Hk]. rewrite eqxx mulr1 mulrC (exprS _ 2) -mulrDr mulf_eq0 => /orP [/eqP ->|]. by rewrite inE eqxx. rewrite eq_sym addrC -subr_eq add0r -mulN1r -sqr_i => H. - have {H}: (norm u)*i%C ^+2 == k ^+2. - rewrite -(eqP H) eq_complex. simpc. by rewrite /= !(mulr0,add0r,mul0r,eqxx). - rewrite eqf_sqr => /orP [/eqP <-|]. + have {H}: `|u|_e *i%C ^+2 == k ^+2. + rewrite -(eqP H) eq_complex. simpc. + by rewrite /= !(mulr0,add0r,mul0r,eqxx). + rewrite eqf_sqr => /predU1P[<-|]. by rewrite !inE eqxx orbC. rewrite -eqr_oppLR => /eqP <-. rewrite !inE orbA; apply/orP; right. @@ -699,7 +700,7 @@ Qed. Lemma skew_det1BM n (M : 'M[R]_n.+1) : M \is 'so[R]_n.+1 -> \det (1 - M) != 0. Proof. move=> Mso; apply/det0P => -[v v0]; apply/eqP; rewrite mulmxBr mulmx1 subr_eq0. -apply: contra v0 => /eqP v1M; rewrite -norm_eq0 -sqrf_eq0 -dotmulvv {2}v1M. +apply: contra v0 => /eqP v1M; rewrite -enorm_eq0 -sqrf_eq0 -dotmulvv {2}v1M. by have /eqP := skew_dotmulmx v Mso; rewrite -eq_sym dotmulNv eqrNxx. Qed. @@ -707,50 +708,50 @@ Qed. Lemma skew_det1DM n (M : 'M[R]_n.+1) : M \is 'so[R]_n.+1 -> \det (1 + M) != 0. Proof. move=> Mso; apply/det0P => -[v v0]; apply/eqP; rewrite mulmxDr mulmx1 addr_eq0. -apply: contra v0 => /eqP v1M; rewrite -norm_eq0 -sqrf_eq0 -dotmulvv {2}v1M. +apply: contra v0 => /eqP v1M; rewrite -enorm_eq0 -sqrf_eq0 -dotmulvv {2}v1M. have /eqP := skew_dotmulmx v Mso. by rewrite -eq_sym dotmulNv eqrNxx dotmulvN eqr_oppLR oppr0. Qed. Lemma inv1BM u : (1 - \S(u)) * - (1 + (1 + (norm u)^+2)^-1 *: \S(u) + (1 + (norm u)^+2)^-1 *: \S(u)^+2) = 1. + (1 + (1 + `|u|_e ^+ 2)^-1 *: \S(u) + (1 + `|u|_e ^+ 2)^-1 *: \S(u)^+2) = 1. Proof. rewrite mulrDr 2!mulrBl 2!mul1r. apply/eqP; rewrite eq_sym addrC -subr_eq; apply/eqP. rewrite opprD addrA opprD addrA subrr add0r opprK addrC. rewrite mulrDr mulr1 (addrC \S(u)) scalerAr -addrA; congr (_ + _). rewrite mulrA -expr2 -scalerAr -exprSr spin3 -{1}(scale1r \S(u)). -rewrite -{1}(@divff _ (1 + norm u ^+ 2)) ?paddr_eq0 ?oner_eq0 ?sqr_ge0//. +rewrite -{1}(@divff _ (1 + `|u|_e ^+ 2)) ?paddr_eq0 ?oner_eq0 ?sqr_ge0//. rewrite mulrC -scalerA -scalerBr -scalerN scaleNr opprK; congr (_ *: _). by rewrite scalerDl scale1r addrAC subrr add0r. Qed. Lemma inv1BME u : (1 - \S(u))^-1 = - 1 + (1 + (norm u)^+2)^-1 *: \S(u) + (1 + (norm u)^+2)^-1 *: \S(u)^+2. + 1 + (1 + `|u|_e ^+ 2)^-1 *: \S(u) + (1 + `|u|_e ^+ 2)^-1 *: \S(u)^+2. Proof. rewrite -[LHS]mulmx1 -[X in _ *m X = _](inv1BM u) mulmxA mulVmx ?mul1mx//. by rewrite unitmxE unitfE skew_det1BM // spin_is_so. Qed. (* TODO: move? *) -Lemma det_sub1spin3E M : M \is 'so[R]_3 -> \det (1 - M) = 1 + norm (unspin M) ^+ 2. +Lemma det_sub1spin3E M : M \is 'so[R]_3 -> \det (1 - M) = 1 + `|unspin M|_e ^+ 2. Proof. move=> Mso; rewrite -{1}(unspinK Mso); set v := \S( _ ). rewrite det_mx33 [v]lock !mxE /=. Simp.r. rewrite -lock /v !spinij subr0. Simp.r. rewrite -!addrA; congr (_ + _); rewrite !addrA. -by rewrite mulrBr opprB addrA mulrDr addrA mulrCA subrK addrAC sqr_norm sum3E. +by rewrite mulrBr opprB addrA mulrDr addrA mulrCA subrK addrAC sqr_enorm sum3E. Qed. (* TODO: move? *) -Lemma det_add1spin3E M : M \is 'so[R]_3 -> \det (1 + M) = 1 + norm (unspin M) ^+ 2. +Lemma det_add1spin3E M : M \is 'so[R]_3 -> \det (1 + M) = 1 + `|unspin M|_e ^+ 2. Proof. move=> Mso; rewrite -{1}(unspinK Mso); set v := \S( _ ). rewrite det_mx33 [v]lock !mxE /=. Simp.r. rewrite -lock /v !spinij addr0. Simp.r. rewrite -!addrA; congr (_ + _); rewrite !addrA. -rewrite sqr_norm sum3E -!expr2 -!addrA; congr (_ + _). -rewrite mulrDr -expr2 (addrC _ (_^+2)) -!addrA addrC; congr (_ + _). +rewrite sqr_enorm sum3E -!expr2 -!addrA; congr (_ + _). +rewrite mulrDr -expr2 (addrC _ (_ ^+ 2)) -!addrA addrC; congr (_ + _). by rewrite mulrBr opprB -expr2 addrCA mulrCA subrr addr0. Qed. @@ -859,11 +860,11 @@ Definition cayley21 (a b c : R) := (b * c + a) *+ 2. Definition cayley22 (a b c : R) := 1 - a ^+ 2 - b ^+ 2 + c ^+ 2. Lemma sqr_norm_row3 (a b c : R) : - (norm (row3 a b c)) ^+ 2 = a ^+ 2 + b ^+ 2 + c ^+ 2. + `|row3 a b c|_e ^+ 2 = a ^+ 2 + b ^+ 2 + c ^+ 2. Proof. by rewrite -dotmulvv dotmulE sum3E !mxE/= -!expr2. Qed. (* result of the Cayley transform expressed with Rodrigues' parameters *) -Lemma cayleyE (a b c : R) : let r := euclidean.norm (row3 a b c) in +Lemma cayleyE (a b c : R) : let r := `|row3 a b c|_e in cayley \S((row3 a b c)) = (1 + r ^+ 2)^-1 *: (col_mx3 (row3 (cayley00 a b c) (cayley01 a b c) (cayley02 a b c)) (row3 (cayley10 a b c) (cayley11 a b c) (cayley12 a b c)) diff --git a/ssr_ext.v b/ssr_ext.v index 54378002..81818fad 100644 --- a/ssr_ext.v +++ b/ssr_ext.v @@ -191,6 +191,12 @@ have -> : k = if i == k then i else if j == k then j else - (i + j). by move: i j k neq_ij; do 3![case=> [[|[|[|?]]] ?] //=]; constructor. Qed. +Lemma I3_cases (i : 'I_3) : [\/ i = 0, i = 1 | i = 2]. +Proof. +by move: i => [[|[|[|[|]]]]] // ?; [ + exact/Or31/val_inj| exact/Or32/val_inj| exact/Or33/val_inj]. +Qed. + Lemma odd_perm312 : perm3 1 2%:R = false :> bool. Proof. suff ->: perm3 1 2%:R = 1%g by rewrite odd_perm1. diff --git a/tilt.v b/tilt.v index 9cf7fc89..f9b4a11c 100644 --- a/tilt.v +++ b/tilt.v @@ -192,29 +192,6 @@ Qed. End gradient. -(* spin and matrix/norm properties*) - -Lemma norm_spin {R : rcfType} (u : 'rV[R]_3) (v : 'rV[R]_3) : - (u *m \S(v - u) ^+ 2 *m (u)^T) 0 0 = - norm (u *m \S(v)) ^+ 2. -Proof. -rewrite spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !mul_tr_spin !addr0. -rewrite -dotmulvv /dotmul trmx_mul. -rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. - by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. -by rewrite tr_spin mulNmx mulmxN [in RHS]mxE opprK mulmxA. -Qed. - -Lemma sqr_spin {R : realType} (u : 'rV[R]_3) (norm_u1 : norm u = 1) : - \S(u) *m \S(u) = u^T *m u - 1%:M. -Proof. -have sqrspin : \S(u) ^+ 2 = u^T *m u - (norm u ^+ 2)%:A by rewrite sqr_spin. -rewrite expr2 norm_u1 expr2 mulr1 in sqrspin. -rewrite mulmxE sqrspin. - apply/matrixP => i j ; rewrite mxE /= [in RHS]mxE /=. - congr (_+_); rewrite mxE mxE /= mul1r. - by rewrite [in RHS]mxE [in RHS]mxE /= -mulNrn mxE -mulNrn. -Qed. - Section posdefmx. Definition posdefmx {K : realType} m (M : 'M[K]_m) : Prop := @@ -336,15 +313,15 @@ rewrite /derive_along /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. by rewrite dsol0 mul0mx !mxE. Qed. -Lemma derive_along_norm_squared m (f : 'rV[R]_n -> 'rV[R]_m) (t : R) : +Lemma derive_along_enorm_squared m (f : 'rV[R]_n -> 'rV[R]_m) (t : R) : differentiable f (sol t) -> differentiable sol t -> - 'D~(sol) (fun y => norm (f y) ^+ 2) t = + 'D~(sol) (fun y => `|f y|_e ^+ 2) t = (2 *: 'D_1 (f \o sol) t *m (f (sol t))^T) 0 0. Proof. move=> difff diffphi. -rewrite derive_along_derive//; last exact: differentiable_norm_squared. -rewrite fctE derive_norm_squared //=; last first. +rewrite derive_along_derive//; last exact: differentiable_enorm_squared. +rewrite fctE derive_enorm_squared //=; last first. by apply: diff_derivable=> //=; exact: differentiable_comp. by rewrite mulrDl mul1r scalerDl scale1r mulmxDl [in RHS]mxE. Qed. @@ -633,41 +610,6 @@ Unshelve. all: by end_near. Qed. End sphere. -(* TODO: generalize within_continuous_comp_norm *) -Lemma within_continuous_comp {R : realType} {K : numDomainType} - {U : pseudoMetricNormedZmodType K} a y (g : U -> R) (f : R -> U) : - a <= y -> - {in f @` `[a, y], continuous g} -> - {within `[a, y], continuous (fun x => f x)} -> - {within `[a, y], continuous fun x => (g \o f) x}. -Proof. -rewrite le_eqVlt => /predU1P[<-|ay]. - rewrite set_itv1 => _ _. - exact: continuous_subspace1. -move=> cg. -move/(continuous_within_itvP f ay) => -[H1 H2 H3]. -apply/continuous_within_itvP => //; split => //. -- move=> z zay. - apply: continuous_comp => //. - by apply: H1. - apply: cg. - rewrite inE/=. - exists z => //. - by apply: subset_itv_oo_cc zay. -- apply: (cvg_comp f g). - by apply: H2. - apply: cg. - rewrite inE/=. - exists a => //. - by rewrite in_itv/= lexx/= ltW. -- apply: (cvg_comp f g). - by apply: H3. - apply: cg. - rewrite inE/=. - exists y => //. - by rewrite in_itv/= lexx/= ltW. -Qed. - Section Lyapunov_stability0. Context {K : realType} {n : nat}. Let U := 'rV[K]_n.+1. @@ -759,9 +701,9 @@ Let U := 'rV[K]_n.+1. Variable phi : U -> U. Variable Init : set U. Let u0 : U := 0. -Hypothesis Initu0 : u0 \in Init. +Hypothesis u0Init : u0 \in Init. -Hypothesis openD : open Init. (* D est forcement un ouvert *) +Hypothesis openInit : open Init. (* Init est forcement un ouvert *) (* see Cohen Rouhling ITP 2017 Sect 3.2 *) Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. @@ -782,8 +724,8 @@ Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) : Proof. move=> VDx eq /= eps eps0/=. move: VDx => [/= xD [Vx0 DxV]]. -have [r [r_gt0 [r_eps BrD]]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` Init. - move: xD; rewrite inE => /(open_subball openD)[r0/= r0_gt0] q. +have [r r_gt0 [r_eps BrD]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` Init. + move: xD; rewrite inE => /(open_subball openInit)[r0/= r0_gt0] q. pose r := Num.min (r0 / 2) eps. have r_gt0 : 0 < r by rewrite /r lt_min eps0 divr_gt0. exists (r / 2); first by rewrite divr_gt0. @@ -958,66 +900,6 @@ Unshelve. all: by end_near. Qed. End Lyapunov_stability. -(* see Appendix VII.A of - https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) -Section basic_facts. -Variable K : realType. - -Lemma fact212 (v w : 'rV[K]_3) : \S(v) * \S(w) = w^T *m v - (v *m w^T)``_0 *: 1. -Proof. -apply/matrix3P/and9P; split; apply/eqP; rewrite !(mxE,sum3E,spinij,sum1E); Simp.r. - ring. -by rewrite mulrC. -by rewrite mulrC. -by rewrite mulrC. -by rewrite !opprD; ring. -by rewrite mulrC. -by rewrite mulrC. -by rewrite mulrC. -by rewrite !opprD; ring. -Qed. - -Lemma fact213 (v w : 'rV[K]_3) : \S(v) * \S(w) * \S(v) = - (v *m w^T) ``_0 *: \S(v). -Proof. -rewrite fact212 mulrBl -mulmxE -mulmxA; have: v *m \S(v) = 0. - apply: trmx_inj. - by rewrite trmx_mul tr_spin mulNmx spin_mul_tr trmx0 oppr0. -move => ->. -by rewrite mulmx0 sub0r -mul_scalar_mx -mulNmx; congr (_ *m _); rewrite scalemx1 rmorphN. -Qed. - -Lemma fact215 ( v w : 'rV[K]_3) : \S(w *m \S(v)) = \S(w) * \S(v) - \S(v) * \S(w). -Proof. -by rewrite spinE spin_crossmul. -Qed. - -Lemma fact216 (v w : 'rV[K]_3): \S(w *m \S(v)) = v^T *m w - w^T *m v. -Proof. -by rewrite fact215 !fact212 -!/(_ *d _) dotmulC opprB addrA subrK. -Qed. -Lemma fact217 (v : 'rV[K]_3): \S(v) ^+ 3 = - (norm v ^+2) *: \S(v). - exact: spin3. -Qed. - -Lemma fact214 (R : 'M[K]_3) (v_ : seq 'rV[K]_3) : R \is 'SO[K]_3 -> - R^T * (\prod_(i <- v_) \S( i )) * R = (\prod_(i <- v_) \S( i *m R)). -Proof. -move => RSO. -elim/big_ind2 : _ => //. - by rewrite -!mulmxE mulmx1 rotation_tr_mul. -- move => a b c d H1 H2. - rewrite -H1 // -H2 // -!mulmxE -!rotation_inv // !mulmxA -[R^-1 *m b *m R *m R^-1]mulmxA. - rewrite mulmxV; last first. - rewrite unitmxE. - apply: orthogonal_unit. - exact: rotation_sub. - by rewrite -[R^-1 *m b *m 1%:M *m d]mulmxA mul1mx. -- move => i true. - exact: spin_similarity. -Qed. - -End basic_facts. - Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). @@ -1061,7 +943,7 @@ Qed. End ya. -Definition S2 {K : realType} := [set x : 'rV[K]_3 | norm x = 1]. +Definition S2 {K : realType} := [set x : 'rV[K]_3 | `|x|_e = 1]. (* section III.A of [benallegue2023itac] *) Section state_dynamics. @@ -1079,7 +961,7 @@ Let w t := ang_vel R t. Lemma x2_S2 t : x2 t \in S2. Proof. -by rewrite /S2 /x2 inE/= orth_preserves_norm ?normeE ?rotation_sub. +by rewrite /S2 /x2 inE/= orth_preserves_norm ?enormeE ?rotation_sub. Qed. (* not used but could be interesting *) @@ -1168,7 +1050,7 @@ Hypothesis RisSO : forall t, R t \is 'SO[K]_3. (* projection from the local frame to the world frame(?) *) Let error1_p t := error1 t *m (R t)^T (* z_p_1 in [benallegue2023ieeetac] *). Let error2_p t := error2 t *m (R t)^T. -Hypothesis norm_x2_hat : forall t, norm (x2_hat t) = 1. +Hypothesis norm_x2_hat : forall t, `|x2_hat t|_e = 1. Let error1E : error1 = fun t => x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). Proof. @@ -1339,7 +1221,7 @@ Qed. End two_steps_first_order_estimator. Definition state_space_tilt {K : realType} := - [set x : 'rV[K]_6 | norm ('e_2 - Right x) = 1]. + [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. Lemma cst_oo_cc {R : realType} (f : R -> R) y (a b : R) : y \in `[a, b] -> @@ -1531,202 +1413,13 @@ apply: (@le_trans _ _ (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: x0 a b|)); last first. Abort. -(* Todo: Maybe useful generally? (PR) *) -Lemma norm_rowmx {m n1 n2 : nat} (A1 : matrix K m.+1 n1.+1) (A2 : matrix K m.+1 n2.+1) : `|row_mx A1 A2| = max `|A1| `|A2|. -Proof. -rewrite /Num.norm/=. -rewrite !mx_normrE. -apply/eqP; rewrite eq_le; apply/andP; split. -- apply: bigmax_le => /=. - rewrite le_max;apply /orP;left. - apply/le_trans/(le_bigmax _ _ (ord0,ord0) ). - by apply normr_ge0. - move => [i j] _. - rewrite /=. - rewrite le_max;apply /orP. - rewrite mxE. - case: (splitP j) => j1 h1. - left;exact: (le_bigmax _ _ (i, j1)). - right;exact: (le_bigmax _ _ (i, j1)). -rewrite ge_max;apply /andP;split. - apply: bigmax_le => /=. - apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, ord0)). - exact: normr_ge0. - move => [i j] _. - rewrite /=. - rewrite -(row_mxEl _ A2). - exact: (le_bigmax _ _ (i, lshift n2.+1 j)). -apply: bigmax_le => /=. -apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, ord0)). - exact: normr_ge0. -move => [i j] _. -rewrite /=. -rewrite -(row_mxEr A1). -exact: (le_bigmax _ _ (i, rshift n1.+1 j)). -Qed. - -Lemma left_sub (x y : 'rV[K]_6) : Left x - Left y = Left (x -y). -Proof. - rewrite /Left. - apply/matrixP => i j. - by rewrite !mxE. -Qed. - -Lemma right_sub (x y : 'rV[K]_6) : Right x - Right y = Right (x -y). -Proof. - rewrite /Left. - apply/matrixP => i j. - by rewrite !mxE. -Qed. -Lemma left_norm_le (x : 'rV[K]_6) : `|Left x| <= `|x|. -Proof. -rewrite /Num.norm/=. -rewrite !mx_normrE. -apply: bigmax_le. - by apply/le_trans/(le_bigmax _ _ (ord0,ord0) );apply normr_ge0. - move => [i j] _. - rewrite /=. - rewrite mxE. - exact: (le_bigmax _ _ (i, lshift 3 j)). -Qed. - -Lemma right_norm_le (x : 'rV[K]_6) : `|Right x| <= `|x|. +Lemma closed_ball_bounded {n} (x y : 'rV[K]_n) r : 0 < r -> closed_ball x r y -> + `|y| <= `|x| + r. Proof. -rewrite /Num.norm/=. -rewrite !mx_normrE. -apply: bigmax_le. - by apply/le_trans/(le_bigmax _ _ (ord0,ord0) );apply normr_ge0. - move => [i j] _. - rewrite /=. - rewrite mxE. - exact: (le_bigmax _ _ (i, rshift 3 j)). -Qed. - -(*Todo: This also seems useful in general (PR) *) -Lemma mx_norm_mul {m n p} (A : matrix K m.+1 n.+1) (B : 'M_(n.+1, p.+1)) : - `|(A *m B)| <= (n.+1)%:R * `| A| * `|B|. -Proof. - rewrite /Num.norm/=. - rewrite !mx_normrE. - apply: bigmax_le. - rewrite -mulrA. - apply mulr_ge0 => //. - by apply mulr_ge0; apply/le_trans/(le_bigmax _ _ (ord0,ord0) );apply normr_ge0. - move => [i j] _. - rewrite /=. - rewrite mxE. - apply: le_trans; first by apply ler_norm_sum. - rewrite /=. - have le_inside :forall i0, `|A i i0 * B i0 j| <= `| A | * `|B|. - move => k. - rewrite normrM. - rewrite /Num.norm/= !mx_normrE. - apply ler_pM. - exact: normr_ge0. - exact: normr_ge0. - apply: (le_bigmax _ _ (i,k)). - apply: (le_bigmax _ _ (k,j)). - rewrite -mulrA. - apply : (@le_trans _ _ (\sum_(i0 < n.+1) `|A| * `|B|)). - apply: ler_sum => k _; apply le_inside. - rewrite mulr_natl. - rewrite big_const_ord. - rewrite iter_addr_0. - by rewrite /Num.norm/= !mx_normrE. -Qed. - -Lemma mx_norm_sq_le {n} (A : matrix K n.+1 n.+1) : `|A^+2| <= (n.+1)%:R* `|A|^+2. -Proof. - rewrite !expr2 mulrA. - exact: mx_norm_mul. -Qed. - - -Lemma closed_ball_bounded {n} (x y : 'rV[K]_n) r: 0 < r -> closed_ball x r y -> `|y| <= `|x| + r. -Proof. -move => r0. -rewrite closed_ballE//. -rewrite /closed_ball_/=. -move => dxy. -rewrite ler_distlCDr //. -by apply: (le_trans (ler_dist_dist _ _)). -Qed. -Local Lemma euclidean_norm_mxnorm {n} (x : 'rV[K]_n.+1) : (norm x)^+2 <= n.+1%:R* `|x| ^ 2. -Proof. -rewrite sqr_norm /=. -have le_inside :forall i, x``_i^+2 <= `| x |^+2. - move => i. - rewrite -sqr_normr. - suff h : `|x``_i| <= `|x| by apply ler_pM => //; apply normr_ge0. - rewrite {2}/Num.norm/= !mx_normrE /=. - exact: (le_bigmax _ _ (ord0,i)). -apply : (@le_trans _ _ (\sum_(i0 < n.+1) `|x|^+2 )). -apply: ler_sum => k _; apply le_inside. -by rewrite big_const_ord mulr_natl iter_addr_0. -Qed. - -Lemma mx_norm1 {n} : `|(1 : matrix K n.+1 n.+1)| = 1. -Proof. -rewrite /Num.norm/= !mx_normrE. -apply/eqP; rewrite eq_le; apply/andP; split. -- apply: bigmax_le => //. - move => i _. - rewrite mxE /=. - case: eqP => /= _. - by rewrite normr1. - by rewrite normr0. -rewrite -normr1. -have ->: ((1 : K) = ((1 : matrix K n.+1 n.+1) ord0 ord0)) by rewrite mxE. -exact: (le_bigmax _ _ (ord0, ord0)). -Qed. -Local Lemma I3_cases (i : 'I_3) : i = 0 \/ i = 1 \/ i = 2. -Proof. -case: i => m hm. -have : m = 0 \/ m = 1 \/ m = 2. -case: m hm => [|[|[|m]]] //=; by [left| right;left | right;right]. -by case=> [h|[h|h]];[left|right;left|right;right];apply/val_inj. -Qed. - -Lemma spin_le_norm (x : 'rV[K]_3) : `|\S(x)| <= `|x|. -Proof. -rewrite {1}/Num.norm/= !mx_normrE. -apply: bigmax_le. -apply normr_ge0. -move => [i j] _. -have [->|[->|->]] := I3_cases i;have [->|[->|->]] := I3_cases j => //=. -all: rewrite ?spinii ?spin01 ?spin02 ?spin10 ?spin12 ?spin20 ?spin21 - ?normr0 ?normrN ?normr_ge0 // {2}/Num.norm/= !mx_normrE;exact : (le_bigmax _ _ (0,_)). -Qed. - -Lemma spin_sq_norm_bound (x : 'rV[K]_3) : `|\S(x)^+2| <= 3* `|x|^+2. -Proof. - apply: (le_trans (mx_norm_sq_le _)). - apply ler_pM => //. - suff h : `|\S(x)| <= `|x| by apply ler_pM. - exact: spin_le_norm. -Qed. - -Lemma spin_sq_dist_bound (x y: 'rV[K]_3) : `|\S(x)^+2 - \S(y)^+2| <= 3 * (`|x|+`|y|)* `|x-y|. -Proof. -have -> : \S(x) ^+ 2 - \S(y) ^+ 2 = \S(x) *m (\S(x) - \S(y)) + (\S(x) - \S(y)) *m \S(y). - by rewrite mulmxBr mulmxBl addrA subrK. -rewrite mulrDr mulrDl. -apply: (le_trans (ler_normD _ _)). -rewrite -spinN -spinD. -apply: lerD. - apply: (le_trans (mx_norm_mul _ _)). - apply : ler_pM => //. - apply : ler_pM => //. - exact: spin_le_norm. - exact: spin_le_norm. -rewrite -mulrA (mulrC `|y|) mulrA. -apply: (le_trans (mx_norm_mul _ _)). -apply : ler_pM => //. -apply : ler_pM => //. -exact: spin_le_norm. -exact: spin_le_norm. +move=> r0. +rewrite closed_ballE// /closed_ball_/= => dxy. +rewrite ler_distlCDr//. +by rewrite (le_trans (ler_dist_dist _ _)). Qed. (* Lemma spin_sq_norm_bound (x : 'rV[K]_3) : `|\S(x)^+2| <= 4* `|x|^+2. *) @@ -1744,9 +1437,10 @@ Qed. (* exact: euclidean_norm_mxnorm. *) (* Qed. *) -Lemma tilt_eqn_locally_lipschitz : forall x, exists (r k : {posnum K}), k%:num.-lipschitz_(closed_ball x r%:num) tilt_eqn. +Lemma tilt_eqn_locally_lipschitz x : + exists r k : {posnum K}, k%:num.-lipschitz_(closed_ball x r%:num) tilt_eqn. Proof. -move => /= x. +move=> /=. rewrite /tilt_eqn. (* near (pinfty_nbhs K) => k'. *) (* exists k' => -[/= x x0] _. *) @@ -1755,50 +1449,36 @@ exists (PosNum ltr01). near (pinfty_nbhs K) => k. have k0 : (0 < k) by []. exists (PosNum k0) => /= => -[/= x0 x1] [x0B x1B]. - rewrite (opp_row_mx (n1:=3)) (add_row_mx (n1:=3)). rewrite !scaleNr opprK/=. rewrite addrC -scalerBr. rewrite /eqn14b_rhs. rewrite -!scalemxAl -scalerBr. rewrite (norm_rowmx (m:=0) (n1:=2) (n2:=2)). -rewrite ge_max;apply /andP;split. +rewrite ge_max; apply/andP; split. - rewrite mx_normZ. - rewrite left_sub. - apply: ler_pM; try by apply normr_ge0. - by []. + rewrite -linearB/=. + rewrite ler_pM//. rewrite distrC. - by apply /le_trans/left_norm_le. + exact/le_trans/(@left_norm_le _ 2 2). - rewrite mx_normZ. - set a := (Right x0 - Left x0). - set b := (Right x1 - Left x1). + set a := Right x0 - Left x0. + set b := Right x1 - Left x1. set c := \S('e_2 - Right x0) ^+ 2. set d := \S('e_2 - Right x1) ^+ 2. - have abound : `|a| <= 2 * (`|x| + 1). - rewrite /a. - apply: (le_trans (ler_normB _ _ )). - rewrite mulrDl lerD // mul1r. - apply : (le_trans (right_norm_le _)). - by apply closed_ball_bounded. - apply : (le_trans (left_norm_le _)). - by apply closed_ball_bounded. + have abound : `|a| <= 2 * (`|x| + 1). + rewrite (le_trans (ler_normB _ _ ))// mulrDl lerD// mul1r. + rewrite (le_trans (right_norm_le _))//. + exact: closed_ball_bounded. + rewrite (le_trans (left_norm_le _))//. + exact: closed_ball_bounded. (* todo: find some bound and show *) have sbound x' : closed_ball x 1 x' -> `|'e_2 - Right x'| <= 2+`|x|. - move => cb. - apply: (le_trans (ler_normB _ _)). - have -> : 2 + `|x| = 1+(1+`|x|) by ring. - apply lerD. - rewrite /Num.norm /= mx_normrE. - apply: bigmax_le => //. - move => i _. - rewrite mxE /=. - case: eqP=> /= _;last by rewrite normr0. - case:eqP => /= _;last by rewrite normr0. - by rewrite normr1. - apply: (le_trans (right_norm_le _)). - rewrite addrC. - by apply closed_ball_bounded. - have dbound : `|d| <= 3* (2 + `|x|)^+2. + move=> cb. + rewrite (le_trans (ler_normB _ _))// [in leRHS](natrD _ 1 1) -addrA lerD//. + exact: mx_norm_delta_mx. + by rewrite (le_trans (right_norm_le _))// addrC closed_ball_bounded. + have dbound : `|d| <= 3 * (2 + `|x|) ^+ 2. rewrite /d. apply: (le_trans (spin_sq_norm_bound _)). apply ler_pM => //. @@ -1807,58 +1487,45 @@ rewrite ge_max;apply /andP;split. by apply sbound. rewrite -ler_pdivlMl; last by rewrite normr_gt0 lt0r_neq0. rewrite -(subrKA (a *m d) (a *m c )) (le_trans (ler_normD _ _))//. - (* why is this so slow?*) - rewrite -mulmxBr. - rewrite -(@mulmxBl K 1 3 3 a b d). + rewrite -[X in `|X| + _]mulmxBr. + rewrite -[X in _ + `|X|]mulmxBl. rewrite (splitr `|gamma|^-1) mulrDl. rewrite -invrM; last 2 first. - by rewrite unitfE. - rewrite unitfE. - apply lt0r_neq0. - by rewrite normr_gt0 lt0r_neq0. - rewrite lerD //. + by rewrite unitfE. + by rewrite unitfE// gt_eqF// gtr0_norm. + rewrite lerD//. + apply: (le_trans (mx_norm_mul _ _)). have h0 := spin_sq_dist_bound ('e_2 - Right x0) ('e_2 - Right x1). apply : (le_trans (ler_pM _ _ (le_refl _) h0)) => //. have -> : 'e_2 - Right x0 - ('e_2 - Right x1) = Right x1 - Right x0. by rewrite opprB addrC addrA subrK. rewrite !mulrA. - apply ler_pM => //; last by rewrite distrC right_sub;exact: right_norm_le. + apply ler_pM => //; last by rewrite distrC -linearB; exact: right_norm_le. rewrite (mulrC 3) -!mulrA. apply : (le_trans (ler_pM _ _ abound (le_refl _))) => //. rewrite !mulrA. rewrite ler_pdivlMl; last first. - apply mulr_gt0 => //. - by rewrite normr_gt0 lt0r_neq0. + by rewrite mulr_gt0// gtr0_norm. rewrite !mulrA. suff h : `|'e_2 - Right x0| + `|'e_2 - Right x1| <= 2 * (2 + `|x|). - by apply: (le_trans (ler_pM _ _ (le_refl _) h)) => //. - rewrite mulrDl mul1r. - by apply lerD; apply sbound. - + apply: le_trans. - apply: mx_norm_mul. + exact: (le_trans (ler_pM _ _ (le_refl _) h)). + by rewrite mulrDl mul1r lerD//; apply sbound. + + rewrite (le_trans (mx_norm_mul _ _))//. rewrite opprB -addrA (addrC (-Left x0)) addrA (addrC (Left x1)) addrA -(addrA (Right x0 - _)). rewrite mulrC. apply (@le_trans _ _ (`| d| * (6 * `|x0 - x1|))). apply ler_pM => //. - have -> : (6 : K) = (3 * 2) by ring. - rewrite -mulrA. - apply ler_pM => //. - apply (le_trans (ler_normD (Right x0 - _) _)). - rewrite mulrDl lerD // mul1r. - by rewrite right_sub;apply right_norm_le. - by rewrite distrC left_sub; apply left_norm_le. - apply: (le_trans (ler_pM _ _ dbound (lexx _ ))). - apply normr_ge0. - apply mulr_ge0 => //. + rewrite [in leRHS](natrM _ 3 2)// -mulrA ler_pM//. + rewrite (le_trans (ler_normD _ _))//. + rewrite mulrDl lerD// mul1r. + by rewrite -linearB; apply: right_norm_le. + by rewrite distrC -linearB/=; apply: left_norm_le. + rewrite (le_trans (ler_pM _ _ dbound (lexx _ )))//. rewrite ler_pdivlMl; last first. - apply mulr_gt0 => //. - by rewrite normr_gt0 lt0r_neq0. - rewrite !mulrA. - apply ler_pM => //. + by rewrite mulr_gt0// gtr0_norm. + by rewrite !mulrA ler_pM. Unshelve. all: by end_near. Qed. - (*Lemma invariant_state_space_tilt p (p33 : state_space tilt_eqn' state_space_tilt p) : let y := sval (cid p33) in @@ -1938,32 +1605,33 @@ have : {in `]0, Delta[, derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right move => h [t [t0d ->]]. (* under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0 *) *) (* move => h. *) -have norm_constant : forall t, t \in `[0,Delta] -> norm ('e_2 - Right (y t))^+2 = norm ('e_2 - Right (y 0))^+2. +have norm_constant : forall t, t \in `[0,Delta] -> + `|'e_2 - Right (y t)|_e ^+ 2 = `|'e_2 - Right (y 0)|_e ^+ 2. move => t0. - have : forall x0, x0 \in `]0,Delta[ -> is_derive x0 (1:K) (fun x : K => norm ('e_2 - Right (y x)) ^+ 2) 0. + have : forall x0, x0 \in `]0,Delta[ -> + is_derive x0 (1:K) (fun x : K => `|'e_2 - Right (y x)|_e ^+ 2) 0. move => x0 x0d. apply: DeriveDef. - apply/derivable_norm_squared => //=. + apply/derivable_enorm_squared => //=. apply/derivableB => //=. apply/derivable_rsubmx => //. by apply deri. rewrite -derive1E. have := h _ x0d. under eq_fun do rewrite dotmulvv /=. - by apply. + by apply. rewrite /=. move => hd0 t0d'. apply/esym. have := is_derive_0_is_cst_new' t0d' _ hd0. apply => //; last first. by rewrite inE/= in_itv/= lexx/=. - apply: (@within_continuous_comp _ _ _ _ _ (fun x => norm ('e_2 - Right x) ^+ 2) y) => //=. + apply: (@within_continuous_comp _ _ _ _ _ (fun x => `|'e_2 - Right x|_e ^+ 2) y) => //=. move=> z _. apply: differentiable_continuous => //. - apply: differentiable_norm_squared => /=. - apply: differentiableB => //. - by apply: differentiable_rsubmx. -suff: norm ('e_2 - Right (y t)) ^+ 2 = 1. + apply: differentiable_enorm_squared => /=. + exact: differentiableB. +suff: `|'e_2 - Right (y t)|_e ^+ 2 = 1. move => /(congr1 Num.sqrt). rewrite sqrtr1 sqr_sqrtr //. by rewrite dotmulvv sqr_ge0. @@ -1982,7 +1650,7 @@ Lemma equilibrium_point1 : Proof. split. - rewrite inE /state_space_tilt /point1/=. - by rewrite rsubmx_const /= subr0 normeE. + by rewrite rsubmx_const /= subr0 enormeE. - split => //=. split. + move=> t t0Delta. @@ -2009,7 +1677,7 @@ split. - rewrite inE /state_space_tilt /point2 /=. rewrite row_mxKr. rewrite -[X in X - _ ]scale1r. - rewrite -scalerBl normZ normeE mulr1 distrC. + rewrite -scalerBl enormZ enormeE mulr1 distrC. rewrite [X in _ - X](_:1 = 1%:R) //. by rewrite -natrB //= normr1. - split => //. @@ -2154,13 +1822,13 @@ Hypothesis gamma_gt0 : 0 < gamma. Definition V1 (zp1_z2 : 'rV[K]_6) : K := let zp1 := Left zp1_z2 in let z2 := Right zp1_z2 in - (norm zp1)^+2 / (2 * alpha1) + (norm z2)^+2 / (2 * gamma). + `|zp1|_e ^+ 2 / (2 * alpha1) + `|z2|_e ^+ 2 / (2 * gamma). Lemma V1_is_Lyapunov_candidate : is_Lyapunov_candidate V1 [set: 'rV_6] point1. Proof. rewrite /V1 /point1; split; first by rewrite inE. split. - by rewrite lsubmx_const rsubmx_const norm0 expr0n/= !mul0r add0r. + by rewrite lsubmx_const rsubmx_const enorm0 expr0n/= !mul0r add0r. move=> /= z_near _ z0. have /orP[lz0|rz0] : (Left z_near != 0) || (Right z_near != 0). rewrite -negb_and. @@ -2169,22 +1837,22 @@ have /orP[lz0|rz0] : (Left z_near != 0) || (Right z_near != 0). apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; by rewrite mxE. - set rsub := Right z_near. - have : norm rsub >= 0 by rewrite norm_ge0. + have : `|rsub|_e >= 0 by rewrite enorm_ge0. set lsub := Left z_near. move=> nor. - have normlsub : norm lsub > 0 by rewrite norm_gt0. + have normlsub : `|lsub|_e > 0 by rewrite enorm_gt0. rewrite ltr_pwDl//. by rewrite divr_gt0 ?exprn_gt0// mulr_gt0. by rewrite divr_ge0 ?exprn_ge0// mulr_ge0// ltW. - rewrite ltr_pwDr//. - by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0// norm_gt0. - by rewrite divr_ge0 ?exprn_ge0 ?norm_ge0// mulr_ge0// ltW. + by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0 ?enorm_gt0. + by rewrite divr_ge0 ?exprn_ge0 ?enorm_ge0 ?mulr_ge0// ltW. Unshelve. all: by end_near. Qed. Definition V1dot (zp1_z2 : 'rV[K]_6) : K := let zp1 := Left zp1_z2 in let z2 := Right zp1_z2 in - - (norm zp1)^+2 + (z2 *m (\S('e_2 - z2))^+2 *m z2^T + - `|zp1|_e ^+ 2 + (z2 *m (\S('e_2 - z2))^+2 *m z2^T - z2 *m (\S('e_2 - z2))^+2 *m zp1^T)``_0. End V1. @@ -2274,7 +1942,7 @@ Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - is_sol phi Delta sol state_space_tilt -> norm u = 1. + is_sol phi Delta sol state_space_tilt -> `|u|_e = 1. Proof. move=> z0Delta dtraj. suff: state_space_tilt (row_mx (zp1 z) (z2 z)). @@ -2311,26 +1979,26 @@ Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : z \in `[0, Delta[%R -> is_sol phi Delta sol state_space_tilt-> - norm (Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))) = - norm (Right (sol z) *m \S('e_2)). + `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = + `|Right (sol z) *m \S('e_2)|_e. Proof. move=> z0Delta. move=> dtraj. -rewrite mulmxN normN. +rewrite mulmxN enormN. pose zp1 := fun r => Left (sol r). pose z2 := fun r => Right (sol r). set w := (z2 z) *m \S('e_2). have Gamma1_traj : state_space_tilt (sol z). by apply/is_sol_state_space_tilt. -rewrite /norm. +rewrite /enorm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. -have Hnorm_sq : norm (w *m \S('e_2 - Right (sol z))) ^+ 2 = norm w ^+ 2. +have Hnorm_sq : `|w *m \S('e_2 - Right (sol z))|_e ^+ 2 = `|w|_e ^+ 2. rewrite -!dotmulvv angvel_sqr// !dotmulvv norm_e2z2//=. rewrite -!dotmulvv expr2 !mul1r mulr1. have -> : w *d ('e_2 - Right (sol z)) = 0 by rewrite dotmulC ortho_spin. by rewrite expr2 mul0r subr0. -rewrite !normr_norm. -by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?norm_ge0. +rewrite !normr_enorm. +by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?enorm_ge0. Qed. Let c1 := 2^-1 / alpha1. @@ -2372,34 +2040,33 @@ Proof. move=> t0Delta tilt_eqnx dif1. rewrite /V1 derive_alongD; last 3 first. apply/differentiableM => //=. - exact/differentiable_norm_squared/differentiable_lsubmx. + exact/differentiable_enorm_squared/differentiable_lsubmx_comp. apply/differentiableM => //=. - exact/differentiable_norm_squared/differentiable_rsubmx. + exact/differentiable_enorm_squared/differentiable_rsubmx_comp. exact: dif1. under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. rewrite derive_alongMl => //; last 2 first. - exact/differentiable_norm_squared/differentiable_lsubmx. - by apply: dif1. + exact/differentiable_enorm_squared/differentiable_lsubmx_comp. + exact: dif1. rewrite derive_alongMl => //; last 2 first. - exact/differentiable_norm_squared/differentiable_rsubmx. - by apply: dif1. -rewrite -fctE /= !derive_along_norm_squared//=. + exact/differentiable_enorm_squared/differentiable_rsubmx_comp. + exact: dif1. +rewrite -fctE /= !derive_along_enorm_squared//=. - rewrite V1dotE. by rewrite /c1 /c2 !invfM. rewrite /= in tilt_eqnx. exact: tilt_eqnx. - assumption. -- exact/differentiable_lsubmx. - by apply: dif1. -- exact/differentiable_rsubmx. - by apply: dif1. +- exact/differentiable_lsubmx_comp. +- by apply: dif1. +- by apply: dif1. Qed. Definition u1 (sol : K -> 'rV[K]_6) t (zp1 := Left \o sol) (z2 := Right \o sol) (w := z2 t *m \S('e_2)) : 'rV[K]_2 := - \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 t), 1 |-> norm w] i. + \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 t|_e, 1 |-> `|w|_e] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : is_sol phi Delta sol state_space_tilt -> @@ -2414,20 +2081,20 @@ have -> : z2 z *m \S('e_2 - z2 z) = z2 z *m \S('e_2). by rewrite spinD spinN -tr_spin !mulmxDr !mul_tr_spin !addr0. rewrite -dotmulNv addrC -mulmxN -expr2. have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= - norm(w *m - (\S('e_2 - z2 z))) * norm(zp1 z). + `|w *m - \S('e_2 - z2 z)|_e * `|zp1 z|_e. rewrite mxE /= mulr1n (le_trans (ler_norm _)) //. rewrite -ler_sqr // ; last first. - by rewrite nnegrE // mulr_ge0 ?norm_ge0. - by rewrite exprMn sqr_normr (le_trans (CauchySchwarz_vec _ _)) // !dotmulvv. -apply: (@le_trans _ _ (norm (w *m - \S('e_2 - z2 z)) * norm (zp1 z) + (- norm (zp1 z) ^+ 2 - norm w ^+ 2))). + by rewrite nnegrE // mulr_ge0 ?enorm_ge0. + by rewrite exprMn sqr_normr (le_trans (CauchySchwarz_rV _ _)) // !dotmulvv. +apply: (@le_trans _ _ (`|w *m - \S('e_2 - z2 z)|_e * `|zp1 z|_e + (- `|zp1 z|_e ^+ 2 - `|w|_e ^+ 2))). rewrite lerD2r. - rewrite (le_trans _ (cauchy)) //. + rewrite (le_trans _ cauchy) //. by rewrite mxE eqxx mulr1n. rewrite neg_spin /u1 /u2 //. rewrite mxE. rewrite !sum2E/= ![in leRHS]mxE !sum2E/= ![in leRHS]mxE /=. rewrite !mulr1 mulrN mulNr opprK mulrDl mulNr -expr2. -rewrite [in leLHS] addrCA -!addrA lerD2l mulrDl (mulNr (norm w)). +rewrite [in leLHS] addrCA -!addrA lerD2l mulrDl (mulNr `|w|_e). rewrite -expr2 !addrA lerD2r !(mulrN , mulNr) opprK -mulrA. rewrite [in leRHS](mulrC (_ / 2)) (mulrC 2^-1) -mulrDr -splitr. by rewrite [leRHS]mulrC. @@ -2439,8 +2106,8 @@ Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : is_sol phi Delta (sol x) state_space_tilt -> sol x 0 = point1 -> \forall z \near 0^', - ('D~(sol x) (fun x => norm (Left x) ^+ 2 / (2 * alpha1)) + - 'D~(sol x) (fun x => norm (Right x) ^+ 2 / (2 * gamma))) z <= 0. + ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + + 'D~(sol x) (fun x => `|Right x|_e ^+ 2 / (2 * gamma))) z <= 0. Proof. move=> [in_init [_ [dtraj btraj]]] traj0. rewrite fctE !invfM /=. @@ -2532,9 +2199,9 @@ split. rewrite /V1. apply: differentiableD => //; last first. apply: differentiableM; last exact: differentiable_cst. - exact/differentiable_norm_squared/differentiable_rsubmx. + exact/differentiable_enorm_squared/differentiable_rsubmx_comp. apply: differentiableM => //. - exact/differentiable_norm_squared/differentiable_lsubmx. + exact/differentiable_enorm_squared/differentiable_lsubmx_comp. near=> z0. rewrite derive_along_V1. - have z00Delta : z0 \in `[0, Delta[%R. @@ -2542,8 +2209,8 @@ rewrite derive_along_V1. have V1dot_le := V1dot_ub solves z00Delta => //. set w := z2 z0 *m \S('e_2). set u1 : 'rV[K]_2 := \row_(i < 2) - [eta (fun=> 0) with 0 |-> norm (zp1 z0), 1 |-> norm w] i. - have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0. + [eta (fun=> 0) with 0 |-> `|zp1 z0|_e, 1 |-> `|w|_e] i. + have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0. rewrite u2_quadratic_form_gt0//. rewrite /u1. admit. @@ -2609,12 +2276,12 @@ have t0Delta : t \in `[0, Delta[%R. have Hub := V1dot_ub solves t0Delta. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 - with 0 |-> norm ((Left \o sol) t), - 1 |-> norm ((Right \o sol) t *m \S('e_2))] + with 0 |-> `|(Left \o sol) t|_e, + 1 |-> `|(Right \o sol) t *m \S('e_2)|_e] i in 0 <= (u1 *m u2 *m u1^T) 0 0. set u1 := \row_i [eta fun=> 0 - with 0 |-> norm ((Left \o sol) t), - 1 |-> norm ((Right \o sol) t *m \S('e_2))] + with 0 |-> `|(Left \o sol) t|_e, + 1 |-> `|(Right \o sol) t *m \S('e_2)|_e] i. rewrite /=. case: (u1 =P 0) => [->|/eqP u1_neq0]. @@ -2654,9 +2321,9 @@ move=> Init0 openInit Init_in_state. apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). - move=> t; apply/differentiableD => //=. apply/differentiableM => //=. - exact/differentiable_norm_squared/differentiable_lsubmx. + exact/differentiable_enorm_squared/differentiable_lsubmx_comp. apply/differentiableM => //=. - exact/differentiable_norm_squared/differentiable_rsubmx. + exact/differentiable_enorm_squared/differentiable_rsubmx_comp. - move=> Delta sol solP t t0. case: solP => sol0Init solP. apply: (@derive_along_V1_le0 _ _ _ _ _ Delta sol). @@ -2679,7 +2346,7 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). rewrite /is_Lyapunov_candidate /point1 => Hpos. rewrite /V1 lsubmx_const rsubmx_const; split => //. split. - by rewrite !expr2 !norm0 !mulr0 !mul0r add0r. + by rewrite !expr2 !enorm0 !mulr0 !mul0r add0r. move=> z zin z_neq0. case : Hpos => // _ [V1_eq0 V1_gt0]. apply: V1_gt0 => //. diff --git a/tilt_analysis.v b/tilt_analysis.v index 1e699600..536bc891 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -1,4 +1,4 @@ -From mathcomp Require Import all_ssreflect all_algebra ring. +From mathcomp Require Import all_boot all_order all_algebra ring. From mathcomp Require Import boolp classical_sets functions reals. From mathcomp Require Import topology normedtype derive realfun landau. From HB Require Import structures. @@ -11,55 +11,64 @@ Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. - (* is already in realfun.v*) -Global Instance is_derive1_sqrt {K : realType} (x : K) : 0 < x -> - is_derive x 1 Num.sqrt (2 * Num.sqrt x)^-1. + +(* Todo: Maybe useful generally? (PR) *) +Lemma norm_rowmx {K : rcfType} {m n1 n2 : nat} + (A1 : 'M[K]_(m.+1, n1.+1)) (A2 : 'M[K]_(m.+1, n2.+1)) : + `|row_mx A1 A2| = Num.max `|A1| `|A2|. Proof. -move=> x_gt0. -have sqrtK : {in Num.pos, cancel (@Num.sqrt K) (fun x => x ^+ 2)}. - by move=> a a0; rewrite sqr_sqrtr// ltW. -rewrite -[x]sqrtK//. -apply: (@is_derive_inverse K (fun x => x ^+ 2)). -- near=> z. - rewrite sqrtr_sqr gtr0_norm//. - have [xz|zx|->] := ltgtP z (Num.sqrt x); last first. - + by rewrite sqrtr_gt0. - + by rewrite (lt_trans _ zx)// sqrtr_gt0. - + move: xz. - near: z. - exists (Num.sqrt x / 2). - rewrite /=. - rewrite mulr_gt0 //. - by rewrite sqrtr_gt0 x_gt0. - rewrite invr_gt0. - by []. - move=> r/=. - move=> /[swap] rx. - rewrite gtr0_norm ?subr_gt0//. - rewrite ltrBlDl. - rewrite -ltrBlDr. - apply: le_lt_trans. - rewrite subr_ge0. - rewrite ger_pMr. - rewrite invf_le1. - by rewrite ler1n. - by []. - by rewrite sqrtr_gt0. -- near=> z. - exact: exprn_continuous. -- rewrite !sqrtK//; split. - exact: exprn_derivable (* TODO: renaming, see https://github.com/math-comp/analysis/issues/1677 *). - by rewrite exp_derive (* TODO: renaming -> issue *) expr1 scaler1. -- by rewrite mulf_neq0 ?pnatr_eq0// gt_eqF// sqrtr_gt0 exprn_gt0// sqrtr_gt0. -Unshelve. all: by end_near. Qed. +rewrite /Num.norm/= !mx_normrE. +apply/eqP; rewrite eq_le; apply/andP; split. +- apply: bigmax_le => /=. + rewrite le_max;apply /orP;left. + exact/le_trans/(le_bigmax _ _ (ord0,ord0)). + move=> [i j] _ /=. + rewrite le_max; apply/orP. + rewrite mxE. + case: (splitP j) => j1 h1. + by left; exact: (le_bigmax _ _ (i, j1)). + by right;exact: (le_bigmax _ _ (i, j1)). +rewrite ge_max; apply/andP; split. + apply: bigmax_le => /=. + apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, ord0)). + exact: normr_ge0. + move=> [i j] _. + rewrite -(row_mxEl _ A2). + exact: (le_bigmax _ _ (i, lshift n2.+1 j)). +apply: bigmax_le => /=. + apply: le_trans; last first. + exact: (le_bigmax _ _ (ord0, ord0)). + exact: normr_ge0. +move=> [i j] _. +rewrite -(row_mxEr A1). +exact: (le_bigmax _ _ (i, rshift n1.+1 j)). +Qed. -Lemma derive_sqrt {K : realType} (r : K) : 0 < r -> - (Num.sqrt^`())%classic r = (2 * Num.sqrt r)^-1 :> K. +(*Todo: This also seems useful in general (PR) *) +Lemma mx_norm_mul {K : rcfType} {m n p} (A : 'M[K]_(m.+1, n.+1)) (B : 'M_(n.+1, p.+1)) : + `|A *m B| <= n.+1%:R * `| A| * `|B|. Proof. -move=> r0. -rewrite derive1E. -apply: derive_val. -exact: is_derive1_sqrt. +rewrite /Num.norm/= !mx_normrE. +apply: bigmax_le. + rewrite -mulrA mulr_ge0//. + by apply mulr_ge0; apply/le_trans/(le_bigmax _ _ (ord0, ord0)). +move=> /= [i j] _/=. +rewrite mxE. +rewrite (le_trans (ler_norm_sum _ _ _))//=. +have le_inside k : `|A i k * B k j| <= `|A| * `|B|. + rewrite normrM /Num.norm/= !mx_normrE/= ler_pM//=. + - exact: normr_ge0. + - exact: normr_ge0. + - exact: (le_bigmax _ _ (i, k)). + - exact: (le_bigmax _ _ (k, j)). +rewrite -mulrA. +rewrite (@le_trans _ _ (\sum_(k < n.+1) `|A| * `|B|))//. + by apply: ler_sum => k _; apply le_inside. +rewrite mulr_natl. +rewrite big_const_ord. +rewrite iter_addr_0. +by rewrite /Num.norm/= !mx_normrE. Qed. Lemma differentiable_scalar_mx {R : realType} n (r : R) : @@ -68,7 +77,6 @@ Proof. apply/derivable1_diffP/cvg_ex => /=. exists 1; apply/cvgrPdist_le => /= e e0. near=> t. -Search (_%:A). rewrite scaler1 -raddfB/= addrK (scale_scalar_mx _ t^-1) mulVf. by rewrite subrr normr0 ltW. by near: t; exact: nbhs_dnbhs_neq. @@ -105,11 +113,11 @@ rewrite dotmulP mxE /= mulr1n derive_dotmul// dotmulC. by field. Qed.*) -Lemma derivable_sqrt {K: realType} (u : K) : u > 0 -> derivable Num.sqrt (u) 1. +Lemma derivable_sqrt {K: realType} (u : K) : u > 0 -> derivable Num.sqrt u 1. Proof. -move => gt0. +move=> u0. apply: ex_derive. -by apply: (is_derive1_sqrt gt0). +exact: (is_derive1_sqrt u0). Qed. (* should go to tilt_robot*) (*Lemma differentiable_norm {K : realType} m n (f : 'rV[K]_m -> 'rV_n) @@ -135,56 +143,14 @@ exact: differentiable_dotmul. Qed.*) (* this one too *) -(*DONE*) -Lemma differentiable_rsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : - differentiable (@rsubmx R 1 n1 n2) t. -Proof. -have lin_rsubmx : linear (@rsubmx R 1 n1 n2). - move=> a b c. - by rewrite linearD//= linearZ. -pose build_lin_rsubmx := GRing.isLinear.Build _ _ _ _ _ lin_rsubmx. -pose Rsubmx : {linear 'rV[R^o]_(n1 + n2) -> 'rV[R^o]_n2} := HB.pack (@rsubmx R _ _ _) build_lin_rsubmx. -apply: (@linear_differentiable _ _ _ Rsubmx). -move=> /= u A /=. -move/nbhs_ballP=> [e /= e0 eA]. -apply/nbhs_ballP; exists e => //= v [? uv]. -apply: eA; split => //. -(* TODO: lemma *) -move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. -apply: (le_lt_trans _ (uv i (rshift n1 j))). -by rewrite !mxE. -Qed. -(*DONE*) - -Lemma differentiable_rsubmx {R : realFieldType} (V : normedModType R) {n1 n2} +Lemma differentiable_rsubmx_comp {R : realFieldType} (V : normedModType R) {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t : (forall x, differentiable f x) -> differentiable (fun x => rsubmx (f x)) t. Proof. -move=> /= => df1. +move=> /= df1. apply: differentiable_comp => //. -exact: differentiable_rsubmx0. -Qed. - -(*DONE*) -Lemma differentiable_lsubmx0 {R : realFieldType} {V : normedModType R} {n1 n2} t : - differentiable (@lsubmx R 1 n1 n2) t. -Proof. -have lin_lsubmx : linear (@lsubmx R 1 n1 n2). - move=> a b c. - by rewrite linearD//= linearZ. -pose build_lin_lsubmx := GRing.isLinear.Build _ _ _ _ _ lin_lsubmx. -pose Lsubmx : {linear 'rV[R^o]_(n1 + n2) -> 'rV[R^o]_n1} := - HB.pack (@lsubmx R _ _ _) build_lin_lsubmx. -apply: (@linear_differentiable _ _ _ Lsubmx). -move=> /= u A /=. -move/nbhs_ballP=> [e /= e0 eA]. -apply/nbhs_ballP; exists e => //= v [? uv]. -apply: eA; split => //. -(* TODO: lemma *) -move: uv; rewrite /ball/= /mx_ball/ball /= => uv i j. -apply: (le_lt_trans _ (uv i (lshift n2 j))). -by rewrite !mxE. +exact: differentiable_rsubmx. Qed. (*Global Instance is_diff_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} @@ -204,15 +170,14 @@ rewrite -[in RHS]deriveE; last first. rewrite derive_lsubmx//. Abort.*) -(*DONE*) -Lemma differentiable_lsubmx {R : realFieldType} (V : normedModType R) {n1 n2} +Lemma differentiable_lsubmx_comp {R : realFieldType} (V : normedModType R) {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t : (forall x, differentiable f x) -> differentiable (fun x => lsubmx (f x)) t. Proof. -move=> /= => df1. +move=> /= df1. apply: differentiable_comp => //. -exact: differentiable_lsubmx0. +exact: differentiable_lsubmx. Qed. (*Lemma derivable_row_mx {R : realFieldType} {n1 n2 : nat} @@ -296,3 +261,87 @@ move: jE. rewrite jj1 => /(congr1 val) => /= /eqP. by rewrite eqn_add2l => /eqP /val_inj. Qed.*) + +Local Open Scope classical_set_scope. + +Lemma within_continuous_comp {R : realType} {K : numDomainType} + {U : pseudoMetricNormedZmodType K} a y (g : U -> R) (f : R -> U) : + a <= y -> + {in f @` `[a, y], continuous g} -> + {within `[a, y], continuous (fun x => f x)} -> + {within `[a, y], continuous fun x => (g \o f) x}. +Proof. +rewrite le_eqVlt => /predU1P[<- _ _|ay cg]. + by rewrite set_itv1; exact: continuous_subspace1. +move/(continuous_within_itvP f ay) => -[cf fa fy]. +apply/continuous_within_itvP => //; split => //. +- move=> z zay; apply: continuous_comp => //. + exact: cf. + apply/cg/image_f. + by rewrite inE/=; apply: subset_itv_oo_cc zay. +- apply/(cvg_comp f g fa)/cg/image_f. + by rewrite inE/= in_itv/= lexx/= ltW. +- apply/(cvg_comp f g fy)/cg/image_f. + by rewrite inE/= in_itv/= lexx/= ltW. +Qed. + +Local Notation Left := (@lsubmx _ 1 _ _). +Local Notation Right := (@rsubmx _ 1 _ _). + +Lemma left_norm_le {K : rcfType} n1 n2 (x : 'rV[K]_(n1.+1 + n2.+1)) : + `|Left x| <= `|x|. +Proof. +rewrite /Num.norm/= !mx_normrE; apply: bigmax_le. + exact/le_trans/(le_bigmax _ _ (ord0, ord0)). +move=> /= [i j] _ /=. +rewrite mxE. +exact: (le_bigmax _ _ (i, lshift n2.+1 j)). +Qed. + +Lemma right_norm_le {K : rcfType} n1 n2 (x : 'rV[K]_(n1.+1 + n2.+1)) : + `|Right x| <= `|x|. +Proof. +rewrite /Num.norm/= !mx_normrE; apply: bigmax_le. + exact/le_trans/(le_bigmax _ _ (ord0,ord0)). +move=> /= [i j] _ /=. +rewrite mxE. +exact: (le_bigmax _ _ (i, rshift n1.+1 j)). +Qed. + +Lemma mx_norm1 {K : rcfType} {n} : `|1 : 'M[K]_n.+1| = 1. +Proof. +rewrite /Num.norm/= !mx_normrE. +apply/eqP; rewrite eq_le; apply/andP; split. +- apply: bigmax_le => //= i _. + rewrite mxE/=. + by case: eqP => /= _; rewrite ?(normr1, normr0). +- rewrite -normr1. + have -> : (1 : K) = ((1 : 'M[K]_n.+1) ord0 ord0) by rewrite mxE. + exact: (le_bigmax _ _ (ord0, ord0)). +Qed. + +Lemma mx_norm_delta_mx {K : rcfType} n (i : 'I_n.+1) : `| 'e_i : 'rV[K]__ | <= 1. +Proof. +rewrite /Num.norm /= mx_normrE; apply: bigmax_le => //= -[/= a b] _. +rewrite mxE /=. +case: eqP => /= _; last by rewrite normr0. +case: eqP => /= _; last by rewrite normr0. +by rewrite normr1. +Qed. + +Lemma enorm_mxnorm {K : rcfType} {n} (x : 'rV[K]_n.+1) : + `|x|_e ^+ 2 <= n.+1%:R * `|x| ^ 2. +Proof. +rewrite sqr_enorm /=. +apply : (@le_trans _ _ (\sum_(i0 < n.+1) `|x| ^+ 2)). + apply: ler_sum => k _. + rewrite -sqr_normr. + suff h : `|x ord0 k| <= `|x| by exact: ler_pM. + rewrite {2}/Num.norm/= !mx_normrE /=. + exact: (le_bigmax _ _ (ord0, k)). +by rewrite big_const_ord mulr_natl iter_addr_0. +Qed. + +Lemma mx_norm_sq_le {K : rcfType} {n} (A : 'M[K]_n.+1) : + `|A ^+ 2| <= n.+1%:R * `|A| ^+ 2. +Proof. by rewrite !expr2 mulrA; exact: mx_norm_mul. Qed. diff --git a/tilt_mathcomp.v b/tilt_mathcomp.v index 3eeca902..f7eb01d5 100644 --- a/tilt_mathcomp.v +++ b/tilt_mathcomp.v @@ -1,4 +1,4 @@ -From mathcomp Require Import all_ssreflect all_algebra ring. +From mathcomp Require Import all_boot all_order all_algebra ring. Require Import ssr_ext euclidean rigid frame skew. Set Implicit Arguments. @@ -8,40 +8,7 @@ Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Def Num.Theory. Local Open Scope ring_scope. -(* to appear in MathComp 2.5.0 *) -Lemma lsubmx_const {R : nmodType} (r : R) m n1 n2 : - lsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. -Proof. by apply/matrixP => i j; rewrite !mxE. Qed. - -(* to appear in MathComp 2.5.0 *) -Lemma rsubmx_const {R : nmodType} (r : R) m n1 n2 : - rsubmx (const_mx r : 'M_(m, n1 + n2)) = const_mx r. -Proof. by apply/matrixP => i j; rewrite !mxE. Qed. - Lemma sqr_inj {R : rcfType} : {in Num.nneg &, injective (fun x : R => x ^+ 2)}. Proof. by move=> x y x0 y0 /(congr1 (@Num.sqrt R)); rewrite !sqrtr_sqr! ger0_norm. Qed. - -(* PR to MathComp *) -(* det_mx22 depend de robot*) -(*Lemma char_poly2 (R : numFieldType) (M : 'M[R]_2) : char_poly M = 'X^2 - (\tr M)%:P * 'X + (\det M)%:P. -Proof. -set P := (RHS). -apply/polyP => -[|[|[|i]]]; last first. -- have := (rwP (leq_sizeP (char_poly M) i.+3)).2. - rewrite size_char_poly => /(_ erefl) /(_ i.+3) => ->//. - rewrite (rwP (leq_sizeP P i.+3)).2//. - rewrite /P -addrA size_addl ?size_polyXn//. - rewrite -mulNr size_MXaddC; case: ifPn => // _. - by rewrite ltnS -polyCN size_polyC; case: (_ == _). -- rewrite /P -[in RHS]addrA [RHS]coefD coefXn/= coefD -mulrN coefCM coefC/= coefN coefX/= oppr0 mulr0 !addr0. - rewrite /char_poly det_mx22//. - rewrite /char_poly_mx !mxE/= mulr1n mulr0n sub0r mulNr opprK sub0r mulrN. - rewrite coefD coefN coefCM coefC/= mulr0 subr0. - by rewrite coefM sum3E !coefE/= !(subr0,mul0r,mulr0,addr0,mulr1,add0r). -- rewrite char_poly_trace//. - by rewrite /P -addrA addrCA !coefD coefN coefCM coefX/= mulr1 coefC/= addr0 coefXn addr0. -- rewrite char_poly_det sqrrN expr1n mul1r. - by rewrite /P !coefD coefC/= coefN coefCM coefX mulr0 subr0 coefXn/= add0r. -Qed.*) diff --git a/tilt_robot.v b/tilt_robot.v index 5a12a046..12fd4b2a 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -1,5 +1,5 @@ From HB Require Import structures. -From mathcomp Require Import all_ssreflect all_algebra ring. +From mathcomp Require Import all_boot all_order all_algebra ring. From mathcomp Require Import interval_inference. From mathcomp Require Import boolp classical_sets functions reals. From mathcomp Require Import topology normedtype derive. @@ -13,6 +13,66 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. +(* see Appendix VII.A of + https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) +Section basic_facts. +Variable K : realType. + +Lemma fact212 (v w : 'rV[K]_3) : \S(v) * \S(w) = w^T *m v - (v *m w^T)``_0 *: 1. +Proof. +apply/matrix3P/and9P; split; apply/eqP; rewrite !(mxE,sum3E,spinij,sum1E); Simp.r. + ring. +by rewrite mulrC. +by rewrite mulrC. +by rewrite mulrC. +by rewrite !opprD; ring. +by rewrite mulrC. +by rewrite mulrC. +by rewrite mulrC. +by rewrite !opprD; ring. +Qed. + +Lemma fact213 (v w : 'rV[K]_3) : \S(v) * \S(w) * \S(v) = - (v *m w^T) ``_0 *: \S(v). +Proof. +rewrite fact212 mulrBl -mulmxE -mulmxA; have: v *m \S(v) = 0. + apply: trmx_inj. + by rewrite trmx_mul tr_spin mulNmx spin_mul_tr trmx0 oppr0. +move => ->. +by rewrite mulmx0 sub0r -mul_scalar_mx -mulNmx; congr (_ *m _); rewrite scalemx1 rmorphN. +Qed. + +Lemma fact215 ( v w : 'rV[K]_3) : \S(w *m \S(v)) = \S(w) * \S(v) - \S(v) * \S(w). +Proof. +by rewrite spinE spin_crossmul. +Qed. + +Lemma fact216 (v w : 'rV[K]_3): \S(w *m \S(v)) = v^T *m w - w^T *m v. +Proof. +by rewrite fact215 !fact212 -!/(_ *d _) dotmulC opprB addrA subrK. +Qed. +Lemma fact217 (v : 'rV[K]_3): \S(v) ^+ 3 = - (`|v|_e ^+2) *: \S(v). + exact: spin3. +Qed. + +Lemma fact214 (R : 'M[K]_3) (v_ : seq 'rV[K]_3) : R \is 'SO[K]_3 -> + R^T * (\prod_(i <- v_) \S( i )) * R = (\prod_(i <- v_) \S( i *m R)). +Proof. +move => RSO. +elim/big_ind2 : _ => //. + by rewrite -!mulmxE mulmx1 rotation_tr_mul. +- move => a b c d H1 H2. + rewrite -H1 // -H2 // -!mulmxE -!rotation_inv // !mulmxA -[R^-1 *m b *m R *m R^-1]mulmxA. + rewrite mulmxV; last first. + rewrite unitmxE. + apply: orthogonal_unit. + exact: rotation_sub. + by rewrite -[R^-1 *m b *m 1%:M *m d]mulmxA mul1mx. +- move => i true. + exact: spin_similarity. +Qed. + +End basic_facts. + (* spin and matrix/norm properties *) Lemma tr_sqr_spin {R : realFieldType} (u : 'rV[R]_3) : @@ -22,8 +82,29 @@ Proof. by apply/esym/eqP; rewrite -symE; exact: sqr_spin_is_sym. Qed. Lemma mul_tr_spin {R : comNzRingType} (u : 'rV[R]_3) : u *m \S(u)^T = 0. Proof. by apply: trmx_inj; rewrite trmx_mul trmxK spin_mul_tr trmx0. Qed. -Lemma CauchySchwarz_vec {R : rcfType} {n : nat} (a b : 'rV[R]_n) : - (a *d b)^+2 <= (a *d a) * (b *d b). +Lemma norm_spin {R : rcfType} (u : 'rV[R]_3) (v : 'rV[R]_3) : + (u *m \S(v - u) ^+ 2 *m (u)^T) 0 0 = - `|u *m \S(v)|_e ^+ 2. +Proof. +rewrite spinD spinN -tr_spin mulmxA !mulmxDr mulmxDl !mul_tr_spin !addr0. +rewrite -dotmulvv /dotmul trmx_mul. +rewrite mxE [X in _ + X = _](_ : _ = 0) ?addr0; last first. + by rewrite tr_spin -mulmxA mulNmx spin_mul_tr mulmxN mulmx0 oppr0 mxE. +by rewrite tr_spin mulNmx mulmxN [in RHS]mxE opprK mulmxA. +Qed. + +Lemma sqr_spin {R : rcfType} (u : 'rV[R]_3) (norm_u1 : `|u|_e = 1) : + \S(u) *m \S(u) = u^T *m u - 1%:M. +Proof. +have sqrspin : \S(u) ^+ 2 = u^T *m u - (`|u|_e ^+ 2)%:A by rewrite sqr_spin. +rewrite expr2 norm_u1 expr2 mulr1 in sqrspin. +rewrite mulmxE sqrspin. + apply/matrixP => i j ; rewrite mxE /= [in RHS]mxE /=. + congr (_+_); rewrite mxE mxE /= mul1r. + by rewrite [in RHS]mxE [in RHS]mxE /= -mulNrn mxE -mulNrn. +Qed. + +Lemma CauchySchwarz_rV {R : rcfType} {n : nat} (a b : 'rV[R]_n) : + (a *d b) ^+ 2 <= (a *d a) * (b *d b). Proof. suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. rewrite subr_ge0. @@ -31,64 +112,57 @@ suffices: 0 <= (b *d b) * (a *d a) - (a *d b) ^+ 2. rewrite subr_ge0 expr2 mulrC !dotmulvv /= -expr2. have [->|hb] := eqVneq b 0. rewrite dotmulv0 expr0n. - rewrite norm0. - rewrite expr0n mul0r //=. -pose t := (a *d b) / (norm b ^+ 2). -have h : 0 <= norm (a - t *: b) ^+ 2. - rewrite exprn_ge0 //. - by rewrite norm_ge0. + rewrite enorm0. + by rewrite expr0n mul0r. +pose t := (a *d b) / (`|b|_e ^+ 2). +have h : 0 <= `|a - t *: b|_e ^+ 2. + by rewrite exprn_ge0// enorm_ge0. rewrite -(dotmulvv (a - t *: b)) in h. rewrite dotmulBl dotmulBr dotmulvv in h. rewrite dotmulvZ in h. rewrite -dotmulvv in h. rewrite /t in h. -have h1 : 0 <= a *d a - (a *d b) ^+ 2 / norm b ^+ 2. +have h1 : 0 <= a *d a - (a *d b) ^+ 2 / `|b|_e ^+ 2. move: h. rewrite dotmulBr dotmulvZ. - rewrite (dotmulC ((a *d b / norm b ^+ 2) *: b) a). + rewrite (dotmulC ((a *d b / `|b|_e ^+ 2) *: b) a). rewrite dotmulvZ dotmulC dotmulvv /t expr2 -!expr2 dotmulZv dotmulvv. rewrite divfK /=; last first. - by rewrite sqrf_eq0 norm_eq0. + by rewrite sqrf_eq0 enorm_eq0. by rewrite subrr subr0 !expr2 mulrAC. -have h2 : 0 <= norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. - have pos: 0 < norm b ^+ 2. - by rewrite exprn_gt0 // norm_gt0. - suff: norm b ^+ 2 * (a *d a - (a *d b) ^+ 2 / norm b ^+ 2) = - norm b ^+ 2 * (a *d a) - (a *d b) ^+ 2. +have h2 : 0 <= `|b|_e ^+ 2 * (a *d a) - (a *d b) ^+ 2. + have pos: 0 < `|b|_e ^+ 2. + by rewrite exprn_gt0// enorm_gt0. + suff: `|b|_e ^+ 2 * (a *d a - (a *d b) ^+ 2 / `|b|_e ^+ 2) = + `|b|_e ^+ 2 * (a *d a) - (a *d b) ^+ 2. move=> eq_step. rewrite -eq_step. by apply: mulr_ge0; [rewrite ltW | exact h1]. rewrite mulrBr. congr (_ - _)%R. - by rewrite mulrCA divff ?mulr1// sqrf_eq0 norm_eq0. + by rewrite mulrCA divff ?mulr1// sqrf_eq0 enorm_eq0. rewrite -subr_ge0 mulrC. by rewrite dotmulvv mulrC in h2. Qed. (* not used *) -Lemma young_inequality_vec {R : rcfType} {n : nat} (a b : 'rV[R]_n) : - (a *d b) <= (2^-1 * (norm a)^+2) + (2^-1 * (norm b)^+2). +Lemma Young_inequality_rV {R : rcfType} {n : nat} (a b : 'rV[R]_n) : + (a *d b) <= (2^-1 * (`|a|_e) ^+ 2) + (2^-1 * `|b|_e ^+ 2). Proof. -have normage0 : 0 <= (norm a)^+2. - rewrite expr2. - by rewrite mulr_ge0 // norm_ge0. -have normbge0 : 0 <= (norm(b))^+2. - rewrite expr2. - by rewrite mulr_ge0 // norm_ge0. +have normage0 : 0 <= `|a|_e ^+ 2 by rewrite sqr_ge0. +have normbge0 : 0 <= `|b|_e ^+ 2 by rewrite sqr_ge0. rewrite -!dotmulvv. -have: 0 <= norm(a - b)^+2. - rewrite expr2. - by rewrite mulr_ge0 // norm_ge0. +have: 0 <= `|a - b|_e ^+ 2 by rewrite sqr_ge0. rewrite -dotmulvv dotmulD !dotmulvv. move => h. rewrite -mulr_natl in h. -have h2 : 2 * (a *d b) <= norm a ^+ 2 + norm (- b) ^+ 2. +have h2 : 2 * (a *d b) <= `|a|_e ^+ 2 + `|- b|_e ^+ 2. rewrite -subr_ge0. rewrite dotmulvN mulrN in h. by rewrite addrAC. rewrite -ler_pdivlMl// in h2. rewrite -mulrDr. -by rewrite normN in h2. +by rewrite enormN in h2. Qed. Lemma dotmulspin1 {R : numFieldType} (u : 'rV[R]_3) (v : 'rV[R]_3) : @@ -112,7 +186,7 @@ Lemma ortho_spin {R : numFieldType} (u : 'rV[R]_3) (v : 'rV[R]_3) : Proof. by rewrite dotmulBl dotmulC dotmulspin1 dotmulC dotmulspin2 subr0. Qed. Lemma norm_squared {R : rcfType} n (u : 'rV[R]_n) : - (u *m (u)^T) 0 0 = norm u ^+2. + (u *m u^T) 0 0 = `|u|_e ^+ 2. Proof. by rewrite -dotmulvv /dotmul. Qed. Global Instance is_diff_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} @@ -122,24 +196,15 @@ Global Instance is_diff_rsubmx {R : realFieldType} {V : normedModType R} {n1 n2} Proof. case=> diff_f dfE. apply: DiffDef. - by apply: differentiable_comp => //; exact: differentiable_rsubmx0. + by apply: differentiable_comp => //; exact: differentiable_rsubmx. apply/funext => v. rewrite -dfE. rewrite -[LHS]deriveE; last first. - by apply: differentiable_comp => //; exact: differentiable_rsubmx0. + by apply: differentiable_comp => //; exact: differentiable_rsubmx. rewrite -[in RHS]deriveE; last first. by []. rewrite derive_rsubmx//. -Abort. - -Lemma differentiable_rsubmx_comp {R : realFieldType} (V : normedModType R) {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t : - (forall x, differentiable f x) -> - differentiable (fun x => rsubmx (f x)) t. -Proof. -move=> /= => df1. -apply: differentiable_comp => //. -exact: differentiable_rsubmx. +by apply: diff_derivable. Qed. (*Global Instance is_diff_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} @@ -159,16 +224,6 @@ rewrite -[in RHS]deriveE; last first. rewrite derive_lsubmx//. Abort.*) -Lemma differentiable_lsubmx_comp {R : realFieldType} (V : normedModType R) {n1 n2} - (f : V -> 'rV[R]_(n1 + n2)) t : - (forall x, differentiable f x) -> - differentiable (fun x => lsubmx (f x)) t. -Proof. -move=> /= => df1. -apply: differentiable_comp => //. -exact: differentiable_lsubmx0. -Qed. - Lemma derivable_row_mx {R : realFieldType} {n1 n2 : nat} (f : R -> 'rV[R]_n1) (g : R -> 'rV[R]_n2) t v : (forall x, derivable f x v) -> (forall x, derivable g x v) -> @@ -238,7 +293,7 @@ apply/polyP => -[|[|[|i]]]; last first. - have := (rwP (leq_sizeP (char_poly M) i.+3)).2. rewrite size_char_poly => /(_ erefl) /(_ i.+3) => ->//. rewrite (rwP (leq_sizeP P i.+3)).2//. - rewrite /P -addrA size_addl ?size_polyXn//. + rewrite /P -addrA size_polyDl ?size_polyXn//. rewrite -mulNr size_MXaddC; case: ifPn => // _. by rewrite ltnS -polyCN size_polyC; case: (_ == _). - rewrite /P -[in RHS]addrA [RHS]coefD coefXn/= coefD -mulrN coefCM coefC/= coefN coefX/= oppr0 mulr0 !addr0. @@ -252,21 +307,21 @@ apply/polyP => -[|[|[|i]]]; last first. by rewrite /P !coefD coefC/= coefN coefCM coefX mulr0 subr0 coefXn/= add0r. Qed. -Lemma differentiable_norm {K : realType} m n (f : 'rV[K]_m -> 'rV_n) +Lemma differentiable_enorm {K : realType} m n (f : 'rV[K]_m -> 'rV_n) (g : K -> 'rV[K]_m) t : differentiable f (g t) -> f (g t) != 0 -> - differentiable (fun x => norm (f x)) (g t) . + differentiable (fun x => `|f x|_e) (g t) . Proof. -move=> fgt fgt0; rewrite /norm -fctE. +move=> fgt fgt0; rewrite /enorm -fctE. apply: differentiable_comp. exact: differentiable_dotmul. apply/derivable1_diffP/derivable_sqrt. -by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0. +by rewrite dotmulvv expr2 mulr_gt0 //= !enorm_gt0. Qed. -Lemma derivable_norm_squared {K : realType} n (f : K -> 'rV[K]_n) (x0 : K) : +Lemma derivable_enorm_squared {K : realType} n (f : K -> 'rV[K]_n) (x0 : K) : derivable f x0 1 -> - derivable (fun x => norm (f x) ^+ 2) x0 1. + derivable (fun x => `|f x|_e ^+ 2) x0 1. Proof. move => dif1. apply/diff_derivable. @@ -284,10 +339,9 @@ apply/derivable1_diffP. by apply/derivable_coord => //. Qed. -Lemma derive_norm_squared {K : realType} n (u : K -> 'rV[K]_n) (t : K) : +Lemma derive_enorm_squared {K : realType} n (u : K -> 'rV[K]_n) (t : K) : derivable u t 1 -> - 'D_1 (fun x => norm (u x) ^+ 2) t = - 2 * ('D_1 u t *d u t). + 'D_1 (fun x => `|u x|_e ^+ 2) t = 2 * ('D_1 u t *d u t). Proof. move=> ut1. under eq_fun do rewrite -dotmulvv. @@ -295,12 +349,51 @@ rewrite derive_dotmul// dotmulC. by field. Qed. -Lemma differentiable_norm_squared {R : rcfType} m n +Lemma differentiable_enorm_squared {R : rcfType} m n (f : 'rV[R]_m -> 'rV[R]_n) (v : 'rV[R]_m) : differentiable f v -> - differentiable (fun x => norm (f x) ^+ 2) v. + differentiable (fun x => `|f x|_e ^+ 2) v. Proof. move=> dif1. under eq_fun do rewrite -dotmulvv. exact: differentiable_dotmul. Qed. + +Lemma spin_le_norm {K : rcfType} (x : 'rV[K]_3) : `|\S(x)| <= `|x|. +Proof. +rewrite {1}/Num.norm/= !mx_normrE. +apply: bigmax_le; first exact: normr_ge0. +move=> /= [i j] _/=. +by have [->|->|->] := I3_cases i; have [->|->|->] := I3_cases j; + rewrite ?(spinij,normr0,normrN)// /Num.norm/= mx_normrE; + exact: (le_bigmax _ _ (0, _)). +Qed. + +Lemma spin_sq_norm_bound {K : rcfType} (x : 'rV[K]_3) : `|\S(x) ^+ 2| <= 3 * `|x|^+2. +Proof. +rewrite (le_trans (mx_norm_sq_le _))// ler_pM//. +suff h : `|\S(x)| <= `|x| by apply: ler_pM. +exact: spin_le_norm. +Qed. + +Lemma spin_sq_dist_bound {K : rcfType} (x y: 'rV[K]_3) : + `|\S(x)^+2 - \S(y)^+2| <= 3 * (`|x| +`|y|) * `|x-y|. +Proof. +have -> : \S(x) ^+ 2 - \S(y) ^+ 2 = \S(x) *m (\S(x) - \S(y)) + (\S(x) - \S(y)) *m \S(y). + by rewrite mulmxBr mulmxBl addrA subrK. +rewrite mulrDr mulrDl. +apply: (le_trans (ler_normD _ _)). +rewrite -spinN -spinD. +apply: lerD. + apply: (le_trans (mx_norm_mul _ _)). + apply : ler_pM => //. + apply : ler_pM => //. + exact: spin_le_norm. + exact: spin_le_norm. +rewrite -mulrA (mulrC `|y|) mulrA. +apply: (le_trans (mx_norm_mul _ _)). +apply : ler_pM => //. + apply : ler_pM => //. + exact: spin_le_norm. +exact: spin_le_norm. +Qed. diff --git a/vec_angle.v b/vec_angle.v index 38773e6e..fe0452cf 100644 --- a/vec_angle.v +++ b/vec_angle.v @@ -1,5 +1,5 @@ (* coq-robot (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) -From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat poly. +From mathcomp Require Import all_boot all_order ssralg ssrint ssrnum rat poly. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. From mathcomp Require Import sesquilinear. From mathcomp Require Import realalg complex fingroup perm reals interval trigo. @@ -46,8 +46,8 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Local Open Scope ring_scope. -Lemma norm_le1 [T : rcfType] (u : 'rV[T]_2) : - norm u <= 1 -> (- 1 <= u``_ 0 <= 1) /\ (- 1 <= u``_1 <= 1). +Lemma enorm_le1 [T : rcfType] (u : 'rV[T]_2) : + `| u |_e <= 1 -> (- 1 <= u``_ 0 <= 1) /\ (- 1 <= u``_1 <= 1). Proof. move=> nuL1; rewrite -!ler_norml. rewrite -!(expr_le1 (_ : 0 < 2)%N (normr_ge0 _)) //. @@ -56,22 +56,22 @@ suff sL1 : `|u``_0| ^+ 2 + `|u``_1| ^+ 2 <= 1. by rewrite -[X in X <= _]addr0 lerD // sqr_ge0. by rewrite -[X in X <= _]add0r lerD // sqr_ge0. rewrite !sqr_normr //. -suff : norm u ^+ 2 <= 1 by rewrite sqr_norm sum2E. -by apply: exprn_ile1 (norm_ge0 _) _. +suff : `| u |_e ^+ 2 <= 1 by rewrite sqr_enorm sum2E. +by apply: exprn_ile1 (enorm_ge0 _) _. Qed. -Lemma norm1_cossin (T : realType) (v : 'rV[T]_2) : - norm v = 1 -> {a | v``_0 = cos a /\ v``_1 = sin a}. +Lemma enorm1_cossin (T : realType) (v : 'rV[T]_2) : + `| v |_e = 1 -> {a | v``_0 = cos a /\ v``_1 = sin a}. Proof. move=> nvE. exists (if 0 <= v``_1 then acos v``_0 else -acos v``_0). -have /norm_le1[v0B v1B] : norm v <= 1 by rewrite nvE. +have /enorm_le1[v0B v1B] : `| v |_e <= 1 by rewrite nvE. have [v0_ge0|v0_gt0] := leP 0%R (v``_1). rewrite acosK ?in_itv //= sin_acos ?in_itv //=. - rewrite -(expr1n T 2) -nvE sqr_norm sum2E [_ + _^+2] addrC addrK. + rewrite -(expr1n T 2) -nvE sqr_enorm sum2E [_ + _^+2] addrC addrK. by rewrite sqrtr_sqr ger0_norm. rewrite cosN sinN acosK ?in_itv //= sin_acos ?in_itv //=. -rewrite -(expr1n T 2) -nvE sqr_norm sum2E [_ + _^+2] addrC addrK. +rewrite -(expr1n T 2) -nvE sqr_enorm sum2E [_ + _^+2]addrC addrK. by rewrite sqrtr_sqr ltr0_norm ?opprK. Qed. @@ -81,7 +81,7 @@ Implicit Types u v : 'rV[T]_3. Definition vec_angle v w : T := if v == 0 then 0 else - if w == 0 then 0 else acos (v *d w / (norm v * norm w)). + if w == 0 then 0 else acos (v *d w / (`| v |_e * `| w |_e)). Lemma vec_anglev0 v : vec_angle v 0 = 0. Proof. by rewrite /vec_angle eqxx if_same. Qed. @@ -93,14 +93,14 @@ Definition vec_angle0 := (vec_anglev0, vec_angle0v). Lemma vec_angleC v w : vec_angle v w = vec_angle w v. Proof. -by rewrite /vec_angle dotmulC [norm _ * _]mulrC; do 2 case: eqP. +by rewrite /vec_angle dotmulC [`| _ |_e * _]mulrC; do 2 case: eqP. Qed. Lemma vec_anglevZ u v k : 0 < k -> vec_angle u (k *: v) = vec_angle u v. Proof. move=> k_gt0; rewrite /vec_angle; case: eqP => // /eqP u0. rewrite scaler_eq0 (negPf (lt0r_neq0 _)) //=. -rewrite dotmulvZ normZ gtr0_norm // mulrCA -mulf_div divff ?mul1r //. +rewrite dotmulvZ enormZ gtr0_norm // mulrCA -mulf_div divff ?mul1r//. by rewrite lt0r_neq0. Qed. @@ -111,7 +111,7 @@ Lemma vec_anglevZN u v k : k < 0 -> vec_angle u (k *: v) = vec_angle u (- v). Proof. move=> k_lt0; rewrite /vec_angle; case: eqP => // /eqP u0. rewrite scaler_eq0 (negPf (ltr0_neq0 _)) //= oppr_eq0. -rewrite dotmulvZ normZ ltr0_norm // normN dotmulvN mulrCA -mulf_div. +rewrite dotmulvZ enormZ ltr0_norm// enormN dotmulvN mulrCA -mulf_div. rewrite invrN mulrN divff ?(mulN1r, mulNr) //. by rewrite ltr0_neq0. Qed. @@ -123,24 +123,24 @@ Lemma vec_anglevv u : u != 0 -> vec_angle u u = 0. Proof. move=> u0. rewrite /vec_angle /= (negPf u0) dotmulvv -expr2 divff ?acos1 //. -by rewrite expf_eq0 //= norm_eq0. +by rewrite expf_eq0 //= enorm_eq0. Qed. Lemma dotmul_div_N11 v w : - v != 0 -> w != 0 -> v *d w / (norm v * norm w) \in `[(-1), 1]. + v != 0 -> w != 0 -> v *d w / (`| v |_e * `| w |_e) \in `[(-1), 1]. Proof. move=> u0 v0. rewrite in_itv /= -ler_norml -(expr_le1 (_ : 0 < 2)%N) //. rewrite sqr_normr expr_div_n ler_pdivrMr ?mul1r. -rewrite -subr_ge0 -norm_crossmul' ?exprn_ge0 ?norm_ge0 //. -by rewrite exprn_gt0 // mulr_gt0 // norm_gt0. +rewrite -subr_ge0 -enorm_crossmul' ?exprn_ge0 ?enorm_ge0//. +by rewrite exprn_gt0// mulr_gt0// enorm_gt0. Qed. Lemma cos_vec_angleNv v w : v != 0 -> w != 0 -> cos (vec_angle (- v) w) = - cos (vec_angle v w). Proof. move=> u0 v0. -rewrite /vec_angle oppr_eq0 (negPf u0) (negPf v0) normN dotmulNv mulNr. +rewrite /vec_angle oppr_eq0 (negPf u0) (negPf v0) enormN dotmulNv mulNr. have H := dotmul_div_N11 u0 v0. by rewrite !acosK ?oppr_itvcc ?opprK. Qed. @@ -164,21 +164,21 @@ Proof. rewrite /vec_angle oppr_eq0; case: eqP => [//|/eqP uD0]. case: eqP => [//|/eqP vD0]. have H := dotmul_div_N11 uD0 vD0; rewrite in_itv in H. -rewrite normN dotmulvN mulNr !sin_acos ?sqrrN //. +rewrite enormN dotmulvN mulNr !sin_acos ?sqrrN//. by rewrite lerNr opprK lerNl andbC. Qed. Lemma sin_vec_angleNv u v : sin (vec_angle (- u) v) = sin (vec_angle u v). Proof. by rewrite vec_angleC [in RHS]vec_angleC [in LHS]sin_vec_anglevN. Qed. -Lemma dotmul_cos u v : u *d v = norm u * norm v * cos (vec_angle u v). +Lemma dotmul_cos u v : u *d v = `| u |_e * `| v |_e * cos (vec_angle u v). Proof. wlog /andP[u0 v0] : u v / (u != 0) && (v != 0). - case/boolP : (u == 0) => [/eqP ->{u}|u0]; first by rewrite dotmul0v norm0 !mul0r. - case/boolP : (v == 0) => [/eqP ->{v}|v0]; first by rewrite dotmulv0 norm0 !(mulr0,mul0r). - apply; by rewrite u0. -rewrite /vec_angle (negPf u0) (negPf v0) acosK; last by apply: dotmul_div_N11. -by rewrite mulrC divfK // mulf_eq0 negb_or !norm_eq0 u0. + have [->|u0] := eqVneq u 0; first by rewrite dotmul0v enorm0 !mul0r. + have [->|v0] := eqVneq v 0; first by rewrite dotmulv0 enorm0 !(mulr0,mul0r). + by apply; rewrite u0. +rewrite /vec_angle (negPf u0) (negPf v0) acosK; last exact: dotmul_div_N11. +by rewrite mulrC divfK // mulf_eq0 negb_or !enorm_eq0 u0. Qed. Lemma dotmul0_vec_angle u v : u != 0 -> v != 0 -> @@ -189,13 +189,13 @@ by rewrite /vec_angle (negPf u0) (negPf v0) uv0 mul0r acos0 sin_pihalf normr1. Qed. Lemma triine u v : - (norm u * norm v * cos (vec_angle u v)) *+ 2 <= norm u ^+ 2 + norm v ^+ 2. + (`| u |_e * `| v |_e * cos (vec_angle u v)) *+ 2 <= `| u |_e ^+ 2 + `| v |_e ^+ 2. Proof. -move/eqP: (sqrrD (norm u) (norm v)); rewrite addrAC -subr_eq => /eqP <-. -rewrite lerBrDr -mulrnDl -{2}(mulr1 (norm u * norm v)) -mulrDr. -apply (@le_trans _ _ (norm u * norm v * 2%:R *+ 2)). +move/eqP: (sqrrD `|u|_e `|v|_e); rewrite addrAC -subr_eq => /eqP <-. +rewrite lerBrDr -mulrnDl -{2}(mulr1 (`|u|_e * `|v|_e)) -mulrDr. +apply (@le_trans _ _ (`|u|_e * `|v|_e * 2%:R *+ 2)). rewrite lerMn2r /=; apply ler_pM => //. - by apply mulr_ge0; apply norm_ge0. + by apply mulr_ge0; apply: enorm_ge0. rewrite -lerBlDr add0r; move: (cos_max (vec_angle u v)). by rewrite ler_norml => /andP[]. rewrite -lerBrDr {2}(_ : 1 = 1%:R) // -natrB //. @@ -204,43 +204,45 @@ rewrite sqrrD mulr2n addrAC; apply: lerD; last by rewrite mulr_natr. by rewrite -subr_ge0 addrAC mulr_natr -sqrrB sqr_ge0. Qed. -Lemma normB u v : norm (u - v) ^+ 2 = - norm u ^+ 2 + norm u * norm v * cos (vec_angle u v) *- 2 + norm v ^+ 2. +(* TODO: move? *) +Lemma enormB u v : `|u - v|_e ^+ 2 = + `|u|_e ^+ 2 + `|u|_e * `|v|_e * cos (vec_angle u v) *- 2 + `|v|_e ^+ 2. Proof. -rewrite /norm dotmulD {1}dotmulvv sqr_sqrtr; last first. +rewrite /enorm dotmulD {1}dotmulvv sqr_sqrtr; last first. rewrite !dotmulvN !dotmulNv opprK dotmulvv dotmul_cos. by rewrite addrAC mulNrn subr_ge0 triine. -rewrite sqr_sqrtr ?le0dotmul // !dotmulvv !sqrtr_sqr normN dotmulvN dotmul_cos. -by rewrite ger0_norm ?norm_ge0 // ger0_norm ?norm_ge0 // mulNrn. +rewrite sqr_sqrtr ?le0dotmul // !dotmulvv !sqrtr_sqr enormN dotmulvN dotmul_cos. +by rewrite ger0_norm ?enorm_ge0// ger0_norm ?enorm_ge0// mulNrn. Qed. -Lemma normD u v : norm (u + v) ^+ 2 = - norm u ^+ 2 + norm u * norm v * cos (vec_angle u v) *+ 2 + norm v ^+ 2. +(* TODO: move? *) +Lemma enormD u v : `|u + v|_e ^+ 2 = + `|u|_e ^+ 2 + `|u|_e * `|v|_e * cos (vec_angle u v) *+ 2 + `|v|_e ^+ 2. Proof. rewrite {1}(_ : v = - - v); last by rewrite opprK. -rewrite normB normN. -case/boolP: (u == 0) => [/eqP ->|u0]. - by rewrite !(norm0,expr0n,add0r,vec_angle0,mul0r,mul0rn,oppr0). -case/boolP: (v == 0) => [/eqP ->|v0]. - by rewrite norm0 mulr0 oppr0 vec_angle0 cos0 mul0r mul0rn subr0 addr0. +rewrite enormB enormN. +have [->|u0] := eqVneq u 0. + by rewrite !(enorm0,expr0n,add0r,vec_angle0,mul0r,mul0rn,oppr0). +have [->|v0] := eqVneq v 0. + by rewrite enorm0 mulr0 oppr0 vec_angle0 cos0 mul0r mul0rn subr0 addr0. by rewrite [in LHS]cos_vec_anglevN // mulrN mulNrn opprK. Qed. Lemma cosine_law' a b c : - norm (b - c) ^+ 2 = norm (c - a) ^+ 2 + norm (b - a) ^+ 2 - - norm (c - a) * norm (b - a) * cos (vec_angle (b - a) (c - a)) *+ 2. + `|b - c|_e ^+ 2 = `|c - a|_e ^+ 2 + `|b - a|_e ^+ 2 - + `|c - a|_e * `|b - a|_e * cos (vec_angle (b - a) (c - a)) *+ 2. Proof. rewrite -[in LHS]dotmulvv (_ : b - c = b - a - (c - a)); last first. by rewrite -!addrA opprB (addrC (- a)) (addrC a) addrK. rewrite dotmulD dotmulvv [in X in _ + _ + X = _]dotmulvN dotmulNv opprK. -rewrite dotmulvv dotmulvN addrAC (addrC (norm (b - a) ^+ _)); congr (_ + _). -by rewrite dotmul_cos mulNrn (mulrC (norm (b - a))). +rewrite dotmulvv dotmulvN addrAC (addrC (`|b - a|_e ^+ _)); congr (_ + _). +by rewrite dotmul_cos mulNrn (mulrC `|b - a|_e). Qed. -Lemma cosine_law a b c : norm (c - a) != 0 -> norm (b - a) != 0 -> +Lemma cosine_law a b c : `|c - a|_e != 0 -> `|b - a|_e != 0 -> cos (vec_angle (b - a) (c - a)) = - (norm (b - c) ^+ 2 - norm (c - a) ^+ 2 - norm (b - a) ^+ 2) / - (norm (c - a) * norm (b - a) *- 2). + (`|b - c|_e ^+ 2 - `|c - a|_e ^+ 2 - `|b - a|_e ^+ 2) / + (`|c - a|_e * `|b - a|_e *- 2). Proof. move=> H0 H1. rewrite (cosine_law' a b c) -2!addrA addrCA -opprD subrr addr0. @@ -253,51 +255,51 @@ rewrite -mulrA mulf_eq0 pnatr_eq0/=. by rewrite mulf_eq0 negb_or H0 H1. Qed. -Lemma norm_crossmul u v : - norm (u *v v) = norm u * norm v * `| sin (vec_angle u v) |. +Lemma enorm_crossmul u v : + `|u *v v|_e = `|u|_e * `|v|_e * `| sin (vec_angle u v) |. Proof. -suff /eqP : (norm (u *v v))^+2 = (norm u * norm v * `| sin (vec_angle u v) |)^+2. - rewrite -eqr_sqrt ?sqr_ge0 // 2!sqrtr_sqr ger0_norm; last by rewrite norm_ge0. +suff /eqP : `|u *v v|_e ^+ 2 = (`|u|_e * `|v|_e * `| sin (vec_angle u v) |)^+2. + rewrite -eqr_sqrt ?sqr_ge0 // 2!sqrtr_sqr ger0_norm; last by rewrite enorm_ge0. rewrite ger0_norm; first by move/eqP. - by rewrite -mulrA mulr_ge0 // ?norm_ge0 // mulr_ge0 // ? norm_ge0. -rewrite norm_crossmul' dotmul_cos !exprMn. + by rewrite -mulrA mulr_ge0 ?enorm_ge0 // mulr_ge0 // enorm_ge0. +rewrite enorm_crossmul' dotmul_cos !exprMn. apply/eqP; rewrite subr_eq -mulrDr. rewrite real_normK //; first by rewrite addrC cos2Dsin2 mulr1. by rewrite realE; case: ltgtP. Qed. -Lemma norm_dotmul_crossmul u v : u != 0 -> v != 0 -> - (`|u *d v +i* norm (u *v v)| = (norm u * norm v)%:C)%C. +Lemma enorm_dotmul_crossmul u v : u != 0 -> v != 0 -> + (`|u *d v +i* `|u *v v|_e| = (`|u|_e * `|v|_e)%:C)%C. Proof. move=> u0 v0 . -rewrite {1}dotmul_cos {1}norm_crossmul normc_def. +rewrite {1}dotmul_cos {1}enorm_crossmul normc_def. rewrite exprMn (@exprMn _ 2 _ `| sin _ |) -mulrDr. rewrite sqrtrM ?sqr_ge0 // sqr_normr cos2Dsin2 sqrtr1 mulr1. -rewrite sqrtr_sqr normrM; by do 2 rewrite ger0_norm ?norm_ge0 //. +by rewrite sqrtr_sqr normrM; do 2 rewrite ger0_norm ?enorm_ge0//. Qed. Lemma vec_angle0_inv u v : u != 0 -> v != 0 -> - vec_angle u v = 0 -> u = (norm u / norm v) *: v. + vec_angle u v = 0 -> u = (`|u|_e / `|v|_e) *: v. Proof. move=> uD0 vD0 uv0. -apply/eqP; rewrite -subr_eq0 -norm_eq0. -rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr0n /= normB. -rewrite vec_anglevZ; last by rewrite divr_gt0 // norm_gt0. -rewrite uv0 cos0 mulr1 !normZ ger0_norm; last first. - by rewrite divr_ge0 // norm_ge0. -by rewrite divfK ?norm_eq0 // -expr2 addrAC -mulr2n subrr. +apply/eqP; rewrite -subr_eq0 -enorm_eq0. +rewrite -(@eqrXn2 _ 2) ?enorm_ge0// expr0n /= enormB. +rewrite vec_anglevZ; last by rewrite divr_gt0// enorm_gt0. +rewrite uv0 cos0 mulr1 !enormZ ger0_norm; last first. + by rewrite divr_ge0// enorm_ge0. +by rewrite divfK ?enorm_eq0// -expr2 addrAC -mulr2n subrr. Qed. Lemma vec_anglepi_inv u v : u != 0 -> v != 0 -> - vec_angle u v = pi -> u = - (norm u / norm v) *: v. + vec_angle u v = pi -> u = - (`|u|_e / `|v|_e) *: v. Proof. move=> uD0 vD0 uvpi. -apply/eqP; rewrite -subr_eq0 -norm_eq0 scaleNr opprK. -rewrite -(@eqrXn2 _ 2) // ?norm_ge0 // expr0n /= normD. -rewrite vec_anglevZ; last by rewrite divr_gt0 // norm_gt0. -rewrite uvpi cospi mulrN1 !normZ ger0_norm; last first. - by rewrite divr_ge0 // norm_ge0. -rewrite mulNrn divfK ?norm_eq0 //. +apply/eqP; rewrite -subr_eq0 -enorm_eq0 scaleNr opprK. +rewrite -(@eqrXn2 _ 2) ?enorm_ge0// expr0n /= enormD. +rewrite vec_anglevZ; last by rewrite divr_gt0// enorm_gt0. +rewrite uvpi cospi mulrN1 !enormZ ger0_norm; last first. + by rewrite divr_ge0// enorm_ge0. +rewrite mulNrn divfK ?enorm_eq0//. by rewrite addrC addrA -expr2 -mulr2n subrr. Qed. @@ -309,31 +311,31 @@ have := dotmul_div_N11 uD0 vD0; rewrite in_itv /= => uv_bound. by rewrite acos_ge0 // acos_lepi. Qed. -Lemma dotmul1_inv u v : norm u = 1 -> norm v = 1 -> u *d v = 1 -> u = v. +Lemma dotmul1_inv u v : `|u|_e = 1 -> `|v|_e = 1 -> u *d v = 1 -> u = v. Proof. move=> u1 v1; rewrite dotmul_cos u1 v1 2!mul1r => Huv. -suff: u = (norm u / norm v) *: v. +suff: u = (`|u|_e / `|v|_e) *: v. rewrite u1 v1 ?divff ?(scale1r, oner_neq0) //. -apply: vec_angle0_inv; first by rewrite -norm_eq0 u1 oner_neq0. - by rewrite -norm_eq0 v1 oner_neq0. +apply: vec_angle0_inv; first by rewrite -enorm_eq0 u1 oner_neq0. + by rewrite -enorm_eq0 v1 oner_neq0. apply: cos_inj; rewrite ?in_itv /=; last by rewrite cos0. by apply: vec_angle_bound. by rewrite lexx pi_ge0. Qed. -Lemma dotmulN1_inv u v : norm u = 1 -> norm v = 1 -> u *d v = - 1 -> u = - v. +Lemma dotmulN1_inv u v : `|u|_e = 1 -> `|v|_e = 1 -> u *d v = - 1 -> u = - v. Proof. move=> u1 v1 Huv. -by apply: dotmul1_inv; rewrite ?normN // dotmulvN Huv opprK. +by apply: dotmul1_inv; rewrite ?enormN// dotmulvN Huv opprK. Qed. Lemma cos_vec_angle a b : a != 0 -> b != 0 -> - `| cos (vec_angle a b) | = Num.sqrt (1 - (norm (a *v b) / (norm a * norm b)) ^+ 2). + `| cos (vec_angle a b) | = Num.sqrt (1 - (`|a *v b|_e / (`|a|_e * `|b|_e)) ^+ 2). Proof. move=> Ha Hb. -rewrite norm_crossmul mulrAC divrr // ?mul1r. +rewrite enorm_crossmul mulrAC divrr // ?mul1r. by rewrite sqr_normr -cos2sin2 sqrtr_sqr. -by rewrite unitfE mulf_neq0 // norm_eq0. +by rewrite unitfE mulf_neq0// enorm_eq0. Qed. Lemma orth_preserves_vec_angle M : M \is 'O[T]_3 -> @@ -343,8 +345,8 @@ move=> MO v w. have [->|/eqP vD0]:= v =P 0; first by rewrite mul0mx !vec_angle0. have [->|/eqP wD0]:= w =P 0; first by rewrite mul0mx !vec_angle0. apply: cos_inj; try by apply: vec_angle_bound. -have /mulfI : norm v * norm w != 0. - by rewrite mulf_eq0 !norm_eq0 negb_or vD0 wD0. +have /mulfI : `|v|_e * `|w|_e != 0. + by rewrite mulf_eq0 !enorm_eq0 negb_or vD0 wD0. apply; rewrite -[RHS]dotmul_cos. have /orth_preserves_dotmul/(_ v w)<- := MO. by rewrite [RHS]dotmul_cos !orth_preserves_norm. @@ -515,13 +517,13 @@ Lemma axialcomp0v e : axialcomp 0 e = 0. Proof. by rewrite /axialcomp dotmulv0 scale0r. Qed. Lemma axialcompv0 v : axialcomp v 0 = 0. -Proof. by rewrite /axialcomp /normalize norm0 invr0 ?(scale0r,dotmul0v). Qed. +Proof. by rewrite /axialcomp /normalize enorm0 invr0 ?(scale0r,dotmul0v). Qed. -Lemma axialcompE v e : axialcomp v e = (norm e) ^- 2 *: (v *m e^T *m e). +Lemma axialcompE v e : axialcomp v e = `|e|_e ^- 2 *: (v *m e^T *m e). Proof. -have [/eqP ->|?] := boolP (e == 0); first by rewrite axialcompv0 mulmx0 scaler0. +have [->|?] := eqVneq e 0; first by rewrite axialcompv0 mulmx0 scaler0. rewrite /axialcomp dotmulZv scalerA mulrAC dotmulP mul_scalar_mx dotmulC. -by rewrite -invrM ?unitfE ?norm_eq0 // -expr2 scalerA. +by rewrite -invrM ?unitfE ?enorm_eq0// -expr2 scalerA. Qed. Lemma axialcompvN v e : axialcomp v (- e) = axialcomp v e. @@ -532,9 +534,9 @@ Proof. by rewrite /axialcomp dotmulvN scaleNr. Qed. Lemma axialcompZ k e : axialcomp (k *: e) e = k *: e. Proof. -rewrite /axialcomp dotmulvZ dotmulC dotmul_normalize_norm. +rewrite /axialcomp dotmulvZ dotmulC dotmul_normalize_enorm. have [/eqP u0|u0] := boolP (e == 0); first by rewrite u0 normalize0 2!scaler0. -by rewrite scalerA -mulrA divrr ?unitfE ?norm_eq0 // mulr1. +by rewrite scalerA -mulrA divrr ?unitfE ?enorm_eq0// mulr1. Qed. Lemma axialcomp_dotmul v e : e *d v = 0 -> axialcomp v e = 0. @@ -559,15 +561,15 @@ rewrite (linearZl_LR _ e)/= (@liexx _ (vec3 T)). by rewrite scaler0 (linear0l _ (_ *v v)). Qed. -Lemma norm_axialcomp v e : e *d v < 0 -> - norm (axialcomp v e) = - (normalize e *d v). +Lemma enorm_axialcomp v e : e *d v < 0 -> + `|axialcomp v e|_e = - (normalize e *d v). Proof. move=> H. have ? : e != 0 by apply: contraTN H => /eqP ->; rewrite dotmul0v ltxx. -rewrite /axialcomp scalerA normZ ltr0_norm; last first. - rewrite pmulr_llt0 ?invr_gt0 ?norm_gt0 //. - by rewrite /normalize dotmulZv pmulr_rlt0 // invr_gt0 norm_gt0. -by rewrite mulNr -(mulrA _ _ (norm e)) mulVr ?mulr1 ?unitfE ?norm_eq0. +rewrite /axialcomp scalerA enormZ ltr0_norm; last first. + rewrite pmulr_llt0 ?invr_gt0 ?enorm_gt0 //. + by rewrite /normalize dotmulZv pmulr_rlt0 // invr_gt0 enorm_gt0. +by rewrite mulNr -(mulrA _ _ `|e|_e) mulVr ?mulr1 ?unitfE ?enorm_eq0. Qed. Lemma axialcomp_mulO Q p e : Q \is 'O[T]_3 -> e *m Q = e -> @@ -585,8 +587,8 @@ Lemma vec_angle_axialcomp v e : 0 < e *d v -> Proof. move=> H. have ? : e != 0 by apply: contraTN H => /eqP ->; rewrite dotmul0v ltxx. -rewrite /axialcomp scalerA vec_anglevZ // divr_gt0 // ?norm_gt0 //. -by rewrite /normalize dotmulZv mulr_gt0 // invr_gt0 norm_gt0. +rewrite /axialcomp scalerA vec_anglevZ // divr_gt0 ?enorm_gt0//. +by rewrite /normalize dotmulZv mulr_gt0 // invr_gt0 enorm_gt0. Qed. Definition normalcomp v e := v - axialcomp v e. @@ -594,7 +596,7 @@ Definition normalcomp v e := v - axialcomp v e. Lemma axialnormalcomp v e : v = axialcomp v e + normalcomp v e. Proof. by rewrite /axialcomp /normalcomp addrC subrK. Qed. -Lemma normalcompE v e : normalcomp v e = v *m (1 - norm e ^-2 *: (e^T *m e)). +Lemma normalcompE v e : normalcomp v e = v *m (1 - `|e|_e ^-2 *: (e^T *m e)). Proof. by rewrite /normalcomp axialcompE -mulmxA scalemxAr -{1}(mulmx1 v) -mulmxBr. Qed. @@ -618,7 +620,7 @@ Lemma normalcompB v1 v2 : normalcomp (v1 - v2) v2 = normalcomp v1 v2. Proof. apply/esym/eqP. rewrite /normalcomp subr_eq /axialcomp -scaleNr -!addrA -scalerDl -dotmulvN. -rewrite -dotmulDr opprB subrK dotmulC dotmul_normalize_norm. +rewrite -dotmulDr opprB subrK dotmulC dotmul_normalize_enorm. by rewrite norm_scale_normalize addrA subrK. Qed. @@ -644,10 +646,10 @@ Qed. Lemma dotmul_normalcomp v e : normalcomp v e *d e = 0. Proof. -case/boolP : (e == 0) => [/eqP ->|?]; first by rewrite dotmulv0. +have [->|?] := eqVneq e 0; first by rewrite dotmulv0. rewrite /normalcomp dotmulBl !dotmulZv dotmulvv (exprD _ 1 1) expr1. -rewrite (mulrA (_^-1)) mulVr ?unitfE ?norm_eq0 // mul1r mulrAC. -by rewrite mulVr ?unitfE ?norm_eq0 // mul1r dotmulC subrr. +rewrite (mulrA (_^-1)) mulVr ?unitfE ?enorm_eq0// mul1r mulrAC. +by rewrite mulVr ?unitfE ?enorm_eq0// mul1r dotmulC subrr. Qed. Lemma axialnormal v e : axialcomp v e *d normalcomp v e = 0. @@ -673,7 +675,7 @@ rewrite -scalemxAr -scalemxAl; congr (_ *: _). by rewrite -{1}uQu trmx_mul !mulmxA orthogonal_mul_tr // mul1mx -mulmxA uQu. Qed. -Lemma normalcomp_mul_tr e (e1 : norm e = 1) : normalcomp 'e_0 e *m e^T == 0. +Lemma normalcomp_mul_tr e (e1 : `|e|_e = 1) : normalcomp 'e_0 e *m e^T == 0. Proof. rewrite /normalcomp mulmxBl -scalemxAl -scalemxAl dotmul1 // dotmulC /dotmul. by rewrite e1 invr1 scalemx1 scalemx1 normalizeI // {1}dotmulP subrr. @@ -685,11 +687,11 @@ Lemma dotmul_orthogonalize v e : e *d orthogonalize v e = 0. Proof. rewrite /normalcomp /normalize dotmulBr !(dotmulZv, dotmulvZ). rewrite mulrACA -invfM -expr2 dotmulvv mulrCA. -have [->|u_neq0] := eqVneq e 0; first by rewrite norm0 invr0 dotmul0v !mul0r subrr. +have [->|u_neq0] := eqVneq e 0; first by rewrite enorm0 invr0 dotmul0v !mul0r subrr. rewrite norm_normalize // expr1n invr1 mul1r. rewrite (mulrC _ (e *d _)). rewrite -mulrA (mulrA (_^-1)) -expr2 -exprMn mulVr ?expr1n ?mulr1 ?subrr //. -by rewrite unitfE norm_eq0. +by rewrite unitfE enorm_eq0. Qed. End axial_normal_decomposition. @@ -764,32 +766,32 @@ Lemma cos0sin1 [R : realType] [x : R] : cos x = 0 -> `|sin x| = 1. Proof. by move/eqP; rewrite -norm_sin_eq1 => /eqP. Qed. Lemma triangle_sin_vector_helper v1 v2 : ~~ colinear v1 v2 -> - norm v1 ^+ 2 * sin (vec_angle v1 v2) ^+ 2 = norm (normalcomp v1 v2) ^+ 2. + `|v1|_e ^+ 2 * sin (vec_angle v1 v2) ^+ 2 = `|normalcomp v1 v2|_e ^+ 2. Proof. move=> H. have v10 : v1 != 0 by apply: contra H => /eqP ->; rewrite colinear0. have v20 : v2 != 0 by apply: contra H => /eqP ->; rewrite colinear_sym colinear0. -rewrite /normalcomp [in RHS]normB. +rewrite /normalcomp [in RHS]enormB. case/boolP : (0 < v2 *d v1) => [v2v1|]. - rewrite normZ gtr0_norm; last first. - by rewrite dotmulZv mulr_gt0 // invr_gt0 norm_gt0. + rewrite enormZ gtr0_norm; last first. + by rewrite dotmulZv mulr_gt0 // invr_gt0 enorm_gt0. rewrite norm_normalize // mulr1 vec_angle_axialcomp //. rewrite dotmul_cos norm_normalize // mul1r vec_angleZv; last first. - by rewrite invr_gt0 norm_gt0. + by rewrite invr_gt0 enorm_gt0. rewrite [in RHS]mulrA (vec_angleC v1) -expr2 -mulrA -expr2 exprMn. by rewrite mulr2n opprD addrA subrK sin2cos2 mulrBr mulr1. rewrite -leNgt le_eqVlt => /orP[|v2v1]. - rewrite {1}dotmul_cos -mulrA mulf_eq0 norm_eq0 (negbTE v20) /=. - rewrite mulf_eq0 norm_eq0 (negbTE v10) /= => /eqP Hcos. + rewrite {1}dotmul_cos -mulrA mulf_eq0 enorm_eq0 (negbTE v20) /=. + rewrite mulf_eq0 enorm_eq0 (negbTE v10) /= => /eqP Hcos. rewrite axialcomp_dotmul; last by rewrite dotmul_cos Hcos mulr0. - rewrite norm0 mulr0 mul0r expr0n mul0rn addr0 subr0. + rewrite enorm0 mulr0 mul0r expr0n mul0rn addr0 subr0. by rewrite -(sqr_normr (sin _)) vec_angleC cos0sin1 ?expr1n ?mulr1. rewrite vec_anglevZN //; last first. - by rewrite /normalize dotmulZv pmulr_rlt0 // invr_gt0 norm_gt0. + by rewrite /normalize dotmulZv pmulr_rlt0 // invr_gt0 enorm_gt0. rewrite cos_vec_anglevN // ?normalize_eq0 //. -rewrite norm_axialcomp // !(mulrN,mulNr,opprK,sqrrN). -rewrite vec_anglevZ // ?invr_gt0 ?norm_gt0 //. -rewrite dotmul_cos norm_normalize // mul1r vec_angleZv ?invr_gt0 ?norm_gt0 //. +rewrite enorm_axialcomp // !(mulrN,mulNr,opprK,sqrrN). +rewrite vec_anglevZ // ?invr_gt0 ?enorm_gt0//. +rewrite dotmul_cos norm_normalize // mul1r vec_angleZv ?invr_gt0 ?enorm_gt0//. rewrite (vec_angleC v2) -!mulrA -expr2 exprMn addrAC -addrA -mulrA -mulrnAr. rewrite -mulrBr mulr2n opprD addrA subrr sub0r. rewrite mulrA -expr2 mulrN mulrA -expr2. @@ -797,27 +799,27 @@ by rewrite sin2cos2 mulrBr mulr1. Qed. Lemma triangle_sin_vector v1 v2 : ~~ colinear v1 v2 -> - sin (vec_angle v1 v2) = norm (normalcomp v1 v2) / norm v1. + sin (vec_angle v1 v2) = `|normalcomp v1 v2|_e / `|v1|_e. Proof. move=> H. have v10 : v1 != 0 by apply: contra H => /eqP ->; rewrite colinear0. have v20 : v2 != 0 by apply: contra H => /eqP ->; rewrite colinear_sym colinear0. apply/eqP. -rewrite -(@eqrXn2 _ 2) // ?divr_ge0 // ?norm_ge0 // ?sin_vec_angle_ge0 //. +rewrite -(@eqrXn2 _ 2) // ?divr_ge0 ?enorm_ge0// ?sin_vec_angle_ge0 //. rewrite exprMn -triangle_sin_vector_helper // mulrAC exprVn divrr ?mul1r //. -by rewrite unitfE sqrf_eq0 norm_eq0. +by rewrite unitfE sqrf_eq0 enorm_eq0. Qed. Lemma triangle_sin_point (p1 p2 p : 'rV[T]_3) : ~~ tricolinear p1 p2 p -> let v1 := p1 - p in let v2 := p2 - p in - sin (vec_angle v1 v2) = norm (normalcomp v1 v2) / norm v1. + sin (vec_angle v1 v2) = `|normalcomp v1 v2|_e / `|v1|_e. Proof. move=> H v1 v2; apply triangle_sin_vector; apply: contra H. by rewrite tricolinear_perm 2!tricolinear_rot /tricolinear /v1 /v2 colinear_sym. Qed. Lemma law_of_sines_vector v1 v2 : ~~ colinear v1 v2 -> - sin (vec_angle v1 v2) / norm (v2 - v1) = sin (vec_angle (v2 - v1) v2) / norm v1. + sin (vec_angle v1 v2) / `|v2 - v1|_e = sin (vec_angle (v2 - v1) v2) / `|v1|_e. Proof. move=> H. move: (triangle_sin_vector H) => /= H1. @@ -826,16 +828,16 @@ have H' : ~~ colinear v2 (v2 - v1). rewrite colinear_sym; apply: contra H => H. move: (colinear_refl v2); rewrite -colinearNv => /(colinearD H). by rewrite addrAC subrr add0r colinearNv. -have H2 : sin (vec_angle v2 (v2 - v1)) = norm (normalcomp (v2 - v1) v2) / norm (v2 - v1). +have H2 : sin (vec_angle v2 (v2 - v1)) = `|normalcomp (v2 - v1) v2|_e / `|v2 - v1|_e. rewrite vec_angleC; apply triangle_sin_vector; by rewrite colinear_sym. rewrite [in RHS]vec_angleC [in RHS]H2. -by rewrite -normalcompB mulrAC -(opprB v2) normalcompNv normN. +by rewrite -normalcompB mulrAC -(opprB v2) normalcompNv enormN. Qed. Lemma law_of_sines_point (p1 p2 p : 'rV[T]_3) : ~~ tricolinear p1 p2 p -> let v1 := p1 - p in let v2 := p2 - p in - sin (vec_angle v1 v2) / norm (p2 - p1) = - sin (vec_angle (p2 - p1) (p2 - p)) / norm (p1 - p). + sin (vec_angle v1 v2) / `|p2 - p1|_e = + sin (vec_angle (p2 - p1) (p2 - p)) / `|p1 - p|_e. Proof. move=> H v1 v2. rewrite (_ : p2 - p1 = v2 - v1); last by rewrite /v1 /v2 opprB addrA subrK. @@ -1065,7 +1067,7 @@ Variable T : rcfType. Let point := 'rV[T]_3. Definition distance_point_line (p : point) l : T := - norm ((p - \pt( l )) *v \vec( l )) / norm \vec( l ). + `|(p - \pt( l )) *v \vec( l )|_e / `|\vec( l )|_e. Definition distance_between_lines (l1 l2 : Line.t T) : T := if intersects l1 l2 then @@ -1074,6 +1076,6 @@ Definition distance_between_lines (l1 l2 : Line.t T) : T := distance_point_line \pt( l1 ) l2 else (* skew lines *) let n := \vec( l1 ) *v \vec( l2 ) in - `| (\pt( l2 ) - \pt( l1 )) *d n | / norm n. + `| (\pt( l2 ) - \pt( l1 )) *d n | / `|n|_e. End distance_line. From c0a9d20136c64b60fdb48c108560b9b2bf97d572 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Fri, 30 Jan 2026 01:31:05 +0900 Subject: [PATCH 079/144] characterization of point1 and point2 --- tilt.v | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) diff --git a/tilt.v b/tilt.v index f9b4a11c..6dc64590 100644 --- a/tilt.v +++ b/tilt.v @@ -2100,6 +2100,55 @@ rewrite [in leRHS](mulrC (_ / 2)) (mulrC 2^-1) -mulrDr -splitr. by rewrite [leRHS]mulrC. Qed. +Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : + is_sol phi Delta sol state_space_tilt -> + t \in `[0, Delta[%R -> + V1dot (sol t) = 0 -> + sol t = point1 \/ sol t = point2. +Proof. +move => solP t0d V1dsol. +have h: u1 sol t = 0. + case: (u1 sol t =P 0) => [-> // |/eqP hsol]. + have := (V1dot_ub solP t0d). + have := u2_quadratic_form_gt0 hsol. + rewrite V1dsol !mulNmx !mxE oppr_ge0. + move => h1 h2. + have := lt_le_trans h1 h2. + by rewrite ltxx. +have L0: Left (sol t) = 0. + apply /eqP; rewrite -enorm_eq0; apply /eqP. + have := congr1 (fun v : 'rV[K]_2 => v ord0 ord0) h. + by rewrite !mxE/=. +have R0 : (Right (sol t)) *m \S('e_2) = 0. + apply /eqP. + rewrite -enorm_eq0. + apply /eqP. + have := congr1 (fun v : 'rV[K]_2 => v ord0 ord_max) h. + by rewrite !mxE/=. +rewrite -(hsubmxK (n1:=3) (sol t)). +rewrite L0. +suff [-> | -> ]: (Right (sol t)) = 0 \/ Right (sol t) = (2 *: 'e_2). + left;apply /matrixP => i j;rewrite mxE. + case: splitP => // k _;by rewrite !mxE. + right;apply /matrixP => i j;rewrite mxE. + by case: splitP => // k _. +have := is_sol_state_space_tilt t0d solP. +rewrite /state_space_tilt/=. +have /sub_rVP [k ->] : (Right (sol t) <= ('e_2 : 'rV[K]_3))%MS. + apply: (@submx_trans _ _ _ _ _ _ (kermx \S('e_2))). + by apply /sub_kermxP. + rewrite submxElt kernel_spin //. + by apply /negP;rewrite -enorm_eq0 enormeE;apply /negP. +rewrite -{1}(scale1r 'e_2) -scalerBl enormZ enormeE mulr1. +rewrite -{2}normr1. +move /eqP => hk. +rewrite eqr_norm2 in hk. +case /orP : hk. +by rewrite subr_eq addrC -subr_eq subrr => /eqP <-;rewrite scale0r;left. +by rewrite subr_eq addrC -subr_eq opprK => /eqP <-;right. +Qed. + + (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : From cc313ffe03fcc30901e9155cf826e040241c495c Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Sun, 1 Feb 2026 01:19:19 +0900 Subject: [PATCH 080/144] applying LaSalle (wip) --- tilt.v | 495 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 476 insertions(+), 19 deletions(-) diff --git a/tilt.v b/tilt.v index 6dc64590..0be0720f 100644 --- a/tilt.v +++ b/tilt.v @@ -7,6 +7,7 @@ From mathcomp Require Import matrix_normedtype. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. + (**md**************************************************************************) (* # Tentative formalization of [1] *) (* *) @@ -409,7 +410,7 @@ Variable phi : T -> T. Definition state_space (Init : set T) : set T := [set x | exists f Delta, (is_sol phi Delta f Init /\ - (exists t, t \in `[0, Delta]%R /\ x = f t))]. + (exists t, t \in `[0, Delta[%R /\ x = f t))]. End state_space. @@ -1540,7 +1541,6 @@ exists x0; split. case: cid => //= y' y'sol. case: cid => t'/= pt'. Abort.*) - Lemma state_space_tiltS : state_space tilt_eqn state_space_tilt `<=` state_space_tilt. Proof. @@ -1550,7 +1550,7 @@ have [Delta0|Delta0] := leP 0 Delta; last first. rewrite /state_space/= => -[t [rt x]]. move : rt. rewrite in_itv/= => -[/andP[x0 xDelta]]. - have := le_lt_trans xDelta Delta0. + have := lt_trans xDelta Delta0. by rewrite ltNge x0. (* move=> p [y [[y0_init1]] [_ [/= deri [conti ball]]]]. *) rewrite /state_space_tilt. @@ -1635,8 +1635,9 @@ suff: `|'e_2 - Right (y t)|_e ^+ 2 = 1. move => /(congr1 Num.sqrt). rewrite sqrtr1 sqr_sqrtr //. by rewrite dotmulvv sqr_ge0. -rewrite norm_constant //; last first. - by rewrite inE. +rewrite norm_constant //;last first. + rewrite inE. + by apply: subset_itv_co_cc . move: y0_init1. rewrite inE /state_space_tilt /= => ->. by rewrite expr2 mulr1. @@ -1645,12 +1646,16 @@ Qed. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). +Lemma point1_in_state_space_tilt : point1 \in state_space_tilt. +Proof. +rewrite inE /state_space_tilt /point1/=. + by rewrite rsubmx_const /= subr0 enormeE. +Qed. Lemma equilibrium_point1 : is_equilibrium_point tilt_eqn state_space_tilt point1. Proof. split. -- rewrite inE /state_space_tilt /point1/=. - by rewrite rsubmx_const /= subr0 enormeE. +- by apply point1_in_state_space_tilt. - split => //=. split. + move=> t t0Delta. @@ -1670,16 +1675,21 @@ split. exact: cvg_cst. Qed. +Lemma point2_in_state_space_tilt : point2 \in state_space_tilt. +Proof. +rewrite inE /state_space_tilt /point2 /=. +rewrite row_mxKr. +rewrite -[X in X - _ ]scale1r. +rewrite -scalerBl enormZ enormeE mulr1 distrC. +rewrite [X in _ - X](_:1 = 1%:R) //. +by rewrite -natrB //= normr1. +Qed. + Lemma equilibrium_point2 : is_equilibrium_point tilt_eqn state_space_tilt point2. Proof. split. -- rewrite inE /state_space_tilt /point2 /=. - rewrite row_mxKr. - rewrite -[X in X - _ ]scale1r. - rewrite -scalerBl enormZ enormeE mulr1 distrC. - rewrite [X in _ - X](_:1 = 1%:R) //. - by rewrite -natrB //= normr1. +- exact: point2_in_state_space_tilt. - split => //. split. + move=> t t0Delta. @@ -1873,6 +1883,7 @@ Lemma tilt_eqn_is_locally_exponentially_stable_at_0 alpha1 gamma : locally_exponentially_stable_at (tilt_eqn alpha1 gamma) point1. Proof. rewrite /locally_exponentially_stable_at /jacobian /hurwitz. +rewrite /lin1_mx/=/tilt_eqn/eqn14b_rhs/=. move => a. move/eigenvalueP => [u] /[swap] u0 H. have a_eigen : eigenvalue (jacobian (tilt_eqn alpha1 gamma) point1) a. @@ -1884,6 +1895,7 @@ have : root (char_poly (jacobian (tilt_eqn alpha1 gamma) point1)) a. rewrite -eigenvalue_root_char. exact : a_eigen. rewrite /tilt_eqn /jacobian. +Search root char_poly. Abort. End hurwitz. @@ -1936,7 +1948,7 @@ apply: (@state_space_tiltS _ alpha1 gamma) => //=. exists sol. exists Delta; split => //=. exists t; split => //. -by rewrite in_itv/= (ltW t0) (ltW tDelta). +by rewrite in_itv/= (ltW t0) tDelta. Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) @@ -2063,6 +2075,7 @@ rewrite -fctE /= !derive_along_enorm_squared//=. - by apply: dif1. Qed. + Definition u1 (sol : K -> 'rV[K]_6) t (zp1 := Left \o sol) (z2 := Right \o sol) (w := z2 t *m \S('e_2)) : 'rV[K]_2 := @@ -2341,6 +2354,136 @@ Qed. End tilt_eqn_Lyapunov. +Section tilt_eqn_Lyapunov_global. +Local Open Scope classical_set_scope. +Context {K : realType}. +Variables alpha1 gamma : K. +Hypotheses (alpha1_gt0 : 0 < alpha1) (gamma_gt0 : 0 < gamma). +Let phi := tilt_eqn alpha1 gamma. + +Let c1 := 2^-1 / alpha1. +Let c2 := 2^-1 / gamma. + +(* todo: copy paste *) +Lemma derive_zp10 (sol : K -> 'rV_6) : + is_global_sol phi sol state_space_tilt -> + 'D_1 (Left \o sol) 0 = - alpha1 *: Left (sol 0). +Proof. +move=> [/= sol0in]. +move /(_ 0) => [d0 +]. +move=> /(congr1 Left). +rewrite derive1E. +rewrite row_mxKl. +move=> <-. +by rewrite derive_lsubmx. +Qed. + +Lemma derive_z20 (sol : K -> 'rV_6) : + is_global_sol phi sol state_space_tilt -> + 'D_1 (Right \o sol) 0 = + gamma *: (Right (sol 0) - Left (sol 0)) *m \S('e_2 - Right (sol 0)) ^+ 2. +Proof. + +move=> [/= sol0in]. +move /(_ 0) => [d0 +]. +move => /(congr1 Right). +rewrite derive1E. +by rewrite row_mxKr => ?; rewrite derive_rsubmx. +Qed. + +Lemma V1dotE0 (sol : K -> 'rV_6) + (zp1 := Left \o sol) (z2 := Right \o sol) : + is_global_sol phi sol state_space_tilt -> + V1dot (sol 0) = + c1 *: (2 *: 'D_1 zp1 0 *m (Left (sol 0))^T) 0 0 + + c2 *: (2 *: 'D_1 z2 0 *m (Right (sol 0))^T) 0 0. +Proof. +move => h. +rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. +rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC. +rewrite mulVf// div1r. +rewrite derive_zp10 // -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)). +rewrite mulrN mulVf ?gt_eqF// mulN1r. +rewrite derive_z20 // -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE. +rewrite scalerA mulVf ?gt_eqF// scale1r. +rewrite norm_squared /V1dot. +congr +%R. +rewrite -2![in LHS]mulmxA -mulmxBr -mulmxBr -linearB/=. +rewrite -[X in (X *m (_ *m _)) 0 0 = _]trmxK. +rewrite -[X in (_ *m (X *m _)) 0 0 = _]trmxK. +rewrite mulmxA -trmx_mul -trmx_mul [LHS]mxE. +rewrite -(mulmxA (Right (sol 0) - (Left (sol 0)))) mulmxE -expr2. +rewrite tr_sqr_spin. +by rewrite mulmxA. +Qed. + + +Lemma derive_along_V1_global t (sol : K -> 'rV_6) : + 0 <= t -> + is_global_sol phi sol state_space_tilt -> + 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). +Proof. +move=> t0 tilt_eqnx. +have dif1 : forall t, differentiable sol t. + move => /= t'. + apply /derivable1_diffP. + by apply tilt_eqnx. +rewrite /V1 derive_alongD; last 3 first. + apply/differentiableM => //=. + exact/differentiable_enorm_squared/differentiable_lsubmx_comp. + apply/differentiableM => //=. + exact/differentiable_enorm_squared/differentiable_rsubmx_comp. + exact: dif1. +under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. +under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. +rewrite derive_alongMl => //; last first. + exact/differentiable_enorm_squared/differentiable_lsubmx_comp. +rewrite derive_alongMl => //; last first. + exact/differentiable_enorm_squared/differentiable_rsubmx_comp. + rewrite -fctE /= !derive_along_enorm_squared//=. + move : t0. + rewrite le_eqVlt => /predU1P[<-//|t0]. + rewrite V1dotE0 => //. + by rewrite !invfM. + - rewrite (V1dotE alpha1_gt0 gamma_gt0 (global_sol_sol tilt_eqnx (t + 1))) //. + by rewrite !invfM. + by rewrite inE/=in_itv/=t0 ltrDl;apply /andP. +- exact/differentiable_lsubmx_comp. +Qed. + +Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : + is_global_sol phi sol state_space_tilt -> + forall t : K, 0 <= t -> + 'D~(sol) (V1 alpha1 gamma) t <= 0. +Proof. +move=> solves. +have diff : forall t, differentiable sol t. + move => /= t'. + apply /derivable1_diffP. + by apply solves. +move => t t0. +rewrite derive_along_V1_global//. +have t0Delta : t \in `[0, t+1[%R. + by rewrite in_itv/=t0 ltrDl ltr01. +have Hub := V1dot_ub (global_sol_sol solves (t + 1)) t0Delta. +apply: (le_trans Hub). +have Hquad : let u1 := \row_i [eta fun=> 0 + with 0 |-> `|(Left \o sol) t|_e, + 1 |-> `|(Right \o sol) t *m \S('e_2)|_e] + i in 0 <= (u1 *m u2 *m u1^T) 0 0. + set u1 := \row_i [eta fun=> 0 + with 0 |-> `|(Left \o sol) t|_e, + 1 |-> `|(Right \o sol) t *m \S('e_2)|_e] + i. + rewrite /=. + case: (u1 =P 0) => [->|/eqP u1_neq0]. + by rewrite !mul0mx mxE. + by rewrite ltW// u2_quadratic_form_gt0. +by rewrite -oppr_ge0 !mulNmx mxE opprK Hquad. +Qed. + +End tilt_eqn_Lyapunov_global. + Section equilibrium_zero_stable. Context {K : realType}. Variables gamma alpha1 : K. @@ -2362,17 +2505,22 @@ have [inD0 about_sol] := H Delta0. by split. Qed. +Lemma V1_diff : forall t : 'rV_6, differentiable (V1 alpha1 gamma) t. +Proof. +move=> t; apply/differentiableD => //=. + apply/differentiableM => //=. + exact/differentiable_enorm_squared/differentiable_lsubmx_comp. +apply/differentiableM => //=. +exact/differentiable_enorm_squared/differentiable_rsubmx_comp. +Qed. + Lemma equilibrium_zero_stable : 0 \in Init -> open Init -> Init `<=` state_space_tilt -> is_locally_stable_at phi Init point1. Proof. move=> Init0 openInit Init_in_state. apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). -- move=> t; apply/differentiableD => //=. - apply/differentiableM => //=. - exact/differentiable_enorm_squared/differentiable_lsubmx_comp. - apply/differentiableM => //=. - exact/differentiable_enorm_squared/differentiable_rsubmx_comp. +- exact: V1_diff. - move=> Delta sol solP t t0. case: solP => sol0Init solP. apply: (@derive_along_V1_le0 _ _ _ _ _ Delta sol). @@ -2404,3 +2552,312 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). Qed. End equilibrium_zero_stable. + +Section LaSalle. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variable phi : U -> U. +Variable sol : U -> R -> U. + +Definition limS (A : set U) := \bigcup_(q in A) cluster (sol q @ +oo). +Variable K : set U. +Hypothesis Kco : compact K. +Definition is_invariant A := state_space phi A `<=` A. +Hypothesis invarK : is_invariant K. +Hypothesis isSol : forall p, p \in K -> is_global_sol phi (sol p) setT. +Hypothesis initp: forall p, p \in K -> sol p 0 = p. + +Lemma invariant_limS A : A `<=` K -> is_invariant (limS A). +Proof. +Admitted. + +Lemma stable_limS (V : U -> R) : + {in K, continuous V} -> + (forall p t, K p -> 0 <= t -> differentiable V (sol p t)) -> + (forall p, K p -> 'D~(sol p) V 0 <= 0) -> + limS K `<=` [set p | 'D~(sol p) V 0 = 0]. +Proof. +move=> Vcont Vsol_ex_deriv Vsol'le0 p0 [q Kq plimp]. +(* have ssqRpK : sol q @` [ `<=` K. *) +(* by move=> _ [t tge0 <-]; apply: Kinvar. *) +(* suff : exists l, cluster (sol q @ +oo) `<=` V @^-1` [set l]. *) +(* move=> [l Vpliml]. *) +(* rewrite (@derive_ext_ge0 _ (fun=> l)); first exact: Derive_const. *) +(* exact: Rle_refl. *) +(* by move=> t tge0; apply/Vpliml/invariant_pos_limit_set. *) +(* suff [l Vsoltol] : [cvg V \o sol q @ +oo]. *) +(* exists l; apply: (c0_cvg_cst_on_pos_lim_set Vcont)=> //. *) +(* exact: compact_closed hU Kco. *) +(* apply: nincr_lb_cvg. *) +(* move=> s t [sge0 slet]. *) +(* apply: (@nincr_function_le _ (Finite 0) (Finite t))=> //; last first. *) +(* - exact: Rle_refl. *) +(* - move=> t' t'ge0 _. *) +(* suff <- : Derive (V \o (sol (sol q t'))) 0 = Derive (V \o (sol q)) t'. *) +(* exact/Vsol'le0/Kinvar. *) +(* rewrite -[t' in RHS]Rplus_0_r. *) +(* apply: derive_ext_ge0_shift; [apply: Rle_refl|apply: t'ge0|]. *) +(* by move=> ??; rewrite /comp -solD // Rplus_comm. *) +(* - by move=> t' t'ge0 _; apply: Vsol_ex_deriv. *) +(* have: compact (V @` K) by apply: continuous_compact. *) +(* move=> /compact_bounded [N hN]. *) +(* exists (- N)=> _ [t tge0 <-]. *) +(* have /hN : (V @` K) ((V \o sol q) t) by apply/imageP/Kinvar. *) +(* by move=> /Rabs_def2 []. *) +Admitted. + Lemma cvg_to_limS : + forall p, p \in K -> sol p t @[t --> +oo] --> globally (limS K). + Admitted. +End LaSalle. + +Section LaSalle_tilt. +Context {K : realType}. +Let U := 'rV[K]_6. +Variable sol : U -> K -> U. +Variables gamma alpha1 : K. +Hypothesis gamma_gt0 : 0 < gamma. +Hypothesis alpha1_gt0 : 0 < alpha1. +Let phi := tilt_eqn alpha1 gamma. +Hypothesis isSol : forall p, p \in state_space_tilt -> is_global_sol phi (sol p) setT. +Hypothesis initp: forall p, p \in state_space_tilt -> sol p 0 = p. +Definition Ksub (p : U) := + [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` state_space_tilt. + +Lemma mxnorm_enorm_le {n} (x : 'rV[K]_n) : `|x| <= `|x|_e. +Proof. +rewrite /Num.norm/=mx_normrE. +apply/bigmax_leP; split. + exact: enorm_ge0. +move=> /= [i j] _ /=. +rewrite {i}ord1. +rewrite -sqrtr_sqr. +rewrite /enorm dotmulvv sqr_enorm. +rewrite ler_sqrt; last by apply sumr_ge0 => k _;apply sqr_ge0. +rewrite (bigD1 j) //=. +rewrite lerDl. +by apply sumr_ge0 => k _;apply sqr_ge0. +Qed. + +Lemma V1_bound_compact p : compact [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p]. +Proof. +apply: bounded_closed_compact. +- rewrite /V1/=. + rewrite /bounded_near. + near=>R. + move => /= x. + rewrite !addf_div; rewrite ?lt0r_neq0 ?mulr_gt0 //. + rewrite ler_pdivrMr ?mulr_gt0 // divrK; last first. + by rewrite unitfE lt0r_neq0 // ?mulr_gt0. + rewrite !(mulrC 2) !mulrA -!mulrDl ler_pM2r //. + move => h. + set c := `| Left p |_e ^+ 2 * gamma + `| Right p |_e ^+ 2 * alpha1. + have c0 : 0 <= c. + by apply addr_ge0; rewrite mulr_ge0 // ?sqr_ge0 ?ltW. + have hL : `| Left x |_e <= Num.sqrt (c / gamma). + rewrite -(sqr_sqrtr (enorm_ge0 (Left x)) ). + rewrite /GRing.exp/= -sqrtrM ?enorm_ge0 // ler_sqrt ?divr_ge0 ?(@ltW _ _ _ gamma) //. + rewrite ler_pdivlMr //. + move : h;apply le_trans. + rewrite lerDl mulr_ge0 // ?sqr_ge0 ?ltW //. + have hR : `| Right x |_e <= Num.sqrt (c / alpha1). + rewrite -(sqr_sqrtr (enorm_ge0 (Right x)) ). + rewrite /GRing.exp/= -sqrtrM ?enorm_ge0 // ler_sqrt ?divr_ge0 ?(@ltW _ _ _ alpha1) //. + rewrite ler_pdivlMr //. + move : h;apply le_trans. + rewrite addrC lerDl mulr_ge0 // ?sqr_ge0 ?ltW //. + have normb : `|x| <= `| Left x |_e + `|Right x|_e. + have {1}-> : x = row_mx (Left x) (Right x). + by rewrite hsubmxK. + rewrite (norm_rowmx (Left x)). + apply (@le_trans _ _ (`|Left x| + `|Right x|)). + rewrite ge_max. + by apply /andP;split;rewrite ?lerDl ?lerDr normr_ge0 //. + apply lerD. + exact: mxnorm_enorm_le. + exact: mxnorm_enorm_le. + apply: (le_trans normb). + by apply: (le_trans (lerD hL hR)). +- have -> : [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] = (V1 alpha1 gamma) @^-1` [set r | r <= V1 alpha1 gamma p] by []. + apply: closed_comp. + move => /= x xin. + exact: (differentiable_continuous (V1_diff _ _ _ )). + exact: closed_le. +Unshelve. all: by end_near. Qed. + +Lemma continuous_enorm {n:nat} : continuous (fun u : 'rV[K]_n => `|u|_e). +Proof. +rewrite /enorm. +move => /= x. +apply/ continuous_comp=>/=. +move => /= A. +Admitted. + +Lemma compact_Ksub p : compact (Ksub p). +Proof. +apply: compact_closedI. +exact: V1_bound_compact. +have -> : state_space_tilt = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. + by []. +apply : closed_comp => //. +move => x xp. +apply : continuous_comp; last by exact:continuous_enorm. +apply: continuousB. +exact: cst_continuous. +exact: continuous_rsubmx. +Qed. +Lemma invariant_Ksub p : is_invariant phi (Ksub p). +Proof. +move => x [/= sol' [d [solP [t h]]]]. +rewrite /Ksub/=. +split; last first. +- apply/(@state_space_tiltS _ alpha1 gamma). + exists sol',d. + split;last by exists t. + apply/is_sol_subset/solP. + exact: subIsetr. +- have [sol0 solA] := solP. + have : V1 alpha1 gamma (sol' 0) <= V1 alpha1 gamma p. + by move: sol0; rewrite inE/=/Ksub/inE;move => []. + apply le_trans. + have [t0 ->] := h. + move : t0;rewrite in_itv/= => /andP[t0 td]. + apply: (V_nincr solA (V1_diff _ _)); rewrite ?t0 ?lexx //. + apply : derive_along_V1_le0=> //. + by apply/is_sol_subset/solP;exact: subIsetr. + move => /= t' t'd. + apply /derivable1_diffP. + have [_ [solA' _]] := solA. + have td' : t' \in `]0,d[ by rewrite inE/=in_itv/=. + by move /(_ _ td') : solA' => [+ _]. +Qed. + +Local Lemma sol_Ksub p :forall u, u \in Ksub p -> is_global_sol phi (sol u) setT. +Proof. + move => u. + rewrite inE/=;move=> [h1 h2]. + split. + apply isSol. + by rewrite inE. + move =>/= x. + apply isSol. + by rewrite inE. +Qed. + +Lemma V1dot_p1_eq0 : V1dot point1 = (0 : K). +Proof. +rewrite /V1dot /point1 /=. +rewrite lsubmx_const rsubmx_const enorm0 expr0n /= oppr0 add0r !mul0mx sub0r oppr0. +by rewrite mxE. +Qed. + +Lemma V1dot_p2_eq0 : V1dot point2 = (0 : K). +Proof. +rewrite /V1dot /point2 /=. +rewrite row_mxKl row_mxKr. +rewrite enorm0 expr0n /= oppr0 add0r. +rewrite -!scalemxAl -scalerBr. +rewrite trmx0 mulmx0 subr0. +rewrite !scalemxAl. +rewrite norm_spin. +Search enorm (_ *: _). +rewrite -!scalemxAl enormZ. +rewrite spinE. +suff -> : 'e_2 *v 'e_2 = (0 : 'rV[K]_3). + by rewrite enorm0 /GRing.exp /= !mulr0 oppr0. +by rewrite vece2 /= scale0r. +Qed. + +Local Lemma limS_subset_V1dot0 p : + p \in state_space_tilt -> limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` state_space_tilt. +Proof. +move => ps. +have H : limS sol (Ksub p) `<=` [set x | 'D~(sol x) (V1 alpha1 gamma) 0 = 0] `&` state_space_tilt. + rewrite subsetI;split. + apply: (@stable_limS _ _ _ _ _ _ _ (@sol_Ksub p) _ (V1 alpha1 gamma)). + exact: compact_Ksub. + exact: invariant_Ksub. + move => p0. + rewrite inE/=/Ksub/inE/=. + move => [_ K0]. + by apply initp;rewrite inE. + move => p0 p0K. + exact: (differentiable_continuous (V1_diff _ _ _ )). + move => /= p0 t K0 t0. + apply: V1_diff. + move => p0 K0. + have p0s : (p0 \in state_space_tilt). + by move : K0;rewrite inE/=/Ksub/inE/=;move=>[]. + apply : derive_along_V1_le0_global => //. + split. + by rewrite initp. + by apply isSol. + move=>/=x px. + admit. +apply: (subset_trans H). +move =>/= x [+ h1]. +rewrite derive_along_V1_global //=. +by rewrite initp ?inE. +split => //. +by rewrite initp ?inE. +move=>x0. +have h1' : (x \in state_space_tilt) by rewrite inE. +by have [_ /=] := (isSol h1'). +Admitted. + +Lemma limS_subset_p1p2 p : + p \in state_space_tilt -> limS sol (Ksub p) `<=` [set point1; point2]. +Proof. +have -> : [set point1; point2] = [set x : 'rV[K]_6 | V1dot x = 0] `&` state_space_tilt. + apply /seteqP;split => x /=. + case => ->;split; [exact: V1dot_p1_eq0 | | exact: V1dot_p2_eq0 | ]. + have := (@point1_in_state_space_tilt K). + by rewrite inE. + have := (@point2_in_state_space_tilt K). + by rewrite inE. + move => [h1 h2']. + have h2: x \in state_space_tilt by rewrite inE. + move : h1. + have hi := initp h2. + rewrite -hi => h1. + have sol' : is_sol phi 1 (sol x) state_space_tilt. + apply: global_sol_sol. + split. + by rewrite hi. + by apply isSol. + apply: (V1dot_eq0_p1_or_p2 sol') => //. + by rewrite in_itv /= lexx ltr01. +by apply limS_subset_V1dot0. +Qed. + +Lemma cvg_to_set_p1_p2 p : p \in state_space_tilt -> + sol p t @[t --> +oo] --> globally [set point1; point2]. +Proof. + rewrite inE => ps. + have : p \in Ksub p. + by rewrite inE; split => //=. + move => pK. + + have p0K : (forall p0 : 'rV_6, p0 \in Ksub p -> sol p0 0 = p0). + move => q. + rewrite inE/=. + move => [_ h]. + apply: initp. + by rewrite inE. + have H0 := cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) (@sol_Ksub p) p0K pK. + apply: (cvg_trans H0). + rewrite /globally/=/cvg_to/=/nbhs/=. + move => A /= h1 x h2. + apply h1. + apply : (@limS_subset_p1p2 p) => //. + by rewrite inE. +Qed. + +Lemma cvg_to_p1_or_p2 p : (p \in state_space_tilt) -> + (sol p t @[t --> +oo] --> point1 ) \/ ( sol p t @[t --> +oo] --> point2). +Proof. + move => h. + have := (cvg_to_set_p1_p2 h). + pose d := `|(@point1 K) - point2|. + pose g t := `|sol p t - point1| - `|sol p t - point2|. +Admitted. +End LaSalle_tilt. From 04395e5087fd5a4c642f6cdf0d63c973947be26a Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Sun, 1 Feb 2026 20:57:24 +0900 Subject: [PATCH 081/144] progress on LaSalle --- tilt.v | 121 +++++++++++++++++++++++++++++++-------------------------- 1 file changed, 65 insertions(+), 56 deletions(-) diff --git a/tilt.v b/tilt.v index 0be0720f..e5358d96 100644 --- a/tilt.v +++ b/tilt.v @@ -1895,7 +1895,6 @@ have : root (char_poly (jacobian (tilt_eqn alpha1 gamma) point1)) a. rewrite -eigenvalue_root_char. exact : a_eigen. rewrite /tilt_eqn /jacobian. -Search root char_poly. Abort. End hurwitz. @@ -2553,6 +2552,7 @@ Qed. End equilibrium_zero_stable. +(* from https://github.com/drouhling/LaSalle *) Section LaSalle. Context {R : realType} {n : nat}. Let U := 'rV[R]_n. @@ -2567,46 +2567,18 @@ Hypothesis invarK : is_invariant K. Hypothesis isSol : forall p, p \in K -> is_global_sol phi (sol p) setT. Hypothesis initp: forall p, p \in K -> sol p 0 = p. -Lemma invariant_limS A : A `<=` K -> is_invariant (limS A). -Proof. -Admitted. - Lemma stable_limS (V : U -> R) : {in K, continuous V} -> (forall p t, K p -> 0 <= t -> differentiable V (sol p t)) -> (forall p, K p -> 'D~(sol p) V 0 <= 0) -> limS K `<=` [set p | 'D~(sol p) V 0 = 0]. Proof. -move=> Vcont Vsol_ex_deriv Vsol'le0 p0 [q Kq plimp]. -(* have ssqRpK : sol q @` [ `<=` K. *) -(* by move=> _ [t tge0 <-]; apply: Kinvar. *) -(* suff : exists l, cluster (sol q @ +oo) `<=` V @^-1` [set l]. *) -(* move=> [l Vpliml]. *) -(* rewrite (@derive_ext_ge0 _ (fun=> l)); first exact: Derive_const. *) -(* exact: Rle_refl. *) -(* by move=> t tge0; apply/Vpliml/invariant_pos_limit_set. *) -(* suff [l Vsoltol] : [cvg V \o sol q @ +oo]. *) -(* exists l; apply: (c0_cvg_cst_on_pos_lim_set Vcont)=> //. *) -(* exact: compact_closed hU Kco. *) -(* apply: nincr_lb_cvg. *) -(* move=> s t [sge0 slet]. *) -(* apply: (@nincr_function_le _ (Finite 0) (Finite t))=> //; last first. *) -(* - exact: Rle_refl. *) -(* - move=> t' t'ge0 _. *) -(* suff <- : Derive (V \o (sol (sol q t'))) 0 = Derive (V \o (sol q)) t'. *) -(* exact/Vsol'le0/Kinvar. *) -(* rewrite -[t' in RHS]Rplus_0_r. *) -(* apply: derive_ext_ge0_shift; [apply: Rle_refl|apply: t'ge0|]. *) -(* by move=> ??; rewrite /comp -solD // Rplus_comm. *) -(* - by move=> t' t'ge0 _; apply: Vsol_ex_deriv. *) -(* have: compact (V @` K) by apply: continuous_compact. *) -(* move=> /compact_bounded [N hN]. *) -(* exists (- N)=> _ [t tge0 <-]. *) -(* have /hN : (V @` K) ((V \o sol q) t) by apply/imageP/Kinvar. *) -(* by move=> /Rabs_def2 []. *) Admitted. - Lemma cvg_to_limS : - forall p, p \in K -> sol p t @[t --> +oo] --> globally (limS K). + (* Lemma cvg_to_limS : *) + (* forall p, p \in K -> sol p t @[t --> +oo] --> (limS K). *) + (* Admitted. *) + Lemma cvg_to_limS : + forall p, p \in K -> cluster (sol p t @[t --> +oo]) `<=` limS K. Admitted. End LaSalle. @@ -2686,11 +2658,22 @@ Unshelve. all: by end_near. Qed. Lemma continuous_enorm {n:nat} : continuous (fun u : 'rV[K]_n => `|u|_e). Proof. -rewrite /enorm. -move => /= x. +move=> /= x. +rewrite /enorm/=. apply/ continuous_comp=>/=. -move => /= A. -Admitted. +apply: differentiable_continuous. +under eq_fun do rewrite dotmulvv sqr_enorm. +rewrite /=. +have <- : (\sum_(i < n) (fun x0 : 'rV[K]_n => x0``_i ^+ 2)) = (fun x0 : 'rV[K]_n => \sum_(i < n) x0``_i ^+ 2). + apply funext => x0 /=. + by apply: (big_morph (fun f : 'rV[K]_n -> K => f x0)). +apply : differentiable_sum. +move => i. +have -> : (fun x0 : 'rV[K]_n => x0``_i ^+ 2) = (fun x0 : 'rV_n => x0``_i ) ^+2 by []. +apply: differentiableX. +apply: differentiable_coord. +exact: sqrt_continuous. +Qed. Lemma compact_Ksub p : compact (Ksub p). Proof. @@ -2759,13 +2742,20 @@ rewrite -!scalemxAl -scalerBr. rewrite trmx0 mulmx0 subr0. rewrite !scalemxAl. rewrite norm_spin. -Search enorm (_ *: _). rewrite -!scalemxAl enormZ. rewrite spinE. suff -> : 'e_2 *v 'e_2 = (0 : 'rV[K]_3). by rewrite enorm0 /GRing.exp /= !mulr0 oppr0. by rewrite vece2 /= scale0r. Qed. +Local Lemma global_sol_T A sol' : is_global_sol phi sol' setT -> sol' 0 \in A -> is_global_sol phi sol' A. +Proof. + move => [_ solP] initP. + split=>//. +Qed. + +Local Lemma q_inKsubq q : q \in state_space_tilt -> q \in Ksub q. +Proof. rewrite !inE => h;split => //=. Qed. Local Lemma limS_subset_V1dot0 p : p \in state_space_tilt -> limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` state_space_tilt. @@ -2791,8 +2781,24 @@ have H : limS sol (Ksub p) `<=` [set x | 'D~(sol x) (V1 alpha1 gamma) 0 = 0] `&` split. by rewrite initp. by apply isSol. - move=>/=x px. - admit. + move=>/=x [q qKsub xcl]. + suff [] : (Ksub q) x by []. + rewrite (closure_id (Ksub q)).1;last first. + apply compact_closed => //. + exact: compact_Ksub. + have qs (t :K) : 0<=t -> state_space phi (Ksub q) (sol q t). + exists (sol q),(t+1). + split. + apply global_sol_sol; apply global_sol_T. + apply isSol;rewrite inE;apply qKsub. + rewrite initp; [apply q_inKsubq|];rewrite inE;apply qKsub. + exists t;split => //. + by rewrite/=in_itv/=H ltrDl ltr01. + have lim_sp : (sol q x @[x --> +oo]) (Ksub q). + exists 0; split => // t t0 /=. + by apply (invariant_Ksub (qs _ (ltW t0))). + rewrite clusterE in xcl. + by apply:xcl. apply: (subset_trans H). move =>/= x [+ h1]. rewrite derive_along_V1_global //=. @@ -2802,7 +2808,7 @@ by rewrite initp ?inE. move=>x0. have h1' : (x \in state_space_tilt) by rewrite inE. by have [_ /=] := (isSol h1'). -Admitted. +Qed. Lemma limS_subset_p1p2 p : p \in state_space_tilt -> limS sol (Ksub p) `<=` [set point1; point2]. @@ -2830,7 +2836,7 @@ by apply limS_subset_V1dot0. Qed. Lemma cvg_to_set_p1_p2 p : p \in state_space_tilt -> - sol p t @[t --> +oo] --> globally [set point1; point2]. + cluster (sol p t @[t --> +oo]) `<=` [set point1; point2]. Proof. rewrite inE => ps. have : p \in Ksub p. @@ -2844,20 +2850,23 @@ Proof. apply: initp. by rewrite inE. have H0 := cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) (@sol_Ksub p) p0K pK. - apply: (cvg_trans H0). - rewrite /globally/=/cvg_to/=/nbhs/=. - move => A /= h1 x h2. - apply h1. + apply: (subset_trans H0). apply : (@limS_subset_p1p2 p) => //. by rewrite inE. Qed. - -Lemma cvg_to_p1_or_p2 p : (p \in state_space_tilt) -> - (sol p t @[t --> +oo] --> point1 ) \/ ( sol p t @[t --> +oo] --> point2). -Proof. - move => h. - have := (cvg_to_set_p1_p2 h). - pose d := `|(@point1 K) - point2|. - pose g t := `|sol p t - point1| - `|sol p t - point2|. -Admitted. +(* Requires something about the cluster set of trajectory being connected *) +(* Lemma cvg_to_p1_or_p2 p : (p \in state_space_tilt) -> *) +(* (sol p t @[t --> +oo] --> point1 ) \/ ( sol p t @[t --> +oo] --> point2). *) +(* Proof. *) +(* move => h. *) +(* have := (cvg_to_set_p1_p2 h). *) +(* Search cluster. *) +(* rewrite /globally/= => hc. *) +(* have : exists t0, forall t, t > t0 -> sol p t \in [set point1; point2]. *) +(* Search globally. *) +(* move => []. *) +(* move => h'. *) +(* pose d := `|(@point1 K) - point2|. *) +(* pose g t := `|sol p t - point1| - `|sol p t - point2|. *) +(* Admitted. *) End LaSalle_tilt. From e4982e765185812253548ac8281d38d27da24b17 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Tue, 3 Feb 2026 15:51:11 +0900 Subject: [PATCH 082/144] trajectory omega-limits --- tilt.v | 131 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 131 insertions(+) diff --git a/tilt.v b/tilt.v index e5358d96..6fdec4a3 100644 --- a/tilt.v +++ b/tilt.v @@ -2835,6 +2835,137 @@ have -> : [set point1; point2] = [set x : 'rV[K]_6 | V1dot x = 0] `&` state_sp by apply limS_subset_V1dot0. Qed. +(*Todo: generalize + PR? *) +Lemma compact_decreasing_bigcap + (X : topologicalType) (B : K -> set X) (O : set X) : + (forall i, compact (B i)) -> + (forall i j, i <= j -> B j `<=` B i) -> + open O -> + (\bigcap_i B i `<=` O) -> + exists i0, B i0 `<=` O. +Proof. + move => H. +Admitted. +Lemma open_disjoint_separated (X : topologicalType) (A B : set X) : + open A -> open B -> A `&` B = set0 -> separated A B. +Proof. + move=>Ao Bo ABdisj. + split. + apply /disjoints_subset. + rewrite (closure_id (~` B)).1; last by apply open_closedC. + by apply /closure_subset/disjoints_subset. + rewrite setIC;apply /disjoints_subset. + rewrite (closure_id (~` A)).1; last by apply open_closedC. + apply /closure_subset/disjoints_subset. + by rewrite setIC. +Qed. + +Lemma separated_closedUP {T : topologicalType} (A B : set T) : separated A B -> closed (A `|` B) <-> closed A /\ closed B. +Proof. + move => ABsep. + split => [/closure_id h | [h1 h2]]; last by apply closedU. + rewrite closureU in h. + split;apply /closure_id/seteqP;split => [|x cx]; try by apply subset_closure. + have /orP[] : (x \in A) || (x \in B). + by rewrite -in_setU h inE/=;left. + by rewrite inE. + rewrite inE => xB. + have [/seteqP[+ _] _] := ABsep. + case /(_ x). + by split. + have /orP[] : (x \in A) || (x \in B). + by rewrite -in_setU h inE/=;right. + rewrite inE => xB. + have [_ /seteqP[+ _]] := ABsep. + case /(_ x). + by split. + by rewrite inE. +Qed. + +(*Todo: PR? *) +(* NB: should be possible to generalize without normal_space X *) +Lemma compact_connected_cluster + (X : topologicalType) (f : K -> X) (A : set X) : + hausdorff_space X -> + normal_space X -> + continuous f -> + compact A -> + (forall t, f t \in A) -> + connected (cluster (f t @[t --> +oo])). +Proof. +move => H Hn contf compactf imagef. +set B := fun t => closure (f @` `[t, +oo[). +have Bcon t : connected (B t). + apply: connected_closure. + apply: connected_continuous_connected. + apply /connected_intervalP/interval_is_interval. + by apply continuous_subspaceT. +have Bnonempty t : B t !=set0. + exists (f t);apply subset_closure. + by exists t; rewrite /=?in_itv/=?lexx. +have Bmon (s t : K): s <= t -> B t `<=` B s. + move => st. + apply: closure_subset. + move => _ [t' tt'] <-. + exists t' => //. + move : tt'; rewrite /=!in_itv//= => /andP[ht _];apply /andP;split=>//. + by apply: (le_trans st). +have Bcom t : compact (B t). + apply: (subclosed_compact _ compactf). + exact: closed_closure. + rewrite (closure_id A).1; last by apply compact_closed. + apply: closure_subset. + move => _ [t0 tp] <-. + move /(_ t0): imagef. + by rewrite inE. +have -> : cluster (f t @[t --> +oo]) = \bigcap_t B t. + rewrite clusterE. + apply /seteqP;split. + apply:sub_bigcap => t0 _. + apply: bigcap_inf. + exists t0; split. + apply num_real. + move => t tx; exists t;rewrite //=in_itv/=ltW//. + apply : sub_bigcap => b /= [t0 [_ /= h]]. + apply: (subset_trans (bigcap_inf (i := t0+1) _)) => //. + apply closure_subset. + move => _ /= [x xt] <-. + apply h. + have t1: (t0+1 <= x). + by move : xt; rewrite /=in_itv/= => /andP[]. + apply/lt_le_trans/t1. + by rewrite ltrDl. +apply /connectedP => E [Enonempty Eu Esep]. +have /(separated_closedUP Esep) [E1c E2c] : closed ((E false) `|` (E true)). + by rewrite -Eu;apply closed_bigI => i _;apply compact_closed. +have /normal_openP := Hn. +move /(_ K (E false) (E true)) => [| | | V1 [V2 [V1o V2o V1E1 V2E2 V12disj]]]//. + by apply separated_disjoint. +have V1V2o : open (V1 `|` V2). + by apply openU. +have V1V2sep : separated V1 V2. + by apply open_disjoint_separated. +have BV1V2 : \bigcap_t B t `<=` V1 `|` V2. + by rewrite Eu;apply : setUSS. +case /compact_decreasing_bigcap : BV1V2 => // t0 Bto. +suff: V1 `&` V2 !=set0. + by apply nonemptyPn. +have [e1 E1 ] := Enonempty false. +have [e2 E2 ] := Enonempty true. +have EB : (E false `|` E true `<=` B t0). + rewrite <- Eu. + by apply bigcap_inf. +case (connected_subset V1V2sep Bto (Bcon _)) => hbv. + exists e2. + split; last by apply V2E2. + apply hbv. + by apply EB;right. + exists e1. +split; first by apply V1E1. +apply hbv. +by apply EB;left. +Qed. + Lemma cvg_to_set_p1_p2 p : p \in state_space_tilt -> cluster (sol p t @[t --> +oo]) `<=` [set point1; point2]. Proof. From 96be4ba910d2cb82b6802a29ad747a904620773e Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 3 Feb 2026 16:04:42 +0900 Subject: [PATCH 083/144] add Rouhling's development --- _CoqProject | 2 + lasalle.v | 491 +++++++++++++++++++++++++ pendulum.v | 1011 +++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 1504 insertions(+) create mode 100644 lasalle.v create mode 100644 pendulum.v diff --git a/_CoqProject b/_CoqProject index cee97fc7..6509eb5f 100644 --- a/_CoqProject +++ b/_CoqProject @@ -17,6 +17,8 @@ scara.v derive_matrix.v differential_kinematics.v extra_trigo.v +lasalle.v +pendulum.v tilt_mathcomp.v tilt_analysis.v tilt_robot.v diff --git a/lasalle.v b/lasalle.v new file mode 100644 index 00000000..f1835de2 --- /dev/null +++ b/lasalle.v @@ -0,0 +1,491 @@ +(* LaSalle (c) 2025 Inria and AIST. Licence: CeCILL-C. *) +(* -------------------------------------------------------------------------- *) +(* Copyright (c) - 2017 -- 2019 Inria *) +(* -------------------------------------------------------------------------- *) +From HB Require Import structures. +From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype choice seq. +From mathcomp Require Import order interval_inference. +From mathcomp Require Import fintype bigop ssralg ssrnum finmap interval ssrint. +From mathcomp Require Import boolp reals classical_sets functions. +From mathcomp Require Import topology normedtype landau derive. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import GRing.Theory Num.Def Num.Theory Order.POrderTheory Order.TotalTheory. +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. + +Lemma mul2r (R : ringType) (x : R) : (2 * x = x + x)%R. +Proof. by rewrite -mulr2n mulr_natl. Qed. + +Section pseudoMetricType_numDomainType. +Context {R : numDomainType} {M : pseudoMetricType R}. + +Definition ball_set (A : set M) e := \bigcup_(p in A) ball p e. + +(*HB.instance Definition _ := isPointed.Build (set M) [set point].*) + +HB.instance Definition _ := isFiltered.Build M (set M) (nbhs_ball_ ball_set). + +End pseudoMetricType_numDomainType. + +Section PositiveLimitingSet. +Variable R : realFieldType. +Variable U : pseudoPMetricType R. + +Definition pos_limit_set (y : R -> U) := + \bigcap_(eps in [set e | 0 < e]%R) \bigcap_(T in [set T | 0 < T]%R) + [set p | ltr T `&` (y @^-1` ball p eps) !=set0]. + +Lemma plim_cluster (y : R -> U) : + pos_limit_set y = cluster (y @ +oo%R). +Proof. +rewrite predeqE => p; split. + move=> plim_p A B [M [Mreal ygtM_A]]. + move=> /nbhs_ballP [e egt0 pe_B]. + wlog Mgt0 : M Mreal ygtM_A / (0 < M)%R; last first. + by have [t [/ygtM_A Ayt /pe_B Byt]] := plim_p _ egt0 _ Mgt0; exists (y t). + move=> /(_ (maxr M 1%R)) []; last by move=> q ?; exists q. + by rewrite max_real// real1. + by move=> ?; rewrite gt_max => /andP [/ygtM_A]. + by rewrite lt_max orbC ltr01. +move=> clyp e egt0 T Tgt0. +have [] := clyp (y @` ltr T) (ball p e). + by exists T; rewrite num_real; split => //; exact: imageP. + by rewrite -nbhs_ballE; exists e. +by move=> _ [[t ? <-] ?]; exists t. +Qed. + +Lemma plimn0 (y : R -> U) (A : set U) : + compact A -> (y @ +oo%R) A -> cluster (y @ +oo%R) !=set0. +Proof. by move=> Aco /Aco [p []]; exists p. Qed. + +Lemma closed_plim (y : R -> U) : closed (cluster (y @ +oo%R)). +Proof. +by rewrite clusterE; apply: closed_bigI => ??; apply: closed_closure. +Qed. + +Lemma filter_cluster (F : set (set U)) (A : set U) : + ProperFilter F -> F A -> compact A -> + forall e, (0 < e)%R -> F (ball_set (cluster F) e). +Proof. +move=> FF FA; rewrite compact_In0 => Aco e egt0. +set B := ball_set (cluster F) e. +have Fn0 : F !=set0 by exists A. +have : A `&` (cluster F `\` B°) = set0. + suff -> : cluster F `\` B° = set0 by rewrite setI0. + rewrite setD_eq0 => p clFp. + by rewrite /interior -nbhs_ballE; exists e => // ??; exists p. +rewrite clusterE. +rewrite -[_ `\` _]bigcapIl // setIC. +rewrite -bigcapIl // => IFBoA0. +set f := fun C => closure C `&` ~` B° `&` A. +have [G sGF IGBoA0] : exists2 G : {fset (set U)}, + {subset G <= F} & \bigcap_(C in [set C | C \in G]) f C = set0. + have {}IFBoA0 : ~ (\bigcap_(C in F) f C !=set0). + by move=> [p IFBoAp]; rewrite -[False]/(set0 p) -IFBoA0. + have /Aco : closed_fam_of A F f. + exists (fun C => closure C `&` ~` B°). + move=> C _; apply: closedI (@closed_closure _ _) _. + by rewrite closedC; exact/open_interior. + by move=> ? _; rewrite setIC. + move=> /contra_not /(_ IFBoA0) /asboolPn /existsp_asboolPn [H /asboolPn]. + move=> /imply_asboolPn [sHF IHBoA0]; exists H => //. + by rewrite predeqE => p; split=> // IHBoAp; apply: IHBoA0; exists p. +have Gn0 : [set C | C \in G] !=set0. + apply: contrapT => /asboolPn /forallp_asboolPn G0. + by rewrite -[False]/(@set0 U point) -IGBoA0 => ? /G0. +move: IGBoA0; have -> : \bigcap_(C in [set C | C \in G]) f C = + \bigcap_(C in [set C | C \in G]) (A `&` closure C `&` ~` B°). + by rewrite predeqE => a; split=> IGBoAa ? /IGBoAa [[]]. +rewrite bigcapIl // setD_eq0 => sIGABo. +suff : F B° by apply: filterS => ?; apply: nbhs_singleton. +apply: filterS sIGABo _; apply: filter_bigI => C /sGF; rewrite in_setE => FC. +by apply: filterI FA _; apply: filterS (@subset_closure _ C) _. +Qed. + +Lemma cvg_to_plim (y : R -> U) (A : set U) : + (y @ +oo%R) A -> compact A -> y @ +oo%R --> cluster (y @ +oo%R). +Proof. +move=> yinftyA coA B [e egt0 scleB]. +by apply: filterS scleB _; exact: filter_cluster coA _ egt0. +Qed. + +(* Lemma cvg_to_plim y (A : set U) : *) +(* (y @ +oo) A -> compact A -> y @ +oo --> cluster (y @ +oo). *) +(* Proof. *) +(* move=> yinftyA coA; apply/NNP. *) +(* move=> /asboolPn /existsp_asboolPn [B] /asboolPn /imply_asboolPn. *) +(* move=> [[e egt0 plim_e_B] /asboolPn /forallp_asboolPn nygtxB]. *) +(* suff : ~` B `&` B !=set0 by case=> ? []. *) +(* have proper_within_CB : ProperFilter (within (~` B) (y @ +oo)). *) +(* apply: Build_ProperFilter=> C [T ygtTsBC]. *) +(* have /asboolPn /existsp_asboolPn [t /asboolPn /imply_asboolPn [tgtT nByt]] *) +(* := nygtxB T. *) +(* by exists (y t); apply: ygtTsBC. *) +(* have [|p [Ap plimnBp]] := coA _ proper_within_CB. *) +(* exact: flim_within yinftyA. *) +(* apply plimnBp; first exact: withinT. *) +(* rewrite -locally_ballE; exists e => // q pe_q; apply: plim_e_B. *) +(* by exists p => // C D yinftyC; apply/plimnBp; apply: flim_within yinftyC. *) +(* Qed. *) + +Lemma sub_image_at_infty (y : R -> U) (A : set U) : + y @` (>= 0)%R `<=` A -> (y @ +oo%R) A. +Proof. +move=> syRpA; exists 0%R; rewrite real0; split => // t tgt0. +exact/syRpA/imageP/ltW. +Qed. + +Lemma sub_plim_clos_invar (y : R -> U) (A : set U) : + y @` (>= 0)%R `<=` A -> cluster (y @ +oo%R) `<=` closure A. +Proof. by move=> syRpA p ypp B /ypp; apply; exact: sub_image_at_infty. Qed. + +(* to mathcomp/analysis ? *) +Definition continuous_on (T U : topologicalType) (A : set T) (f : T -> U) := + forall p : T, A p -> f @ (within A (nbhs p)) --> f p. + +Lemma map_sub_cluster (S T : topologicalType) (F : set_system S) (f : S -> T) + (A : set S) : Filter F -> continuous_on A f -> F A -> closed A -> + f @` (cluster F) `<=` cluster (f @ F). +Proof. +move=> Ffilt fcont FA Acl _ [p clFp <-] B C fFB. +have Ap : A p by apply: Acl => ? /clFp - /(_ _ FA). +move=> /(fcont _ Ap) fp_C. +suff /clFp /(_ fp_C) [q [[Aq ?] /(_ Aq)]] : F (A `&` f @^-1` B) by exists (f q). +exact: filterI. +Qed. + +Lemma c0_cvg_cst_on_plim A (y : R -> U) (V : U -> R^o) (l : R^o) : + continuous_on A V -> V \o y @ +oo%R --> l -> + closed A -> y @` (>= 0)%R `<=` A -> cluster (y @ +oo%R) `<=` V @^-1` [set l]. +Proof. +move=> Vcont Vypl Acl syRpA p plimp. +have Aypinfty : (y @ +oo%R) A by apply: sub_image_at_infty. +have : (V @` cluster (y @ +oo%R)) (V p) by exists p. +move=> /(map_sub_cluster _ Vcont Aypinfty Acl). +by move=> /(cvg_cluster Vypl) /Rhausdorff ->. +Qed. + +End PositiveLimitingSet. + +Lemma bounded_plim (K : realFieldType) (V : normedModType K) (y : K -> V) : + bounded_set (y @` (>= 0)%R) -> bounded_set (cluster (y @ +oo%R)). +Proof. +rewrite /bounded_set => - [N [Nreal ybndN]]. +wlog Ngt0 : N Nreal ybndN / (0 < N)%R. + move=> bnd_plim; apply: (bnd_plim (maxr N 1%R)); last first. + by rewrite lt_max orbC ltr01. + by move=> ?; rewrite gt_max => /andP [/ybndN]. + by rewrite max_real// real1. +rewrite /bounded_set. +red. +near=> M => p plimp. +have [] := plimp (y @` (>= 0)%R) (ball_ Num.norm p (PosNum Ngt0)%:num). +- exact: sub_image_at_infty. +- exact: nbhs_ball_norm. +move=> _ [[t tge0 <-] pN_yt]; rewrite -[p](subrK (y t)). +apply: (le_trans (ler_normD _ _)). +rewrite -lerBrDr. +apply/ltW; apply: lt_le_trans pN_yt _. +rewrite lerBrDr addrC -lerBrDr; apply: ybndN; last by exists t. +by rewrite ltrBrDr; near: M; exists (N + N)%R; rewrite realD. +Unshelve. all: by end_near. Qed. + +Lemma continuous_on_compact (S T : topologicalType) (f : S -> T) (A : set S) : + continuous_on A f -> compact A -> compact (f @` A). +Proof. +move=> fcont Aco F FF FfA; set G := filter_from F (fun C => A `&` f @^-1` C). +have GF : ProperFilter G. + apply: (filter_from_proper (filter_from_filter _ _)); first by exists (f @` A). + move=> C1 C2 F1 F2; exists (C1 `&` C2); first exact: filterI. + by move=> ?[?[]]; split; split. + by move=> C /(filterI FfA) /filter_ex [_ [[p ? <-]]]; eexists p. +move: Aco => /(_ G GF)[]. + by exists (f @` A) => // ? []. +move=> p [Ap clsGp]; exists (f p); split; first exact/imageP. +move=> B C FB /(fcont _ Ap) /= p_Cf. +have : G (A `&` f @^-1` B) by exists B. +by move=> /clsGp /(_ p_Cf) [q [[Aq ?] /(_ Aq)]]; exists (f q). +Qed. + +(* TODO: PR to mathcomp-analysis? *) +Lemma nearN (R : realFieldType) (P : set R) : + (\forall x \near (0%R : R^o), P x) = (\forall x \near (0%R : R^o), P (- x)%R). +Proof. +rewrite propeqE; split. + move/nbhs_ballP => [e e0 eP]. + near=> x; apply: eP; rewrite /ball/= opprK add0r. + by near: x; exact: (@nbhs0_lt _ R^o). +move/nbhs_ballP => [e e0 eP]. +near=> x. +rewrite -(opprK x); apply: eP; rewrite /ball/= opprK add0r. +by near: x; exact: (@nbhs0_lt _ R^o). +Unshelve. all: by end_near. Qed. + +Section DifferentialSystem. +Context {R : realType}. +Variable U : normedModType R. +Let hU : hausdorff_space U := @norm_hausdorff _ U. + +(* function defining the differential system *) +Variable F : U -> U. + +Definition is_sol (y : [the normedModType _ of R^o] -> U) := + (forall t, t < 0 -> y t = 2 *: (y 0) - (y (- t)))%R /\ + forall t, (0 <= t)%R -> is_derive (t : R^o) 1%R y (F (y t)). + +(* compact set used in LaSalle's invariance principle *) +Variable K : set U. +Hypothesis Kco : compact K. + +(* solution function *) +Variable sol : U -> R -> U. +Hypothesis (sol0 : forall p, sol p 0 = p). +Hypothesis solP : forall y : R -> U, K (y 0%R) -> is_sol y <-> y = sol (y 0%R). +Hypothesis sol_cont : forall t, continuous_on K (sol^~ t). + +Lemma sol_is_sol p : K p -> is_sol (sol p). +Proof. by move=> Kp; apply/solP; rewrite sol0. Qed. +Hint Resolve sol_is_sol : core. + +Lemma uniq_sol (x y : R -> U) : + K (x 0%R) -> K (y 0%R) -> is_sol x -> is_sol y -> x 0%R = y 0%R -> x = y. +Proof. by move=> Kx0 Ky0 /(solP Kx0)-> /(solP Ky0)->; rewrite !sol0 => ->. Qed. + +Definition is_invariant A := forall p, A p -> forall t, (0 <= t)%R -> A (sol p t). + +Hypothesis Kinvar : is_invariant K. + +Definition shift_sol p t0 t := + (if t >= 0 then sol p (t + t0) else 2 *: (sol p t0) - (sol p (- t + t0)))%R. + +Lemma sol_shift p (t0 : R^o) : K p -> (0 <= t0)%R -> is_sol (shift_sol p t0). +Proof. +move=> Kp t0ge0; split=> [t tlt0|t tge0]. + rewrite /shift_sol leNgt tlt0/= lexx/=. + rewrite ltW ?oppr_gt0//. + rewrite [X in _ = (2 *: sol p X - _)%R](_ : _ = t0)//. + by rewrite add0r. +suff dshift : (shift_sol p t0) \o shift t = (cst (shift_sol p t0 t) + + (fun h : R^o => h *: F (shift_sol p t0 t)))%R +o_ (0%R : R^o) (id : R^o -> R^o). + move=> [:dshiftE]. + have diff_shift : differentiable (shift_sol p t0 : R^o -> _) t. + apply/diff_locallyP; split; last first. + apply/eqaddoE; rewrite dshift. + congr +%R. +(* 0.3.6: + (cst (shift_sol p t0 t) + *:%R^~ (F (shift_sol p t0 t)))%R = + (cst (shift_sol p t0 t) + 'd (shift_sol p t0) t)%R *) + congr +%R. + abstract: dshiftE. + have lin_scal : linear (fun h : R^o => h *: F (shift_sol p t0 t))%R. + by move=> ???; rewrite scalerDl scalerA. + pose glM := GRing.isLinear.Build _ _ _ _ _ lin_scal. + pose gL : {linear R^o -> U} := HB.pack ( *:%R^~ (F (shift_sol p t0 t))) glM. + have -> : (fun h : R^o => h *: F (shift_sol p t0 t))%R = gL by []. + apply/esym. + apply: diff_unique; first exact: scalel_continuous. + apply/eqaddoE; rewrite dshift. +(* 0.3.6: + (cst (shift_sol p t0 t) + *:%R^~ (F (shift_sol p t0 t)) + 'o_[filter of 0] id )%R = + (cst (shift_sol p t0 t) + Linear lin_scal + 'a_o_(nbhs_filter_on 0) id )%R *) + by []. + by rewrite -dshiftE; apply: scalel_continuous. + apply: DeriveDef; first exact/derivable1_diffP. + by rewrite deriveE // -dshiftE scale1r. +have /sol_is_sol [_ solp] := Kp. +have /solp solp' : (0 <= t + t0)%R by apply: addr_ge0 => //; apply: ltrW. +rewrite /shift_sol tge0. +move: tge0; rewrite le_eqVlt orbC => /orP [tgt0|/eqP teq0]. + apply/eqaddoP => _ /posnumP[e]; near=> s. + rewrite -![(_ + _ : _ -> _)%R _]/(_ + _)%R /=. + have /derivable_nbhs : derivable (sol p : R^o -> U) (t + t0) 1 by []. + rewrite funeqE => /(_ s) /=; rewrite addrA [(_%:A)%R]mulr1 =>->. + suff -> /= : (0 <= s + t)%R. + rewrite derive_val addrC addrA [(_ s + _)%R]addrC subrr add0r. + near: s. + case: e => /= e. + rewrite /Itv.num_sem/= num_real/= in_itv/= andbT. + move: e. + apply/(eqoP (nbhs_filter_on (0%R : R))). + (* 0.3.6: 'o_[filter of nbhs 0%R] id = 'o_(nbhs_filter_on 0%R) id *) + by []. + near: s; exists t => // s; rewrite /ball_ /= => ltst. + rewrite -lerBlDl sub0r; apply/ltW; apply: le_lt_trans ltst. + by rewrite sub0r ler_norm. +rewrite -teq0. +rewrite shift0. +rewrite add0r. +apply/eqaddoP => _ /posnumP[e]; near=> s. +rewrite -![(_ + _ : _ -> _)%R _]/(_ + _)%R /=. +rewrite -[t0]add0r/=. +rewrite {1 2 3 4 5 6}teq0. +have /derivable_nbhs dsol : derivable (sol p : R^o -> U) (t + t0) 1 by []. +have := dsol; rewrite funeqE => /(_ (- s)%R) /=; rewrite [(_%:A)%R]mulr1 =>->. +have := dsol; rewrite funeqE => /(_ s) /=; rewrite [(_%:A)%R]mulr1 =>->. +rewrite -{1}teq0 derive_val; case: (lerP 0 s) => [le0s|lts0]. + rewrite addrC addrA [(_ s + _)%R]addrC subrr add0r; near: s. + case: e => /= e. + rewrite /Itv.num_sem num_real in_itv/= andbT. + move: e. + apply/(eqoP (nbhs_filter_on (0%R : R))). +(* 0.3.6: + 'o_[filter of nbhs 0%R] id = 'o_(nbhs_filter_on 0%R) id *) + by []. +rewrite !opprD oppox /cst /= addrACA -[(- _ : _ -> _)%R _]/(- _)%R !addrA. +rewrite [X in (X *: _)%R](_ : _ = (1 + 1)%R); last by []. +rewrite scalerDl scale1r -[(_ - _ - sol _ _)%R]addrA -opprD subrr sub0r. +rewrite scaleNr opprK addrC addKr -[in X in (_ <= X)%R]normrN; near: s. +rewrite !near_simpl. +rewrite -(nearN (fun x : R^o => `|_ x| <= e%:num * `|x|%R))%R. +case: e => /= e. +rewrite /Itv.num_sem num_real in_itv/= andbT => e0. +near=> x. +set u := (X in `|X x|%R). +near: x. +exact: (@eqoP _ _ _ _ (nbhs_filter_on (0%R : R^o)) id u).1. +Unshelve. all: by end_near. Qed. + +Lemma solD p t0 t : + K p -> (0 <= t0)%R -> (0 <= t)%R -> sol p (t + t0) = sol (sol p t0) t. +Proof. +move=> Kp t0ge0 tge0; have /sol_shift /(_ t0ge0) /solP := Kp. +rewrite [shift_sol _ _ _]/shift_sol lexx. +rewrite add0r. +move=> <-; last exact: Kinvar. +by rewrite /shift_sol tge0. +Qed. + +Lemma invariant_plim p : K p -> is_invariant (cluster (sol p @ +oo%R)). +Proof. +move=> Kp q plim_q t0 t0_ge0 A B [M]. +wlog Mge0 : M / (0 <= M)%R => [sufMge0|] [Mreal solpMinfty_A]. + apply: (sufMge0 (maxr 0%R M)); first by rewrite le_max lexx. + split. + by rewrite max_real// real0. + by move=> x; rewrite gt_max => /andP[_]; apply: solpMinfty_A. +have Kq : K q. + apply: compact_closed => // C qC. + move: plim_q; apply => //. + exists 0%R; split => // t /ltW tge0. + exact: Kinvar. +move=> /(sol_cont Kq) /plim_q q_Bsolt0. +have /q_Bsolt0 [_ [[[t tgtM <-] _]]] : (sol p @ +oo%R) (sol p @` (> M)%R `&` A). + by exists M; split => // => t tgtM; split; [apply: imageP|apply: solpMinfty_A]. +have tge0 : (0 <= t)%R by apply/ltW; apply: le_lt_trans tgtM. +have Ksolpt : K (sol p t) by apply: Kinvar. +move=> /(_ Ksolpt) /=; rewrite -solD // => Bsolpt0t; exists (sol p (t0 + t)). +by split=> //; exact/solpMinfty_A/ltr_wpDl. +Qed. + +Definition limS (A : set U) := \bigcup_(q in A) cluster (sol q @ +oo%R). + +Lemma invariant_limS A : A `<=` K -> is_invariant (limS A). +Proof. +move=> sAK p [q Aq plimp] t tge0. +by exists q => //; apply: invariant_plim => //; apply: sAK. +Qed. + +Lemma nincr_lb_cvg (f : R -> R) : + (forall x y, 0 <= x <= y -> f y <= f x)%R -> + (exists M, f @` (>= 0)%R `<=` (> M)%R) -> cvg (f @ +oo%R). +Proof. +move=> fnincr [M ltMf]. +apply/cvg_ex; exists (inf (fun x => x \in f @` (>= 0)%R)). +move=> A /nbhs_ballP [_ /posnumP[e] infe_A]. +have imf_inf : has_inf (fun x => x \in f @` (>= 0)%R). + split; first by exists (f 0%R); rewrite in_setE; apply: imageP. + by exists M; apply/lbP => ?; rewrite in_setE => /ltMf /ltW. +have := imf_inf => /inf_adherent => /(_ e%:num)%R. +move=> /(_ (gt0 e)) [x]. +rewrite in_setE => -[t tge0 <-] ltftinfe. +exists t; rewrite num_real; split => // s ltts; apply: infe_A. +rewrite /ball/=. +rewrite distrC ger0_norm. + rewrite ltrBlDl. + by apply: le_lt_trans ltftinfe; apply: fnincr; rewrite tge0 (ltW ltts). +rewrite subr_ge0. +apply: inf_lbound => //. + by case: imf_inf. +rewrite in_setE; apply: imageP. +by apply: ltW; exact: le_lt_trans ltts. +Qed. + +(* todo: use directional derivative *) +Lemma stable_limS (V : U -> R^o) : + continuous_on K V -> + (forall p t, K p -> (0 <= t)%R -> derivable (V \o sol p : R^o -> R^o) t 1) -> + (forall (p : U), K p -> derive1 (V \o sol p) 0 <= 0)%R -> + limS K `<=` [set p | derive1 (V \o sol p) 0 = 0]%R. +Proof. +move=> Vcont Vsol_drvbl Vsol'le0 p [q Kq plimp]. +have ssqRpK : sol q @` (>= 0)%R `<=` K by move=> _ [t tge0 <-]; apply: Kinvar. +(* should be inferred *) +(*have atrF := at_right_proper_filter 0%R. (* is it now?*) *) +suff : exists l, cluster (sol q @ +oo%R) `<=` V @^-1` [set l]. + move=> [l Vpliml]/=; rewrite derive1E /derive cvg_at_rightE; last first. + apply: Vsol_drvbl => //; apply: compact_closed => //. + exact: sub_plim_clos_invar plimp. + apply: (@cvg_lim _ _ _ (at_right _)) => // A A0. + rewrite !near_simpl; near=> h. + rewrite /= sol0 addr0. + rewrite [X in sol p X](_ : _ = h); last by rewrite scaler1. + rewrite Vpliml//. + by rewrite Vpliml // subrr scaler0; apply: nbhs_singleton. + by apply: invariant_plim => //; apply: ltW; near: h; exists 1%R. +suff cvVsol : cvg (V \o sol q @ +oo%R). + exists (lim (V \o sol q @ +oo%R)); apply: (c0_cvg_cst_on_plim Vcont) => //. + exact: compact_closed. +apply: nincr_lb_cvg; last first. + have: compact (V @` K) by apply: continuous_on_compact. + move=> /compact_bounded [N imVltN]. + exists (- (N + 2))%R=> _ [t tge0 <-]. + suff : (`|(V \o sol q) t| < N + 2)%R by rewrite ltr_norml => /andP[]. + rewrite (@le_lt_trans _ _ (N + 1)%R)// ?ltrD2l ?ltr1n//. + by apply: imVltN.2; [rewrite ltrDl|apply/imageP/Kinvar]. +move=> s t /andP [sge0 slet]. +apply: (@ler0_derive1_le_cc _ _ s t); first 2 last. + apply: continuous_in_subspaceT => x. + rewrite inE/= in_itv/= => /andP[sx xt]. + have := Vsol_drvbl _ _ Kq (le_trans sge0 sx). + move/derivable1_diffP/differentiable_continuous. + exact. + by rewrite in_itv/= slet lexx. + by rewrite in_itv/= lexx slet. + by []. + move=> r rst. + apply: Vsol_drvbl => //; apply: le_trans sge0 _. + by rewrite (itvP rst). +move=> r rst. +have rge0 : (0 <= r)%R by apply: le_trans sge0 _; rewrite (itvP rst). +suff -> : derive1 (V \o sol q) r = derive1 (V \o (sol (sol q r))) 0. + exact/Vsol'le0/Kinvar. +rewrite derive1E /derive cvg_at_rightE; last exact: Vsol_drvbl. +rewrite derive1E /derive cvg_at_rightE; last first. + by apply: Vsol_drvbl => //; apply: Kinvar. +congr (lim _); rewrite predeqE /= nbhs_filterE => A; split. + move=> [_/posnumP[e] Ae]; exists e%:num%R=> //= x xe xgt0. + rewrite sol0/=. + rewrite addr0 -solD //; [exact: Ae|]. + by rewrite scaler1 ltW. +move=> [_/posnumP[e] Ae]; exists e%:num%R => //= x xe xgt0. +have /Ae - /(_ xe) := xgt0. +by rewrite sol0/= addr0 -solD// scaler1 ltW. +Unshelve. all: by end_near. Qed. + +Lemma cvg_to_limS (A : set U) : compact A -> is_invariant A -> + forall p, A p -> sol p @ +oo%R --> (limS A : set U). +Proof. +move=> Aco Ainvar p Ap B [_/posnumP[e] limSeB]. +apply: (cvg_to_plim _ Aco). + exists 0%R; split => //. + by move=> _/posnumP[?]; exact: Ainvar. +exists e%:num%R=> //= q [r plimr re_q]. +by apply: limSeB; exists r => //; exists p. +Qed. + +End DifferentialSystem. diff --git a/pendulum.v b/pendulum.v new file mode 100644 index 00000000..9ac0ff67 --- /dev/null +++ b/pendulum.v @@ -0,0 +1,1011 @@ +(* LaSalle (c) 2025 Inria and AIST. Licence: CeCILL-C. *) +(* -------------------------------------------------------------------------- *) +(* Copyright (c) - 2017 -- 2019 Inria *) +(* -------------------------------------------------------------------------- *) +From HB Require Import structures. +From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype choice seq. +From mathcomp Require Import order interval_inference. +From mathcomp Require Import fintype bigop ssralg ssrnum finmap interval ssrint. +From mathcomp Require Import matrix zmodp ring. +From mathcomp Require Import mathcomp_extra. +From mathcomp Require Import boolp reals classical_sets functions. +From mathcomp Require Import topology normedtype prodnormedzmodule landau derive. +Require Import lasalle. + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import GRing.Theory Num.Def Num.Theory Order.POrderTheory Order.TotalTheory. + +Import numFieldTopology.Exports. + +Local Open Scope classical_set_scope. +Local Open Scope ring_scope. + +Notation "p ..[ i ]" := (p 0 (inZp i)) (at level 10). + +Lemma poly2_factor {R : realType} (a b c x : R) : + a != 0 -> a * (x ^+ 2) + b * x + c = 0 -> + x = (- b + Num.sqrt (b ^+ 2 - 4%:R * a * c)) / (2 * a) \/ + x = (- b - Num.sqrt (b ^+ 2 - 4%:R * a * c)) / (2 * a). +Proof. +move=> ane0 xroot. +set dlt := b ^+ 2 - 4%:R * a * c. +set x1 := (- b + Num.sqrt dlt) / (2 * a). +set x2 := (- b - Num.sqrt dlt) / (2 * a). +suff poly_fact : a * (x ^+ 2) + b * x + c = a * (x - x1) * (x - x2). + move: xroot; rewrite poly_fact => /eqP; rewrite mulf_eq0 => /orP []. + by rewrite mulrI_eq0; [rewrite subr_eq0 => /eqP->; left|apply/lregP]. + by rewrite subr_eq0 => /eqP->; right. +rewrite /x1 /x2; case: (lerP 0 dlt) => [dltge0|dltlt0]. + rewrite -mulrA mulrBr mulrBl mulrBl opprB addrA [(x * x + _) + _]addrAC. + rewrite [_ / _ * x]mulrC. + rewrite -[in RHS](addrA (x * x + _)). + rewrite -(opprD (x * _)). + rewrite -mulrDr. + rewrite -mulrDl. + rewrite addrCA -[- b + _ - _]addrA subrr addr0 -mul2r. + rewrite invrM ?unitfE // [2 * _ * _]mulrC !mulrA mulfVK//. + rewrite addrAC mulrN opprK !mulrDr mulrA [a * (x / _ * _)]mulrCA !mulrA. + rewrite mulfVK// [b * _]mulrC; congr (_ + _ + _). + rewrite [a * _]mulrC -[_ * a * _]mulrA mulfV // mulr1. + rewrite ![_ * - _]mulrC !mulrA !mulrDr -!mulrDl !mulrN !mulNr !opprK. + rewrite [_ * Num.sqrt _]mulrC -addrA addKr -!expr2 sqr_sqrtr // /dlt. + rewrite opprD addrA subrr opprK add0r -mulrA -invrM ?unitfE //. + rewrite (_ : 4 = 2 * 2); last by rewrite -natrM. + rewrite mulrC !mulrA mulVf ?mul1r// (mulrC _ c) -mulrA divff ?mulr1//. + by rewrite mulf_eq0 negb_or ane0 pnatr_eq0. +move: xroot; have -> : a * (x ^+ 2) + b * x + c = + a * ((x + b / (2 * a)) ^+ 2) + (c - b ^+ 2 / (4%:R * a)). + rewrite [in RHS]expr2 -mulrA mulrDr mulrDl [c - _]addrC addrA !mulrDr. + rewrite -[_ - _]addrA -[a * _ + _ + _ in RHS]addrA; congr (_ + _ + _). + rewrite addrA [(x + _) * _]mulrDl mulrDr addrA -mulrDr [x * _]mulrC -mulrDl. + rewrite -[LHS]addr0 -addrA; congr (_ + _). + rewrite mulrA; congr (_ * _); rewrite -mulrDl invrM ?unitfE //. + rewrite mulrC -mulrA [_ * a]mulrC mulVKr ?unitfE // mulrDl. + exact: splitr. + rewrite !mulrA [a * _]mulrC -[b * a / _]mulrA invrM ?unitfE //. + rewrite mulVKr ?unitfE // [b / _ * _]mulrAC -[_ / 2 * _]mulrA -mulrBr. + rewrite [_^-1 * _]mulrCA invrM ?unitfE // -mulrBr -invrM ?unitfE //. + by rewrite -natrM subrr !mulr0. +suff : a * (x + b / (2 * a)) ^+ 2 + (c - b ^+ 2 / (4%:R * a)) != 0. + by move=> pn0 p0; move: pn0; rewrite p0 eq_refl. +have := ane0; rewrite neq_lt => /orP [alt0|agt0]; last first. + apply:lt0r_neq0; rewrite ltr_wpDl //; first by rewrite pmulr_rge0 // sqr_ge0. + rewrite subr_gt0 ltr_pdivrMr; last by rewrite pmulr_rgt0. + by rewrite mulrC -subr_lt0. +rewrite -oppr_eq0 opprD; apply: lt0r_neq0; rewrite ltr_wpDl //. + by rewrite oppr_ge0 nmulr_rle0 // sqr_ge0. +rewrite oppr_gt0 subr_lt0 ltr_ndivlMr; last by rewrite mulrC nmulr_rlt0. +by rewrite mulrC -subr_lt0. +Qed. + +Lemma deriveE' {R : realType} (V W : normedModType R) (f : V -> W) x v : + derive f x v = derive (fun h : R^o => f (h *: v + x)) 0 1. +Proof. +rewrite /derive. +set g1 := fun h => h^-1 *: _; set g2 := fun h => h^-1 *: _. +suff -> : g1 = g2 by []. +by rewrite funeqE /g1 /g2 => h /=; rewrite addr0 scale0r add0r [_%:A]mulr1. +Qed. + +Lemma bounded_poly {R : realType} (a b c d : R) : + 0 < a -> \forall M \near +oo, forall x, + a * (x ^+ 2) - (b * `|x|) - c < d -> `|x| < M. +Proof. +move=> agt0. +suff ptoinfty : (fun x => a * (x ^+ 2) - (b * `|x|) - c) @ +oo --> +oo. + have dleatinfty : +oo (>= d). + exists d; split => //. + by rewrite num_real. + by move=> // ? /ltW. + have /ptoinfty [M1 [M1real sgtM1pged]] := dleatinfty; near=> M. + move=> x pxltd; rewrite ltNge; apply/negP => Mlex. + move: pxltd; rewrite ltNge => /negP; apply. + rewrite -(@ger0_norm _ `|x|) // -(@ger0_norm _ (_ ^+ 2)) ?sqr_ge0 // normrX. + by apply: sgtM1pged; apply: lt_le_trans Mlex; near: M; exists M1. +move=> A [M [Mreal sgtMA]]; rewrite !near_simpl; near=> x. +have lt0x : 0 < x by []. +rewrite ger0_norm ?ltW //; apply: sgtMA. +rewrite ltrBrDr expr2 mulrA -mulrBl; apply: le_lt_trans (ler_norm _) _. +rewrite -[ `|_|%R]sqr_sqrtr // expr2; apply: ltr_pM; last 1 first. +- by near: x; exists (Num.sqrt `|M + c|); split => //. +- exact: sqrtr_ge0. +- exact: sqrtr_ge0. +rewrite ltrBrDr -ltr_pdivrMl //; near: x. +exists (a^-1 * (Num.sqrt `|M + c| + b)); split => //. +rewrite realM//. + by rewrite realV// num_real. +by rewrite realD// num_real. +Unshelve. all: by end_near. Qed. + +(* TODO: generalize *) +Lemma eq0_derive1_cst {R : realType} (f : R^o -> R^o) (a b : R) : + (forall t, t \in `[a, b] -> is_derive (t : R^o) 1 f 0) -> + forall t, t \in `[a, b] -> f t = f a. +Proof. +move=> f'eq0 t tab; apply/eqP; rewrite eq_le; apply/andP; split. + apply: (@ler0_derive1_le_cc _ _ a b) => //; rewrite ?(itvP tab) //;[ + by move=> x /subset_itv_oo_cc /f'eq0 // df; rewrite derive1E derive_val..|]. + apply: continuous_in_subspaceT => x. + rewrite inE/= => /f'eq0. + move=> /(@ex_derive _ [the normedModType R of R^o]). + move=> /derivable1_diffP /differentiable_continuous. + exact. +apply: (@ger0_derive1_ndecr _ _ a b) => //; rewrite ?(itvP tab) //;[ + by move=> x /subset_itv_oo_cc /f'eq0 // df; rewrite derive1E derive_val..|]. +apply: continuous_in_subspaceT => x. +rewrite inE/= => /f'eq0. +move=> /(@ex_derive _ [the normedModType R of R^o]). +move=> /derivable1_diffP /differentiable_continuous. +exact. +Qed. + +Lemma is_derive_nneg_eq {R : realType} (f h : R^o -> R^o) (t : R^o) l1 l2 : + (forall t, 0 <= t -> f t = h t) -> 0 <= t -> + is_derive t 1 f l1 -> is_derive t 1 h l2 -> l1 = l2. +Proof. +move=> feg tge0 df dh. +have /@derive_val <- := df; have /@derive_val <- := dh. +apply: subr0_eq; rewrite -deriveB // /derive cvg_at_rightE; last first. + by rewrite -[cvg _]/(derivable _ _ _). +apply: cvg_lim => A A0. + by rewrite -closeEnbhs norm_closeE. +rewrite !near_simpl; near=> r. +rewrite /= -![(_ - _ : _ -> _) _]/(_ - _) !feg //. + by rewrite !subrr scaler0; apply: nbhs_singleton. +by rewrite addr_ge0 // [_%:A]mulr1 ltW //; near: h; exists 1. +Unshelve. all: by end_near. Qed. + +Section System. +Context {R : realType}. +Variable m M l g : {posnum R}. + +Variable ke kv kx kd : {posnum R}. + +Notation U := 'rV[R]_5. + +(* p = (x, x', cos theta, sin theta, theta') *) +Definition E (p : U) := + (1 / 2) * ((M%:num + m%:num) * (p..[1] ^+ 2) + + m%:num * (l%:num ^+ 2) * (p..[4] ^+ 2)) + + m%:num * l%:num * p..[1] * p..[2] * p..[4] + + m%:num * l%:num * g%:num * (p..[2] - 1). + +Definition fctrl (p : U) := + (kv%:num * m%:num * p..[3] * (g%:num * p..[2] - l%:num * (p..[4] ^+ 2)) - + (M%:num + m%:num * (p..[3] ^+ 2)) * (kx%:num * p..[0] + kd%:num * p..[1])) / + (kv%:num + (M%:num + m%:num * (p..[3] ^+ 2)) * ke%:num * (E p)). + +Definition Fpendulum (p : U) : U := + \row_(i < 5) nth 0 + [:: p..[1] + ; ((m%:num * p..[3] * (l%:num * (p..[4] ^+ 2) - g%:num * p..[2]) + + (fctrl p)) / (M%:num + m%:num * (p..[3] ^+ 2))) + ; - p..[3] * p..[4] + ; p..[2] * p..[4] + ; (((M%:num + m%:num) * g%:num * p..[3] - + p..[2] * (m%:num * l%:num * (p..[4] ^+ 2) * p..[3] + (fctrl p))) / + (l%:num * (M%:num + m%:num * (p..[3] ^+ 2))))] i. + +Definition V (p : U) := + (ke%:num / 2) * ((E p) ^+ 2) + (kv%:num / 2) * (p..[1] ^+ 2) + + (kx%:num / 2) * (p..[0] ^+ 2). + +Global Instance is_diff_component n i (p : 'rV[R]_n.+1) : + is_diff p (fun q => q..[i] : R^o) (fun q => q..[i]). +Proof. +have comp_lin : linear (fun q : 'rV[R]_n.+1 => q..[i] : R^o). + by move=> ???; rewrite !mxE. +have comp_cont : continuous (fun q : 'rV[R]_n.+1 => q..[i] : R^o). + move=> q A [_/posnumP[e] Ae] /=; apply/nbhs_ballP; exists e%:num => //=. + by move=> r [e0] /(_ ord0) /(_ (inZp i)) /Ae. +pose glM := GRing.isLinear.Build _ _ _ _ _ comp_lin. +pose gL : {linear 'rV_n.+1 -> R^o} := HB.pack (fun q : 'rV_n.+1 => q ..[ i]) glM. +apply: DiffDef; first exact: (@linear_differentiable _ _ _ gL). +by rewrite (@diff_lin _ _ _ gL). +Qed. + +Global Instance is_diff_component_comp (V : normedModType R) n + (f : V -> 'rV[R]_n.+1) i p df : is_diff p f df -> + is_diff p (fun q => (f q)..[i] : R^o) (fun q => (df q)..[i]). +Proof. +move=> dfp. +have -> : (fun q => (f q)..[i]) = (fun v => v..[i]) \o f by rewrite funeqE. +(* This should work *) +(* apply: is_diff_eq. *) +exact: is_diff_comp. +Qed. + +Global Instance is_derive_component (V : normedModType R) n + (f : V -> 'rV[R]_n.+1) i x v df : + is_derive x v f df -> is_derive x v (fun q => (f q)..[i] : R^o) (df..[i]). +Proof. +move=> dfx. +have diff_f : is_diff (0 : [the normedModType _ of R^o]) (fun h => f (h *: v + x)) ( *:%R^~ df ). + have /derivable1P/derivable1_diffP fdrvbl : derivable f x v by []. + by apply: DiffDef => //; rewrite diff1E // derive1E -deriveE' derive_val. +apply: DeriveDef; first exact/derivable1P/derivable1_diffP. +by rewrite deriveE' deriveE // diff_val scale1r. +Qed. + +Lemma V_continuous : continuous V. +Proof. +by move=> ?; apply: (@differentiable_continuous _ _ R^o). +Qed. + +Variable k0 : R. +Let B := ke%:num * ((minr (kv%:num / (ke%:num * (M%:num + m%:num))) + (2 * m%:num * g%:num * l%:num)) ^+ 2) / 2. +(* restriction to make fctrl smooth *) +Hypothesis k0_valid : k0 < B. + +Definition K : set U := + [set p : U | (p..[2] ^+ 2) + (p..[3] ^+ 2) = 1 /\ V p <= k0]. + +Lemma expr_continuous n : continuous (fun x : R^o => x ^+ n.+1 : R^o). +Proof. +move=> x; suff : differentiable (fun y : R^o => y ^+ n.+1) x. + by apply: differentiable_continuous. +suff -> : (fun y => y ^+ n.+1) = ((id : R^o -> R^o) ^+ n.+1) by []. +by rewrite exprfctE. +Qed. + +Lemma circle_closed : closed [set p : U | p..[2] ^+ 2 + p..[3] ^+ 2 = 1]. +Proof. +move=> p clcircp. +apply/close_eq => //=; first exact: Rhausdorff. +rewrite (@ball_close _ R^o) => e /=. +have : nbhs (p ..[ 2] ^+ 2) (ball (p ..[ 2] ^+ 2) ((e%:num / 2)%:pos)%:num). + by apply: nbhsx_ballx. +move=> /expr_continuous [_/posnumP[e1] p2e1_sp2he]. +have : nbhs (p ..[ 3] ^+ 2) (ball (p ..[ 3] ^+ 2) ((e%:num / 2)%:pos)%:num). + by apply: nbhsx_ballx. +move=> /expr_continuous [_ /posnumP[e2] p3e2_sp3he]. +have [q [circq [e0 pme12_q]]] : + [set p : U | p..[2] ^+ 2 + p..[3] ^+ 2 = 1] `&` + ball p (minr e1%:num e2%:num) !=set0. + apply/clcircp. + rewrite /minr. + by case: ifPn => // ?; apply/nbhsx_ballx. +rewrite -circq. +rewrite /ball/=. +rewrite opprD addrACA; apply: le_lt_trans (ler_normD _ _) _. +by rewrite (splitr e%:num) ltrD //; [apply/p2e1_sp2he|apply/p3e2_sp3he]; + apply: le_ball (pme12_q _ _); rewrite ge_min lexx // orbC. +Qed. + +Lemma preimV_lek0_closed : closed (V @^-1` (<= k0 : _ -> _)). +Proof. +by apply: closed_comp; [move=> ??; apply: V_continuous|apply: closed_le]. +Qed. + +Lemma K_closed : closed K. +Proof. exact: closedI circle_closed preimV_lek0_closed. Qed. + +Lemma K_bounded : bounded_set K. +Proof. +suff : \forall M \near +oo, forall p, K p -> forall i, `|p ord0 i| < M. + rewrite /bounded_set; apply: filter_app; near=> M0. + move=> Kbnd /= p /Kbnd ltpM0. + rewrite /normr/=. + rewrite mx_normrE. + apply/bigmax_leP; split => //= i _. + rewrite ord1. + exact/ltW/ltpM0. +suff : \forall M \near +oo, forall p, K p -> `| p..[0] | < M /\ + `| p..[1] | < M /\ `| p..[2] | < M /\ `| p..[3] | < M /\ `| p..[4] | < M. + apply: filter_app; near=> M0. + move=> Kbnd p /Kbnd [ltp0M [ltp1M [ltp2M [ltp3M ltp4M]]]]. + case; do 5 ?[case; first by move=> ?; rewrite -[ Ordinal _ ]natr_Zp Zp_nat]. + by move=> n ?; suff : (n.+1.+4 < 5)%N by rewrite !ltnS ltn0. +have K1bnd : \forall M \near +oo, forall p, K p -> `| p..[1] | < M. + near=> M0 => p [_ Vps]. + suff /lt_trans : `| p..[1] | < Num.sqrt (2 * B / kv%:num). + by apply; near: M0; exists (Num.sqrt (2 * B / kv%:num)); split => //. + rewrite -sqrtr_sqr ltr_sqrt // mulrAC -ltr_pdivrMl // invf_div; last first. + by rewrite mulr0 /B/=. + apply: le_lt_trans k0_valid; apply: le_trans Vps. + by rewrite [V _]addrAC lerDr addr_ge0 // pmulr_rge0 // sqr_ge0. +apply: filter_app (K1bnd); near=> M0. +move=> K1ltM p Kp; have [circp Vps] := Kp; split. + suff /lt_trans : `| p..[0] | < Num.sqrt (2 * B / kx%:num). + by apply; near: M0; exists (Num.sqrt (2 * B / kx%:num)); split => //. + rewrite -sqrtr_sqr ltr_sqrt // mulrAC -ltr_pdivrMl // invf_div; last first. + by rewrite mulr0 /B. + apply: le_lt_trans k0_valid; apply: le_trans Vps. + by rewrite lerDr addr_ge0 // pmulr_rge0 // sqr_ge0. +split; first exact: K1ltM; split. + suff /le_lt_trans : `| p..[2] | <= 1. + apply. + by near: M0; exists 1. + by rewrite -sqrtr_sqr -sqrtr1 ler_sqrt // -circp lerDl sqr_ge0. +split. + suff /le_lt_trans : `| p..[3] | <= 1. + apply. + by near: M0; exists 1. + by rewrite -sqrtr_sqr -sqrtr1 ler_sqrt // -circp lerDr sqr_ge0. +move: p Kp {circp Vps}; near: M0; rewrite /= !near_simpl. +have [M1 [M1real sgtM1gtK1]] := K1bnd. +have := bounded_poly (m%:num * l%:num * ((`|M1| + 1) ^+ 2)) + (m%:num * l%:num * g%:num * ((`|M1| + 1) + 1)) (Num.sqrt (2 * B / ke%:num)) + [gt0 of m%:num * (l%:num ^+ 2) / 2]. +apply: filter_app; near=> M0 => sEsltM0 p Kp; have [circp Vps] := Kp. +apply: sEsltM0. +have : E p < Num.sqrt (2 * B / ke%:num). + apply: le_lt_trans (ler_norm _) _. + rewrite -sqrtr_sqr ltr_sqrt // mulrAC -ltr_pdivrMl // invf_div; last first. + by rewrite mulr0 /B. + apply: le_lt_trans k0_valid; apply: le_trans Vps. + by rewrite -[V _]addrA lerDl addr_ge0 // pmulr_rge0 // sqr_ge0. +apply: le_lt_trans; apply: lerD; last first. + rewrite -mulrN opprD ler_wpM2l //. + rewrite lerD2r lerNl. + rewrite ler_wpDl // (le_trans (ler_norm _)) // normrN. + rewrite -sqrtr_sqr. + by rewrite -sqrtr1 ler_sqrt // -circp lerDl sqr_ge0. +rewrite mulrDr [1 / 2 * _ + _]addrC -addrA [1 / 2 * _]mulrCA mul1r mulrA. +rewrite /=. +rewrite (expr2 l%:num) lerD2l; apply: ler_wpDl. + by rewrite pmulr_rge0 // pmulr_rge0 // sqr_ge0. +rewrite -mulrN -!mulrA ler_wpM2l // ler_wpM2l // !mulrN lerNl. +suff : `| p..[1] | * (`| p..[2] | * `| p..[4] |) <= + (`|M1| + 1) * ((`|M1| + 1) * `| p..[4] |). + by apply: le_trans; rewrite -!normrM -normrN ler_norm. +rewrite !mulrA ler_wpM2r // ler_pM //. + apply/ltW/sgtM1gtK1 => //; apply: le_lt_trans (ler_norm _) _. + by rewrite ltrDl. +have /(le_trans _) : 1 <= `|M1| + 1 by rewrite lerDr. +by apply; rewrite -sqrtr_sqr -sqrtr1 ler_sqrt // -circp lerDl sqr_ge0. +Unshelve. all: by end_near. Qed. + +Lemma K_compact : compact K. +Proof. exact: bounded_closed_compact K_bounded K_closed. Qed. + +Lemma Mp_ms_gt0 (p : U) : 0 < M%:num + m%:num * (p..[3] ^+ 2). +Proof. by rewrite ltr_pwDl // pmulr_rge0 // sqr_ge0. Qed. + +Lemma E_small p : V p < B -> `|E p| < kv%:num / (ke%:num * (M%:num + m%:num)). +Proof. +move=> Vp_s; rewrite -ltr_sqr ?nnegrE // -normrX ger0_norm ?sqr_ge0 //. +suff : 2 * (V p) / ke%:num < (kv%:num / (ke%:num * (M%:num + m%:num))) ^+ 2. + apply: le_lt_trans. + rewrite ler_pdivlMr // -ler_pdivrMl // mulrC -mulrA mulrC. + by rewrite /V -addrA lerDl addr_ge0 // pmulr_rge0 // sqr_ge0. +rewrite ltr_pdivrMr // mulrC -ltr_pdivlMr // (lt_le_trans Vp_s) //. +rewrite -mulrA mulrCA mulrA; apply: ler_pM => //; apply: ler_pM => //. +rewrite lerXn2r// ?nnegrE//. +by rewrite ge_min/= lexx. +Qed. + +Lemma fctrl_wdef (p : U) : (p..[2] ^+ 2) + (p..[3] ^+ 2) = 1 -> V p < B -> + kv%:num + (M%:num + m%:num * (p..[3] ^+ 2)) * ke%:num * (E p) != 0. +Proof. +move=> circp Vp_s; rewrite -normr_gt0. +rewrite -[X in X + _](@mulfVK _ ((M%:num + m%:num * (p..[3] ^+ 2)) * ke%:num)); + last by rewrite lt0r_neq0 // pmulr_rgt0 // Mp_ms_gt0. +rewrite mulrC -mulrDr normrM pmulr_rgt0; last first. + by rewrite normrM pmulr_rgt0 gtr0_norm // Mp_ms_gt0. +apply: lt_le_trans (lerB_normD _ _). +rewrite subr_gt0; apply: lt_le_trans (E_small Vp_s) _. +rewrite ger0_norm; last first. + by rewrite pmulr_rge0 // invr_ge0 pmulr_rge0 // Mp_ms_gt0. +rewrite ler_pM // lef_pV2 ?posrE //; last by rewrite pmulr_rgt0 // Mp_ms_gt0. +rewrite mulrC ler_pM //; first exact/ltW/Mp_ms_gt0. +rewrite lerD2l -{2}[m%:num]mulr1 ler_pM // ?sqr_ge0 //. +by rewrite -circp lerDr sqr_ge0. +Qed. + +(* TODO: show that Fpendulum is smooth in K and remove these hypotheses using + Cauchy-Lipschitz *) +Variable sol : U -> R -> U. +Hypothesis (sol0 : forall p, sol p 0 = p). +Hypothesis solP : forall y, K (y 0) -> is_sol Fpendulum y <-> y = sol (y 0). +Hypothesis sol_cont : forall t, continuous_on K (sol^~ t). + +Lemma circ_invar p : + K p -> forall t, 0 <= t -> (sol p t)..[2] ^+ 2 + (sol p t)..[3] ^+ 2 = 1. +Proof. +move=> Kp /= t tge0; have [circp _] := Kp; rewrite -circp -[in RHS](sol0 p). +pose f s := (sol p s)..[2] ^+ 2 + (sol p s)..[3] ^+ 2; rewrite -!/(f _). +(* BUG in unification *) +apply (@eq0_derive1_cst R (f : R^o -> R^o) 0 t); last first. + by rewrite in_itv/= lexx tge0. +move=> s s0t; have sge0 : s >= 0 by rewrite (itvP s0t). +have [_ /(_ _ sge0) dsol] := sol_is_sol sol0 solP Kp. +apply: is_derive_eq. +rewrite 2!mxE/=. +rewrite /GRing.scale/=. +rewrite mulrCA. +by rewrite -!mulrDr addrC mulNr subrr. +Qed. + +Lemma is_derive_Esol p t : + K p -> 0 <= t -> is_derive (t : R^o) 1 (E \o (sol p) : _ -> R^o) + ((sol p t)..[1] * fctrl (sol p t)). +Proof. +move=> Kp tge0; have [_ /(_ _ tge0) sol_att] := sol_is_sol sol0 solP Kp. +apply: is_derive_eq. +have /eqP : (sol p t)..[2] ^+ 2 + (sol p t)..[3] ^+ 2 = 1 by apply: circ_invar. +rewrite eq_sym addrC -subr_eq => /eqP circp. +have Mpmsne0 : M%:num + m%:num * (sol p t)..[3] ^+ 2 != 0. + by rewrite lt0r_neq0 // Mp_ms_gt0. +rewrite subr0 !mxE /= -circp -![_ *: _]/(_ * _) invrM ?unitfE //; last first. + by rewrite circp. +set q := sol _ _ _; set x := (M%:num + m%:num * _)^-1; set y := fctrl _. +rewrite [x / _]mulrC; do ![rewrite ?[_ * (_ * x)]mulrA -?(mulrDl _ _ x)]. +rewrite [_ * (_ + _ * x)]mulrDr [_ * (_ * x)]mulrA [_ + _ * x]addrC. +do 2 rewrite addrA -(mulrDl _ _ x). +rewrite -!mul2r mul1r mulrDr; do 2 rewrite [2^-1 * _]mulrCA. +do 2 rewrite [2^-1 * _]mulrA mulVf // mul1r. +rewrite [_ / _]mulrC. +rewrite ![_ * (_^-1 * _)]mulrA. +rewrite [_ * (_ / _ * _)]mulrA. +rewrite -(addrA ((M%:num + m%:num) * + (q (inZp 1) * + (m%:num * q (inZp 3) * (l%:num * q (inZp 4) ^+ 2 - g%:num * q (inZp 2)) + y)))). +rewrite -mulrDl. +rewrite [in _ * x]addrAC ![_ * (_ * (_ + _))]mulrA -mulrDl. +rewrite -addrA [_ * (_ * (- _ * _))]mulrA -mulrDl. +apply/(canLR (subrK _))/(canLR (mulfK _)); first by rewrite circp. +rewrite [RHS]mulrDl !mulNr [in RHS]mulrAC; apply: (canRL (addrK _)). +rewrite [(_ + _) * _]mulrDr addrAC [_ + _ * y + _]addrAC. +by field; rewrite gt_eqF. +(* this used to work with MathComp 2.4.0: +apply: (canLR (subrK _)); rewrite -mulrBl [_ * (_ + y)]mulrDr opprD addrA. +rewrite [_ * (_ - _ * y)]mulrDr addrA -[- (_ * y)]mulNr [_ * (_ * y)]mulrA. +rewrite [_ + _ * y + _]addrAC; apply: (canLR (subrK _)); rewrite -mulrBl. +rewrite [in RHS]mulrN opprK mulrACA [_ ^+2 / _]mulrAC mulfVK//. +rewrite [_ / _]mulrC ![_^-1 * _]mulrA [_^-1 * _ * _]mulrC mulVKf//. +ring. +*) +Qed. + +Lemma is_deriv_Vsol p t : + K p -> 0 <= t -> V (sol p t) < B -> + is_derive (t : R^o) 1 (V \o (sol p) : _ -> R^o) + (- kd%:num * ((sol p t)..[1] ^+ 2)). +Proof. +move=> Kp tge0 Vsolpt_s. +have [_ /(_ _ tge0) sol_att] := sol_is_sol sol0 solP Kp. +have Esol' := is_derive_Esol Kp tge0; apply: is_derive_eq. +rewrite [in X in _ + X]mxE /= -!mul2r -![_ *: _]/(_ * _). +do 3 rewrite [_ / _]mulrC [_^-1 * _ * _]mulrCA -[_ ^-1 * _ * _]mulrA mulVKf //. +rewrite [_ * fctrl _]mulrC [_ * Fpendulum _ _ _]mulrC mulrA mulrA -addrA. +rewrite ![in X in _ + X]mulrA -!mulrDl expr2 [RHS]mulrA; congr (_ * _). +rewrite addrA mxE /=. +have Mpmsne0 : M%:num + m%:num * (sol p t)..[3] ^+ 2 != 0. + by rewrite lt0r_neq0 // Mp_ms_gt0. +apply: (canLR (subrK _)); rewrite [kv%:num * _]mulrA. +rewrite -[_ * fctrl _](mulfVK Mpmsne0) [_ / _ * _]mulrAC -mulrDl. +apply: (canLR (mulfK _)) => //; rewrite [kv%:num * _]mulrDr addrA addrAC. +apply: (canLR (subrK _)); rewrite mulrAC -mulrDl /fctrl [LHS]mulrA. +have circp : (sol p t)..[2] ^+ 2 + (sol p t)..[3] ^+ 2 = 1 by apply: circ_invar. +have ? := fctrl_wdef circp Vsolpt_s; apply: (canLR (mulfK _)) => //. +ring. +Qed. + +Lemma defset_invar p : K p -> forall t, 0 <= t -> + (sol p t)..[2] ^+ 2 + (sol p t)..[3] ^+ 2 = 1 /\ V (sol p t) < B. +Proof. +move=> Kp t tge0; split; first exact: circ_invar. +set A := [set t | (0 <= t) && (B <= V (sol p t))]. +case: (pselect (nonempty A))=> [An0 |]; last first. + move=> /asboolPn /forallp_asboolPn /(_ t) /negP. + by move => /nandP []; + [rewrite tge0|rewrite -ltNge]. +have infA : has_inf A. + by split=> //; exists 0; apply/lbP => ? /andP []. +exfalso=> {t tge0}; have infge0 : 0 <= inf A. + by apply: lb_le_inf => //; apply/lbP => ? /andP []. +have Vsolp_drvbl t : 0 <= t -> derivable (V \o (sol p) : R^o -> R^o) t 1. + by move=> tge0; have [_ /(_ _ tge0) sol_att] := sol_is_sol sol0 solP Kp. +have Vsolpinf_geB : B <= V (sol p (inf A)). + case: (lerP B (V (sol p (inf A)))) => // Vsolpinf_ltB; rewrite falseE. + have Vsolp_cont : {for inf A, continuous (V \o (sol p))}. + suff /differentiable_continuous : + differentiable (V \o sol p : R^o -> R^o) (inf A) by []. + exact/derivable1_diffP/Vsolp_drvbl. + have BmVsolps_gt0 : 0 < B - V (sol p (inf A)) by rewrite subr_gt0. + have /Vsolp_cont := nbhsx_ballx (V (sol p (inf A))) _ BmVsolps_gt0. + move=> [_ /posnumP[e] /= infe_Vsolp]. + suff : inf A + e%:num / 2 <= inf A. + by rewrite leNgt => /negP; apply; rewrite ltrDl. + apply: lb_le_inf An0 _; apply/lbP => s /andP [sge0 Vsolps_geB]. + rewrite leNgt; apply/negP => ltsinfphe; have leinfs : inf A <= s. + apply: inf_lbound => //. + by case: infA. + by rewrite /A/= sge0 Vsolps_geB. + suff /infe_Vsolp : ball (inf A) e%:num s. + rewrite /ball/= distrC => /(le_lt_trans (ler_norm _)). + by rewrite ltNge => /negP; apply; rewrite lerB. + rewrite /ball/= distrC ger0_norm ?subr_ge0 // ltrBlDl. + by apply: lt_trans ltsinfphe _; rewrite ltrD2l {2}[e%:num]splitr ltrDl. +have Vsol_drvbl t : t \in `]0, (inf A)[ -> + is_derive (t : R^o) 1 (V \o sol p : _ -> R^o) + (- kd%:num * (sol p t)..[1] ^+ 2). + move=> t0inf; apply: is_deriv_Vsol => //; first by rewrite (itvP t0inf). + rewrite ltNge; apply/negP => Vsolpt_geB; suff : inf A <= t. + by rewrite leNgt => /negP; apply; rewrite (itvP t0inf). + apply: inf_lbound => //. + by case: infA. + apply/andP; split=> //. + by rewrite (itvP t0inf). +have : {in `[0, (inf A)]%classic, continuous (V \o sol p)}. + move=> t t0inf; suff /differentiable_continuous : + differentiable (V \o sol p : R^o -> R^o) t by []. + apply/derivable1_diffP/Vsolp_drvbl. + rewrite inE/= in t0inf. + by rewrite (itvP t0inf). +move/continuous_in_subspaceT. +move=> /(MVT_segment infge0)[t t0inf]. +rewrite /comp sol0 subr0 => dVsol. +have infgt0 : 0 < inf A. + rewrite lt_def; apply/andP; split=> //. + apply/negP => /eqP infA0; have := Vsolpinf_geB. + rewrite leNgt => /negP; apply; rewrite infA0 sol0. + by apply: le_lt_trans k0_valid; have [] := Kp. +have : V (sol p (inf A)) - V p <= 0. + by rewrite dVsol !mulNr oppr_le0 pmulr_lge0 // pmulr_rge0 // sqr_ge0. +rewrite leNgt => /negP; apply. +rewrite subr_gt0; apply: lt_le_trans Vsolpinf_geB. +by apply: le_lt_trans k0_valid; have [] := Kp. +Qed. + +Lemma is_derive_Vsol p (t : R^o) : + K p -> 0 <= t -> is_derive t 1 (V \o sol p : _ -> R^o) + (- kd%:num * (sol p t)..[1] ^+ 2). +Proof. +move=> Kp tge0; have [circpt Vpts] := defset_invar Kp tge0. +exact: is_deriv_Vsol. +Qed. + +Lemma Kinvar : is_invariant sol K. +Proof. +move=> p Kp t tge0; have [_ Vp_s] := Kp; split; first exact: circ_invar. +apply: le_trans Vp_s; rewrite -{2}[p]sol0. +have Vsol_deriv : forall s, s \in `[0, t] -> + is_derive (s : R^o) 1 (V \o sol p : _ -> R^o) + (- kd%:num * (sol p s)..[1] ^+ 2) by move=> s /andP [/(is_derive_Vsol Kp)]. +apply: (@ler0_derive1_le_cc _ (V \o sol p) 0 t);[| | | | |by []]. +- move=> x /subset_itv_oo_cc /Vsol_deriv. + by apply: (@ex_derive _ [the normedModType R of R^o]). +- move=> x /subset_itv_oo_cc /Vsol_deriv. + rewrite derive1E. + case => _ ->. + by rewrite mulr_le0_ge0// sqr_ge0. +- apply: continuous_in_subspaceT => x. + rewrite inE/= => /Vsol_deriv. + move=> /(@ex_derive _ [the normedModType R of R^o]). + move=> /derivable1_diffP /differentiable_continuous. + exact. +- by rewrite in_itv/= lexx tge0. +- by rewrite in_itv/= lexx tge0. +Qed. + +Definition homoclinic_orbit : set U := [set p : U | p..[0] = 0 /\ p..[1] = 0 /\ + (1 / 2) * m%:num * (l%:num ^+ 2) * (p..[4] ^+ 2) = + m%:num * g%:num * l%:num * (1 - p..[2])]. + +Lemma homoclinicE : + homoclinic_orbit = [set p : U | p..[0] = 0 /\ p..[1] = 0 /\ E p = 0]. +Proof. +rewrite predeqE => p; split. + move=> [p0eq0 [p1eq0 /eqP]]; rewrite -subr_eq0 => /eqP homoeq. + split=> //; split=> //; rewrite -homoeq /E p1eq0 expr0n /=. + rewrite !mulr0 !mul0r addr0 add0r mulrA [_ / _ * _]mulrA -mulrN opprB. + by rewrite [_ * _ * g%:num]mulrAC. +move=> [p0eq0 [p1eq0 Epeq0]]; split=> //; split=> //. +apply: subr0_eq. +rewrite -[RHS]Epeq0 /E p1eq0 expr0n /=. +rewrite !mulr0 !mul0r addr0 add0r [in RHS] mulrA [_ / _ * _ in RHS]mulrA -mulrN. +by rewrite opprB [_ * _ * g%:num]mulrAC. +Qed. + +Lemma limSKinvar : is_invariant sol (limS sol K). +Proof. +move=> p limSKp t tge0. +exact: (@invariant_limS _ _ _ _ K_compact _ sol0 solP sol_cont Kinvar). +Qed. + +Lemma subset_limSK_K : limS sol K `<=` K. +Proof. +move=> p [q Kq solq_top]. +apply: compact_closed (@norm_hausdorff _ _) K_compact _ _. +have solqK : (sol q @ +oo) K. + exists 0; split. + by rewrite real0. + by move=> ? /ltW; exact: Kinvar. +by move=> A /solq_top - /(_ _ solqK) [r []]; exists r. +Qed. + +Lemma Vsol'_eq0 p t : + limS sol K p -> 0 <= t -> derive1 (V \o sol p : _ -> R^o) t = 0. +Proof. +move=> limSKp tge0; have limSKsolp : limS sol K (sol p t) by apply: limSKinvar. +have Kp : K p by apply: subset_limSK_K. +have -> : derive1 (V \o sol p : _ -> R^o) t = + derive1 (V \o sol (sol p t) : _ -> R^o) 0. + have dVsolt := is_derive_Vsol Kp tge0; rewrite derive1E derive_val. + have Ksolpt : K (sol p t) by apply: subset_limSK_K. + have dVsolt' := is_derive_Vsol Ksolpt (lexx _); rewrite derive1E derive_val. + rewrite -(solD sol0 solP Kinvar) //. + by rewrite add0r. +apply: (stable_limS K_compact sol0 solP sol_cont Kinvar (V:=V)) limSKsolp. +- move=> q Kq; have /(_ q) := V_continuous; apply: cvg_trans. + exact: cvg_app (@cvg_within _ _ _ _). +- by move=> q s Kq sge0; have := is_derive_Vsol Kq sge0. +- move=> q Kq; have dVsolq := is_derive_Vsol Kq (lexx _). + by rewrite derive1E derive_val mulNr oppr_le0 pmulr_rge0 // sqr_ge0. +Qed. + +Lemma sol1_eq0 p t : limS sol K p -> 0 <= t -> (sol p t)..[1] = 0. +Proof. +move=> limSKp tge0; have Kp : K p by apply: subset_limSK_K. +have dVsol := is_derive_Vsol Kp tge0; have /eqP := Vsol'_eq0 limSKp tge0. +rewrite derive1E derive_val mulrI_eq0; last exact/lregN/lregP. +by rewrite sqrf_eq0 => /eqP. +Qed. + +Lemma sol1'_eq0 p t : limS sol K p -> 0 <= t -> (Fpendulum (sol p t))..[1] = 0. +Proof. +move=> limSKp tge0; have := is_derive_cst (0 : R^o) (t : R^o) 1. +have /subset_limSK_K Kp := limSKp. +have [_ /(_ _ tge0) /(is_derive_component 1)] := sol_is_sol sol0 solP Kp. +by apply: is_derive_nneg_eq => // s sge0; rewrite sol1_eq0. +Qed. + +Lemma sol0_const p t : limS sol K p -> 0 <= t -> (sol p t)..[0] = p..[0]. +Proof. +move=> limSKp tge0; rewrite -[p in RHS]sol0. +apply (@eq0_derive1_cst R (fun s => (sol p s)..[0]) 0 t); last first. + by rewrite in_itv/= lexx tge0. +move=> s /andP [sge0 _]; have /subset_limSK_K Kp := limSKp. +have [_ /(_ _ sge0) /(is_derive_component 0) dsol0] := sol_is_sol sol0 solP Kp. +by apply: DeriveDef => //; rewrite derive_val mxE /= sol1_eq0. +Qed. + +Lemma Esol_const p t : limS sol K p -> 0 <= t -> (E \o sol p) t = E p. +Proof. +move=> limSKp tge0; rewrite -[p in RHS]sol0. +apply (@eq0_derive1_cst R (E \o sol p) 0 t); last first. + by rewrite in_itv/= lexx tge0. +move=> s /andP [sge0 _]; have /subset_limSK_K Kp := limSKp. +have dEsol := is_derive_Esol Kp sge0; apply: DeriveDef => //. +by rewrite derive_val sol1_eq0 // mul0r. +Qed. + +Lemma Efctrl_psol0_eq0 p t : limS sol K p -> 0 <= t -> + ke%:num * (E (sol p t)) * (fctrl (sol p t)) + kx%:num * (sol p t)..[0] = 0. +Proof. +move=> limSKp tge0. +rewrite [RHS](_ : _ = + - (kd%:num * (sol p t)..[1] + kv%:num * (Fpendulum (sol p t))..[1])); last first. + by rewrite sol1'_eq0 // sol1_eq0 // !mulr0 add0r oppr0. +have [circsolt /le_lt_trans /(_ k0_valid) Vsolts] : K (sol p t). + by apply: Kinvar tge0; apply: subset_limSK_K. +have fctrl_def := fctrl_wdef circsolt Vsolts. +have Mpmsne0 : M%:num + m%:num * (sol p t)..[3] ^+ 2 != 0. + by rewrite lt0r_neq0 // Mp_ms_gt0. +rewrite /Fpendulum !mxE /= /fctrl; apply: (canLR (subrK _)); rewrite mulrA. +apply: (canLR (mulfK _)) => //; rewrite [RHS]mulrDl; apply: (canRL (subrK _)). +rewrite opprD [RHS]mulrDl [RHS]addrC; apply/(canRL (subrK _))/Logic.eq_sym. +rewrite mulrC -mulNr mulrA mulrA; apply: (canLR (mulfK _)) => //. +rewrite [RHS]mulrDr [LHS]mulrDr addrC; apply: (canLR (subrK _)). +rewrite mulrA -[in X in X / _]mulrA; apply: (canLR (mulfK _)) => //. +ring. +Qed. + +Lemma div_fctrl_mP p t : limS sol K p -> 0 <= t -> + (sol p t)..[3] * (g%:num * (sol p t)..[2] - l%:num * (sol p t)..[4] ^+ 2) = + (fctrl (sol p t)) / m%:num. +Proof. +move=> limSKp tge0; apply: (canRL (mulfK _)) => //; apply: subr0_eq. +have := sol1'_eq0 limSKp tge0; rewrite !mxE /= => /(canRL (mulfK _)). +rewrite mul0r => fctrl_val. +rewrite mulrC mulrA -[in X in X - _]opprB mulrN -opprD fctrl_val ?oppr0 //. +exact/invr_neq0/lt0r_neq0/Mp_ms_gt0. +Qed. + +Lemma Fpendulum4E p t : limS sol K p -> 0 <= t -> + (Fpendulum (sol p t))..[4] = g%:num / l%:num * (sol p t)..[3]. +Proof. +move=> limSKp tge0; rewrite !mxE /=. +have /(canLR (mulfVK _)) <- // := div_fctrl_mP limSKp tge0. +apply: (canLR (mulfK _)); last apply/esym. + by apply: lt0r_neq0; rewrite pmulr_rgt0 // Mp_ms_gt0. +rewrite mulrCA mulrA mulrA [l%:num * _ in LHS]mulrC mulfVK//. +have [] : K (sol p t) by apply/subset_limSK_K/limSKinvar. +rewrite addrC => /(canRL (addrK _)) -> _. +ring. +Qed. + +Lemma En0_fctrlsol_const p t : + limS sol K p -> E p != 0 -> 0 <= t -> fctrl (sol p t) = fctrl p. +Proof. +move=> limSKp Epn0 tge0. +have := Efctrl_psol0_eq0 limSKp tge0. +rewrite -[X in _ = X -> _](Efctrl_psol0_eq0 limSKp (lexx _)) sol0 + [E (sol p t)](Esol_const limSKp tge0) (sol0_const limSKp tge0). +have keEn0 : ke%:num * E p != 0 by rewrite mulrI_eq0 //; apply/lregP. +move/(canRL (addrK _)); rewrite -addrA subrr addr0 mulrC. +by move=> /(canRL (mulfK _)) - /(_ keEn0) ->; rewrite mulrAC -mulrA mulVKf. +Qed. + +Lemma inf_in_finset (A : {fset R}) : + has_inf [set t | t \in A] -> inf [set t | t \in A] \in A. +Proof. +move=> infA; have [[t At] _] := infA. +have Amin : \big[minr/t]_(s <- enum_fset A) s \in A. + have : forall s, s \in enum_fset A -> s \in A by []. + elim: (enum_fset A) => [inA|s l0 ihl0 inA]; first by rewrite big_nil. + rewrite big_cons. + have [sl|sl] := leP s _. + by apply: inA; rewrite mem_head. + by apply: ihl0 => r lr; apply: inA; rewrite inE orbC lr. +suff -> : inf [set t | t \in A] = \big[minr/t]_(s <- enum_fset A) s by []. +apply/eqP; rewrite eq_le; apply/andP; split. + apply: inf_lbound => //. + by case: infA. +apply: lb_le_inf; first by have [] := infA. +apply/lbP => s As; have : s \in enum_fset A by []. +elim: (enum_fset A) => // r l0 ihl0; rewrite inE => /orP [/eqP <-|]. + by rewrite big_cons ge_min lexx. +by rewrite big_cons ge_min orbC => /ihl0 ->. +Qed. + +Lemma continuous_finimage_cst (f : R -> R) n (h : 'I_n -> R) : + {in (>= 0), continuous f} -> + (forall t, 0 <= t -> exists i, f t = h i) -> + forall t, 0 <= t -> f t = f 0. +Proof. +case: n h => [h ? finim_f t tge0|]; first by have /finim_f [] := tge0; case. +case=> [|n] h fcont finim_f t tge0. + have /finim_f [i ->] := tge0; have /finim_f [j ->] := lexx (0 : R). + by rewrite !ord1. +case: (eqVneq (f t) (f 0)) => // ftnef0. +set fl := minr (f 0) (f t); set fr := maxr (f 0) (f t). +have ltflr : fl < fr. + rewrite /fr. + have [left0|lt0ft] := leP (f 0) _. + rewrite /fl; move: (left0) => /min_idPl => ->. + by rewrite lt_def ftnef0/= left0. + by rewrite /fl; move/ltW: (lt0ft) => /min_idPr => ->. +set img := [set x | (fl < x) && (x \in range h)]. +have imgfr : (range h) fr. + rewrite /fr. + have [f0ft|f0ft] := leP (f 0) (f t). + by have /finim_f [i] := tge0; exists i. + by have /finim_f [i] := lexx (0 : R); exists i. +have imgn0 : nonempty img. + exists fr. + by rewrite /img/= ltflr andTb; apply/asboolP. +have infimg : has_inf img. + by split=> //; exists fl; apply/lbP => ? /andP [/ltW]. +have [] := @IVT _ f _ _ ((fl + inf img) / 2) tge0. + apply: continuous_in_subspaceT => x. + rewrite inE/= in_itv/= => /andP[x0 xt]. + by apply: fcont => //=. + apply/andP; split. + rewrite ler_pdivlMr // mulrC mul2r lerD2l. + by apply: lb_le_inf imgn0 _; apply/lbP => ? /andP [/ltW]. + rewrite ler_pdivrMr // mulrC mul2r lerD //; first exact: ltW. + apply: inf_lbound => //. + by case: infimg. + by apply/andP; split=> //; apply/asboolP. +move=> s s0t fsemid; suff ltfl_inf : fl < inf img. + have : inf img <= (fl + inf img) / 2. + apply: inf_lbound. + by case: infimg. + apply/andP; split; last first. + have /finim_f [i] : 0 <= s by rewrite (itvP s0t). + by rewrite fsemid => midegi; apply/asboolP; exists i. + by rewrite ltr_pdivlMr // mulrC mul2r ltrD2l. + by rewrite ler_pdivlMr // mulrC mul2r lerD2r leNgt ltfl_inf. +have imgE : img = pred_of_finset [fset x in + [seq t <- [seq h i | i : 'I_n.+2] | fl < t]]%fset :> set R. + rewrite funeqE => x; rewrite /img /= /pred_of_finset in_fset/=. + apply/propext; split. + rewrite mem_filter => /andP[flx]. + rewrite inE => -[i _ gix]. + rewrite flx/=. + apply/mapP; exists i => //=. + by rewrite mem_enum. + rewrite mem_filter/= => /andP[flx /mapP[/= i _ xgi]]. + rewrite flx/= xgi. + by apply/asboolP; exists i. +rewrite imgE; set A := [fset x in _]%fset. +have : inf (pred_of_finset A) \in A. + by apply: inf_in_finset; rewrite -[X in has_inf X]imgE. +by rewrite /A in_fset mem_filter => /andP []. +Qed. + +Lemma En0_sol2_const p : + limS sol K p -> E p != 0 -> forall t, 0 <= t -> (sol p t)..[2] = p..[2]. +Proof. +move=> limSKp Epn0 t tge0. +have Kp : K p by apply: subset_limSK_K. +set C1 := - (2 * g%:num + 2 * (E p) / (m%:num * l%:num)). +set C2 := fctrl p / m%:num. +have sol32_val : forall s, 0 <= s -> + (sol p s)..[3] * (3%:R * g%:num * (sol p s)..[2] + C1) = C2. + move=> s sge0. + rewrite /C1 /C2 -(Esol_const limSKp sge0) /E /= (sol1_eq0 limSKp sge0) + -(En0_fctrlsol_const limSKp Epn0 sge0) -(div_fctrl_mP limSKp sge0). + rewrite !expr0n /= !mulr0 !mul0r add0r addr0. + rewrite (mulrDr 2). + rewrite mulrA [1 / _]mulrC. + rewrite mulVKr ?unitfE // mul1r mulrBr addrC; apply: (canLR (subrK _)). + rewrite -mulNr mulrDr addrC; apply: (canLR (subrK _)). + rewrite mulrA; apply: (canLR (mulfK _)) => //. + ring. +have sol423_val s : 0 <= s -> + (sol p s)..[4] * (3%:R * g%:num * ((sol p s)..[2] ^+ 2 - + (sol p s)..[3] ^+ 2) + C1 * (sol p s)..[2]) = 0. + move=> sge0; apply (is_derive_nneg_eq sol32_val sge0); last first. + exact: is_derive_cst. + have [_ /(_ _ sge0) sol_ats] := sol_is_sol sol0 solP Kp; apply: is_derive_eq. + rewrite !mxE /=. + rewrite /GRing.scale/=. + ring. +have sol432_val' s : 0 <= s -> + (sol p s)..[3] * (g%:num / l%:num * (3%:R * g%:num * ((sol p s)..[2] ^+ 2 - + (sol p s)..[3] ^+ 2) + C1 * (sol p s)..[2]) - + (sol p s)..[4] ^+ 2 * (12%:R * g%:num * (sol p s)..[2] + C1)) = 0. + move=> sge0; apply (is_derive_nneg_eq sol423_val sge0); last first. + exact: is_derive_cst. + have [_ /(_ _ sge0) sol_ats] := sol_is_sol sol0 solP Kp; apply: is_derive_eq. + rewrite Fpendulum4E // !mxE /= addrC; apply: (canLR (subrK _)). + rewrite -![_ *: _]/(_ * _) mulrA mulrAC mulrA; apply: (canLR (mulfK _)) => //. + rewrite [in RHS]mulrDl; apply: (canRL (subrK _)). + rewrite [(sol p s)..[3] * _]mulrDr [in RHS]mulrDl; apply: (canRL (subrK _)). + rewrite [_ / _ * _]mulrC [in RHS]mulrA [in RHS]mulrA mulfVK//. + ring. +set x1 := (- C1 + Num.sqrt (C1 ^+ 2 - 4%:R * (6%:R * g%:num) * + (- 3%:R * g%:num))) / (2 * (6%:R * g%:num)). +set x2 := (- C1 - Num.sqrt (C1 ^+ 2 - 4%:R * (6%:R * g%:num) * + (- 3%:R * g%:num))) / (2 * (6%:R * g%:num)). +set f := fun i : 'I_4 => if i == 0 then - 1 else + if i == 1 then 1 else + if i == 2 then x1 else x2. +rewrite -[p in RHS]sol0. +apply: (@continuous_finimage_cst (fun s => (sol p s)..[2]) _ f) tge0. + move=> s sge0; apply: (@differentiable_continuous _ R^o R^o). + have [_ /(_ _ sge0) sol_ats]:= sol_is_sol sol0 solP Kp. + exact/derivable1_diffP. +move=> s sge0. +have circsol : (sol p s)..[2] ^+ 2 + (sol p s)..[3] ^+ 2 = 1. + suff [] : K (sol p s) by []. + exact/subset_limSK_K/limSKinvar. +have solroot_imf : + 3%:R * g%:num * ((sol p s)..[2] ^+ 2 - (sol p s)..[3] ^+ 2) + + C1 * (sol p s)..[2] = 0 -> exists i, (sol p s)..[2] = f i. + have -> : (sol p s)..[3] ^+ 2 = 1 - (sol p s)..[2] ^+ 2. + by rewrite -circsol [X in X - _]addrC addrK. + move=> sol2_val. + have sol2_root : + 6%:R * g%:num * ((sol p s)..[2] ^+ 2) + C1 * (sol p s)..[2] + + (- 3%:R * g%:num) = 0. + rewrite -[RHS]sol2_val. + ring. + case/poly2_factor: sol2_root => {sol2_val} [|sol2_val|sol2_val] //. + by exists (2%:R); rewrite sol2_val. + by exists (3%:R); rewrite sol2_val. +case: (eqVneq ((sol p s)..[4]) 0) => [sol4e0|sol4ne0]; last first. + by have /sol423_val/eqP := sge0; rewrite mulrI_eq0 => [/eqP|]//; apply/lregP. +have /sol432_val' := sge0. +rewrite sol4e0 expr0n /= mul0r subr0. +case: (eqVneq ((sol p s)..[3]) 0) => [sol3e0|sol3ne0]. + move=> _; move: circsol; rewrite sol3e0 expr0n /= addr0. + rewrite -(expr1n R 2) => /eqP; rewrite eqf_sqr=> /orP [] /eqP->. + by exists 1. + by exists 0. +move=> /eqP; rewrite mulrI_eq0; last exact/lregP. +by rewrite mulrI_eq0=> [/eqP|] //; apply/lregP. +Qed. + +Lemma En0_sol3_const p : + limS sol K p -> E p != 0 -> forall t, 0 <= t -> (sol p t)..[3] = p..[3]. +Proof. +move=> limSKp Epn0 t tge0. +have circsol s : 0 <= s -> p..[2] ^+ 2 + (sol p s)..[3] ^+ 2 = 1. + move=> sge0; rewrite -(En0_sol2_const limSKp Epn0 sge0). + suff [] : K (sol p s) by []. + exact/subset_limSK_K/limSKinvar. +set h := fun i : 'I_2 => if i == 0 then Num.sqrt (1 - p..[2] ^+ 2) + else - (Num.sqrt (1 - p..[2] ^+ 2)). +rewrite -[p in RHS]sol0. +apply: (@continuous_finimage_cst (fun t => (sol p t)..[3]) _ h) tge0. + move=> s sge0; apply: (@differentiable_continuous _ R^o R^o). + have Kp : K p by apply: subset_limSK_K. + have [_ /(_ _ sge0) sol_ats]:= sol_is_sol sol0 solP Kp. + exact/derivable1_diffP. +move=> s sge0. +suff : (sol p s)..[3] ^+ 2 == (Num.sqrt (1 - p..[2] ^+ 2)) ^+2. + by rewrite eqf_sqr => /orP [/eqP ?|/eqP ?]; [exists 0|exists 1]. +have /circsol <- := sge0. +by rewrite -addrA addrCA addrA addrK sqr_sqrtr // sqr_ge0. +Qed. + +Lemma En0_sol4_eq0 p : + limS sol K p -> E p != 0 -> forall t, 0 <= t -> (sol p t)..[4] = 0. +Proof. +move=> limSKp Epn0 t tge0. +have Kp : K p by apply: subset_limSK_K. +have [_ /(_ _ tge0) sol't] := sol_is_sol sol0 solP Kp. +have : (sol p t)..[3] * (sol p t)..[4] == 0. + rewrite -oppr_eq0 -mulNr; apply/eqP. + apply (is_derive_nneg_eq (En0_sol2_const limSKp Epn0) tge0); last first. + exact: is_derive_cst. + by apply: is_derive_eq; rewrite mxE. +rewrite mulf_eq0 => /orP [] /eqP // sol3eq0. +have /eqP : (sol p t)..[2] * (sol p t)..[4] = 0. + apply (is_derive_nneg_eq (En0_sol3_const limSKp Epn0) tge0); last first. + exact: is_derive_cst. + by apply: is_derive_eq; rewrite mxE. +rewrite mulf_eq0 => /orP [] /eqP // sol2eq0. +have [] : K (sol p t) by apply/Kinvar. +by rewrite sol3eq0 sol2eq0 expr0n /= addr0 => /eqP; rewrite eq_sym oner_eq0. +Qed. + +Lemma En0_sol3_eq0 p t : + limS sol K p -> E p != 0 -> 0 <= t -> (sol p t)..[3] = 0. +Proof. +move=> limSKp Epn0 tge0; rewrite En0_sol3_const => //. +case: (eqVneq (p..[3]) 0) => // p3n0. +suff : (Fpendulum (sol p 0))..[4] = 0. + rewrite Fpendulum4E // sol0 => /eqP; rewrite mulrI_eq0; last exact/lregP. + by move/eqP. +apply (is_derive_nneg_eq (En0_sol4_eq0 limSKp Epn0) (lexx 0)); last first. + exact: is_derive_cst. +have Kp : K p by apply: subset_limSK_K. +have [_ /(_ _ (lexx 0))] := sol_is_sol sol0 solP Kp. +exact: is_derive_component. +Qed. + +Lemma En0_sol2_eq1 p t : + limS sol K p -> E p != 0 -> 0 <= t -> (sol p t)..[2] = 1. +Proof. +move=> limSKp Epn0 tge0. +have [] : K (sol p t) by apply/subset_limSK_K/limSKinvar. +rewrite En0_sol3_eq0 // expr0n /= addr0 -{1}(expr1n R 2). +move/eqP; rewrite eqf_sqr => /orP [] /eqP // sol2_eqN1 _. +suff : `|E (sol p t)| < 2 * m%:num * g%:num * l%:num. + rewrite /E sol1_eq0 // En0_sol4_eq0 // expr0n /= !mulr0 !addr0 mulr0 add0r. + rewrite sol2_eqN1 -opprD mulrN normrN mulrC !mulrA mulrAC. + by rewrite -(natrD _ 1 1) addn1 ltr_norml ltxx andbF. +rewrite -[X in _ < X]ger0_norm // -ltr_sqr ?nnegrE // -!normrX. +do 2 rewrite ger0_norm ?sqr_ge0 //. +suff : 2 * (V (sol p t)) / ke%:num < (2 * m%:num * g%:num * l%:num) ^+ 2. + apply: le_lt_trans. + rewrite -mulrA -ler_pdivrMl // ler_pdivlMr // mulrC mulrA. + by rewrite /V -addrA lerDl addr_ge0 // pmulr_rge0 // sqr_ge0. +rewrite ltr_pdivrMr // -ltr_pdivlMl // mulrC [_ * ke%:num]mulrC. +have /lt_le_trans : V (sol p t) < B. + have [_ Vsolp_s] : K (sol p t) by apply/subset_limSK_K/limSKinvar. + exact: le_lt_trans k0_valid. +rewrite /B; apply; apply: ler_pM => //; apply: ler_pM => //. +by rewrite lerXn2r // ?nnegrE // ge_min lexx orbC. +Qed. + +Lemma subset_limSK_homoclinic_orbit : limS sol K `<=` homoclinic_orbit. +Proof. +move=> p limSKp; rewrite homoclinicE; case: (eqVneq (E p) 0) => [Ep0|Epn0]. + have := sol1_eq0 limSKp (lexx _); rewrite sol0 => p10. + have := Efctrl_psol0_eq0 limSKp (lexx _). + rewrite sol0 Ep0 mulr0 mul0r add0r => /eqP. + by rewrite mulrI_eq0 => [/eqP|] //; apply/lregP. +suff Ep0 : E p == 0 by move: Epn0; rewrite Ep0. +rewrite /E -[p]sol0 sol1_eq0 // En0_sol4_eq0 // En0_sol2_eq1 // subrr expr0n /=. +by rewrite !mulr0 !addr0 mulr0. +Qed. + +Lemma cvg_to_homoclinic_orbit p : K p -> + sol p @ +oo --> (homoclinic_orbit : set [the pseudoMetricType _ of U]). +Proof. +move=> Kp A [_/posnumP[e] hoe_A]; apply: cvg_to_limS K_compact Kinvar _ Kp _ _. +exists e%:num => //= q [r /subset_limSK_homoclinic_orbit hor re_q]. +by apply: hoe_A; exists r. +Qed. + +End System. From 716f7c36c36f65f836a5c48e5989be9028f19b50 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 3 Feb 2026 16:28:38 +0900 Subject: [PATCH 084/144] add ode files --- _CoqProject | 3 + common.v | 853 ++++++++++++++++++++++++ contfun.v | 882 +++++++++++++++++++++++++ ode.v | 1823 +++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 3561 insertions(+) create mode 100644 common.v create mode 100644 contfun.v create mode 100644 ode.v diff --git a/_CoqProject b/_CoqProject index 6509eb5f..6cd7f8fc 100644 --- a/_CoqProject +++ b/_CoqProject @@ -17,6 +17,9 @@ scara.v derive_matrix.v differential_kinematics.v extra_trigo.v +common.v +contfun.v +ode.v lasalle.v pendulum.v tilt_mathcomp.v diff --git a/common.v b/common.v new file mode 100644 index 00000000..cfe7a0f6 --- /dev/null +++ b/common.v @@ -0,0 +1,853 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. +From mathcomp Require Import generic_quotient ring_quotient. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import constructive_ereal. +From mathcomp Require Import functions reals interval_inference topology. +From mathcomp Require Import prodnormedzmodule tvs normedtype landau. +From mathcomp Require Import ereal sequences derive numfun measure realfun. +From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. +(**md**************************************************************************) +(* # ODE *) +(* cont_on_seg a b := pred type for functions continuous on [a;b] *) +(* infty_norm0 f == sup (|f|(K)) *) +(* f has type {fun K >-> [set: _]} *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. + +Open Scope ring_scope. +Open Scope classical_set_scope. + +(* NB: merged to MathComp *) +Lemma gerN {R : numDomainType} (x : R) : 0 <= x -> - x <= x. +Proof. by move=> x0; rewrite ge0_cp. Qed. + +(* TODO : rename *) +Lemma in_switch {R : numDomainType} (I : interval R) P : + {in [set` I],forall x, P x} <-> {in I,forall x, P x}. +Proof. +split => [h x xI| h x xI];apply h. + by rewrite inE. +by rewrite inE in xI. +Qed. + +Lemma eq_on_itv_deriv {R : realType} {W : normedModType R} c d (g h : R -> W) : + {in `]c,d[, g =1 h} -> {in `]c,d[, g^`() =1 h^`()}. +Proof. +move=> gh x xcd; rewrite !derive1E; apply: near_eq_derive => //. +near=> x0. +apply gh. +rewrite inE. +near: x0. +apply/near_in_itvoo. +by rewrite -inE. +Unshelve. all: by end_near. Qed. + +Section about_sup. + +Lemma sup_ge0 {R : realType} (A : set R) : + (forall x, A x -> 0 <= x) -> 0 <= sup A. +Proof. +move=> Ax. +have [->|/set0P[a Aa]] := eqVneq A set0; first by rewrite sup0. +have [supA|supA] := pselect (has_sup A). + rewrite (le_trans (Ax _ Aa))// ub_le_sup//. + by case: supA. +by rewrite /sup supremum_out. +Qed. + +Lemma has_sup_Mn {R : realType} (A : set R) n : + has_sup A -> has_sup [set x *+n | x in A ]. +Proof. +move => [-[] x Ax [y uby]]. +split; first by exists (x *+ n), x. +exists (y *+ n). +move => _ [y0 Ay0 <-] . +rewrite lerMn2r. +by apply /orP;right;apply uby. +Qed. + +Lemma sup_Mn {R : realType} (A : set R) n : + has_sup A -> sup [set x *+n | x in A ] = sup A *+ n. +Proof. +move => ex_sup. +elim: n. + rewrite !mulr0n -(sup1 0);congr (sup _). + apply eq_set => /= z ;apply propext; split => [[x _ <- ] | ->]; rewrite ?normr0 => //. + by case : ex_sup => -[] x Ax _; exists x. +move => n IH. +rewrite !mulrS. +rewrite -IH. +rewrite -sup_sumE => //; last by apply has_sup_Mn. +apply /eqP. +rewrite eq_le. +apply /andP;split; last first. + apply ge_sup. + case : ex_sup => -[] x Ax _;exists (x+x *+ n); exists x => //. + exists (x *+ n) => //. + by exists x. + move => _ /= [x Ax [_ [x0 Ax0] <-] <-]. + have /orP[ xx0| xx0] := le_total x x0. + rewrite (@le_trans _ _ (x0 *+ n.+1)) //. + by rewrite mulrS lerD2r. + rewrite ub_le_sup//; first by apply has_sup_Mn. + by exists x0. + rewrite (@le_trans _ _ (x *+ n.+1)) //. + rewrite mulrS lerD2l. + by rewrite lerMn2r xx0 orbT. + apply ub_le_sup; first by apply has_sup_Mn. + by exists x. +apply sup_le. +- apply: subset_trans; last by apply: le_down. + move => _ [x Ax <-] /=. + exists x => //. + exists (x *+ n)=> //. + exists x => //. + by rewrite mulrS. +- case : ex_sup => -[] x Ax _. + exists (x *+ n.+1)=> //=. + by exists x. +- case : ex_sup => -[] x Ax [y uby]. + split. + exists (x + x *+ n). + exists x => //. + exists (x *+ n) => //. + by exists x. +- exists (y + y *+ n) => _ [x0 Ax0 [_ [x1 Ax1] <-] <-]. + apply lerD;first by apply uby. + rewrite lerMn2r; apply /orP. + by right;apply uby. +Qed. + +Lemma sup_mult {R: realType} (A : set R) (a : R) : + has_sup A -> sup [set normr a * x | x in A ] = (normr a) * sup A . +Proof. +move =>ex_sup. +have []:= ex_sup => -[] x Ax ub. +apply /eqP. +rewrite eq_le. +apply /andP;split. +apply ge_sup; first by exists (normr a * x); exists x. +move => _ [x0 Axo <-]. +apply ler_wpM2l => //. +rewrite ub_le_sup//. +have [/eqP ->| ha0] := boolP (a == 0). +rewrite normr0 !mul0r . +suff ->: [set 0 * x0 | x0 in A] = [set 0] by rewrite sup1 lexx. +apply/predeqP => x0 /=;split => [ [x1 _ <-] | -> ]. + by rewrite mul0r. + by exists x => //=; rewrite mul0r. +rewrite -ler_pdivlMl; last by rewrite normr_gt0. +apply ge_sup; first by apply ex_sup. +move => x0 Ax0. +rewrite ler_pdivlMl; last by rewrite normr_gt0. +rewrite ub_le_sup//. + have [x1 ubx1] := ub. + exists (`|a| * x1). + move => _ [x2 Ax2 <-]. + apply ler_wpM2l => //. + by apply ubx1. +by exists x0. +Qed. + +End about_sup. + +(* TODO: PR to MathComp-Analysis *) +Lemma cst_is_fun {T1 T2} (A : set T1) x : @isFun T1 T2 A [set: T2] (cst x). +Proof. by constructor. Qed. + +HB.instance Definition _ {T1 T2} (A : set T1) x := @cst_is_fun T1 T2 A x. + +Lemma seg_nonempty {R : realType} (c d : R) : c <= d -> `[c,d] !=set0. +Proof. +move => h. +exists c. +by rewrite /=in_itv/= lexx. +Qed. + +(* TODO: PR *) +Lemma restrict0 [T : Type] (K : realFieldType) (D : set T) : + (cst 0 : T -> K) \_ D = cst 0. +Proof. +by apply/funext => x/=; rewrite patchE; case: ifPn. +Qed. + +(* TODO: rewrite rmorphD should work declare patch as a morphism: + erestrictD, erestrictM, *) +Lemma restrictD [T : pointedType] [R : realFieldType] (D : set T) (f g : T -> R) : + (f \+ g)%R \_ D = (f \_ D \+ g \_ D)%R. +Proof. +rewrite /patch. +apply/funext => /= x. +case: ifPn => xD. + by rewrite /GRing.add_fun xD. +by rewrite /GRing.add_fun (negbTE xD)// addr0. +Qed. + +Lemma restrictM [T : pointedType] [R : realFieldType] (D : set T) (f g : T -> R) : + (f \* g)%R \_ D = (f \_ D \* g \_ D)%R. +Proof. +rewrite /patch. +apply/funext => /= x. +case: ifPn => xD. + by rewrite /GRing.mul_fun xD. +by rewrite /GRing.mul_fun (negbTE xD)// mulr0. +Qed. + +(* TODO: now in MathComp-Analysis master *) +Section continuous_within_itvP. +Context {R : realType}. +Context {U : normedModType R}. + +Implicit Type f : R -> U. + +Let near_at_left (a : itv_bound R) b f eps : (a < BLeft b)%O -> 0 < eps -> + {within [set` Interval a (BRight b)], continuous f} -> + \forall t \near b^'-, `|f b - f t| < eps. +Proof. +move=> ab eps_gt0 cf. +move/continuous_withinNx/(@cvgrPdist_lt _ _)/(_ _ eps_gt0) : (cf b). +rewrite /dnbhs/= near_withinE !near_simpl /prop_near1 /nbhs/=. +rewrite -nbhs_subspace_in//; last first. + rewrite /= in_itv/= lexx andbT. + by move: a ab {cf} => [[a|a]/=|[|]//]; rewrite bnd_simp// => /ltW. +rewrite /within/= near_simpl; apply: filter_app. +move: a ab {cf} => [a0 a/= /[!bnd_simp] ab|[_|//]]. +- exists (b - a); rewrite /= ?subr_gt0// => c cba + ac. + apply=> //; rewrite ?lt_eqF// !in_itv/= (ltW ac)/= andbT; move: cba => /=. + rewrite gtr0_norm ?subr_gt0// ltrD2l ltrNr opprK => {}ac. + by case: a0 => //=; exact/ltW. +- by exists 1%R => //= c cb1 + bc; apply; rewrite ?lt_eqF ?in_itv/= ?ltW. +Qed. + +Let near_at_right a (b : itv_bound R) f eps : (BRight a < b)%O -> 0 < eps -> + {within [set` Interval (BLeft a) b], continuous f} -> + \forall t \near a^'+, `|f a - f t| < eps. +Proof. +move=> ab eps_gt0 cf. +move/continuous_withinNx/(@cvgrPdist_lt _ _)/(_ _ eps_gt0) : (cf a). +rewrite /dnbhs/= near_withinE !near_simpl// /prop_near1 /nbhs/=. +rewrite -nbhs_subspace_in//; last first. + rewrite /= in_itv/= lexx//=. + by move: b ab {cf} => [[b|b]/=|[|]//]; rewrite bnd_simp// => /ltW. +rewrite /within/= near_simpl; apply: filter_app. +move: b ab {cf} => [b0 b/= /[!bnd_simp] ab|[//|_]]. +- exists (b - a); rewrite /= ?subr_gt0// => c cba + ac. + apply=> //; rewrite ?gt_eqF// !in_itv/= (ltW ac)/=; move: cba => /=. + rewrite ltr0_norm ?subr_lt0// opprB ltrD2r. + by case: b0 => //= /ltW. +- by exists 2%R => //= c ca1 + ac; apply; rewrite ?gt_eqF ?in_itv/= ?ltW. +Qed. + +(* NB: PR in progress *) +Lemma continuous_within_itvP_g a b f : a < b -> + {within `[a, b], continuous f} <-> + [/\ {in `]a, b[, continuous f}, f @ a^'+ --> f a & f @b^'- --> f b]. +Proof. +move=> ab; split=> [abf|]. + split; [|apply/(@cvgrPdist_lt _ _) => eps eps_gt0 /=..]. + - rewrite -continuous_open_subspace; last exact: interval_open. + by move: abf; exact/continuous_subspaceW/subset_itvW. + - by apply: near_at_right => //; rewrite bnd_simp. + - by apply: near_at_left => //; rewrite bnd_simp. +case=> ctsoo ctsL ctsR; apply/subspace_continuousP => x /andP[]. +rewrite !bnd_simp/= !le_eqVlt => /predU1P[<-{x}|ax] /predU1P[|]. +- by move/eqP; rewrite lt_eqF. +- move=> _; apply/(@cvgrPdist_lt _ _) => eps eps_gt0 /=. + move/(@cvgrPdist_lt _ _)/(_ _ eps_gt0): ctsL; rewrite /at_right !near_withinE. + apply: filter_app; exists (b - a); rewrite /= ?subr_gt0// => c cba + ac. + have : a <= c by move: ac => /andP[]. + by rewrite le_eqVlt => /predU1P[->|/[swap] /[apply]//]; rewrite subrr normr0. +- move=> ->; apply/(@cvgrPdist_lt _ _) => eps eps_gt0 /=. + move/(@cvgrPdist_lt _ _)/(_ _ eps_gt0): ctsR; rewrite /at_left !near_withinE. + apply: filter_app; exists (b - a); rewrite /= ?subr_gt0 // => c cba + ac. + have : c <= b by move: ac => /andP[]. + by rewrite le_eqVlt => /predU1P[->|/[swap] /[apply]//]; rewrite subrr normr0. +- move=> xb; have aboox : x \in `]a, b[ by rewrite inE /= !in_itv/= ax. + rewrite within_interior; first exact: ctsoo. + rewrite inE in aboox. + suff : `]a, b[ `<=` interior `[a, b] by exact. + by rewrite -open_subsetE; [exact: subset_itvW| exact: interval_open]. +Qed. + +End continuous_within_itvP. + +Lemma proveme {R : realType} (a b : R) (g : R -> R) : + {within `[a, b], continuous g} -> + {within `[a, b], continuous (g \o -%R)}. +Abort. + +Lemma within_continuous_comp_norm {R : realType} {U : normedModType R} a y (f : R -> U) : + a <= y -> + {within `[a, y], continuous fun x => f x} -> + {within `[a, y], continuous fun x => `|f x|}. +Proof. +rewrite le_eqVlt => /predU1P[<-|ay]. + rewrite set_itv1 => _. + exact: continuous_subspace1. +move/continuous_within_itvP => /(_ ay)[H1 H2 H3]. +apply/continuous_within_itvP => //; split => //. + move=> z zay. + apply: continuous_comp => //. + by apply: H1. + exact: norm_continuous. +apply: cvg_comp. + apply: H2. + by apply: cvg_norm. +apply: cvg_comp. +apply: H3. +by apply: cvg_norm. +Qed. + +(* NB: it is now in master *) +Lemma integrable_norm d {T : measurableType d} {R : realType} + (mu : {measure set T -> \bar R}) (D : set T) (f : T -> R) : + mu.-integrable D (EFin \o f) -> + mu.-integrable D (EFin \o (normr \o f)). +Proof. +move=> /integrableP[mf foo]; apply/integrableP; split. + do 2 apply: measurableT_comp => //. + exact/measurable_EFinP. +by under eq_integral do rewrite /= normr_id. +Qed. + +Lemma lipschitzW {R : realType} {T U W : normedModType R} (A B : set T) C (f : T -> U -> W) k : + A `<=` B -> {in B, forall x, k.-lipschitz_C (f x)} -> {in A, forall x, k.-lipschitz_C (f x)}. +Proof. +move=> AB H x xA. +apply: H. +by apply/mem_set/AB/set_mem. +Qed. +(* NB: why is in1_subset_itv so specialized?! *) + +Section lip_implies_cont. +Context {R : realType}. +Variables (f : R -> R -> R) (a t1 : R). +Hypothesis a1 : a < t1. +Variable k : R. +Hypothesis k1 : k > 0. +Variables (u0 : R) (r : {posnum R}). +Let B := closed_ball u0 r%:num. + +Hypothesis lip2 : {in `[a, t1]%R, forall x, k.-lipschitz_B (f x)}. + +Lemma lipschitz_within_continuous : {in `[a, t1]%R, forall x, {within B, continuous f x}}. +Proof. +move=> x xa1. +rewrite [B]closed_ball_itv//. +apply/continuous_within_itvP; first by rewrite ltrD2l gtrN. +split. +- move=> y ya1. + move: (xa1); have := @lip2 x => /[apply] kfx. + rewrite /continuous_at. + apply/cvgrPdist_le => /= e e0. + near=> y'. + move: kfx => /(_ (y, y'))/=. + have By : B y. + rewrite /B closed_ball_itv//=. + exact: subset_itv_oo_cc ya1. + have By' : B y'. + rewrite /B closed_ball_itv//=. + rewrite in_itv/=; apply/andP; split. + near: y'. + exists (y - (u0 - r%:num)). + by move: ya1; rewrite in_itv/= -subr_gt0 => /andP[]. + move=> z/=. + by rewrite ltr_distlC opprB addrCA subrr addr0 => /andP[/ltW]. + near: y'. + exists ((u0 + r%:num) - y). + by move: ya1; rewrite in_itv/= -(subr_gt0 y) => /andP[]. + move=> z/=. + rewrite ltr_distlC => /andP[_]. + by rewrite addrCA subrr addr0 => /ltW. + move=> /(_ (conj By By'))/le_trans; apply. + rewrite -ler_pdivlMl// mulrC. + near: y'. + (* TODO(rei): investigate *) + exists (e / k); first by rewrite divr_gt0. + by move=> z/= => /ltW. +- apply/cvgrPdist_le => /= e e0. + near=> y'. + move: (xa1); have := @lip2 x => /[apply]. + move=> /(_ (u0 - r%:num, y'))/=. + have Bu0r : B (u0 - r%:num). + rewrite /B closed_ball_itv//=. + by rewrite bound_itvE lerD2l gerN. + have By' : B y'. + rewrite /B closed_ball_itv//=. + rewrite in_itv/=; apply/andP; split => //. + near: y'. + exists r%:num => //=. + move=> z/=. + rewrite ltr_distlC. + rewrite subrK => /andP[_ /ltW + _] => /le_trans; apply. + by rewrite lerDl. + move=> /(_ (conj Bu0r By'))/le_trans; apply. + rewrite -ler_pdivlMl// mulrC. + near: y'. + (* TODO(rei): investigate *) + exists (e / k) => /=; first by rewrite divr_gt0. + by move=> z/= => /ltW. +- apply/cvgrPdist_le => /= e e0. + near=> y'. + move: (xa1); have := @lip2 x => /[apply]. + move=> /(_ (y', u0 + r%:num))/=. + have By' : B y'. + rewrite /B closed_ball_itv//=. + rewrite in_itv/=; apply/andP; split => //. + near: y'. + exists r%:num => //=. + move=> z/=. + rewrite ltr_distlC addrK => /andP[/ltW + _ _]. + rewrite lerBlDl => /le_trans; apply. + by rewrite lerDr. + have Bu0r : B (u0 + r%:num). + rewrite /B closed_ball_itv//=. + by rewrite bound_itvE lerD2l gerN. + move=> /(_ (conj By' Bu0r)). + rewrite distrC. + move=> /le_trans; apply. + rewrite -ler_pdivlMl// mulrC. + near: y'. + (* TODO(rei): investigate *) + exists (e / k) => /=; first by rewrite divr_gt0. + move=> z/= => /ltW. + by rewrite distrC. +Unshelve. all: end_near. Qed. + +End lip_implies_cont. + +(* NB: should this be PRed or is a patch for our development? *) +Section cst_continuous_on_subspace. +Context {R : realType} {W : topologicalType}. +Variable A : set R. + +Lemma cst_continuous_subspace (r : W) : {within A, continuous (cst r)}. +Proof. by apply: continuous_subspaceT; exact: cst_continuous. Qed. + +HB.instance Definition _ x := isContinuous.Build (subspace A) W + (@cst _ W x) (@cst_continuous_subspace x). + +End cst_continuous_on_subspace. + +(* NB: continuousFunType is defined in subspace_topology.v *) + +HB.instance Definition _ (R : realType) (V : topologicalType) (A : set R) := + gen_eqMixin (continuousFunType A [set: V]). + +HB.instance Definition _ (R : realType) (V : topologicalType) (A : set R) := + gen_choiceMixin (continuousFunType A [set: V]). + +Section cont_on_seg_pred. +Context {R : realType} {V : topologicalType}. +Variables a b : R. + +Definition cont_on_seg : {pred R -> V} := + mem [set f | squashed (@ContinuousFun R V `[a, b] [set: V] f)]. +Definition cont_on_seg_key : pred_key cont_on_seg. Proof. exact. Qed. +Canonical cont_on_seg_keyed := KeyedPred cont_on_seg_key. + +End cont_on_seg_pred. + +(* NB(rei): was this just motivated by generic predicates such as rpredD? +or more generally by stability of "cont. over [a,b]"? +anyway, maybe not needed right now *) +Section cont_on_seg_sub. +Context {R : realType} {V : topologicalType}. +Variables a b : R. +Notation T := (continuousFunType `[a, b] [set: V]). + +Section Sub. +Context (f : R -> V) (fP : f \in cont_on_seg a b). + +Definition cont_on_seg_Sub_subproof := unsquash (set_mem fP). +#[local] HB.instance Definition _ := cont_on_seg_Sub_subproof. +Definition cont_on_seg_Sub : continuousFunType `[a, b] [set: V] := + {| ContinuousFun.sort := f; ContinuousFun.class := cont_on_seg_Sub_subproof |}. + +End Sub. + +Lemma cont_on_seg_rect (K : T -> Type) : + (forall f (Pf : f \in cont_on_seg a b), K (cont_on_seg_Sub Pf)) -> + forall u : T, K u. +Proof. +move=> Ksub [f Pf]. +rewrite (_ : K _ = K (cont_on_seg_Sub (mem_set (squash Pf))))//. +rewrite /cont_on_seg_Sub /cont_on_seg_Sub_subproof /= mem_setK. +rewrite /unsquash; case : cid => // /= => x _. +congr (K (ContinuousFun.Pack _)). +move : Pf x => [[H1] [H2]] [[K1] [K2]]. +by rewrite (Prop_irrelevance H1 K1) (Prop_irrelevance H2 K2). +Qed. + +Lemma cont_on_seg_valP f (Pf : f \in cont_on_seg a b) : + cont_on_seg_Sub Pf = f :> (_ -> _). +Proof. by []. Qed. + +HB.instance Definition _ := isSub.Build _ _ T cont_on_seg_rect cont_on_seg_valP. + +Lemma cont_on_seg_eqP (f g : continuousFunType `[a, b] [set: V]) : + f = g <-> f =1 g. +Proof. by split=> [->//|fg]; exact/val_inj/funext. Qed. + +(* commented out on [2025-12-26] +HB.instance Definition _ := [Choice of continuousFunType `[a, b] [set: R] by <:]. +*) + +End cont_on_seg_sub. + +Definition cont_on_segN {R : realType} (a b : R) (ab : a < b) + (g : R -> R) := g \o -%R. +Arguments cont_on_segN {R} _ _. + +Section cont_on_segN. +Context {R : realType}. +Variables t0 t1 : R. +Hypothesis t01 : t0 < t1. + +Let g'fun (g : continuousFunType `[t0, t1] [set: R]) : + set_fun `[-t1, -t0] setT (cont_on_segN t0 t1 t01 g). +Proof. by constructor => x/=. Qed. + +HB.instance Definition _ (g : continuousFunType `[t0, t1] [set: R]) := + @isFun.Build (subspace `[-t1, -t0]) R `[-t1, -t0] setT (cont_on_segN t0 t1 t01 g) (g'fun g). + +(* TODO: should this be a lemma? about balls? *) + +Let cg' (g : continuousFunType `[t0, t1] [set: R]) : + {within `[- t1, - t0], continuous (cont_on_segN t0 t1 t01 g)}. +Proof. +apply/continuous_within_itvP. + by rewrite ltrN2. +have /continuous_within_itvP[] := @cts_fun _ _ g. + by []. +move=> cg gR gL; split. +- move=> x xdd; apply: continuous_comp; first exact: continuousN. + by apply: cg; rewrite oppr_itvoo. +- by apply/cvg_at_leftNP; rewrite /cont_on_segN/= opprK. +- move/cvg_at_rightNP : gR. + by rewrite /cont_on_segN/= opprK. +Qed. + +HB.instance Definition _ (g : continuousFunType `[t0, t1] [set: R]) := + isContinuous.Build _ _ (cont_on_segN t0 t1 t01 g : subspace `[-t1, -t0] -> R) (@cg' g). + +End cont_on_segN. + +Lemma cont_on_seg_zmod_closed {R : realType} {V : normedModType R} a b : + zmod_closed (@cont_on_seg R V a b). +Proof. +split=> [|f g]; rewrite !inE/=. +- apply: squash. + do 2 split => //. + exact: cst_continuous. +- move=> /unsquash cf /unsquash cg. + apply: squash. + pose f' : @continuousFunType _ _ `[a, b] setT := HB.pack f cf. + pose g' : @continuousFunType _ _ `[a, b] setT := HB.pack g cg. + rewrite [f]/(f' : _ -> _). + rewrite [g]/(g' : _ -> _). + move: {f g cf cg} f' g' => f g. + have isfun_fg : @isFun _ _ `[a, b] setT (f \- g) by constructor. + have iscontfun_fg : @isContinuous _ _ (f \- g). + constructor => x. + by apply: continuousB; exact: cts_fun. + by split. +Qed. + +Lemma contfun_scaler_closed {R : realType} {V : normedModType R} a b : + GRing.scaler_closed (@cont_on_seg R V a b). +Proof. +move=> r f; rewrite 2!inE/= => /unsquash[[_ cf]]. +apply: squash. +split => //. +constructor => x. +apply: continuousZ; first exact: cst_continuous. +by case: cf; exact. +Qed. + +Lemma cont_within_cont_comp {R : realType} {W : normedModType R} (f : W -> R) + (K : set R) (g : continuousFunType K [set: W]) : {in g @` K, continuous f} -> + {within K, continuous (f \o g)}. +Proof. +move=> ctf. +rewrite continuous_subspace_in => /= x Kx. +apply: continuous_comp; first exact: cts_fun. +apply: ctf. +exact: image_f Kx. +Qed. + +(* generalized to higher dimension *) +Section within_continuous_lipschitz. +Context {R : realType} {U : normedModType R}. +Variables (f : R -> U -> U) (a b : R). +Variable (u0 : U) (r : {posnum R}). + +Variable (g : R -> U). +Hypothesis cg : {within `[a, b], continuous g}. + +Let B := closed_ball u0 r%:num. + +Variable k : R. +Hypothesis k0 : k > 0. +(* properties of the function f defining the differential equation: *) +(* k-lipschitz for all t *) +Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (f x)}. +(* within-continuous for all y *) +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous f ^~ y}}. + +Hypothesis imageg : g @` `[a, b] `<=` B. + +Let within_continuous_lipschitz_at_right (ab : a < b) : + f x (g x) @[x --> a^'+] --> f a (g a). +Proof. +apply/cvgrPdist_le => /= e e0. +have aab : a \in `[a, b]%R by rewrite bound_itvE ltW. +have e20 : 0 < e / 2 by rewrite divr_gt0. +(* use continuity in first variable *) +have c1_ineq : \forall t \near a^'+, `|f a (g a) - f t (g a)| <= e / 2. + have : g a \in (B : set U) by apply/mem_set/imageg => /=; exists a. + move /cont1/continuous_within_itvP_g => /(_ ab). + move=> [_ + _]. + rewrite cvgrPdist_le /=. + exact. +have gtd : \forall t \near a^'+, g t \in (B : set U). + near=> t. + apply/mem_set/imageg => /=; exists t => //. + rewrite in_itv/=; apply/andP; split => //. + by near: t; exact: nbhs_right_le. +(* use continuity of g *) +have cg_ineq : \forall t \near a^'+, `|g a - g t| <= k^-1 * (e / 2). + have /continuous_within_itvP_g := cg. + move/(_ ab) => [_ + _]. + move/cvgrPdist_le => /(_ (k^-1 * (e / 2)) ). + apply. + by rewrite mulr_gt0// invr_gt0. +(* use Lipschitz continuity *) +have c2_ineq : \forall t \near a^'+, `|f t (g (a)) - f t (g t)| <= (e/2). + near=> t. + have td' : t \in `[a, b]%R. + by rewrite in_itv /=; apply/andP; split=>//; rewrite ltW. + have gNdB : B (g a) by apply: imageg => //=; exists a. + have Bgt : B (g t) by apply: imageg => //=; exists t. + move: lip2 => /(_ _ td'). + move /(_ (g a, g t) (conj gNdB Bgt)). + move/le_trans; apply. + rewrite -ler_pdivlMl//. + by near: t. +near=>t. +rewrite -(subrKA (f t (g a)) (f (a) (g (a)))) (le_trans (ler_normD _ _))//. +by rewrite (splitr e) lerD//; near: t. +Unshelve. all: end_near. Qed. + +Let within_continuous_lipschitz_at_left (ab : a < b) : + f x (g x) @[x --> b^'-] --> f b (g b). +Proof. +apply/cvgrPdist_le => /= e e0. +have bbab : b \in `[a, b]%R by rewrite bound_itvE ltW. +have e20 : 0 < e / 2 by rewrite divr_gt0. +have c1_ineq : \forall t \near b^'-, `|f b (g b) - f t (g b)| <= e / 2. + have : g b \in (B : set U) by apply/mem_set/imageg => //=; exists b. + move /cont1/continuous_within_itvP_g => /(_ ab). + move=> [_ _ +]. + rewrite cvgrPdist_le /=. + exact. +have gtd : \forall t \near b^'-, g t \in (B : set U). + near=>t. + apply/mem_set/imageg => /=; exists t => //. + rewrite in_itv/=; apply/andP; split => //. + by near: t; exact: nbhs_left_ge. +have cg_ineq : \forall t \near (b)^'-, `|g b - g t| <= k^-1 * (e / 2). + have /continuous_within_itvP_g := cg. + move/(_ ab) => [_ _ +]. + move/cvgrPdist_le => /(_ (k^-1 * (e / 2))). + apply. + by rewrite mulr_gt0// invr_gt0. +have c2_ineq : \forall t \near (b)^'-, `|f t (g b) - f t (g t)| <= (e/2). + near=> t. + have td' : t \in `[a, b]%R. + by rewrite in_itv /=; apply/andP; split=> //; rewrite ltW. + have gNdB : B (g b) by apply: imageg => /=; exists b. + have Bgt : B (g t) by apply: imageg; exists t. + move: lip2 => /(_ _ td'). + move /(_ (g b, g t) (conj gNdB Bgt)). + move/le_trans; apply. + rewrite -ler_pdivlMl//. + by near: t. +near=>t. +rewrite -(subrKA (f t (g b)) (f b (g b))) (le_trans (ler_normD _ _))//. +by rewrite (splitr e) lerD//; near: t. +Unshelve. all: end_near. Qed. + +Lemma within_continuous_lipschitz : + {within `[a, b], continuous fun x0 : R => f x0 (g x0)}. +Proof. +have [ab|] := ltP a b; last first. + rewrite le_eqVlt => /predU1P[<-|ab]. + by rewrite set_itv1; exact: continuous_subspace1. + by rewrite set_itv_ge ?bnd_simp -?ltNge//; exact: continuous_subspace0. +apply/continuous_within_itvP_g; [by [] | split]. +- move=> x; rewrite inE /= in_itv/= => /andP[ndx dx]. + rewrite /continuous_at. + apply/cvgrPdist_le => /= e e0. + have gxB : g x \in (B : set U). + apply/mem_set/imageg => /=; exists x => //. + by rewrite in_itv/= (ltW ndx) (ltW dx). + have H : r%:num - `|g x - u0| >= 0. + rewrite subr_ge0 distrC. + by move: gxB; rewrite /B closed_ballE /closed_ball_ //= inE. + near=> t. + rewrite -(subrKA (f t (g x)) (f x (g x))) (le_trans (ler_normD _ _))//. + rewrite (splitr e) lerD//. + + near: t. + near_simpl. + have /cont1 : g x \in B. + apply/mem_set/imageg => /=; exists x => //. + by rewrite in_itv/= (ltW ndx) (ltW dx). + move/continuous_within_itvP_g => /(_ ab). + move=> [+ Htmp1 Htmp2]. + move/(_ x). + rewrite /continuous_at. + have e20 : 0 < e / 2 by rewrite divr_gt0. + rewrite inE /= !in_itv/= ndx dx => /(_ isT). + move/cvgrPdist_le => /(_ _ e20)[r0 /= r0_gt0 Br0]. + near=> t. + apply: Br0 => //. + rewrite -/(ball x r0 t). + near: t. + near_simpl. + exact: (near_ball x _ r0_gt0). + + have := @lip2 t. + have tab : t \in `[a, b]%R. + near: t. + exists (Num.min (b - x) (x - a)) => /=. + by rewrite lt_min subr_gt0 dx/= subr_gt0. + move=> z/=. + rewrite lt_min => /andP[H1 H2]. + rewrite in_itv/=; apply/andP; split. + move: H2. + by rewrite ltr_distlC subKr => /andP[/ltW]. + move: H1. + by rewrite ltr_distlC (addrC x (b-x)) subrK => /andP[_ /ltW]. + move/(_ tab). + move/set_mem in gxB. + have Bgt : B (g t) by apply: (imageg) => /=; exists t. + move/(_ (g x, g t) (conj gxB Bgt)). + move=> /le_trans; apply. + rewrite -ler_pdivlMl//. + near: t. + move/continuous_within_itvP_g : cg => /(_ ab)[+ _ _] => /(_ x). + rewrite inE /= in_itv/= ndx dx => /(_ isT). + rewrite /continuous_at => /cvgrPdist_le. + apply. + by rewrite mulr_gt0 ?divr_gt0 ?invr_gt0. +- exact: within_continuous_lipschitz_at_right. +- exact: within_continuous_lipschitz_at_left. +Unshelve. all: end_near. Qed. + +End within_continuous_lipschitz. + +Lemma compact_has_ubound {R : realType} (A : set R) : compact A -> has_ubound A . +Proof. +move=> /compact_bounded[u [_ /= uA]]. +exists (u + 1) => x Ax. +by rewrite (le_trans (ler_norm x))// uA// ltrDl. +Qed. + +Lemma normr_has_sup {R : realType} {W : normedModType R} (a b : R) + (f : continuousFunType `[a, b] [set: W]) : + a <= b -> has_sup [set (normr \o f) z | z in `[a, b] ]. +Proof. +move=> /seg_nonempty[c Kc]. +split; first by exists `|f c|, c. +apply/compact_has_ubound/continuous_compact => //; last exact: segment_compact. +by apply:cont_within_cont_comp => w wK; exact: norm_continuous. +Qed. + +Definition infty_norm0 {R : realType} {W : normedModType R} (K : set R) + (f : {fun K >-> [set: W]}) := sup ((Num.norm \o f) @` K). + +Section infty_norm0_lemmas. +Context {R : realType} {W : normedModType R}. +Variables a b : R. +Hypothesis ab : a <= b. +Let K := `[a, b]. +Local Notation T := (continuousFunType K [set: W]). + +Lemma infty_norm0_le (g : T) (u : R) : {in K, forall x, `| g x | <= u} -> + infty_norm0 g <= u. +Proof. +have [c Kc] := seg_nonempty ab. + move => h; rewrite /infty_norm0; apply: ge_sup. + by exists (normr (g c)); exists c => //; rewrite /= in_itv/= lexx. + by move => _ [x xab] <-;apply h; rewrite inE. +Qed. + +Lemma infty_norm0_ge (g : T) x : x \in K -> `|g x| <= infty_norm0 g. +Proof. +move=> xK. +rewrite sup_upper_bound //=. + exact: normr_has_sup. +exists x => //. +by rewrite inE in xK. +Qed. + +Lemma infty_norm0_itv_eq (f g : T): {in K, f =1 g} -> + infty_norm0 f = infty_norm0 g. +Proof. +move=> inK. +rewrite /infty_norm0 /=; congr (sup _). +by apply/seteqP; split; move => _ [ y ? <- ]; exists y; rewrite //= inK // inE. +Qed. + +End infty_norm0_lemmas. + +Section intermediate_lemma. +Context {R : realType}. +Variables (a b : R). +Hypothesis a1 : a < b. +Variable u0 : R. +Variable r : {posnum R}. +Let B := closed_ball u0 r%:num. + +(* NB: not used anymore *) +Local Lemma imageg_closure (g : R -> R) : {within `[a, b], continuous g} -> + g @` `]a, b[ `<=` interior B -> g @` `[a, b] `<=` B. +Proof. +move => cont_g imageg _ [] x /= + <-. +rewrite in_itv /= => /andP[+ +]/=. +have /continuous_within_itvP := cont_g. +move=> /(_ a1)[]/=. +move => gcont gcontl gcontr. +have closea1 : closed `[a, b] by exact: interval_closed. +have h0 x0 : g x0 \in (interior B : set R) -> g x0 \in B. + rewrite /B interior_closed_ballE//. + rewrite closed_ball_itv//. + rewrite ball_itv 2!inE. + exact: subset_itv_oo_cc. +case: ltgtP => [hyd|_|<-] // => _. + case: ltgtP => [hyd'|_|->] // => _. + apply/set_mem/h0/mem_set/imageg => /=. + exists x => //=; rewrite in_itv /= hyd hyd' //. + apply: (@closed_cvg _ _ (b^'-) _ g B) => //=. + exact: closed_ball_closed. + near=>t. + apply/set_mem/h0/mem_set/imageg => /=. + exists t => //=. + by rewrite !in_itv/=; apply/andP; split. +move => _. +apply: (@closed_cvg _ _ (a^'+) _ g B) => //=. + exact: closed_ball_closed. +near=>t. +apply/set_mem/h0/mem_set/imageg; exists t => //=. +by rewrite !in_itv/=; apply/andP; split. +Unshelve. all: end_near. Qed. + +End intermediate_lemma. diff --git a/contfun.v b/contfun.v new file mode 100644 index 00000000..7fc03165 --- /dev/null +++ b/contfun.v @@ -0,0 +1,882 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. +From mathcomp Require Import generic_quotient ring_quotient. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import constructive_ereal. +From mathcomp Require Import functions reals interval_inference topology. +From mathcomp Require Import prodnormedzmodule tvs normedtype landau. +From mathcomp Require Import ereal sequences derive numfun measure realfun. +From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. +Require Import common. +(**md**************************************************************************) +(* # ODE *) +(* infty_norm f := infty_norm0 (repr f) *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. + +Open Scope ring_scope. +Open Scope classical_set_scope. +Locate continuousEP. +Module Cont_on_seg_zlmodtype. +Section cont_on_seg_zlmodtype. +Context {R : realType} {V : normedModType R} (a b : R). + +HB.instance Definition _ := GRing.isZmodClosed.Build _ _ + (@cont_on_seg_zmod_closed R V a b). +Fail Check continuousFunType `[a, b] [set: V] : zmodType. + +HB.instance Definition _ := + [SubChoice_isSubZmodule of continuousFunType `[a, b] [set: V] by <:]. + +Check continuousFunType `[a, b] [set: V] : zmodType. + +HB.instance Definition _ := GRing.isScaleClosed.Build _ _ + (cont_on_seg a b) (@contfun_scaler_closed R V a b). + +Fail Check @continuousFunType R V `[a, b] [set: V] : lmodType _. + +HB.instance Definition _ := + [SubZmodule_isSubLmodule of continuousFunType `[a, b] [set: V] by <:]. + +Check continuousFunType `[a, b] [set: V] : lmodType _. + +End cont_on_seg_zlmodtype. +End Cont_on_seg_zlmodtype. + +(* point V does not need to be 0, so rewrite f\_K explicitly *) +Section submod_itv. +Context {R : realType} {V : normedModType R} (a b : R). +Local Notation T := (continuousFunType `[a, b] [set: V]). + +Definition submod_itv (ab : a <= b) : {pred T} := + [pred f : T | patch 0 `[a, b] f == 0]. + +End submod_itv. +Arguments submod_itv {R} V {a b} ab. + +Section contFun_seminorm. +Context {R : realType} {W : normedModType R}. +Variables a b : R. +Hypothesis ab : a <= b. +Let K := `[a, b]. +Local Notation T := (continuousFunType K [set: W]). + +Import Cont_on_seg_zlmodtype. + +(* NB: require Nmodule properties *) +Lemma infty_norm0_eq0 : infty_norm0 (0 : T) = 0. +Proof. +rewrite /infty_norm0 -(sup1 0); congr sup. +apply eq_set => /= z ;apply propext; split => [[x _ <- ] | ->]; rewrite ?normr0 => //. +have [c Kc] := seg_nonempty ab. +by exists c; [ | rewrite normr0 ]. +Qed. + +(* NB: require Nmodule properties *) +Lemma infty_norm0rMn (x : T) n : infty_norm0 (x *+ n) = infty_norm0 x *+ n. +Proof. +rewrite /infty_norm0 -sup_Mn; last exact: normr_has_sup. +rewrite image_comp/=; congr (sup _). +apply eq_imagel => z Kz /=. +rewrite -normrMn /=. +have /(congr1 (fun a => a z)) <- := natmulfctE x n. +congr (normr (_ z)). +(* This is strange *) +elim: n x => //= n IH x. +by rewrite !mulrS -IH. +Qed. + +Lemma infty_norm0N (x : T) : infty_norm0 (- x) = infty_norm0 x. +Proof. +rewrite /infty_norm0; congr sup. +apply: eq_set => /= x0. +apply propext; split => [[x1 in_itv] | [x1 in_itv]] H; exists x1 =>//. +by rewrite -normrN. +by rewrite normrN. +Qed. + +End contFun_seminorm. + +Module Cont_on_seg_quot. +Export Cont_on_seg_zlmodtype. +Section submod_definition. +Context {R : realType} {V : normedModType R}. +Variables a b : R. +Hypothesis ab : a <= b. + +Lemma submod_closed_itv : submod_closed (submod_itv V ab). +Proof. +split => /=. +- rewrite inE/=; apply/funext => x. + by rewrite /patch; case: ifPn. +- move => f u v. + rewrite !inE => u0 v0. + apply/funext => u1. + rewrite /patch; case: ifPn => // u1ab. + move: u0 v0; rewrite /patch. + move=> /(congr1 (fun x => x u1)); rewrite u1ab => uu1. + move=> /(congr1 (fun x => x u1)); rewrite u1ab => vu1. + by rewrite -[LHS]/(f *: u u1 + v u1) uu1 vu1 addr0 scaler0. +Qed. + +Fail Check (submod_itv V ab) : zmodClosed _. + +HB.instance Definition _ := + GRing.isZmodClosed.Build _ _ (GRing.submod_closedB submod_closed_itv). + +Check (submod_itv V ab) : zmodClosed _. + +End submod_definition. + +Import Quotient. + +Section cont_on_seg_quotient. +Context {R : realType} {W : normedModType R} (a b : R). +Hypothesis ab : a <= b. + +(*Definition eq_seg (f g : continuousFunType a b) := `[< {in `[a, b], f =1 g} >]. + +Let eq_seg_refl : reflexive eq_seg. +Proof. by move=> f; apply/asboolP => r. Qed. + +Let eq_seg_sym : symmetric eq_seg. +Proof. by move=> f g; apply/idP/idP => /asboolP h; apply/asboolP => r /h. Qed. + +(* TODO: wait for quotient *) +Let eq_seg_trans : transitive eq_seg. +Proof. +by move=> f g h /asboolP fg /asboolP gh; apply/asboolP => r rab; rewrite fg// gh. +Qed. + +Canonical eq_seg_canonical := + EquivRel eq_seg eq_seg_refl eq_seg_sym eq_seg_trans.*) + +Local Open Scope quotient_scope. + +Definition quot_continuousFunType := {quot (@submod_itv _ W _ _ ab)}. +Local Notation T := quot_continuousFunType. + +(* NB: ZmodQuotient is defined in ring_quotient.v *) +HB.instance Definition _ := ZmodQuotient.on T. + +Definition quot_continuousFunType_to_fun (f : T) : + (* NB(rei): was R -> R before 2025-12-26 *) + subspace `[a, b] -> W := repr f. +Coercion quot_continuousFunType_to_fun : T >-> Funclass. + +Lemma eq_segP (f g : T) : reflect ({in `[a, b], f =1 g}) (f == g %[mod T]). +Proof. +apply/(iffP idP); rewrite eqmodE//=. +- rewrite equivE inE => fgab0 x xab. + move/(congr1 (fun z => z x)) : fgab0. + by rewrite /patch xab => /subr0_eq. +- move=> abfg. + rewrite /equivE inE; apply/funext => x. + rewrite /patch; case: ifPn => //= xab. + rewrite !fctE. + by apply/eqP; rewrite subr_eq0; exact/eqP/abfg. +Qed. + +Lemma eqmod_on_itv f g : f = g %[mod T] -> {in `[a, b], f =1 g}. +Proof. +move=> /eqmodP + x xab. +move/set_mem => abfg0. +apply: subr0_eq. +move/(congr1 (fun z => z x)) : abfg0. +by rewrite /patch xab. +Qed. + +Lemma eval_mod_on_itv f x : x \in `[a, b] -> (\pi_T f : T) x = f x. +Proof. +move => xab. +apply: (@eqmod_on_itv (repr (\pi_T f)) f) => //. +by rewrite reprK. +Qed. + +End cont_on_seg_quotient. +End Cont_on_seg_quot. + +Section zmodule_normed. +Context {R : realType} {W : normedModType R}. +Variables a b : R. +Hypothesis ab : a <= b. +Let K := `[a, b]. + +Import Cont_on_seg_quot. + +Local Notation V := (@quot_continuousFunType R W a b ab). + +Definition infty_norm (f : V) := infty_norm0 (repr f). + +Local Open Scope quotient_scope. + +Lemma ler_infty_normD (x y : V) : + infty_norm (x + y) <= infty_norm x + infty_norm y :> R. +Proof. +rewrite /infty_norm/= -sup_sumE; [|exact: normr_has_sup..]. +apply: sup_le. +- move=> A -[s sab] <-{A}. + rewrite /down/=. + eexists. + split. + exists `|repr x s|. + by exists s. + exists `|repr y s|. + by exists s. + reflexivity. + suff -> : repr (x + y) s = repr x s + repr y s by exact: ler_normD. + suff : (repr (x+y) = repr x + repr y %[mod V]). + move=> /eqmod_on_itv ->. + by []. + by rewrite inE. + by rewrite Quotient.pi_add !reprK. +- exact: (normr_has_sup _ _).1. +- split. + + exists ((normr \o repr x) a + (normr \o repr y) a)=> /=. + exists ((normr \o repr x) a) => //; [exists a => //; rewrite in_itv/= lexx ab // | ]. + by exists ((normr \o repr y) a) => //; exists a => //; rewrite bound_itvE. + + exists (sup [set (normr \o repr x) x0 | x0 in K] + sup [set (normr \o repr y) x0 | x0 in K]). + apply ubP => _ [x0 xs] [y0 ys] <-. + rewrite lerD// ub_le_sup//. + exact: (normr_has_sup x _).2. + exact: (normr_has_sup y _).2. +Qed. + +Lemma infty_normr0_eq0 (x : V) : infty_norm x = 0 -> x = 0. +Proof. +rewrite /infty_norm /infty_norm0 /= => H. +rewrite -(reprK x) -(reprK 0). +apply/eqquotP. +rewrite Quotient.equivE inE; apply: funext => x0 /=. +rewrite /patch; case : ifPn => // /set_mem in_itv. +rewrite 2!fctE. +have -> : {in K, repr (0 : V) =1 (0 : @continuousFunType R W K setT)}. +- apply/eqmod_on_itv. + by rewrite reprK /GRing.zero /= /Quotient.zero /= -lock. +- rewrite [LHS]subr0. + apply/eqP; rewrite -normr_le0. + have := sup_upper_bound (normr_has_sup x ab). + rewrite H /ubound /=. + apply. + by exists x0. +- by rewrite inE. +Qed. + +Lemma infty_normrMn (x : V) n : infty_norm (x *+ n) = infty_norm x *+ n. +Proof. +rewrite /infty_norm -infty_norm0rMn => //. +apply: infty_norm0_itv_eq => r rab. +suff : repr (x *+ n) = repr x *+ n %[mod V] by move=> /eqmod_on_itv ->. +elim n; [rewrite !mulr0n // reprK /GRing.zero /= /Quotient.zero /= -lock // | ]. +move => n' IHn'; rewrite reprK !mulrS. +rewrite reprK in IHn'. +rewrite Quotient.pi_add reprK. +by move : IHn' <-. +Qed. + +Let infty_norm_pi x : infty_norm (\pi_V x) = infty_norm0 x. +Proof. +rewrite /infty_norm /=. +have /eqmod_on_itv Heq : repr (\pi_V x) = x %[mod V] by rewrite reprK. +exact: infty_norm0_itv_eq. +Qed. + +Lemma infty_normrN (x : V) : infty_norm (- x) = infty_norm x. +Proof. +rewrite -(reprK x) /GRing.opp /= -Quotient.pi_opp !infty_norm_pi /infty_norm /infty_norm0. +congr sup. +apply eq_set => /= x0. +apply propext; split => [[x1 in_itv] | [x1 in_itv]] H; exists x1 =>//. + by rewrite -normrN. +by rewrite normrN. +Qed. +(* TODO: dev the theory of sup following the theory of ess_sup *) + +Fail Check V : normedZmodType R. + +HB.instance Definition _ := @Num.Zmodule_isNormed.Build R V + infty_norm ler_infty_normD infty_normr0_eq0 infty_normrMn infty_normrN. + +Lemma norm_piE x : `|\pi_V x| = infty_norm0 x. +Proof. by rewrite /Num.norm /= infty_norm_pi. Qed. + +Check V : normedZmodType R. + +Check (pseudoMetric_normed V) : pseudoMetricType R. +Check (pseudoMetric_normed V) : normedZmodType R. + +Fail Check (pseudoMetric_normed V) : normedModType R. + +End zmodule_normed. + +Section V_normedtype. +Context {R : realType} {W : normedModType R} {r s : R} (rs : r <= s). + +Import Cont_on_seg_quot. + +Local Notation V := (@quot_continuousFunType R W r s rs). + +Fail Check (pseudoMetric_normed V) : normedModType R. +HB.instance Definition _ := PseudoMetric.copy V (pseudoMetric_normed V). +HB.instance Definition _ := isPointed.Build V 0. + +Lemma is_normZmod_contFunBallType : NormedZmod_PseudoMetric_eq R V. +Proof. by constructor. Qed. + +Fail Check V : pseudoMetricNormedZmodType R. + +HB.instance Definition _ := is_normZmod_contFunBallType. + +Check V : pseudoMetricNormedZmodType R. +Import Quotient. +Open Scope quotient_scope. +Definition cont_scale (k : R) (v : V) : V := \pi_V (k *: repr v). + +Let cont_scalerA a b v : cont_scale a (cont_scale b v) = cont_scale (a * b) v. +Proof. +rewrite /cont_scale. +have [-> | a0] := eqVneq a 0; first by rewrite !(scale0r, mul0r). +apply/eqmodP; rewrite /equiv_equiv/= /equiv/=. +rewrite -scalerA -scalerBr. +rewrite inE. +apply/funext => x/=. +rewrite /patch; case: ifPn => // xrs. +rewrite !fctE. +apply/eqP; rewrite scaler_eq0. +rewrite (negPf a0)/= subr_eq0. +apply/eqP. +case: piP => f. +by move/eqmod_on_itv => /(_ _ xrs) <-. +Qed. + +Let cont_scale1r : left_id 1 cont_scale. +Proof. +move=> v. +rewrite /cont_scale/=. +rewrite [RHS](_ : _ = (\pi_V (repr v))%qT); last by rewrite reprK. +apply/eqmodP. +by rewrite scale1r. +Qed. + +Let cont_scalerDr : right_distributive cont_scale +%R. +Proof. +move=> k b c. +rewrite /cont_scale/=. +have [-> | k0] := eqVneq k 0. + by rewrite !scale0r piE//= add0r. +rewrite /cont_scale/=. +rewrite piE/=. +apply/eqmodP. +rewrite /equiv_equiv /equiv/=. +rewrite -scalerDr. +rewrite -scalerBr. +rewrite inE. +apply/funext => x/=. +rewrite /patch; case: ifPn => // xrs. +rewrite !fctE. +apply/eqP; rewrite scaler_eq0 (negPf k0)/=. +rewrite subr_eq0. +apply/eqP. +have := @eqmod_on_itv _ _ _ _ rs (repr (b + c)) (repr b + repr c). +move=> ->//. +rewrite pi_add//=. +by rewrite !reprK. +Qed. + +Let cont_scalerDl v : {morph cont_scale^~ v: a b / a + b}. +Proof. +move=> a b. +rewrite /cont_scale piE/=. +apply/eqmodP; rewrite /equiv_equiv/= /equiv/=. +rewrite -scalerDl subrr. +rewrite inE/=. +by apply/funext => x; rewrite /patch; case: ifP. +Qed. + +HB.instance Definition _ := + @GRing.Zmodule_isLmodule.Build R V cont_scale cont_scalerA cont_scale1r + cont_scalerDr cont_scalerDl. + +Local Lemma repr_mult l (x : V) a : a \in `[r, s] -> + repr (l *: x) a = l *: (repr x a). +Proof. +move =>ars. +have : repr (l *: x) = l *: repr x %[mod V]. + by case: piP. +move/(@eqmod_on_itv _ _ _ _ rs (repr (l *: x)) (l *: repr x)). +by move/(_ _ ars). +Qed. + +Lemma is_pmnormedZmod_contFunBallType : + PseudoMetricNormedZmod_Lmodule_isNormedModule R V. +Proof. +constructor => l x. +rewrite /Num.norm/= /infty_norm /infty_norm0 /=. +apply/eqP; rewrite eq_le; apply/andP; split. + apply: ge_sup. + exists `|repr (l *: x) r|, r => //=. + by rewrite bound_itvE. + move=> _/= [a ars] <-. + rewrite repr_mult; last by rewrite inE. + rewrite normrZ ler_wpM2l// ub_le_sup//. + exact: (normr_has_sup _ _).2. + by exists a. +rewrite -sup_mult => //; last by apply normr_has_sup. +apply sup_le; [ | | by apply normr_has_sup]. + move => _ [_ [x0 x0rs] <- <-]. + exists (`|l| * `|repr x x0|); split=> //=; exists x0. + by rewrite inE. + rewrite repr_mult; last by rewrite inE. + by rewrite normrZ. +exists `|l *: x r|, `|repr x r|. + by exists r => //=; rewrite bound_itvE. +by rewrite normrZ. +Qed. + +HB.instance Definition _ := is_pmnormedZmod_contFunBallType. +End V_normedtype. + +From mathcomp Require Import all_algebra. +From mathcomp Require Import matrix_topology. + +Section completeness. +Context {R : realType} (*{n : nat}*) {W : completeNormedModType R}. +(*Let W := 'rV[R]_n.*) +Variables a b : R. +Hypothesis ab : a <= b. + +Import Cont_on_seg_quot. + +Notation V := (@quot_continuousFunType R W _ _ ab). + +Check (V : pseudoMetricType R). +Check (V : normedModType R). + +Lemma infty_norm_gt_V (f : V) e : + `| f | < e -> {in `[a, b], forall x : R, `|f x| < e}. +Proof. +rewrite -{1}(reprK f) norm_piE => h x xab. +exact/le_lt_trans/h/infty_norm0_ge. +Qed. + +Lemma infty_norm_le_V (f : V) e : + {in `[a, b], forall x : R, `|f x| <= e} -> `| f | <= e. +Proof. by move => h; by rewrite -(reprK f) norm_piE infty_norm0_le. Qed. + +Definition lim_fun (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : + subspace `[a, b] -> W := + fun t => lim (@^~t @ F). + +Lemma lim_fun_is_fun (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : + @isFun (subspace `[a, b]) W `[a, b] [set: W] (@lim_fun F FF Fc). +Proof. by constructor. Qed. + +HB.instance Definition _ F FF Fc := (@lim_fun_is_fun F FF Fc). + +Lemma lim_fun_cvg_pt (F : set_system V) (FF: ProperFilter F) (Fc : cauchy F) : + forall (e : R), e > 0 -> forall t, t \in `[a,b] -> + \forall f \near F, `|lim_fun FF Fc t - (f : V) t| <= e. +Proof. +have /(_ _ _) /cauchy_cvg /cvg_app_entourageP cvF : + forall t : R, t \in `[a,b] -> + cauchy (fmap (fun (h : V) => h t) (fun x : set V => nbhs F (fun x0 : V => x x0))). + move=> t tab A /=. + rewrite -entourage_ballE. + move=> [e /= e0 eA]. + rewrite near_simpl -near2E near_map2. + apply : Fc. + rewrite -entourage_ballE. + rewrite /nbhs/=. + exists e => //. + move => /= [f g] /=. + move /infty_norm_gt_V => h. + apply eA => /=. + rewrite -ball_normE /ball/=. + have <- : (f - g : V) t = (f : V) t - (g : V) t. + rewrite -(reprK f) -(reprK g) /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. + by rewrite !eval_mod_on_itv. + by apply h. +have cvg_pt : forall (t : R), t \in `[a,b] -> x @[x --> fmap (fun h : V => h t) F] --> lim_fun FF Fc t. + move => t tab. + apply /cvg_entourageP. + by apply cvF. +move => e e0 t tab. +move /(_ t tab) : cvg_pt. +move/cvgrPdist_le/(_ _ e0). +exact. +Qed. + +Lemma lim_fun_cvg_uniform (F : set_system V) (FF: ProperFilter F) (Fc : cauchy F) : + forall (e : R), e > 0 -> \forall f \near F, forall t, t \in `[a,b] -> `|lim_fun FF Fc t - (f : V) t| <= e. +Proof. +move => e e0. +have e20 : 0 < e/2 by rewrite divr_gt0. +have := Fc _ (entourage_ball V (PosNum e20)). +move => [/= [ha hb] /= [n1 n2]] H. +near=>f. +move=>t tab. +near F => g. +rewrite -(subrKA (g t) (lim_fun FF Fc t)). +rewrite (le_trans (ler_normD _ _))// (splitr e) lerD//. + near: g. + by apply lim_fun_cvg_pt;rewrite // divr_gt0. +have c1 : ball f (e/2) g. + apply (H (f, g)); split => //=. + by near: f. + by near: g. +rewrite /ball /= /pseudoMetric_from_normedZmodType.ball /= in c1. +rewrite distrC. +have <- : (f - g : V) t = (f : V) t - (g : V) t. + rewrite -(reprK f) -(reprK g) /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. + by rewrite !eval_mod_on_itv. +rewrite ltW //. +exact: infty_norm_gt_V. +Unshelve. all: by end_near. Qed. + +Lemma lim_fun_cont (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : + {within `[a, b], continuous (@lim_fun F FF Fc)}. +Proof. +move: ab; rewrite le_eqVlt => /predU1P[<-| ab']. + by rewrite set_itv1; exact: continuous_subspace1. +have H : forall (e : R), e > 0 ->forall t, t \in `[a,b] -> \forall t' \near t, t' \in `[a,b] -> + `|lim_fun FF Fc t - lim_fun FF Fc t'| <= e. + move => e e0 t tab. + near F => f. + move /(continuous_within_itvP _ ab') : (@cts_fun _ _ f ) => [mc lc rc]. + move : (tab). + rewrite -{1}setUitv1/=; last by rewrite bnd_simp ltW. + rewrite -{1}setU1itv/=; last by rewrite bnd_simp. + (* split t=a, t \in ]a,b[, t=b *) + rewrite inE/= in_itv/= => -[[->|tab']|->]. + - near=> t' => t'ab. + rewrite -(subrKA (f a) (lim_fun FF Fc a)). + rewrite (le_trans (ler_normD _ _))//. + rewrite (splitr e) lerD//. + suff: forall t, t \in `[a,b] -> `|lim_fun FF Fc t - f t| <= e / 2 by apply;rewrite inE /= in_itv/= lexx ltW //. + near:f. + by apply lim_fun_cvg_uniform;rewrite // divr_gt0 //. + rewrite -(subrKA (f t') (f a)). + rewrite (le_trans (ler_normD _ _))//. + rewrite (splitr (e/2)) lerD//. + move : t'ab. + rewrite -{1}setU1itv/=; last by rewrite bnd_simp. + rewrite inE/= in_itv/= => -[-> | ]. + rewrite subrr normr0 ltW //. + do 2 rewrite divr_gt0 //. + near:t'. + move /cvgrPdist_le : lc . + move /( _ (e/ 2/ 2)) => [| e1 e10 eh]. + do 2 rewrite divr_gt0 //. + exists e1 => //. + move => x bx /andP [xa _]. + by apply eh. + rewrite distrC. + move : (t') t'ab. + near:f. + by apply lim_fun_cvg_uniform; do 2 rewrite divr_gt0 //. + - near=> t' => t'ab. + rewrite -(subrKA (f t) (lim_fun FF Fc t)). + rewrite (le_trans (ler_normD _ _))//. + rewrite (splitr e) lerD//. + move : (t) (tab). + near:f. + by apply lim_fun_cvg_uniform;rewrite // divr_gt0 //. + rewrite -(subrKA (f t') (f t)). + rewrite (le_trans (ler_normD _ _))//. + rewrite (splitr (e/2)) lerD//. + near:t'. + move /(_ _ tab'): mc. + rewrite /continuous_at cvgrPdist_le /=. + apply. + do 2 rewrite divr_gt0 //. + rewrite distrC. + move : (t') t'ab. + near:f. + apply lim_fun_cvg_uniform; do 2 rewrite divr_gt0 //. +(* Todo: same as 1 *) + - near=> t' => t'ab. + rewrite -(subrKA (f b) (lim_fun FF Fc b)). + rewrite (le_trans (ler_normD _ _))//. + rewrite (splitr e) lerD//. + suff: forall t, t \in `[a,b] -> `|lim_fun FF Fc t - f t| <= e / 2 by apply;rewrite inE /= in_itv/= lexx ltW //. + near:f. + by apply lim_fun_cvg_uniform;rewrite // divr_gt0 //. + rewrite -(subrKA (f t') (f b)). + rewrite (le_trans (ler_normD _ _))//. + rewrite (splitr (e/2)) lerD//. + move : t'ab. + rewrite -{1}setUitv1/=; last by rewrite bnd_simp ltW. + rewrite inE/= in_itv/= => -[ | -> ];last first. + rewrite subrr normr0 ltW //. + do 2 rewrite divr_gt0 //. + near:t'. + move /cvgrPdist_le : rc . + move /( _ (e/ 2/ 2)) => [| e1 e10 eh]. + do 2 rewrite divr_gt0 //. + exists e1 => //. + move => x bx /andP [_ xb]. + by apply eh. + rewrite distrC. + move : (t') t'ab. + near:f. + by apply lim_fun_cvg_uniform; do 2 rewrite divr_gt0 //. +apply/continuous_within_itvP => //; split. +- move => t tab. + apply/cvgrPdist_le => /= e e0. + near=>t'. + have : t' \in `[a,b]. + rewrite inE; apply: subset_itv_oo_cc. + near: t'. + apply/at_right_in_segment. + by apply: open_itvcc_subset. + near:t'. + apply: H => //. + by rewrite inE; apply subset_itv_oo_cc. +- apply/cvgrPdist_le => /= e e0. + near=>t'. + have : t' \in `[a,b]. + rewrite inE /= in_itv/=. + apply/andP; split; near:t'. + exact: nbhs_right_ge. + exact: nbhs_right_le. + near:t'. + apply : cvg_at_right_filter. + by apply cvg_id. + apply: H => //. + by rewrite inE/= bound_itvE// ltW. +apply/cvgrPdist_le => /= e e0. +near=>t'. +have : t' \in `[a,b]. + rewrite inE /= in_itv/=. + apply /andP;split;near:t'. + exact: nbhs_left_ge. + exact: nbhs_left_le. +near:t'. +apply: cvg_at_left_filter. + exact: cvg_id. +apply: H => //. +by rewrite inE /= bound_itvE/= ltW. +Unshelve. all: by end_near. Qed. + +HB.instance Definition _ F FF Fc := + isContinuous.Build (subspace `[a, b]) W + (@lim_fun F FF Fc : subspace `[a, b] -> W) (@lim_fun_cont F FF Fc). + +Fail Check (V : completeType). + +Lemma cvg_V_entourageP (F : set_system V) (FF : Filter F) + (f : V) : + F --> f <-> forall A, entourage A -> + \forall g \near F, {in `[a, b], forall t : R, A (f t, (g : V) t)}. +Proof. +split => [/cvg_entourageP /= Ff A|/=Ff]. + rewrite -entourage_ballE => -[eps eps0 /= H]. + apply: (Ff [set fg : V * V| {in `[a, b], forall t : R, A (fg.1 t, fg.2 t)}]). + exists eps => //. + rewrite /pseudoMetric_from_normedZmodType.ball /=. + move => /= x bx t tab. + apply H => /=. + rewrite -ball_normE /ball/=. + have -> : (x.1 : V) t - (x.2 : V) t = (x.1 - x.2 :V) t. + rewrite -(reprK x.1) -(reprK x.2) /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. + by rewrite !eval_mod_on_itv. + exact: infty_norm_gt_V. +apply/cvg_entourageP => /= A [e e0 sPA]. +have e20 : 0 < e / 2 by rewrite divr_gt0. +have e2 : e / 2 < e by rewrite ltr_pdivrMr// mulrC ltr_pMl //= ltrDr. +near=>g. +apply: sPA. +apply/le_lt_trans/e2/infty_norm_le_V => /= t tab. +have -> : (f - g : V) t = f t - (g : V) t. + rewrite -(reprK f) -(reprK g) /GRing.opp /=. + rewrite -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. + by rewrite !eval_mod_on_itv. +rewrite ltW //. +suff: ball (f t) (e / 2) (g t). + by rewrite -ball_normE /ball/=. +move: t tab. +near: g. +exact: (Ff [set xy : W * W | ball xy.1 (PosNum e20)%:num xy.2] (entourage_ball _ _)). +Unshelve. all: by end_near. Qed. + +Lemma quot_cont_on_segType_cauchy_cvg (F : set_system V) : + ProperFilter F -> cauchy F -> cvg F. +Proof. +move=> FF Fc. +have /(_ _ _)/cauchy_cvg /cvg_app_entourageP cvF : + forall t : R, t \in `[a,b] -> + cauchy (fmap (fun (h : V) => h t) (fun x : set V => nbhs F (fun x0 : V => x x0))). + move=> t tab A /=. + rewrite -entourage_ballE => -[e e0 ee]; rewrite near_simpl -near2E near_map2. + apply : Fc. + exists e => //. + move => /= [f g]. + move /infty_norm_gt_V => h. + apply ee => /=. + rewrite -ball_normE /ball_/=. + have <- : (f - g : V) t = (f : V) t - (g : V) t. + rewrite -(reprK f) -(reprK g) /GRing.opp /=. + rewrite -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. + by rewrite !eval_mod_on_itv. + exact: h. +apply/cvg_ex; exists (pi V (@lim_fun F FF Fc : continuousFunType `[a, b] [set: W])). +apply /cvg_V_entourageP => /=. +move=> A /= entA. +near=>f. +move => t tab. +near F => g. +apply : (entourage_split (g t)) => //. + by rewrite eval_mod_on_itv => //; first by near:g;apply: cvF. +move: (t) (tab); near: g; near: f; apply: nearP_dep; apply: Fc. +rewrite /nbhs /=. +have := entourage_split_ent entA. +rewrite -entourage_ballE => -[e e0 ee]. +rewrite -entourage_ballE. +exists e => //. +move => [/= x y]. +rewrite /pseudoMetric_from_normedZmodType.ball/=. +move /infty_norm_gt_V => h t tab. +apply ee => /=. +rewrite -ball_normE /ball_ /=. +rewrite distrC. +have -> : (x : V) t - (y : V) t = (x - y :V) t. + rewrite -(reprK y) -(reprK x) /GRing.opp /=. + rewrite -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. + by rewrite !eval_mod_on_itv. +exact: h. +Unshelve. all: by end_near. Qed. + +HB.instance Definition _ := Uniform_isComplete.Build V + quot_cont_on_segType_cauchy_cvg. + +Check (V : completeType). +End completeness. + +(* Section vector_contseg. *) + +(* Context {R : realType}. *) +(* Variables (a b : R). *) +(* Hypothesis ab : a <= b. *) + +(* Notation V := (quot_contFunType (seg_nonempty ab) (@segment_compact R _ _)). *) + +(* Definition Vn n := {ffun 'I_n -> V}. *) +(* Check V : normedZmodType R. *) +(* Check (V : pseudoMetricType R). *) +(* Check (V : normedModType R). *) +(* Check (Vn 2 : normedZmodType R). *) +(* Check (Vn 2 : pseudoMetricType R). *) +(* Check (Vn 2 : completeType). *) +(* Fail Check (Vn 2 : normedModType R). *) +(* End vector_contseg. *) +(* (* not neeeded anymore *) *) + +(* Section lip_implies_cont. *) +(* Context {R : realType}. *) +(* Local Notation mu := lebesgue_measure. *) +(* Variables (f : R -> R -> R) (t0 t1 : R). *) +(* Hypothesis t01 : t0 < t1. *) +(* Variable k : R. *) +(* Hypothesis k1 : k > 0. *) +(* Variables (u0 : R) (r : {posnum R}). *) +(* Let B := closed_ball u0 r%:num. *) + +(* Hypothesis lip2 : {in `[t0, t1]%R, forall x, k.-lipschitz_B (f x)}. *) + +(* Lemma cont2 : {in `[t0, t1]%R, forall x, {within B, continuous f x}}. *) +(* Proof. *) +(* move=> x xt01. *) +(* rewrite [B]closed_ball_itv//. *) +(* apply/continuous_within_itvP; first by rewrite ltrD2l gtrN. *) +(* split. *) +(* - move=> y yt01. *) +(* move: (xt01); have := @lip2 x => /[apply] kfx. *) +(* rewrite /continuous_at. *) +(* apply/cvgrPdist_le => /= e e0. *) +(* near=> y'. *) +(* move: kfx => /(_ (y, y'))/=. *) +(* have By : B y. *) +(* rewrite /B closed_ball_itv//=. *) +(* exact: subset_itv_oo_cc yt01. *) +(* have By' : B y'. *) +(* rewrite /B closed_ball_itv//=. *) +(* rewrite in_itv/=; apply/andP; split. *) +(* near: y'. *) +(* exists (y - (u0 - r%:num)). *) +(* by move: yt01; rewrite in_itv/= -subr_gt0 => /andP[]. *) +(* move=> z/=. *) +(* rewrite ltr_distlC. *) +(* by rewrite opprB addrCA subrr addr0 => /andP[/ltW]. *) +(* near: y'. *) +(* exists ((u0 + r%:num) - y). *) +(* by move: yt01; rewrite in_itv/= -(subr_gt0 y) => /andP[]. *) +(* move=> z/=. *) +(* rewrite ltr_distlC => /andP[_]. *) +(* by rewrite addrCA subrr addr0 => /ltW. *) +(* move=> /(_ (conj By By')). *) +(* move=> /le_trans; apply. *) +(* rewrite -ler_pdivlMl// mulrC. *) +(* near: y'. *) +(* (* TODO(rei): investigate *) *) +(* exists (e / k). *) +(* by rewrite divr_gt0//. *) +(* by move=> z/= => /ltW. *) +(* - apply/cvgrPdist_le => /= e e0. *) +(* near=> y'. *) +(* move: (xt01); have := @lip2 x => /[apply]. *) +(* move=> /(_ (u0 - r%:num, y'))/=. *) +(* have Bu0r : B (u0 - r%:num). *) +(* rewrite /B closed_ball_itv//=. *) +(* by rewrite in_itv/= lexx/= lerD2l gerN. *) +(* have By' : B y'. *) +(* rewrite /B closed_ball_itv//=. *) +(* rewrite in_itv/=; apply/andP; split => //. *) +(* near: y'. *) +(* exists r%:num => //=. *) +(* move=> z/=. *) +(* rewrite ltr_distlC. *) +(* rewrite subrK => /andP[_ /ltW + _] => /le_trans; apply. *) +(* by rewrite lerDl. *) +(* move=> /(_ (conj Bu0r By')). *) +(* move=> /le_trans; apply. *) +(* rewrite -ler_pdivlMl// mulrC. *) +(* near: y'. *) +(* (* TODO(rei): investigate *) *) +(* exists (e / k) => /=. *) +(* by rewrite divr_gt0//. *) +(* by move=> z/= => /ltW. *) +(* - apply/cvgrPdist_le => /= e e0. *) +(* near=> y'. *) +(* move: (xt01); have := @lip2 x => /[apply]. *) +(* move=> /(_ (y', u0 + r%:num))/=. *) +(* have By' : B y'. *) +(* rewrite /B closed_ball_itv//=. *) +(* rewrite in_itv/=; apply/andP; split => //. *) +(* near: y'. *) +(* exists r%:num => //=. *) +(* move=> z/=. *) +(* rewrite ltr_distlC addrK => /andP[/ltW + _ _]. *) +(* rewrite lerBlDl => /le_trans; apply. *) +(* by rewrite lerDr. *) +(* have Bu0r : B (u0 + r%:num). *) +(* rewrite /B closed_ball_itv//=. *) +(* by rewrite in_itv/= lexx/= lerD2l andbT gerN. *) +(* move=> /(_ (conj By' Bu0r)). *) +(* rewrite distrC. *) +(* move=> /le_trans; apply. *) +(* rewrite -ler_pdivlMl// mulrC. *) +(* near: y'. *) +(* (* TODO(rei): investigate *) *) +(* exists (e / k) => /=. *) +(* by rewrite divr_gt0//. *) +(* move=> z/= => /ltW. *) +(* by rewrite distrC. *) +(* Unshelve. all: end_near. Qed. *) + +(* End lip_implies_cont. *) diff --git a/ode.v b/ode.v new file mode 100644 index 00000000..00baf8d3 --- /dev/null +++ b/ode.v @@ -0,0 +1,1823 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. +From mathcomp Require Import archimedean generic_quotient ring_quotient. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import constructive_ereal. +From mathcomp Require Import functions reals interval_inference topology. +From mathcomp Require Import prodnormedzmodule tvs normedtype landau. +From mathcomp Require Import ereal sequences derive numfun measure realfun. +From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. +Require Import common contfun. + +(**md**************************************************************************) +(* # Proof of the Cauchy-Lipschitz theorem *) +(* *) +(* We consider an ODE defined by a function phi : K -> 'rV[K]_n -> 'rV[K]_n. *) +(* The idea of the proof is to define a function *) +(* picard := fun t => u0 + \int[mu]_(x in `[a, t]) phi x (g x) *) +(* and to study the solution of the integral equation g t = picard t. *) +(* *) +(* Preliminaries: *) +(* \vint[mu]_(x in A) f x == integral of f of type R -> 'rV_n *) +(* *) +(* picard_fun_subdef u0 r phi a b g gabB == *) +(* fun t => u0 + \vint_(x in `[a, t]) phi x (g x) *) +(* defined as a continuous function from `[a, b] to 'rV_n *) +(* morally, takes a function g and returns a function g *) +(* gabB is a proof that g @` `[a, b] `<=` closed_ball u0 r *) +(* *) +(* picard_fun lip2 cont1 g == same as picard_fun_subdef when *) +(* g @` `[a, b] `<=` closed_ball u0 r and cst 0 o.w. *) +(* *) +(* Technical constants need for the proof: *) +(* sup_phi == sup {phi t u0 | t \in [a, b]} *) +(* delta_max == min (b - a, r / (k * r + sup_phi), rho / k) *) +(* upper-bound of delta *) +(* The dependence of delta_max on the initial state u0 comes *) +(* from sup_phi in the second term. *) +(* @img_cball R n f a b k ab u0 r k0 rho == *) +(* set of functions of type (quot_continuousFunType (leDl_delta_max ...)) *) +(* s.t. f @` `[a, a + delta_max] `<=` closed_ball u0 r *) +(* *) +(* picard == similar to picard_fun *) +(* as a function from/to the quotient of functions continuous over `[a, b] *) +(* more precisely, function of type {fun img_cball >-> img_cball} *) +(* *) +(* picard_fix == fixpoint of the integral equation defined by picard *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. + +Open Scope ring_scope. +Open Scope classical_set_scope. + +(* start of preliminaries *) + +(* NB: PR to MathComp-Analysis in progress *) +Section pointwise_derivable. +Context {R : realFieldType} {V W : normedModType R} {m n : nat}. +Implicit Types M : V -> 'M[R]_(m, n). + +Definition derivable_mx M t v := + forall i j, derivable (fun x => M x i j) t v. + +Lemma derivable_mxP M t v : derivable_mx M t v <-> derivable M t v. +Proof. +split; rewrite /derivable_mx /derivable. +- move=> H. + apply/cvg_ex => /=. + pose l := \matrix_(i < m, j < n) sval (cid ((cvg_ex _).1 (H i j))). + exists l. + apply/cvgrPdist_le => /= e e0. + near=> x. + rewrite /Num.Def.normr/= mx_normrE. + apply: (bigmax_le _ (ltW e0)) => /= i _. + rewrite !mxE/=. + move: i. + near: x. + apply: filter_forall => /= i. + exact: ((@cvgrPdist_le _ _ _ _ (dnbhs_filter 0) _ _).1 + (svalP (cid ((cvg_ex _).1 (H i.1 i.2)))) _ e0). +- move=> /cvg_ex[/= l Hl] i j. + apply/cvg_ex; exists (l i j). + apply/cvgrPdist_le => /= e e0. + move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0] H. + near=> x. + apply: le_trans; last first. + apply: (H x). + rewrite /ball_/=. + rewrite sub0r normrN. + near: x. + exact: dnbhs0_lt. + near: x. + exact: nbhs_dnbhs_neq. + rewrite [leRHS]/Num.Def.normr/= mx_normrE. + apply: le_trans; last exact: le_bigmax. + by rewrite /= !mxE. +Unshelve. all: by end_near. Qed. + +End pointwise_derivable. + +(* NB: PR to MathComp-Analysis in progress *) +Section pointwise_derive. +Local Open Scope classical_set_scope. +Context {R : realFieldType} {V W : normedModType R} . + +Lemma derive_mx {m n : nat} (M : V -> 'M[R]_(m, n)) t v : + derivable M t v -> + 'D_v M t = \matrix_(i < m, j < n) 'D_v (fun t => M t i j) t. +Proof. +move=> /cvg_ex[/= l Hl]; apply/cvg_lim => //=. +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : (Hl) => /(_ (e / 2)). +rewrite divr_gt0// => /(_ isT)[d /= d0 dle]. +near=> x. +rewrite [in leLHS]/Num.Def.normr/= mx_normrE. +apply/(bigmax_le _ (ltW e0)) => -[/= i j] _. +rewrite [in leLHS]mxE/= [X in _ + X]mxE -[X in X - _](subrK (l i j)). +rewrite -(addrA (_ - _)) (le_trans (ler_normD _ _))// (splitr e) lerD//. +- rewrite mxE. + suff : (h^-1 *: (M (h *: v + t) i j - M t i j)) @[h --> 0^'] --> l i j. + move/cvg_lim => /=; rewrite /derive /= => ->//. + by rewrite subrr normr0 divr_ge0// ltW. + apply/cvgrPdist_le => /= r r0. + move/cvgrPdist_le : Hl => /(_ r r0)[/= s s0] sr. + near=> y. + have : `|l - y^-1 *: (M (y *: v + t) - M t)| <= r. + rewrite sr//=; last by near: y; exact: nbhs_dnbhs_neq. + by rewrite sub0r normrN; near: y; exact: dnbhs0_lt. + apply: le_trans. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE. + by under eq_bigr do rewrite !mxE; exact: (le_bigmax _ _ (i, j)). +- rewrite mxE. + have : `|l - x^-1 *: (M (x *: v + t) - M t)| <= e / 2. + apply: dle => //=; last by near: x; exact: nbhs_dnbhs_neq. + by rewrite sub0r normrN; near: x; exact: dnbhs0_lt. + apply: le_trans. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE/=. + under eq_bigr do rewrite !mxE. + apply: le_trans; last exact: le_bigmax. + by rewrite !mxE. +Unshelve. all: by end_near. Qed. + +End pointwise_derive. + +Reserved Notation "\vint [ mu ]_ ( i 'in' D ) F" + (at level 36, F at level 36, i, D at level 60, + format "'[' \vint [ mu ]_ ( i 'in' D ) '/ ' F ']'"). +Reserved Notation "\vint [ mu ]_ i F" + (F at level 36, i at level 0, + right associativity, format "'[' \vint [ mu ]_ i '/ ' F ']'"). + +(* TODO: move *) +Section row_Rintegral. +Context {R : realType} (d : measure_display) {T : measurableType d}. +Variable (mu : {measure set T -> \bar R}). +Variable (D : set T) (n : nat). + +Definition rowRintegral (f : T -> 'rV[R]_n) : 'rV[R]_n := + \row_i (\int[mu]_(x in D) (f x) ord0 i). + +Local Notation "\vint_ i F" := + (rowRintegral (fun i => F)%R) (at level 36, i at level 0, + format "'[' \vint_ i '/ ' F ']'") : ring_scope. + +Lemma rowRintegralE (f : T -> 'rV[R]_n) i : + (\vint_x f x) ord0 i = \int[mu]_(x in D) (f x) ord0 i. +Proof. by rewrite /rowRintegral mxE. Qed. + +End row_Rintegral. + +Notation "\vint [ mu ]_ ( x 'in' D ) f" := + (rowRintegral mu D (fun x => f)%R) : ring_scope. +Notation "\vint [ mu ]_ x f" := + (rowRintegral mu setT (fun x => f)%R) : ring_scope. + +Section rowRintegral. +Context {R : realType}. +Let mu := @lebesgue_measure R. + +Lemma rowRintegral_set1 n (f : R -> 'rV[R]_n) (r : R) : + \vint[mu]_(x in [set r]) f x = 0. +Proof. by apply/rowP => i; rewrite !mxE Rintegral_set1. Qed. +Lemma eq_rowRintegral n (D : set R) (f : R -> 'rV[R]_n) (g : R -> 'rV[R]_n): + {in D, f =1 g} -> \vint[mu]_(x in D) f x = \vint[mu]_(x in D) g x. +Proof. +move => h. +apply /rowP => i. +rewrite !rowRintegralE. +apply eq_Rintegral => /= x Dx. +by rewrite h. +Qed. + +End rowRintegral. + +Section rowRintegral_itv_split. +Local Notation mu := lebesgue_measure. + +Lemma rowRintegral_itv_split {R : realType} (n : nat) (F : R -> 'rV[R]_n) + (a c b : R) : + a <= c <= b -> + (forall i, mu.-integrable `[a, b] (EFin \o (fun x : R => F x ord0 i))) -> + \vint[mu]_(s in `[a, b]) F s = + \vint[mu]_(s in `[a, c]) F s + \vint[mu]_(s in `[c, b]) F s. +Proof. +move=> /andP[t0t1 t1t2] intF. +apply/rowP=> i. +rewrite !rowRintegralE !mxE. +apply/eqP. +rewrite addrC -subr_eq. +apply/eqP. +rewrite (@Rintegral_itvB _ (fun x => F x ord0 i) (BLeft a) (BRight b) c) //=. +apply Rintegral_itv_obnd_cbnd. +apply (@integrableS _ _ _ lebesgue_measure `[a, b] `]c, b] (EFin \o (fun x => F x ord0 i))) =>//. +exact: subset_itvScc. +Qed. + +End rowRintegral_itv_split. + +(* TODO: PR *) +Section vector_continuous. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. + +Lemma within_continuous_coord (h : R -> U) D : + {within D, continuous h} <-> forall i, {within D, continuous (fun x => h x ord0 i)}. +Proof. +split=> [Dh i|H]. +- apply/subspace_continuousP => /= x Dx. + have /subspace_continuousP/(_ x Dx) H := Dh. + apply: ((@cvg_comp _ _ _ h (fun z => z ord0 i)) _ _ _ H). + exact: coord_continuous. +- apply/subspace_continuousP => /= x Dx. + apply/cvgrPdist_le => /= e e0. + rewrite near_withinE. + near=> t => Dt. + rewrite /Num.norm/= mx_normrE. + apply/(bigmax_le _ (ltW e0)) => /= -[i j] _ /=. + rewrite {i}(ord1 i) !mxE. + move: j Dt. + near: t. + apply: filter_forall => /= i. + have /subspace_continuousP/(_ x Dx) := H i. + move/cvgrPdist_le => /(_ _ e0). + rewrite near_withinE. + exact. +Unshelve. all: by end_near. Qed. + +End vector_continuous. + +Lemma continuous_within_ext {A B : topologicalType} (g h : A -> B) D : + {in D, g =1 h} -> + {within D, continuous g } -> {within D, continuous h}. +Proof. +move=> h1 h2. +apply subspace_continuousP. +move => x Dx. +apply : cvg_trans. +apply (fmap_within_eq (g := g)) => //. +apply nbhs_filter. +move => x' Dx' . +symmetry. +by apply h1. +rewrite <-h1. +move /subspace_continuousP : h2. +by apply. +by rewrite inE. +Qed. + +(* TODO: PR *) +Lemma measurable_fun_bigmaxr d (T : measurableType d) (R : realType) + (D : set T) (n : nat) (f : 'I_n -> T -> R) : + d.-measurable D -> + (forall i, measurable_fun D (f i)) -> + measurable_fun D (fun x => \big[maxr/0]_(i < n) f i x). +Proof. +move=> mD mf. +elim: n f mf => [|n IH] f mf. + have -> : (fun x : T => \big[maxr/0]_(i < 0) f i x) = 0. + apply funext => x. + by rewrite big_ord0. + exact: measurable_cst. +have -> : (fun x : T => \big[maxr/0]_(i < n.+1) f i x) = + fun x => maxr (f ord0 x) (\big[maxr/0]_(i < n) (f (lift ord0 i) x)). + by apply funext => x;apply big_ord_recl. +apply: measurable_maxr. + exact: mf. +by apply: IH => i; exact: mf. +Qed. + +Lemma vec_norm_le_sum {R : realType} {n : nat} (x : 'rV[R]_n) : + `| x | <= \sum_(i < n) `|x ord0 i|. +Proof. +rewrite {1}/Num.norm/= mx_normrE. +apply: bigmax_le => /=;first by apply sumr_ge0 => i _; exact: normr_ge0. +move => [i0 i] _ /=. +rewrite {i0}(ord1 i0)/=. +rewrite (bigD1 i) //= lerDl. +by apply: sumr_ge0 => j _; exact: normr_ge0. +Qed. + +Lemma vmeasurable_norm {R : realType} {n : nat} (D : set R) (F : R -> 'rV[R]_n): + measurable D -> (forall i, measurable_fun D (fun t => F t ord0 i)) -> + measurable_fun D (Num.norm \o F). +Proof. +move=> mD h. +have -> : normr \o F = (fun x => \big[maxr/0]_(i < n) `| F x ord0 i |). + apply: funext => x. + rewrite {1}/Num.norm/= mx_normrE. + rewrite (reindex (fun i : 'I_n => (ord0, i))) => //=. + exists (@snd 'I_1 'I_n) => /=. + + by move => i. + + move => [i j] /= _. + by rewrite {i}(ord1 i). +apply: measurable_fun_bigmaxr => //= i. +by apply: measurableT_comp => //=. +Qed. + +Lemma vintegrable_norm {R : realType} {n : nat} (D : set R) (F : R -> 'rV[R]_n): + measurable D -> + (forall i, lebesgue_measure.-integrable D (EFin \o (fun t => F t ord0 i))) -> + lebesgue_measure.-integrable D (EFin \o (Num.norm \o F)). +Proof. +move => mD intf. +apply (le_integrable (mu:=lebesgue_measure) mD (f := EFin \o (normr \o F)) + (g := EFin \o fun x => (\sum_(i < n) `| F x ord0 i|))). +- apply/measurable_EFinP. + apply vmeasurable_norm => // i. + have /integrableP[+ _]/= := intf i. + by move/measurable_EFinP. +- move => /= x0 Dx0. + rewrite normr_id. + rewrite lee_fin. + rewrite ger0_norm. + apply vec_norm_le_sum. + exact: sumr_ge0. +- have -> : EFin \o (fun x => \sum_(i < n) `|F x ord0 i|) = + fun x => (\sum_(i < n) `|F x ord0 i|%:E). + by apply/funext => x; rewrite sumEFin. + apply: integrable_sum => //= i _. + exact: integrable_norm. +Qed. + +Lemma closed_ball_vecE {R : realType} {n} (x0 : 'rV[R]_n) (r : {posnum R}) x : + closed_ball x0 r%:num x <-> + forall i, closed_ball (x0 ord0 i) r%:num (x ord0 i). +Proof. +split. +- rewrite closed_ballE /closed_ball_ //=. + rewrite /Num.norm/= mx_normrE => h i. + rewrite closed_ballE// /closed_ball_/=. + apply/le_trans/h. + have -> : x0 ord0 i - x ord0 i = (x0 - x) ord0 i by rewrite !mxE. + exact: (le_bigmax _ _ (ord0, i)). +- move=> h. + rewrite closed_ballE// /closed_ball_/=. + rewrite [in leLHS]/Num.norm/= mx_normrE. + apply: bigmax_le => //= -[i j] _ /=. + rewrite {i}(ord1 i)/=. + move /(_ j) : h. + by rewrite closed_ballE// /closed_ball_ /= 2!mxE. +Qed. + +Section lipschitz_componentE. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R). +Variables (u0 : U) (r : {posnum R}). +Let B := closed_ball u0 r%:num. +Hypothesis k0 : 0 < k. + +Lemma lipschitz_componentE x : k.-lipschitz_B (phi x) <-> + forall i, k.-lipschitz_B (fun y => phi x y ord0 i). +Proof. +split. +- move => lip i /= [x1 x2] /= Bx12. + move /(_ (x1,x2) Bx12) : lip. + apply le_trans => /=. + rewrite /Num.norm/= mx_normrE. + have -> : phi x x1 ord0 i - phi x x2 ord0 i = (phi x x1 - phi x x2) ord0 i by rewrite !mxE. + exact: (le_bigmax _ _ (ord0,i)). +- move => h /= [x1 x2] Bx12 /=. + rewrite [in leLHS]/Num.norm/= mx_normrE. + apply/bigmax_le. + by rewrite mulr_ge0 //= ltW. + move => //= -[i j] _ /=. + rewrite {i}(ord1 i)/=. + move /(_ j (x1,x2) Bx12) : h. + by rewrite !mxE. +Qed. + +End lipschitz_componentE. + +Definition measure_rV_display : measure_display -> measure_display. +Proof. exact. Qed. + +Section measurable_rV. +Context {d} {T : sigmaRingType d}. +Variable n : nat. + +Let coors : 'I_n -> 'rV[T]_n -> T := fun i x => x ord0 i. + +Let rV_set0 : g_sigma_preimage coors set0. +Proof. exact: sigma_algebra0. Qed. + +Let rV_setC A : g_sigma_preimage coors A -> g_sigma_preimage coors (~` A). +Proof. exact: sigma_algebraC. Qed. + +Let rV_bigcup (F : _^nat) : (forall i, g_sigma_preimage coors (F i)) -> + g_sigma_preimage coors (\bigcup_i (F i)). +Proof. exact: sigma_algebra_bigcup. Qed. + +HB.instance Definition _ := @isMeasurable.Build (measure_rV_display d) + 'rV[T]_n (g_sigma_preimage coors) rV_set0 rV_setC rV_bigcup. + +End measurable_rV. + +(* end of preliminaries *) + +(* cauchy-lipschitz really starts here *) + +Definition picard_fun_subdef {R : realType} n (U := 'rV[R]_n) (u0 : U) (r : R) + (B := closed_ball u0 r) (phi : R -> U -> U) (a b : R) (g : R -> U) + (gabB : g @` `[a, b] `<=` B) : R -> U := + fun t => u0 + (\vint[lebesgue_measure]_(x in `[a, t]) phi x (g x))%R. + +Section picard_fun_subdef_isFun. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R). +Variables (u0 : U) (r : {posnum R}). +Let B : set U := closed_ball u0 r%:num. +Variable g : R -> U. +Hypothesis gabB : g @` `[a, b] `<=` B. + +Let set_fun_picard_fun_subdef : + {homo picard_fun_subdef phi gabB : x / `[a, b] x >-> [set: U] x}. +Proof. by []. Qed. + +HB.instance Definition _ := @isFun.Build + (subspace `[a, b]) _ `[a, b] [set: U] (picard_fun_subdef phi gabB) + (set_fun_picard_fun_subdef). + +End picard_fun_subdef_isFun. + +Section picard_fun_subdef_isContinuous. +Local Notation mu := lebesgue_measure. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R). +Hypothesis ab : a <= b. +Variables (u0 : U) (r : {posnum R}). +Let B : set U := closed_ball u0 r%:num. + +Variable k : R. +Hypothesis k0 : k > 0. +Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. +Variable g : R -> U. +Variable cg : {within `[a, b], continuous g}. +Hypothesis gabB : g @` `[a, b] `<=` B. + +Lemma within_continuous_picard_fun_subdef : + {within `[a, b], continuous (picard_fun_subdef phi gabB)}. +Proof. +apply/within_continuous_coord => i. +rewrite /picard_fun_subdef. +suff: {within `[a, b], + continuous (fun t => \int[mu]_(y in `[a, t]) phi y (g y) ord0 i)}. + move=> abf x. + rewrite (_ : (fun r => (u0 + \vint[mu]_(y in `[a, r]) phi y (g y)) ord0 i) = + (fun r => u0 ord0 i + \int[mu]_(y in `[a, r]) (phi y (g y)) ord0 i)). + by apply: cvgD; [exact: cvg_cst|exact: abf]. + by apply/funext=> r0; rewrite mxE rowRintegralE. +move=> /= x. +apply: parameterized_integral_continuous => //. +apply: continuous_compact_integrable; first exact: segment_compact. +move=> {x}. +move: i; apply/within_continuous_coord. +exact: (within_continuous_lipschitz cg k0 lip2 cont1). +Qed. + +HB.instance Definition _ := isContinuous.Build (subspace `[a, b]) U + (picard_fun_subdef phi gabB : subspace _ -> _) + within_continuous_picard_fun_subdef. + +Let continuous_picard_fun_subdef : + {within `[a, b], continuous picard_fun_subdef phi gabB}. +Proof. exact: cts_fun. Abort. + +End picard_fun_subdef_isContinuous. + +Section picard_fun. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R). +Variables (u0 : U) (r : {posnum R}). +Let B := closed_ball u0 r%:num. + +Definition picard_fun + (k : R) (lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}) + (cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}) + (g : R -> U) : R -> U := + match pselect (g @` `[a, b] `<=` B) with + | left gabB => picard_fun_subdef phi gabB + | _ => cst 0 + end. + +End picard_fun. + +Section sup_phi. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R). +Variables (u0 : U). + +Definition sup_phi : R := sup [set `|phi t u0| | t in `[a, b]]. + +Lemma sup_phi_ge0 : 0 <= sup_phi. +Proof. by rewrite /sup_phi sup_ge0//= => x [y _ <-]. Qed. + +End sup_phi. + +(* PR 1802 om porgress *) +Lemma EVT_max_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : + A !=set0 -> compact A -> {within A, continuous f} -> + exists2 c, c \in A & forall t, t \in A -> f t <= f c. +Admitted. + +Section sup_phi_lemmas. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U). +Variables (u0 : U). + +Lemma sup_phiS a b c d : {within `[a, b], continuous (phi ^~ u0)} -> + a < b -> `[c, d] `<=` `[a, b] -> + sup_phi phi c d u0 <= sup_phi phi a b u0. +Proof. +move=> cf ab cdab. +rewrite /sup_phi. +have [cd|dc] := leP c d. + apply: sup_le => //. + - move=> _/= [r rcd <-]. + red. + simpl. + exists `|phi r u0|; split => //. + exists r => //. + by apply: cdab. + - exists `|phi c u0| => /=. + exists c => //. + by rewrite in_itv/= lexx cd. + - split. + exists `|phi a u0| => //=. + exists a => //. + by rewrite in_itv/= lexx (ltW ab). + have : {within `[a, b], continuous fun t : R => `|phi t u0|}. + apply: within_continuous_comp_norm => //. + exact/ltW. + move/(@EVT_max R (fun t => `|phi t u0|) _ _ (ltW ab)) => [e eab Hmax]. + exists (`|phi e u0|) => x/= [r rab <-//]. + exact: Hmax. +rewrite set_itv_ge ?bnd_simp/= -?ltNge// image_set0 sup0. +by apply: sup_ge0 => x/= [y _ <-//]. +Qed. + +End sup_phi_lemmas. + +Section delta_max. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R). +Hypothesis ab : a < b. +Variables (u0 : U) (r : {posnum R}). +Hypothesis k0 : 0 < k. +Variable rho : {posnum R}. (* rho < 1 *) + +Local Notation sup_phi := (sup_phi phi a b u0). + +Definition delta_max := Num.min (b - a) + (Num.min (r%:num / (k * r%:num + sup_phi)) + (rho%:num / k)). + +Lemma delta_max_gt0 : 0 < delta_max. +Proof. +rewrite lt_min subr_gt0 ab/= lt_min mulr_gt0 ?divr_gt0//. +by rewrite invr_gt0// ltr_wpDr ?sup_phi_ge0// mulr_gt0. +Qed. + +Lemma ltDl_delta_max : a < a + delta_max. +Proof. by rewrite ltrDl delta_max_gt0. Qed. + +Lemma leDl_delta_max : a <= a + delta_max. +Proof. by rewrite ltW// ltDl_delta_max. Qed. + +Lemma delta_max_itv : delta_max <= b - a. +Proof. by rewrite /delta_max ge_min lexx. Qed. + +End delta_max. + +Section image_in_closed_ball. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R). +Hypothesis ab : a < b. +Variables (u0 : U) (r : {posnum R}). +Hypothesis k0 : 0 < k. +Variable rho : {posnum R}. (* rho < 1 *) + +Import Cont_on_seg_quot. + +Local Notation delta_max := (@delta_max R n phi a b k u0 r rho). + +Local Notation V := + (quot_continuousFunType (@leDl_delta_max _ _ phi a b k ab u0 r k0 rho)). + +Definition img_cball : set V := + [set f : V | f @` `[a, a + delta_max] `<=` closed_ball u0 r%:num]. + +Lemma img_cball_nonempty : img_cball !=set0. +Proof. +exists (pi V (cst u0)) => _ [y aay] <-. +suff -> : quot_continuousFunType_to_fun (\pi_(V)%qT (cst u0)) y = u0. + exact: closed_ballxx. +rewrite /quot_continuousFunType_to_fun/=. +have /eqmod_on_itv : (repr (\pi_(V)%qT (cst u0)) = cst u0 %[mod V])%qT. + by rewrite reprK. +by apply; rewrite inE. +Qed. + +Lemma img_cballE : img_cball = + @closed_ball R V (pi V (@cst (subspace `[a, a + delta_max]) U u0)) r%:num. +Proof. +rewrite closed_ballE// /img_cball. +apply eq_set => /= f'; apply propext; split => h. +- rewrite -(@reprK _ V f'). + rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. + rewrite norm_piE. + apply: infty_norm0_le => /=. + exact: leDl_delta_max. + move=> x adx. + move /(_ (f' x)) : h. + rewrite closed_ballE//. + apply. + exists x => //. + by rewrite inE in adx. +- move => _ [x xad] <-. + rewrite closed_ballE// /closed_ball_ /=. + have -> : u0 - f' x = ((pi V (cst u0)) - f' : V) x. + rewrite -(@reprK _ V f') /GRing.opp /=. + rewrite -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. + by rewrite !eval_mod_on_itv// inE. + rewrite -(@reprK _ V f'). + rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. + rewrite eval_mod_on_itv;last by rewrite inE. + rewrite -inE in xad. + apply: (le_trans (infty_norm0_ge (leDl_delta_max phi ab u0 r k0 rho) _ xad)). + rewrite -(norm_piE (leDl_delta_max phi ab u0 r k0 rho)). + by rewrite Quotient.pi_add Quotient.pi_opp reprK. +Qed. + +Lemma closed_img_cball : closed img_cball. +Proof. by rewrite img_cballE; exact: closed_ball_closed. Qed. + +End image_in_closed_ball. + +Section picard_fun_isFun. +Local Notation mu := lebesgue_measure. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R). +Hypothesis ab : a < b. +Variables (u0 : U) (r : {posnum R}). +Let B := closed_ball u0 r%:num. +Hypothesis k0 : 0 < k. +Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. + +Variable rho : {posnum R}. (* rho < 1 *) + +Local Notation delta_max := (delta_max phi a b k u0 r rho). + +Lemma lip2_delta_max : {in `[a, a + delta_max]%R, forall x, k.-lipschitz_B (phi x)}. +Proof. +(* TODO: generalize to the subset relation *) +move/in_switch : lip2 => lip2'. +apply/in_switch. +apply: lipschitzW lip2'. +apply: subset_itvl. +by rewrite bnd_simp -lerBrDl; exact: delta_max_itv. +Qed. + +Lemma cont1_delta_max : + {in B, forall y, {within `[a, a + delta_max], continuous phi ^~ y}}. +Proof. +move=> /= x xB. +apply: continuous_subspaceW; last exact: cont1. +apply: subset_itvl. +by rewrite bnd_simp -lerBrDl; exact: delta_max_itv. +Qed. + +Local Notation picard_fun := + (@picard_fun _ n phi a (a + delta_max) u0 r k lip2_delta_max cont1_delta_max). + +Lemma picard_funE g t : g @` `[a, a + delta_max] `<=` B -> + picard_fun g t = u0 + \vint[mu]_(x in `[a, t]) phi x (g x). +Proof. by rewrite /picard_fun; case: pselect. Qed. + +Lemma picard_fun_init g : g @` `[a, a + delta_max] `<=` B -> + picard_fun g a = u0. +Proof. +by move => h; rewrite picard_funE// set_itv1 rowRintegral_set1 addr0. +Qed. + +Import Cont_on_seg_quot. + +Local Notation V := (quot_continuousFunType + (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). + +Let set_fun_picard_fun (g : V) : + set_fun `[a, a + delta_max] [set: U] (picard_fun g). +Proof. by []. Qed. + +HB.instance Definition _ (g : V) := @isFun.Build + (subspace `[a, a + delta_max]) _ + `[a, a + delta_max] setT (picard_fun g) (set_fun_picard_fun g). + +End picard_fun_isFun. + +Section picard_fun_isContinuous. +Local Notation mu := lebesgue_measure. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R). +Hypothesis ab : a < b. +Variables (u0 : U) (r : {posnum R}). +Let B := closed_ball u0 r%:num. +Hypothesis k0 : 0 < k. +Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. + +Variable rho : {posnum R}. (* rho < 1 *) + +Local Notation delta_max := (delta_max phi a b k u0 r rho). + +Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k + (@lip2_delta_max R n phi a b k u0 r lip2 rho) + (@cont1_delta_max R n phi a b k u0 r cont1 rho)). + +Import Cont_on_seg_quot. + +Local Notation V := (quot_continuousFunType + (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). + +Let continuous_picard_fun (g : V) : + {within `[a, a + delta_max], continuous (picard_fun g)}. +Proof. +have := @cts_fun _ _ g. +rewrite /picard_fun; case: pselect => /=. + move => z cg. + apply: (@cts_fun (subspace `[a, a + delta_max])). + + exact: leDl_delta_max. + + exact: k0. + + exact : lip2_delta_max. + + exact : cont1_delta_max. + + exact : cg. +move=> _ _. +by apply: continuous_subspaceT => z; exact: cvg_cst. +Qed. + +HB.instance Definition _ (g : V) := @isContinuous.Build _ _ + (picard_fun g : subspace _ -> _) (@continuous_picard_fun g). + +Check fun g : V => picard_fun g : continuousFunType _ _. + +Check fun g : V => (\pi_(V)%qT (picard_fun g )) : V. + +End picard_fun_isContinuous. + +Section integrable_comp. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Local Notation mu := lebesgue_measure. +Variables (phi : R -> U -> U) (a b : R) (k : R). +Hypothesis ab : a < b. +Variables (u0 : U) (r : {posnum R}). +Let B := closed_ball u0 r%:num. +Hypothesis k0 : 0 < k. +Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. + +Variable rho : {posnum R}. (* rho < 1 *) + +Local Notation delta_max := (delta_max phi a b k u0 r rho). + +Import Cont_on_seg_quot. + +Local Notation V := (quot_continuousFunType (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). + +Lemma integrable_comp (F : V) y : y \in `[a, a + delta_max]%R -> + F @` `[a, y] `<=` B -> + forall i, + mu.-integrable `[a, y] (EFin \o (fun t => phi t (F t) ord0 i)). +Proof. +move => yaadelta ab0r i. +apply: continuous_compact_integrable; first exact: segment_compact. +move: (yaadelta); rewrite in_itv/= => /andP[ay yadelta]. +move: i. +apply/within_continuous_coord. +apply/(within_continuous_lipschitz _ k0). +- have := @cts_fun _ _ F. + by apply/continuous_subspaceW/subset_itvl; rewrite bnd_simp. +- apply/in_switch. + move/in_switch : (@lip2_delta_max R n phi a b k u0 r lip2 rho). + by apply/lipschitzW/subset_itvl; rewrite bnd_simp. +- rewrite -/B => x xB. + have := @cont1_delta_max R n phi a b k u0 r cont1 rho _ xB. + by apply/continuous_subspaceW/subset_itvl; rewrite bnd_simp. +- exact: ab0r. +Qed. + +End integrable_comp. + +Section picard. +Local Notation mu := lebesgue_measure. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R). +Hypothesis ab : a < b. +Variables (u0 : U) (r : {posnum R}). +Let B := closed_ball u0 r%:num. +Hypothesis k0 : 0 < k. +Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. + +Variable rho : {posnum R}. (* rho < 1 *) + +Local Notation delta_max := (delta_max phi a b k u0 r rho). + +Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k + (@lip2_delta_max R n phi a b k u0 r lip2 rho) + (@cont1_delta_max R n phi a b k u0 r cont1 rho)). + +Import Cont_on_seg_quot. + +Local Notation V := (quot_continuousFunType (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). + +Definition picard (x : V) : V := \pi_V%qT (picard_fun x). + +Local Notation img_cball := (@img_cball R n phi a b k ab u0 r k0 rho). + +Local Notation sup_phi := (@sup_phi R n phi a b u0). + +Let set_fun_picard : set_fun img_cball img_cball picard. +Proof. +move=> F. +rewrite /img_cball/= => invariant _/= [y yaaDelta <-]. +rewrite /picard. +apply closed_ball_vecE => i. +rewrite closed_ball_itv//=. +rewrite in_itv//=. +rewrite [X in _ <= X <= _](_ : _ = (picard_fun F) y ord0 i); last first. + have /eqmod_on_itv : (repr (\pi_(V)%qT (picard_fun F)) = + picard_fun F %[mod V])%qT. + by rewrite reprK. + by move=> <- //; rewrite inE. +rewrite /picard_fun; case: pselect => /= abu0r; last by []. +rewrite /picard_fun_subdef /=. +rewrite mxE/=. +rewrite -ler_distl. +rewrite -addrA subrKC. +rewrite rowRintegralE. +rewrite (le_trans (le_normr_Rintegral _ _))//=. + apply: integrable_comp => //. + apply: subset_trans abu0r. + apply/image_subset/subset_itvl; rewrite bnd_simp. + by move : yaaDelta; rewrite in_itv /= => /andP[]. +have integrable2 : mu.-integrable `[a, y] (EFin \o (fun x => phi x (F x) ord0 i)). + apply integrable_comp => //=. + apply: subset_trans abu0r. + apply/image_subset/subset_itvl; rewrite bnd_simp. + by move: yaaDelta; rewrite in_itv /= => /andP[]. +have integrable1 : mu.-integrable `[a, y] + (fun x => `|phi x (F x) ord0 i - phi x u0 ord0 i|%:E + `|phi x u0 ord0 i|%:E). + rewrite integrableD//=. + apply integrable_norm => /=. + under [x in integrable _ _ x]eq_fun do rewrite EFinD. + rewrite integrableD //=. + under [x in integrable _ _ x]eq_fun do rewrite EFinN. + rewrite integrableN //=. + apply: continuous_compact_integrable => //=; first exact: segment_compact. + apply within_continuous_coord. + apply/continuous_subspaceW/(@cont1_delta_max R n phi a b k u0 r cont1 rho). + apply: subset_itvl; rewrite bnd_simp. + by move : yaaDelta;rewrite in_itv /= => /andP[]. + by rewrite /B inE; exact: closed_ballxx. + apply integrable_norm => /=. + apply continuous_compact_integrable => //=; first exact: segment_compact. + apply within_continuous_coord. + apply/continuous_subspaceW/(@cont1_delta_max R n phi a b k u0 r cont1 rho). + apply: subset_itvl; rewrite bnd_simp. + by move : yaaDelta;rewrite in_itv /= => /andP[]. + rewrite /B inE. + exact: closed_ballxx. +rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) + (`|phi x (F x) ord0 i - phi x u0 ord0 i| + `|phi x u0 ord0 i|)))//. + apply: le_Rintegral => //=. + - exact: integrable_norm. + - move=> x xay. + by rewrite (le_trans _ (ler_normD _ _))// subrK. +rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * `|F x - u0 | + sup_phi)))//. + apply: le_Rintegral => //=. + under [x in integrable _ _ x]eq_fun do rewrite EFinD. + rewrite integrableD //=. + under [x in integrable _ _ x]eq_fun do rewrite EFinM. + rewrite integrableMr //=. + exact: bounded_cst. + apply: vintegrable_norm => //. + move => j //=. + under [x in integrable _ _ x]eq_fun do rewrite !mxE EFinB. + rewrite integrableB //=. + apply continuous_compact_integrable => //; first exact: segment_compact. + apply within_continuous_coord. + apply/continuous_subspaceW/cts_fun. + apply: subset_itvl; rewrite bnd_simp. + by move : yaaDelta; rewrite in_itv /= => /andP[]. + apply measurable_bounded_integrable => //=. + rewrite lebesgue_measure_itv //=. + case: ifPn => //=. + by rewrite -EFinD ltry. + exact: bounded_cst. + apply measurable_bounded_integrable => //=. + rewrite lebesgue_measure_itv //=. + case: ifPn => //=. + by rewrite -EFinD ltry. + exact: bounded_cst. + move=> x xay. + rewrite lerD//. + have xaaDelta : x \in `[a, a + delta_max]%R. + move: x xay. + apply: subset_itvl; rewrite bnd_simp. + by rewrite (itvP yaaDelta). + move/(lip2_delta_max lip2) : xaaDelta. + rewrite lipschitz_componentE//. + move/(_ i (F x, u0)) => /=. + apply. + split => /=. + apply: invariant => /=. + exists x => //. + move : xay. + apply: subset_itvl; rewrite bnd_simp. + by rewrite (itvP yaaDelta). + exact: closed_ballxx. + apply: (@le_trans _ _ `|phi x u0 |). + rewrite {2}/Num.norm/= mx_normrE /=. + by apply: (le_bigmax _ _ (ord0, i)). + rewrite /sup_phi ub_le_sup//. + have [M [Mb1 Mb2]] : bounded_set [set `|phi t u0| | t in `[a,b]]. + apply/compact_bounded/continuous_compact; last exact: segment_compact. + apply: within_continuous_comp_norm. + by rewrite ltW. + by apply cont1;rewrite inE; exact: closed_ballxx. + exists (M + 1) => _ [x0 x0ab] <- /=. + rewrite -normr_id. + apply Mb2. + by rewrite ltrDl. + by exists x0. + exists x => //. + move: xay; rewrite in_itv/= in_itv/= => /andP[] -> /=. + move/le_trans; apply. + move : yaaDelta; rewrite in_itv /= => /andP[]. + move => _ /le_trans; apply. + by rewrite -lerBrDl delta_max_itv. +rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * r%:num + sup_phi)))//. + apply: le_Rintegral => //=. + - under [x in integrable _ _ x]eq_fun do rewrite EFinD. + rewrite integrableD //=. + under [x in integrable _ _ x]eq_fun do rewrite EFinM. + rewrite integrableMr //=. + exact: bounded_cst. + apply: vintegrable_norm => // j /=. + under [x in integrable _ _ x]eq_fun do rewrite !mxE EFinB. + rewrite integrableB //=. + apply continuous_compact_integrable => //. + exact: segment_compact. + apply within_continuous_coord. + apply /continuous_subspaceW/cts_fun. + apply: subset_itvl; rewrite bnd_simp. + by move : yaaDelta; rewrite in_itv /= => /andP[]. + apply: measurable_bounded_integrable => //=. + rewrite lebesgue_measure_itv//=. + case: ifPn => //=. + by rewrite -EFinD ltry. + exact: bounded_cst. + apply measurable_bounded_integrable => //=. + rewrite lebesgue_measure_itv //=. + case: ifPn => //=. + by rewrite -EFinD ltry. + exact: bounded_cst. + apply measurable_bounded_integrable => //=. + rewrite lebesgue_measure_itv //=. + case: ifPn => //=. + by rewrite -EFinD ltry. + exact: bounded_cst. + - move=> x xay. + rewrite lerD2r ler_pM2l//. + have : B (F x). + apply: invariant => /=. + exists x => //. + move: xay; rewrite !in_itv/= => /andP[] -> /= /le_trans. + apply. + by move: yaaDelta; rewrite in_itv /= => /andP[]. + by rewrite /B closed_ballE// /closed_ball_/=; rewrite distrC. +rewrite Rintegral_cst//. +rewrite /= (* to remove a reverse_coercion *). +rewrite lebesgue_measure_itv/=. +rewrite lte_fin. +move: (yaaDelta); rewrite in_itv/= => /andP[+ yadelta]. +rewrite le_eqVlt => /predU1P[->|ay]. + by rewrite ltxx/= mulr0. +rewrite (@le_trans _ _ ((k * r%:num + sup_phi) * delta_max))//. + rewrite ler_wpM2l//. + by rewrite addr_ge0 ?mulr_ge0 ?(ltW k0)// sup_phi_ge0. + by rewrite ay//= lerBlDl. +rewrite -ler_pdivlMl//; last first. + by rewrite ltr_pwDl ?mulr_gt0// sup_phi_ge0. +by rewrite 2!ge_min mulrC lexx/= orbT. +Qed. + +Fail Check picard_to_cont : {fun [set: V] >-> [set: V]}. + +HB.instance Definition _ := @isFun.Build _ _ _ _ picard set_fun_picard. + +Check picard : {fun img_cball >-> img_cball}. +(* still, we can't state that it is a contraction for typing reasons *) + +Fail Lemma tmp : is_contraction (picard : {fun [set: W] >-> [set: W]}). +About is_contraction. + +End picard. + +(* (* see measurable_fun_tnthP *) *) +(* Lemma rV_measurable_fun {d} {T : measurableType d} {R : realType} *) +(* (D : set T) n (f : T -> 'rV[R]_n) : *) +(* measurable_fun D f <-> forall i, measurable_fun D (fun t => f t ord0 i). *) +(* Proof. *) +(* split => [mf i mD /= Y mY|mf mD /= Y mY]. *) +(* admit. *) +(* admit. *) +(* Admitted. *) + +(* Definition proj (T : Type) n (A : set (n.-tuple T)) (i : 'I_n) : set T := *) +(* [set t | exists x, A x /\ t = tnth x i]. *) + +(* Lemma vnormr_measurable {R : realType} n (D : set 'rV[R]_n) : *) +(* measurable_fun D (@Num.norm R 'rV[R]_n). *) +(* Proof. *) +(* move=> mD /= Y mY. *) +(* rewrite /normr/=. *) +(* Admitted. *) + +(* Lemma vintegrable_norm {d} {T : measurableType d} {R : realType} *) +(* (mu : {measure set T -> \bar R}) (D : set T) n (f : T -> 'rV[R]_n) : *) +(* (forall i, mu.-integrable D (EFin \o (fun t => f t ord0 i))) -> *) +(* mu.-integrable D (EFin \o (Num.norm \o f)). *) +(* Proof. *) +(* move=> intf. *) +(* apply/integrableP; split. *) +(* apply/measurable_EFinP. *) +(* apply/measurableT_comp. *) +(* exact: vnormr_measurable. *) +(* apply/rV_measurable_fun => i. *) +(* have /integrableP[+ _]/= := intf i. *) +(* by move/measurable_EFinP. *) +(* rewrite (@le_lt_trans _ _ *) +(* (\big[maxe/-oo]_(i < n) \int[mu]_(x in D) `|f x ord0 i|%:E )%E)//. *) +(* rewrite /=. *) +(* under eq_integral do rewrite normr_id. *) +(* rewrite [in leLHS]/Num.norm/=. *) +(* under eq_integral do rewrite mx_normrE. *) +(* admit. *) +(* apply: bigmax_lt => //= i _. *) +(* have /integrableP[_]/= := intf i. *) +(* exact. *) + +(* PR: to master *) +Section Rintegral. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Implicit Types (D : set T). + +Lemma Rintegral_cst D : d.-measurable D -> + forall r, \int[mu]_(_ in D) r = r * fine (mu D). +Proof. +move=> mD r; rewrite /Rintegral/= integral_cst//. +have := leey (mu D); rewrite le_eqVlt => /predU1P[->/=|muy]; last first. + by rewrite fineM// ge0_fin_numE. +rewrite mulr0 mulr_infty/=; have [_|r0|r0] := sgrP r. +- by rewrite mul0e. +- by rewrite mul1e. +- by rewrite mulN1e. +Qed. + +End Rintegral. + +Section is_contraction_picard. +Local Notation mu := lebesgue_measure. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R). +Hypothesis ab : a < b. +Variable k : R. +Hypothesis k0 : 0 < k. +Variables (u0 : U) (r : {posnum R}). +Let B := closed_ball u0 r%:num. +Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. + +Variable rho : {posnum R}. (* rho < 1 *) +Hypothesis rho1 : (rho%:num < 1). + +Import Cont_on_seg_quot. + +Notation V := (quot_continuousFunType (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Notation img_cball := (@img_cball _ n phi a b k ab u0 r k0 rho). +Notation delta_max := (delta_max phi a b k u0 r rho). + +Check @cst (subspace `[a, a + delta_max]) U u0 + : {fun `[a, a + delta_max] >-> [set: U]}. + +Check @cst (subspace `[a, a + delta_max]) U u0 + : continuousType (subspace `[a, a + delta_max]) U. + +Local Notation picard := (@picard R n phi a b k ab u0 r k0 lip2 cont1 rho). + +Lemma is_contraction_picard : is_contraction picard. +Proof. +rewrite /is_contraction /contraction. +rewrite /picard /picard_fun /picard_fun_subdef. +exists (NngNum (ge0 rho)); split => //=. +move=> /= [/= x y] [Vrx Vry]. +rewrite /picard/=. +rewrite !piE/=. +rewrite norm_piE/=. +rewrite /infty_norm0/=. +apply: ge_sup => //=. + set u := _ \o _; exists (u a) => /=; exists a => //. + by rewrite in_itv/= lexx leDl_delta_max. +move=> _ /= [t tNdd <-]. +have tb : t <= b. + move: tNdd. + rewrite in_itv/= => /andP[Ndt]. + move=> /le_trans; apply. + by rewrite -lerBrDl; exact: delta_max_itv. +rewrite /picard_fun/=; case: pselect => //= Hg; case: pselect => [Hg2|//]. +rewrite /picard_fun_subdef/=. +rewrite !fctE. +rewrite (addrC u0). +rewrite addrKA. +rewrite [in leLHS]/Num.norm/= mx_normrE. +apply: bigmax_le => //= -[i j] _. +rewrite {i}(ord1 i)/=. +rewrite mxE rowRintegralE mxE rowRintegralE. +have integrable1 : mu.-integrable `[a, t] (EFin \o (fun x0 => phi x0 (x x0) ord0 j)). + apply: integrable_comp => //=. + apply: subset_trans Hg; apply: image_subset. + apply/subset_itvl; rewrite bnd_simp. + by move: tNdd; rewrite !in_itv/= => /andP[]. +have integrable2 : mu.-integrable `[a, t] (EFin \o (fun x0 => phi x0 (y x0) ord0 j)). + apply: integrable_comp => //= => _ [x0 h] <-. + apply: Hg2 => /=. + exists x0 => //. + apply/subset_itvl/h; rewrite bnd_simp. + by move: tNdd; rewrite !in_itv/= => /andP[]. +rewrite -RintegralB//=. +rewrite (le_trans (le_normr_Rintegral _ _))//=. + under [x in integrable _ _ x]eq_fun do rewrite EFinB. + by rewrite integrableB. +have integrable3 : mu.-integrable `[a, t] (fun x0 => `|x x0 - y x0|%:E). + rewrite /=. + apply : vintegrable_norm. + exact: measurable_itv. + move => i. + under [x in integrable _ _ x]eq_fun do rewrite !mxE EFinB. + rewrite integrableB//=. + apply continuous_compact_integrable => //=. + exact: segment_compact. + apply within_continuous_coord. + apply/continuous_subspaceW/cts_fun. + apply: subset_itvl; rewrite bnd_simp. + by move: tNdd; rewrite in_itv /= => /andP[]. + apply continuous_compact_integrable => //=. + exact: segment_compact. + apply within_continuous_coord. + apply/continuous_subspaceW/cts_fun. + apply: subset_itvl; rewrite bnd_simp. + by move: tNdd; rewrite in_itv /= => /andP[]. +rewrite (@le_trans _ _ (k * \int[mu]_(t0 in `[a, t]) `| x t0 - y t0|))//. + rewrite (@le_trans _ _ (\int[mu]_(t0 in `[a, t]) (k * `|x t0 - y t0|)))//. + apply: le_Rintegral => //=. + apply integrable_norm => //=. + under [x in integrable _ _ x]eq_fun do rewrite EFinB. + rewrite integrableB //=. + under [x in integrable _ _ x]eq_fun do rewrite EFinM. + rewrite integrableMr//=. + exact: bounded_cst. + move=> x0 x0at. + have : x0 \in `[a, b]%R by apply /subset_itvl/x0at. + move/lip2. + rewrite /dominated_by/= => /(_ (x x0, y x0)) /=. + have Bxy : B (x x0) /\ B (y x0). + split. + apply: Vrx => /=. + exists x0 => //. + apply/subset_itvl/x0at. + by move: tNdd; rewrite in_itv/= => /andP[Ndt]. + apply: Vry => /=. + exists x0 => //. + apply/subset_itvl/x0at. + by move: tNdd; rewrite in_itv/= => /andP[Ndt]. + move=> /(_ Bxy); apply: le_trans. + rewrite [in leRHS]/Num.norm/= mx_normrE. + apply: le_trans; last first. + by apply: le_bigmax => /=; exact: (ord0, j). + by rewrite /= !mxE. + by rewrite RintegralZl. +rewrite (@le_trans _ _ (k * \int[mu]_(t0 in `[a, t]) `|x - y| ))//. + rewrite ler_pM2l//. + apply: le_Rintegral => //=. + apply measurable_bounded_integrable => //=. + rewrite lebesgue_measure_itv //=. + case: ifPn => //=. + by rewrite -EFinD ltry. + exact: bounded_cst. + move=> x0 x0at. + have x0ad : x0 \in `[a, a + delta_max]. + rewrite inE/=. + apply: subset_itvl x0at; rewrite bnd_simp. + by move: tNdd; rewrite in_itv/= => /andP[]. + have -> : x x0 - y x0 = (x - y : V) x0. + apply (@eqmod_on_itv _ _ _ _ (leDl_delta_max phi ab u0 r k0 rho) (repr x - repr y)) => //. + by rewrite Quotient.pi_add Quotient.pi_opp !reprK. + by rewrite infty_norm0_ge// leDl_delta_max. +rewrite (@le_trans _ _ (k * `|x - y| * (t - a)))//. + rewrite -mulrA ler_wpM2l//; first exact: ltW. + rewrite Rintegral_cst// ler_pM//. + move: tNdd; rewrite in_itv/= => /andP[+ _]. + rewrite le_eqVlt => /predU1P[->|]. + by rewrite set_itv1 lebesgue_measure_set1 subrr lexx. + by rewrite /= (lebesgue_measure_itv `[a,t]%R) /= lte_fin => ->. +rewrite [leLHS]mulrAC ler_wpM2r//. +move: tNdd; rewrite in_itv/= => /andP[Ndt]. +rewrite -lerBlDl. +rewrite /delta_max !le_min => /andP[_ /andP[_]]. +by rewrite ler_pdivlMr// mulrC. +Qed. + +End is_contraction_picard. + +Definition row_vector {R : realType} (n : nat) := 'rV[R]_n. + +HB.instance Definition _ {R : realType} (n : nat) := Complete.on (@row_vector R n). +HB.instance Definition _ {R : realType} (n : nat) := NormedModule.on (@row_vector R n). +(*HB.instance Definition _ {R : realType} (n : nat) := CompleteNormedModule.on (@row_vector R n).*) + +Section integral_ode. +Local Notation mu := lebesgue_measure. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (u0 : U) (sol : R -> U) (k : R) (r : {posnum R}). +Hypothesis k0 : 0 < k. +Hypothesis ab : a < b. + +Let B := closed_ball u0 r%:num. +Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. +Hypothesis cont_sol : {within `[a, b], continuous sol}. +Hypothesis sol_bound : sol @` `[a, b] `<=` closed_ball u0 r%:num. + +Definition is_integral_sol_on := sol a = u0 /\ + forall t, `[a, b] t -> sol t = sol a + (\vint[mu]_(s in `[a, t]) phi s (sol s))%R. + +(* Definition is_integral_sol_on_open := *) +(* phi t0 = u0 /\ *) +(* forall t, `]t0, t1[ t -> *) +(* phi t = phi t0 + (\vint[mu]_(s in `[t0, t]) f s (phi s))%R. *) + +(* Lemma integral_sol_open_closed : is_integral_sol_on_open -> is_integral_sol_on. *) +(* Proof. *) +(* move => [h0 h1]. *) +(* split => //. *) +(* move => t. *) +(* case: (eqVneq t t0) => [-> _|Ht0]. *) +(* by rewrite set_itv1 rowRintegral_set1 addr0. *) +(* rewrite /=in_itv/= => /andP [ht0 ht1]. *) +(* apply h1. *) +(* by rewrite /=in_itv/=ht1//= lt_neqAle ht0/= eq_sym Ht0. *) +(* Qed. *) + +Definition is_sol_on := sol a = u0 /\ + {in `]a, b[, forall x, derivable sol x 1 /\ sol^`() x = phi x (sol x)}. + +Lemma picard_iterator_within_continuous i : + {within `[a, b], continuous (fun x => phi x (sol x) ord0 i)}. +Proof. +move: i. +apply/within_continuous_coord. +exact: (within_continuous_lipschitz _ k0 _ (u0 := u0) (r := r)). +Qed. + +Lemma picard_iterator_continuous i t : t \in `]a, b[ -> + {for t, continuous (fun x => phi x (sol x) ord0 i)}. +Proof. +rewrite inE => /within_continuous_continuous; apply => //. +exact: picard_iterator_within_continuous. +Qed. + +(* Lemma Rintegral_itv_open_closed (a b : R) (g : R -> R) : *) +(* \int[mu]_(x in `]a, b[) g x *) +(* = \int[mu]_(x in `[a, b]) g x. *) +(* Proof. *) +(* rewrite Rintegral_itv_obnd_cbnd. *) +(* rewrite Rintegral_itv_bndo_bndc //. *) +(* Admitted. *) + +Lemma picard_iterator_integrable i : mu.-integrable `[a, b] + (EFin \o (fun x : R => phi x (sol x) ord0 i)). +Proof. +apply: continuous_compact_integrable; first exact: segment_compact. +exact: picard_iterator_within_continuous. +Qed. + +Lemma integral_sol_iff_sol : is_integral_sol_on <-> is_sol_on. +Proof. +split. +- move => [hinit h]; split => // t tab. + move: (tab); rewrite inE /= in_itv /= => /andP[ta tb]. + have -> : sol^`() t = (fun x => sol a + \vint[mu]_(s in `[a, x]) phi s (sol s))^`() t. + apply/eq_on_itv_deriv/tab => x xt01; apply h. + rewrite inE in xt01. + exact: subset_itv_oo_cc. + (* move : xt01 . *) + (* Search "itv" "subs". *) + (* rewrite inE/=!in_itv/= => /andP [xt01 xt01']. *) + (* by rewrite ltW. *) + suff hi : forall i, derivable (fun x => sol x ord0 i) t 1 /\ + (fun x : R => (sol a + \vint[mu]_(s in `[a, x]) phi s (sol s))%E)^`() t ord0 i = + phi t (sol t) ord0 i. + split. + apply /derivable_mxP. + rewrite /derivable_mx => i j. + have [? _] := hi j. + by rewrite ord1. + apply/rowP => j. + by have [_ ?] := hi j. + move => j. + have [H1 H2] := @continuous_FTC1_closed _ (fun x => phi x (sol x) ord0 j) + a t b tb (picard_iterator_integrable j) ta (picard_iterator_continuous tab). + have Hderivable : derivable (fun x : R => \vint[mu]_(x0 in `[a, x]) phi x0 (sol x0)) t 1. + apply/(@derivable_mxP R R) => i0 i; rewrite (ord1 i0){i0}/=. + have [?] := @continuous_FTC1_closed _ (fun x => phi x (sol x) ord0 i) + a t b tb (picard_iterator_integrable i) ta (picard_iterator_continuous tab). + rewrite /rowRintegral. + rewrite [X in derivable X t 1](_ : _ = + (fun x => \int[mu]_(y in `[a, x]) phi y (sol y) ord0 i))//. + by apply/funext => x; rewrite mxE. + rewrite derive1E deriveD /=; last 2 first. + exact: derivable_cst. + exact: Hderivable. + split. + apply: (near_eq_derivable + (f := (fun x => (sol a + \vint[mu]_(s in `[a, x]) phi s (sol s)) ord0 j))) => //=. + near=> t'. + rewrite (h t') //= in_itv/=. + apply/andP; split. + - by apply: ltW; near: t'; exact: lt_nbhsr. + - by apply: ltW; near: t'; exact: lt_nbhsl. + have -> : (fun x => (sol a + \vint[mu]_(s in `[a, x]) phi s (sol s))%E ord0 j) = + cst (sol a ord0 j) + + (fun x => (\vint[mu]_(s in `[a, x]) (phi s (sol s))) ord0 j). + by apply funext => x; rewrite mxE. + apply: derivableD. + exact: derivable_cst. + by move/derivable_mxP : Hderivable; exact. + rewrite -!derive1E derive1_cst add0r -H2 !derive1E derive_mx//= mxE/=. + congr ('D_1 _ t). + by apply/funext => t'; rewrite mxE. +move => [hinit h]; split => // t tab. +have /= := tab; rewrite in_itv/= => /andP[ta tb]. +apply/rowP => i. +rewrite mxE rowRintegralE. +move: ta; rewrite le_eqVlt => /predU1P[<-|ta]. + by rewrite set_itv1 Rintegral_set1 addr0. +rewrite /Rintegral. +have cont_soli : {within `[a, b], continuous (fun x => sol x ord0 i)}. + by move: i; exact/within_continuous_coord. +rewrite (@continuous_FTC2 _ (fun x => phi x (sol x) ord0 i) (fun x => sol x ord0 i) _ _ ta). +- by rewrite -EFinB subrKC. +- apply: continuous_subspaceW; last exact: picard_iterator_within_continuous. + exact: subset_itvl. +- split. + + move=> t' tx'. + by have /h[/derivable_mxP] : t' \in `]a, b[ by rewrite inE; exact/subset_itvl/tx'. + + by move /(continuous_within_itvP _ ab) : cont_soli => [_ + _]. + + have cont_phii' : {within `[a, t], continuous fun x0 : R => sol x0 ord0 i}. + apply: continuous_subspaceW; last exact: cont_soli. + exact: subset_itvl. + by move/(continuous_within_itvP _ ta) : cont_phii' => [_ _ +]. +- move=> x xt. + have /h[? +] : x \in `]a, b[ by rewrite inE; exact/subset_itvl/xt. + by rewrite !derive1E derive_mx//= => <-; rewrite mxE. +Unshelve. all: by end_near. Qed. + +End integral_ode. + +Section picard. +Local Notation mu := lebesgue_measure. +Context {R : realType} {n : nat}. +Notation U := (@row_vector R n). +Variables (f : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}). +Hypothesis ab : a < b. +Hypothesis k0 : 0 < k. +Let B := closed_ball u0 r%:num. +Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (f x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous f ^~ y}}. +Variable rho : {posnum R}. +Hypothesis rho1 : rho%:num < 1. + +Import Cont_on_seg_quot. + +Check U : completeType. +Check U : completePseudoMetricType R. +Check U : normedModType R. +Check U : completeNormedModType R. + +Notation V := (@quot_continuousFunType R U _ _ (leDl_delta_max f ab u0 r k0 rho)). + +Check V : completeNormedModType _. + +Local Notation img_cball := (@img_cball R n f a b k ab u0 r k0 rho). + +Local Notation img_cball_nonempty := (img_cball_nonempty f ab u0 r k0 rho). +Local Notation closed_img_cball := (@closed_img_cball R n f a b k ab u0 r k0 rho). + +Definition picard_fix : V := + sval (cid2 (@banach_fixed_point R V img_cball + (@picard R n f a b k ab u0 r k0 lip2 cont1 rho) + (@is_contraction_picard _ n f a b ab k k0 u0 r lip2 cont1 rho rho1) + closed_img_cball + img_cball_nonempty)). + +Let picard_fixE : + picard_fix = (@picard _ n f a b k ab u0 r k0 lip2 cont1 rho) picard_fix. +Proof. by rewrite {}/picard_fix; case: cid2. Qed. + +Lemma img_cball_picard_fix : img_cball picard_fix. +Proof. +by apply (svalP (cid2 (@banach_fixed_point R V img_cball _ + (@is_contraction_picard R n f _ _ ab k k0 u0 r lip2 cont1 _ rho1) + closed_img_cball img_cball_nonempty))). +Qed. + +Lemma picard_fix_init : picard_fix a = u0. +Proof. +rewrite picard_fixE eval_mod_on_itv. + by rewrite /picard_fun /= picard_fun_init//; exact: img_cball_picard_fix. +by rewrite inE/= in_itv/= lexx leDl_delta_max. +Qed. + +Local Notation delta_max := (delta_max f a b k u0 r rho). + +Lemma picardE g t : img_cball g -> t \in `[a, a + delta_max] -> + (@picard _ n f a b k ab u0 r k0 lip2 cont1 rho) g t = + u0 + \vint[mu]_(x in `[a, t]) f x (g x). +Proof. +by move=> Hg taad; rewrite eval_mod_on_itv//; exact: picard_funE. +Qed. + +Lemma cauchy_lipschitz_integral_version : + is_integral_sol_on f a (a + delta_max) u0 picard_fix. +Proof. +split; first exact: picard_fix_init. +move=> t tad. +rewrite {1}picard_fixE eval_mod_on_itv; last by rewrite inE. +rewrite picard_fix_init. +exact: picard_funE img_cball_picard_fix. +Qed. + +Theorem cauchy_lipschitz_unique (picard_fix' : V) : img_cball picard_fix' -> + (forall t, t \in `[a, a + delta_max] -> + picard_fix' t = u0 + \vint[mu]_(x in `[a, t]) f x (picard_fix' x)) -> + picard_fix = picard_fix'. +Proof. +move=> imgpicard_fix'_cball h. +apply: (contraction_fixpoint_unique + (@is_contraction_picard R n f a b ab k k0 u0 r lip2 cont1 rho rho1) + img_cball_picard_fix imgpicard_fix'_cball) => //=. +rewrite -(reprK picard_fix'). +apply/eqquotP. +rewrite /Quotient.equiv/=. +rewrite inE /submod_itv. +apply/funext => x. +rewrite /patch;case: ifPn => [xK | xKnot] => //. +rewrite /quot_continuousFunType_to_fun /=. +rewrite !fctE. +rewrite !reprK. +rewrite picard_funE//=. +have -> : repr picard_fix' x = picard_fix' x by []. +by rewrite h// subrr. +Qed. + +Theorem cauchy_lipschitz_existence : picard_fix a = u0 /\ + {in `]a, a + delta_max[, forall x, picard_fix^`() x = f x (picard_fix x)}. +Proof. +split; first exact: picard_fix_init. +move => t tad. +rewrite {1}picard_fixE. +apply/rowP => j. +suff -> : (picard lip2 cont1 picard_fix)^`() t = + (fun x0 => u0 + \vint[mu]_(x in `[a, x0]) f x (picard_fix x))^`() t. + move: (tad); rewrite inE /= in_itv /= => /andP[ta tadelta]. + have Fint i : mu.-integrable `[a, a + delta_max] + (EFin \o (fun x => f x (picard_fix x) ord0 i)). + apply: integrable_comp => //. + by rewrite in_itv /= lexx andbT leDl_delta_max. + exact: img_cball_picard_fix. + have Fcont i : {for t, continuous (fun x => f x (picard_fix x) ord0 i)}. + move: tad; rewrite inE. + apply/within_continuous_continuous => //=. + exact: ltDl_delta_max. + clear Fint. + move: i; apply/within_continuous_coord. + apply: (within_continuous_lipschitz _ k0 _ (u0 := u0) (r := r)). + + exact: cts_fun. + + exact: lip2_delta_max. + + exact: cont1_delta_max. + + exact: img_cball_picard_fix. + have [H1 H2] := @continuous_FTC1_closed _ (fun x => f x (picard_fix x) ord0 j) + a t _ tadelta (Fint j) ta (Fcont j). + have Hderivable : derivable (fun x => \vint[mu]_(y in `[a, x]) f y (picard_fix y)) t 1. + apply/derivable_mxP => i0 i; rewrite (ord1 i0){i0}/=. + have [?] := @continuous_FTC1_closed _ (fun x => f x (picard_fix x) ord0 i) + a t _ tadelta (Fint i) ta (Fcont i). + rewrite /rowRintegral. + rewrite [X in derivable X t 1](_ : _ = + (fun x => \int[mu]_(y in `[a, x]) f y (picard_fix y) ord0 i))//. + by apply/funext => x; rewrite mxE. + rewrite derive1E deriveD /=; last 2 first. + exact: derivable_cst. + exact: Hderivable. + rewrite -!derive1E derive1_cst add0r -H2 !derive1E derive_mx// mxE/=. + congr ('D_1 _ t). + by apply/funext => t0; rewrite mxE. +rewrite /picard /picard_fun. +move: t tad. +apply: eq_on_itv_deriv => t tad /=. +rewrite -(@picard_funE _ _ _ a b k _ r lip2 cont1 rho)//=. + rewrite eval_mod_on_itv// inE; apply: subset_itv_oo_cc. + by rewrite inE in tad. +exact: img_cball_picard_fix. +Qed. + +Lemma cauchy_lipschitz_in_cball (t : R) : `[a, a + delta_max] t -> + closed_ball u0 r%:num (picard_fix t). +Proof. by move=> taad; apply: img_cball_picard_fix => /=; exists t. Qed. + +End picard. + +Section picard_extension. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b c : R) (u0 : U) (sol1 : R -> U) (sol2 : R -> U). +Hypothesis ab : a < b. +Hypothesis bc : b < c. +Hypothesis cont1 : {within `[a, b], continuous (fun x => phi x (sol1 x))}. +Hypothesis cont2 : {within `[b, c], continuous (fun x => phi x (sol2 x))}. +Hypothesis matchb : sol1 b = sol2 b. + +Lemma solution_extends : is_integral_sol_on phi a b u0 sol1 -> + is_integral_sol_on phi b c (sol1 b) sol2 -> + is_integral_sol_on phi a c u0 (patch sol2 `[a, b] sol1). +Proof. +move => [p0a p0s ] [p1a p1s]. +have h0 : patch sol2 `[a, b] sol1 a = u0. + rewrite /patch. + case: ifPn => [xK | xKnot] => //. + move /negP : xKnot. + by rewrite inE/=in_itv/=lexx ltW. +split => //. +rewrite h0. +move => t tac. +rewrite /patch. +case: ifPn => [xK | xKnot] => /=. + rewrite inE in xK. + rewrite p0s // p0a. + apply /rowP => i. + rewrite !mxE. + congr (_ + _)%E. + apply eq_Rintegral => /= x xat. + suff ->: (x \in `[a,b]) by []. + move : xat xK. + rewrite !inE /= !in_itv /= => /andP [xat1 xat2] /andP [tab1 tab2]. + apply /andP; split => //. + exact/le_trans/tab2. +have tbc : t \in `[b, c]. + move : tac. + move /negP : xKnot. + rewrite !inE /= !in_itv /=. + have /orP := le_total b t. + case => // -> h1 /andP [h2 ->] //. + by move : h1;rewrite h2. +rewrite (rowRintegral_itv_split (c := b) (F := (fun x => phi x (patch sol2 `[a, b] sol1 x)))). +- rewrite inE in tbc. + rewrite p1s //. + suff : sol2 b = u0 + \vint[lebesgue_measure]_(s in `[a, b]) phi s (patch sol2 `[a, b] sol1 s). + rewrite /GRing.add /= addmxA => ->;congr (addmx _). + apply eq_rowRintegral => /= x xbt. + rewrite /patch;case: ifPn => [ | ] => //. + rewrite inE/=in_itv/= => /andP [_ xleb]. + move : xbt. + rewrite !inE/=!in_itv/= => /andP [h _]. + suff -> : x = b by rewrite p1a. + apply le_anti. + by rewrite xleb. + rewrite p1a p0s;last by rewrite /=in_itv/=ltW//=. + rewrite p0a. + congr (_ + _)%E. + rewrite /patch. + by apply eq_rowRintegral => /= x ->. +- by rewrite ltW //=; move : tbc; rewrite inE /= in_itv /= => /andP [-> _]. +- move=> i. + have cont' : {within `[a, t], continuous (fun x => phi x (patch sol2 `[a, b] sol1 x) ord0 i)}. + have -> : `[a, t] = `[a, b] `|` `[b, t]. + rewrite (@itv_bndbnd_setU _ _ _ (BRight b))// ?bnd_simp//=; last 2 first. + exact: ltW. + by move: tbc; rewrite inE/= in_itv/= => /andP[]. + apply/seteqP; split => x. + move=> []; [by left|right]. + exact: subset_itv_oc_cc b0. + move=> []; [by left|]. + rewrite -setU1itv ?bnd_simp//; last first. + by move: tbc; rewrite inE/= in_itv/= => /andP[]. + case; [|by right]. + move=> ->; left => /=. + by rewrite in_itv/= (ltW ab) lexx. + apply: (withinU_continuous (@itv_closed _ _ a b) (@itv_closed _ _ b t)). + move : i. + apply /within_continuous_coord. + have eq1 : {in `[a, b], (fun x0 => phi x0 (sol1 x0)) =1 + (fun x0 => phi x0 (patch sol2 `[a, b] sol1 x0))}. + move => x0 x0ab. + by rewrite /patch x0ab. + apply: (continuous_within_ext eq1). + exact: cont1. + move : i. + apply /within_continuous_coord. + have eq2 : {in `[b, c], (fun x0 => phi x0 (sol2 x0)) =1 + (fun x0 => phi x0 (patch sol2 `[a,b] sol1 x0))}. + move => x0 x0ab. + rewrite /patch;case: ifPn => [xab | xabnot] => //. + suff -> : x0 = b by rewrite matchb. + apply: le_anti. + move: x0ab xab. + by rewrite !inE/=!in_itv/= => /andP [-> _] /andP [_ ->]. + apply /continuous_subspaceW/(continuous_within_ext eq2)/cont2. + apply: subset_itvl; rewrite bnd_simp. + by move : tbc; rewrite inE/= in_itv/= => /andP[]. + apply: continuous_compact_integrable => //. + exact: segment_compact. +Qed. + +End picard_extension. + +Section cauchy_lipschitz_local. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}). +Hypothesis ab : a < b. +Hypothesis k0 : 0 < k. +Let B := closed_ball u0 r%:num. +Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. + +Let rho : {posnum R} := (2^-1)%:pos. + +Let rho1 : rho%:num < 1. +Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. + +Definition local_solution := repr (picard_fix ab k0 lip2 cont1 rho1). + +Local Notation delta_max := (delta_max phi a b k u0 r rho). + +Lemma solution_local_solution : is_sol_on phi a (a + delta_max) u0 local_solution. +Proof. +apply /(integral_sol_iff_sol (k:=k) (r:=r)) => //. +- exact: ltDl_delta_max. +- move=> t td. + apply: lip2. + move: td; rewrite /=!in_itv/= => /andP [-> h] /=. + by rewrite (le_trans h)// -lerBrDl; exact: delta_max_itv. +- move=> /= x xB . + apply/continuous_subspaceW/cont1 => //. + apply: subset_itvl => //=. + by rewrite bnd_simp -lerBrDl delta_max_itv. +- rewrite /local_solution. + exact: cts_fun. +- by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. +- exact: cauchy_lipschitz_integral_version. +Qed. + +Lemma solution_stays_in_ball : + {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (local_solution t)}. +Proof. by move=> t; rewrite inE => /cauchy_lipschitz_in_cball; exact. Qed. + +Lemma solution_continuous : + {within `[a, a + delta_max], continuous local_solution}. +Proof. exact: cts_fun. Qed. + +Definition cauchy_lipschitz_local_f : continuousFunType `[a, a + delta_max] [set: 'rV[R]_n] := + repr (picard_fix ab k0 lip2 cont1 rho1). + +Let f := cauchy_lipschitz_local_f. + +Theorem cauchy_lipschitz_local : + delta_max > 0 /\ + is_sol_on phi a (a + delta_max) u0 f /\ + {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f t)} /\ + {within `[a, a + delta_max], continuous f}. +Proof. +split; first exact: delta_max_gt0. +split; [| split]. +- exact: solution_local_solution. +- exact: solution_stays_in_ball. +- exact: solution_continuous. +Qed. + +End cauchy_lipschitz_local. + +Section solution_unique. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}) (f f' : R -> U). +Hypothesis ab : a < b. +Hypothesis k0 : 0 < k. +Let B := closed_ball u0 r%:num. +Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. +Hypothesis cf : {within `[a, b], continuous f}. +Hypothesis cf' : {within `[a, b], continuous f'}. + +Lemma solution_unique : is_sol_on phi a b u0 f -> is_sol_on phi a b u0 f' -> + {in `[a, b], f =1 f'}. +Proof. +rewrite -!(integral_sol_iff_sol (r := r) (k:=k)) => //. +move => h1 h2 t tab. +(*have /= := cauchy_lipschitz_unique lip2 cont1 rho1.*) +Abort. + +End solution_unique. + +Section picard_autonomous. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : U -> U) (k : R) (u0 : U) (r : {posnum R}). +Hypothesis k0 : 0 < k. +Let B := closed_ball u0 r%:num. +Hypothesis lip2 : k.-lipschitz_B phi. + +Definition is_sol_autonomous a b (f : R -> U) := f a = u0 /\ + {in `]a, b[, forall x, derivable f x 1 /\ f^`() x = phi (f x)}. +Definition phi_ (t : R) x := phi x. + +Lemma phi_lip2 a b: {in `[a, b]%R, forall x, k.-lipschitz_B (phi_ x)}. +Proof. by move => x abx; exact: lip2. Qed. + +Lemma phi_cont1 a b : {in B, forall y, {within `[a, b], continuous phi_ ^~ y}}. +Proof. by move => /= x Bx; exact: cst_continuous_subspace. Qed. + +Lemma autonomous_solution a b f : + is_sol_autonomous a b f <-> is_sol_on phi_ a b u0 f. +Proof. by []. Qed. + +Let rho : {posnum R} := (2^-1)%:pos. + +Theorem cauchy_lipschitz_autonomous a : exists f delta, + delta > 0 /\ is_sol_autonomous a (a + delta) f /\ + {in `[a, a + delta], forall t, closed_ball u0 r%:num (f t)} /\ + {within `[a, a + delta], continuous f}. +Proof. +have aa1 : a < a + 1 by rewrite ltrDl. +have [d0 [solf [cball cf]]] := + cauchy_lipschitz_local aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)). +exists (@cauchy_lipschitz_local_f R n phi_ a _ k u0 r aa1 k0 + (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1))). +by exists (delta_max phi_ a (a + 1) k u0 r rho). +Qed. + +End picard_autonomous. + +Section locally_lipschitz. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables phi : U -> U. + +Hypothesis locally_lipschitz : forall x, + exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. + +Theorem cauchy_lipschitz_ll u0 a : exists f delta r, + delta > 0 /\ is_sol_autonomous phi u0 a (a + delta) f /\ + {in `[a, a + delta], forall t, closed_ball u0 r (f t)}. +Proof. +have [/= r [k lip]] := locally_lipschitz u0. +have [//|f [delta [delta_ft0 [solf [cball cf]]]]] := cauchy_lipschitz_autonomous _ lip a. +by exists f, delta, r%:num. +Qed. + +End locally_lipschitz. From 87d5b609b15033ac1d0968d8cf0d2d878b0da3a9 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 3 Feb 2026 18:32:20 +0900 Subject: [PATCH 085/144] rm continuous_on --- lasalle.v | 37 ++++++++++--------------------------- pendulum.v | 4 ++-- 2 files changed, 12 insertions(+), 29 deletions(-) diff --git a/lasalle.v b/lasalle.v index f1835de2..ac10caae 100644 --- a/lasalle.v +++ b/lasalle.v @@ -144,23 +144,20 @@ Lemma sub_plim_clos_invar (y : R -> U) (A : set U) : y @` (>= 0)%R `<=` A -> cluster (y @ +oo%R) `<=` closure A. Proof. by move=> syRpA p ypp B /ypp; apply; exact: sub_image_at_infty. Qed. -(* to mathcomp/analysis ? *) -Definition continuous_on (T U : topologicalType) (A : set T) (f : T -> U) := - forall p : T, A p -> f @ (within A (nbhs p)) --> f p. - Lemma map_sub_cluster (S T : topologicalType) (F : set_system S) (f : S -> T) - (A : set S) : Filter F -> continuous_on A f -> F A -> closed A -> + (A : set S) : Filter F -> {within A, continuous f} -> F A -> closed A -> f @` (cluster F) `<=` cluster (f @ F). Proof. move=> Ffilt fcont FA Acl _ [p clFp <-] B C fFB. have Ap : A p by apply: Acl => ? /clFp - /(_ _ FA). +move/subspace_continuousP in fcont. move=> /(fcont _ Ap) fp_C. suff /clFp /(_ fp_C) [q [[Aq ?] /(_ Aq)]] : F (A `&` f @^-1` B) by exists (f q). exact: filterI. Qed. Lemma c0_cvg_cst_on_plim A (y : R -> U) (V : U -> R^o) (l : R^o) : - continuous_on A V -> V \o y @ +oo%R --> l -> + {within A, continuous V} -> V \o y @ +oo%R --> l -> closed A -> y @` (>= 0)%R `<=` A -> cluster (y @ +oo%R) `<=` V @^-1` [set l]. Proof. move=> Vcont Vypl Acl syRpA p plimp. @@ -195,23 +192,6 @@ rewrite lerBrDr addrC -lerBrDr; apply: ybndN; last by exists t. by rewrite ltrBrDr; near: M; exists (N + N)%R; rewrite realD. Unshelve. all: by end_near. Qed. -Lemma continuous_on_compact (S T : topologicalType) (f : S -> T) (A : set S) : - continuous_on A f -> compact A -> compact (f @` A). -Proof. -move=> fcont Aco F FF FfA; set G := filter_from F (fun C => A `&` f @^-1` C). -have GF : ProperFilter G. - apply: (filter_from_proper (filter_from_filter _ _)); first by exists (f @` A). - move=> C1 C2 F1 F2; exists (C1 `&` C2); first exact: filterI. - by move=> ?[?[]]; split; split. - by move=> C /(filterI FfA) /filter_ex [_ [[p ? <-]]]; eexists p. -move: Aco => /(_ G GF)[]. - by exists (f @` A) => // ? []. -move=> p [Ap clsGp]; exists (f p); split; first exact/imageP. -move=> B C FB /(fcont _ Ap) /= p_Cf. -have : G (A `&` f @^-1` B) by exists B. -by move=> /clsGp /(_ p_Cf) [q [[Aq ?] /(_ Aq)]]; exists (f q). -Qed. - (* TODO: PR to mathcomp-analysis? *) Lemma nearN (R : realFieldType) (P : set R) : (\forall x \near (0%R : R^o), P x) = (\forall x \near (0%R : R^o), P (- x)%R). @@ -246,7 +226,7 @@ Hypothesis Kco : compact K. Variable sol : U -> R -> U. Hypothesis (sol0 : forall p, sol p 0 = p). Hypothesis solP : forall y : R -> U, K (y 0%R) -> is_sol y <-> y = sol (y 0%R). -Hypothesis sol_cont : forall t, continuous_on K (sol^~ t). +Hypothesis sol_cont : forall t, {within K, continuous (sol^~ t)}. Lemma sol_is_sol p : K p -> is_sol (sol p). Proof. by move=> Kp; apply/solP; rewrite sol0. Qed. @@ -373,7 +353,10 @@ have Kq : K q. move: plim_q; apply => //. exists 0%R; split => // t /ltW tge0. exact: Kinvar. -move=> /(sol_cont Kq) /plim_q q_Bsolt0. +have sol_cont' : forall t : R, + (forall x : U, K x -> (sol^~ t) x @[x --> within K (nbhs x)] --> (sol^~ t) x). + by move=> t; exact/subspace_continuousP/sol_cont. +move=> /(sol_cont' t0 _ Kq) /plim_q q_Bsolt0. have /q_Bsolt0 [_ [[[t tgtM <-] _]]] : (sol p @ +oo%R) (sol p @` (> M)%R `&` A). by exists M; split => // => t tgtM; split; [apply: imageP|apply: solpMinfty_A]. have tge0 : (0 <= t)%R by apply/ltW; apply: le_lt_trans tgtM. @@ -417,7 +400,7 @@ Qed. (* todo: use directional derivative *) Lemma stable_limS (V : U -> R^o) : - continuous_on K V -> + {within K, continuous V} -> (forall p t, K p -> (0 <= t)%R -> derivable (V \o sol p : R^o -> R^o) t 1) -> (forall (p : U), K p -> derive1 (V \o sol p) 0 <= 0)%R -> limS K `<=` [set p | derive1 (V \o sol p) 0 = 0]%R. @@ -441,7 +424,7 @@ suff cvVsol : cvg (V \o sol q @ +oo%R). exists (lim (V \o sol q @ +oo%R)); apply: (c0_cvg_cst_on_plim Vcont) => //. exact: compact_closed. apply: nincr_lb_cvg; last first. - have: compact (V @` K) by apply: continuous_on_compact. + have: compact (V @` K) by exact: continuous_compact. move=> /compact_bounded [N imVltN]. exists (- (N + 2))%R=> _ [t tge0 <-]. suff : (`|(V \o sol q) t| < N + 2)%R by rewrite ltr_norml => /andP[]. diff --git a/pendulum.v b/pendulum.v index 9ac0ff67..9974b933 100644 --- a/pendulum.v +++ b/pendulum.v @@ -401,7 +401,7 @@ Qed. Variable sol : U -> R -> U. Hypothesis (sol0 : forall p, sol p 0 = p). Hypothesis solP : forall y, K (y 0) -> is_sol Fpendulum y <-> y = sol (y 0). -Hypothesis sol_cont : forall t, continuous_on K (sol^~ t). +Hypothesis sol_cont : forall t, {within K, continuous (sol^~ t)}. Lemma circ_invar p : K p -> forall t, 0 <= t -> (sol p t)..[2] ^+ 2 + (sol p t)..[3] ^+ 2 = 1. @@ -632,7 +632,7 @@ have -> : derive1 (V \o sol p : _ -> R^o) t = rewrite -(solD sol0 solP Kinvar) //. by rewrite add0r. apply: (stable_limS K_compact sol0 solP sol_cont Kinvar (V:=V)) limSKsolp. -- move=> q Kq; have /(_ q) := V_continuous; apply: cvg_trans. +- apply/subspace_continuousP => q Kq; have /(_ q) := V_continuous; apply: cvg_trans. exact: cvg_app (@cvg_within _ _ _ _). - by move=> q s Kq sge0; have := is_derive_Vsol Kq sge0. - move=> q Kq; have dVsolq := is_derive_Vsol Kq (lexx _). From f536715fbed6e3a58afee6482986a8a690db0179 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 7 Feb 2026 13:34:07 +0900 Subject: [PATCH 086/144] global versions (wip) --- _CoqProject | 1 + ode.v | 17 +- ode_wip.v | 573 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 581 insertions(+), 10 deletions(-) create mode 100644 ode_wip.v diff --git a/_CoqProject b/_CoqProject index 6cd7f8fc..a58a402c 100644 --- a/_CoqProject +++ b/_CoqProject @@ -26,6 +26,7 @@ tilt_mathcomp.v tilt_analysis.v tilt_robot.v tilt.v +ode_wip.v -R . robot diff --git a/ode.v b/ode.v index 00baf8d3..fbe033d1 100644 --- a/ode.v +++ b/ode.v @@ -540,7 +540,7 @@ Variables (phi : R -> U -> U). Variables (u0 : U). Lemma sup_phiS a b c d : {within `[a, b], continuous (phi ^~ u0)} -> - a < b -> `[c, d] `<=` `[a, b] -> + a <= b -> `[c, d] `<=` `[a, b] -> sup_phi phi c d u0 <= sup_phi phi a b u0. Proof. move=> cf ab cdab. @@ -559,11 +559,10 @@ have [cd|dc] := leP c d. - split. exists `|phi a u0| => //=. exists a => //. - by rewrite in_itv/= lexx (ltW ab). + by rewrite in_itv/= lexx ab. have : {within `[a, b], continuous fun t : R => `|phi t u0|}. - apply: within_continuous_comp_norm => //. - exact/ltW. - move/(@EVT_max R (fun t => `|phi t u0|) _ _ (ltW ab)) => [e eab Hmax]. + by apply: within_continuous_comp_norm => //. + move/(@EVT_max R (fun t => `|phi t u0|) _ _ ab) => [e eab Hmax]. exists (`|phi e u0|) => x/= [r rab <-//]. exact: Hmax. rewrite set_itv_ge ?bnd_simp/= -?ltNge// image_set0 sup0. @@ -1702,12 +1701,10 @@ apply /(integral_sol_iff_sol (k:=k) (r:=r)) => //. - exact: ltDl_delta_max. - move=> t td. apply: lip2. - move: td; rewrite /=!in_itv/= => /andP [-> h] /=. - by rewrite (le_trans h)// -lerBrDl; exact: delta_max_itv. -- move=> /= x xB . + by apply: subset_itvl td; rewrite bnd_simp -lerBrDl delta_max_itv. +- move=> /= x xB. apply/continuous_subspaceW/cont1 => //. - apply: subset_itvl => //=. - by rewrite bnd_simp -lerBrDl delta_max_itv. + by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl delta_max_itv. - rewrite /local_solution. exact: cts_fun. - by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. diff --git a/ode_wip.v b/ode_wip.v new file mode 100644 index 00000000..739758db --- /dev/null +++ b/ode_wip.v @@ -0,0 +1,573 @@ +(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) +From HB Require Import structures. +From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. +From mathcomp Require Import archimedean generic_quotient ring_quotient. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import constructive_ereal. +From mathcomp Require Import functions reals interval_inference topology. +From mathcomp Require Import prodnormedzmodule tvs normedtype landau. +From mathcomp Require Import ereal sequences derive numfun measure realfun. +From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. +Require Import common contfun ode. + +(**md**************************************************************************) +(* # ODE wip *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. + +Open Scope ring_scope. +Open Scope classical_set_scope. + +(* global Lipschitz condition -> the solution is always in a set where phi is Lipschitz *) +Section cauchy_lipschitzT. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}) (rho : {posnum R}). +Hypothesis rho1 : rho%:num < 1. +Hypothesis ab : a < b. +Hypothesis k0 : 0 < k. +(* lip2 and cont1 hold for any vector *) +Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_[set: 'rV_n] (phi x)}. +Hypothesis cont1 : {in [set: 'rV_n], forall y, {within `[a, b], continuous phi ^~ y}}. + +Let B := closed_ball u0 r%:num. + +Let lip2' : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. +Proof. +move=> t tab /= [x y] [/= Bx By]. +have : ([set: 'rV_n] `*` [set: 'rV_n]) (x, y) by rewrite setXTT. +by move=> /(lip2 tab); exact. +Qed. + +Let cont1' : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. +Proof. by move=> t tab /=; apply: cont1; rewrite in_setT. Qed. + +Local Notation delta_max := (delta_max phi a b k u0 r rho). + +Definition lipschitzT_solution_f : continuousFunType `[a, a + delta_max] [set: 'rV[R]_n] := + repr (picard_fix ab k0 lip2' cont1' rho1). + +Lemma lipschitzT_solution : + is_sol_on phi a (a + delta_max) u0 lipschitzT_solution_f. +Proof. +apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. +- exact: ltDl_delta_max. +- move=> t td. + apply: lip2'. + by apply: subset_itvl td; rewrite bnd_simp -lerBrDl delta_max_itv. +- move=> /= x xB. + apply/continuous_subspaceW/cont1 => //. + by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl delta_max_itv. + by rewrite inE. +- rewrite /local_solution. + exact: cts_fun. +- by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. +- exact: cauchy_lipschitz_integral_version. +Qed. + +Lemma lipschitzT_solution_stays_in_ball : + {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (lipschitzT_solution_f t)}. +Proof. by move=> t; rewrite inE => /cauchy_lipschitz_in_cball; exact. Qed. + +Lemma lipschitzT_solution_continuous : + {within `[a, a + delta_max], continuous lipschitzT_solution_f}. +Proof. exact: cts_fun. Qed. + +Let f := lipschitzT_solution_f. + +Theorem lipschitzT_cauchy_lipschitz_local : + delta_max > 0 /\ + is_sol_on phi a (a + delta_max) u0 f /\ + {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f t)} /\ + {within `[a, a + delta_max], continuous f}. +Proof. +split; first exact: delta_max_gt0. +split; [| split]. +- exact: lipschitzT_solution. +- exact: lipschitzT_solution_stays_in_ball. +- exact: lipschitzT_solution_continuous. +Qed. + +End cauchy_lipschitzT. + +Section itv_partition_lemmas. +Context {R : realType}. +Variables a b : R. +Hypothesis ab : a < b. + +Lemma itv_partition_ex s x : itv_partition a b s -> + a <= x <= b -> + let I i := `[nth b (a :: s) i, nth b (a :: s) i.+1]%R in + exists2 i, (i < size s)%N & x \in I i. +Proof. +elim: s a b ab x => [a0 b0 a0b0 x|s0 s1 ih a0 b0 a0b0 x abs]. + move/itv_partition_nil => a0E. + by rewrite a0E ltxx in a0b0. +move=> /andP[a0x xb0]. +have [s0s1 /= /eqP s0s1b0] := itv_partition_cons abs. +rewrite -s0s1b0. +destruct s1 as [|s2 s3]. + exists O => //. + rewrite in_itv/= a0x/=. + case: abs => /=. + by rewrite andbT => a0s0 /eqP ->. +have s0b0 : s0 < b0. + have [] := itv_partition_cons abs. + move/order_path_min => /(_ lt_trans)/allP + /eqP <-. + apply. + by rewrite /= mem_last. +have [xs0|s0x] := ltP x s0. + exists 0 => //=. + by rewrite in_itv/= a0x (ltW xs0). +have := ih s0 b0 s0b0 x (itv_partition_cons abs). +rewrite s0x xb0 => /(_ isT)[i is3 Hx]. +exists i.+1 => //=. +suff : b0 = last s2 s3 by move=> <-. +have := itv_partition_cons abs. +by case => _ /= /eqP. +Qed. + +Lemma itv_partition_lt (delta : R) : 0 < delta -> + exists (delta' : R) s, + 0 < delta' < delta /\ + itv_partition a b s /\ + forall i, (i < size s)%N -> nth b (a :: s) i.+1 - nth b (a :: s) i < delta. +Proof. +move=> delta0. +pose delta' := delta / 2. +have delta'delta : delta' < delta. + by rewrite gtr_pMr// invf_lt1// ltr1n. +have delta'0 : 0 < delta' by rewrite divr_gt0. +have [Hnat_num|Hnat_num] := pselect ((b - a) / delta' \is a nat_num). + pose m := truncn ((b - a) / delta'). + have m0 : (0 < m)%N. + rewrite -(ltr_nat R). + move: Hnat_num; rewrite natrEtruncn => /eqP; rewrite -/m => ->. + by rewrite divr_gt0// subr_gt0. + have bE : a + delta' *+ m = b. + rewrite -mulr_natl. + move: Hnat_num; rewrite natrEtruncn => /eqP; rewrite -/m => ->. + by rewrite -mulrA mulVf ?mulr1 ?gt_eqF// subrKC. + pose s := (seq.map (fun k => a + delta' *+ k) (iota 1 m)). + have lasts : last b s = b. + rewrite /s -bE (@last_map _ _ (fun k => a + delta' *+ k)). + rewrite (_ : last _ _ = m)//. + rewrite {2}(_ : m = m.-1 + 1)%N//; last by rewrite addn1 prednK. + by rewrite iotaD/= cats1 last_rcons add1n prednK. + (* a + a + delta' + ... + a + m * delta' = b + size = m *) + have sm : size s = m by rewrite /s size_map size_iota. + have nth_itv_partition : + (forall i, (i <= m)%N -> nth b (a :: s) i = a + delta' *+ i). + move=> i im. + rewrite /s; destruct i as [|i] => /=. + by rewrite mulr0n addr0. + by rewrite (nth_map 0) ?size_iota// nth_iota. + exists delta', s. + split. + by apply/andP; split. + split. + split; last first. + rewrite -nth_last -lasts -nth_last; apply/eqP. + apply: set_nth_default. + by rewrite sm prednK. + apply/(pathP b) => i si. + destruct i as [|i] => /=. + by rewrite (nth_map 0) ?size_iota// nth_iota// addn0 mulr1n ltrDl. + have im : (i < m)%N by rewrite -sm (leq_trans _ si). + rewrite /s (nth_map 0) ?size_iota// nth_iota//. + rewrite (nth_map 0) ?size_iota//; last by rewrite -sm. + rewrite nth_iota; last by rewrite -sm. + by rewrite !add1n ltrD2l [in ltRHS]mulrS ltrDr. + move=> i si. + rewrite nth_itv_partition; last by rewrite -sm. + rewrite nth_itv_partition; last by rewrite -sm ltnW. + by rewrite mulrS (addrCA _ delta') addrK. +pose m := (truncn ((b - a) / delta')).+1. +pose s := rcons (seq.map (fun k => a + delta' *+ k) (iota 1 m.-1)) b. +have m0 : (0 < m)%N by []. +(* a + a + delta' + ... + a + (m - 1) * delta' + b + size = m + 1 *) +have sm1 : size s = m by rewrite /s size_rcons size_map size_iota prednK. +have nth_itv_partition : + (forall i, (i < m)%N -> nth b (a :: s) i = a + delta' *+ i). + move=> i im. + rewrite /s; destruct i as [|i] => /=. + by rewrite mulr0n addr0. + rewrite nth_rcons size_map size_iota. + case: ifPn => im1. + by rewrite (nth_map 0) ?size_iota// nth_iota. + move: im1. + by rewrite -(ltn_add2r 1) !addn1 -/m im. +have asrhok_last : nth b (a :: s) m - nth b (a :: s) m.-1 <= delta'. + rewrite {1}(_ : m = (size (a :: s)).-1)// nth_last. + rewrite {1}/s /= last_rcons. + rewrite nth_itv_partition//. + rewrite opprD addrA lerBlDl -mulrSr -/m. + rewrite -mulr_natl -ler_pdivrMr//. + by rewrite /m ltW// real_truncnS_gt// num_real. +exists delta', s. +split. + by apply/andP; split. +split. + split; last by rewrite last_rcons. + apply/(pathP b) => i si. + destruct i as [|i] => /=. + rewrite /s nth_rcons size_map size_iota. + case: ifPn => m10. + by rewrite (nth_map 0) ?size_iota// nth_iota// addn0 mulr1n ltrDl. + by rewrite if_same. + rewrite /s !nth_rcons size_map size_iota. + have im1 : (i < m.-1)%N. + by rewrite -(ltn_add2r 1) !addn1 prednK// -sm1. + rewrite im1 (nth_map 0) ?size_iota// nth_iota//. + case: ifPn => i1m1. + rewrite (nth_map 0) ?size_iota//. + by rewrite nth_iota// !add1n ltrD2l [in ltRHS]mulrS ltrDr. + rewrite if_same add1n. + have {}i1m1 : i.+1 = m.-1 by apply/eqP; rewrite eqn_leq im1 leqNgt i1m1. + rewrite i1m1. + rewrite -ltrBrDl -mulr_natl -ltr_pdivlMr//. + rewrite /m/= lt_neqAle. + apply/andP; split. + by rewrite -natrEtruncn//; exact/negP. + by rewrite truncn_le divr_ge0// ltW// subr_gt0. +move=> i. +rewrite leq_eqVlt => /predU1P[i1s|si1]. + rewrite i1s. + rewrite (_ : (size s) = (size (a :: s)).-1)//. + rewrite nth_last/= last_rcons. + rewrite nth_itv_partition//; last by rewrite -sm1 -i1s. + rewrite (le_lt_trans _ delta'delta)//. + rewrite opprD addrA lerBlDl -mulrSr -/m. + rewrite -mulr_natl -ler_pdivrMr// /m ltW// i1s sm1. + by rewrite real_truncnS_gt// num_real. +rewrite nth_itv_partition//; last by rewrite -sm1. +rewrite nth_itv_partition//; last by rewrite -sm1 (leq_trans _ si1). +by rewrite mulrS (addrCA _ delta') addrK. +Qed. + +End itv_partition_lemmas. + +(* Theorem 3.2: global existence and uniqueness *) +(* what happens when globally lipschitz? *) +Section cauchy_lipschitz_global. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U). +Hypothesis ab : a < b. +Hypothesis k0 : 0 < k. +Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_[set: 'rV[R]_n] (phi x)}. +Hypothesis cont1 : {in [set: 'rV[R]_n], forall y, {within `[a, b], continuous phi ^~ y}}. + +Theorem cauchy_lipschitz_global : exists f : R -> 'rV_n (*: continuousFunType `[a, b] [set: 'rV[R]_n]*), + is_sol_on phi a b u0 f. +Proof. +near (0:R)^'+ => rho'. +have rho'_gt0 : 0 < rho' by []. +have rho'_lt1 : rho' < 1 by []. +pose rho := PosNum rho'_gt0. +have rho1 : rho%:num < 1 by []. +have [barhok|barhok] := leP (b - a) (rho%:num / k). + have @r : {posnum R}. + admit. (* can be chosen arbitrary large because the Lipschitz condition holds globally *) + have Hr h : 0 <= h -> r%:num / (k * r%:num + h) > rho%:num / k. + move=> h0. + rewrite ltr_pdivlMr; last by rewrite ltr_wpDr// mulr_gt0. + rewrite mulrAC -ltr_pdivlMr ?invr_gt0// invrK. + rewrite mulrDr -ltrBrDl -[X in _ < X - _]mul1r (mulrC k). + rewrite -mulrBl mulrCA -ltr_pdivrMr; last by rewrite mulr_gt0// subr_gt0. + admit. (* for any finite sup_phi, we can choose r large enough so that this holds *) + have delta_maxba : delta_max phi a b k u0 r rho = b - a. + rewrite /delta_max; apply/min_idPl. + rewrite (le_trans barhok)// le_min lexx andbT -/sup_phi ltW//. + apply: Hr. + exact: sup_phi_ge0. + exists (@lipschitzT_solution_f R n phi a b k u0 r rho rho1 ab k0 lip2 cont1). + have [d0 [[fau0 H1] [H2 H3]]] := + @lipschitzT_cauchy_lipschitz_local R n phi a b k u0 r rho rho1 ab k0 lip2 cont1. + split => // t tab. + apply H1; apply/mem_set. + move/set_mem : tab. + by apply: subset_itvl; rewrite bnd_simp delta_maxba subrKC. +have @r : {posnum R}. + admit. +have Hr : rho%:num / k < r%:num / ((k * r%:num)%R + sup_phi phi a b u0)%E. + admit. +pose delta : R := delta_max phi a b k u0 r rho. +have Hdelta_max : delta = rho%:num / k. + rewrite /delta /delta_max minA; apply/min_idPr. + by rewrite le_min (ltW Hr) andbT ltW. +have delta0 : 0 < delta by rewrite /delta delta_max_gt0. +have [delta' [s [/andP[delta'0 delta'delta] [abs nthdelta']]]] : exists (delta' : R) s, + 0 < delta' < delta /\ + itv_partition a b s /\ + forall i, (i < size s)%N -> nth b (a :: s) i.+1 - nth b (a :: s) i < delta. + exact: itv_partition_lt. +have Ilt i : (i < size s)%N -> nth b (a :: s) i < nth b (a :: s) i.+1. + move=> si; case: abs => sa /eqP asb. + by move/(pathP b) : sa; apply. +pose I i := `[nth b (a :: s) i, nth b (a :: s) i.+1]%R. +have Iiab i : (i <= size s)%N -> [set` I i] `<=` `[a, b]. + move=> si x/=. + rewrite !in_itv/= => /andP[ix xi]; apply/andP. + destruct i as [|i] => //. + rewrite ix; split => //. + rewrite (le_trans xi)//. + destruct s as [|s0 s1] => //=. + case: abs => /= /andP[as0]. + move/order_path_min => /(_ lt_trans)/allP H /eqP s0s1b. + destruct s1 as [|s1 s2]. + by rewrite /= in s0s1b; rewrite s0s1b. + by apply/ltW/H; rewrite -s0s1b /= mem_last. + split. + rewrite (le_trans _ ix)// ltW//. + case: abs => /order_path_min => /(_ lt_trans)/allP + _. + apply. + by apply/(nthP b); exists i. + rewrite (le_trans xi)//. + case: abs => sa /eqP asb. + move: si; rewrite leq_eqVlt => /predU1P[->|si]. + by rewrite nth_default. + rewrite -{2} asb (last_nth b) -(@prednK (size s)); last by rewrite (leq_trans _ si). + apply: sorted_leq_nth => //. + - exact: le_trans. + - apply: path_sorted. + apply: sub_path sa. + by move=> ? ? /ltW. + - by rewrite inE prednK// (leq_trans _ si). + - by rewrite -(ltn_add2r 1) !addn1 (leq_trans si)// prednK// (leq_trans _ si). +suff: forall i, (i < size s)%N -> + exists f : R -> 'rV_n, is_sol_on phi (nth b (a :: s) i) (nth b (a :: s) i.+1) u0 f. + move=> suf. + have pickup_itv (x : R) : x \in `[a, b] -> exists2 i : nat, (i < size s)%N & x \in I i. + move=> xab; apply: itv_partition_ex => //. + by move: xab; rewrite inE/= in_itv/=. + pose pickup_itv_fun (x : R) : nat := + match pselect (x \in `[a, b]) with + | left H => sval (cid2 (pickup_itv x H)) + | right _ => 0 + end. + have lip2'' (i : nat) : (i <= size s)%N -> + {in I i, forall x : R, k.-lipschitz (phi x)}. + move=> im. + apply/in_switch/(@lipschitzW _ _ _ _ _ `[a, b]). + exact: Iiab. + apply/in_switch => t tab [X Y] [/= u0rX u0rY]. + have /(_ (X, Y)) := lip2 tab. + exact. + have cont1'' (i : nat) : (i <= size s)%N -> + {in [set: 'rV_n], forall y : 'rV_n, {within [set` I i], continuous phi^~ y}}. + move=> si /= t tu0r. + apply: (@continuous_subspaceW _ _ _ `[a, b]); last exact: cont1. + exact: Iiab. + pose F (x : R) : 'rV_n := + match pselect (x \in `[a, b]) with + | left H => let i := sval (cid2 (pickup_itv x H)) in + let im : (i < size s)%N := (svalP (cid2 (pickup_itv x H))).1 in + let xIi : x \in I i := (svalP (cid2 (pickup_itv x H))).2 in + (@lipschitzT_solution_f R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) k u0 r + rho rho1 (Ilt _ im) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im))) x + | right _ => \row_(i < n) 0 + end. + exists F; split. + rewrite /F; case: pselect; last first. + by rewrite inE/= in_itv/= lexx (ltW ab). + move=> aab. + case: cid2 => /= x xs aIx. + set K1 := Ilt _ _. + set K2 := lip2'' _ _. + set K3 := cont1'' _ _. + have [d0 [[H1 fiu0] [_ _]]] := + @lipschitzT_cauchy_lipschitz_local R n phi (nth b (a :: s) x) (nth b (a :: s) x.+1) k u0 r + rho rho1 K1 k0 (lip2'' _ (ltnW xs)) (cont1'' _ (ltnW xs)). + rewrite -[RHS]H1. + have <- : K2 = lip2'' x (ltnW xs) by apply: Prop_irrelevance. + have <- : K3 = (cont1'' x (ltnW xs)) by apply: Prop_irrelevance. + have x0 : x = 0. + admit. + by subst x. + move=> t tab. + have [i im tIi] : exists2 i : nat, (i < size s)%N & t \in I i. + apply: itv_partition_ex => //. + by move: tab; rewrite inE/= in_itv/= => /andP[] /ltW -> /ltW ->. + split. + move: tIi; rewrite /I in_itv/= => /andP[it ti]. + pose f := @lipschitzT_solution_f R n phi + (nth b (a :: s) i) (nth b (a :: s) i.+1) k u0 r rho rho1 (Ilt _ im) k0 + (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)). + suff : derivable f t 1. + admit. + have [d0 [[fau0 H1] [_ _]]] := + @lipschitzT_cauchy_lipschitz_local R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) + k u0 r rho rho1 (Ilt _ im) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)). + rewrite /= in H1. + apply H1. + rewrite inE/= in_itv/=. + apply/andP; split. + admit. + rewrite (le_lt_trans ti)//. + rewrite -[ltLHS]/(nth b (a :: s) i.+1). + have : delta_max phi (nth b (a :: s) i) (nth b s i)%E k u0 r rho = delta. + rewrite Hdelta_max. + rewrite /delta_max. + rewrite minA. + apply/min_idPr. + rewrite le_min. + apply/andP; split. + rewrite -Hdelta_max. + admit. (* pbm: rho must be defined after s!*) + rewrite (le_trans (ltW Hr))//. + rewrite ler_wpM2l//. + rewrite lef_pV2 ?posrE; last 2 first. + admit. + admit. + rewrite lerD2l. + apply: sup_phiS. + apply: cont1. + by rewrite inE. + exact: ltW. + apply: subset_itv; rewrite bnd_simp. + admit. + admit. + move=> ->. + admit. + admit. +move=> i im. +have Ilti1 : nth b (a :: s) i < nth b (a :: s) i.+1. + by apply: Ilt. +have lip2'' (j : nat) : (j <= size s)%N -> + {in I j, forall x : R, k.-lipschitz_(closed_ball u0 r%:num) (phi x)}. + admit. +have cont1'' (j : nat) : (j <= size s)%N -> + {in closed_ball u0 r%:num, forall y : 'rV_n, {within [set` I j], continuous phi^~ y}}. + admit. +exists (@cauchy_lipschitz_local_f R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) + k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im))). +have [d0 [[fau0 H1] [H2 H3]]] := + @cauchy_lipschitz_local R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) + k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)). +split => // t tab. +apply H1. +apply/mem_set. +move/set_mem : tab. +apply: subset_itvl. +rewrite bnd_simp. +rewrite -lerBlDl. +admit. +Abort. + +End cauchy_lipschitz_global. + +Section exe325. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R). +Hypothesis k0 : 0 < k. +Variable D : set U. +Hypothesis lip2 : {in `[a, b]%R, forall t : R, k.-lipschitz_D (phi t)}. +Hypothesis cont1 : {in D, forall x : U, {within `[a, b], continuous phi ^~ x}}. +Variable W : set U. +Hypothesis compactW : compact W. +Variable u0 : U. +Hypothesis u0W : u0 \in W. + +Variable f : R -> U. +Hypothesis fder : forall t, derivable f t 1 /\ 'D_1 f t = phi t (f t). +Hypothesis fini : f a = u0. + +Variable T : R. +Hypothesis xW : forall t, t \in `[a, T[%R -> t < b. + +Lemma exe325a : @unif_continuous (subspace `[a, T[) U f. +Proof. +Admitted. + +Lemma exe325b1 : forall t, t \in `[a, T[ -> f t \in W. +Proof. +Admitted. + +Lemma exe325b2 : is_sol_on phi a T u0 f. +Proof. +Admitted. + +Lemma exe325b3 : exists delta, delta > 0 /\ is_sol_on phi a (T + delta) u0 f. +Proof. +Admitted. + +End exe325. + +Section exe326. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R). +Hypothesis k0 : 0 < k. +Variable D : set U. +Hypothesis lip2 : {in `[a, b]%R, forall t : R, k.-lipschitz_D (phi t)}. +Hypothesis cont1 : {in D, forall x : U, {within `[a, b], continuous phi ^~ x}}. + +Variable T : R. +Hypothesis aTab : `[a, T[ `<=` `[a, b]. +Variable f : R -> U. +Variable u0 : U. +Hypothesis fsol : is_sol_on phi a T(*exluded*) u0 f. + +Variable W : set U. +Hypothesis compactW : compact W. +Hypothesis u0W : u0 \in W. + +Lemma exe326 : exists t, t \in `[a, T[%R /\ f t \notin W. +Proof. +Admitted. + +End exe326. + +Section cauchy_lipschitz_nonlocal. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a : R) (k : R). +Hypothesis k0 : 0 < k. +Variable D : set U. +Hypothesis lip2 : {in `[a, +oo[%R, forall t : R, k.-lipschitz_D (phi t)}. +Hypothesis cont1 : {in D, forall x : U, {within `[a, +oo[, continuous phi ^~ x}}. + +Variable W : set U. +Hypothesis compactW : compact W. +Variable u0 : U. +Hypothesis u0W : u0 \in W. +Hypothesis solW : forall f : R -> U, + (forall t, derivable f t 1 /\ 'D_1 f t = phi t (f t)) /\ f a = u0 + -> forall t, f t \in W. + +Lemma thm33 : exists !f, (forall t, t \in `[a, +oo[ -> derivable f t 1 /\ + 'D_1 f t = phi t (f t)) /\ + f a = u0. +Proof. +have @rho : {posnum R}. + admit. +(* by thm31, there is a unique local solution over `[a, a + delta[*) +have @T : R. + (* [a, T[ is the maximum interval of the solution above *) + admit. +have @y : R -> U. + (* a solution on [a, T[ *) + admit. +(* if T is finite, y must leave W -> absurd *) +(* therefore T = +oo, cqfd *) +Abort. + +End cauchy_lipschitz_nonlocal. From afd185517d6aa8d9e16a2a9bae82c3ee7ac759b2 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Tue, 3 Feb 2026 21:18:57 +0900 Subject: [PATCH 087/144] wip lasalle --- tilt.v | 248 ++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 175 insertions(+), 73 deletions(-) diff --git a/tilt.v b/tilt.v index 6fdec4a3..6e4e6b72 100644 --- a/tilt.v +++ b/tilt.v @@ -6,7 +6,7 @@ From mathcomp Require Import topology normedtype landau derive realfun. From mathcomp Require Import matrix_normedtype. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. - +Require Import lasalle. (**md**************************************************************************) (* # Tentative formalization of [1] *) @@ -2553,34 +2553,34 @@ Qed. End equilibrium_zero_stable. (* from https://github.com/drouhling/LaSalle *) -Section LaSalle. -Context {R : realType} {n : nat}. -Let U := 'rV[R]_n. -Variable phi : U -> U. -Variable sol : U -> R -> U. - -Definition limS (A : set U) := \bigcup_(q in A) cluster (sol q @ +oo). -Variable K : set U. -Hypothesis Kco : compact K. -Definition is_invariant A := state_space phi A `<=` A. -Hypothesis invarK : is_invariant K. -Hypothesis isSol : forall p, p \in K -> is_global_sol phi (sol p) setT. -Hypothesis initp: forall p, p \in K -> sol p 0 = p. - -Lemma stable_limS (V : U -> R) : - {in K, continuous V} -> - (forall p t, K p -> 0 <= t -> differentiable V (sol p t)) -> - (forall p, K p -> 'D~(sol p) V 0 <= 0) -> - limS K `<=` [set p | 'D~(sol p) V 0 = 0]. -Proof. -Admitted. - (* Lemma cvg_to_limS : *) - (* forall p, p \in K -> sol p t @[t --> +oo] --> (limS K). *) - (* Admitted. *) - Lemma cvg_to_limS : - forall p, p \in K -> cluster (sol p t @[t --> +oo]) `<=` limS K. - Admitted. -End LaSalle. +(* Section LaSalle. *) +(* Context {R : realType} {n : nat}. *) +(* Let U := 'rV[R]_n. *) +(* Variable phi : U -> U. *) +(* Variable sol : U -> R -> U. *) + +(* Definition limS (A : set U) := \bigcup_(q in A) cluster (sol q @ +oo). *) +(* Variable K : set U. *) +(* Hypothesis Kco : compact K. *) +(* (* Definition is_invariant A := state_space phi A `<=` A. *) *) +(* Hypothesis invarK : is_invariant K. *) +(* Hypothesis isSol : forall p, p \in K -> is_global_sol phi (sol p) setT. *) +(* Hypothesis initp: forall p, p \in K -> sol p 0 = p. *) + +(* (* Lemma stable_limS (V : U -> R) : *) *) +(* (* {in K, continuous V} -> *) *) +(* (* (forall p t, K p -> 0 <= t -> differentiable V (sol p t)) -> *) *) +(* (* (forall p, K p -> 'D~(sol p) V 0 <= 0) -> *) *) +(* (* limS K `<=` [set p | 'D~(sol p) V 0 = 0]. *) *) +(* (* Proof. *) *) +(* (* Admitted. *) *) +(* (* lemma cvg_to_limS : *) *) +(* (* forall p, p \in K -> sol p t @[t --> +oo] --> (limS K). *) *) +(* (* Admitted. *) *) +(* Lemma cvg_to_limS : *) +(* forall p, p \in K -> cluster (sol p t @[t --> +oo]) `<=` limS K. *) +(* Admitted. *) +(* End LaSalle. *) Section LaSalle_tilt. Context {K : realType}. @@ -2590,8 +2590,54 @@ Variables gamma alpha1 : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. Let phi := tilt_eqn alpha1 gamma. -Hypothesis isSol : forall p, p \in state_space_tilt -> is_global_sol phi (sol p) setT. -Hypothesis initp: forall p, p \in state_space_tilt -> sol p 0 = p. + +Hypothesis solP : forall y, (y 0) \in state_space_tilt -> lasalle.is_sol phi y <-> y = sol (y 0). + +Hypothesis initp: forall p, sol p 0 = p. + +Let isSol : forall p, p \in state_space_tilt -> is_global_sol phi (sol p) setT. +Proof. +move => p Kp. +have : lasalle.is_sol phi (sol p). + admit. +move => [/= H1 H2]. +split; first by rewrite inE. +move => /=t. +have [tlt | tge] := ltP t 0. +- set sol' := fun t => 2*: (sol p 0) - sol p (- t). + have H0 : {near t, sol' =1 sol p}. + admit. + split. + + apply : (near_eq_derivable _ H0) =>//. + rewrite /sol'. + apply /derivable1_diffP. + apply: differentiable_comp => //. + apply: differentiable_comp => //. + apply: differentiable_comp => //. + apply /derivable1_diffP. + have := (H2 (-t) ). + rewrite lerNr oppr0 ltW//. + move /(_ erefl). + move => {}H2. + by apply @ex_derive in H2. + + + rewrite derive1E. + have -> : 'D_1 (sol p) t = 'D_1 sol' t. + symmetry. + apply: near_eq_derive => //. + rewrite /sol'. + rewrite deriveB/=?derive_cst ?sub0r. + admit. + apply derivable_cst. + admit. +- split. + have {}H2 := H2 _ tge. + by apply @ex_derive in H2. + rewrite derive1E. + by apply H2. +Admitted. + + Definition Ksub (p : U) := [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` state_space_tilt. @@ -2612,6 +2658,7 @@ Qed. Lemma V1_bound_compact p : compact [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p]. Proof. +(* TODO: use something similar to compact_sphere *) apply: bounded_closed_compact. - rewrite /V1/=. rewrite /bounded_near. @@ -2688,30 +2735,50 @@ apply: continuousB. exact: cst_continuous. exact: continuous_rsubmx. Qed. -Lemma invariant_Ksub p : is_invariant phi (Ksub p). +Lemma invariant_Ksub p : is_invariant sol (Ksub p). Proof. -move => x [/= sol' [d [solP [t h]]]]. -rewrite /Ksub/=. +rewrite /= /is_invariant/=. +move => /= x. (* . [/= sol' [d [solP [t h]]]]*) +rewrite /Ksub/= => -[Vx Kx] t t0. split; last first. - apply/(@state_space_tiltS _ alpha1 gamma). - exists sol',d. - split;last by exists t. - apply/is_sol_subset/solP. - exact: subIsetr. -- have [sol0 solA] := solP. - have : V1 alpha1 gamma (sol' 0) <= V1 alpha1 gamma p. - by move: sol0; rewrite inE/=/Ksub/inE;move => []. - apply le_trans. - have [t0 ->] := h. - move : t0;rewrite in_itv/= => /andP[t0 td]. - apply: (V_nincr solA (V1_diff _ _)); rewrite ?t0 ?lexx //. - apply : derive_along_V1_le0=> //. - by apply/is_sol_subset/solP;exact: subIsetr. - move => /= t' t'd. + exists (sol x), (t+1) => /=. (* use large enough time *) + split. + apply global_sol_sol. + split. + rewrite initp ?inE //=. + apply isSol. + by rewrite inE. + exists t;split => //. + by rewrite /=in_itv/=t0/=ltrDl. + - have [] := (@isSol x). + by rewrite inE. + move => _ /= solA. + rewrite (le_trans _ Vx)//. + rewrite -[in leRHS](@initp x). + have : is_sol_autonomous x phi 0 (t+1) (sol x). + split. + by rewrite initp// inE. + split => //. + apply: derivable_within_continuous. + move => x0 x0t. + by apply solA. + move /(V_nincr ) => /=. + move /(_ (V1 alpha1 gamma)). + apply. + exact: V1_diff. + (* apply : (V_nincr solA (V1_diff _ _)); rewrite ?t0 ?lexx //. *) + move => t1 tt1. + apply : (@derive_along_V1_le0 _ _ _ _ _ (t+1))=> //. + apply global_sol_sol. + split => //. + rewrite inE. + by rewrite initp ?inE//. + move => t2 t20. apply /derivable1_diffP. - have [_ [solA' _]] := solA. - have td' : t' \in `]0,d[ by rewrite inE/=in_itv/=. - by move /(_ _ td') : solA' => [+ _]. + apply solA. + by rewrite ltrDl. + by rewrite lexx. Qed. Local Lemma sol_Ksub p :forall u, u \in Ksub p -> is_global_sol phi (sol u) setT. @@ -2750,7 +2817,7 @@ by rewrite vece2 /= scale0r. Qed. Local Lemma global_sol_T A sol' : is_global_sol phi sol' setT -> sol' 0 \in A -> is_global_sol phi sol' A. Proof. - move => [_ solP] initP. + move => [_ solP'] initP. split=>//. Qed. @@ -2761,26 +2828,50 @@ Local Lemma limS_subset_V1dot0 p : p \in state_space_tilt -> limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` state_space_tilt. Proof. move => ps. -have H : limS sol (Ksub p) `<=` [set x | 'D~(sol x) (V1 alpha1 gamma) 0 = 0] `&` state_space_tilt. + have H : limS sol (Ksub p) `<=` [set x | derive1 (V1 alpha1 gamma \o sol x) 0 = 0] `&` state_space_tilt. +(* have H : limS sol (Ksub p) `<=` [set x | 'D~(sol x) (V1 alpha1 gamma) 0 = 0] `&` state_space_tilt. *) rewrite subsetI;split. - apply: (@stable_limS _ _ _ _ _ _ _ (@sol_Ksub p) _ (V1 alpha1 gamma)). - exact: compact_Ksub. - exact: invariant_Ksub. - move => p0. - rewrite inE/=/Ksub/inE/=. - move => [_ K0]. - by apply initp;rewrite inE. - move => p0 p0K. - exact: (differentiable_continuous (V1_diff _ _ _ )). - move => /= p0 t K0 t0. + have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). + admit. + apply: (@stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (V1 alpha1 gamma)) => //=. + (* apply. *) + (* Search derive_along. *) + (* have /= := stable_limS (@compact_Ksub p) _ lasalle_sol _ (@invariant_Ksub p). *) + (* appl *) + (* have: (@stable_limS _ _ _ _ _ _ _ (@sol_Ksub p) _ (V1 alpha1 gamma)). *) + (* apply: (@stable_limS _ _ _ _ _ _ _ (@sol_Ksub p) _ (V1 alpha1 gamma)). *) + (* exact: compact_Ksub. *) + (* exact: invariant_Ksub. *) + (* move => p0. *) + (* rewrite inE/=/Ksub/inE/=. *) + (* move => [_ K0]. *) + (* by apply initp;rewrite inE. *) + (* move => p0 p0K. *) + admit. (* needs additional assumption *) + apply /continuous_subspaceT. + move => x xK. + apply : differentiable_continuous. apply: V1_diff. + move => /= p0 t K0 t0. + apply /derivable1_diffP. + apply differentiable_comp. + apply /derivable1_diffP. + apply isSol. + rewrite inE. + by have [_ +] := K0. + exact: V1_diff. move => p0 K0. have p0s : (p0 \in state_space_tilt). by move : K0;rewrite inE/=/Ksub/inE/=;move=>[]. + rewrite derive1E. + rewrite -derive_along_derive. apply : derive_along_V1_le0_global => //. split. by rewrite initp. by apply isSol. + exact : V1_diff. + apply /derivable1_diffP => /=. + by apply isSol. move=>/=x [q qKsub xcl]. suff [] : (Ksub q) x by []. rewrite (closure_id (Ksub q)).1;last first. @@ -2791,16 +2882,24 @@ have H : limS sol (Ksub p) `<=` [set x | 'D~(sol x) (V1 alpha1 gamma) 0 = 0] `&` split. apply global_sol_sol; apply global_sol_T. apply isSol;rewrite inE;apply qKsub. - rewrite initp; [apply q_inKsubq|];rewrite inE;apply qKsub. + rewrite initp; apply q_inKsubq. + rewrite inE. + by have/= [_ +] := qKsub. exists t;split => //. by rewrite/=in_itv/=H ltrDl ltr01. have lim_sp : (sol q x @[x --> +oo]) (Ksub q). exists 0; split => // t t0 /=. - by apply (invariant_Ksub (qs _ (ltW t0))). + apply invariant_Ksub. + split => /=. + by rewrite lexx. + by have/= [_ +] := qKsub. + by rewrite ltW. rewrite clusterE in xcl. by apply:xcl. apply: (subset_trans H). move =>/= x [+ h1]. +rewrite derive1E. +rewrite -derive_along_derive. rewrite derive_along_V1_global //=. by rewrite initp ?inE. split => //. @@ -2808,7 +2907,11 @@ by rewrite initp ?inE. move=>x0. have h1' : (x \in state_space_tilt) by rewrite inE. by have [_ /=] := (isSol h1'). -Qed. +apply V1_diff. +apply /derivable1_diffP. +apply isSol. +by rewrite inE. +Admitted. Lemma limS_subset_p1p2 p : p \in state_space_tilt -> limS sol (Ksub p) `<=` [set point1; point2]. @@ -2823,7 +2926,7 @@ have -> : [set point1; point2] = [set x : 'rV[K]_6 | V1dot x = 0] `&` state_sp move => [h1 h2']. have h2: x \in state_space_tilt by rewrite inE. move : h1. - have hi := initp h2. + have hi := initp x. rewrite -hi => h1. have sol' : is_sol phi 1 (sol x) state_space_tilt. apply: global_sol_sol. @@ -2979,12 +3082,11 @@ Proof. rewrite inE/=. move => [_ h]. apply: initp. - by rewrite inE. - have H0 := cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) (@sol_Ksub p) p0K pK. - apply: (subset_trans H0). - apply : (@limS_subset_p1p2 p) => //. - by rewrite inE. -Qed. + (* have H0 := cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) _ _ (@sol_Ksub p) p0K pK. *) + (* apply: (subset_trans H0). *) + (* apply : (@limS_subset_p1p2 p) => //. *) + (* by rewrite inE. *) +Admitted. (* Requires something about the cluster set of trajectory being connected *) (* Lemma cvg_to_p1_or_p2 p : (p \in state_space_tilt) -> *) (* (sol p t @[t --> +oo] --> point1 ) \/ ( sol p t @[t --> +oo] --> point2). *) From 4316080560ae0119b8b610c305adb8e6a28a9a6d Mon Sep 17 00:00:00 2001 From: yosakaon Date: Tue, 3 Feb 2026 19:54:09 +0100 Subject: [PATCH 088/144] one less admit but wrong goal? --- tilt.v | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/tilt.v b/tilt.v index 6e4e6b72..77f4a2b1 100644 --- a/tilt.v +++ b/tilt.v @@ -2606,7 +2606,11 @@ move => /=t. have [tlt | tge] := ltP t 0. - set sol' := fun t => 2*: (sol p 0) - sol p (- t). have H0 : {near t, sol' =1 sol p}. - admit. + near=> s. + rewrite /sol'. + rewrite -H1 //. + near: s. + by apply: lt_nbhsl. split. + apply : (near_eq_derivable _ H0) =>//. rewrite /sol'. @@ -2626,9 +2630,20 @@ have [tlt | tge] := ltP t 0. symmetry. apply: near_eq_derive => //. rewrite /sol'. - rewrite deriveB/=?derive_cst ?sub0r. + rewrite deriveB/=?derive_cst ?sub0r => //. + have tt : 0 <= - t. + rewrite lerNr oppr0 ltW => //. + have h3 : 'D_1 (sol p ) (-t) = phi (sol p ( -t)). + have := H2 (-t) tt. + move=> h. + by apply derive_val. + rewrite -fctE. + have Dt_neg: 'D_1 (sol p \o -%R) t = - 'D_1 (sol p) (- t) by admit. + rewrite Dt_neg opprK. + rewrite h3. admit. - apply derivable_cst. + apply /derivable1_diffP. + apply: differentiable_comp => //. admit. - split. have {}H2 := H2 _ tge. From 3d65d075903cdb6ab565cd148b18b84201588d3a Mon Sep 17 00:00:00 2001 From: yosakaon Date: Wed, 4 Feb 2026 01:11:06 +0100 Subject: [PATCH 089/144] one less admit but wrong goal? --- tilt.v | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tilt.v b/tilt.v index 77f4a2b1..6434323c 100644 --- a/tilt.v +++ b/tilt.v @@ -2641,6 +2641,14 @@ have [tlt | tge] := ltP t 0. have Dt_neg: 'D_1 (sol p \o -%R) t = - 'D_1 (sol p) (- t) by admit. rewrite Dt_neg opprK. rewrite h3. + rewrite /phi. + rewrite /tilt_eqn. + rewrite /eqn14b_rhs /=. + rewrite !linearB /=. + rewrite !linearZ /=. + rewrite ![in RHS] (H1 (t)); last by apply tlt. + rewrite ![in RHS]initp /=. + (* impossible ? *) admit. apply /derivable1_diffP. apply: differentiable_comp => //. From 20cffb02b7bdc20095f0274ead5f40b07f79d14f Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Wed, 4 Feb 2026 21:09:53 +0900 Subject: [PATCH 090/144] lasalle (wip) --- tilt.v | 306 +++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 190 insertions(+), 116 deletions(-) diff --git a/tilt.v b/tilt.v index 6434323c..81f263fc 100644 --- a/tilt.v +++ b/tilt.v @@ -373,15 +373,20 @@ Definition is_sol (Delta : K) (f : K -> U) (Init : set U) := f 0 \in Init /\ is_sol_autonomous (f 0) phi 0 Delta f. Definition is_global_sol (f : K -> U) (Init : set U) := - f 0 \in Init /\ forall x , derivable f x 1 /\ f^`() x = phi (f x). + f 0 \in Init /\ forall t , t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). Lemma global_sol_sol f Init : is_global_sol f Init -> forall Delta, is_sol Delta f Init. Proof. move => [init0 /= solP] Delta. do 3 split =>//. - apply: derivable_within_continuous. - move => x _. - apply solP. + move => x. + rewrite /=inE/=in_itv/= => /andP[h _]. + apply solP. + by rewrite ltW. + apply: derivable_within_continuous. + move => x. +rewrite /=in_itv/= => /andP[h _]. +by apply solP. Qed. End ode. @@ -2369,7 +2374,7 @@ Lemma derive_zp10 (sol : K -> 'rV_6) : 'D_1 (Left \o sol) 0 = - alpha1 *: Left (sol 0). Proof. move=> [/= sol0in]. -move /(_ 0) => [d0 +]. +move /(_ _ (lexx 0)) => [d0 +]. move=> /(congr1 Left). rewrite derive1E. rewrite row_mxKl. @@ -2384,7 +2389,7 @@ Lemma derive_z20 (sol : K -> 'rV_6) : Proof. move=> [/= sol0in]. -move /(_ 0) => [d0 +]. +move /(_ _ (lexx 0)) => [d0 +]. move => /(congr1 Right). rewrite derive1E. by rewrite row_mxKr => ?; rewrite derive_rsubmx. @@ -2423,8 +2428,8 @@ Lemma derive_along_V1_global t (sol : K -> 'rV_6) : 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0 tilt_eqnx. -have dif1 : forall t, differentiable sol t. - move => /= t'. +have dif1 : forall (t : K), (0 <= t) -> differentiable sol t. + move => /= t' t'0. apply /derivable1_diffP. by apply tilt_eqnx. rewrite /V1 derive_alongD; last 3 first. @@ -2436,8 +2441,10 @@ rewrite /V1 derive_alongD; last 3 first. under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. rewrite derive_alongMl => //; last first. + exact: dif1. exact/differentiable_enorm_squared/differentiable_lsubmx_comp. rewrite derive_alongMl => //; last first. + exact: dif1. exact/differentiable_enorm_squared/differentiable_rsubmx_comp. rewrite -fctE /= !derive_along_enorm_squared//=. move : t0. @@ -2448,6 +2455,8 @@ rewrite derive_alongMl => //; last first. by rewrite !invfM. by rewrite inE/=in_itv/=t0 ltrDl;apply /andP. - exact/differentiable_lsubmx_comp. +exact:dif1. +exact:dif1. Qed. Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : @@ -2456,8 +2465,8 @@ Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. move=> solves. -have diff : forall t, differentiable sol t. - move => /= t'. +have diff : forall (t : K), (0 <= t) -> differentiable sol t. + move => /= t' t0'. apply /derivable1_diffP. by apply solves. move => t t0. @@ -2595,75 +2604,28 @@ Hypothesis solP : forall y, (y 0) \in state_space_tilt -> lasalle.is_sol phi y < Hypothesis initp: forall p, sol p 0 = p. + + Let isSol : forall p, p \in state_space_tilt -> is_global_sol phi (sol p) setT. Proof. move => p Kp. have : lasalle.is_sol phi (sol p). - admit. -move => [/= H1 H2]. + by apply /solP; rewrite ?initp. +move => [/=_ H]. split; first by rewrite inE. -move => /=t. -have [tlt | tge] := ltP t 0. -- set sol' := fun t => 2*: (sol p 0) - sol p (- t). - have H0 : {near t, sol' =1 sol p}. - near=> s. - rewrite /sol'. - rewrite -H1 //. - near: s. - by apply: lt_nbhsl. - split. - + apply : (near_eq_derivable _ H0) =>//. - rewrite /sol'. - apply /derivable1_diffP. - apply: differentiable_comp => //. - apply: differentiable_comp => //. - apply: differentiable_comp => //. - apply /derivable1_diffP. - have := (H2 (-t) ). - rewrite lerNr oppr0 ltW//. - move /(_ erefl). - move => {}H2. - by apply @ex_derive in H2. - + - rewrite derive1E. - have -> : 'D_1 (sol p) t = 'D_1 sol' t. - symmetry. - apply: near_eq_derive => //. - rewrite /sol'. - rewrite deriveB/=?derive_cst ?sub0r => //. - have tt : 0 <= - t. - rewrite lerNr oppr0 ltW => //. - have h3 : 'D_1 (sol p ) (-t) = phi (sol p ( -t)). - have := H2 (-t) tt. - move=> h. - by apply derive_val. - rewrite -fctE. - have Dt_neg: 'D_1 (sol p \o -%R) t = - 'D_1 (sol p) (- t) by admit. - rewrite Dt_neg opprK. - rewrite h3. - rewrite /phi. - rewrite /tilt_eqn. - rewrite /eqn14b_rhs /=. - rewrite !linearB /=. - rewrite !linearZ /=. - rewrite ![in RHS] (H1 (t)); last by apply tlt. - rewrite ![in RHS]initp /=. - (* impossible ? *) - admit. - apply /derivable1_diffP. - apply: differentiable_comp => //. - admit. -- split. - have {}H2 := H2 _ tge. - by apply @ex_derive in H2. - rewrite derive1E. - by apply H2. -Admitted. +move => /= t t0. +split. + by apply: ex_derive; apply H. +by rewrite derive1E;apply H. +Qed. Definition Ksub (p : U) := [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` state_space_tilt. +(* continuity in initial value: assumption needed for LaSalle *) +Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. + Lemma mxnorm_enorm_le {n} (x : 'rV[K]_n) : `|x| <= `|x|_e. Proof. rewrite /Num.norm/=mx_normrE. @@ -2782,9 +2744,13 @@ split; last first. have : is_sol_autonomous x phi 0 (t+1) (sol x). split. by rewrite initp// inE. - split => //. + split. + move => t'. + rewrite inE/=in_itv/= => /andP[t0' _]. + by apply solA; rewrite ltW. apply: derivable_within_continuous. - move => x0 x0t. + move => x0. + rewrite in_itv/= => /andP[t0' _]. by apply solA. move /(V_nincr ) => /=. move /(_ (V1 alpha1 gamma)). @@ -2797,9 +2763,11 @@ split; last first. split => //. rewrite inE. by rewrite initp ?inE//. - move => t2 t20. + move => t2. + move => /andP[t2' _]. apply /derivable1_diffP. apply solA. + by rewrite ltW. by rewrite ltrDl. by rewrite lexx. Qed. @@ -2851,26 +2819,14 @@ Local Lemma limS_subset_V1dot0 p : p \in state_space_tilt -> limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` state_space_tilt. Proof. move => ps. - have H : limS sol (Ksub p) `<=` [set x | derive1 (V1 alpha1 gamma \o sol x) 0 = 0] `&` state_space_tilt. -(* have H : limS sol (Ksub p) `<=` [set x | 'D~(sol x) (V1 alpha1 gamma) 0 = 0] `&` state_space_tilt. *) +have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). + move => y Ky. + apply /solP. + rewrite inE. + by apply Ky. +have H : limS sol (Ksub p) `<=` [set x | derive1 (V1 alpha1 gamma \o sol x) 0 = 0] `&` state_space_tilt. rewrite subsetI;split. - have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). - admit. - apply: (@stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (V1 alpha1 gamma)) => //=. - (* apply. *) - (* Search derive_along. *) - (* have /= := stable_limS (@compact_Ksub p) _ lasalle_sol _ (@invariant_Ksub p). *) - (* appl *) - (* have: (@stable_limS _ _ _ _ _ _ _ (@sol_Ksub p) _ (V1 alpha1 gamma)). *) - (* apply: (@stable_limS _ _ _ _ _ _ _ (@sol_Ksub p) _ (V1 alpha1 gamma)). *) - (* exact: compact_Ksub. *) - (* exact: invariant_Ksub. *) - (* move => p0. *) - (* rewrite inE/=/Ksub/inE/=. *) - (* move => [_ K0]. *) - (* by apply initp;rewrite inE. *) - (* move => p0 p0K. *) - admit. (* needs additional assumption *) + apply: (@stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (V1 alpha1 gamma)) => //=. apply /continuous_subspaceT. move => x xK. apply : differentiable_continuous. @@ -2879,7 +2835,7 @@ move => ps. apply /derivable1_diffP. apply differentiable_comp. apply /derivable1_diffP. - apply isSol. + apply isSol => //. rewrite inE. by have [_ +] := K0. exact: V1_diff. @@ -2927,14 +2883,14 @@ rewrite derive_along_V1_global //=. by rewrite initp ?inE. split => //. by rewrite initp ?inE. -move=>x0. +move=>x0 x0t. have h1' : (x \in state_space_tilt) by rewrite inE. -by have [_ /=] := (isSol h1'). +by apply (isSol h1'). apply V1_diff. apply /derivable1_diffP. -apply isSol. +apply isSol => //. by rewrite inE. -Admitted. +Qed. Lemma limS_subset_p1p2 p : p \in state_space_tilt -> limS sol (Ksub p) `<=` [set point1; point2]. @@ -3093,29 +3049,147 @@ by apply EB;left. Qed. Lemma cvg_to_set_p1_p2 p : p \in state_space_tilt -> - cluster (sol p t @[t --> +oo]) `<=` [set point1; point2]. + sol p t @[t --> +oo] --> [set point1; point2]. Proof. - rewrite inE => ps. - have : p \in Ksub p. - by rewrite inE; split => //=. - move => pK. +rewrite inE => ps. +have : p \in Ksub p. + by rewrite inE; split => //=. +move => pK. +have p0K : (forall p0 : 'rV_6, p0 \in Ksub p -> sol p0 0 = p0). + move => q. + rewrite inE/=. + move => [_ h]. + apply: initp. +apply : (cvg_trans (cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) _)). + by move:pK; rewrite inE. +move => /= S [eps eps0 Be]. +exists eps => //. +apply bigcup_sub => /= x H. +apply: (subset_trans _ Be). +have ps' : p \in state_space_tilt by rewrite inE. +have : [set point1; point2] x. + by apply: (limS_subset_p1p2 ps'). +move => h x' Bx'. +by exists x => //. +Qed. + +Lemma avoid_x (x : U) : (~` [set point1; point2]) x -> + exists S : set U, [/\ open S, [set point1; point2] `<=` S & ~ closure S x]. +Proof. +move => hx. +have cx : closed [set x]. + by apply accessible_closed_set1; apply hausdorff_accessible. +have cp : closed [set (point1 : U);point2]. + by apply accessible_finite_set_closed => //; apply hausdorff_accessible. +have /(@normal_openP K) Hn : normal_space U by apply: pseudometric_normal. +have [|V1 [V2 [V1o V2o V1c V2c Vdisj]]] := (Hn _ _ cx cp). + apply disjoints_subset. + by rewrite sub1set inE. +exists V2;split => //. +move => h. +have [_ +] := open_disjoint_separated V1o V2o Vdisj. +apply /nonemptyPn => /=. +rewrite not_notE. +exists x. +split => //. +by apply V1c. +Qed. - have p0K : (forall p0 : 'rV_6, p0 \in Ksub p -> sol p0 0 = p0). - move => q. - rewrite inE/=. - move => [_ h]. - apply: initp. - (* have H0 := cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) _ _ (@sol_Ksub p) p0K pK. *) - (* apply: (subset_trans H0). *) - (* apply : (@limS_subset_p1p2 p) => //. *) - (* by rewrite inE. *) +Lemma cluster_contained_p1p2 p : p \in state_space_tilt -> cluster (sol p t @[t --> +oo]) `<=` [set point1; point2]. +Proof. +move => ps. +have /cvg_cluster cp12 := (cvg_to_set_p1_p2 ps). +apply: (subset_trans cp12). +rewrite clusterE. +move => /= x H. +suff : (~ (~` [set point1; point2]) x) by apply contrapT. +move => Hdist. +have [S [So Sc Sx]] := avoid_x Hdist. +have [e1 /= e10 /= P1] : \forall e \near 0^'+, ball point1 e `<=` S. + apply: open_subball => //. + by apply Sc;left. +have [e2 /= e20 /= P2] : \forall e \near 0^'+, ball point2 e `<=` S. + apply: open_subball => //. + by apply Sc;right. +set eps := min (e1/2) (e2/2). +have eps0 : 0 < eps. + by rewrite lt_min !divr_gt0. +have B1 : ball point1 eps `<=` S. + apply P1 => //. + rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ltr_pdivrMr // ltr_pMr ?ltrDr //. + by apply /orP;left. +have B2 : ball point2 eps `<=` S. + apply P2 => //. + rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ?ltr_pdivrMr // ltr_pMr ?ltrDr //. + by apply /orP;right. +have nbh' : (nbhs [set point1;point2] S). + exists eps => //=. + rewrite /ball_set. + by apply: bigcup_sub => /= _ [-> | ->]. +by have := (H _ nbh'). +Qed. + +Local Lemma connected2_subset (A : set U) : connected A -> A !=set0 -> A `<=` [set point1; point2] -> A = [set point1] \/ A = [set point2]. +Proof. +move=>Ac Anonempty Asub. +have sep : separated [set (point1 : U)] [set point2]. + split. + rewrite -(closure_id _).1; last first. + by apply accessible_closed_set1; apply hausdorff_accessible. + apply /disjoints_subset. + rewrite sub1set. + rewrite inE /=. + rewrite /point1/point2. + admit. + admit. +have [/subset_set1 [/nonemptyPn A0 | ] | /subset_set1 [/nonemptyPn A0 |] ]:= (connected_subset sep Asub Ac) => //. +by left. +by right. Admitted. -(* Requires something about the cluster set of trajectory being connected *) -(* Lemma cvg_to_p1_or_p2 p : (p \in state_space_tilt) -> *) -(* (sol p t @[t --> +oo] --> point1 ) \/ ( sol p t @[t --> +oo] --> point2). *) -(* Proof. *) + +Lemma cvg_to_p1_or_p2 p : (p \in state_space_tilt) -> + (sol p t @[t --> +oo] --> point1 ) \/ ( sol p t @[t --> +oo] --> point2). +Proof. +move => ps. +have cluster_con : connected (cluster (sol p t @[t --> +oo])). + apply: (compact_connected_cluster _ _ _ (@compact_Ksub p)) => //. + by apply: pseudometric_normal. + move => t. + apply: differentiable_continuous. + apply /derivable1_diffP. + apply isSol => //. + admit. (* use solP or set time >= 0 in lemma *) + admit. (* same*) +(* have := connected2_subset cluster_con (cluster_contained_p1p2 ps). *) +(* have [h | h] : cluster (sol p t @[t --> +oo]) = [set point1] \/ cluster (sol p t @[t --> +oo]) = [set point1]. *) +(* have := connected2_subset () *) +(* have := cluster_contained_p1p2 ps. *) +(* have ->: ((nbhs [set point1; point2]) = globally [set (point1 :U); point2]). *) +(* admit. *) +(* rewrite -closureEcluster. *) +(* left. *) +(* apply: (compact_cluster_set1 _ (@compact_Ksub p) ) => //. *) +(* rewrite nbhsE/=. *) +(* exists (ball point1 1). *) +(* admit. *) +(* admit. *) +(* apply cvg_to_set_p1_p2. *) +(* admit. *) +(* admit. *) +(* have := nbhs_singleton. *) +(* rewrite /nbhs/=. *) +(* Search nbhs *) +(* apply: (compact_cluster_set1 _ (closed_ball ) ) => //. *) +(* admit. *) +(* admit. *) +(* apply cvg_to_set_p1_p2. *) +(* exists (point1 : matrix K 1 6). *) +(* Search nbhs "mx". *) +(* apply mx_nbhs_filter. *) +(* exists . *) +(* have:= cvg_to_plim. *) (* move => h. *) -(* have := (cvg_to_set_p1_p2 h). *) +(* have /cvg_cluster := (cvg_to_set_p1_p2 h). *) (* Search cluster. *) (* rewrite /globally/= => hc. *) (* have : exists t0, forall t, t > t0 -> sol p t \in [set point1; point2]. *) @@ -3124,5 +3198,5 @@ Admitted. (* move => h'. *) (* pose d := `|(@point1 K) - point2|. *) (* pose g t := `|sol p t - point1| - `|sol p t - point2|. *) -(* Admitted. *) +Admitted. End LaSalle_tilt. From c9f452fe7aab2487d3d48d767f55b71ca0212775 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Thu, 5 Feb 2026 21:01:20 +0900 Subject: [PATCH 091/144] la salle --- tilt.v | 257 +++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 194 insertions(+), 63 deletions(-) diff --git a/tilt.v b/tilt.v index 81f263fc..415fa0f7 100644 --- a/tilt.v +++ b/tilt.v @@ -2806,10 +2806,37 @@ suff -> : 'e_2 *v 'e_2 = (0 : 'rV[K]_3). by rewrite enorm0 /GRing.exp /= !mulr0 oppr0. by rewrite vece2 /= scale0r. Qed. + +Local Lemma sol_continuous p : p \in state_space_tilt -> continuous (sol p). +Proof. +move => sp t. +have [issol0 issol1]: lasalle.is_sol phi (sol p). + apply: (sol_is_sol (sol := sol) (K:=state_space_tilt) ) => //. + move => y Ky. + by apply /solP;rewrite inE. + move : sp. + by rewrite inE. +apply : differentiable_continuous. +apply /derivable1_diffP. +have [ht | ht] := ltP t 0; last by apply /ex_derive/issol1. +apply : (@near_eq_derivable _ _ _ (fun t => 2 *: sol p 0 - sol p (-t))) => //. + near=> s. + rewrite -issol0 //. + near: s. + by apply: lt_nbhsl. +apply /derivable1_diffP. +apply: differentiable_comp => //. +apply: differentiable_comp => //. +apply: differentiable_comp => //. +apply /derivable1_diffP. +apply /ex_derive/issol1. +rewrite lerNr oppr0 ltW//. +Unshelve. all: by end_near. Qed. + Local Lemma global_sol_T A sol' : is_global_sol phi sol' setT -> sol' 0 \in A -> is_global_sol phi sol' A. Proof. - move => [_ solP'] initP. - split=>//. +move => [_ solP'] initP. +split=>//. Qed. Local Lemma q_inKsubq q : q \in state_space_tilt -> q \in Ksub q. @@ -2919,15 +2946,52 @@ Qed. (*Todo: generalize + PR? *) Lemma compact_decreasing_bigcap - (X : topologicalType) (B : K -> set X) (O : set X) : - (forall i, compact (B i)) -> + (X : ptopologicalType) (B : K -> set X) (O : set X) : + hausdorff_space X -> + (forall i, 0 <= i -> compact (B i)) -> (forall i j, i <= j -> B j `<=` B i) -> open O -> - (\bigcap_i B i `<=` O) -> - exists i0, B i0 `<=` O. -Proof. - move => H. + (\bigcap_(i in [set i | 0 <= i]) B i `<=` O) -> + exists i0, (0 <= i0) /\ B i0 `<=` O. +Proof. +move => H comp decr openO subO. +set V := fun i => ((B i) `&` ~` O). +have comp' i : (0 <= i) -> compact (V i). + move=>i0. + apply: compact_closedI. + by apply comp. + by apply open_closedC. +have decr' i j : i <= j -> V j `<=` V i. + move=>ij. + rewrite /V. + by apply setSI;apply decr. + +apply /not_existsP. +move => /= hf. +suff /set0P : \bigcap_(i in [set t | 0 <= t]) V i !=set0. + rewrite /V/=. + rewrite bigcapIl; last first. + by exists 0 => /=. + move /eqP => h. + by have /subsets_disjoint := h. +have cf : closed_fam_of (B 0) [set t | t >= 0] V. + exists V => /=t t0 //. + apply closedI. + apply compact_closed => //. + apply comp => //. + by apply open_closedC. + rewrite /V. + rewrite setIA. + apply: congr2 => //. + symmetry. + rewrite setIC. + apply: setIidl. + by apply decr. +have : compact (B 0) by apply comp. +rewrite compact_In0/=. +apply => //. Admitted. + Lemma open_disjoint_separated (X : topologicalType) (A B : set X) : open A -> open B -> A `&` B = set0 -> separated A B. Proof. @@ -2967,12 +3031,12 @@ Qed. (*Todo: PR? *) (* NB: should be possible to generalize without normal_space X *) Lemma compact_connected_cluster - (X : topologicalType) (f : K -> X) (A : set X) : + (X : ptopologicalType) (f : K -> X) (A : set X) : hausdorff_space X -> normal_space X -> continuous f -> compact A -> - (forall t, f t \in A) -> + (forall t, 0 <= t -> f t \in A) -> connected (cluster (f t @[t --> +oo])). Proof. move => H Hn contf compactf imagef. @@ -2992,15 +3056,21 @@ have Bmon (s t : K): s <= t -> B t `<=` B s. exists t' => //. move : tt'; rewrite /=!in_itv//= => /andP[ht _];apply /andP;split=>//. by apply: (le_trans st). -have Bcom t : compact (B t). +have Bcom t : 0 <= t -> compact (B t). + move => tge0. apply: (subclosed_compact _ compactf). exact: closed_closure. rewrite (closure_id A).1; last by apply compact_closed. apply: closure_subset. move => _ [t0 tp] <-. move /(_ t0): imagef. + have t0ge0 : 0 <= t0. + move : tp. + rewrite /=in_itv/= => /andP[+ _]. + by apply le_trans. + move /(_ t0ge0). by rewrite inE. -have -> : cluster (f t @[t --> +oo]) = \bigcap_t B t. +have -> : cluster (f t @[t --> +oo]) = \bigcap_(t in [set t | 0 <= t]) B t. rewrite clusterE. apply /seteqP;split. apply:sub_bigcap => t0 _. @@ -3009,17 +3079,21 @@ have -> : cluster (f t @[t --> +oo]) = \bigcap_t B t. apply num_real. move => t tx; exists t;rewrite //=in_itv/=ltW//. apply : sub_bigcap => b /= [t0 [_ /= h]]. - apply: (subset_trans (bigcap_inf (i := t0+1) _)) => //. + apply: (subset_trans (bigcap_inf (i := (max 0 (t0+1))) _)) => //. + by rewrite /=le_max lexx. apply closure_subset. move => _ /= [x xt] <-. apply h. have t1: (t0+1 <= x). - by move : xt; rewrite /=in_itv/= => /andP[]. + move : xt; rewrite /=in_itv/= => /andP[+ _]. + apply le_trans. + by rewrite le_max lexx;apply /orP;right. apply/lt_le_trans/t1. by rewrite ltrDl. apply /connectedP => E [Enonempty Eu Esep]. have /(separated_closedUP Esep) [E1c E2c] : closed ((E false) `|` (E true)). - by rewrite -Eu;apply closed_bigI => i _;apply compact_closed. + rewrite -Eu;apply closed_bigI => i P;apply compact_closed => //. + by apply Bcom. have /normal_openP := Hn. move /(_ K (E false) (E true)) => [| | | V1 [V2 [V1o V2o V1E1 V2E2 V12disj]]]//. by apply separated_disjoint. @@ -3027,16 +3101,16 @@ have V1V2o : open (V1 `|` V2). by apply openU. have V1V2sep : separated V1 V2. by apply open_disjoint_separated. -have BV1V2 : \bigcap_t B t `<=` V1 `|` V2. +have BV1V2 : \bigcap_(t in [set t | 0 <= t]) B t `<=` V1 `|` V2. by rewrite Eu;apply : setUSS. -case /compact_decreasing_bigcap : BV1V2 => // t0 Bto. +case /compact_decreasing_bigcap : BV1V2 => // t0 [t0ge0 Bto] //. suff: V1 `&` V2 !=set0. by apply nonemptyPn. have [e1 E1 ] := Enonempty false. have [e2 E2 ] := Enonempty true. have EB : (E false `|` E true `<=` B t0). rewrite <- Eu. - by apply bigcap_inf. + apply bigcap_inf => //. case (connected_subset V1V2sep Bto (Bcon _)) => hbv. exists e2. split; last by apply V2E2. @@ -3147,56 +3221,113 @@ by left. by right. Admitted. +Lemma cluster_nonempty p : p \in state_space_tilt -> cluster (sol p t @[t --> +oo]) !=set0. +Proof. +move => sp. +suff : (Ksub p) `&` cluster (sol p t @[t --> +oo]) !=set0. + move => [x [_ cx]]. + by exists x. +apply (@compact_Ksub p) => //. + by apply: fmap_proper_filter. +apply sub_image_at_infty => /=. +move => _ [t t0] <-. +apply invariant_Ksub => //. +have:= (q_inKsubq sp). +by rewrite inE. +Qed. + +Lemma p1_Ksub p : Ksub p point1. +Proof. +split => /=; last by have := (@point1_in_state_space_tilt K);rewrite inE. +rewrite /point1/V1. +rewrite lsubmx_const rsubmx_const/= !enorm0 !expr0n /= !mul0r add0r. +by rewrite addr_ge0 // divr_ge0 // ?sqr_ge0 ?mulr_ge0 // ltW. +Qed. + +(*Todo : PR ? *) + Lemma cvg_to_p1_or_p2 p : (p \in state_space_tilt) -> (sol p t @[t --> +oo] --> point1 ) \/ ( sol p t @[t --> +oo] --> point2). Proof. move => ps. have cluster_con : connected (cluster (sol p t @[t --> +oo])). - apply: (compact_connected_cluster _ _ _ (@compact_Ksub p)) => //. + apply: (compact_connected_cluster _ _ _ (@compact_Ksub p) ) => //. by apply: pseudometric_normal. + by apply: sol_continuous. move => t. - apply: differentiable_continuous. - apply /derivable1_diffP. - apply isSol => //. - admit. (* use solP or set time >= 0 in lemma *) - admit. (* same*) -(* have := connected2_subset cluster_con (cluster_contained_p1p2 ps). *) -(* have [h | h] : cluster (sol p t @[t --> +oo]) = [set point1] \/ cluster (sol p t @[t --> +oo]) = [set point1]. *) -(* have := connected2_subset () *) -(* have := cluster_contained_p1p2 ps. *) -(* have ->: ((nbhs [set point1; point2]) = globally [set (point1 :U); point2]). *) -(* admit. *) -(* rewrite -closureEcluster. *) -(* left. *) -(* apply: (compact_cluster_set1 _ (@compact_Ksub p) ) => //. *) -(* rewrite nbhsE/=. *) -(* exists (ball point1 1). *) -(* admit. *) -(* admit. *) -(* apply cvg_to_set_p1_p2. *) -(* admit. *) -(* admit. *) -(* have := nbhs_singleton. *) -(* rewrite /nbhs/=. *) -(* Search nbhs *) -(* apply: (compact_cluster_set1 _ (closed_ball ) ) => //. *) -(* admit. *) -(* admit. *) -(* apply cvg_to_set_p1_p2. *) -(* exists (point1 : matrix K 1 6). *) -(* Search nbhs "mx". *) -(* apply mx_nbhs_filter. *) -(* exists . *) -(* have:= cvg_to_plim. *) -(* move => h. *) -(* have /cvg_cluster := (cvg_to_set_p1_p2 h). *) -(* Search cluster. *) -(* rewrite /globally/= => hc. *) -(* have : exists t0, forall t, t > t0 -> sol p t \in [set point1; point2]. *) -(* Search globally. *) -(* move => []. *) -(* move => h'. *) -(* pose d := `|(@point1 K) - point2|. *) -(* pose g t := `|sol p t - point1| - `|sol p t - point2|. *) -Admitted. + rewrite inE. + apply : invariant_Ksub. + have := q_inKsubq ps. + by rewrite inE. +have := connected2_subset cluster_con (cluster_nonempty ps) (cluster_contained_p1p2 ps). +suff H (q : U): cluster (sol p t @[t --> +oo]) = [set q] -> sol p t @[t --> +oo] --> q. + move => [h | h]; [left | right];apply H => //. +move => H. + +have Ksubq : Ksub p q. + suff: cluster (sol p t @[t --> +oo]) `<=` Ksub p. + by apply; rewrite H. + rewrite clusterE. + apply :(@subset_trans _ (closure (sol p @` `[0, +oo[))). + apply: bigcap_inf => //=. + exists 0; split => //= x x0. + exists x=>//. + rewrite in_itv/=ltW//. + rewrite (closure_id (Ksub p)).1;last first. + by apply compact_closed =>//; apply compact_Ksub. + apply closure_subset. + move => /= _ [t +] <-. + rewrite in_itv/= => /andP[t0 _]. + apply invariant_Ksub => //. + have := q_inKsubq ps. + by rewrite inE. +have [M [Mr Mp]]: bounded_set (Ksub p). + apply compact_bounded. + exact: compact_Ksub. +have [M0 | M0] := leP 0 M;last first. + suff : `|q| < 0 by rewrite normr_lt0. + have M02 : M < M/2. + by rewrite ltr_pdivlMr // gtr_nMr // ltrDl. + have /= w := (Mp _ M02 _ Ksubq). + apply (le_lt_trans w). + rewrite ltr_pdivrMr // mul0r //. +set V := ball (p : U) (`|p|+(M+1+1) : K). +have VKsub : Ksub p `<=` V. + move => /= x Kx. + rewrite /V -ball_normE/ball_ /=. + apply: (le_lt_trans (ler_normB _ _)). + apply: ler_ltD => //. + apply: ltr_pwDr => //. + apply Mp => //. + by apply: ltr_pwDr => //. +have B1 : 0 < `|p| + (M + 1 + 1). + rewrite ltr_wpDl//?normr_ge0. + apply addr_gt0 => //. + by rewrite ltr_wpDl. +have Vo : open V. + by rewrite /V;apply: ball_open. +have cV : compact (closure V). + rewrite closure_ballE closed_ballE//. + apply: bounded_closed_compact; last by apply: closed_closed_ball_. + exists (`|p| + (`|p| + (M+1 +1))). + rewrite /closed_ball_/=. + split => //= x xB y Hy. + rewrite -(subrKC p y). + apply : (le_trans (ler_normD _ _)). + rewrite distrC. + apply (le_trans (lerD (lexx _ ) Hy)). + by apply ltW. +apply: (compact_cluster_set1 _ cV ) => //. + rewrite nbhsE/=. + exists V; last by apply subset_closure. + split => //. + by apply VKsub. +apply : (filterS (closure_subset VKsub)). +exists 0;split => //= x /ltW x0. +rewrite -(closure_id (Ksub p)).1;last first. + by apply compact_closed =>//; apply compact_Ksub. +apply invariant_Ksub => //. +have := q_inKsubq ps. +by rewrite inE. +Qed. End LaSalle_tilt. From 75f58287f6e829fdbe90563dedabd9d65ed3d83a Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 8 Feb 2026 11:23:02 +0900 Subject: [PATCH 092/144] tilt_is_sol --- tilt.v | 57 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 29 insertions(+), 28 deletions(-) diff --git a/tilt.v b/tilt.v index 415fa0f7..ed9253b6 100644 --- a/tilt.v +++ b/tilt.v @@ -22,7 +22,7 @@ Require Import lasalle. (* initial_condition u0 *) (* equation phi *) (* solution f on [t0, t1] *) -(* is_sol phi Delta f Init := is_sol_autonomous (f 0) phi 0 Delta f *) +(* tilt_is_sol_autonomous phi Delta f Init := is_sol_autonomous (f 0) phi 0 Delta f *) (* + f 0 \in Init *) (* is_equilibrium_point f p := solves_equation f (cst p) *) (* state_space f == the set points attainable by a solution *) @@ -369,13 +369,13 @@ Let U := 'rV[K]_n. Variable phi : U -> U. -Definition is_sol (Delta : K) (f : K -> U) (Init : set U) := +Definition tilt_is_sol_autonomous (Delta : K) (f : K -> U) (Init : set U) := f 0 \in Init /\ is_sol_autonomous (f 0) phi 0 Delta f. Definition is_global_sol (f : K -> U) (Init : set U) := f 0 \in Init /\ forall t , t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). -Lemma global_sol_sol f Init : is_global_sol f Init -> forall Delta, is_sol Delta f Init. +Lemma global_sol_sol f Init : is_global_sol f Init -> forall Delta, tilt_is_sol_autonomous Delta f Init. Proof. move => [init0 /= solP] Delta. do 3 split =>//. @@ -383,11 +383,12 @@ Proof. rewrite /=inE/=in_itv/= => /andP[h _]. apply solP. by rewrite ltW. - apply: derivable_within_continuous. + apply: derivable_within_continuous. move => x. rewrite /=in_itv/= => /andP[h _]. -by apply solP. +by apply solP. Qed. + End ode. Section is_sol. @@ -398,10 +399,10 @@ Variable Delta : K. Lemma is_sol_subset f (A B : set T) : A `<=` B -> - is_sol phi Delta f A -> is_sol phi Delta f B. + tilt_is_sol_autonomous phi Delta f A -> tilt_is_sol_autonomous phi Delta f B. Proof. move=> AB. -rewrite /is_sol inE => -[inD0 [_ [deri cont]]]; rewrite inE. +rewrite /tilt_is_sol_autonomous inE => -[inD0 [_ [deri cont]]]; rewrite inE. split => //. by apply: AB. Qed. @@ -414,7 +415,7 @@ Let T := 'rV[K]_n. Variable phi : T -> T. Definition state_space (Init : set T) : set T := - [set x | exists f Delta, (is_sol phi Delta f Init /\ + [set x | exists f Delta, (tilt_is_sol_autonomous phi Delta f Init /\ (exists t, t \in `[0, Delta[%R /\ x = f t))]. End state_space. @@ -427,7 +428,7 @@ Variable Init : set T. Variable Delta : K. Definition is_equilibrium_point (x : T) := - forall Delta, is_sol phi Delta (cst x) Init. + forall Delta, tilt_is_sol_autonomous phi Delta (cst x) Init. End equilibrium_point. @@ -444,7 +445,7 @@ Lemma equilibrium_points_subset (A B : set T) : equilibrium_points A `<=` equilibrium_points B. Proof. move=> AB x. -rewrite /equilibrium_points/= /is_equilibrium_point /is_sol inE => H Delta. +rewrite /equilibrium_points/= /is_equilibrium_point /tilt_is_sol_autonomous inE => H Delta. have [inD0 [deriv [cont tilt]]] := H Delta. rewrite inE; split => //. exact: AB. @@ -460,7 +461,7 @@ Variable Init : set T. Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (z : K -> 'rV[K]_n) (Delta : K), is_sol phi Delta z Init -> + forall (z : K -> 'rV[K]_n) (Delta : K), tilt_is_sol_autonomous phi Delta z Init -> `| z 0 - x | < d -> forall t, 0 < t < Delta -> `| z t - x | < eps. (* assuming solution exists for all time *) @@ -719,7 +720,7 @@ Proof. by move=> r0; rewrite /B -closed_ballE. Qed. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall Delta sol, is_sol phi Delta sol Init -> +Hypothesis V'_le0 : forall Delta sol, tilt_is_sol_autonomous phi Delta sol Init -> forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. (* khalil theorem 4.1 *) @@ -776,7 +777,7 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) have Df_Omega_beta Delta sol : - is_sol phi Delta sol Init -> + tilt_is_sol_autonomous phi Delta sol Init -> sol 0 \in Omega_beta -> forall t, 0 < t < Delta -> sol t \in Omega_beta. move=> solP phi_Omega. have /= V_nincr_consequence : forall t, 0 < t < Delta -> forall u, 0 <= u <= t -> @@ -1913,7 +1914,7 @@ Let phi := tilt_eqn alpha1 gamma. Variable Delta : K. Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : - is_sol phi Delta sol state_space_tilt -> + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> t \in `]0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. move=> [/= sol0in [_ [deri conti]] t0Delta]. @@ -1926,7 +1927,7 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - is_sol phi Delta sol state_space_tilt -> + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. @@ -1939,7 +1940,7 @@ Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : t \in `[0, Delta[%R -> - is_sol phi Delta sol state_space_tilt -> + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> state_space_tilt (sol t). Proof. move=> t0Delta. @@ -1958,7 +1959,7 @@ Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - is_sol phi Delta sol state_space_tilt -> `|u|_e = 1. + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> `|u|_e = 1. Proof. move=> z0Delta dtraj. suff: state_space_tilt (row_mx (zp1 z) (z2 z)). @@ -1970,7 +1971,7 @@ Qed. Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - is_sol phi Delta sol state_space_tilt -> + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> z0Delta dtraj. @@ -1994,7 +1995,7 @@ Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : z \in `[0, Delta[%R -> - is_sol phi Delta sol state_space_tilt-> + tilt_is_sol_autonomous phi Delta sol state_space_tilt-> `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = `|Right (sol z) *m \S('e_2)|_e. Proof. @@ -2022,7 +2023,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol phi Delta sol state_space_tilt -> + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> z \in `]0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + @@ -2049,7 +2050,7 @@ Qed. Lemma derive_along_V1 t (sol : K -> 'rV_6) : t \in `]0, Delta[ -> - is_sol phi Delta sol state_space_tilt -> + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> (forall t, t \in `]0, Delta[ -> differentiable sol t) -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. @@ -2086,7 +2087,7 @@ Definition u1 (sol : K -> 'rV[K]_6) t \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 t|_e, 1 |-> `|w|_e] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol phi Delta sol state_space_tilt -> + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> forall t, t \in `[0, Delta[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. @@ -2118,7 +2119,7 @@ by rewrite [leRHS]mulrC. Qed. Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : - is_sol phi Delta sol state_space_tilt -> + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> t \in `[0, Delta[%R -> V1dot (sol t) = 0 -> sol t = point1 \/ sol t = point2. @@ -2169,7 +2170,7 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : - is_sol phi Delta (sol x) state_space_tilt -> + tilt_is_sol_autonomous phi Delta (sol x) state_space_tilt -> sol x 0 = point1 -> \forall z \near 0^', ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + @@ -2212,7 +2213,7 @@ Unshelve. all: try by end_near. Abort. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - is_sol phi Delta (sol x) state_space_tilt -> + tilt_is_sol_autonomous phi Delta (sol x) state_space_tilt -> sol x 0 = point1 -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. @@ -2252,7 +2253,7 @@ Abort. Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - is_sol phi Delta (sol x) state_space_tilt -> + tilt_is_sol_autonomous phi Delta (sol x) state_space_tilt -> (forall t : K, state_space_tilt (sol x t)) -> sol x 0 = point1 -> locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. @@ -2325,7 +2326,7 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : - is_sol phi Delta sol state_space_tilt -> + tilt_is_sol_autonomous phi Delta sol state_space_tilt -> (forall t, 0 < t < Delta -> differentiable sol t) -> forall t : K, 0 < t < Delta -> 'D~(sol) (V1 alpha1 gamma) t <= 0. @@ -2934,7 +2935,7 @@ have -> : [set point1; point2] = [set x : 'rV[K]_6 | V1dot x = 0] `&` state_sp move : h1. have hi := initp x. rewrite -hi => h1. - have sol' : is_sol phi 1 (sol x) state_space_tilt. + have sol' : tilt_is_sol_autonomous phi 1 (sol x) state_space_tilt. apply: global_sol_sol. split. by rewrite hi. From 4df6965a9b47a4c5c8a2bf7d2d8efbd5ebb848b1 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 8 Feb 2026 11:43:37 +0900 Subject: [PATCH 093/144] wip --- ode.v | 24 ++++++++++++++++-------- ode_wip.v | 14 +++++++------- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/ode.v b/ode.v index fbe033d1..98b89aeb 100644 --- a/ode.v +++ b/ode.v @@ -1268,6 +1268,17 @@ HB.instance Definition _ {R : realType} (n : nat) := Complete.on (@row_vector R HB.instance Definition _ {R : realType} (n : nat) := NormedModule.on (@row_vector R n). (*HB.instance Definition _ {R : realType} (n : nat) := CompleteNormedModule.on (@row_vector R n).*) +Section is_sol. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (u0 : U) (a : R) (b : itv_bound R) (sol : R -> U). + +Definition is_sol_on := + sol a = u0 /\ + {in [set` Interval (BRight a)(*open*) b (*(BLeft b)(*open*)*)], forall x, derivable sol x 1 /\ sol^`() x = phi x (sol x)}. + +End is_sol. + Section integral_ode. Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. @@ -1302,9 +1313,6 @@ Definition is_integral_sol_on := sol a = u0 /\ (* by rewrite /=in_itv/=ht1//= lt_neqAle ht0/= eq_sym Ht0. *) (* Qed. *) -Definition is_sol_on := sol a = u0 /\ - {in `]a, b[, forall x, derivable sol x 1 /\ sol^`() x = phi x (sol x)}. - Lemma picard_iterator_within_continuous i : {within `[a, b], continuous (fun x => phi x (sol x) ord0 i)}. Proof. @@ -1335,7 +1343,7 @@ apply: continuous_compact_integrable; first exact: segment_compact. exact: picard_iterator_within_continuous. Qed. -Lemma integral_sol_iff_sol : is_integral_sol_on <-> is_sol_on. +Lemma integral_sol_iff_sol : is_integral_sol_on <-> is_sol_on phi u0 a (BLeft b) sol. Proof. split. - move => [hinit h]; split => // t tab. @@ -1695,7 +1703,7 @@ Definition local_solution := repr (picard_fix ab k0 lip2 cont1 rho1). Local Notation delta_max := (delta_max phi a b k u0 r rho). -Lemma solution_local_solution : is_sol_on phi a (a + delta_max) u0 local_solution. +Lemma solution_local_solution : is_sol_on phi u0 a (BLeft (a + delta_max)) local_solution. Proof. apply /(integral_sol_iff_sol (k:=k) (r:=r)) => //. - exact: ltDl_delta_max. @@ -1726,7 +1734,7 @@ Let f := cauchy_lipschitz_local_f. Theorem cauchy_lipschitz_local : delta_max > 0 /\ - is_sol_on phi a (a + delta_max) u0 f /\ + is_sol_on phi u0 a (BLeft (a + delta_max)) f /\ {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f t)} /\ {within `[a, a + delta_max], continuous f}. Proof. @@ -1751,7 +1759,7 @@ Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Hypothesis cf : {within `[a, b], continuous f}. Hypothesis cf' : {within `[a, b], continuous f'}. -Lemma solution_unique : is_sol_on phi a b u0 f -> is_sol_on phi a b u0 f' -> +Lemma solution_unique : is_sol_on phi u0 a (BLeft b) f -> is_sol_on phi u0 a (BLeft b) f' -> {in `[a, b], f =1 f'}. Proof. rewrite -!(integral_sol_iff_sol (r := r) (k:=k)) => //. @@ -1780,7 +1788,7 @@ Lemma phi_cont1 a b : {in B, forall y, {within `[a, b], continuous phi_ ^~ y}}. Proof. by move => /= x Bx; exact: cst_continuous_subspace. Qed. Lemma autonomous_solution a b f : - is_sol_autonomous a b f <-> is_sol_on phi_ a b u0 f. + is_sol_autonomous a b f <-> is_sol_on phi_ u0 a (BLeft b) f. Proof. by []. Qed. Let rho : {posnum R} := (2^-1)%:pos. diff --git a/ode_wip.v b/ode_wip.v index 739758db..8aba1333 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -55,7 +55,7 @@ Definition lipschitzT_solution_f : continuousFunType `[a, a + delta_max] [set: ' repr (picard_fix ab k0 lip2' cont1' rho1). Lemma lipschitzT_solution : - is_sol_on phi a (a + delta_max) u0 lipschitzT_solution_f. + is_sol_on phi u0 a (BLeft (a + delta_max)) lipschitzT_solution_f. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. - exact: ltDl_delta_max. @@ -84,7 +84,7 @@ Let f := lipschitzT_solution_f. Theorem lipschitzT_cauchy_lipschitz_local : delta_max > 0 /\ - is_sol_on phi a (a + delta_max) u0 f /\ + is_sol_on phi u0 a (BLeft (a + delta_max)) f /\ {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f t)} /\ {within `[a, a + delta_max], continuous f}. Proof. @@ -275,7 +275,7 @@ Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_[set: 'rV[R]_n] (phi Hypothesis cont1 : {in [set: 'rV[R]_n], forall y, {within `[a, b], continuous phi ^~ y}}. Theorem cauchy_lipschitz_global : exists f : R -> 'rV_n (*: continuousFunType `[a, b] [set: 'rV[R]_n]*), - is_sol_on phi a b u0 f. + is_sol_on phi u0 a (BLeft b) f. Proof. near (0:R)^'+ => rho'. have rho'_gt0 : 0 < rho' by []. @@ -352,7 +352,7 @@ have Iiab i : (i <= size s)%N -> [set` I i] `<=` `[a, b]. - by rewrite inE prednK// (leq_trans _ si). - by rewrite -(ltn_add2r 1) !addn1 (leq_trans si)// prednK// (leq_trans _ si). suff: forall i, (i < size s)%N -> - exists f : R -> 'rV_n, is_sol_on phi (nth b (a :: s) i) (nth b (a :: s) i.+1) u0 f. + exists f : R -> 'rV_n, is_sol_on phi u0 (nth b (a :: s) i) (BLeft (nth b (a :: s) i.+1)) f. move=> suf. have pickup_itv (x : R) : x \in `[a, b] -> exists2 i : nat, (i < size s)%N & x \in I i. move=> xab; apply: itv_partition_ex => //. @@ -501,11 +501,11 @@ Lemma exe325b1 : forall t, t \in `[a, T[ -> f t \in W. Proof. Admitted. -Lemma exe325b2 : is_sol_on phi a T u0 f. +Lemma exe325b2 : is_sol_on phi u0 a (BLeft T) f. Proof. Admitted. -Lemma exe325b3 : exists delta, delta > 0 /\ is_sol_on phi a (T + delta) u0 f. +Lemma exe325b3 : exists delta, delta > 0 /\ is_sol_on phi u0 a (BLeft (T + delta)) f. Proof. Admitted. @@ -524,7 +524,7 @@ Variable T : R. Hypothesis aTab : `[a, T[ `<=` `[a, b]. Variable f : R -> U. Variable u0 : U. -Hypothesis fsol : is_sol_on phi a T(*exluded*) u0 f. +Hypothesis fsol : is_sol_on phi u0 a (BLeft T)(*exluded*) f. Variable W : set U. Hypothesis compactW : compact W. From b8c88e4dc45b9782820a27515b05769f5202ff8b Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Sun, 8 Feb 2026 11:42:45 +0900 Subject: [PATCH 094/144] unique solution (wip) --- ode.v | 339 +++++++++++++++++++++++++++++++++++++++++++++++++++--- ode_wip.v | 4 +- 2 files changed, 325 insertions(+), 18 deletions(-) diff --git a/ode.v b/ode.v index 98b89aeb..c83b9f44 100644 --- a/ode.v +++ b/ode.v @@ -1579,6 +1579,48 @@ Proof. by move=> taad; apply: img_cball_picard_fix => /=; exists t. Qed. End picard. +Section continuous_patch. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (a b c : R) (f : R -> U) (g : R->U). +Hypothesis ab : a < b. +Hypothesis bc : b < c. +Hypothesis cont1 : {within `[a, b], continuous f}. +Hypothesis cont2 : {within `[b, c], continuous g}. +Hypothesis matchb : f b = g b. + +Lemma within_continuous_patch : {within `[a,c], continuous (patch g `[a, b] f)}. + have -> : `[a, c] = `[a, b] `|` `[b, c]. + rewrite (@itv_bndbnd_setU _ _ _ (BRight b)) // ?bnd_simp//=; last 2 first. + exact: ltW. + exact: ltW. + apply/seteqP; split => x. + move=> []; [by left|right]. + exact: subset_itv_oc_cc b0. + move=> []; [by left|]. + rewrite -setU1itv ?bnd_simp//; last first. + exact: ltW. + case; [|by right]. + move=> ->; left => /=. + by rewrite in_itv/= (ltW ab) lexx. + apply: (withinU_continuous (@itv_closed _ _ a b) (@itv_closed _ _ b c)). + have eq1 : {in `[a, b], f =1 patch g `[a, b] f }. + move => x0 x0ab. + by rewrite /patch x0ab. + apply: (continuous_within_ext eq1). + exact: cont1. + have eq2 : {in `[b, c], g =1 patch g `[a, b] f }. + move => x0 x0ab. + rewrite /patch;case: ifPn => [xab | xabnot] => //. + suff -> : x0 = b by rewrite matchb. + apply: le_anti. + move: x0ab xab. + by rewrite !inE/=!in_itv/= => /andP [-> _] /andP [_ ->]. + apply /continuous_subspaceW/(continuous_within_ext eq2)/cont2. + by apply: subset_itvl; rewrite bnd_simp. +Qed. +End continuous_patch. + Section picard_extension. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -1694,10 +1736,12 @@ Let B := closed_ball u0 r%:num. Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. -Let rho : {posnum R} := (2^-1)%:pos. +Variable rho : {posnum R}. +Hypothesis rho1 : rho%:num < 1. +(* Let rho : {posnum R} := (2^-1)%:pos. *) -Let rho1 : rho%:num < 1. -Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. +(* Let rho1 : rho%:num < 1. *) +(* Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. *) Definition local_solution := repr (picard_fix ab k0 lip2 cont1 rho1). @@ -1709,10 +1753,12 @@ apply /(integral_sol_iff_sol (k:=k) (r:=r)) => //. - exact: ltDl_delta_max. - move=> t td. apply: lip2. - by apply: subset_itvl td; rewrite bnd_simp -lerBrDl delta_max_itv. -- move=> /= x xB. + move: td; rewrite /=!in_itv/= => /andP [-> h] /=. + by rewrite (le_trans h)// -lerBrDl; exact: delta_max_itv. +- move=> /= x xB . apply/continuous_subspaceW/cont1 => //. - by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl delta_max_itv. + apply: subset_itvl => //=. + by rewrite bnd_simp -lerBrDl delta_max_itv. - rewrite /local_solution. exact: cts_fun. - by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. @@ -1745,27 +1791,285 @@ split; [| split]. - exact: solution_continuous. Qed. +Local Notation V := (Cont_on_seg_quot.quot_continuousFunType (@leDl_delta_max _ _ phi a b k ab u0 r k0 rho)). + +Theorem cauchy_lipschitz_local_unique f' : + {within `[a,a+delta_max], continuous f'} -> + {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f' t)} -> + is_sol_on phi u0 a (BLeft (a + delta_max)) f' -> + {in `[a, a + delta_max], f =1 f'}. +Proof. +move => cont bnd. +move /(integral_sol_iff_sol k0 (r:=r) ) => []//. +- exact: ltDl_delta_max. +- move=> t td. + apply: lip2. + move: td; rewrite /=!in_itv/= => /andP [-> h] /=. + by rewrite (le_trans h)// -lerBrDl; exact: delta_max_itv. +- move=> /= x xB . + apply/continuous_subspaceW/cont1 => //. + apply: subset_itvl => //=. + by rewrite bnd_simp -lerBrDl delta_max_itv. +- by move => _ [t tad] <-;apply bnd;rewrite inE. +move => h0 h1. +move => t tab. +have fc : cont_on_seg a (a+delta_max) f'. + by apply mem_set. +have pieq : \pi_V%qT f = \pi_V%qT (cont_on_seg_Sub fc). + rewrite reprK. + apply: cauchy_lipschitz_unique. + move => /= _ [t' tad' ] <- /=. + rewrite /Cont_on_seg_quot.quot_continuousFunType_to_fun. + suff -> : (repr (\pi_V%qT (cont_on_seg_Sub fc))) t' = f' t'. + by apply bnd;rewrite inE. + by apply Cont_on_seg_quot.eval_mod_on_itv;rewrite inE. + move => t0. + rewrite inE => -t0ad. + rewrite Cont_on_seg_quot.eval_mod_on_itv //=; last by rewrite inE. + rewrite h1// h0. + apply congr1. + apply: eq_rowRintegral => t' tad'. + rewrite Cont_on_seg_quot.eval_mod_on_itv //=. + move: tad'. + rewrite! inE. + apply: subset_itvl. + move : t0ad. + by rewrite /=in_itv/= => /andP[]. +suff -> : f t = (Cont_on_seg_quot.quot_continuousFunType_to_fun (\pi_V%qT (cont_on_seg_Sub fc))) t. + by rewrite /Cont_on_seg_quot.quot_continuousFunType_to_fun/=;apply Cont_on_seg_quot.eval_mod_on_itv. +rewrite -pieq. +by rewrite Cont_on_seg_quot.eval_mod_on_itv. +Qed. End cauchy_lipschitz_local. +Section continuous_confined. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (a b : R) (u0 : U) (r : {posnum R}). +Hypothesis ab : a < b. +Let B := closed_ball u0 r%:num. +Local Lemma continuous_confined (g : R -> U) : {within `[a, b], continuous g} -> (g a) = u0 -> exists Delta:{posnum R}, {in `[a, a + Delta%:num ], forall t, (g t) \in B}. +Proof. +move /(continuous_within_itvP _ ab) => [cc cl cr] g0. +have : {within `[a,b], continuous (fun t => `| u0 - g t |) }. + apply: within_continuous_comp_norm. + by rewrite ltW. + apply/ continuous_within_itvP => //=. + split. + move => t tab. + apply: (cvgB (cvg_cst _) (cc _ tab)). + apply: (cvgB (cvg_cst _) cl). + apply: (cvgB (cvg_cst _) cr). +move /(continuous_within_itvP _ ab) => [_ /cvgrPdist_le + _]. +move /(_ r%:num). +case => // Delta /= Delta0. +rewrite /ball_/= g0 subrr normr0/= => H. +have D20: (0 < Delta / 2) by rewrite divr_gt0. +exists (PosNum D20). +move => t tab. +move : tab. +rewrite inE /=in_itv/= => /andP[]. +rewrite le_eqVlt => /orP[/eqP <- | ]. + rewrite g0 /B inE => _;by apply: closed_ballxx. +move => ta td. +have /=:= (H t). +rewrite add0r normrN normr_id. +rewrite inE /B closed_ballE/closed_ball_//=;apply =>//. +rewrite ltr_distl. +apply /andP;split. +rewrite ltrBlDr. +apply (le_lt_trans td). + by rewrite ler_ltD// ltr_pdivrMr// ltr_pMr// ltrDl. +apply (lt_le_trans ta). +by rewrite lerDl ltW. +Qed. +End continuous_confined. + +Section solution_locally_unique. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}) (f : R -> U). +Hypothesis ab : a < b. +Hypothesis k0 : 0 < k. +Let B := closed_ball u0 r%:num. +Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. +Hypothesis cf : {within `[a, b], continuous f}. +Hypothesis sol1 : is_sol_on phi u0 a (BLeft b) f. +Let rho_max : {posnum R} := (2^-1)%:pos. + +Let dmax rho := delta_max phi a b k u0 r rho. +Let fc := local_solution ab k0 lip2 cont1. + +Lemma initial_solution_unique f' :{within `[a,b], continuous f'} -> + is_sol_on phi u0 a (BLeft b) f' -> + exists Delta : {posnum R}, {in `[a, a+Delta%:num], f =1 f'} /\ + {in `[a, a + Delta%:num], forall t, closed_ball u0 r%:num (f t)}. +Proof. +move => cf' sol2. +suff [rho [Delta [Hrho [Db [P1 P2]]]]]: exists rho Delta : {posnum R}, exists (Hrho : (rho%:num < 1)) , Delta%:num <= dmax rho /\ {in `[a, a+Delta%:num], f =1 fc Hrho } /\ {in `[a, a+Delta%:num], f' =1 fc Hrho } . + exists Delta; split => t tab; first by rewrite P1 // P2. + rewrite P1 //. + apply solution_stays_in_ball. + move: tab; rewrite !inE/=!in_itv/= => /andP[-> h] //=. + apply (le_trans h). + by rewrite lerD. +have [d1 D1] := continuous_confined r ab cf sol1.1. +have [d2 D2] := continuous_confined r ab cf' sol2.1. +have [rho [drho1 drho2]] : exists rho, dmax rho <= (Num.min d1%:num d2%:num) /\ rho%:num < 1. + rewrite /dmax/delta_max. + have posk : 0 < Num.min rho_max%:num (Num.min (k * rho_max%:num) (k * (Num.min d1%:num d2%:num))). + rewrite lt_min; apply /andP;split=>//. + rewrite lt_min; apply /andP;split=>//. + by apply mulr_gt0. + by apply mulr_gt0. + exists (PosNum posk). + split => //=. + rewrite !ge_min //=;apply /orP;right;apply /orP;right. + rewrite !minr_pMl //= ?invr_ge0 //; try by rewrite ltW. + rewrite ge_min; apply /orP;right. + rewrite ge_min; apply /orP; right. + by rewrite mulrC mulrA mulVr ?unitfE ?mul1r // ?gt_eqF. + rewrite gt_min; apply /orP;left. + by rewrite invf_lt1 // ltrDl. +have drho_pos : 0 < dmax rho. + by apply delta_max_gt0. +exists rho, (PosNum drho_pos), drho2. +split => //. +split. + move => t tad. + apply /esym. + apply : cauchy_lipschitz_local_unique. + - apply/continuous_subspaceW/cf => //. + apply: subset_itvl => //=. + by rewrite bnd_simp -lerBrDl;apply delta_max_itv. + - move => t0 t0ad. + suff : (f t0) \in closed_ball u0 r%:num by rewrite inE. + apply D1. + move : t0ad. + rewrite !inE/=!in_itv/= => /andP[-> h1] //=. + apply: (le_trans h1). + rewrite lerD//. + apply (le_trans drho1). + by rewrite ge_min lexx;apply /orP;left. + - split; first by apply sol1. + move => t0 t0ad. + have [_ + ] := sol1;apply. + move : t0ad. + rewrite !inE/=!in_itv/= => /andP[-> h]//=. + apply: (lt_le_trans h). + rewrite -lerBrDl. + exact: delta_max_itv. + - exact: tad. +move => t tad. +apply /esym. +apply : cauchy_lipschitz_local_unique. +- apply/continuous_subspaceW/cf' => //. + apply: subset_itvl => //=. + by rewrite bnd_simp -lerBrDl;apply delta_max_itv. +- move => t0 t0ad. + suff : (f' t0) \in closed_ball u0 r%:num by rewrite inE. + apply D2. + move : t0ad. + rewrite !inE/=!in_itv/= => /andP[-> h1] //=. + apply: (le_trans h1). + rewrite lerD//. + apply (le_trans drho1). + by rewrite ge_min lexx;apply /orP;right. +- split; first by apply sol2. + move => t0 t0ad. + have [_ + ] := sol2;apply. + move : t0ad. + rewrite !inE/=!in_itv/= => /andP[-> h]//=. + apply: (lt_le_trans h). + rewrite -lerBrDl. + exact: delta_max_itv. +exact: tad. +Qed. + +End solution_locally_unique. + Section solution_unique. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}) (f f' : R -> U). +Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}) (f : R -> U). Hypothesis ab : a < b. Hypothesis k0 : 0 < k. Let B := closed_ball u0 r%:num. Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Hypothesis cf : {within `[a, b], continuous f}. -Hypothesis cf' : {within `[a, b], continuous f'}. +Hypothesis sol1 : is_sol_on phi u0 a (BLeft b) f. -Lemma solution_unique : is_sol_on phi u0 a (BLeft b) f -> is_sol_on phi u0 a (BLeft b) f' -> - {in `[a, b], f =1 f'}. +Lemma unique_at_t0 f' t0: a <= t0 -> t0 < b -> {within `[a,b], continuous f'} -> is_sol_on phi u0 a (BLeft b) f' -> + f' t0 = f t0 -> exists Delta : {posnum R}, {in `[a, t0+Delta%:num], f =1 f'}. + +Proof. +move => t0a tb0 cf' sol2 ft0. +have ta : `[t0, b] `<=` `[a, b]. + move => t. + rewrite /=!in_itv/= => /andP[+ ->]//. + move => t0t;apply /andP;split=>//. + by apply /le_trans/t0t. +have lip20 :{in `[t0, b]%R, forall x : R, k.-lipschitz_B (phi x)}. + move => t t0b;apply lip2. + move : t0b; rewrite !in_itv/= => /andP[+ ->]//. + move => t0t;apply /andP;split=>//. + by apply /le_trans/t0t. +have cont10: {in B, forall y : 'rV_n, {within `[t0, b], continuous phi^~ y}}. + move => /=x xB. + by apply /continuous_subspaceW/cont1. +have cf0 : {within `[t0, b], continuous f}. + by apply /continuous_subspaceW/cf. +have cf'0 : {within `[t0, b], continuous f'}. + by apply /continuous_subspaceW/cf'. +have sol10 : is_sol_on phi (f t0) t0 (BLeft b) f. + split => //. + move => t tab. + apply sol1. + move : tab. + rewrite !inE/=!in_itv/= => /andP[+ ->]. + move => t0t;apply /andP;split=>//. + by apply /le_lt_trans/t0t. +have sol20 : is_sol_on phi (f t0) t0 (BLeft b) f'. + split => //. + move => t tab. + apply sol2. + move : tab. + rewrite !inE/=!in_itv/= => /andP[+ ->]. + move => t0t;apply /andP;split=>//. + by apply /le_lt_trans/t0t. +have := initial_solution_unique tb0 k0 lip20 cont10 cf0 . +Admitted. +Lemma solution_unique f': {within `[a,b], continuous f'} -> is_sol_on phi u0 a (BLeft b) f' -> {in `[a,b], f =1 f'}. Proof. -rewrite -!(integral_sol_iff_sol (r := r) (k:=k)) => //. -move => h1 h2 t tab. -(*have /= := cauchy_lipschitz_unique lip2 cont1 rho1.*) -Abort. +move => fc' sol2. +set E := [set t | {in `[a,t], f =1 f'}]. +suff : E b by rewrite /E/=. +have Enonempty : E !=set0. + exists a. + rewrite /E/= => t. + rewrite set_itv1 inE/= => ->. + by rewrite sol1.1 sol2.1. +have mon c : a <= c -> E c -> forall c', a <= c' <= c -> E c'. + move => ac. + rewrite /E/= => h c' /andP[ac' cc'] t. + rewrite inE => tac'. + apply h. + by rewrite inE; apply/subset_itvl/tac'. +have [hP | hP] := lem (has_sup E);last first. + have /(has_supPn Enonempty) := hP. + move /(_ b) => [x Ex bx]. + apply (mon x) => //. + rewrite ltW//. + by apply (lt_trans ab bx). + by rewrite !ltW. +have Ea : (a <= sup E). +admit. +suff : ~ sup E < b. +admit. +move => h. +Admitted. End solution_unique. @@ -1793,6 +2097,9 @@ Proof. by []. Qed. Let rho : {posnum R} := (2^-1)%:pos. +Let rho1 : rho%:num < 1. +Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. + Theorem cauchy_lipschitz_autonomous a : exists f delta, delta > 0 /\ is_sol_autonomous a (a + delta) f /\ {in `[a, a + delta], forall t, closed_ball u0 r%:num (f t)} /\ @@ -1800,9 +2107,9 @@ Theorem cauchy_lipschitz_autonomous a : exists f delta, Proof. have aa1 : a < a + 1 by rewrite ltrDl. have [d0 [solf [cball cf]]] := - cauchy_lipschitz_local aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)). + cauchy_lipschitz_local aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho1. exists (@cauchy_lipschitz_local_f R n phi_ a _ k u0 r aa1 k0 - (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1))). + (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho rho1). by exists (delta_max phi_ a (a + 1) k u0 r rho). Qed. diff --git a/ode_wip.v b/ode_wip.v index 8aba1333..30f2003f 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -457,10 +457,10 @@ have cont1'' (j : nat) : (j <= size s)%N -> {in closed_ball u0 r%:num, forall y : 'rV_n, {within [set` I j], continuous phi^~ y}}. admit. exists (@cauchy_lipschitz_local_f R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) - k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im))). + k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)) rho rho1). have [d0 [[fau0 H1] [H2 H3]]] := @cauchy_lipschitz_local R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) - k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)). + k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)) rho rho1. split => // t tab. apply H1. apply/mem_set. From bc6a28856fd1704a15605339f8f86e271d4d4806 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sun, 8 Feb 2026 13:16:20 +0900 Subject: [PATCH 095/144] generic is_sol and same is_sol in tilt --- ode.v | 79 +++++++++++++++++++++++++++++++++------------- ode_wip.v | 22 ++++++++----- tilt.v | 93 ++++++++++++++++++++++++++++--------------------------- 3 files changed, 119 insertions(+), 75 deletions(-) diff --git a/ode.v b/ode.v index c83b9f44..d4ef89b5 100644 --- a/ode.v +++ b/ode.v @@ -1273,9 +1273,14 @@ Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. Variables (phi : R -> U -> U) (u0 : U) (a : R) (b : itv_bound R) (sol : R -> U). +(*NB: b = (BLeft r) is open, + b = (BRight r) is closed, + b = +oo%R is +oo *) Definition is_sol_on := - sol a = u0 /\ - {in [set` Interval (BRight a)(*open*) b (*(BLeft b)(*open*)*)], forall x, derivable sol x 1 /\ sol^`() x = phi x (sol x)}. + [/\ sol a = u0, + {in [set` Interval (BRight a)(*open*) b], + forall x, derivable sol x 1 /\ sol^`() x = phi x (sol x)} & + {within (closure [set` Interval (BRight a) b]), continuous sol}]. End is_sol. @@ -1346,7 +1351,11 @@ Qed. Lemma integral_sol_iff_sol : is_integral_sol_on <-> is_sol_on phi u0 a (BLeft b) sol. Proof. split. -- move => [hinit h]; split => // t tab. +- move => [hinit h]. + split => //; last first. + apply: continuous_subspaceW cont_sol. + exact: itv_closure (* TODO: why not equality? *). + move=> t tab. move: (tab); rewrite inE /= in_itv /= => /andP[ta tb]. have -> : sol^`() t = (fun x => sol a + \vint[mu]_(s in `[a, x]) phi s (sol s))^`() t. apply/eq_on_itv_deriv/tab => x xt01; apply h. @@ -1884,6 +1893,13 @@ by rewrite lerDl ltW. Qed. End continuous_confined. +Definition And31 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := + let: And3 p1 p2 p3 := a in p1. +Definition And32 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := + let: And3 p1 p2 p3 := a in p2. +Definition And33 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := + let: And3 p1 p2 p3 := a in p3. + Section solution_locally_unique. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -1913,8 +1929,8 @@ suff [rho [Delta [Hrho [Db [P1 P2]]]]]: exists rho Delta : {posnum R}, exists (H move: tab; rewrite !inE/=!in_itv/= => /andP[-> h] //=. apply (le_trans h). by rewrite lerD. -have [d1 D1] := continuous_confined r ab cf sol1.1. -have [d2 D2] := continuous_confined r ab cf' sol2.1. +have [d1 D1] := continuous_confined r ab cf (And31 sol1). +have [d2 D2] := continuous_confined r ab cf' (And31 sol2). have [rho [drho1 drho2]] : exists rho, dmax rho <= (Num.min d1%:num d2%:num) /\ rho%:num < 1. rewrite /dmax/delta_max. have posk : 0 < Num.min rho_max%:num (Num.min (k * rho_max%:num) (k * (Num.min d1%:num d2%:num))). @@ -1953,12 +1969,15 @@ split. by rewrite ge_min lexx;apply /orP;left. - split; first by apply sol1. move => t0 t0ad. - have [_ + ] := sol1;apply. + have [_ + _] := sol1; apply. move : t0ad. rewrite !inE/=!in_itv/= => /andP[-> h]//=. apply: (lt_le_trans h). rewrite -lerBrDl. exact: delta_max_itv. + - apply: continuous_subspaceW cf. + apply: subset_trans; first exact: itv_closure. + by apply: subset_itvl; rewrite bnd_simp -lerBrDl delta_max_itv. - exact: tad. move => t tad. apply /esym. @@ -1977,12 +1996,13 @@ apply : cauchy_lipschitz_local_unique. by rewrite ge_min lexx;apply /orP;right. - split; first by apply sol2. move => t0 t0ad. - have [_ + ] := sol2;apply. + have [_ + _] := sol2; apply. move : t0ad. rewrite !inE/=!in_itv/= => /andP[-> h]//=. - apply: (lt_le_trans h). - rewrite -lerBrDl. - exact: delta_max_itv. + by rewrite (lt_le_trans h)// -lerBrDl delta_max_itv. +- apply/continuous_subspaceW/cf' => //. + apply: subset_trans; first exact: itv_closure. + by apply: subset_itvl; rewrite bnd_simp -lerBrDl;apply delta_max_itv. exact: tad. Qed. @@ -2050,8 +2070,8 @@ have Enonempty : E !=set0. exists a. rewrite /E/= => t. rewrite set_itv1 inE/= => ->. - by rewrite sol1.1 sol2.1. -have mon c : a <= c -> E c -> forall c', a <= c' <= c -> E c'. + by rewrite (And31 sol1) (And31 sol2). +have mon c : a <= c -> E c -> forall c', a <= c' <= c -> E c'. move => ac. rewrite /E/= => h c' /andP[ac' cc'] t. rewrite inE => tac'. @@ -2073,6 +2093,27 @@ Admitted. End solution_unique. +(* proof to be PRed to mathcomp *) +Section closure_neitv. +Context {R : realType}. +Implicit Type a b : R. + +Lemma closure_neitv_oo a b : a < b -> + closure `]a, b[%classic = `[a, b]%classic. +Proof. +move=> ab. +set c := (a + b) / 2%:R. +set d := (b - a) / 2%:R. +rewrite (_:a = c - d); last by rewrite /c/d !mulrDl addrKA mulNr opprK -splitr. +rewrite (_:b = c + d); last by rewrite addrC /c/d !mulrDl mulNr subrKA -splitr. +rewrite -ball_itv -closed_ball_itv ?closure_ballE//. +apply: divr_gt0 => //. +by rewrite subr_gt0. +Qed. + +End closure_neitv. + + Section picard_autonomous. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -2081,8 +2122,6 @@ Hypothesis k0 : 0 < k. Let B := closed_ball u0 r%:num. Hypothesis lip2 : k.-lipschitz_B phi. -Definition is_sol_autonomous a b (f : R -> U) := f a = u0 /\ - {in `]a, b[, forall x, derivable f x 1 /\ f^`() x = phi (f x)}. Definition phi_ (t : R) x := phi x. Lemma phi_lip2 a b: {in `[a, b]%R, forall x, k.-lipschitz_B (phi_ x)}. @@ -2091,17 +2130,13 @@ Proof. by move => x abx; exact: lip2. Qed. Lemma phi_cont1 a b : {in B, forall y, {within `[a, b], continuous phi_ ^~ y}}. Proof. by move => /= x Bx; exact: cst_continuous_subspace. Qed. -Lemma autonomous_solution a b f : - is_sol_autonomous a b f <-> is_sol_on phi_ u0 a (BLeft b) f. -Proof. by []. Qed. - Let rho : {posnum R} := (2^-1)%:pos. -Let rho1 : rho%:num < 1. -Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. +Let rho1 : rho%:num < 1. +Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. Theorem cauchy_lipschitz_autonomous a : exists f delta, - delta > 0 /\ is_sol_autonomous a (a + delta) f /\ + delta > 0 /\ is_sol_on (phi_) u0 a (BLeft (a + delta)) f /\ {in `[a, a + delta], forall t, closed_ball u0 r%:num (f t)} /\ {within `[a, a + delta], continuous f}. Proof. @@ -2124,7 +2159,7 @@ Hypothesis locally_lipschitz : forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. Theorem cauchy_lipschitz_ll u0 a : exists f delta r, - delta > 0 /\ is_sol_autonomous phi u0 a (a + delta) f /\ + delta > 0 /\ is_sol_on (fun=> phi) u0 a (BLeft (a + delta)) f /\ {in `[a, a + delta], forall t, closed_ball u0 r (f t)}. Proof. have [/= r [k lip]] := locally_lipschitz u0. diff --git a/ode_wip.v b/ode_wip.v index 30f2003f..8a2f004e 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -298,12 +298,17 @@ have [barhok|barhok] := leP (b - a) (rho%:num / k). apply: Hr. exact: sup_phi_ge0. exists (@lipschitzT_solution_f R n phi a b k u0 r rho rho1 ab k0 lip2 cont1). - have [d0 [[fau0 H1] [H2 H3]]] := + have [d0 [[fau0 H1] H2 [H3 H4]]] := @lipschitzT_cauchy_lipschitz_local R n phi a b k u0 r rho rho1 ab k0 lip2 cont1. - split => // t tab. - apply H1; apply/mem_set. - move/set_mem : tab. - by apply: subset_itvl; rewrite bnd_simp delta_maxba subrKC. + split => //. + move=> t tab. + apply H1; apply/mem_set. + move/set_mem : tab. + by apply: subset_itvl; rewrite bnd_simp delta_maxba subrKC. + apply: continuous_subspaceW H4. + apply: subset_trans; first exact: itv_closure. + apply: subset_itvl; rewrite bnd_simp -lerBlDl. + by rewrite delta_maxba. have @r : {posnum R}. admit. have Hr : rho%:num / k < r%:num / ((k * r%:num)%R + sup_phi phi a b u0)%E. @@ -392,7 +397,7 @@ suff: forall i, (i < size s)%N -> set K1 := Ilt _ _. set K2 := lip2'' _ _. set K3 := cont1'' _ _. - have [d0 [[H1 fiu0] [_ _]]] := + have [d0 [[H1 fiu0] _ _]] := @lipschitzT_cauchy_lipschitz_local R n phi (nth b (a :: s) x) (nth b (a :: s) x.+1) k u0 r rho rho1 K1 k0 (lip2'' _ (ltnW xs)) (cont1'' _ (ltnW xs)). rewrite -[RHS]H1. @@ -412,7 +417,7 @@ suff: forall i, (i < size s)%N -> (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)). suff : derivable f t 1. admit. - have [d0 [[fau0 H1] [_ _]]] := + have [d0 [[fau0 H1] _ _]] := @lipschitzT_cauchy_lipschitz_local R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) k u0 r rho rho1 (Ilt _ im) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)). rewrite /= in H1. @@ -447,6 +452,7 @@ suff: forall i, (i < size s)%N -> move=> ->. admit. admit. +admit. move=> i im. have Ilti1 : nth b (a :: s) i < nth b (a :: s) i.+1. by apply: Ilt. @@ -458,7 +464,7 @@ have cont1'' (j : nat) : (j <= size s)%N -> admit. exists (@cauchy_lipschitz_local_f R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)) rho rho1). -have [d0 [[fau0 H1] [H2 H3]]] := +have [d0 [[fau0 H1] H2 H3]] := @cauchy_lipschitz_local R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)) rho rho1. split => // t tab. diff --git a/tilt.v b/tilt.v index ed9253b6..d1f69894 100644 --- a/tilt.v +++ b/tilt.v @@ -6,7 +6,7 @@ From mathcomp Require Import topology normedtype landau derive realfun. From mathcomp Require Import matrix_normedtype. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. -Require Import lasalle. +Require Import ode lasalle. (**md**************************************************************************) (* # Tentative formalization of [1] *) @@ -347,18 +347,13 @@ Let B := closed_ball u0 r%:num. Definition stays_in_ball (t0 t1 : R) (f : R -> U) := {in `[t0, t1], forall t, closed_ball u0 r%:num (f t)}. -Definition is_sol_autonomous (t0 t1 : R) (f : R -> U) := - f t0 = u0 /\ - {in `]t0, t1[, forall x, derivable f x 1 /\ f^`() x = phi (f x)} /\ - {within `[t0, t1], continuous f}. - Variable k : R. Hypothesis k0 : 0 < k. Hypothesis lip2 : k.-lipschitz_B phi. Theorem picard_lindeloeff_autonomous t0 : exists sol delta, - delta > 0 /\ is_sol_autonomous t0 (t0 + delta) sol. + delta > 0 /\ is_sol_on (fun=> phi) u0 t0 (BLeft (t0 + delta)) sol. Admitted. End picard. @@ -370,23 +365,29 @@ Let U := 'rV[K]_n. Variable phi : U -> U. Definition tilt_is_sol_autonomous (Delta : K) (f : K -> U) (Init : set U) := - f 0 \in Init /\ is_sol_autonomous (f 0) phi 0 Delta f. + f 0 \in Init /\ is_sol_on (fun=> phi) (f 0) 0 (BLeft Delta) f. Definition is_global_sol (f : K -> U) (Init : set U) := f 0 \in Init /\ forall t , t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). Lemma global_sol_sol f Init : is_global_sol f Init -> forall Delta, tilt_is_sol_autonomous Delta f Init. Proof. - move => [init0 /= solP] Delta. - do 3 split =>//. - move => x. - rewrite /=inE/=in_itv/= => /andP[h _]. - apply solP. - by rewrite ltW. - apply: derivable_within_continuous. - move => x. -rewrite /=in_itv/= => /andP[h _]. -by apply solP. + move => [init0 /= solP] Delta. +split => //. +split => //. + move => x. + rewrite /=inE/=in_itv/= => /andP[h _]. + apply solP. + by rewrite ltW. +have [Delta_gt0|Delta_le0] := ltP 0 Delta. + rewrite closure_neitv_oo//. + apply: derivable_within_continuous => t t0Delta. + apply solP. + by move: t0Delta; rewrite in_itv/= => /andP[]. +rewrite set_itv_ge//. + rewrite closure0. + exact: continuous_subspace0. +by rewrite bnd_simp -leNgt. Qed. End ode. @@ -402,7 +403,7 @@ Lemma is_sol_subset f (A B : set T) : tilt_is_sol_autonomous phi Delta f A -> tilt_is_sol_autonomous phi Delta f B. Proof. move=> AB. -rewrite /tilt_is_sol_autonomous inE => -[inD0 [_ [deri cont]]]; rewrite inE. +rewrite /tilt_is_sol_autonomous inE => -[inD0 [_ deri cont]]; rewrite inE. split => //. by apply: AB. Qed. @@ -446,7 +447,7 @@ Lemma equilibrium_points_subset (A B : set T) : Proof. move=> AB x. rewrite /equilibrium_points/= /is_equilibrium_point /tilt_is_sol_autonomous inE => H Delta. -have [inD0 [deriv [cont tilt]]] := H Delta. +have [inD0 [deriv cont tilt]] := H Delta. rewrite inE; split => //. exact: AB. Qed. @@ -623,8 +624,8 @@ Let U := 'rV[K]_n.+1. Variable phi : U -> U. Variable Delta : K. Variable u0 : U. -Variable sol : K -> U. -Hypothesis solP : is_sol_autonomous u0 phi 0 Delta sol. +Variable sol : K -> U (* TODO(2026-02-08): maybe this should be U -> K -> U to match lasalle *). +Hypothesis solP : is_sol_on (fun=> phi) u0 0 (BLeft Delta) sol. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. @@ -638,7 +639,7 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. - move=> y yb. apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. rewrite -derivable1_diffP. - case: solP => /= h0Init [+ _]. + case: solP => /= h0Init + _. move/(_ y) /(_ _) => []. move: yb. rewrite inE/=. @@ -651,7 +652,7 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. move : yb; rewrite in_itv/= => /andP[->/= /lt_le_trans]; apply. exact: ltW. + rewrite -derivable1_diffP. - case: solP => /= h0Init [+ _]. + case: solP => /= h0Init + _. move/(_ y) /(_ _) => []. move: yb. rewrite inE/=. @@ -671,27 +672,27 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. apply: continuous_comp; last exact: differentiable_continuous. apply: differentiable_continuous => //. rewrite -derivable1_diffP. - case: solP => /= h0Init [+ _]. + case: solP => /= h0Init + _. move/(_ z) /(_ _) => []. move: z0b. rewrite inE/=. apply: subset_itvl. by rewrite bnd_simp ltW. by []. - + case: solP => solu0u0 [deri cont]. + + case: solP => solu0u0 deri cont. (* filled this *) + have d0 : 0 < Delta by apply /lt_trans/bDelta. + rewrite closure_neitv_oo// in cont. apply: cvg_comp. - have d0 : 0 < Delta. - by apply /lt_trans/bDelta. have /continuous_within_itvP := cont. move/(_ d0) => [_ + _]. apply. - apply (differentiable_continuous (Vdiff (sol 0))). + by apply (differentiable_continuous (Vdiff (sol 0))). + apply: cvg_at_left_filter. apply: differentiable_continuous => //. apply: differentiable_comp. rewrite -derivable1_diffP. - case: solP => /= h0Init [+ _]. + case: solP => /= h0Init + _. move/(_ b) /(_ _) => []. by rewrite inE/= in_itv/= b0 bDelta. by []. @@ -816,8 +817,9 @@ have Df_Omega_beta Delta sol : exact: ltW. move=> z _. by apply: norm_continuous. - case: solP => sol0init [_ [_]]. + case: solP => sol0init [_ _]. apply: continuous_subspaceW. + rewrite closure_neitv_oo; last by rewrite (lt_trans _ tDelta). apply: subset_itvl. by rewrite bnd_simp ltW. have : min `|sol 0| `|sol t| <= r <= max `|sol 0| `|sol t|. @@ -1550,7 +1552,7 @@ Abort.*) Lemma state_space_tiltS : state_space tilt_eqn state_space_tilt `<=` state_space_tilt. Proof. -move => p [y [Delta [[y0_init1 [/=_ [deri conti]] ]]]]. +move => p [y [Delta [[y0_init1 [/=_ deri conti] ]]]]. have [Delta0|Delta0] := leP 0 Delta; last first. rewrite /state_space/= => -[t [rt x]]. @@ -1637,6 +1639,9 @@ have norm_constant : forall t, t \in `[0,Delta] -> apply: differentiable_continuous => //. apply: differentiable_enorm_squared => /=. exact: differentiableB. + move: t0d; rewrite in_itv/= => /andP[t_ge0 tDelta]. + move: conti; rewrite closure_neitv_oo//. + by rewrite (le_lt_trans _ tDelta). suff: `|'e_2 - Right (y t)|_e ^+ 2 = 1. move => /(congr1 Num.sqrt). rewrite sqrtr1 sqr_sqrtr //. @@ -1663,7 +1668,6 @@ Proof. split. - by apply point1_in_state_space_tilt. - split => //=. - split. + move=> t t0Delta. split; first exact: derivable_cst. rewrite derive1E derive_cst /tilt_eqn_functional /point1; apply/eqP. @@ -1697,7 +1701,6 @@ Proof. split. - exact: point2_in_state_space_tilt. - split => //. - split. + move=> t t0Delta. split; first exact: derivable_cst. rewrite derive1E derive_cst; apply/eqP. @@ -1917,7 +1920,7 @@ Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : tilt_is_sol_autonomous phi Delta sol state_space_tilt -> t \in `]0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. -move=> [/= sol0in [_ [deri conti]] t0Delta]. +move=> [/= sol0in [_ deri conti] t0Delta]. have [derivable_sol] := deri _ t0Delta. move=> /(congr1 Left). rewrite derive1E. @@ -1931,7 +1934,7 @@ Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. -move=> [/= traj0 [_ [deriv conti]] z0Delta]. +move=> [/= traj0 [_ deriv conti] z0Delta]. have [derivable_sol +] := deriv _ z0Delta. move => /(congr1 Right). rewrite derive1E. @@ -1944,7 +1947,7 @@ Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : state_space_tilt (sol t). Proof. move=> t0Delta. -case => sol0 [_ [deriv_sol csol]]. +case => sol0 [_ deriv_sol csol]. move: t0Delta. rewrite in_itv/= => /andP[]. rewrite le_eqVlt => /predU1P[<- Delta0|t0 tDelta]. @@ -2176,7 +2179,7 @@ Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + 'D~(sol x) (fun x => `|Right x|_e ^+ 2 / (2 * gamma))) z <= 0. Proof. -move=> [in_init [_ [dtraj btraj]]] traj0. +move=> [in_init [_ dtraj btraj]] traj0. rewrite fctE !invfM /=. near=> z. under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. @@ -2300,7 +2303,7 @@ rewrite derive_along_V1. - move => t t0Delta. apply/derivable1_diffP => //. move : solves; rewrite /is_sol. - case => _ [_ [deri conti]]. + case => _ [_ deri conti]. by apply deri. Unshelve. all: by end_near. Abort. @@ -2542,7 +2545,7 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). assumption. + move=> /= t1 t10Delta. rewrite -derivable1_diffP. - case: solP => _ [deri _]. + case: solP => _ deri _. apply deri. by rewrite inE/= in_itv/=. + case/andP : t0 => t0 tDelta. @@ -2742,13 +2745,13 @@ split; last first. move => _ /= solA. rewrite (le_trans _ Vx)//. rewrite -[in leRHS](@initp x). - have : is_sol_autonomous x phi 0 (t+1) (sol x). + have : is_sol_on (fun=> phi) x 0 (BLeft (t+1)) (sol x). split. by rewrite initp// inE. - split. - move => t'. - rewrite inE/=in_itv/= => /andP[t0' _]. - by apply solA; rewrite ltW. + move => t'. + rewrite inE/=in_itv/= => /andP[t0' _]. + by apply solA; rewrite ltW. + rewrite closure_neitv_oo; last by rewrite ltr_wpDl. apply: derivable_within_continuous. move => x0. rewrite in_itv/= => /andP[t0' _]. From ec6abdc12a3fc3ff0f248d1eee77f38d8320a4d7 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Sun, 8 Feb 2026 20:07:09 +0900 Subject: [PATCH 096/144] solution is unique (wip) --- ode.v | 311 ++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 227 insertions(+), 84 deletions(-) diff --git a/ode.v b/ode.v index d4ef89b5..bd1480c6 100644 --- a/ode.v +++ b/ode.v @@ -2009,90 +2009,6 @@ Qed. End solution_locally_unique. -Section solution_unique. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}) (f : R -> U). -Hypothesis ab : a < b. -Hypothesis k0 : 0 < k. -Let B := closed_ball u0 r%:num. -Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. -Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. -Hypothesis cf : {within `[a, b], continuous f}. -Hypothesis sol1 : is_sol_on phi u0 a (BLeft b) f. - -Lemma unique_at_t0 f' t0: a <= t0 -> t0 < b -> {within `[a,b], continuous f'} -> is_sol_on phi u0 a (BLeft b) f' -> - f' t0 = f t0 -> exists Delta : {posnum R}, {in `[a, t0+Delta%:num], f =1 f'}. - -Proof. -move => t0a tb0 cf' sol2 ft0. -have ta : `[t0, b] `<=` `[a, b]. - move => t. - rewrite /=!in_itv/= => /andP[+ ->]//. - move => t0t;apply /andP;split=>//. - by apply /le_trans/t0t. -have lip20 :{in `[t0, b]%R, forall x : R, k.-lipschitz_B (phi x)}. - move => t t0b;apply lip2. - move : t0b; rewrite !in_itv/= => /andP[+ ->]//. - move => t0t;apply /andP;split=>//. - by apply /le_trans/t0t. -have cont10: {in B, forall y : 'rV_n, {within `[t0, b], continuous phi^~ y}}. - move => /=x xB. - by apply /continuous_subspaceW/cont1. -have cf0 : {within `[t0, b], continuous f}. - by apply /continuous_subspaceW/cf. -have cf'0 : {within `[t0, b], continuous f'}. - by apply /continuous_subspaceW/cf'. -have sol10 : is_sol_on phi (f t0) t0 (BLeft b) f. - split => //. - move => t tab. - apply sol1. - move : tab. - rewrite !inE/=!in_itv/= => /andP[+ ->]. - move => t0t;apply /andP;split=>//. - by apply /le_lt_trans/t0t. -have sol20 : is_sol_on phi (f t0) t0 (BLeft b) f'. - split => //. - move => t tab. - apply sol2. - move : tab. - rewrite !inE/=!in_itv/= => /andP[+ ->]. - move => t0t;apply /andP;split=>//. - by apply /le_lt_trans/t0t. -have := initial_solution_unique tb0 k0 lip20 cont10 cf0 . -Admitted. -Lemma solution_unique f': {within `[a,b], continuous f'} -> is_sol_on phi u0 a (BLeft b) f' -> {in `[a,b], f =1 f'}. -Proof. -move => fc' sol2. -set E := [set t | {in `[a,t], f =1 f'}]. -suff : E b by rewrite /E/=. -have Enonempty : E !=set0. - exists a. - rewrite /E/= => t. - rewrite set_itv1 inE/= => ->. - by rewrite (And31 sol1) (And31 sol2). -have mon c : a <= c -> E c -> forall c', a <= c' <= c -> E c'. - move => ac. - rewrite /E/= => h c' /andP[ac' cc'] t. - rewrite inE => tac'. - apply h. - by rewrite inE; apply/subset_itvl/tac'. -have [hP | hP] := lem (has_sup E);last first. - have /(has_supPn Enonempty) := hP. - move /(_ b) => [x Ex bx]. - apply (mon x) => //. - rewrite ltW//. - by apply (lt_trans ab bx). - by rewrite !ltW. -have Ea : (a <= sup E). -admit. -suff : ~ sup E < b. -admit. -move => h. -Admitted. - -End solution_unique. - (* proof to be PRed to mathcomp *) Section closure_neitv. Context {R : realType}. @@ -2168,3 +2084,230 @@ by exists f, delta, r%:num. Qed. End locally_lipschitz. + +Section uniqueness. +Context {R : realType} {n : nat} (a b : R). +Notation U := 'rV[R]_n. +Variables phi : U -> U. +Hypothesis ab : a < b. +Hypothesis locally_lipschitz : forall x, + exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. +Variables (u0 : U) (f : R -> U) (f' : R -> U). +Hypothesis sol1 : is_sol_on (fun => phi) u0 a (BLeft b) f. +Hypothesis sol2 : is_sol_on (fun => phi) u0 a (BLeft b) f'. + +Lemma locally_unique_at_t0 t0: a <= t0 < b -> f' t0 = f t0 + -> exists Delta : {posnum R}, {in `[t0, t0+Delta%:num], f =1 f'}. + +Proof. +move => /andP[t0a tb0] eq. +have ta : `[t0, b] `<=` `[a, b]. + move => t. + rewrite /=!in_itv/= => /andP[+ ->]//. + move => t0t;apply /andP;split=>//. + by apply /le_trans/t0t. +have [r [k L]] := locally_lipschitz (f t0). +have cf0 : {within `[t0, b], continuous f}. + have := And33 sol1. + rewrite closure_neitv_oo// => h. + by apply /continuous_subspaceW/h. +have cf'0 : {within `[t0, b], continuous f'}. + have := And33 sol2. + rewrite closure_neitv_oo// => h. + by apply /continuous_subspaceW/h. +have sol10 : is_sol_on (fun => phi) (f t0) t0 (BLeft b) f. + split => //; last by rewrite closure_neitv_oo//. + move => t tab. + apply sol1. + move : tab. + rewrite !inE/=!in_itv/= => /andP[+ ->]. + move => t0t;apply /andP;split=>//. + by apply /le_lt_trans/t0t. +have sol20 : is_sol_on (fun => phi) (f t0) t0 (BLeft b) f'. + split => //; last by rewrite closure_neitv_oo//. + move => t tab. + apply sol2. + move : tab. + rewrite !inE/=!in_itv/= => /andP[+ ->]. + move => t0t;apply /andP;split=>//. + by apply /le_lt_trans/t0t. +have lip20 : {in `[t0, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t0) r%:num) phi}. + by move => t _;apply L. +have k0 : 0 < k%:num by []. +have cont1: {in closed_ball (f t0) r%:num, forall y : 'rV_n, {within `[t0, b], continuous fun=> phi y}}. + move => y _;exact: cst_continuous_subspace. +have [D [P1 P2]]:= initial_solution_unique tb0 k0 lip20 cont1 cf0 sol10 cf'0 sol20. +by exists D. +Qed. + +Lemma solution_unique : {in `[a,b], f =1 f'}. +Proof. +set E := [set t | t \in `[a,b]%R /\ {in `[a,t], f =1 f'}]. +suff : E b by rewrite /E/= => -[]. +have Enonempty : E !=set0. + exists a. + rewrite /E/=;split; first by rewrite in_itv/=lexx ltW. + move => t. + rewrite set_itv1 inE/= => ->. + by rewrite (And31 sol1) (And31 sol2). +have mon c : E c -> forall c', a <= c' <= c -> E c'. + rewrite /E/= => -[+ h c'] /andP[ac' cc']. + rewrite /in_itv/= => /andP[c1 c2]. + split. + by apply: (subset_itvl c2); rewrite /=in_itv/= ac' cc'. + move => t. + rewrite inE => tac'. + apply h. + by rewrite inE; apply/subset_itvl/tac'. + +have monC c c' : a <= c' -> E c -> ~ E c' -> c < c'. + move => h Ec nEc'. + have [] := leP c' c => //. + move => h'. + rewrite falseE. + apply nEc'. + apply: (mon c) => //. + by apply /andP;split. + +have [hP | hP] := lem (has_sup E);last first. + have /(has_supPn Enonempty) := hP. + move /(_ b) => [x Ex bx]. + apply (mon x) => //. + by rewrite !ltW//. +have Eclosed : closed E. + have -> : E = `[a,b] `&` [set t | t \in `[a,b]%R -> {in `[a,t], f =1 f'}]. + by apply /seteqP;split => x [xab x1];split => //;apply x1. + apply closedI. + by apply: itv_closed. + rewrite /closed/closure/=. + move => t /= tb. + rewrite /E. + move => tab. + move => t0 t0t. + apply /not_notP. + move => hf. + set E' := [set t | t \in `[a, b]%R -> {in `[a, t], f =1 f'}] . + suff: exists B, nbhs t B /\ E' `&` B =set0. + move => [B [B1 B2]]. + have := tb B B1. + rewrite B2. + by case => //. + move : t0t. + rewrite inE/=in_itv/= => /andP[at0 ]. + rewrite le_eqVlt => /orP[/eqP tt0 | tt0];last first. + exists (ball t (t- t0)). + split. + apply: nbhsx_ballx. + by rewrite subr_gt0. + rewrite /E'. + apply disjoints_subset => x Ex Bx. + have : t0 < x. + admit. + admit. + set g := fun x => `|f x - f' x|. + have contg : {within `[a,b], continuous g}. + admit. + have g0 x : x \in `[a, b]%R -> (g x > 0) -> ~ E' x. + rewrite /E'/= => -Ex1 + Ex2. + suff -> : g x = 0 by rewrite ltxx. + rewrite /g. + apply /normr0P. + rewrite Ex2 =>//. + by rewrite subrr. + move : Ex1. + by rewrite in_itv/=!inE/=!in_itv/= lexx => /andP[-> _]. + have ggt0 : (g t0 > 0). + rewrite normr_gt0. + apply /eqP. + move /subr0_eq => h. + by apply hf. + rewrite -tt0. + suff : \forall x \near t0^'-, 0 < g x. + move => [e eps0 Be]. + exists (ball t0 e). + split; first by apply:nbhsx_ballx. + apply disjoints_subset => x Ex Bx. + suff : ~ E' x by []. + rewrite /E'. + apply g0. + admit. + apply Be => //. + apply: monC => //. + split => //. + admit. + apply Ex. + admit. + rewrite /E/=. + rewrite tt0 tab //= not_andE;right. + have tat : t \in `[a, t]. + by rewrite inE /=in_itv/=lexx//= -tt0 at0. + move /(_ t tat). + rewrite -tt0 => -h. + move : ggt0. + by rewrite /g h subrr normr0. + (* move : t0t. *) + (* by rewrite inE/=in_itv/= => /andP[]. *) + (* by apply g0. *) + (* have []:= (Be x Bx). *) + (* have *) + (* suff [eps [e0 Heps]] : exists (eps : R), eps > 0 /\ forall (t : R), t < t0 -> ball t0 eps t -> 0 < g t. *) + (* exists (ball t0 eps). *) + (* split; first by apply:nbhsx_ballx. *) + (* apply disjoints_subset => x Ex Bx. *) + (* suff : ~ E' x by []. *) + (* apply g0. *) + (* apply Heps => //. *) + (* apply: monC => //. *) + (* move : t0t. *) + (* by rewrite inE/=in_itv/= => /andP[]. *) + (* by apply g0. *) + have at0' : (a < t0). + admit. + Search prop_near1 (_ < _). + have rcont : g x @[x --> t0^'-] --> g t0. + move => t1 t1ab /=. + admit. + by apply: (cvgr_gt _ rcont). +have supE : E (sup E). + rewrite {1}(closure_id E).1 //. + apply: closure_sup => //. + by apply hP. +have sup_itv : (a <= sup E). + apply sup_upper_bound => //. + rewrite /E/=;split; first by rewrite in_itv/=lexx ltW. + move => t. + rewrite set_itv1 inE/= => ->. + by rewrite (And31 sol1) (And31 sol2). +have supeq : f' (sup E) = f (sup E). + apply /esym. + apply supE. + by rewrite inE/= in_itv/= lexx sup_itv//=. +have [h|h] := leP b (sup E). + apply: (mon _ supE) => //. + by apply /andP; rewrite ltW. +have [| Delta Hdelta] := locally_unique_at_t0 _ supeq; first by apply /andP. +have Delta0 : 0 < Delta%:num by []. +suff : Num.min b (sup E + Delta%:num) <= sup E. + rewrite ge_min => /orP[]. + move => h0. + suff : b < b by rewrite ltxx. + by apply (le_lt_trans h0 h). + rewrite gerDl. + rewrite ltNge in Delta0. + by have /negP := Delta0. +apply sup_upper_bound => //. +split. + rewrite in_itv/=. + apply /andP;split. + rewrite le_min; apply /andP;split; first by apply ltW. + apply (le_trans sup_itv). + by rewrite lerDl. + by rewrite ge_min lexx. +move => t. +rewrite inE/=in_itv/= => -/andP[t1 t2]. +have [ht | ht] := leP t (sup E). + by apply supE; rewrite inE/=in_itv/= t1 ht. +apply Hdelta; rewrite inE/=in_itv/= ltW // (le_trans t2)// ge_min lexx. +by apply /orP;right. +Admitted. +End uniqueness. From 2bd2660db56597e6d8f9e2eb7b4bc115e6215f72 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Mon, 9 Feb 2026 13:17:57 +0900 Subject: [PATCH 097/144] uniqueness --- ode.v | 218 ++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 129 insertions(+), 89 deletions(-) diff --git a/ode.v b/ode.v index bd1480c6..dbd2e76a 100644 --- a/ode.v +++ b/ode.v @@ -2150,6 +2150,7 @@ have Enonempty : E !=set0. move => t. rewrite set_itv1 inE/= => ->. by rewrite (And31 sol1) (And31 sol2). + have mon c : E c -> forall c', a <= c' <= c -> E c'. rewrite /E/= => -[+ h c'] /andP[ac' cc']. rewrite /in_itv/= => /andP[c1 c2]. @@ -2174,100 +2175,138 @@ have [hP | hP] := lem (has_sup E);last first. move /(_ b) => [x Ex bx]. apply (mon x) => //. by rewrite !ltW//. + have Eclosed : closed E. - have -> : E = `[a,b] `&` [set t | t \in `[a,b]%R -> {in `[a,t], f =1 f'}]. - by apply /seteqP;split => x [xab x1];split => //;apply x1. - apply closedI. - by apply: itv_closed. - rewrite /closed/closure/=. - move => t /= tb. - rewrite /E. - move => tab. - move => t0 t0t. - apply /not_notP. - move => hf. - set E' := [set t | t \in `[a, b]%R -> {in `[a, t], f =1 f'}] . - suff: exists B, nbhs t B /\ E' `&` B =set0. - move => [B [B1 B2]]. - have := tb B B1. - rewrite B2. - by case => //. - move : t0t. - rewrite inE/=in_itv/= => /andP[at0 ]. - rewrite le_eqVlt => /orP[/eqP tt0 | tt0];last first. - exists (ball t (t- t0)). - split. - apply: nbhsx_ballx. - by rewrite subr_gt0. - rewrite /E'. - apply disjoints_subset => x Ex Bx. - have : t0 < x. - admit. - admit. - set g := fun x => `|f x - f' x|. - have contg : {within `[a,b], continuous g}. - admit. - have g0 x : x \in `[a, b]%R -> (g x > 0) -> ~ E' x. - rewrite /E'/= => -Ex1 + Ex2. - suff -> : g x = 0 by rewrite ltxx. +(* have Ei : E = `[a,b] `&` [set t | t \in `[a,b]%R -> {in `[a,t], f =1 f'}]. *) +(* by apply /seteqP;split => x [xab x1];split => //;apply x1. *) +(* rewrite Ei. *) +(* apply closedI. *) +(* exact: itv_closed. *) + rewrite closedE/= => p pn. + (* rewrite Ei. *) + (* apply closedI. *) + (* admit. *) + suff : forall x, ~ E x -> \forall y \near x, ~ E y. + move => H. + apply /not_notP => Ec. + apply pn. + by apply H. + move => x Ex1. + have [xab | xnab ] := boolP (x \in `[a,b]%R); last first. + suff : \forall y \near x, ~ (y \in `[a,b]%R). + move => h. + near=>y. + rewrite not_andP;left. + near:y. + by []. + move : xnab. + rewrite in_itv/= negb_and/= -!ltNge => /orP[xa | xb]. + near=>y. + apply /negP. + rewrite in_itv/=negb_and/= -!ltNge. + apply /orP;left. + near:y. + exact: lt_nbhsl. + near=>y. + apply /negP. + rewrite in_itv/=negb_and/= -!ltNge. + apply /orP;right. + near:y. + exact: lt_nbhsr. + rewrite not_andP in Ex1. + case Ex1 => // {}Ex1. + have [t Et]: exists t, t \in `[a,x] /\ ~ (f t = f' t). + rewrite not_existsP => h. + apply Ex1. + move => t tax. + have := (h t). + rewrite not_andP => -[]//. + by move /contrapT. + have [xt | xt]:= eqVneq x t. + subst t. + set g := fun x => `|f x - f' x|. + have contg : {within `[a,b], continuous g}. + apply : within_continuous_comp_norm. + by apply ltW. + move => t. + apply: continuousB. + have := (And33 sol1). + rewrite closure_neitv_oo//. + apply. + have := (And33 sol2). + rewrite closure_neitv_oo//. + apply. + have g0x : g x > 0. + rewrite normr_gt0 subr_eq0. + apply /eqP. + by case : Et. + have g0 t : t \in `[a, b]%R -> (g t > 0) -> ~ {in `[a, t], f =1 f'}. + move => tab gt Et'. + move : gt. + suff -> : g t = 0 by rewrite ltxx. rewrite /g. apply /normr0P. - rewrite Ex2 =>//. - by rewrite subrr. - move : Ex1. - by rewrite in_itv/=!inE/=!in_itv/= lexx => /andP[-> _]. - have ggt0 : (g t0 > 0). - rewrite normr_gt0. - apply /eqP. - move /subr0_eq => h. - by apply hf. - rewrite -tt0. - suff : \forall x \near t0^'-, 0 < g x. - move => [e eps0 Be]. - exists (ball t0 e). - split; first by apply:nbhsx_ballx. - apply disjoints_subset => x Ex Bx. - suff : ~ E' x by []. - rewrite /E'. - apply g0. - admit. - apply Be => //. - apply: monC => //. - split => //. - admit. - apply Ex. + rewrite Et'; first by rewrite subrr. + move : tab. + by rewrite in_itv/=inE/=!in_itv/= lexx => /andP[-> _]. + suff hgx: \forall y \near x^'-, 0 < g y. + near=>y. + have [] := ltP y x;last first. + move => xy Ey. + have := mon _ Ey x. + move : xab. + rewrite /=in_itv/= xy => /andP[-> _] //. + move => /(_ isT). + case. + done. + move => yx. + apply /not_andP. + rewrite -implyE => yab. + apply g0 => //. + move : yx. + by near:y. + have := @cvgr_gt R R (nbhs x^'-) _ g (g x). + apply => //. + have xa : a < x. + move : Ex1. + rewrite ltNge. + apply contra_notN. + move : xab. + rewrite in_itv/= => /andP[+ _ ]. + move => h1 h2. + have := eq_le a x. + rewrite h1 h2 /=. + move => /eqP <-. + move => y. + rewrite set_itv1/=inE/= => ->. + by rewrite (And31 sol1) (And31 sol2). + have /(continuous_within_itvP _ ab) := contg => -[h1 _ h2]. + move : xab. + rewrite in_itv/= => /andP[_ ]. + rewrite le_eqVlt => /predU1P[-> // | xb ]. + apply cvg_at_left_filter. + apply h1. + by rewrite in_itv/= xb xa. + have xt' : t < x. + case : Et. + rewrite inE/=in_itv/= => /andP[_ ]. + by rewrite le_eqVlt eq_sym (negbTE xt) . + near=> y. + move => Ey. + have : (~ E t). + rewrite not_andP. + right. + move => /(_ t). + admit. + have ta : a <= t. admit. - rewrite /E/=. - rewrite tt0 tab //= not_andE;right. - have tat : t \in `[a, t]. - by rewrite inE /=in_itv/=lexx//= -tt0 at0. - move /(_ t tat). - rewrite -tt0 => -h. - move : ggt0. - by rewrite /g h subrr normr0. - (* move : t0t. *) - (* by rewrite inE/=in_itv/= => /andP[]. *) - (* by apply g0. *) - (* have []:= (Be x Bx). *) - (* have *) - (* suff [eps [e0 Heps]] : exists (eps : R), eps > 0 /\ forall (t : R), t < t0 -> ball t0 eps t -> 0 < g t. *) - (* exists (ball t0 eps). *) - (* split; first by apply:nbhsx_ballx. *) - (* apply disjoints_subset => x Ex Bx. *) - (* suff : ~ E' x by []. *) - (* apply g0. *) - (* apply Heps => //. *) - (* apply: monC => //. *) - (* move : t0t. *) - (* by rewrite inE/=in_itv/= => /andP[]. *) - (* by apply g0. *) - have at0' : (a < t0). + have := (monC y t ta Ey). + move => /[apply]. + apply /negP. + rewrite -leNgt. + apply ltW. + near:y. admit. - Search prop_near1 (_ < _). - have rcont : g x @[x --> t0^'-] --> g t0. - move => t1 t1ab /=. - admit. - by apply: (cvgr_gt _ rcont). have supE : E (sup E). rewrite {1}(closure_id E).1 //. apply: closure_sup => //. @@ -2285,6 +2324,7 @@ have supeq : f' (sup E) = f (sup E). have [h|h] := leP b (sup E). apply: (mon _ supE) => //. by apply /andP; rewrite ltW. + have [| Delta Hdelta] := locally_unique_at_t0 _ supeq; first by apply /andP. have Delta0 : 0 < Delta%:num by []. suff : Num.min b (sup E + Delta%:num) <= sup E. From d87c05fd578a21315d5b0f11eb3511f821851b15 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 9 Feb 2026 17:58:36 +0900 Subject: [PATCH 098/144] complete uniqueness, two small admits in tilt, cleaning --- ode.v | 651 +++++++++++++----------------- tilt.v | 1220 ++++++++++++++++++++++++++------------------------------ 2 files changed, 841 insertions(+), 1030 deletions(-) diff --git a/ode.v b/ode.v index dbd2e76a..c0e41339 100644 --- a/ode.v +++ b/ode.v @@ -1,4 +1,3 @@ -(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. From mathcomp Require Import archimedean generic_quotient ring_quotient. @@ -1284,11 +1283,22 @@ Definition is_sol_on := End is_sol. +Section is_integral_sol. +Local Notation mu := lebesgue_measure. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (u0 : U) (a b : R) (sol : R -> U). + +Definition is_integral_sol_on := sol a = u0 /\ + forall t, t \in `[a, b] -> sol t = sol a + (\vint[mu]_(s in `[a, t]) phi s (sol s))%R. + +End is_integral_sol. + Section integral_ode. Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (a b : R) (u0 : U) (sol : R -> U) (k : R) (r : {posnum R}). +Variables (phi : R -> U -> U) (u0 : U) (a b : R) (sol : R -> U) (k : R) (r : {posnum R}). Hypothesis k0 : 0 < k. Hypothesis ab : a < b. @@ -1298,26 +1308,6 @@ Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Hypothesis cont_sol : {within `[a, b], continuous sol}. Hypothesis sol_bound : sol @` `[a, b] `<=` closed_ball u0 r%:num. -Definition is_integral_sol_on := sol a = u0 /\ - forall t, `[a, b] t -> sol t = sol a + (\vint[mu]_(s in `[a, t]) phi s (sol s))%R. - -(* Definition is_integral_sol_on_open := *) -(* phi t0 = u0 /\ *) -(* forall t, `]t0, t1[ t -> *) -(* phi t = phi t0 + (\vint[mu]_(s in `[t0, t]) f s (phi s))%R. *) - -(* Lemma integral_sol_open_closed : is_integral_sol_on_open -> is_integral_sol_on. *) -(* Proof. *) -(* move => [h0 h1]. *) -(* split => //. *) -(* move => t. *) -(* case: (eqVneq t t0) => [-> _|Ht0]. *) -(* by rewrite set_itv1 rowRintegral_set1 addr0. *) -(* rewrite /=in_itv/= => /andP [ht0 ht1]. *) -(* apply h1. *) -(* by rewrite /=in_itv/=ht1//= lt_neqAle ht0/= eq_sym Ht0. *) -(* Qed. *) - Lemma picard_iterator_within_continuous i : {within `[a, b], continuous (fun x => phi x (sol x) ord0 i)}. Proof. @@ -1333,14 +1323,6 @@ rewrite inE => /within_continuous_continuous; apply => //. exact: picard_iterator_within_continuous. Qed. -(* Lemma Rintegral_itv_open_closed (a b : R) (g : R -> R) : *) -(* \int[mu]_(x in `]a, b[) g x *) -(* = \int[mu]_(x in `[a, b]) g x. *) -(* Proof. *) -(* rewrite Rintegral_itv_obnd_cbnd. *) -(* rewrite Rintegral_itv_bndo_bndc //. *) -(* Admitted. *) - Lemma picard_iterator_integrable i : mu.-integrable `[a, b] (EFin \o (fun x : R => phi x (sol x) ord0 i)). Proof. @@ -1348,7 +1330,7 @@ apply: continuous_compact_integrable; first exact: segment_compact. exact: picard_iterator_within_continuous. Qed. -Lemma integral_sol_iff_sol : is_integral_sol_on <-> is_sol_on phi u0 a (BLeft b) sol. +Lemma integral_sol_iff_sol : is_integral_sol_on phi u0 a b sol <-> is_sol_on phi u0 a (BLeft b) sol. Proof. split. - move => [hinit h]. @@ -1359,12 +1341,9 @@ split. move: (tab); rewrite inE /= in_itv /= => /andP[ta tb]. have -> : sol^`() t = (fun x => sol a + \vint[mu]_(s in `[a, x]) phi s (sol s))^`() t. apply/eq_on_itv_deriv/tab => x xt01; apply h. - rewrite inE in xt01. + rewrite inE/= in xt01. + rewrite inE/=. exact: subset_itv_oo_cc. - (* move : xt01 . *) - (* Search "itv" "subs". *) - (* rewrite inE/=!in_itv/= => /andP [xt01 xt01']. *) - (* by rewrite ltW. *) suff hi : forall i, derivable (fun x => sol x ord0 i) t 1 /\ (fun x : R => (sol a + \vint[mu]_(s in `[a, x]) phi s (sol s))%E)^`() t ord0 i = phi t (sol t) ord0 i. @@ -1393,7 +1372,7 @@ split. apply: (near_eq_derivable (f := (fun x => (sol a + \vint[mu]_(s in `[a, x]) phi s (sol s)) ord0 j))) => //=. near=> t'. - rewrite (h t') //= in_itv/=. + rewrite (h t') //= inE/= in_itv/=. apply/andP; split. - by apply: ltW; near: t'; exact: lt_nbhsr. - by apply: ltW; near: t'; exact: lt_nbhsl. @@ -1408,7 +1387,7 @@ split. congr ('D_1 _ t). by apply/funext => t'; rewrite mxE. move => [hinit h]; split => // t tab. -have /= := tab; rewrite in_itv/= => /andP[ta tb]. +have /= := tab; rewrite inE/= in_itv/= => /andP[ta tb]. apply/rowP => i. rewrite mxE rowRintegralE. move: ta; rewrite le_eqVlt => /predU1P[<-|ta]. @@ -1499,11 +1478,11 @@ by move=> Hg taad; rewrite eval_mod_on_itv//; exact: picard_funE. Qed. Lemma cauchy_lipschitz_integral_version : - is_integral_sol_on f a (a + delta_max) u0 picard_fix. + is_integral_sol_on f u0 a (a + delta_max) picard_fix. Proof. split; first exact: picard_fix_init. move=> t tad. -rewrite {1}picard_fixE eval_mod_on_itv; last by rewrite inE. +rewrite {1}picard_fixE eval_mod_on_itv//. rewrite picard_fix_init. exact: picard_funE img_cball_picard_fix. Qed. @@ -1640,9 +1619,9 @@ Hypothesis cont1 : {within `[a, b], continuous (fun x => phi x (sol1 x))}. Hypothesis cont2 : {within `[b, c], continuous (fun x => phi x (sol2 x))}. Hypothesis matchb : sol1 b = sol2 b. -Lemma solution_extends : is_integral_sol_on phi a b u0 sol1 -> - is_integral_sol_on phi b c (sol1 b) sol2 -> - is_integral_sol_on phi a c u0 (patch sol2 `[a, b] sol1). +Lemma solution_extends : is_integral_sol_on phi u0 a b sol1 -> + is_integral_sol_on phi (sol1 b) b c sol2 -> + is_integral_sol_on phi u0 a c (patch sol2 `[a, b] sol1). Proof. move => [p0a p0s ] [p1a p1s]. have h0 : patch sol2 `[a, b] sol1 a = u0. @@ -1655,7 +1634,6 @@ rewrite h0. move => t tac. rewrite /patch. case: ifPn => [xK | xKnot] => /=. - rewrite inE in xK. rewrite p0s // p0a. apply /rowP => i. rewrite !mxE. @@ -1675,7 +1653,7 @@ have tbc : t \in `[b, c]. by move : h1;rewrite h2. rewrite (rowRintegral_itv_split (c := b) (F := (fun x => phi x (patch sol2 `[a, b] sol1 x)))). - rewrite inE in tbc. - rewrite p1s //. + rewrite p1s//; last by rewrite inE. suff : sol2 b = u0 + \vint[lebesgue_measure]_(s in `[a, b]) phi s (patch sol2 `[a, b] sol1 s). rewrite /GRing.add /= addmxA => ->;congr (addmx _). apply eq_rowRintegral => /= x xbt. @@ -1686,9 +1664,9 @@ rewrite (rowRintegral_itv_split (c := b) (F := (fun x => phi x (patch sol2 `[a, suff -> : x = b by rewrite p1a. apply le_anti. by rewrite xleb. - rewrite p1a p0s;last by rewrite /=in_itv/=ltW//=. + rewrite p1a p0s;last by rewrite inE/= in_itv/=ltW/=. rewrite p0a. - congr (_ + _)%E. + congr (u0 + _)%E. rewrite /patch. by apply eq_rowRintegral => /= x ->. - by rewrite ltW //=; move : tbc; rewrite inE /= in_itv /= => /andP [-> _]. @@ -1758,7 +1736,7 @@ Local Notation delta_max := (delta_max phi a b k u0 r rho). Lemma solution_local_solution : is_sol_on phi u0 a (BLeft (a + delta_max)) local_solution. Proof. -apply /(integral_sol_iff_sol (k:=k) (r:=r)) => //. +apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. - exact: ltDl_delta_max. - move=> t td. apply: lip2. @@ -1803,96 +1781,88 @@ Qed. Local Notation V := (Cont_on_seg_quot.quot_continuousFunType (@leDl_delta_max _ _ phi a b k ab u0 r k0 rho)). Theorem cauchy_lipschitz_local_unique f' : - {within `[a,a+delta_max], continuous f'} -> + {within `[a, a + delta_max], continuous f'} -> {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f' t)} -> is_sol_on phi u0 a (BLeft (a + delta_max)) f' -> {in `[a, a + delta_max], f =1 f'}. Proof. move => cont bnd. -move /(integral_sol_iff_sol k0 (r:=r) ) => []//. +move/(@integral_sol_iff_sol _ _ _ _ _ _ _ _ r k0) => []//. - exact: ltDl_delta_max. - move=> t td. apply: lip2. - move: td; rewrite /=!in_itv/= => /andP [-> h] /=. - by rewrite (le_trans h)// -lerBrDl; exact: delta_max_itv. -- move=> /= x xB . + by apply: subset_itvl td; rewrite bnd_simp -lerBrDl delta_max_itv. +- move=> /= x xB. apply/continuous_subspaceW/cont1 => //. - apply: subset_itvl => //=. - by rewrite bnd_simp -lerBrDl delta_max_itv. + by apply: subset_itvl => //=; rewrite bnd_simp -lerBrDl delta_max_itv. - by move => _ [t tad] <-;apply bnd;rewrite inE. -move => h0 h1. -move => t tab. -have fc : cont_on_seg a (a+delta_max) f'. - by apply mem_set. -have pieq : \pi_V%qT f = \pi_V%qT (cont_on_seg_Sub fc). +move=> f'au0 h1 t tab. +have fc : cont_on_seg a (a + delta_max) f' by exact: mem_set. +have pieq : \pi_V%qT f = \pi_V%qT (cont_on_seg_Sub fc). rewrite reprK. apply: cauchy_lipschitz_unique. move => /= _ [t' tad' ] <- /=. rewrite /Cont_on_seg_quot.quot_continuousFunType_to_fun. suff -> : (repr (\pi_V%qT (cont_on_seg_Sub fc))) t' = f' t'. - by apply bnd;rewrite inE. - by apply Cont_on_seg_quot.eval_mod_on_itv;rewrite inE. - move => t0. - rewrite inE => -t0ad. - rewrite Cont_on_seg_quot.eval_mod_on_itv //=; last by rewrite inE. - rewrite h1// h0. - apply congr1. + by apply: bnd; rewrite inE. + by apply: Cont_on_seg_quot.eval_mod_on_itv; rewrite inE. + move=> t0 t0ad. + rewrite Cont_on_seg_quot.eval_mod_on_itv //=. + rewrite h1//. + rewrite f'au0; congr (u0 + _). apply: eq_rowRintegral => t' tad'. rewrite Cont_on_seg_quot.eval_mod_on_itv //=. - move: tad'. - rewrite! inE. - apply: subset_itvl. - move : t0ad. - by rewrite /=in_itv/= => /andP[]. + move: tad'; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp. + rewrite inE/= in t0ad. + by move/itvP : t0ad => ->. suff -> : f t = (Cont_on_seg_quot.quot_continuousFunType_to_fun (\pi_V%qT (cont_on_seg_Sub fc))) t. by rewrite /Cont_on_seg_quot.quot_continuousFunType_to_fun/=;apply Cont_on_seg_quot.eval_mod_on_itv. rewrite -pieq. by rewrite Cont_on_seg_quot.eval_mod_on_itv. Qed. + End cauchy_lipschitz_local. + Section continuous_confined. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. Variables (a b : R) (u0 : U) (r : {posnum R}). Hypothesis ab : a < b. Let B := closed_ball u0 r%:num. -Local Lemma continuous_confined (g : R -> U) : {within `[a, b], continuous g} -> (g a) = u0 -> exists Delta:{posnum R}, {in `[a, a + Delta%:num ], forall t, (g t) \in B}. + +Local Lemma continuous_confined (g : R -> U) : {within `[a, b], continuous g} -> + g a = u0 -> + exists Delta : {posnum R}, {in `[a, a + Delta%:num], forall t, g t \in B}. Proof. -move /(continuous_within_itvP _ ab) => [cc cl cr] g0. +move /(continuous_within_itvP _ ab) => [cc cl cr] g0. have : {within `[a,b], continuous (fun t => `| u0 - g t |) }. - apply: within_continuous_comp_norm. + apply: within_continuous_comp_norm. by rewrite ltW. - apply/ continuous_within_itvP => //=. + apply/continuous_within_itvP => //=. split. - move => t tab. - apply: (cvgB (cvg_cst _) (cc _ tab)). - apply: (cvgB (cvg_cst _) cl). - apply: (cvgB (cvg_cst _) cr). -move /(continuous_within_itvP _ ab) => [_ /cvgrPdist_le + _]. -move /(_ r%:num). -case => // Delta /= Delta0. + - move => t tab. + exact: (cvgB (cvg_cst _) (cc _ tab)). + - exact: (cvgB (cvg_cst _) cl). + - exact: (cvgB (cvg_cst _) cr). +move/(continuous_within_itvP _ ab) => [_ /cvgrPdist_le + _]. +move=> /(_ r%:num). +case=> // Delta /= Delta0. rewrite /ball_/= g0 subrr normr0/= => H. -have D20: (0 < Delta / 2) by rewrite divr_gt0. -exists (PosNum D20). -move => t tab. -move : tab. -rewrite inE /=in_itv/= => /andP[]. -rewrite le_eqVlt => /orP[/eqP <- | ]. - rewrite g0 /B inE => _;by apply: closed_ballxx. -move => ta td. -have /=:= (H t). +have D20 : (0 < Delta / 2) by rewrite divr_gt0. +exists (PosNum D20) => t. +rewrite inE/= in_itv/= => /andP[]. +rewrite le_eqVlt => /predU1P[<-|ta td]. + by rewrite g0 /B inE => _; exact: closed_ballxx. +have /= := H t. rewrite add0r normrN normr_id. -rewrite inE /B closed_ballE/closed_ball_//=;apply =>//. -rewrite ltr_distl. -apply /andP;split. -rewrite ltrBlDr. -apply (le_lt_trans td). - by rewrite ler_ltD// ltr_pdivrMr// ltr_pMr// ltrDl. -apply (lt_le_trans ta). -by rewrite lerDl ltW. +rewrite inE /B closed_ballE /closed_ball_//=; apply => //. +rewrite ltr0_norm ?subr_lt0// opprB ltrBlDl. +by rewrite (le_lt_trans td)// ltrD2l gtr_pMr// invf_lt1// ltr1n. Qed. + End continuous_confined. +(* TODO: move *) Definition And31 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := let: And3 p1 p2 p3 := a in p1. Definition And32 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := @@ -1916,90 +1886,66 @@ Let rho_max : {posnum R} := (2^-1)%:pos. Let dmax rho := delta_max phi a b k u0 r rho. Let fc := local_solution ab k0 lip2 cont1. -Lemma initial_solution_unique f' :{within `[a,b], continuous f'} -> +Lemma initial_solution_unique f' : {within `[a, b], continuous f'} -> is_sol_on phi u0 a (BLeft b) f' -> - exists Delta : {posnum R}, {in `[a, a+Delta%:num], f =1 f'} /\ - {in `[a, a + Delta%:num], forall t, closed_ball u0 r%:num (f t)}. + exists Delta : {posnum R}, {in `[a, a + Delta%:num], f =1 f'} /\ + {in `[a, a + Delta%:num], forall t, closed_ball u0 r%:num (f t)}. Proof. move => cf' sol2. -suff [rho [Delta [Hrho [Db [P1 P2]]]]]: exists rho Delta : {posnum R}, exists (Hrho : (rho%:num < 1)) , Delta%:num <= dmax rho /\ {in `[a, a+Delta%:num], f =1 fc Hrho } /\ {in `[a, a+Delta%:num], f' =1 fc Hrho } . - exists Delta; split => t tab; first by rewrite P1 // P2. - rewrite P1 //. - apply solution_stays_in_ball. - move: tab; rewrite !inE/=!in_itv/= => /andP[-> h] //=. - apply (le_trans h). - by rewrite lerD. +suff [rho [Delta [Hrho [Db P1 P2]]]] : exists rho Delta : {posnum R}, exists (Hrho : rho%:num < 1), + [/\ Delta%:num <= dmax rho, + {in `[a, a + Delta%:num], f =1 fc Hrho } & + {in `[a, a + Delta%:num], f' =1 fc Hrho} ]. + exists Delta; split => t tab; first by rewrite P1// P2. + rewrite P1//. + apply: solution_stays_in_ball. + by move: tab; rewrite !inE; apply: subset_itvl; rewrite bnd_simp lerD2l. have [d1 D1] := continuous_confined r ab cf (And31 sol1). have [d2 D2] := continuous_confined r ab cf' (And31 sol2). -have [rho [drho1 drho2]] : exists rho, dmax rho <= (Num.min d1%:num d2%:num) /\ rho%:num < 1. +have [rho [drho1 drho2]] : exists rho, dmax rho <= (Num.min d1%:num d2%:num) /\ rho%:num < 1. rewrite /dmax/delta_max. have posk : 0 < Num.min rho_max%:num (Num.min (k * rho_max%:num) (k * (Num.min d1%:num d2%:num))). - rewrite lt_min; apply /andP;split=>//. - rewrite lt_min; apply /andP;split=>//. - by apply mulr_gt0. - by apply mulr_gt0. - exists (PosNum posk). - split => //=. - rewrite !ge_min //=;apply /orP;right;apply /orP;right. - rewrite !minr_pMl //= ?invr_ge0 //; try by rewrite ltW. - rewrite ge_min; apply /orP;right. - rewrite ge_min; apply /orP; right. - by rewrite mulrC mulrA mulVr ?unitfE ?mul1r // ?gt_eqF. - rewrite gt_min; apply /orP;left. - by rewrite invf_lt1 // ltrDl. -have drho_pos : 0 < dmax rho. - by apply delta_max_gt0. -exists rho, (PosNum drho_pos), drho2. -split => //. -split. - move => t tad. - apply /esym. - apply : cauchy_lipschitz_local_unique. + by rewrite lt_min/= invr_gt0// ltr0n/= lt_min divr_gt0//= mulr_gt0. + exists (PosNum posk); split => //=. + rewrite !ge_min/= minA; apply/orP; right. + rewrite !minr_pMl//=; [|by rewrite ltW// invr_gt0..]. + do 2 rewrite ge_min; apply/orP; right. + apply/orP; right. + by rewrite mulrAC divff ?mul1r// gt_eqF//. + by rewrite gt_min; apply/orP; left; rewrite invf_lt1// ltr1n. +have drho_pos : 0 < dmax rho by exact: delta_max_gt0. +exists rho, (PosNum drho_pos), drho2; split => //. +- move => t tad. + apply/esym; apply: cauchy_lipschitz_local_unique. - apply/continuous_subspaceW/cf => //. apply: subset_itvl => //=. by rewrite bnd_simp -lerBrDl;apply delta_max_itv. - - move => t0 t0ad. - suff : (f t0) \in closed_ball u0 r%:num by rewrite inE. + - move=> t0 t0ad. + suff : f t0 \in closed_ball u0 r%:num by rewrite inE. apply D1. - move : t0ad. - rewrite !inE/=!in_itv/= => /andP[-> h1] //=. - apply: (le_trans h1). - rewrite lerD//. - apply (le_trans drho1). - by rewrite ge_min lexx;apply /orP;left. + move: t0ad; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp/=. + by rewrite lerD2l// (le_trans drho1)// ge_min lexx. - split; first by apply sol1. - move => t0 t0ad. + move=> t0 t0ad. have [_ + _] := sol1; apply. - move : t0ad. - rewrite !inE/=!in_itv/= => /andP[-> h]//=. - apply: (lt_le_trans h). - rewrite -lerBrDl. - exact: delta_max_itv. + by move: t0ad; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp -lerBrDl delta_max_itv. - apply: continuous_subspaceW cf. apply: subset_trans; first exact: itv_closure. by apply: subset_itvl; rewrite bnd_simp -lerBrDl delta_max_itv. - exact: tad. move => t tad. -apply /esym. -apply : cauchy_lipschitz_local_unique. +apply/esym; apply : cauchy_lipschitz_local_unique. - apply/continuous_subspaceW/cf' => //. - apply: subset_itvl => //=. - by rewrite bnd_simp -lerBrDl;apply delta_max_itv. -- move => t0 t0ad. - suff : (f' t0) \in closed_ball u0 r%:num by rewrite inE. + by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl;apply delta_max_itv. +- move=> t0 t0ad. + suff : f' t0 \in closed_ball u0 r%:num by rewrite inE. apply D2. - move : t0ad. - rewrite !inE/=!in_itv/= => /andP[-> h1] //=. - apply: (le_trans h1). - rewrite lerD//. - apply (le_trans drho1). - by rewrite ge_min lexx;apply /orP;right. + move: t0ad; rewrite !inE; apply: subset_itvl; rewrite bnd_simp lerD2l. + by rewrite (le_trans drho1)// ge_min lexx orbT. - split; first by apply sol2. - move => t0 t0ad. + move=> t0 t0ad. have [_ + _] := sol2; apply. - move : t0ad. - rewrite !inE/=!in_itv/= => /andP[-> h]//=. - by rewrite (lt_le_trans h)// -lerBrDl delta_max_itv. + by move: t0ad; rewrite !inE; apply: subset_itvl; rewrite bnd_simp -lerBrDl delta_max_itv. - apply/continuous_subspaceW/cf' => //. apply: subset_trans; first exact: itv_closure. by apply: subset_itvl; rewrite bnd_simp -lerBrDl;apply delta_max_itv. @@ -2008,8 +1954,7 @@ Qed. End solution_locally_unique. - -(* proof to be PRed to mathcomp *) +(* move *) Section closure_neitv. Context {R : realType}. Implicit Type a b : R. @@ -2029,7 +1974,6 @@ Qed. End closure_neitv. - Section picard_autonomous. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -2066,19 +2010,36 @@ Qed. End picard_autonomous. +(* TODO: move *) +Lemma nbhs_ge {R : realFieldType} (t x : R) : t < x -> \forall x0 \near nbhs x, t <= x0. +Proof. +move=> tx. +exists ((x - t) / 2). + by rewrite /= divr_gt0// subr_gt0. +move=> y/=. +have [xy|yx] := lerP x y. + rewrite ltrBlDl => H. + by rewrite (le_trans (ltW tx)). +rewrite ltrBlDl -ltrBlDr => /ltW; apply: le_trans. +rewrite -lerBlDr opprK. +by rewrite -lerBrDl ler_piMr ?invf_le1 ?ler1n// subr_ge0 ltW. +Qed. + +Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := + forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. + Section locally_lipschitz. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. Variables phi : U -> U. -Hypothesis locally_lipschitz : forall x, - exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. +Hypothesis phi_locally_lipschitz : locally_lipschitz phi. Theorem cauchy_lipschitz_ll u0 a : exists f delta r, delta > 0 /\ is_sol_on (fun=> phi) u0 a (BLeft (a + delta)) f /\ {in `[a, a + delta], forall t, closed_ball u0 r (f t)}. Proof. -have [/= r [k lip]] := locally_lipschitz u0. +have [/= r [k lip]] := phi_locally_lipschitz u0. have [//|f [delta [delta_ft0 [solf [cball cf]]]]] := cauchy_lipschitz_autonomous _ lip a. by exists f, delta, r%:num. Qed. @@ -2088,266 +2049,202 @@ End locally_lipschitz. Section uniqueness. Context {R : realType} {n : nat} (a b : R). Notation U := 'rV[R]_n. -Variables phi : U -> U. +Variable phi : U -> U. Hypothesis ab : a < b. -Hypothesis locally_lipschitz : forall x, - exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. + +Hypothesis phi_locally_lipschitz : locally_lipschitz phi. + Variables (u0 : U) (f : R -> U) (f' : R -> U). -Hypothesis sol1 : is_sol_on (fun => phi) u0 a (BLeft b) f. -Hypothesis sol2 : is_sol_on (fun => phi) u0 a (BLeft b) f'. +Hypothesis sol1 : is_sol_on (fun=> phi) u0 a (BLeft b) f. +Hypothesis sol2 : is_sol_on (fun=> phi) u0 a (BLeft b) f'. -Lemma locally_unique_at_t0 t0: a <= t0 < b -> f' t0 = f t0 - -> exists Delta : {posnum R}, {in `[t0, t0+Delta%:num], f =1 f'}. - +Lemma locally_unique_extends t : a <= t < b -> f' t = f t -> + exists Delta : {posnum R}, {in `[t, t + Delta%:num], f =1 f'}. Proof. -move => /andP[t0a tb0] eq. -have ta : `[t0, b] `<=` `[a, b]. - move => t. - rewrite /=!in_itv/= => /andP[+ ->]//. - move => t0t;apply /andP;split=>//. - by apply /le_trans/t0t. -have [r [k L]] := locally_lipschitz (f t0). -have cf0 : {within `[t0, b], continuous f}. - have := And33 sol1. - rewrite closure_neitv_oo// => h. - by apply /continuous_subspaceW/h. -have cf'0 : {within `[t0, b], continuous f'}. - have := And33 sol2. - rewrite closure_neitv_oo// => h. - by apply /continuous_subspaceW/h. -have sol10 : is_sol_on (fun => phi) (f t0) t0 (BLeft b) f. - split => //; last by rewrite closure_neitv_oo//. - move => t tab. - apply sol1. - move : tab. - rewrite !inE/=!in_itv/= => /andP[+ ->]. - move => t0t;apply /andP;split=>//. - by apply /le_lt_trans/t0t. -have sol20 : is_sol_on (fun => phi) (f t0) t0 (BLeft b) f'. - split => //; last by rewrite closure_neitv_oo//. - move => t tab. - apply sol2. - move : tab. - rewrite !inE/=!in_itv/= => /andP[+ ->]. - move => t0t;apply /andP;split=>//. - by apply /le_lt_trans/t0t. -have lip20 : {in `[t0, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t0) r%:num) phi}. - by move => t _;apply L. +move=> /andP[ta tb] eq. +have taab : `[t, b] `<=` `[a, b]. + by move=> ?/=; apply: subset_itvr; rewrite bnd_simp. +have [r [k L]] := phi_locally_lipschitz (f t). +have cf0 : {within `[t, b], continuous f}. + have := And33 sol1. + rewrite closure_neitv_oo//; exact: continuous_subspaceW. +have cf'0 : {within `[t, b], continuous f'}. + have := And33 sol2. + by rewrite closure_neitv_oo//; exact: continuous_subspaceW. +have sol10 : is_sol_on (fun => phi) (f t) t (BLeft b) f. + split => //; last by rewrite closure_neitv_oo. + move=> t0 tab. + apply sol1. + by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. +have sol20 : is_sol_on (fun => phi) (f t) t (BLeft b) f'. + split => //; last by rewrite closure_neitv_oo. + move=> t0 tab. + apply sol2. + by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. +have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) phi}. + by move => ? _; apply L. have k0 : 0 < k%:num by []. -have cont1: {in closed_ball (f t0) r%:num, forall y : 'rV_n, {within `[t0, b], continuous fun=> phi y}}. - move => y _;exact: cst_continuous_subspace. -have [D [P1 P2]]:= initial_solution_unique tb0 k0 lip20 cont1 cf0 sol10 cf'0 sol20. +have cont1 : {in closed_ball (f t) r%:num, + forall y : 'rV_n, {within `[t, b], continuous fun=> phi y}}. + by move => y _; exact: cst_continuous_subspace. +have [D [P1 P2]] := initial_solution_unique tb k0 lip20 cont1 cf0 sol10 cf'0 sol20. by exists D. Qed. -Lemma solution_unique : {in `[a,b], f =1 f'}. +Lemma solution_unique : {in `[a, b], f =1 f'}. Proof. -set E := [set t | t \in `[a,b]%R /\ {in `[a,t], f =1 f'}]. -suff : E b by rewrite /E/= => -[]. +set E := [set t | t \in `[a, b]%R /\ {in `[a, t], f =1 f'}]. +suff : E b by case. have Enonempty : E !=set0. - exists a. - rewrite /E/=;split; first by rewrite in_itv/=lexx ltW. - move => t. - rewrite set_itv1 inE/= => ->. + exists a; split; first by rewrite in_itv/= lexx ltW. + rewrite set_itv1 => t; rewrite inE/= => ->. by rewrite (And31 sol1) (And31 sol2). - -have mon c : E c -> forall c', a <= c' <= c -> E c'. - rewrite /E/= => -[+ h c'] /andP[ac' cc']. - rewrite /in_itv/= => /andP[c1 c2]. +have mon c : E c -> forall c', a <= c' <= c -> E c'. + move=> -[+ h c'] /andP[ac' cc']. + rewrite in_itv/= => /andP[ac cb]. split. - by apply: (subset_itvl c2); rewrite /=in_itv/= ac' cc'. - move => t. - rewrite inE => tac'. - apply h. - by rewrite inE; apply/subset_itvl/tac'. - + by rewrite in_itv/= ac' (le_trans cc'). + move => t tac'. + apply: h. + by move: tac'; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp. have monC c c' : a <= c' -> E c -> ~ E c' -> c < c'. - move => h Ec nEc'. - have [] := leP c' c => //. - move => h'. - rewrite falseE. - apply nEc'. - apply: (mon c) => //. - by apply /andP;split. - -have [hP | hP] := lem (has_sup E);last first. + move => ac' Ec nEc'. + rewrite ltNge; apply/negP => c'c. + apply/nEc'/(mon c) => //. + by rewrite ac'. +have [hP|hP] := lem (has_sup E); last first. have /(has_supPn Enonempty) := hP. - move /(_ b) => [x Ex bx]. - apply (mon x) => //. - by rewrite !ltW//. - + move=> /(_ b)[x Ex bx]. + apply/(mon x) => //. + by rewrite !ltW. have Eclosed : closed E. -(* have Ei : E = `[a,b] `&` [set t | t \in `[a,b]%R -> {in `[a,t], f =1 f'}]. *) -(* by apply /seteqP;split => x [xab x1];split => //;apply x1. *) -(* rewrite Ei. *) -(* apply closedI. *) -(* exact: itv_closed. *) rewrite closedE/= => p pn. - (* rewrite Ei. *) - (* apply closedI. *) - (* admit. *) suff : forall x, ~ E x -> \forall y \near x, ~ E y. move => H. - apply /not_notP => Ec. - apply pn. - by apply H. - move => x Ex1. - have [xab | xnab ] := boolP (x \in `[a,b]%R); last first. + apply/not_notP => Ec. + apply: pn. + exact: H. + move=> x Ex1. + have [xab|xnab] := boolP (x \in `[a, b]%R); last first. suff : \forall y \near x, ~ (y \in `[a,b]%R). - move => h. + move=> h. near=>y. rewrite not_andP;left. near:y. - by []. - move : xnab. - rewrite in_itv/= negb_and/= -!ltNge => /orP[xa | xb]. - near=>y. - apply /negP. - rewrite in_itv/=negb_and/= -!ltNge. - apply /orP;left. - near:y. - exact: lt_nbhsl. - near=>y. - apply /negP. - rewrite in_itv/=negb_and/= -!ltNge. - apply /orP;right. - near:y. - exact: lt_nbhsr. - rewrite not_andP in Ex1. - case Ex1 => // {}Ex1. - have [t Et]: exists t, t \in `[a,x] /\ ~ (f t = f' t). + exact: h. + move: xnab; rewrite in_itv/= negb_and/= -!ltNge => /orP[xa|xb]. + near=> y. + apply/negP; rewrite in_itv/= negb_and/= -!ltNge; apply/orP; left. + by near: y; exact: lt_nbhsl. + near=>y. + apply/negP. + rewrite in_itv/=negb_and/= -!ltNge; apply/orP; right. + by near: y; exact: lt_nbhsr. + rewrite not_andP in Ex1. + case: Ex1 => // {}Ex1. + have [t Et] : exists t, t \in `[a, x] /\ ~ (f t = f' t). rewrite not_existsP => h. - apply Ex1. - move => t tax. - have := (h t). - rewrite not_andP => -[]//. - by move /contrapT. - have [xt | xt]:= eqVneq x t. - subst t. - set g := fun x => `|f x - f' x|. + apply Ex1 => t tax. + have := h t. + by rewrite not_andP => -[//|/contrapT]. + have [xt|xt]:= eqVneq x t. + subst t. + set g := fun x => `|f x - f' x|. have contg : {within `[a,b], continuous g}. - apply : within_continuous_comp_norm. - by apply ltW. - move => t. + apply: (within_continuous_comp_norm (ltW ab)) => t. apply: continuousB. - have := (And33 sol1). - rewrite closure_neitv_oo//. - apply. - have := (And33 sol2). - rewrite closure_neitv_oo//. - apply. - have g0x : g x > 0. - rewrite normr_gt0 subr_eq0. - apply /eqP. - by case : Et. - have g0 t : t \in `[a, b]%R -> (g t > 0) -> ~ {in `[a, t], f =1 f'}. - move => tab gt Et'. - move : gt. - suff -> : g t = 0 by rewrite ltxx. - rewrite /g. - apply /normr0P. - rewrite Et'; first by rewrite subrr. - move : tab. - by rewrite in_itv/=inE/=!in_itv/= lexx => /andP[-> _]. - suff hgx: \forall y \near x^'-, 0 < g y. - near=>y. - have [] := ltP y x;last first. - move => xy Ey. - have := mon _ Ey x. - move : xab. - rewrite /=in_itv/= xy => /andP[-> _] //. - move => /(_ isT). - case. - done. - move => yx. - apply /not_andP. - rewrite -implyE => yab. - apply g0 => //. - move : yx. - by near:y. - have := @cvgr_gt R R (nbhs x^'-) _ g (g x). - apply => //. + - have := And33 sol1. + rewrite closure_neitv_oo//. + exact. + - have := And33 sol2. + rewrite closure_neitv_oo//. + exact. + have g0x : g x > 0. + rewrite normr_gt0 subr_eq0. + by apply/eqP; case: Et. + have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t], f =1 f'}. + move => tab gt Et'. + move : gt. + suff -> : g t = 0 by rewrite ltxx. + apply/normr0P. + rewrite Et' ?subrr//. + by move: tab; rewrite inE/= !in_itv/= lexx => /andP[->]. + suff hgx: \forall y \near x^'-, 0 < g y. + near=>y. + have [yx|xy Ey] := ltP y x; last first. + have := mon _ Ey x. + move: xab. + by rewrite /=in_itv/= xy => /andP[-> _] // /(_ isT)[]. + apply/not_andP. + rewrite -implyE => yab. + apply g0 => //. + by move: yx; near: y. + apply: (@cvgr_gt R R (nbhs x^'-) _ g (g x)) => //. have xa : a < x. - move : Ex1. rewrite ltNge. - apply contra_notN. - move : xab. - rewrite in_itv/= => /andP[+ _ ]. - move => h1 h2. - have := eq_le a x. - rewrite h1 h2 /=. - move => /eqP <-. - move => y. - rewrite set_itv1/=inE/= => ->. + apply: contra_notN Ex1. + move: xab; rewrite in_itv/= => /andP[+ _] ax. + move/(conj ax) => /andP; rewrite -eq_le => /eqP ->. + rewrite set_itv1/= => y; rewrite inE/= => ->. by rewrite (And31 sol1) (And31 sol2). have /(continuous_within_itvP _ ab) := contg => -[h1 _ h2]. - move : xab. - rewrite in_itv/= => /andP[_ ]. - rewrite le_eqVlt => /predU1P[-> // | xb ]. - apply cvg_at_left_filter. - apply h1. + move: xab; rewrite in_itv/= => /andP[_ ]. + rewrite le_eqVlt => /predU1P[-> //|xb]. + apply/cvg_at_left_filter/h1. by rewrite in_itv/= xb xa. have xt' : t < x. - case : Et. - rewrite inE/=in_itv/= => /andP[_ ]. + case: Et; rewrite inE/=in_itv/= => /andP[_ ]. by rewrite le_eqVlt eq_sym (negbTE xt) . near=> y. - move => Ey. - have : (~ E t). - rewrite not_andP. - right. - move => /(_ t). - admit. - have ta : a <= t. - admit. - have := (monC y t ta Ey). - move => /[apply]. - apply /negP. - rewrite -leNgt. - apply ltW. - near:y. - admit. + move => Ey. + have : ~ E t. + rewrite not_andP. + right. + move=> /(_ t). + case: Et; rewrite !inE/= !in_itv/= => /andP[-> _/=]. + by rewrite lexx => /[swap] => /(_ isT). + have ta : a <= t. + by case: Et; rewrite inE/= in_itv/= => /andP[]. + move/(monC y t ta Ey). + apply/negP; rewrite -leNgt. + by near: y; exact: nbhs_ge. have supE : E (sup E). rewrite {1}(closure_id E).1 //. apply: closure_sup => //. - by apply hP. -have sup_itv : (a <= sup E). + by apply hP. +have sup_itv : a <= sup E. apply sup_upper_bound => //. - rewrite /E/=;split; first by rewrite in_itv/=lexx ltW. + split; first by rewrite in_itv/= lexx ltW. move => t. rewrite set_itv1 inE/= => ->. by rewrite (And31 sol1) (And31 sol2). have supeq : f' (sup E) = f (sup E). - apply /esym. - apply supE. - by rewrite inE/= in_itv/= lexx sup_itv//=. + apply/esym; apply supE. + by rewrite inE/= in_itv/= lexx sup_itv. have [h|h] := leP b (sup E). apply: (mon _ supE) => //. - by apply /andP; rewrite ltW. - -have [| Delta Hdelta] := locally_unique_at_t0 _ supeq; first by apply /andP. + by apply/andP; rewrite ltW. +have [| Delta Hdelta] := locally_unique_extends _ supeq; first by apply/andP. have Delta0 : 0 < Delta%:num by []. suff : Num.min b (sup E + Delta%:num) <= sup E. - rewrite ge_min => /orP[]. - move => h0. + rewrite ge_min => /orP[bE|]. suff : b < b by rewrite ltxx. - by apply (le_lt_trans h0 h). + exact: (le_lt_trans bE h). rewrite gerDl. rewrite ltNge in Delta0. by have /negP := Delta0. apply sup_upper_bound => //. split. rewrite in_itv/=. - apply /andP;split. - rewrite le_min; apply /andP;split; first by apply ltW. - apply (le_trans sup_itv). - by rewrite lerDl. - by rewrite ge_min lexx. + apply/andP; split. + rewrite le_min; apply/andP; split; first by apply ltW. + by rewrite (le_trans sup_itv)// lerDl. + by rewrite ge_min lexx. move => t. -rewrite inE/=in_itv/= => -/andP[t1 t2]. -have [ht | ht] := leP t (sup E). - by apply supE; rewrite inE/=in_itv/= t1 ht. -apply Hdelta; rewrite inE/=in_itv/= ltW // (le_trans t2)// ge_min lexx. -by apply /orP;right. -Admitted. +rewrite inE/= in_itv/= => -/andP[t1 t2]. +have [ht| ht] := leP t (sup E). + by apply supE; rewrite inE/= in_itv/= t1 ht. +by apply Hdelta; rewrite inE/= in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. +Unshelve. all: by end_near. Qed. + End uniqueness. diff --git a/tilt.v b/tilt.v index d1f69894..3664d84f 100644 --- a/tilt.v +++ b/tilt.v @@ -2,7 +2,7 @@ From HB Require Import structures. From mathcomp Require Import all_boot all_algebra ring. From mathcomp Require Import interval_inference. From mathcomp Require Import boolp classical_sets functions reals order. -From mathcomp Require Import topology normedtype landau derive realfun. +From mathcomp Require Import topology normedtype landau sequences derive realfun. From mathcomp Require Import matrix_normedtype. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. @@ -18,12 +18,8 @@ Require Import ode lasalle. (* locnegsemidef V x == V is locally negative semidefinite *) (* 'D~(sol, x0) V == derivative of V along the solution sol *) (* starting at x0 *) -(* is_sol_autonomous u0 phi t0 t1 f == solution of an autonomous ODE *) -(* initial_condition u0 *) -(* equation phi *) -(* solution f on [t0, t1] *) -(* tilt_is_sol_autonomous phi Delta f Init := is_sol_autonomous (f 0) phi 0 Delta f *) -(* + f 0 \in Init *) +(* tilt_is_sol_autonomous phi Delta Init f := f 0 \in Init + *) +(* is_sol_on phi (f 0) 0 Delta f *) (* is_equilibrium_point f p := solves_equation f (cst p) *) (* state_space f == the set points attainable by a solution *) (* (in the sense of `is_sol`) *) @@ -212,6 +208,144 @@ End posdefmx. Local Open Scope classical_set_scope. +Lemma cst_oo_cc {R : realType} (f : R -> R) y (a b : R) : + y \in `[a, b] -> + {within `[a, b], continuous f} -> + {in `]a, b[, f =1 cst (f y)} -> + {in `[a, b], f =1 cst (f y)}. +Proof. +have [ab|ba] := ltP a b; last first. + move=> yab _ H x. + rewrite inE/= in_itv/= => /andP[ax xb]. + have /eqP ? : a == x by rewrite eq_le ax (le_trans xb _). + subst x. + move: yab; rewrite inE/= in_itv/= => /andP[ay yb]. + have /eqP ? : a == y by rewrite eq_le ay (le_trans yb _). + by subst. +move=> yab cf H x. +rewrite inE/= in_itv/= => /andP[]. +rewrite le_eqVlt => /predU1P[<-{x} _|]. + move: yab; rewrite inE/= in_itv/= => /andP[]. + rewrite le_eqVlt => /predU1P[->//|ay yb]. + move/continuous_within_itvP : cf => /(_ ab)[_ fafa _]. + move/cvgrPdist_le in fafa. + rewrite /= in fafa. + apply/eqP. + rewrite -subr_eq0. + rewrite -normr_le0. + apply/ler_addgt0Pr => /= e e0. + rewrite add0r. + have := fafa _ e0 => -[d /= d0] H'. + near a^'+ => a0. + rewrite (_ : f y = f a0)//; last first. + apply/esym/H. + rewrite inE/= in_itv/=. + by apply/andP; split => //. + apply: H' => //=. + rewrite ltr0_norm ?subr_lt0// opprB. + rewrite ltrBlDl. + near: a0. + apply: nbhs_right_lt. + by rewrite ltrDl. +move=> ax. +rewrite le_eqVlt => /predU1P[->|]; last first. + move=> xb. + apply: H => //. + by rewrite inE/= in_itv/= ax. +clear x ax. +move: yab. +rewrite inE/= in_itv/= => /andP[ay]. +rewrite le_eqVlt => /predU1P[<-//|yb]. +move/continuous_within_itvP : cf => /(_ ab)[_ _ fbfb]. +move/cvgrPdist_le in fbfb. +rewrite /= in fbfb. +apply/eqP. +rewrite -subr_eq0. +rewrite -normr_le0. +apply/ler_addgt0Pr => /= e e0. +rewrite add0r. +have := fbfb _ e0 => -[d /= d0] H'. +near b^'- => b0. +rewrite (_ : f y = f b0)//; last first. + apply/esym/H. + rewrite inE/= in_itv/=. + by apply/andP; split => //. +apply: H' => //=. +rewrite distrC. +rewrite ltr0_norm ?subr_lt0// opprB. +rewrite ltrBlDr. +rewrite -ltrBlDl. +near: b0. +apply: nbhs_left_gt. +by rewrite ltrBlDl ltrDr. +Unshelve. all: by end_near. Qed. + +Lemma is_derive_0_is_cst_new {R : realType} (f : R -> R) y (a b : R) : + y \in `]a, b[ -> + {within `[a, b], continuous f} -> + (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. +Proof. +move=> yab cf Hd. +apply: cst_oo_cc => //. + move: yab. + rewrite !inE/=. + by apply: subset_itv_oo_cc. +move=> x xab. +wlog xLy : x y xab yab/ x <= y. + move=> H; case: (leP x y) => [/H |/ltW xy]. + exact. + by apply/esym/H => //. +rewrite -(subKr (f y) (f x)). +have [| |] := @MVT_segment R f 0 _ _ xLy. +- move=> z zxy. + apply: Hd. + move: zxy. + rewrite inE/=. + apply: subset_itvSoo; rewrite bnd_simp. + by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. + by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. +- apply: continuous_subspaceW(* NB: should be , do a PRS*) cf. + apply: subset_itvScc; rewrite bnd_simp. + by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. + by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. +move=> r rxy. +rewrite mul0r => ->. +by rewrite subr0. +Qed. + +Lemma is_derive_0_is_cst_new' {R : realType} (f : R -> R) y (a b : R) : + y \in `[a, b] -> + {within `[a, b], continuous f} -> + (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. +Proof. +move => yab cont d x xab /=. +have : (a <= b). + move: xab. + rewrite inE/=in_itv/= => /andP[]. + by apply le_trans. +rewrite le_eqVlt => /predU1P[ab|ab]. +suff [-> ->] : b = x /\ b = y by []. +split;apply /eqP;rewrite eq_le. +by move : xab;rewrite !ab !inE/=!in_itv/=. +by move : yab;rewrite !ab !inE/=!in_itv/=. +suff [-> ->] : f x = f ((a + b) / 2) /\ f y = f ((a+b )/2) by []. +have ab2: (a+b)/2 \in `]a,b[. + rewrite inE/=in_itv/=. + apply/andP;split. + by rewrite ltr_pdivlMr // mulrDr mulr1 ler_ltD //. + rewrite ltr_pdivrMr // mulrDr mulr1 ltr_leD //. +by split;apply /is_derive_0_is_cst_new. +Qed. + +Lemma closed_ball_bounded {K : realType} {n} (x y : 'rV[K]_n) r : 0 < r -> closed_ball x r y -> + `|y| <= `|x| + r. +Proof. +move=> r0. +rewrite closed_ballE// /closed_ball_/= => dxy. +rewrite ler_distlCDr//. +by rewrite (le_trans (ler_dist_dist _ _)). +Qed. + Section locdef. Context {R : realType} {T : normedModType R}. Implicit Types V : T -> R. @@ -334,8 +468,6 @@ Definition derive_along_partial {R : realType} n (V : 'rV[R]_n -> R) (a : R -> 'rV[R]_n) (t : R) : R := \sum_(i < n) (partial V (a t) i * ('D_1 a t) ``_ i). -From mathcomp Require Import sequences. - Section picard. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -364,15 +496,16 @@ Let U := 'rV[K]_n. Variable phi : U -> U. -Definition tilt_is_sol_autonomous (Delta : K) (f : K -> U) (Init : set U) := +Definition tilt_is_sol (Delta : K) (Init : set U) (f : K -> U) := f 0 \in Init /\ is_sol_on (fun=> phi) (f 0) 0 (BLeft Delta) f. -Definition is_global_sol (f : K -> U) (Init : set U) := - f 0 \in Init /\ forall t , t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). +Definition is_global_sol (Init : set U) (f : K -> U) := + f 0 \in Init /\ forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). -Lemma global_sol_sol f Init : is_global_sol f Init -> forall Delta, tilt_is_sol_autonomous Delta f Init. +Lemma global_sol_sol f Init : is_global_sol Init f -> + forall Delta, tilt_is_sol Delta Init f. Proof. - move => [init0 /= solP] Delta. +move=> [init0 /= solP] Delta. split => //. split => //. move => x. @@ -394,16 +527,14 @@ End ode. Section is_sol. Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. -Variable Delta : K. +Let U := 'rV[K]_n. +Variables (phi : U -> U) (Delta : K). -Lemma is_sol_subset f (A B : set T) : - A `<=` B -> - tilt_is_sol_autonomous phi Delta f A -> tilt_is_sol_autonomous phi Delta f B. +Lemma tilt_is_solS (A B : set U) : A `<=` B -> + tilt_is_sol phi Delta A `<=` tilt_is_sol phi Delta B. Proof. -move=> AB. -rewrite /tilt_is_sol_autonomous inE => -[inD0 [_ deri cont]]; rewrite inE. +move=> AB f. +rewrite /tilt_is_sol inE => -[inD0 [_ deri cont]]; rewrite inE. split => //. by apply: AB. Qed. @@ -415,8 +546,9 @@ Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : T -> T. +(* TODO: two state_space definitions?! *) Definition state_space (Init : set T) : set T := - [set x | exists f Delta, (tilt_is_sol_autonomous phi Delta f Init /\ + [set x | exists f Delta, (tilt_is_sol phi Delta Init f /\ (exists t, t \in `[0, Delta[%R /\ x = f t))]. End state_space. @@ -429,7 +561,7 @@ Variable Init : set T. Variable Delta : K. Definition is_equilibrium_point (x : T) := - forall Delta, tilt_is_sol_autonomous phi Delta (cst x) Init. + forall Delta, tilt_is_sol phi Delta Init (cst x). End equilibrium_point. @@ -438,15 +570,13 @@ Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : T -> T. -Definition equilibrium_points A := - [set p : T | is_equilibrium_point phi A p ]. +Definition equilibrium_points A := [set p : T | is_equilibrium_point phi A p]. -Lemma equilibrium_points_subset (A B : set T) : - A `<=` B -> +Lemma equilibrium_points_subset (A B : set T) : A `<=` B -> equilibrium_points A `<=` equilibrium_points B. Proof. move=> AB x. -rewrite /equilibrium_points/= /is_equilibrium_point /tilt_is_sol_autonomous inE => H Delta. +rewrite /equilibrium_points/= /is_equilibrium_point /tilt_is_sol inE => H Delta. have [inD0 [deriv cont tilt]] := H Delta. rewrite inE; split => //. exact: AB. @@ -462,28 +592,27 @@ Variable Init : set T. Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (z : K -> 'rV[K]_n) (Delta : K), tilt_is_sol_autonomous phi Delta z Init -> - `| z 0 - x | < d -> forall t, 0 < t < Delta -> `| z t - x | < eps. + forall (f : K -> 'rV[K]_n) (Delta : K), tilt_is_sol phi Delta Init f -> + `| f 0 - x | < d -> forall t, 0 < t < Delta -> `| f t - x | < eps. (* assuming solution exists for all time *) Definition is_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (z : K -> 'rV[K]_n), is_global_sol phi z Init -> - `| z 0 - x | < d -> forall t, 0 < t -> `| z t - x | < eps. + forall (f : K -> 'rV[K]_n), is_global_sol phi Init f -> + `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. Lemma locally_stable_stable x : is_locally_stable_at x -> is_stable_at x. Proof. move => lstable e e0. move /(_ _ e0) : lstable => [d d0 stable]. exists d => // z zglob zd t t0. -apply (stable _ (t+1)) => //. -by apply global_sol_sol. -rewrite t0/=. -by rewrite ltrDl. +apply (stable _ (t + 1)) => //. + by apply global_sol_sol. +by rewrite t0/= ltrDl. Qed. -Definition is_asymptotically_stable_at (x : T) (z : K -> 'rV[K]_n) : Prop := - exists2 d, d > 0 & `| z 0 - x | < d -> z t @[t --> +oo] --> x. +Definition is_asymptotically_stable_at (x : T) (f : K -> 'rV[K]_n) : Prop := + exists2 d, d > 0 & `| f 0 - x | < d -> f t @[t --> +oo] --> x. End stability. @@ -721,7 +850,7 @@ Proof. by move=> r0; rewrite /B -closed_ballE. Qed. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall Delta sol, tilt_is_sol_autonomous phi Delta sol Init -> +Hypothesis V'_le0 : forall Delta sol, tilt_is_sol phi Delta Init sol -> forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. (* khalil theorem 4.1 *) @@ -777,8 +906,7 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta Delta sol : - tilt_is_sol_autonomous phi Delta sol Init -> +have Df_Omega_beta Delta sol : tilt_is_sol phi Delta Init sol -> sol 0 \in Omega_beta -> forall t, 0 < t < Delta -> sol t \in Omega_beta. move=> solP phi_Omega. have /= V_nincr_consequence : forall t, 0 < t < Delta -> forall u, 0 <= u <= t -> @@ -1229,234 +1357,60 @@ Qed. End two_steps_first_order_estimator. -Definition state_space_tilt {K : realType} := - [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. - -Lemma cst_oo_cc {R : realType} (f : R -> R) y (a b : R) : - y \in `[a, b] -> - {within `[a, b], continuous f} -> - {in `]a, b[, f =1 cst (f y)} -> - {in `[a, b], f =1 cst (f y)}. -Proof. -have [ab|ba] := ltP a b; last first. - move=> yab _ H x. - rewrite inE/= in_itv/= => /andP[ax xb]. - have /eqP ? : a == x by rewrite eq_le ax (le_trans xb _). - subst x. - move: yab; rewrite inE/= in_itv/= => /andP[ay yb]. - have /eqP ? : a == y by rewrite eq_le ay (le_trans yb _). - by subst. -move=> yab cf H x. -rewrite inE/= in_itv/= => /andP[]. -rewrite le_eqVlt => /predU1P[<-{x} _|]. - move: yab; rewrite inE/= in_itv/= => /andP[]. - rewrite le_eqVlt => /predU1P[->//|ay yb]. - move/continuous_within_itvP : cf => /(_ ab)[_ fafa _]. - move/cvgrPdist_le in fafa. - rewrite /= in fafa. - apply/eqP. - rewrite -subr_eq0. - rewrite -normr_le0. - apply/ler_addgt0Pr => /= e e0. - rewrite add0r. - have := fafa _ e0 => -[d /= d0] H'. - near a^'+ => a0. - rewrite (_ : f y = f a0)//; last first. - apply/esym/H. - rewrite inE/= in_itv/=. - by apply/andP; split => //. - apply: H' => //=. - rewrite ltr0_norm ?subr_lt0// opprB. - rewrite ltrBlDl. - near: a0. - apply: nbhs_right_lt. - by rewrite ltrDl. -move=> ax. -rewrite le_eqVlt => /predU1P[->|]; last first. - move=> xb. - apply: H => //. - by rewrite inE/= in_itv/= ax. -clear x ax. -move: yab. -rewrite inE/= in_itv/= => /andP[ay]. -rewrite le_eqVlt => /predU1P[<-//|yb]. -move/continuous_within_itvP : cf => /(_ ab)[_ _ fbfb]. -move/cvgrPdist_le in fbfb. -rewrite /= in fbfb. -apply/eqP. -rewrite -subr_eq0. -rewrite -normr_le0. -apply/ler_addgt0Pr => /= e e0. -rewrite add0r. -have := fbfb _ e0 => -[d /= d0] H'. -near b^'- => b0. -rewrite (_ : f y = f b0)//; last first. - apply/esym/H. - rewrite inE/= in_itv/=. - by apply/andP; split => //. -apply: H' => //=. -rewrite distrC. -rewrite ltr0_norm ?subr_lt0// opprB. -rewrite ltrBlDr. -rewrite -ltrBlDl. -near: b0. -apply: nbhs_left_gt. -by rewrite ltrBlDl ltrDr. -Unshelve. all: by end_near. Qed. - -Lemma is_derive_0_is_cst_new {R : realType} (f : R -> R) y (a b : R) : - y \in `]a, b[ -> - {within `[a, b], continuous f} -> - (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. -Proof. -move=> yab cf Hd. -apply: cst_oo_cc => //. - move: yab. - rewrite !inE/=. - by apply: subset_itv_oo_cc. -move=> x xab. -wlog xLy : x y xab yab/ x <= y. - move=> H; case: (leP x y) => [/H |/ltW xy]. - exact. - by apply/esym/H => //. -rewrite -(subKr (f y) (f x)). -have [| |] := @MVT_segment R f 0 _ _ xLy. -- move=> z zxy. - apply: Hd. - move: zxy. - rewrite inE/=. - apply: subset_itvSoo; rewrite bnd_simp. - by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. - by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. -- apply: continuous_subspaceW(* NB: should be , do a PRS*) cf. - apply: subset_itvScc; rewrite bnd_simp. - by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. - by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. -move=> r rxy. -rewrite mul0r => ->. -by rewrite subr0. -Qed. - -Lemma is_derive_0_is_cst_new' {R : realType} (f : R -> R) y (a b : R) : - y \in `[a, b] -> - {within `[a, b], continuous f} -> - (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. -Proof. -move => yab cont d x xab /=. -have : (a <= b). - move: xab. - rewrite inE/=in_itv/= => /andP[]. - by apply le_trans. -rewrite le_eqVlt => /predU1P[ab|ab]. -suff [-> ->] : b = x /\ b = y by []. -split;apply /eqP;rewrite eq_le. -by move : xab;rewrite !ab !inE/=!in_itv/=. -by move : yab;rewrite !ab !inE/=!in_itv/=. -suff [-> ->] : f x = f ((a + b) / 2) /\ f y = f ((a+b )/2) by []. -have ab2: (a+b)/2 \in `]a,b[. - rewrite inE/=in_itv/=. - apply/andP;split. - by rewrite ltr_pdivlMr // mulrDr mulr1 ler_ltD //. - rewrite ltr_pdivrMr // mulrDr mulr1 ltr_leD //. -by split;apply /is_derive_0_is_cst_new. -Qed. - -Section tilt_eqn. +Module Tilt. +Section tilt. Context {K : realType}. Variables alpha1 gamma : K. -Hypothesis gamma_gt0 : 0 < gamma. -Hypothesis alpha1_gt0 : 0 < alpha1. -Definition tilt_eqn_functional (f : K -> 'rV[K]_6) : K -> 'rV[K]_6 := +Definition eqn_functional (f : K -> 'rV[K]_6) : K -> 'rV[K]_6 := let error1_p_dot := Left \o f in let error2_p_dot := Right \o f in fun t => row_mx (- alpha1 *: error1_p_dot t) (eqn14b_rhs gamma (error1_p_dot t) (error2_p_dot t)). -Definition tilt_eqn (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := +Definition eqn (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := let zp1_point := Left zp1_z2_point in let z2_point := Right zp1_z2_point in row_mx (- alpha1 *: zp1_point) (eqn14b_rhs gamma zp1_point z2_point). -Lemma tilt_eqnE (f : K -> 'rV[K]_6) t : - tilt_eqn (f t) = tilt_eqn_functional f t. +Lemma eqnE (f : K -> 'rV[K]_6) t : eqn (f t) = eqn_functional f t. Proof. by []. Qed. -Lemma tilt_eqn_functionalE f t : tilt_eqn_functional f t = tilt_eqn (f t). +Lemma eqn_functionalE f t : eqn_functional f t = eqn (f t). Proof. by []. Qed. -(* TODO: this does not hold, we need locally lipschitz *) -Lemma tilt_eqn_lipschitz : exists k, k.-lipschitz_setT tilt_eqn. -Proof. -near (pinfty_nbhs K) => k. -exists k => -[/= x x0] _. -rewrite /tilt_eqn. -set fx := row_mx (- alpha1 *: Left x) - (gamma *: (Right x - Left x) *m \S('e_2 - Right x) ^+ 2). -set fy := row_mx (- alpha1 *: Left x0) - (gamma *: (Right x0 - Left x0) *m \S('e_2 - Right x0) ^+ 2). -rewrite /Num.norm/=. -rewrite !mx_normrE. -apply: bigmax_le => /=. - rewrite mulr_ge0//. - apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, ord0)). - by []. -move=> -[a b] _. -rewrite /=. -rewrite [leRHS](_ : _ = - \big[maxr/0]_ij (maxr alpha1 gamma * `|(x - x0) ij.1 ij.2|)); last first. - admit. -rewrite (le_trans (@ler_peMl _ (maxr alpha1 gamma) _ _ _))//. - admit. -apply: le_trans; last first. - exact: (@le_bigmax _ _ _ 0 - (fun ij => maxr alpha1 gamma * `|(x - x0) ij.1 ij.2|) (a, b)). -rewrite /=. -apply: (@le_trans _ _ - (`|(maxr alpha1 gamma *: fx - maxr alpha1 gamma *: fy) a b|)). - admit. -apply: (@le_trans _ _ - (`|maxr alpha1 gamma *: x a b - maxr alpha1 gamma *: x0 a b|)); last first. -Abort. +Definition state_space := [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. -Lemma closed_ball_bounded {n} (x y : 'rV[K]_n) r : 0 < r -> closed_ball x r y -> - `|y| <= `|x| + r. +Definition point1 : 'rV[K]_6 := 0. +Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). + +Lemma point1_neq2 : point1 != point2. Proof. -move=> r0. -rewrite closed_ballE// /closed_ball_/= => dxy. -rewrite ler_distlCDr//. -by rewrite (le_trans (ler_dist_dist _ _)). +apply/eqP; rewrite /point1 /point2 => /eqP. +rewrite eq_sym (@row_mx_eq0 _ 1 3 3) eqxx/= => /eqP/rowP/(_ ord_max). +by rewrite !mxE eqxx/= mulr1; apply/eqP; rewrite pnatr_eq0. Qed. -(* Lemma spin_sq_norm_bound (x : 'rV[K]_3) : `|\S(x)^+2| <= 4* `|x|^+2. *) -(* Proof. *) -(* have -> : 4* `|x|^+2 = `|x|^+2 + 3* `|x|^+2 by ring. *) -(* rewrite skew.sqr_spin. *) -(* apply: (le_trans (ler_normB _ _)). *) -(* apply lerD. *) -(* apply: (le_trans (mx_norm_mul _ _)). *) -(* rewrite norm_trmx. *) -(* by rewrite mul1r. *) -(* rewrite mx_normZ. *) -(* rewrite mx_norm1 mulr1. *) -(* rewrite normrM normr_norm. *) -(* exact: euclidean_norm_mxnorm. *) -(* Qed. *) - -Lemma tilt_eqn_locally_lipschitz x : - exists r k : {posnum K}, k%:num.-lipschitz_(closed_ball x r%:num) tilt_eqn. -Proof. -move=> /=. -rewrite /tilt_eqn. -(* near (pinfty_nbhs K) => k'. *) -(* exists k' => -[/= x x0] _. *) -(* rewrite /tilt_eqn. *) +Definition points := [set point1; point2]. + +End tilt. +End Tilt. + +Section tilt_eqn. +Context {K : realType}. +Variables alpha1 gamma : K. +Hypothesis gamma_gt0 : 0 < gamma. +Hypothesis alpha1_gt0 : 0 < alpha1. +Let phi := Tilt.eqn alpha1 gamma. + +Lemma tilt_eqn_locally_lipschitz : locally_lipschitz phi. +Proof. +move=> /= x. exists (PosNum ltr01). near (pinfty_nbhs K) => k. -have k0 : (0 < k) by []. +have k0 : 0 < k by []. exists (PosNum k0) => /= => -[/= x0 x1] [x0B x1B]. rewrite (opp_row_mx (n1:=3)) (add_row_mx (n1:=3)). rewrite !scaleNr opprK/=. @@ -1499,9 +1453,8 @@ rewrite ge_max; apply/andP; split. rewrite -[X in `|X| + _]mulmxBr. rewrite -[X in _ + `|X|]mulmxBl. rewrite (splitr `|gamma|^-1) mulrDl. - rewrite -invrM; last 2 first. - by rewrite unitfE. - by rewrite unitfE// gt_eqF// gtr0_norm. + rewrite -invrM ?unitfE//; last first. + by rewrite gt_eqF// gtr0_norm. rewrite lerD//. + apply: (le_trans (mx_norm_mul _ _)). have h0 := spin_sq_dist_bound ('e_2 - Right x0) ('e_2 - Right x1). @@ -1535,34 +1488,17 @@ rewrite ge_max; apply/andP; split. by rewrite !mulrA ler_pM. Unshelve. all: by end_near. Qed. -(*Lemma invariant_state_space_tilt p - (p33 : state_space tilt_eqn' state_space_tilt p) : - let y := sval (cid p33) in - let t := sval (cid (svalP (cid p33)).2) in - forall Delta, Delta >= 0 -> - state_space tilt_eqn state_space_tilt (y (t + Delta)). -Proof. -case: p33 => /= x0 sol_y Delta Delta_ge0. -rewrite /state_space/=. -exists x0; split. - by case: sol_y. -case: cid => //= y' y'sol. -case: cid => t'/= pt'. -Abort.*) -Lemma state_space_tiltS : - state_space tilt_eqn state_space_tilt `<=` state_space_tilt. +Lemma tilt_state_spaceS : + state_space phi Tilt.state_space `<=` Tilt.state_space. Proof. move => p [y [Delta [[y0_init1 [/=_ deri conti] ]]]]. - have [Delta0|Delta0] := leP 0 Delta; last first. - rewrite /state_space/= => -[t [rt x]]. - move : rt. - rewrite in_itv/= => -[/andP[x0 xDelta]]. + move=> -[t [+ x]]. + rewrite in_itv/= => -/andP[x0 xDelta]. have := lt_trans xDelta Delta0. - by rewrite ltNge x0. -(* move=> p [y [[y0_init1]] [_ [/= deri [conti ball]]]]. *) -rewrite /state_space_tilt. -have : {in `]0, Delta[, derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t)))) =1 0}. + by rewrite ltNge x0. +rewrite /Tilt.state_space. +have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))))^`() =1 0}. move => x xd /=. transitivity ((fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))) x). rewrite !derive1E. @@ -1596,11 +1532,9 @@ have : {in `]0, Delta[, derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right rewrite derive_mx//= ?mxE//. by apply deri. ring. - have Rsu t0 : t0 \in `]0, Delta[ -> Right (y^`()%classic t0) = + have Rsu t0 : t0 \in `]0, Delta[ -> Right (y^`()%classic t0) = (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). - move => t0d. - have [_ ->] := deri t0 t0d. - by rewrite row_mxKr. + by move/deri => [_ ->]; rewrite row_mxKr. rewrite /dotmul. transitivity (-2 * (gamma *: (Right (y x) - Left (y x)) *m \S('e_2 - Right (y x)) ^+ 2 *m @@ -1611,11 +1545,8 @@ have : {in `]0, Delta[, derive1 (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. by rewrite !mulmx0 mxE. move => h [t [t0d ->]]. - (* under eq_fun do rewrite dotmulvv /=. (* derivee de la norme est egale a 0 *) *) - (* move => h. *) -have norm_constant : forall t, t \in `[0,Delta] -> - `|'e_2 - Right (y t)|_e ^+ 2 = `|'e_2 - Right (y 0)|_e ^+ 2. - move => t0. +have norm_constant t0 : t0 \in `[0,Delta] -> + `|'e_2 - Right (y t0)|_e ^+ 2 = `|'e_2 - Right (y 0)|_e ^+ 2. have : forall x0, x0 \in `]0,Delta[ -> is_derive x0 (1:K) (fun x : K => `|'e_2 - Right (y x)|_e ^+ 2) 0. move => x0 x0d. @@ -1643,34 +1574,30 @@ have norm_constant : forall t, t \in `[0,Delta] -> move: conti; rewrite closure_neitv_oo//. by rewrite (le_lt_trans _ tDelta). suff: `|'e_2 - Right (y t)|_e ^+ 2 = 1. - move => /(congr1 Num.sqrt). - rewrite sqrtr1 sqr_sqrtr //. - by rewrite dotmulvv sqr_ge0. -rewrite norm_constant //;last first. - rewrite inE. - by apply: subset_itv_co_cc . + move=> /(congr1 Num.sqrt). + by rewrite sqrtr1 sqr_sqrtr// dotmulvv sqr_ge0. +rewrite norm_constant//; last first. + by rewrite inE; exact: subset_itv_co_cc. move: y0_init1. -rewrite inE /state_space_tilt /= => ->. +rewrite inE /Tilt.state_space /= => ->. by rewrite expr2 mulr1. Qed. -Definition point1 : 'rV[K]_6 := 0. -Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). - -Lemma point1_in_state_space_tilt : point1 \in state_space_tilt. +Lemma tilt_point1_in_state_space : @Tilt.point1 K \in Tilt.state_space. Proof. -rewrite inE /state_space_tilt /point1/=. - by rewrite rsubmx_const /= subr0 enormeE. +rewrite inE /Tilt.state_space /Tilt.point1/=. + by rewrite rsubmx_const /= subr0 enormeE. Qed. -Lemma equilibrium_point1 : - is_equilibrium_point tilt_eqn state_space_tilt point1. + +Lemma equilibrium_tilt_point1 : + is_equilibrium_point phi Tilt.state_space Tilt.point1. Proof. split. -- by apply point1_in_state_space_tilt. +- exact: tilt_point1_in_state_space. - split => //=. + move=> t t0Delta. split; first exact: derivable_cst. - rewrite derive1E derive_cst /tilt_eqn_functional /point1; apply/eqP. + rewrite derive1E derive_cst /Tilt.point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP; split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP => i. by rewrite lsubmx_const. @@ -1685,9 +1612,9 @@ split. exact: cvg_cst. Qed. -Lemma point2_in_state_space_tilt : point2 \in state_space_tilt. +Lemma tilt_point2_in_state_space : @Tilt.point2 K \in Tilt.state_space. Proof. -rewrite inE /state_space_tilt /point2 /=. +rewrite inE /Tilt.state_space /Tilt.point2 /=. rewrite row_mxKr. rewrite -[X in X - _ ]scale1r. rewrite -scalerBl enormZ enormeE mulr1 distrC. @@ -1695,48 +1622,45 @@ rewrite [X in _ - X](_:1 = 1%:R) //. by rewrite -natrB //= normr1. Qed. -Lemma equilibrium_point2 : - is_equilibrium_point tilt_eqn state_space_tilt point2. +Lemma equilibrium_tilt_point2 : + is_equilibrium_point phi Tilt.state_space Tilt.point2. Proof. -split. -- exact: point2_in_state_space_tilt. -- split => //. - + move=> t t0Delta. - split; first exact: derivable_cst. - rewrite derive1E derive_cst; apply/eqP. - rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. - set N := (X in _ *: X == 0 /\ _). - have N0 : N = 0. - apply/rowP; move => i; rewrite !mxE; case: splitP. - move => j _; by rewrite mxE. - move => k /= i3k. - have := ltn_ord i. - by rewrite i3k -ltn_subRL subnn. - split. - by rewrite scaler_eq0 N0 eqxx orbT. - rewrite /eqn14b_rhs. - rewrite -scalemxAl scalemx_eq0 gt_eqF//=. - rewrite -[Left point2]/N N0 subr0. - set M := (X in X *m _); rewrite -/M. - have ME : M = 2 *: 'e_2. - apply/rowP => i; rewrite !mxE eqxx/=. - case: splitP => [j ij|j]/=. - have := ltn_ord j. - by rewrite -ij. - move/eqP. - rewrite eqn_add2l => /eqP /ord_inj ->. - by rewrite !mxE eqxx/=. - rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/=. - rewrite [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA. - rewrite subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. - rewrite (_ : 'e_2 *m _ = 0) ?mul0mx//; apply: trmx_inj. - by rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. - + apply: continuous_subspaceT =>x. - exact: cvg_cst. +split; first exact: tilt_point2_in_state_space. +split => //. +- move=> t t0Delta. + split; first exact: derivable_cst. + rewrite derive1E derive_cst; apply/eqP. + rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. + set N := (X in _ *: X == 0 /\ _). + have N0 : N = 0. + apply/rowP; move=> i; rewrite !mxE; case: splitP. + by move => j _; rewrite mxE. + move=> k /= i3k. + have := ltn_ord i. + by rewrite i3k -ltn_subRL subnn. + split. + by rewrite scaler_eq0 N0 eqxx orbT. + rewrite /eqn14b_rhs. + rewrite -scalemxAl scalemx_eq0 gt_eqF//=. + rewrite -[Left Tilt.point2]/N N0 subr0. + set M := (X in X *m _); rewrite -/M. + have ME : M = 2 *: 'e_2. + apply/rowP => i; rewrite !mxE eqxx/=. + case: splitP => [j ij|j]/=. + have := ltn_ord j. + by rewrite -ij. + move/eqP. + rewrite eqn_add2l => /eqP /ord_inj ->. + by rewrite !mxE eqxx/=. + rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/=. + rewrite [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA. + rewrite subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. + rewrite (_ : 'e_2 *m _ = 0) ?mul0mx//; apply: trmx_inj. + by rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. +- by apply: continuous_subspaceT => x; exact: cvg_cst. Qed. End tilt_eqn. -Arguments point1 {K}. (* technical section, skip on a first reading *) Section u2. @@ -1843,9 +1767,10 @@ Definition V1 (zp1_z2 : 'rV[K]_6) : K := let z2 := Right zp1_z2 in `|zp1|_e ^+ 2 / (2 * alpha1) + `|z2|_e ^+ 2 / (2 * gamma). -Lemma V1_is_Lyapunov_candidate : is_Lyapunov_candidate V1 [set: 'rV_6] point1. +Lemma V1_is_Lyapunov_candidate : + is_Lyapunov_candidate V1 [set: 'rV_6] Tilt.point1. Proof. -rewrite /V1 /point1; split; first by rewrite inE. +rewrite /V1 /Tilt.point1; split; first by rewrite inE. split. by rewrite lsubmx_const rsubmx_const enorm0 expr0n/= !mul0r add0r. move=> /= z_near _ z0. @@ -1889,21 +1814,21 @@ Definition locally_exponentially_stable_at n (eqn : 'rV[K]_n -> 'rV[K]_n) hurwitz (jacobian eqn point). Lemma tilt_eqn_is_locally_exponentially_stable_at_0 alpha1 gamma : - locally_exponentially_stable_at (tilt_eqn alpha1 gamma) point1. + locally_exponentially_stable_at (Tilt.eqn alpha1 gamma) Tilt.point1. Proof. rewrite /locally_exponentially_stable_at /jacobian /hurwitz. -rewrite /lin1_mx/=/tilt_eqn/eqn14b_rhs/=. +rewrite /lin1_mx/= /Tilt.eqn /eqn14b_rhs/=. move => a. move/eigenvalueP => [u] /[swap] u0 H. -have a_eigen : eigenvalue (jacobian (tilt_eqn alpha1 gamma) point1) a. +have a_eigen : eigenvalue (jacobian (Tilt.eqn alpha1 gamma) Tilt.point1) a. apply/eigenvalueP. exists u. exact: H. exact: u0. -have : root (char_poly (jacobian (tilt_eqn alpha1 gamma) point1)) a. +have : root (char_poly (jacobian (Tilt.eqn alpha1 gamma) Tilt.point1)) a. rewrite -eigenvalue_root_char. exact : a_eigen. -rewrite /tilt_eqn /jacobian. +rewrite /Tilt.eqn /jacobian. Abort. End hurwitz. @@ -1913,11 +1838,11 @@ Local Open Scope classical_set_scope. Context {K : realType}. Variables alpha1 gamma : K. Hypotheses (alpha1_gt0 : 0 < alpha1) (gamma_gt0 : 0 < gamma). -Let phi := tilt_eqn alpha1 gamma. +Let phi := Tilt.eqn alpha1 gamma. Variable Delta : K. Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> + tilt_is_sol phi Delta Tilt.state_space sol -> t \in `]0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. move=> [/= sol0in [_ deri conti] t0Delta]. @@ -1930,7 +1855,7 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> + tilt_is_sol phi Delta Tilt.state_space sol -> z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. @@ -1943,8 +1868,8 @@ Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : t \in `[0, Delta[%R -> - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> - state_space_tilt (sol t). + tilt_is_sol phi Delta Tilt.state_space sol -> + Tilt.state_space (sol t). Proof. move=> t0Delta. case => sol0 [_ deriv_sol csol]. @@ -1952,9 +1877,8 @@ move: t0Delta. rewrite in_itv/= => /andP[]. rewrite le_eqVlt => /predU1P[<- Delta0|t0 tDelta]. exact/set_mem. -apply: (@state_space_tiltS _ alpha1 gamma) => //=. -exists sol. -exists Delta; split => //=. +apply: (@tilt_state_spaceS _ alpha1 gamma) => //=. +exists sol, Delta; split => //=. exists t; split => //. by rewrite in_itv/= (ltW t0) tDelta. Qed. @@ -1962,11 +1886,11 @@ Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> `|u|_e = 1. + tilt_is_sol phi Delta Tilt.state_space sol -> `|u|_e = 1. Proof. move=> z0Delta dtraj. -suff: state_space_tilt (row_mx (zp1 z) (z2 z)). - by rewrite /state_space_tilt/= row_mxKr. +suff: Tilt.state_space (row_mx (zp1 z) (z2 z)). + by rewrite /Tilt.state_space/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. by apply: is_sol_state_space_tilt => //. Qed. @@ -1974,7 +1898,7 @@ Qed. Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> + tilt_is_sol phi Delta Tilt.state_space sol -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> z0Delta dtraj. @@ -1998,18 +1922,16 @@ Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : z \in `[0, Delta[%R -> - tilt_is_sol_autonomous phi Delta sol state_space_tilt-> + tilt_is_sol phi Delta Tilt.state_space sol -> `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = `|Right (sol z) *m \S('e_2)|_e. Proof. -move=> z0Delta. -move=> dtraj. +move=> z0Delta dtraj. rewrite mulmxN enormN. pose zp1 := fun r => Left (sol r). pose z2 := fun r => Right (sol r). set w := (z2 z) *m \S('e_2). -have Gamma1_traj : state_space_tilt (sol z). - by apply/is_sol_state_space_tilt. +have Gamma1_traj : Tilt.state_space (sol z) by apply/is_sol_state_space_tilt. rewrite /enorm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. have Hnorm_sq : `|w *m \S('e_2 - Right (sol z))|_e ^+ 2 = `|w|_e ^+ 2. @@ -2026,7 +1948,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> + tilt_is_sol phi Delta Tilt.state_space sol -> z \in `]0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + @@ -2053,7 +1975,7 @@ Qed. Lemma derive_along_V1 t (sol : K -> 'rV_6) : t \in `]0, Delta[ -> - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> + tilt_is_sol phi Delta Tilt.state_space sol -> (forall t, t \in `]0, Delta[ -> differentiable sol t) -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. @@ -2079,18 +2001,17 @@ rewrite -fctE /= !derive_along_enorm_squared//=. exact: tilt_eqnx. - assumption. - exact/differentiable_lsubmx_comp. -- by apply: dif1. -- by apply: dif1. +- exact: dif1. +- exact: dif1. Qed. - Definition u1 (sol : K -> 'rV[K]_6) t (zp1 := Left \o sol) (z2 := Right \o sol) (w := z2 t *m \S('e_2)) : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 t|_e, 1 |-> `|w|_e] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> + tilt_is_sol phi Delta Tilt.state_space sol -> forall t, t \in `[0, Delta[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. @@ -2122,39 +2043,37 @@ by rewrite [leRHS]mulrC. Qed. Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> + tilt_is_sol phi Delta Tilt.state_space sol -> t \in `[0, Delta[%R -> - V1dot (sol t) = 0 -> - sol t = point1 \/ sol t = point2. + V1dot (sol t) = 0 -> + sol t = Tilt.point1 \/ sol t = Tilt.point2. Proof. move => solP t0d V1dsol. -have h: u1 sol t = 0. +have h : u1 sol t = 0. case: (u1 sol t =P 0) => [-> // |/eqP hsol]. - have := (V1dot_ub solP t0d). - have := u2_quadratic_form_gt0 hsol. + have := V1dot_ub solP t0d. + have := u2_quadratic_form_gt0 hsol. rewrite V1dsol !mulNmx !mxE oppr_ge0. move => h1 h2. have := lt_le_trans h1 h2. by rewrite ltxx. -have L0: Left (sol t) = 0. - apply /eqP; rewrite -enorm_eq0; apply /eqP. +have L0 : Left (sol t) = 0. + apply/eqP; rewrite -enorm_eq0; apply /eqP. have := congr1 (fun v : 'rV[K]_2 => v ord0 ord0) h. by rewrite !mxE/=. -have R0 : (Right (sol t)) *m \S('e_2) = 0. - apply /eqP. - rewrite -enorm_eq0. - apply /eqP. +have R0 : (Right (sol t)) *m \S('e_2) = 0. + apply/eqP; rewrite -enorm_eq0; apply/eqP. have := congr1 (fun v : 'rV[K]_2 => v ord0 ord_max) h. by rewrite !mxE/=. rewrite -(hsubmxK (n1:=3) (sol t)). rewrite L0. -suff [-> | -> ]: (Right (sol t)) = 0 \/ Right (sol t) = (2 *: 'e_2). +suff [-> | -> ] : Right (sol t) = 0 \/ Right (sol t) = (2 *: 'e_2). left;apply /matrixP => i j;rewrite mxE. case: splitP => // k _;by rewrite !mxE. right;apply /matrixP => i j;rewrite mxE. by case: splitP => // k _. -have := is_sol_state_space_tilt t0d solP. -rewrite /state_space_tilt/=. +have := is_sol_state_space_tilt t0d solP. +rewrite /Tilt.state_space/=. have /sub_rVP [k ->] : (Right (sol t) <= ('e_2 : 'rV[K]_3))%MS. apply: (@submx_trans _ _ _ _ _ _ (kermx \S('e_2))). by apply /sub_kermxP. @@ -2169,12 +2088,11 @@ by rewrite subr_eq addrC -subr_eq subrr => /eqP <-;rewrite scale0r;left. by rewrite subr_eq addrC -subr_eq opprK => /eqP <-;right. Qed. - (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : - tilt_is_sol_autonomous phi Delta (sol x) state_space_tilt -> - sol x 0 = point1 -> + tilt_is_sol phi Delta Tilt.state_space (sol x) -> + sol x 0 = Tilt.point1 -> \forall z \near 0^', ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + 'D~(sol x) (fun x => `|Right x|_e ^+ 2 / (2 * gamma))) z <= 0. @@ -2216,8 +2134,8 @@ Unshelve. all: try by end_near. Abort. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - tilt_is_sol_autonomous phi Delta (sol x) state_space_tilt -> - sol x 0 = point1 -> + tilt_is_sol phi Delta Tilt.state_space (sol x) -> + sol x 0 = Tilt.point1 -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. (* move=> [y033] dy dtraj traj0. *) @@ -2245,20 +2163,20 @@ Proof. (* rewrite /= !derivative_derive_along_eq0. *) (* - by rewrite scaler0 add0r. *) (* TODO: urgent - apply/differentiable_norm_squared/differentiable_rsubmx. - rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. + rewrite [LHS]dtraj /tilt_eqn/= traj0 /tilt_point1. rewrite /eqn14b_rhs. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. exact/differentiable_norm_squared/differentiable_lsubmx. - rewrite [LHS]dtraj /tilt_eqn/= traj0 /point1. + rewrite [LHS]dtraj /tilt_eqn/= traj0 /tilt_point1. rewrite /eqn14b_rhs. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0.*) Abort. Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - tilt_is_sol_autonomous phi Delta (sol x) state_space_tilt -> - (forall t : K, state_space_tilt (sol x t)) -> - sol x 0 = point1 -> + tilt_is_sol phi Delta Tilt.state_space (sol x) -> + (forall t : K, Tilt.state_space (sol x t)) -> + sol x 0 = Tilt.point1 -> locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. move=> solves state y0. @@ -2320,16 +2238,16 @@ Unshelve. all: by end_near. Abort. locnegsemidef (derive_along V (fun a => traj1) 0 ) 0].*) (*Lemma V1_is_Lyapunov_stable : - is_Lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) point1. + is_Lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) tilt_point1. Proof. split. -- exact: equilibrium_point1. +- exact: equilibrium_tilt_point1. - exact: V1_is_Lyapunov_candidate. (*- by move=> traj1 ? ?; exact: V1_point_is_lnsd. Qed.*) Abort.*) Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : - tilt_is_sol_autonomous phi Delta sol state_space_tilt -> + tilt_is_sol phi Delta Tilt.state_space sol -> (forall t, 0 < t < Delta -> differentiable sol t) -> forall t : K, 0 < t < Delta -> 'D~(sol) (V1 alpha1 gamma) t <= 0. @@ -2367,15 +2285,15 @@ Local Open Scope classical_set_scope. Context {K : realType}. Variables alpha1 gamma : K. Hypotheses (alpha1_gt0 : 0 < alpha1) (gamma_gt0 : 0 < gamma). -Let phi := tilt_eqn alpha1 gamma. +Let phi := Tilt.eqn alpha1 gamma. Let c1 := 2^-1 / alpha1. Let c2 := 2^-1 / gamma. (* todo: copy paste *) -Lemma derive_zp10 (sol : K -> 'rV_6) : - is_global_sol phi sol state_space_tilt -> - 'D_1 (Left \o sol) 0 = - alpha1 *: Left (sol 0). +Lemma derive_zp10 (sol : K -> 'rV_6) : + is_global_sol phi Tilt.state_space sol -> + 'D_1 (Left \o sol) 0 = - alpha1 *: Left (sol 0). Proof. move=> [/= sol0in]. move /(_ _ (lexx 0)) => [d0 +]. @@ -2386,12 +2304,11 @@ move=> <-. by rewrite derive_lsubmx. Qed. -Lemma derive_z20 (sol : K -> 'rV_6) : - is_global_sol phi sol state_space_tilt -> +Lemma derive_z20 (sol : K -> 'rV_6) : + is_global_sol phi Tilt.state_space sol -> 'D_1 (Right \o sol) 0 = gamma *: (Right (sol 0) - Left (sol 0)) *m \S('e_2 - Right (sol 0)) ^+ 2. Proof. - move=> [/= sol0in]. move /(_ _ (lexx 0)) => [d0 +]. move => /(congr1 Right). @@ -2399,9 +2316,8 @@ rewrite derive1E. by rewrite row_mxKr => ?; rewrite derive_rsubmx. Qed. -Lemma V1dotE0 (sol : K -> 'rV_6) - (zp1 := Left \o sol) (z2 := Right \o sol) : - is_global_sol phi sol state_space_tilt -> +Lemma V1dotE0 (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : + is_global_sol phi Tilt.state_space sol -> V1dot (sol 0) = c1 *: (2 *: 'D_1 zp1 0 *m (Left (sol 0))^T) 0 0 + c2 *: (2 *: 'D_1 z2 0 *m (Right (sol 0))^T) 0 0. @@ -2425,16 +2341,15 @@ rewrite tr_sqr_spin. by rewrite mulmxA. Qed. - Lemma derive_along_V1_global t (sol : K -> 'rV_6) : 0 <= t -> - is_global_sol phi sol state_space_tilt -> + is_global_sol phi Tilt.state_space sol -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0 tilt_eqnx. -have dif1 : forall (t : K), (0 <= t) -> differentiable sol t. +have dif1 : forall (t : K), 0 <= t -> differentiable sol t. move => /= t' t'0. - apply /derivable1_diffP. + apply/derivable1_diffP. by apply tilt_eqnx. rewrite /V1 derive_alongD; last 3 first. apply/differentiableM => //=. @@ -2464,14 +2379,14 @@ exact:dif1. Qed. Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : - is_global_sol phi sol state_space_tilt -> + is_global_sol phi Tilt.state_space sol -> forall t : K, 0 <= t -> 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. move=> solves. -have diff : forall (t : K), (0 <= t) -> differentiable sol t. +have diff : forall (t : K), 0 <= t -> differentiable sol t. move => /= t' t0'. - apply /derivable1_diffP. + apply/derivable1_diffP. by apply solves. move => t t0. rewrite derive_along_V1_global//. @@ -2501,14 +2416,14 @@ Context {K : realType}. Variables gamma alpha1 : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Let phi := tilt_eqn alpha1 gamma. +Let phi := Tilt.eqn alpha1 gamma. Variable Init : set 'rV[K]_6. (* Hypothesis y_sol : is_sol Delta (sol 0). *) (* Hypothesis y00 : sol 0 0 = 0. *) Lemma is_equilibrium_subset : 0 \in Init -> - is_equilibrium_point phi state_space_tilt 0 -> + is_equilibrium_point phi Tilt.state_space 0 -> is_equilibrium_point phi Init 0. Proof. move=> Init0. @@ -2517,7 +2432,7 @@ have [inD0 about_sol] := H Delta0. by split. Qed. -Lemma V1_diff : forall t : 'rV_6, differentiable (V1 alpha1 gamma) t. +Lemma V1_diff : forall t : 'rV_6, differentiable (V1 alpha1 gamma) t. Proof. move=> t; apply/differentiableD => //=. apply/differentiableM => //=. @@ -2527,8 +2442,8 @@ exact/differentiable_enorm_squared/differentiable_rsubmx_comp. Qed. Lemma equilibrium_zero_stable : - 0 \in Init -> open Init -> Init `<=` state_space_tilt -> - is_locally_stable_at phi Init point1. + 0 \in Init -> open Init -> Init `<=` Tilt.state_space -> + is_locally_stable_at phi Init Tilt.point1. Proof. move=> Init0 openInit Init_in_state. apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). @@ -2539,7 +2454,7 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). + assumption. + assumption. + rewrite -/phi. - apply: (@is_sol_subset _ _ _ Delta _ _ _ Init_in_state). + apply: (@tilt_is_solS _ _ _ Delta _ _ Init_in_state). split. assumption. assumption. @@ -2552,7 +2467,7 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). rewrite tDelta andbT. assumption. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. - rewrite /is_Lyapunov_candidate /point1 => Hpos. + rewrite /is_Lyapunov_candidate /Tilt.point1 => Hpos. rewrite /V1 lsubmx_const rsubmx_const; split => //. split. by rewrite !expr2 !enorm0 !mulr0 !mul0r add0r. @@ -2560,7 +2475,7 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). case : Hpos => // _ [V1_eq0 V1_gt0]. apply: V1_gt0 => //. by rewrite inE. -- exact/is_equilibrium_subset/equilibrium_point1. +- exact/is_equilibrium_subset/equilibrium_tilt_point1. Qed. End equilibrium_zero_stable. @@ -2595,6 +2510,83 @@ End equilibrium_zero_stable. (* Admitted. *) (* End LaSalle. *) +(* TODO: move *) +Lemma open_disjoint_separated (X : topologicalType) (A B : set X) : + open A -> open B -> A `&` B = set0 -> separated A B. +Proof. +move=>Ao Bo ABdisj. +split. +apply /disjoints_subset. +rewrite (closure_id (~` B)).1; last by apply open_closedC. +by apply /closure_subset/disjoints_subset. +rewrite setIC;apply /disjoints_subset. +rewrite (closure_id (~` A)).1; last by apply open_closedC. +apply /closure_subset/disjoints_subset. +by rewrite setIC. +Qed. + +(* TODO: move *) +Lemma separated_closedUP {T : topologicalType} (A B : set T) : separated A B -> + closed (A `|` B) <-> closed A /\ closed B. +Proof. +move => ABsep. +split => [/closure_id h | [h1 h2]]; last by apply closedU. +rewrite closureU in h. +split;apply /closure_id/seteqP;split => [|x cx]; try by apply subset_closure. +have /orP[] : (x \in A) || (x \in B). + by rewrite -in_setU h inE/=;left. +by rewrite inE. +rewrite inE => xB. +have [/seteqP[+ _] _] := ABsep. +case /(_ x). +by split. +have /orP[] : (x \in A) || (x \in B). + by rewrite -in_setU h inE/=;right. +rewrite inE => xB. +have [_ /seteqP[+ _]] := ABsep. +case /(_ x). +by split. +by rewrite inE. +Qed. + +(* TODO: move *) +Lemma mxnorm_enorm_le {K : realType} {n} (x : 'rV[K]_n) : `|x| <= `|x|_e. +Proof. +rewrite /Num.norm/=mx_normrE. +apply/bigmax_leP; split. + exact: enorm_ge0. +move=> /= [i j] _ /=. +rewrite {i}ord1. +rewrite -sqrtr_sqr. +rewrite /enorm dotmulvv sqr_enorm. +rewrite ler_sqrt; last by apply sumr_ge0 => k _;apply sqr_ge0. +rewrite (bigD1 j) //=. +rewrite lerDl. +by apply sumr_ge0 => k _;apply sqr_ge0. +Qed. + +Lemma continuous_enorm {K : realType} {n : nat} : + continuous (fun u : 'rV[K]_n => `|u|_e). +Proof. +move=> /= x. +rewrite /enorm/=. +apply/ continuous_comp=>/=. +apply: differentiable_continuous. +under eq_fun do rewrite dotmulvv sqr_enorm. +rewrite /=. +have <- : (\sum_(i < n) (fun x0 : 'rV[K]_n => x0``_i ^+ 2)) = + (fun x0 : 'rV[K]_n => \sum_(i < n) x0``_i ^+ 2). + apply funext => x0 /=. + by apply: (big_morph (fun f : 'rV[K]_n -> K => f x0)). +apply : differentiable_sum. +move => i. +have -> : (fun x0 : 'rV[K]_n => x0``_i ^+ 2) = + (fun x0 : 'rV_n => x0``_i ) ^+2 by []. +apply: differentiableX. +apply: differentiable_coord. +exact: sqrt_continuous. +Qed. + Section LaSalle_tilt. Context {K : realType}. Let U := 'rV[K]_6. @@ -2602,19 +2594,16 @@ Variable sol : U -> K -> U. Variables gamma alpha1 : K. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. -Let phi := tilt_eqn alpha1 gamma. +Let phi := Tilt.eqn alpha1 gamma. -Hypothesis solP : forall y, (y 0) \in state_space_tilt -> lasalle.is_sol phi y <-> y = sol (y 0). +Hypothesis solP : forall y, y 0 \in Tilt.state_space -> lasalle.is_sol phi y <-> y = sol (y 0). -Hypothesis initp: forall p, sol p 0 = p. +Hypothesis initp: forall p, sol p 0 = p. - - -Let isSol : forall p, p \in state_space_tilt -> is_global_sol phi (sol p) setT. +Let isSol : forall p, p \in Tilt.state_space -> is_global_sol phi [set: 'rV_6] (sol p). Proof. move => p Kp. -have : lasalle.is_sol phi (sol p). - by apply /solP; rewrite ?initp. +have : lasalle.is_sol phi (sol p) by apply/solP; rewrite ?initp. move => [/=_ H]. split; first by rewrite inE. move => /= t t0. @@ -2623,27 +2612,11 @@ split. by rewrite derive1E;apply H. Qed. - Definition Ksub (p : U) := - [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` state_space_tilt. + [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` Tilt.state_space. (* continuity in initial value: assumption needed for LaSalle *) -Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. - -Lemma mxnorm_enorm_le {n} (x : 'rV[K]_n) : `|x| <= `|x|_e. -Proof. -rewrite /Num.norm/=mx_normrE. -apply/bigmax_leP; split. - exact: enorm_ge0. -move=> /= [i j] _ /=. -rewrite {i}ord1. -rewrite -sqrtr_sqr. -rewrite /enorm dotmulvv sqr_enorm. -rewrite ler_sqrt; last by apply sumr_ge0 => k _;apply sqr_ge0. -rewrite (bigD1 j) //=. -rewrite lerDl. -by apply sumr_ge0 => k _;apply sqr_ge0. -Qed. +Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. Lemma V1_bound_compact p : compact [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p]. Proof. @@ -2685,37 +2658,20 @@ apply: bounded_closed_compact. exact: mxnorm_enorm_le. apply: (le_trans normb). by apply: (le_trans (lerD hL hR)). -- have -> : [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] = (V1 alpha1 gamma) @^-1` [set r | r <= V1 alpha1 gamma p] by []. +- have -> : [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] = + (V1 alpha1 gamma) @^-1` [set r | r <= V1 alpha1 gamma p] by []. apply: closed_comp. move => /= x xin. exact: (differentiable_continuous (V1_diff _ _ _ )). exact: closed_le. Unshelve. all: by end_near. Qed. -Lemma continuous_enorm {n:nat} : continuous (fun u : 'rV[K]_n => `|u|_e). -Proof. -move=> /= x. -rewrite /enorm/=. -apply/ continuous_comp=>/=. -apply: differentiable_continuous. -under eq_fun do rewrite dotmulvv sqr_enorm. -rewrite /=. -have <- : (\sum_(i < n) (fun x0 : 'rV[K]_n => x0``_i ^+ 2)) = (fun x0 : 'rV[K]_n => \sum_(i < n) x0``_i ^+ 2). - apply funext => x0 /=. - by apply: (big_morph (fun f : 'rV[K]_n -> K => f x0)). -apply : differentiable_sum. -move => i. -have -> : (fun x0 : 'rV[K]_n => x0``_i ^+ 2) = (fun x0 : 'rV_n => x0``_i ) ^+2 by []. -apply: differentiableX. -apply: differentiable_coord. -exact: sqrt_continuous. -Qed. Lemma compact_Ksub p : compact (Ksub p). Proof. -apply: compact_closedI. +apply: compact_closedI. exact: V1_bound_compact. -have -> : state_space_tilt = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. +have -> : Tilt.state_space = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. by []. apply : closed_comp => //. move => x xp. @@ -2724,14 +2680,15 @@ apply: continuousB. exact: cst_continuous. exact: continuous_rsubmx. Qed. -Lemma invariant_Ksub p : is_invariant sol (Ksub p). + +Lemma invariant_Ksub p : is_invariant sol (Ksub p). Proof. rewrite /= /is_invariant/=. move => /= x. (* . [/= sol' [d [solP [t h]]]]*) rewrite /Ksub/= => -[Vx Kx] t t0. split; last first. -- apply/(@state_space_tiltS _ alpha1 gamma). - exists (sol x), (t+1) => /=. (* use large enough time *) +- apply/(@tilt_state_spaceS _ alpha1 gamma). + exists (sol x), (t + 1) => /=. (* use large enough time *) split. apply global_sol_sol. split. @@ -2740,22 +2697,22 @@ split; last first. by rewrite inE. exists t;split => //. by rewrite /=in_itv/=t0/=ltrDl. - - have [] := (@isSol x). - by rewrite inE. - move => _ /= solA. - rewrite (le_trans _ Vx)//. - rewrite -[in leRHS](@initp x). - have : is_sol_on (fun=> phi) x 0 (BLeft (t+1)) (sol x). - split. - by rewrite initp// inE. - move => t'. - rewrite inE/=in_itv/= => /andP[t0' _]. - by apply solA; rewrite ltW. - rewrite closure_neitv_oo; last by rewrite ltr_wpDl. - apply: derivable_within_continuous. - move => x0. - rewrite in_itv/= => /andP[t0' _]. - by apply solA. +- have [] := (@isSol x). + by rewrite inE. + move => _ /= solA. + rewrite (le_trans _ Vx)//. + rewrite -[in leRHS](@initp x). + have : is_sol_on (fun=> phi) x 0 (BLeft (t+1)) (sol x). + split. + by rewrite initp// inE. + move => t'. + rewrite inE/=in_itv/= => /andP[t0' _]. + by apply solA; rewrite ltW. + rewrite closure_neitv_oo; last by rewrite ltr_wpDl. + apply: derivable_within_continuous. + move => x0. + rewrite in_itv/= => /andP[t0' _]. + by apply solA. move /(V_nincr ) => /=. move /(_ (V1 alpha1 gamma)). apply. @@ -2776,28 +2733,27 @@ split; last first. by rewrite lexx. Qed. -Local Lemma sol_Ksub p :forall u, u \in Ksub p -> is_global_sol phi (sol u) setT. +Local Lemma sol_Ksub p u : u \in Ksub p -> is_global_sol phi [set: 'rV_6] (sol u). Proof. - move => u. - rewrite inE/=;move=> [h1 h2]. - split. - apply isSol. - by rewrite inE. - move =>/= x. - apply isSol. +rewrite inE/= => -[h1 h2]. +split. +apply isSol. by rewrite inE. +move =>/= x. +apply isSol. +by rewrite inE. Qed. -Lemma V1dot_p1_eq0 : V1dot point1 = (0 : K). +Lemma V1dot_point1_eq0 : V1dot Tilt.point1 = (0 : K). Proof. -rewrite /V1dot /point1 /=. +rewrite /V1dot /Tilt.point1 /=. rewrite lsubmx_const rsubmx_const enorm0 expr0n /= oppr0 add0r !mul0mx sub0r oppr0. by rewrite mxE. Qed. -Lemma V1dot_p2_eq0 : V1dot point2 = (0 : K). +Lemma V1dot_point2_eq0 : V1dot Tilt.point2 = (0 : K). Proof. -rewrite /V1dot /point2 /=. +rewrite /V1dot /Tilt.point2 /=. rewrite row_mxKl row_mxKr. rewrite enorm0 expr0n /= oppr0 add0r. rewrite -!scalemxAl -scalerBr. @@ -2811,11 +2767,11 @@ suff -> : 'e_2 *v 'e_2 = (0 : 'rV[K]_3). by rewrite vece2 /= scale0r. Qed. -Local Lemma sol_continuous p : p \in state_space_tilt -> continuous (sol p). +Local Lemma sol_continuous p : p \in Tilt.state_space -> continuous (sol p). Proof. move => sp t. have [issol0 issol1]: lasalle.is_sol phi (sol p). - apply: (sol_is_sol (sol := sol) (K:=state_space_tilt) ) => //. + apply: (sol_is_sol (sol := sol) (K:=Tilt.state_space)) => //. move => y Ky. by apply /solP;rewrite inE. move : sp. @@ -2837,29 +2793,30 @@ apply /ex_derive/issol1. rewrite lerNr oppr0 ltW//. Unshelve. all: by end_near. Qed. -Local Lemma global_sol_T A sol' : is_global_sol phi sol' setT -> sol' 0 \in A -> is_global_sol phi sol' A. +Local Lemma global_sol_T A sol' : + is_global_sol phi [set: 'rV_6] sol' -> sol' 0 \in A -> is_global_sol phi A sol'. Proof. move => [_ solP'] initP. -split=>//. +by split. Qed. -Local Lemma q_inKsubq q : q \in state_space_tilt -> q \in Ksub q. +Local Lemma q_inKsubq q : q \in Tilt.state_space -> q \in Ksub q. Proof. rewrite !inE => h;split => //=. Qed. -Local Lemma limS_subset_V1dot0 p : - p \in state_space_tilt -> limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` state_space_tilt. +Local Lemma limS_subset_V1dot0 p : + p \in Tilt.state_space -> + limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.state_space. Proof. move => ps. -have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). +have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). move => y Ky. - apply /solP. + apply/solP. rewrite inE. by apply Ky. -have H : limS sol (Ksub p) `<=` [set x | derive1 (V1 alpha1 gamma \o sol x) 0 = 0] `&` state_space_tilt. - rewrite subsetI;split. +have H : limS sol (Ksub p) `<=` [set x | (V1 alpha1 gamma \o sol x)^`() 0 = 0] `&` Tilt.state_space. + rewrite subsetI; split. apply: (@stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (V1 alpha1 gamma)) => //=. - apply /continuous_subspaceT. - move => x xK. + apply/continuous_subspaceT => x xK. apply : differentiable_continuous. apply: V1_diff. move => /= p0 t K0 t0. @@ -2871,7 +2828,7 @@ have H : limS sol (Ksub p) `<=` [set x | derive1 (V1 alpha1 gamma \o sol x) 0 = by have [_ +] := K0. exact: V1_diff. move => p0 K0. - have p0s : (p0 \in state_space_tilt). + have p0s : p0 \in Tilt.state_space. by move : K0;rewrite inE/=/Ksub/inE/=;move=>[]. rewrite derive1E. rewrite -derive_along_derive. @@ -2915,7 +2872,7 @@ by rewrite initp ?inE. split => //. by rewrite initp ?inE. move=>x0 x0t. -have h1' : (x \in state_space_tilt) by rewrite inE. +have h1' : x \in Tilt.state_space by rewrite inE. by apply (isSol h1'). apply V1_diff. apply /derivable1_diffP. @@ -2923,61 +2880,62 @@ apply isSol => //. by rewrite inE. Qed. -Lemma limS_subset_p1p2 p : - p \in state_space_tilt -> limS sol (Ksub p) `<=` [set point1; point2]. +Lemma limS_subset_points p : + p \in Tilt.state_space -> limS sol (Ksub p) `<=` Tilt.points. Proof. -have -> : [set point1; point2] = [set x : 'rV[K]_6 | V1dot x = 0] `&` state_space_tilt. - apply /seteqP;split => x /=. - case => ->;split; [exact: V1dot_p1_eq0 | | exact: V1dot_p2_eq0 | ]. - have := (@point1_in_state_space_tilt K). - by rewrite inE. - have := (@point2_in_state_space_tilt K). - by rewrite inE. +have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.state_space. + apply/seteqP; split => x /=. + case => ->;split; [exact: V1dot_point1_eq0 | | exact: V1dot_point2_eq0 | ]. + have := @tilt_point1_in_state_space K. + by rewrite inE. + have := @tilt_point2_in_state_space K. + by rewrite inE. move => [h1 h2']. - have h2: x \in state_space_tilt by rewrite inE. + have h2 : x \in Tilt.state_space by rewrite inE. move : h1. have hi := initp x. rewrite -hi => h1. - have sol' : tilt_is_sol_autonomous phi 1 (sol x) state_space_tilt. + have sol' : tilt_is_sol phi 1 Tilt.state_space (sol x) . apply: global_sol_sol. split. - by rewrite hi. + by rewrite hi. by apply isSol. apply: (V1dot_eq0_p1_or_p2 sol') => //. by rewrite in_itv /= lexx ltr01. by apply limS_subset_V1dot0. Qed. +From mathcomp Require Import finmap. + (*Todo: generalize + PR? *) -Lemma compact_decreasing_bigcap - (X : ptopologicalType) (B : K -> set X) (O : set X) : +Lemma compact_decreasing_bigcap (X : ptopologicalType) (B : K -> set X) (O : set X) : hausdorff_space X -> (forall i, 0 <= i -> compact (B i)) -> - (forall i j, i <= j -> B j `<=` B i) -> + (forall i j, i <= j -> B j `<=` B i) -> open O -> (\bigcap_(i in [set i | 0 <= i]) B i `<=` O) -> - exists i0, (0 <= i0) /\ B i0 `<=` O. + exists i0, 0 <= i0 /\ B i0 `<=` O. Proof. move => H comp decr openO subO. -set V := fun i => ((B i) `&` ~` O). -have comp' i : (0 <= i) -> compact (V i). - move=>i0. +set V := fun i => B i `&` ~` O. +have comp' i : 0 <= i -> compact (V i). + move=> i0. apply: compact_closedI. by apply comp. by apply open_closedC. -have decr' i j : i <= j -> V j `<=` V i. +have decr' i j : i <= j -> V j `<=` V i. move=>ij. rewrite /V. - by apply setSI;apply decr. - -apply /not_existsP. + by apply setSI; apply decr. +rewrite /=. +apply/not_existsP. move => /= hf. -suff /set0P : \bigcap_(i in [set t | 0 <= t]) V i !=set0. +suff /set0P : \bigcap_(i in [set t | 0 <= t]) V i !=set0. rewrite /V/=. rewrite bigcapIl; last first. by exists 0 => /=. - move /eqP => h. - by have /subsets_disjoint := h. + move /eqP => h. + by have /subsets_disjoint := h. have cf : closed_fam_of (B 0) [set t | t >= 0] V. exists V => /=t t0 //. apply closedI. @@ -2996,42 +2954,6 @@ rewrite compact_In0/=. apply => //. Admitted. -Lemma open_disjoint_separated (X : topologicalType) (A B : set X) : - open A -> open B -> A `&` B = set0 -> separated A B. -Proof. - move=>Ao Bo ABdisj. - split. - apply /disjoints_subset. - rewrite (closure_id (~` B)).1; last by apply open_closedC. - by apply /closure_subset/disjoints_subset. - rewrite setIC;apply /disjoints_subset. - rewrite (closure_id (~` A)).1; last by apply open_closedC. - apply /closure_subset/disjoints_subset. - by rewrite setIC. -Qed. - -Lemma separated_closedUP {T : topologicalType} (A B : set T) : separated A B -> closed (A `|` B) <-> closed A /\ closed B. -Proof. - move => ABsep. - split => [/closure_id h | [h1 h2]]; last by apply closedU. - rewrite closureU in h. - split;apply /closure_id/seteqP;split => [|x cx]; try by apply subset_closure. - have /orP[] : (x \in A) || (x \in B). - by rewrite -in_setU h inE/=;left. - by rewrite inE. - rewrite inE => xB. - have [/seteqP[+ _] _] := ABsep. - case /(_ x). - by split. - have /orP[] : (x \in A) || (x \in B). - by rewrite -in_setU h inE/=;right. - rewrite inE => xB. - have [_ /seteqP[+ _]] := ABsep. - case /(_ x). - by split. - by rewrite inE. -Qed. - (*Todo: PR? *) (* NB: should be possible to generalize without normal_space X *) Lemma compact_connected_cluster @@ -3072,11 +2994,10 @@ have Bcom t : 0 <= t -> compact (B t). move : tp. rewrite /=in_itv/= => /andP[+ _]. by apply le_trans. - move /(_ t0ge0). - by rewrite inE. -have -> : cluster (f t @[t --> +oo]) = \bigcap_(t in [set t | 0 <= t]) B t. + by move /(_ t0ge0) /set_mem. +have -> : cluster (f t @[t --> +oo]) = \bigcap_(t in [set t | 0 <= t]) B t. rewrite clusterE. - apply /seteqP;split. + apply/seteqP;split. apply:sub_bigcap => t0 _. apply: bigcap_inf. exists t0; split. @@ -3126,43 +3047,40 @@ apply hbv. by apply EB;left. Qed. -Lemma cvg_to_set_p1_p2 p : p \in state_space_tilt -> - sol p t @[t --> +oo] --> [set point1; point2]. -Proof. -rewrite inE => ps. -have : p \in Ksub p. - by rewrite inE; split => //=. +Lemma cvg_to_set_points p : p \in Tilt.state_space -> + sol p t @[t --> +oo] --> Tilt.points. +Proof. +move=> /set_mem ps. +have : p \in Ksub p by apply/mem_set; split => //=. move => pK. have p0K : (forall p0 : 'rV_6, p0 \in Ksub p -> sol p0 0 = p0). - move => q. - rewrite inE/=. - move => [_ h]. - apply: initp. -apply : (cvg_trans (cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) _)). - by move:pK; rewrite inE. + move => q /set_mem[_ h]. + exact: initp. +apply: (cvg_trans (cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) _)). + by move: pK => /set_mem. move => /= S [eps eps0 Be]. exists eps => //. apply bigcup_sub => /= x H. apply: (subset_trans _ Be). -have ps' : p \in state_space_tilt by rewrite inE. -have : [set point1; point2] x. - by apply: (limS_subset_p1p2 ps'). +have ps' : p \in Tilt.state_space by exact/mem_set. +have : Tilt.points x by apply: (limS_subset_points ps'). move => h x' Bx'. -by exists x => //. +by exists x. Qed. -Lemma avoid_x (x : U) : (~` [set point1; point2]) x -> - exists S : set U, [/\ open S, [set point1; point2] `<=` S & ~ closure S x]. +Lemma avoid_x (x : U) : (~` Tilt.points) x -> + exists S : set U, [/\ open S, Tilt.points `<=` S & ~ closure S x]. Proof. move => hx. have cx : closed [set x]. by apply accessible_closed_set1; apply hausdorff_accessible. -have cp : closed [set (point1 : U);point2]. +have cp : closed (@Tilt.points K). + rewrite /Tilt.points. by apply accessible_finite_set_closed => //; apply hausdorff_accessible. have /(@normal_openP K) Hn : normal_space U by apply: pseudometric_normal. have [|V1 [V2 [V1o V2o V1c V2c Vdisj]]] := (Hn _ _ cx cp). apply disjoints_subset. - by rewrite sub1set inE. + by rewrite sub1set; apply/mem_set . exists V2;split => //. move => h. have [_ +] := open_disjoint_separated V1o V2o Vdisj. @@ -3173,62 +3091,68 @@ split => //. by apply V1c. Qed. -Lemma cluster_contained_p1p2 p : p \in state_space_tilt -> cluster (sol p t @[t --> +oo]) `<=` [set point1; point2]. +Lemma cluster_contained_points p : p \in Tilt.state_space -> + cluster (sol p t @[t --> +oo]) `<=` Tilt.points. Proof. move => ps. -have /cvg_cluster cp12 := (cvg_to_set_p1_p2 ps). -apply: (subset_trans cp12). +have /cvg_cluster cp12 := cvg_to_set_points ps. +apply: (subset_trans cp12). rewrite clusterE. move => /= x H. -suff : (~ (~` [set point1; point2]) x) by apply contrapT. +suff : (~ (~` Tilt.points) x) by apply contrapT. move => Hdist. have [S [So Sc Sx]] := avoid_x Hdist. -have [e1 /= e10 /= P1] : \forall e \near 0^'+, ball point1 e `<=` S. +have [e1 /= e10 /= P1] : \forall e \near 0^'+, ball Tilt.point1 e `<=` S. apply: open_subball => //. by apply Sc;left. -have [e2 /= e20 /= P2] : \forall e \near 0^'+, ball point2 e `<=` S. +have [e2 /= e20 /= P2] : \forall e \near 0^'+, ball Tilt.point2 e `<=` S. apply: open_subball => //. by apply Sc;right. set eps := min (e1/2) (e2/2). have eps0 : 0 < eps. by rewrite lt_min !divr_gt0. -have B1 : ball point1 eps `<=` S. +have B1 : ball Tilt.point1 eps `<=` S. apply P1 => //. rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ltr_pdivrMr // ltr_pMr ?ltrDr //. by apply /orP;left. -have B2 : ball point2 eps `<=` S. +have B2 : ball Tilt.point2 eps `<=` S. apply P2 => //. rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ?ltr_pdivrMr // ltr_pMr ?ltrDr //. by apply /orP;right. -have nbh' : (nbhs [set point1;point2] S). +have nbh' : (nbhs Tilt.points S). exists eps => //=. rewrite /ball_set. by apply: bigcup_sub => /= _ [-> | ->]. -by have := (H _ nbh'). +by have := H _ nbh'. Qed. -Local Lemma connected2_subset (A : set U) : connected A -> A !=set0 -> A `<=` [set point1; point2] -> A = [set point1] \/ A = [set point2]. +Local Lemma connected2_subset (A : set U) : connected A -> A !=set0 -> + A `<=` Tilt.points -> A = [set Tilt.point1] \/ A = [set Tilt.point2]. Proof. move=>Ac Anonempty Asub. -have sep : separated [set (point1 : U)] [set point2]. +have sep : separated [set (@Tilt.point1 K)] [set Tilt.point2]. split. - rewrite -(closure_id _).1; last first. - by apply accessible_closed_set1; apply hausdorff_accessible. - apply /disjoints_subset. - rewrite sub1set. - rewrite inE /=. - rewrite /point1/point2. - admit. - admit. + - rewrite -(closure_id _).1; last first. + by apply accessible_closed_set1; apply hausdorff_accessible. + apply/disjoints_subset. + rewrite sub1set. + apply/mem_set => /=. + exact/eqP/Tilt.point1_neq2. + - rewrite setIC -(closure_id _).1; last first. + by apply accessible_closed_set1; apply hausdorff_accessible. + apply/disjoints_subset. + rewrite sub1set. + apply/mem_set => /=. + exact/nesym/eqP/Tilt.point1_neq2. have [/subset_set1 [/nonemptyPn A0 | ] | /subset_set1 [/nonemptyPn A0 |] ]:= (connected_subset sep Asub Ac) => //. by left. by right. -Admitted. +Qed. -Lemma cluster_nonempty p : p \in state_space_tilt -> cluster (sol p t @[t --> +oo]) !=set0. +Lemma cluster_nonempty p : p \in Tilt.state_space -> cluster (sol p t @[t --> +oo]) !=set0. Proof. move => sp. -suff : (Ksub p) `&` cluster (sol p t @[t --> +oo]) !=set0. +suff : (Ksub p) `&` cluster (sol p t @[t --> +oo]) !=set0. move => [x [_ cx]]. by exists x. apply (@compact_Ksub p) => //. @@ -3236,35 +3160,32 @@ apply (@compact_Ksub p) => //. apply sub_image_at_infty => /=. move => _ [t t0] <-. apply invariant_Ksub => //. -have:= (q_inKsubq sp). -by rewrite inE. +by have /set_mem := q_inKsubq sp. Qed. -Lemma p1_Ksub p : Ksub p point1. +Lemma p1_Ksub p : Ksub p Tilt.point1. Proof. -split => /=; last by have := (@point1_in_state_space_tilt K);rewrite inE. -rewrite /point1/V1. +split => /=; last by have /set_mem := @tilt_point1_in_state_space K. +rewrite /Tilt.point1 /V1. rewrite lsubmx_const rsubmx_const/= !enorm0 !expr0n /= !mul0r add0r. by rewrite addr_ge0 // divr_ge0 // ?sqr_ge0 ?mulr_ge0 // ltW. Qed. (*Todo : PR ? *) - -Lemma cvg_to_p1_or_p2 p : (p \in state_space_tilt) -> - (sol p t @[t --> +oo] --> point1 ) \/ ( sol p t @[t --> +oo] --> point2). +Lemma cvg_to_p1_or_p2 p : p \in Tilt.state_space -> + (sol p t @[t --> +oo] --> Tilt.point1 ) \/ ( sol p t @[t --> +oo] --> Tilt.point2). Proof. move => ps. have cluster_con : connected (cluster (sol p t @[t --> +oo])). apply: (compact_connected_cluster _ _ _ (@compact_Ksub p) ) => //. by apply: pseudometric_normal. by apply: sol_continuous. - move => t. - rewrite inE. - apply : invariant_Ksub. - have := q_inKsubq ps. - by rewrite inE. -have := connected2_subset cluster_con (cluster_nonempty ps) (cluster_contained_p1p2 ps). -suff H (q : U): cluster (sol p t @[t --> +oo]) = [set q] -> sol p t @[t --> +oo] --> q. + move => t t0. + apply/mem_set. + apply: invariant_Ksub => //. + by have /set_mem := q_inKsubq ps. +have := connected2_subset cluster_con (cluster_nonempty ps) (cluster_contained_points ps). +suff H (q : U): cluster (sol p t @[t --> +oo]) = [set q] -> sol p t @[t --> +oo] --> q. move => [h | h]; [left | right];apply H => //. move => H. @@ -3283,9 +3204,8 @@ have Ksubq : Ksub p q. move => /= _ [t +] <-. rewrite in_itv/= => /andP[t0 _]. apply invariant_Ksub => //. - have := q_inKsubq ps. - by rewrite inE. -have [M [Mr Mp]]: bounded_set (Ksub p). + by have /set_mem := q_inKsubq ps. +have [M [Mr Mp]]: bounded_set (Ksub p). apply compact_bounded. exact: compact_Ksub. have [M0 | M0] := leP 0 M;last first. @@ -3299,17 +3219,11 @@ set V := ball (p : U) (`|p|+(M+1+1) : K). have VKsub : Ksub p `<=` V. move => /= x Kx. rewrite /V -ball_normE/ball_ /=. - apply: (le_lt_trans (ler_normB _ _)). - apply: ler_ltD => //. - apply: ltr_pwDr => //. - apply Mp => //. - by apply: ltr_pwDr => //. + by rewrite (le_lt_trans (ler_normB _ _))// ltrD2l ltr_pwDr// Mp// ltrDl. have B1 : 0 < `|p| + (M + 1 + 1). - rewrite ltr_wpDl//?normr_ge0. - apply addr_gt0 => //. - by rewrite ltr_wpDl. + by rewrite ltr_wpDl// addr_gt0// ltr_wpDl. have Vo : open V. - by rewrite /V;apply: ball_open. + by rewrite /V; exact: ball_open. have cV : compact (closure V). rewrite closure_ballE closed_ballE//. apply: bounded_closed_compact; last by apply: closed_closed_ball_. @@ -3331,7 +3245,7 @@ exists 0;split => //= x /ltW x0. rewrite -(closure_id (Ksub p)).1;last first. by apply compact_closed =>//; apply compact_Ksub. apply invariant_Ksub => //. -have := q_inKsubq ps. -by rewrite inE. +by have /set_mem := q_inKsubq ps. Qed. + End LaSalle_tilt. From 695c794ed04dd074ca2c26a489833517173152bc Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Mon, 9 Feb 2026 19:06:03 +0900 Subject: [PATCH 099/144] minor wip --- tilt.v | 1 + 1 file changed, 1 insertion(+) diff --git a/tilt.v b/tilt.v index 3664d84f..6099bfaa 100644 --- a/tilt.v +++ b/tilt.v @@ -2952,6 +2952,7 @@ have cf : closed_fam_of (B 0) [set t | t >= 0] V. have : compact (B 0) by apply comp. rewrite compact_In0/=. apply => //. + Admitted. (*Todo: PR? *) From 1d76ae4c7724a2e0ad2fc8cae02a77ef3dc5b2cd Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Mon, 9 Feb 2026 20:08:47 +0900 Subject: [PATCH 100/144] covering lemma --- tilt.v | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) diff --git a/tilt.v b/tilt.v index 6099bfaa..ab224dc9 100644 --- a/tilt.v +++ b/tilt.v @@ -2907,6 +2907,7 @@ Qed. From mathcomp Require Import finmap. + (*Todo: generalize + PR? *) Lemma compact_decreasing_bigcap (X : ptopologicalType) (B : K -> set X) (O : set X) : hausdorff_space X -> @@ -2952,9 +2953,25 @@ have cf : closed_fam_of (B 0) [set t | t >= 0] V. have : compact (B 0) by apply comp. rewrite compact_In0/=. apply => //. - -Admitted. - +move => D Ds. +set m := \big[max/0]_(z <- D) z. +have M : forall x, x \in D -> x <= m. + move=>x xD. + rewrite /m. + by apply: le_bigmax_seq. +suff Vm : V m `<=` \bigcap_(i in [set` D]) V i . + apply: (subset_nonempty Vm). + have := (hf m). + apply contra_notP. + rewrite /V. + move /nonemptyPn => Ve. + split => //. + apply: bigmax_ge_id. + by apply subsets_disjoint. +apply sub_bigcap => i Di. +apply decr'. +by apply M. +Qed. (*Todo: PR? *) (* NB: should be possible to generalize without normal_space X *) Lemma compact_connected_cluster From 74b1dce3629bbf55f363d5d4ce4534c51cb82ff1 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 9 Feb 2026 21:08:17 +0900 Subject: [PATCH 101/144] Gamma1 --- tilt.v | 157 +++++++++++++++++++++++---------------------------------- 1 file changed, 64 insertions(+), 93 deletions(-) diff --git a/tilt.v b/tilt.v index ab224dc9..2a0b5378 100644 --- a/tilt.v +++ b/tilt.v @@ -18,7 +18,7 @@ Require Import ode lasalle. (* locnegsemidef V x == V is locally negative semidefinite *) (* 'D~(sol, x0) V == derivative of V along the solution sol *) (* starting at x0 *) -(* tilt_is_sol_autonomous phi Delta Init f := f 0 \in Init + *) +(* tilt_is_sol phi Delta Init f := f 0 \in Init + *) (* is_sol_on phi (f 0) 0 Delta f *) (* is_equilibrium_point f p := solves_equation f (cst p) *) (* state_space f == the set points attainable by a solution *) @@ -468,7 +468,7 @@ Definition derive_along_partial {R : realType} n (V : 'rV[R]_n -> R) (a : R -> 'rV[R]_n) (t : R) : R := \sum_(i < n) (partial V (a t) i * ('D_1 a t) ``_ i). -Section picard. +(*Section picard. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. Variable u0 : U. @@ -488,7 +488,7 @@ Theorem picard_lindeloeff_autonomous t0 : delta > 0 /\ is_sol_on (fun=> phi) u0 t0 (BLeft (t0 + delta)) sol. Admitted. -End picard. +End picard.*) Section ode. Context {K : realType} {n : nat}. @@ -500,7 +500,7 @@ Definition tilt_is_sol (Delta : K) (Init : set U) (f : K -> U) := f 0 \in Init /\ is_sol_on (fun=> phi) (f 0) 0 (BLeft Delta) f. Definition is_global_sol (Init : set U) (f : K -> U) := - f 0 \in Init /\ forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). + f 0 \in Init /\ forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). Lemma global_sol_sol f Init : is_global_sol Init f -> forall Delta, tilt_is_sol Delta Init f. @@ -1381,7 +1381,7 @@ Proof. by []. Qed. Lemma eqn_functionalE f t : eqn_functional f t = eqn (f t). Proof. by []. Qed. -Definition state_space := [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. +Definition Gamma1 := [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). @@ -1489,7 +1489,7 @@ rewrite ge_max; apply/andP; split. Unshelve. all: by end_near. Qed. Lemma tilt_state_spaceS : - state_space phi Tilt.state_space `<=` Tilt.state_space. + state_space phi Tilt.Gamma1 `<=` Tilt.Gamma1. Proof. move => p [y [Delta [[y0_init1 [/=_ deri conti] ]]]]. have [Delta0|Delta0] := leP 0 Delta; last first. @@ -1497,7 +1497,7 @@ have [Delta0|Delta0] := leP 0 Delta; last first. rewrite in_itv/= => -/andP[x0 xDelta]. have := lt_trans xDelta Delta0. by rewrite ltNge x0. -rewrite /Tilt.state_space. +rewrite /Tilt.Gamma1. have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))))^`() =1 0}. move => x xd /=. transitivity ((fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))) x). @@ -1579,18 +1579,18 @@ suff: `|'e_2 - Right (y t)|_e ^+ 2 = 1. rewrite norm_constant//; last first. by rewrite inE; exact: subset_itv_co_cc. move: y0_init1. -rewrite inE /Tilt.state_space /= => ->. +rewrite inE /Tilt.Gamma1 /= => ->. by rewrite expr2 mulr1. Qed. -Lemma tilt_point1_in_state_space : @Tilt.point1 K \in Tilt.state_space. +Lemma tilt_point1_in_state_space : @Tilt.point1 K \in Tilt.Gamma1. Proof. -rewrite inE /Tilt.state_space /Tilt.point1/=. +rewrite inE /Tilt.Gamma1 /Tilt.point1/=. by rewrite rsubmx_const /= subr0 enormeE. Qed. Lemma equilibrium_tilt_point1 : - is_equilibrium_point phi Tilt.state_space Tilt.point1. + is_equilibrium_point phi Tilt.Gamma1 Tilt.point1. Proof. split. - exact: tilt_point1_in_state_space. @@ -1612,9 +1612,9 @@ split. exact: cvg_cst. Qed. -Lemma tilt_point2_in_state_space : @Tilt.point2 K \in Tilt.state_space. +Lemma tilt_point2_in_state_space : @Tilt.point2 K \in Tilt.Gamma1. Proof. -rewrite inE /Tilt.state_space /Tilt.point2 /=. +rewrite inE /Tilt.Gamma1 /Tilt.point2 /=. rewrite row_mxKr. rewrite -[X in X - _ ]scale1r. rewrite -scalerBl enormZ enormeE mulr1 distrC. @@ -1623,7 +1623,7 @@ by rewrite -natrB //= normr1. Qed. Lemma equilibrium_tilt_point2 : - is_equilibrium_point phi Tilt.state_space Tilt.point2. + is_equilibrium_point phi Tilt.Gamma1 Tilt.point2. Proof. split; first exact: tilt_point2_in_state_space. split => //. @@ -1842,7 +1842,7 @@ Let phi := Tilt.eqn alpha1 gamma. Variable Delta : K. Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : - tilt_is_sol phi Delta Tilt.state_space sol -> + tilt_is_sol phi Delta Tilt.Gamma1 sol -> t \in `]0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. move=> [/= sol0in [_ deri conti] t0Delta]. @@ -1855,7 +1855,7 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - tilt_is_sol phi Delta Tilt.state_space sol -> + tilt_is_sol phi Delta Tilt.Gamma1 sol -> z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. @@ -1868,8 +1868,8 @@ Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : t \in `[0, Delta[%R -> - tilt_is_sol phi Delta Tilt.state_space sol -> - Tilt.state_space (sol t). + tilt_is_sol phi Delta Tilt.Gamma1 sol -> + Tilt.Gamma1 (sol t). Proof. move=> t0Delta. case => sol0 [_ deriv_sol csol]. @@ -1886,11 +1886,11 @@ Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - tilt_is_sol phi Delta Tilt.state_space sol -> `|u|_e = 1. + tilt_is_sol phi Delta Tilt.Gamma1 sol -> `|u|_e = 1. Proof. move=> z0Delta dtraj. -suff: Tilt.state_space (row_mx (zp1 z) (z2 z)). - by rewrite /Tilt.state_space/= row_mxKr. +suff: Tilt.Gamma1 (row_mx (zp1 z) (z2 z)). + by rewrite /Tilt.Gamma1/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. by apply: is_sol_state_space_tilt => //. Qed. @@ -1898,7 +1898,7 @@ Qed. Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - tilt_is_sol phi Delta Tilt.state_space sol -> + tilt_is_sol phi Delta Tilt.Gamma1 sol -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> z0Delta dtraj. @@ -1922,7 +1922,7 @@ Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : z \in `[0, Delta[%R -> - tilt_is_sol phi Delta Tilt.state_space sol -> + tilt_is_sol phi Delta Tilt.Gamma1 sol -> `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = `|Right (sol z) *m \S('e_2)|_e. Proof. @@ -1931,7 +1931,7 @@ rewrite mulmxN enormN. pose zp1 := fun r => Left (sol r). pose z2 := fun r => Right (sol r). set w := (z2 z) *m \S('e_2). -have Gamma1_traj : Tilt.state_space (sol z) by apply/is_sol_state_space_tilt. +have Gamma1_traj : Tilt.Gamma1 (sol z) by apply/is_sol_state_space_tilt. rewrite /enorm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. have Hnorm_sq : `|w *m \S('e_2 - Right (sol z))|_e ^+ 2 = `|w|_e ^+ 2. @@ -1948,7 +1948,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - tilt_is_sol phi Delta Tilt.state_space sol -> + tilt_is_sol phi Delta Tilt.Gamma1 sol -> z \in `]0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + @@ -1975,7 +1975,7 @@ Qed. Lemma derive_along_V1 t (sol : K -> 'rV_6) : t \in `]0, Delta[ -> - tilt_is_sol phi Delta Tilt.state_space sol -> + tilt_is_sol phi Delta Tilt.Gamma1 sol -> (forall t, t \in `]0, Delta[ -> differentiable sol t) -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. @@ -2011,7 +2011,7 @@ Definition u1 (sol : K -> 'rV[K]_6) t \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 t|_e, 1 |-> `|w|_e] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - tilt_is_sol phi Delta Tilt.state_space sol -> + tilt_is_sol phi Delta Tilt.Gamma1 sol -> forall t, t \in `[0, Delta[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. @@ -2043,7 +2043,7 @@ by rewrite [leRHS]mulrC. Qed. Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : - tilt_is_sol phi Delta Tilt.state_space sol -> + tilt_is_sol phi Delta Tilt.Gamma1 sol -> t \in `[0, Delta[%R -> V1dot (sol t) = 0 -> sol t = Tilt.point1 \/ sol t = Tilt.point2. @@ -2073,7 +2073,7 @@ suff [-> | -> ] : Right (sol t) = 0 \/ Right (sol t) = (2 *: 'e_2). right;apply /matrixP => i j;rewrite mxE. by case: splitP => // k _. have := is_sol_state_space_tilt t0d solP. -rewrite /Tilt.state_space/=. +rewrite /Tilt.Gamma1/=. have /sub_rVP [k ->] : (Right (sol t) <= ('e_2 : 'rV[K]_3))%MS. apply: (@submx_trans _ _ _ _ _ _ (kermx \S('e_2))). by apply /sub_kermxP. @@ -2091,7 +2091,7 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : - tilt_is_sol phi Delta Tilt.state_space (sol x) -> + tilt_is_sol phi Delta Tilt.Gamma1 (sol x) -> sol x 0 = Tilt.point1 -> \forall z \near 0^', ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + @@ -2134,7 +2134,7 @@ Unshelve. all: try by end_near. Abort. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - tilt_is_sol phi Delta Tilt.state_space (sol x) -> + tilt_is_sol phi Delta Tilt.Gamma1 (sol x) -> sol x 0 = Tilt.point1 -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. @@ -2174,8 +2174,8 @@ Abort. Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - tilt_is_sol phi Delta Tilt.state_space (sol x) -> - (forall t : K, Tilt.state_space (sol x t)) -> + tilt_is_sol phi Delta Tilt.Gamma1 (sol x) -> + (forall t : K, Tilt.Gamma1 (sol x t)) -> sol x 0 = Tilt.point1 -> locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. @@ -2247,7 +2247,7 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : - tilt_is_sol phi Delta Tilt.state_space sol -> + tilt_is_sol phi Delta Tilt.Gamma1 sol -> (forall t, 0 < t < Delta -> differentiable sol t) -> forall t : K, 0 < t < Delta -> 'D~(sol) (V1 alpha1 gamma) t <= 0. @@ -2292,7 +2292,7 @@ Let c2 := 2^-1 / gamma. (* todo: copy paste *) Lemma derive_zp10 (sol : K -> 'rV_6) : - is_global_sol phi Tilt.state_space sol -> + is_global_sol phi Tilt.Gamma1 sol -> 'D_1 (Left \o sol) 0 = - alpha1 *: Left (sol 0). Proof. move=> [/= sol0in]. @@ -2305,7 +2305,7 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z20 (sol : K -> 'rV_6) : - is_global_sol phi Tilt.state_space sol -> + is_global_sol phi Tilt.Gamma1 sol -> 'D_1 (Right \o sol) 0 = gamma *: (Right (sol 0) - Left (sol 0)) *m \S('e_2 - Right (sol 0)) ^+ 2. Proof. @@ -2317,7 +2317,7 @@ by rewrite row_mxKr => ?; rewrite derive_rsubmx. Qed. Lemma V1dotE0 (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_global_sol phi Tilt.state_space sol -> + is_global_sol phi Tilt.Gamma1 sol -> V1dot (sol 0) = c1 *: (2 *: 'D_1 zp1 0 *m (Left (sol 0))^T) 0 0 + c2 *: (2 *: 'D_1 z2 0 *m (Right (sol 0))^T) 0 0. @@ -2343,7 +2343,7 @@ Qed. Lemma derive_along_V1_global t (sol : K -> 'rV_6) : 0 <= t -> - is_global_sol phi Tilt.state_space sol -> + is_global_sol phi Tilt.Gamma1 sol -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0 tilt_eqnx. @@ -2379,7 +2379,7 @@ exact:dif1. Qed. Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : - is_global_sol phi Tilt.state_space sol -> + is_global_sol phi Tilt.Gamma1 sol -> forall t : K, 0 <= t -> 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. @@ -2423,7 +2423,7 @@ Variable Init : set 'rV[K]_6. (* Hypothesis y00 : sol 0 0 = 0. *) Lemma is_equilibrium_subset : 0 \in Init -> - is_equilibrium_point phi Tilt.state_space 0 -> + is_equilibrium_point phi Tilt.Gamma1 0 -> is_equilibrium_point phi Init 0. Proof. move=> Init0. @@ -2442,7 +2442,7 @@ exact/differentiable_enorm_squared/differentiable_rsubmx_comp. Qed. Lemma equilibrium_zero_stable : - 0 \in Init -> open Init -> Init `<=` Tilt.state_space -> + 0 \in Init -> open Init -> Init `<=` Tilt.Gamma1 -> is_locally_stable_at phi Init Tilt.point1. Proof. move=> Init0 openInit Init_in_state. @@ -2480,36 +2480,6 @@ Qed. End equilibrium_zero_stable. -(* from https://github.com/drouhling/LaSalle *) -(* Section LaSalle. *) -(* Context {R : realType} {n : nat}. *) -(* Let U := 'rV[R]_n. *) -(* Variable phi : U -> U. *) -(* Variable sol : U -> R -> U. *) - -(* Definition limS (A : set U) := \bigcup_(q in A) cluster (sol q @ +oo). *) -(* Variable K : set U. *) -(* Hypothesis Kco : compact K. *) -(* (* Definition is_invariant A := state_space phi A `<=` A. *) *) -(* Hypothesis invarK : is_invariant K. *) -(* Hypothesis isSol : forall p, p \in K -> is_global_sol phi (sol p) setT. *) -(* Hypothesis initp: forall p, p \in K -> sol p 0 = p. *) - -(* (* Lemma stable_limS (V : U -> R) : *) *) -(* (* {in K, continuous V} -> *) *) -(* (* (forall p t, K p -> 0 <= t -> differentiable V (sol p t)) -> *) *) -(* (* (forall p, K p -> 'D~(sol p) V 0 <= 0) -> *) *) -(* (* limS K `<=` [set p | 'D~(sol p) V 0 = 0]. *) *) -(* (* Proof. *) *) -(* (* Admitted. *) *) -(* (* lemma cvg_to_limS : *) *) -(* (* forall p, p \in K -> sol p t @[t --> +oo] --> (limS K). *) *) -(* (* Admitted. *) *) -(* Lemma cvg_to_limS : *) -(* forall p, p \in K -> cluster (sol p t @[t --> +oo]) `<=` limS K. *) -(* Admitted. *) -(* End LaSalle. *) - (* TODO: move *) Lemma open_disjoint_separated (X : topologicalType) (A B : set X) : open A -> open B -> A `&` B = set0 -> separated A B. @@ -2596,13 +2566,14 @@ Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. Let phi := Tilt.eqn alpha1 gamma. -Hypothesis solP : forall y, y 0 \in Tilt.state_space -> lasalle.is_sol phi y <-> y = sol (y 0). +Hypothesis solP : forall y, y 0 \in Tilt.Gamma1 -> + lasalle.is_sol phi y <-> y = sol (y 0). Hypothesis initp: forall p, sol p 0 = p. -Let isSol : forall p, p \in Tilt.state_space -> is_global_sol phi [set: 'rV_6] (sol p). +Let isSol p : p \in Tilt.Gamma1 -> is_global_sol phi [set: 'rV_6] (sol p). Proof. -move => p Kp. +move => Kp. have : lasalle.is_sol phi (sol p) by apply/solP; rewrite ?initp. move => [/=_ H]. split; first by rewrite inE. @@ -2613,7 +2584,7 @@ by rewrite derive1E;apply H. Qed. Definition Ksub (p : U) := - [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` Tilt.state_space. + [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` Tilt.Gamma1. (* continuity in initial value: assumption needed for LaSalle *) Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. @@ -2671,7 +2642,7 @@ Lemma compact_Ksub p : compact (Ksub p). Proof. apply: compact_closedI. exact: V1_bound_compact. -have -> : Tilt.state_space = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. +have -> : Tilt.Gamma1 = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. by []. apply : closed_comp => //. move => x xp. @@ -2767,11 +2738,11 @@ suff -> : 'e_2 *v 'e_2 = (0 : 'rV[K]_3). by rewrite vece2 /= scale0r. Qed. -Local Lemma sol_continuous p : p \in Tilt.state_space -> continuous (sol p). +Local Lemma sol_continuous p : p \in Tilt.Gamma1 -> continuous (sol p). Proof. move => sp t. have [issol0 issol1]: lasalle.is_sol phi (sol p). - apply: (sol_is_sol (sol := sol) (K:=Tilt.state_space)) => //. + apply: (sol_is_sol (sol := sol) (K:=Tilt.Gamma1)) => //. move => y Ky. by apply /solP;rewrite inE. move : sp. @@ -2800,12 +2771,12 @@ move => [_ solP'] initP. by split. Qed. -Local Lemma q_inKsubq q : q \in Tilt.state_space -> q \in Ksub q. +Local Lemma q_inKsubq q : q \in Tilt.Gamma1 -> q \in Ksub q. Proof. rewrite !inE => h;split => //=. Qed. Local Lemma limS_subset_V1dot0 p : - p \in Tilt.state_space -> - limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.state_space. + p \in Tilt.Gamma1 -> + limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. Proof. move => ps. have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). @@ -2813,7 +2784,7 @@ have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y apply/solP. rewrite inE. by apply Ky. -have H : limS sol (Ksub p) `<=` [set x | (V1 alpha1 gamma \o sol x)^`() 0 = 0] `&` Tilt.state_space. +have H : limS sol (Ksub p) `<=` [set x | (V1 alpha1 gamma \o sol x)^`() 0 = 0] `&` Tilt.Gamma1. rewrite subsetI; split. apply: (@stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (V1 alpha1 gamma)) => //=. apply/continuous_subspaceT => x xK. @@ -2828,7 +2799,7 @@ have H : limS sol (Ksub p) `<=` [set x | (V1 alpha1 gamma \o sol x)^`() 0 = 0] ` by have [_ +] := K0. exact: V1_diff. move => p0 K0. - have p0s : p0 \in Tilt.state_space. + have p0s : p0 \in Tilt.Gamma1. by move : K0;rewrite inE/=/Ksub/inE/=;move=>[]. rewrite derive1E. rewrite -derive_along_derive. @@ -2872,7 +2843,7 @@ by rewrite initp ?inE. split => //. by rewrite initp ?inE. move=>x0 x0t. -have h1' : x \in Tilt.state_space by rewrite inE. +have h1' : x \in Tilt.Gamma1 by rewrite inE. by apply (isSol h1'). apply V1_diff. apply /derivable1_diffP. @@ -2881,9 +2852,9 @@ by rewrite inE. Qed. Lemma limS_subset_points p : - p \in Tilt.state_space -> limS sol (Ksub p) `<=` Tilt.points. + p \in Tilt.Gamma1 -> limS sol (Ksub p) `<=` Tilt.points. Proof. -have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.state_space. +have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. apply/seteqP; split => x /=. case => ->;split; [exact: V1dot_point1_eq0 | | exact: V1dot_point2_eq0 | ]. have := @tilt_point1_in_state_space K. @@ -2891,11 +2862,11 @@ have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.state_space. have := @tilt_point2_in_state_space K. by rewrite inE. move => [h1 h2']. - have h2 : x \in Tilt.state_space by rewrite inE. + have h2 : x \in Tilt.Gamma1 by rewrite inE. move : h1. have hi := initp x. rewrite -hi => h1. - have sol' : tilt_is_sol phi 1 Tilt.state_space (sol x) . + have sol' : tilt_is_sol phi 1 Tilt.Gamma1 (sol x) . apply: global_sol_sol. split. by rewrite hi. @@ -3065,7 +3036,7 @@ apply hbv. by apply EB;left. Qed. -Lemma cvg_to_set_points p : p \in Tilt.state_space -> +Lemma cvg_to_set_points p : p \in Tilt.Gamma1 -> sol p t @[t --> +oo] --> Tilt.points. Proof. move=> /set_mem ps. @@ -3080,7 +3051,7 @@ move => /= S [eps eps0 Be]. exists eps => //. apply bigcup_sub => /= x H. apply: (subset_trans _ Be). -have ps' : p \in Tilt.state_space by exact/mem_set. +have ps' : p \in Tilt.Gamma1 by exact/mem_set. have : Tilt.points x by apply: (limS_subset_points ps'). move => h x' Bx'. by exists x. @@ -3109,7 +3080,7 @@ split => //. by apply V1c. Qed. -Lemma cluster_contained_points p : p \in Tilt.state_space -> +Lemma cluster_contained_points p : p \in Tilt.Gamma1 -> cluster (sol p t @[t --> +oo]) `<=` Tilt.points. Proof. move => ps. @@ -3167,7 +3138,7 @@ by left. by right. Qed. -Lemma cluster_nonempty p : p \in Tilt.state_space -> cluster (sol p t @[t --> +oo]) !=set0. +Lemma cluster_nonempty p : p \in Tilt.Gamma1 -> cluster (sol p t @[t --> +oo]) !=set0. Proof. move => sp. suff : (Ksub p) `&` cluster (sol p t @[t --> +oo]) !=set0. @@ -3190,7 +3161,7 @@ by rewrite addr_ge0 // divr_ge0 // ?sqr_ge0 ?mulr_ge0 // ltW. Qed. (*Todo : PR ? *) -Lemma cvg_to_p1_or_p2 p : p \in Tilt.state_space -> +Lemma cvg_to_p1_or_p2 p : p \in Tilt.Gamma1 -> (sol p t @[t --> +oo] --> Tilt.point1 ) \/ ( sol p t @[t --> +oo] --> Tilt.point2). Proof. move => ps. From f6039e7ec69a3226d8799e0fd281261ff211d5d8 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 9 Feb 2026 21:44:50 +0900 Subject: [PATCH 102/144] clean up the Init business --- tilt.v | 257 ++++++++++++++++++++++++++------------------------------- 1 file changed, 118 insertions(+), 139 deletions(-) diff --git a/tilt.v b/tilt.v index 2a0b5378..d4a68485 100644 --- a/tilt.v +++ b/tilt.v @@ -496,17 +496,16 @@ Let U := 'rV[K]_n. Variable phi : U -> U. -Definition tilt_is_sol (Delta : K) (Init : set U) (f : K -> U) := - f 0 \in Init /\ is_sol_on (fun=> phi) (f 0) 0 (BLeft Delta) f. +Definition tilt_is_sol (Delta : K) (f : K -> U) := + is_sol_on (fun=> phi) (f 0) 0 (BLeft Delta) f. -Definition is_global_sol (Init : set U) (f : K -> U) := - f 0 \in Init /\ forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). +Definition is_global_sol (f : K -> U) := + forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). -Lemma global_sol_sol f Init : is_global_sol Init f -> - forall Delta, tilt_is_sol Delta Init f. +Lemma global_sol_sol f : is_global_sol f -> + forall Delta, tilt_is_sol Delta f. Proof. -move=> [init0 /= solP] Delta. -split => //. +move=> solP Delta. split => //. move => x. rewrite /=inE/=in_itv/= => /andP[h _]. @@ -530,7 +529,7 @@ Context {K : realType} {n : nat}. Let U := 'rV[K]_n. Variables (phi : U -> U) (Delta : K). -Lemma tilt_is_solS (A B : set U) : A `<=` B -> +(*Lemma tilt_is_solS (A B : set U) : A `<=` B -> tilt_is_sol phi Delta A `<=` tilt_is_sol phi Delta B. Proof. move=> AB f. @@ -538,7 +537,7 @@ rewrite /tilt_is_sol inE => -[inD0 [_ deri cont]]; rewrite inE. split => //. by apply: AB. Qed. - +*) End is_sol. Section state_space. @@ -548,8 +547,8 @@ Variable phi : T -> T. (* TODO: two state_space definitions?! *) Definition state_space (Init : set T) : set T := - [set x | exists f Delta, (tilt_is_sol phi Delta Init f /\ - (exists t, t \in `[0, Delta[%R /\ x = f t))]. + [set x | exists f Delta, [/\ f 0 \in Init, tilt_is_sol phi Delta f & + (exists t, t \in `[0, Delta[%R /\ x = f t) ]]. End state_space. @@ -561,7 +560,7 @@ Variable Init : set T. Variable Delta : K. Definition is_equilibrium_point (x : T) := - forall Delta, tilt_is_sol phi Delta Init (cst x). + x \in Init /\ forall Delta, tilt_is_sol phi Delta (cst x). End equilibrium_point. @@ -576,10 +575,12 @@ Lemma equilibrium_points_subset (A B : set T) : A `<=` B -> equilibrium_points A `<=` equilibrium_points B. Proof. move=> AB x. -rewrite /equilibrium_points/= /is_equilibrium_point /tilt_is_sol inE => H Delta. -have [inD0 [deriv cont tilt]] := H Delta. -rewrite inE; split => //. -exact: AB. +rewrite /equilibrium_points/= /is_equilibrium_point /tilt_is_sol inE => -[Ax H]. +split. + exact/mem_set/AB. +move=> Delta. +have [deriv cont tilt] := H Delta. +by split => //. Qed. End equilibrium_point. @@ -592,21 +593,22 @@ Variable Init : set T. Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n) (Delta : K), tilt_is_sol phi Delta Init f -> + forall (f : K -> 'rV[K]_n) (Delta : K), f 0 \in Init /\ tilt_is_sol phi Delta f -> `| f 0 - x | < d -> forall t, 0 < t < Delta -> `| f t - x | < eps. (* assuming solution exists for all time *) Definition is_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n), is_global_sol phi Init f -> + forall (f : K -> 'rV[K]_n), f 0 \in Init /\ is_global_sol phi f -> `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. Lemma locally_stable_stable x : is_locally_stable_at x -> is_stable_at x. Proof. move => lstable e e0. move /(_ _ e0) : lstable => [d d0 stable]. -exists d => // z zglob zd t t0. +exists d => // z [z0Init zglob] zd t t0. apply (stable _ (t + 1)) => //. + split => //. by apply global_sol_sol. by rewrite t0/= ltrDl. Qed. @@ -850,7 +852,7 @@ Proof. by move=> r0; rewrite /B -closed_ballE. Qed. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall Delta sol, tilt_is_sol phi Delta Init sol -> +Hypothesis V'_le0 : forall Delta sol, sol 0 \in Init -> tilt_is_sol phi Delta sol -> forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. (* khalil theorem 4.1 *) @@ -906,19 +908,19 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta Delta sol : tilt_is_sol phi Delta Init sol -> +have Df_Omega_beta Delta sol : sol 0 \in Init -> tilt_is_sol phi Delta sol -> sol 0 \in Omega_beta -> forall t, 0 < t < Delta -> sol t \in Omega_beta. - move=> solP phi_Omega. + move=> sol0 solP phi_Omega. have /= V_nincr_consequence : forall t, 0 < t < Delta -> forall u, 0 <= u <= t -> 'D~(sol) V u <= 0 -> V (sol t) <= V (sol 0) <= beta. move=> /= t1 /andP[t10 t1Delta] u ut1 Vle0. apply/andP; split. move : phi_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. - apply: (@V_nincr _ _ phi Delta (sol 0) sol solP.2). + apply: (@V_nincr _ _ phi Delta (sol 0) sol solP). assumption. move=> /= t t0. - apply: V'_le0. + apply: V'_le0 => //. exact: solP. assumption. assumption. @@ -945,7 +947,7 @@ have Df_Omega_beta Delta sol : tilt_is_sol phi Delta Init sol -> exact: ltW. move=> z _. by apply: norm_continuous. - case: solP => sol0init [_ _]. + case: solP => _ _. apply: continuous_subspaceW. rewrite closure_neitv_oo; last by rewrite (lt_trans _ tDelta). apply: subset_itvl. @@ -966,7 +968,7 @@ have Df_Omega_beta Delta sol : tilt_is_sol phi Delta Init sol -> move=> /(_ t1). rewrite (ltW t10) lexx => /(_ isT). have : 'D~(sol) V t1 <= 0. - apply: V'_le0. + apply: V'_le0 => //. exact: solP. by rewrite t10/= (le_lt_trans _ tDelta). move=> /[swap] /[apply]. @@ -1013,7 +1015,7 @@ have B_delta_Omega_beta : B delta `<=` Omega_beta. by move => ball0 t1 t1_ge0; rewrite /Omega_beta inE => -[].*) rewrite /x. exists delta => //. -move=> sol Delta' solP sol_delta t0 t0_ge0. +move=> sol Delta' [sol0 solP] sol_delta t0 t0_ge0. rewrite subr0. have : sol 0 \in Omega_beta. rewrite inE; apply: B_delta_Omega_beta. @@ -1842,10 +1844,10 @@ Let phi := Tilt.eqn alpha1 gamma. Variable Delta : K. Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + tilt_is_sol phi Delta sol -> t \in `]0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. -move=> [/= sol0in [_ deri conti] t0Delta]. +move=> /= [_ deri conti] t0Delta. have [derivable_sol] := deri _ t0Delta. move=> /(congr1 Left). rewrite derive1E. @@ -1855,11 +1857,11 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + tilt_is_sol phi Delta sol -> z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. -move=> [/= traj0 [_ deriv conti] z0Delta]. +move=> [_ deriv conti] z0Delta. have [derivable_sol +] := deriv _ z0Delta. move => /(congr1 Right). rewrite derive1E. @@ -1868,11 +1870,12 @@ Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : t \in `[0, Delta[%R -> - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + sol 0 \in Tilt.Gamma1 -> + tilt_is_sol phi Delta sol -> Tilt.Gamma1 (sol t). Proof. -move=> t0Delta. -case => sol0 [_ deriv_sol csol]. +move=> t0Delta sol0. +case=> _ deriv_sol csol. move: t0Delta. rewrite in_itv/= => /andP[]. rewrite le_eqVlt => /predU1P[<- Delta0|t0 tDelta]. @@ -1886,9 +1889,10 @@ Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - tilt_is_sol phi Delta Tilt.Gamma1 sol -> `|u|_e = 1. + sol 0 \in Tilt.Gamma1 -> + tilt_is_sol phi Delta sol -> `|u|_e = 1. Proof. -move=> z0Delta dtraj. +move=> z0Delta sol0 dtraj. suff: Tilt.Gamma1 (row_mx (zp1 z) (z2 z)). by rewrite /Tilt.Gamma1/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. @@ -1898,10 +1902,11 @@ Qed. Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + sol 0 \in Tilt.Gamma1 -> + tilt_is_sol phi Delta sol -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. -move=> z0Delta dtraj. +move=> z0Delta sol0 dtraj. rewrite /dotmul !trmx_mul !tr_spin !mulNmx mulmxN opprK mulmxN !dotmulP. have key_ortho : (z2 z *m \S('e_2)) *d u = 0. by rewrite dotmulC; exact/ortho_spin. @@ -1922,11 +1927,12 @@ Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : z \in `[0, Delta[%R -> - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + sol 0 \in Tilt.Gamma1 -> + tilt_is_sol phi Delta sol -> `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = `|Right (sol z) *m \S('e_2)|_e. Proof. -move=> z0Delta dtraj. +move=> z0Delta sol0 dtraj. rewrite mulmxN enormN. pose zp1 := fun r => Left (sol r). pose z2 := fun r => Right (sol r). @@ -1948,7 +1954,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + tilt_is_sol phi Delta sol -> z \in `]0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + @@ -1975,7 +1981,7 @@ Qed. Lemma derive_along_V1 t (sol : K -> 'rV_6) : t \in `]0, Delta[ -> - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + tilt_is_sol phi Delta sol -> (forall t, t \in `]0, Delta[ -> differentiable sol t) -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. @@ -2011,11 +2017,12 @@ Definition u1 (sol : K -> 'rV[K]_6) t \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 t|_e, 1 |-> `|w|_e] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + sol 0 \in Tilt.Gamma1 -> + tilt_is_sol phi Delta sol -> forall t, t \in `[0, Delta[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. -move=> dtraj z z0Delta. +move=> sol0 dtraj z z0Delta. set w := z2 z *m \S('e_2). rewrite /V1dot. rewrite mxE norm_spin mxE addrA expr2 mulmxA. @@ -2043,15 +2050,16 @@ by rewrite [leRHS]mulrC. Qed. Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + tilt_is_sol phi Delta sol -> + sol 0 \in Tilt.Gamma1 -> t \in `[0, Delta[%R -> V1dot (sol t) = 0 -> sol t = Tilt.point1 \/ sol t = Tilt.point2. Proof. -move => solP t0d V1dsol. +move => solP sol0 t0d V1dsol. have h : u1 sol t = 0. case: (u1 sol t =P 0) => [-> // |/eqP hsol]. - have := V1dot_ub solP t0d. + have := V1dot_ub sol0 solP t0d. have := u2_quadratic_form_gt0 hsol. rewrite V1dsol !mulNmx !mxE oppr_ge0. move => h1 h2. @@ -2072,14 +2080,14 @@ suff [-> | -> ] : Right (sol t) = 0 \/ Right (sol t) = (2 *: 'e_2). case: splitP => // k _;by rewrite !mxE. right;apply /matrixP => i j;rewrite mxE. by case: splitP => // k _. -have := is_sol_state_space_tilt t0d solP. +have := is_sol_state_space_tilt t0d sol0 solP. rewrite /Tilt.Gamma1/=. have /sub_rVP [k ->] : (Right (sol t) <= ('e_2 : 'rV[K]_3))%MS. apply: (@submx_trans _ _ _ _ _ _ (kermx \S('e_2))). by apply /sub_kermxP. rewrite submxElt kernel_spin //. by apply /negP;rewrite -enorm_eq0 enormeE;apply /negP. -rewrite -{1}(scale1r 'e_2) -scalerBl enormZ enormeE mulr1. +rewrite -{1}(scale1r 'e_2)/= -scalerBl enormZ enormeE mulr1. rewrite -{2}normr1. move /eqP => hk. rewrite eqr_norm2 in hk. @@ -2091,13 +2099,13 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : - tilt_is_sol phi Delta Tilt.Gamma1 (sol x) -> + tilt_is_sol phi Delta (sol x) -> sol x 0 = Tilt.point1 -> \forall z \near 0^', ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + 'D~(sol x) (fun x => `|Right x|_e ^+ 2 / (2 * gamma))) z <= 0. Proof. -move=> [in_init [_ dtraj btraj]] traj0. +move=> [_ dtraj btraj] traj0. rewrite fctE !invfM /=. near=> z. under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. @@ -2134,7 +2142,7 @@ Unshelve. all: try by end_near. Abort. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - tilt_is_sol phi Delta Tilt.Gamma1 (sol x) -> + tilt_is_sol phi Delta (sol x) -> sol x 0 = Tilt.point1 -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. @@ -2174,12 +2182,13 @@ Abort. Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - tilt_is_sol phi Delta Tilt.Gamma1 (sol x) -> + tilt_is_sol phi Delta (sol x) -> + sol x 0 \in Tilt.Gamma1 -> (forall t : K, Tilt.Gamma1 (sol x t)) -> sol x 0 = Tilt.point1 -> locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. -move=> solves state y0. +move=> solves sol0 state y0. split. rewrite /is_sol in solves. rewrite /= derivative_derive_along_eq0 => //; last first. @@ -2194,7 +2203,7 @@ near=> z0. rewrite derive_along_V1. - have z00Delta : z0 \in `[0, Delta[%R. admit. - have V1dot_le := V1dot_ub solves z00Delta => //. + have V1dot_le := V1dot_ub sol0 solves z00Delta => //. set w := z2 z0 *m \S('e_2). set u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 z0|_e, 1 |-> `|w|_e] i. @@ -2221,7 +2230,7 @@ rewrite derive_along_V1. - move => t t0Delta. apply/derivable1_diffP => //. move : solves; rewrite /is_sol. - case => _ [_ deri conti]. + case => _ deri conti. by apply deri. Unshelve. all: by end_near. Abort. @@ -2247,12 +2256,13 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : - tilt_is_sol phi Delta Tilt.Gamma1 sol -> + tilt_is_sol phi Delta sol -> + sol 0 \in Tilt.Gamma1 -> (forall t, 0 < t < Delta -> differentiable sol t) -> forall t : K, 0 < t < Delta -> 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. -move=> solves diff t t0. +move=> solves sol0 diff t t0. rewrite derive_along_V1//; last 2 first. by rewrite inE/= in_itv/=. move=> t1 t10Delta. @@ -2261,7 +2271,7 @@ rewrite derive_along_V1//; last 2 first. have t0Delta : t \in `[0, Delta[%R. rewrite in_itv/=. by move/andP : t0 => [] /ltW -> ->. -have Hub := V1dot_ub solves t0Delta. +have Hub := V1dot_ub sol0 solves t0Delta. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> `|(Left \o sol) t|_e, @@ -2292,11 +2302,10 @@ Let c2 := 2^-1 / gamma. (* todo: copy paste *) Lemma derive_zp10 (sol : K -> 'rV_6) : - is_global_sol phi Tilt.Gamma1 sol -> + is_global_sol phi sol -> 'D_1 (Left \o sol) 0 = - alpha1 *: Left (sol 0). Proof. -move=> [/= sol0in]. -move /(_ _ (lexx 0)) => [d0 +]. +move/(_ _ (lexx 0)) => [d0 +]. move=> /(congr1 Left). rewrite derive1E. rewrite row_mxKl. @@ -2305,11 +2314,10 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z20 (sol : K -> 'rV_6) : - is_global_sol phi Tilt.Gamma1 sol -> + is_global_sol phi sol -> 'D_1 (Right \o sol) 0 = gamma *: (Right (sol 0) - Left (sol 0)) *m \S('e_2 - Right (sol 0)) ^+ 2. Proof. -move=> [/= sol0in]. move /(_ _ (lexx 0)) => [d0 +]. move => /(congr1 Right). rewrite derive1E. @@ -2317,7 +2325,7 @@ by rewrite row_mxKr => ?; rewrite derive_rsubmx. Qed. Lemma V1dotE0 (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_global_sol phi Tilt.Gamma1 sol -> + is_global_sol phi sol -> V1dot (sol 0) = c1 *: (2 *: 'D_1 zp1 0 *m (Left (sol 0))^T) 0 0 + c2 *: (2 *: 'D_1 z2 0 *m (Right (sol 0))^T) 0 0. @@ -2343,7 +2351,7 @@ Qed. Lemma derive_along_V1_global t (sol : K -> 'rV_6) : 0 <= t -> - is_global_sol phi Tilt.Gamma1 sol -> + is_global_sol phi sol -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0 tilt_eqnx. @@ -2379,11 +2387,12 @@ exact:dif1. Qed. Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : - is_global_sol phi Tilt.Gamma1 sol -> + is_global_sol phi sol -> + sol 0 \in Tilt.Gamma1 -> forall t : K, 0 <= t -> 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. -move=> solves. +move=> solves sol0. have diff : forall (t : K), 0 <= t -> differentiable sol t. move => /= t' t0'. apply/derivable1_diffP. @@ -2392,7 +2401,7 @@ move => t t0. rewrite derive_along_V1_global//. have t0Delta : t \in `[0, t+1[%R. by rewrite in_itv/=t0 ltrDl ltr01. -have Hub := V1dot_ub (global_sol_sol solves (t + 1)) t0Delta. +have Hub := V1dot_ub sol0 (global_sol_sol solves (t + 1)) t0Delta. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> `|(Left \o sol) t|_e, @@ -2422,16 +2431,6 @@ Variable Init : set 'rV[K]_6. (* Hypothesis y_sol : is_sol Delta (sol 0). *) (* Hypothesis y00 : sol 0 0 = 0. *) -Lemma is_equilibrium_subset : 0 \in Init -> - is_equilibrium_point phi Tilt.Gamma1 0 -> - is_equilibrium_point phi Init 0. -Proof. -move=> Init0. -rewrite /is_equilibrium_point => H Delta0. -have [inD0 about_sol] := H Delta0. -by split. -Qed. - Lemma V1_diff : forall t : 'rV_6, differentiable (V1 alpha1 gamma) t. Proof. move=> t; apply/differentiableD => //=. @@ -2448,16 +2447,12 @@ Proof. move=> Init0 openInit Init_in_state. apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). - exact: V1_diff. -- move=> Delta sol solP t t0. - case: solP => sol0Init solP. +- move=> Delta sol sol0 solP t t0. apply: (@derive_along_V1_le0 _ _ _ _ _ Delta sol). + assumption. + assumption. - + rewrite -/phi. - apply: (@tilt_is_solS _ _ _ Delta _ _ Init_in_state). - split. - assumption. - assumption. + + assumption. + + by apply/mem_set/Init_in_state/set_mem. + move=> /= t1 t10Delta. rewrite -derivable1_diffP. case: solP => _ deri _. @@ -2475,7 +2470,9 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). case : Hpos => // _ [V1_eq0 V1_gt0]. apply: V1_gt0 => //. by rewrite inE. -- exact/is_equilibrium_subset/equilibrium_tilt_point1. +- split => // Delta. + have [_] := equilibrium_tilt_point1 alpha1 gamma. + exact. Qed. End equilibrium_zero_stable. @@ -2571,12 +2568,11 @@ Hypothesis solP : forall y, y 0 \in Tilt.Gamma1 -> Hypothesis initp: forall p, sol p 0 = p. -Let isSol p : p \in Tilt.Gamma1 -> is_global_sol phi [set: 'rV_6] (sol p). +Let isSol p : p \in Tilt.Gamma1 -> is_global_sol phi (sol p). Proof. move => Kp. have : lasalle.is_sol phi (sol p) by apply/solP; rewrite ?initp. move => [/=_ H]. -split; first by rewrite inE. move => /= t t0. split. by apply: ex_derive; apply H. @@ -2637,7 +2633,6 @@ apply: bounded_closed_compact. exact: closed_le. Unshelve. all: by end_near. Qed. - Lemma compact_Ksub p : compact (Ksub p). Proof. apply: compact_closedI. @@ -2652,7 +2647,7 @@ exact: cst_continuous. exact: continuous_rsubmx. Qed. -Lemma invariant_Ksub p : is_invariant sol (Ksub p). +Lemma invariant_Ksub p : lasalle.is_invariant sol (Ksub p). Proof. rewrite /= /is_invariant/=. move => /= x. (* . [/= sol' [d [solP [t h]]]]*) @@ -2660,17 +2655,15 @@ rewrite /Ksub/= => -[Vx Kx] t t0. split; last first. - apply/(@tilt_state_spaceS _ alpha1 gamma). exists (sol x), (t + 1) => /=. (* use large enough time *) - split. + split => //. + rewrite initp. + exact/mem_set. apply global_sol_sol. - split. - rewrite initp ?inE //=. - apply isSol. + apply isSol => //. by rewrite inE. - exists t;split => //. + exists t; split => //. by rewrite /=in_itv/=t0/=ltrDl. -- have [] := (@isSol x). - by rewrite inE. - move => _ /= solA. +- move/mem_set : (Kx) => /isSol solA. rewrite (le_trans _ Vx)//. rewrite -[in leRHS](@initp x). have : is_sol_on (fun=> phi) x 0 (BLeft (t+1)) (sol x). @@ -2691,27 +2684,21 @@ split; last first. (* apply : (V_nincr solA (V1_diff _ _)); rewrite ?t0 ?lexx //. *) move => t1 tt1. apply : (@derive_along_V1_le0 _ _ _ _ _ (t+1))=> //. - apply global_sol_sol. - split => //. - rewrite inE. - by rewrite initp ?inE//. + apply global_sol_sol => //. + by rewrite initp inE. move => t2. - move => /andP[t2' _]. - apply /derivable1_diffP. + move => /andP[t2' _]. + apply/derivable1_diffP. apply solA. by rewrite ltW. by rewrite ltrDl. by rewrite lexx. Qed. -Local Lemma sol_Ksub p u : u \in Ksub p -> is_global_sol phi [set: 'rV_6] (sol u). +Local Lemma sol_Ksub p u : u \in Ksub p -> is_global_sol phi (sol u). Proof. rewrite inE/= => -[h1 h2]. -split. -apply isSol. - by rewrite inE. -move =>/= x. -apply isSol. +apply isSol => //. by rewrite inE. Qed. @@ -2764,13 +2751,6 @@ apply /ex_derive/issol1. rewrite lerNr oppr0 ltW//. Unshelve. all: by end_near. Qed. -Local Lemma global_sol_T A sol' : - is_global_sol phi [set: 'rV_6] sol' -> sol' 0 \in A -> is_global_sol phi A sol'. -Proof. -move => [_ solP'] initP. -by split. -Qed. - Local Lemma q_inKsubq q : q \in Tilt.Gamma1 -> q \in Ksub q. Proof. rewrite !inE => h;split => //=. Qed. @@ -2804,25 +2784,25 @@ have H : limS sol (Ksub p) `<=` [set x | (V1 alpha1 gamma \o sol x)^`() 0 = 0] ` rewrite derive1E. rewrite -derive_along_derive. apply : derive_along_V1_le0_global => //. - split. - by rewrite initp. - by apply isSol. - exact : V1_diff. - apply /derivable1_diffP => /=. by apply isSol. + by rewrite initp. + rewrite initp. + by apply: V1_diff => //. + apply /derivable1_diffP. + by apply isSol => //. move=>/=x [q qKsub xcl]. suff [] : (Ksub q) x by []. rewrite (closure_id (Ksub q)).1;last first. apply compact_closed => //. exact: compact_Ksub. - have qs (t :K) : 0<=t -> state_space phi (Ksub q) (sol q t). - exists (sol q),(t+1). + have qs (t :K) : 0 <= t -> state_space phi (Ksub q) (sol q t). + exists (sol q), (t+1). split. - apply global_sol_sol; apply global_sol_T. - apply isSol;rewrite inE;apply qKsub. rewrite initp; apply q_inKsubq. - rewrite inE. - by have/= [_ +] := qKsub. + have/= [_ +] := qKsub. + by move/mem_set. + apply global_sol_sol. + by apply isSol;rewrite inE;apply qKsub. exists t;split => //. by rewrite/=in_itv/=H ltrDl ltr01. have lim_sp : (sol q x @[x --> +oo]) (Ksub q). @@ -2841,11 +2821,11 @@ rewrite -derive_along_derive. rewrite derive_along_V1_global //=. by rewrite initp ?inE. split => //. -by rewrite initp ?inE. -move=>x0 x0t. -have h1' : x \in Tilt.Gamma1 by rewrite inE. -by apply (isSol h1'). -apply V1_diff. +apply isSol => //. +by apply/mem_set. +apply isSol => //. +by apply/mem_set. +by apply: V1_diff. apply /derivable1_diffP. apply isSol => //. by rewrite inE. @@ -2866,19 +2846,18 @@ have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. move : h1. have hi := initp x. rewrite -hi => h1. - have sol' : tilt_is_sol phi 1 Tilt.Gamma1 (sol x) . + have sol' : tilt_is_sol phi 1 (sol x) . apply: global_sol_sol. - split. - by rewrite hi. by apply isSol. apply: (V1dot_eq0_p1_or_p2 sol') => //. + rewrite hi. + exact/mem_set. by rewrite in_itv /= lexx ltr01. by apply limS_subset_V1dot0. Qed. From mathcomp Require Import finmap. - (*Todo: generalize + PR? *) Lemma compact_decreasing_bigcap (X : ptopologicalType) (B : K -> set X) (O : set X) : hausdorff_space X -> From 833ca9c66d6753993522a9b0b19ccf44c44825a0 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 9 Feb 2026 21:59:21 +0900 Subject: [PATCH 103/144] minor fix --- tilt.v | 75 +++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 46 insertions(+), 29 deletions(-) diff --git a/tilt.v b/tilt.v index d4a68485..c4543b49 100644 --- a/tilt.v +++ b/tilt.v @@ -18,8 +18,6 @@ Require Import ode lasalle. (* locnegsemidef V x == V is locally negative semidefinite *) (* 'D~(sol, x0) V == derivative of V along the solution sol *) (* starting at x0 *) -(* tilt_is_sol phi Delta Init f := f 0 \in Init + *) -(* is_sol_on phi (f 0) 0 Delta f *) (* is_equilibrium_point f p := solves_equation f (cst p) *) (* state_space f == the set points attainable by a solution *) (* (in the sense of `is_sol`) *) @@ -493,17 +491,36 @@ End picard.*) Section ode. Context {K : realType} {n : nat}. Let U := 'rV[K]_n. - Variable phi : U -> U. -Definition tilt_is_sol (Delta : K) (f : K -> U) := +Definition is_sol_on0 (Delta : K) (f : K -> U) := is_sol_on (fun=> phi) (f 0) 0 (BLeft Delta) f. Definition is_global_sol (f : K -> U) := forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). +Lemma is_global_solP (f : K -> U) : + is_global_sol f <-> is_sol_on (fun=> phi) (f 0) 0 (BInfty K false) f. +Proof. +split. + rewrite /is_global_sol => /= H. + split => //=. + move=> x; rewrite inE/= in_itv/= andbT => x0. + by apply: H; exact: ltW. + rewrite [X in {within X, continuous f}](_ : _ = `[0, +oo[); last first. + admit. (* TODO: do that *) + apply: continuous_in_subspaceT => x. + rewrite inE/= in_itv/= andbT => x0. + apply: differentiable_continuous. + apply/derivable1_diffP. + by apply H. +move=> [_ H cf]. +split. + apply H. +Abort. + Lemma global_sol_sol f : is_global_sol f -> - forall Delta, tilt_is_sol Delta f. + forall Delta, is_sol_on0 Delta f. Proof. move=> solP Delta. split => //. @@ -529,11 +546,11 @@ Context {K : realType} {n : nat}. Let U := 'rV[K]_n. Variables (phi : U -> U) (Delta : K). -(*Lemma tilt_is_solS (A B : set U) : A `<=` B -> - tilt_is_sol phi Delta A `<=` tilt_is_sol phi Delta B. +(*Lemma is_sol_on0S (A B : set U) : A `<=` B -> + is_sol_on0 phi Delta A `<=` is_sol_on0 phi Delta B. Proof. move=> AB f. -rewrite /tilt_is_sol inE => -[inD0 [_ deri cont]]; rewrite inE. +rewrite /is_sol_on0 inE => -[inD0 [_ deri cont]]; rewrite inE. split => //. by apply: AB. Qed. @@ -547,7 +564,7 @@ Variable phi : T -> T. (* TODO: two state_space definitions?! *) Definition state_space (Init : set T) : set T := - [set x | exists f Delta, [/\ f 0 \in Init, tilt_is_sol phi Delta f & + [set x | exists f Delta, [/\ f 0 \in Init, is_sol_on0 phi Delta f & (exists t, t \in `[0, Delta[%R /\ x = f t) ]]. End state_space. @@ -560,7 +577,7 @@ Variable Init : set T. Variable Delta : K. Definition is_equilibrium_point (x : T) := - x \in Init /\ forall Delta, tilt_is_sol phi Delta (cst x). + x \in Init /\ forall Delta, is_sol_on0 phi Delta (cst x). End equilibrium_point. @@ -575,7 +592,7 @@ Lemma equilibrium_points_subset (A B : set T) : A `<=` B -> equilibrium_points A `<=` equilibrium_points B. Proof. move=> AB x. -rewrite /equilibrium_points/= /is_equilibrium_point /tilt_is_sol inE => -[Ax H]. +rewrite /equilibrium_points/= /is_equilibrium_point /is_sol_on0 inE => -[Ax H]. split. exact/mem_set/AB. move=> Delta. @@ -593,7 +610,7 @@ Variable Init : set T. Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n) (Delta : K), f 0 \in Init /\ tilt_is_sol phi Delta f -> + forall (f : K -> 'rV[K]_n) (Delta : K), f 0 \in Init /\ is_sol_on0 phi Delta f -> `| f 0 - x | < d -> forall t, 0 < t < Delta -> `| f t - x | < eps. (* assuming solution exists for all time *) @@ -852,7 +869,7 @@ Proof. by move=> r0; rewrite /B -closed_ballE. Qed. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall Delta sol, sol 0 \in Init -> tilt_is_sol phi Delta sol -> +Hypothesis V'_le0 : forall Delta sol, sol 0 \in Init -> is_sol_on0 phi Delta sol -> forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. (* khalil theorem 4.1 *) @@ -908,7 +925,7 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta Delta sol : sol 0 \in Init -> tilt_is_sol phi Delta sol -> +have Df_Omega_beta Delta sol : sol 0 \in Init -> is_sol_on0 phi Delta sol -> sol 0 \in Omega_beta -> forall t, 0 < t < Delta -> sol t \in Omega_beta. move=> sol0 solP phi_Omega. have /= V_nincr_consequence : forall t, 0 < t < Delta -> forall u, 0 <= u <= t -> @@ -1844,7 +1861,7 @@ Let phi := Tilt.eqn alpha1 gamma. Variable Delta : K. Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> t \in `]0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. move=> /= [_ deri conti] t0Delta. @@ -1857,7 +1874,7 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. @@ -1871,7 +1888,7 @@ Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : t \in `[0, Delta[%R -> sol 0 \in Tilt.Gamma1 -> - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> Tilt.Gamma1 (sol t). Proof. move=> t0Delta sol0. @@ -1890,7 +1907,7 @@ Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> sol 0 \in Tilt.Gamma1 -> - tilt_is_sol phi Delta sol -> `|u|_e = 1. + is_sol_on0 phi Delta sol -> `|u|_e = 1. Proof. move=> z0Delta sol0 dtraj. suff: Tilt.Gamma1 (row_mx (zp1 z) (z2 z)). @@ -1903,7 +1920,7 @@ Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> sol 0 \in Tilt.Gamma1 -> - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> z0Delta sol0 dtraj. @@ -1928,7 +1945,7 @@ Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : z \in `[0, Delta[%R -> sol 0 \in Tilt.Gamma1 -> - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = `|Right (sol z) *m \S('e_2)|_e. Proof. @@ -1954,7 +1971,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> z \in `]0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + @@ -1981,7 +1998,7 @@ Qed. Lemma derive_along_V1 t (sol : K -> 'rV_6) : t \in `]0, Delta[ -> - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> (forall t, t \in `]0, Delta[ -> differentiable sol t) -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. @@ -2018,7 +2035,7 @@ Definition u1 (sol : K -> 'rV[K]_6) t Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : sol 0 \in Tilt.Gamma1 -> - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> forall t, t \in `[0, Delta[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. @@ -2050,7 +2067,7 @@ by rewrite [leRHS]mulrC. Qed. Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> sol 0 \in Tilt.Gamma1 -> t \in `[0, Delta[%R -> V1dot (sol t) = 0 -> @@ -2099,7 +2116,7 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : - tilt_is_sol phi Delta (sol x) -> + is_sol_on0 phi Delta (sol x) -> sol x 0 = Tilt.point1 -> \forall z \near 0^', ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + @@ -2142,7 +2159,7 @@ Unshelve. all: try by end_near. Abort. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - tilt_is_sol phi Delta (sol x) -> + is_sol_on0 phi Delta (sol x) -> sol x 0 = Tilt.point1 -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. @@ -2182,7 +2199,7 @@ Abort. Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - tilt_is_sol phi Delta (sol x) -> + is_sol_on0 phi Delta (sol x) -> sol x 0 \in Tilt.Gamma1 -> (forall t : K, Tilt.Gamma1 (sol x t)) -> sol x 0 = Tilt.point1 -> @@ -2256,7 +2273,7 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : - tilt_is_sol phi Delta sol -> + is_sol_on0 phi Delta sol -> sol 0 \in Tilt.Gamma1 -> (forall t, 0 < t < Delta -> differentiable sol t) -> forall t : K, 0 < t < Delta -> @@ -2846,7 +2863,7 @@ have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. move : h1. have hi := initp x. rewrite -hi => h1. - have sol' : tilt_is_sol phi 1 (sol x) . + have sol' : is_sol_on0 phi 1 (sol x) . apply: global_sol_sol. by apply isSol. apply: (V1dot_eq0_p1_or_p2 sol') => //. From b8c556970ca96c871ceaef9f2601282be39d2c8c Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 10 Feb 2026 09:37:10 +0900 Subject: [PATCH 104/144] ano --- common.v | 3 +-- contfun.v | 4 ++-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/common.v b/common.v index cfe7a0f6..fa93cbef 100644 --- a/common.v +++ b/common.v @@ -1,4 +1,3 @@ -(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. From mathcomp Require Import generic_quotient ring_quotient. @@ -772,7 +771,7 @@ by apply:cont_within_cont_comp => w wK; exact: norm_continuous. Qed. Definition infty_norm0 {R : realType} {W : normedModType R} (K : set R) - (f : {fun K >-> [set: W]}) := sup ((Num.norm \o f) @` K). + (f : {fun K >-> [set: W]}) := sup ((Num.norm \o f) @` K). Section infty_norm0_lemmas. Context {R : realType} {W : normedModType R}. diff --git a/contfun.v b/contfun.v index 7fc03165..1b61ae06 100644 --- a/contfun.v +++ b/contfun.v @@ -1,4 +1,3 @@ -(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. From mathcomp Require Import generic_quotient ring_quotient. @@ -9,6 +8,7 @@ From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. Require Import common. + (**md**************************************************************************) (* # ODE *) (* infty_norm f := infty_norm0 (repr f) *) @@ -166,7 +166,7 @@ Local Notation T := quot_continuousFunType. HB.instance Definition _ := ZmodQuotient.on T. Definition quot_continuousFunType_to_fun (f : T) : - (* NB(rei): was R -> R before 2025-12-26 *) + (* NB: was R -> R before 2025-12-26 *) subspace `[a, b] -> W := repr f. Coercion quot_continuousFunType_to_fun : T >-> Funclass. From dfe8e9a4b57bbd780a8b4396b1bc323f45a8746b Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 10 Feb 2026 12:11:03 +0900 Subject: [PATCH 105/144] is_sol_on0 --- tilt.v | 310 +++++++++++++++++++++++++++++++-------------------------- 1 file changed, 167 insertions(+), 143 deletions(-) diff --git a/tilt.v b/tilt.v index c4543b49..6e20d5f6 100644 --- a/tilt.v +++ b/tilt.v @@ -493,8 +493,15 @@ Context {K : realType} {n : nat}. Let U := 'rV[K]_n. Variable phi : U -> U. -Definition is_sol_on0 (Delta : K) (f : K -> U) := - is_sol_on (fun=> phi) (f 0) 0 (BLeft Delta) f. +Definition is_sol_on0 (Delta : K)(* TODO: generalize to itv_bound*) (f : K -> U) := + {in `[0, Delta[%R, forall t, derivable f t 1 /\ f^`() t = phi (f t)}. + +Lemma is_sol_on0P (Delta : K) (f : K -> U) (e : {posnum K} ) : + is_sol_on (fun=> phi) (f (- e%:num)) (- e%:num) (BLeft Delta) f -> + is_sol_on0 Delta f. +Proof. +by move=> [_ H cf] t t0D; apply H; rewrite inE/=; apply: subset_itv t0D; rewrite bnd_simp. +Qed. Definition is_global_sol (f : K -> U) := forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). @@ -522,21 +529,10 @@ Abort. Lemma global_sol_sol f : is_global_sol f -> forall Delta, is_sol_on0 Delta f. Proof. -move=> solP Delta. -split => //. - move => x. - rewrite /=inE/=in_itv/= => /andP[h _]. - apply solP. - by rewrite ltW. -have [Delta_gt0|Delta_le0] := ltP 0 Delta. - rewrite closure_neitv_oo//. - apply: derivable_within_continuous => t t0Delta. - apply solP. - by move: t0Delta; rewrite in_itv/= => /andP[]. -rewrite set_itv_ge//. - rewrite closure0. - exact: continuous_subspace0. -by rewrite bnd_simp -leNgt. +move=> solP Delta t t0D. +apply: solP. +move: t0D. +by rewrite in_itv/= => /andP[]. Qed. End ode. @@ -595,8 +591,8 @@ move=> AB x. rewrite /equilibrium_points/= /is_equilibrium_point /is_sol_on0 inE => -[Ax H]. split. exact/mem_set/AB. -move=> Delta. -have [deriv cont tilt] := H Delta. +move=> Delta t t0D. +have [deriv1 deriv2] := H Delta t t0D. by split => //. Qed. @@ -773,7 +769,7 @@ Variable phi : U -> U. Variable Delta : K. Variable u0 : U. Variable sol : K -> U (* TODO(2026-02-08): maybe this should be U -> K -> U to match lasalle *). -Hypothesis solP : is_sol_on (fun=> phi) u0 0 (BLeft Delta) sol. +Hypothesis solP : is_sol_on0 phi Delta sol. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. @@ -787,12 +783,11 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. - move=> y yb. apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. rewrite -derivable1_diffP. - case: solP => /= h0Init + _. + move: solP. move/(_ y) /(_ _) => []. move: yb. - rewrite inE/=. - apply: subset_itvl. - by rewrite bnd_simp ltW. + apply: subset_itv; rewrite bnd_simp//. + exact: ltW. by []. - move=> y yb. rewrite derive1E -derive_along_derive//. @@ -800,12 +795,11 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. move : yb; rewrite in_itv/= => /andP[->/= /lt_le_trans]; apply. exact: ltW. + rewrite -derivable1_diffP. - case: solP => /= h0Init + _. + move: solP. move/(_ y) /(_ _) => []. move: yb. - rewrite inE/=. - apply: subset_itvl. - by rewrite bnd_simp ltW. + apply: subset_itv; rewrite bnd_simp//. + exact/ltW. by []. - (* `[0, b] *) have [b0|] := ltP 0 b; last first. @@ -820,29 +814,29 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. apply: continuous_comp; last exact: differentiable_continuous. apply: differentiable_continuous => //. rewrite -derivable1_diffP. - case: solP => /= h0Init + _. + move: solP. move/(_ z) /(_ _) => []. move: z0b. - rewrite inE/=. - apply: subset_itvl. - by rewrite bnd_simp ltW. + by apply: subset_itv; rewrite bnd_simp// ltW. by []. - + case: solP => solu0u0 deri cont. - (* filled this *) - have d0 : 0 < Delta by apply /lt_trans/bDelta. - rewrite closure_neitv_oo// in cont. + + have d0 : 0 < Delta by apply /lt_trans/bDelta. + have cont : {in `[0, Delta[%R, continuous sol}. + move=> t t0D. + apply: differentiable_continuous. + apply/derivable1_diffP. + by apply solP. apply: cvg_comp. - have /continuous_within_itvP := cont. - move/(_ d0) => [_ + _]. - apply. + apply: cvg_at_right_filter. + apply: cont. + by rewrite in_itv/= lexx. by apply (differentiable_continuous (Vdiff (sol 0))). + apply: cvg_at_left_filter. apply: differentiable_continuous => //. apply: differentiable_comp. rewrite -derivable1_diffP. - case: solP => /= h0Init + _. + move: solP. move/(_ b) /(_ _) => []. - by rewrite inE/= in_itv/= b0 bDelta. + by rewrite in_itv/= (ltW b0)// bDelta. by []. by apply: Vdiff. - by rewrite !in_itv/= lexx (le_trans a_ge0). @@ -934,8 +928,10 @@ have Df_Omega_beta Delta sol : sol 0 \in Init -> is_sol_on0 phi Delta sol -> move=> /= t1 /andP[t10 t1Delta] u ut1 Vle0. apply/andP; split. move : phi_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. - apply: (@V_nincr _ _ phi Delta (sol 0) sol solP). + apply: (@V_nincr _ _ phi Delta sol). assumption. + move=> t. + by apply: Vdiff. move=> /= t t0. apply: V'_le0 => //. exact: solP. @@ -964,11 +960,15 @@ have Df_Omega_beta Delta sol : sol 0 \in Init -> is_sol_on0 phi Delta sol -> exact: ltW. move=> z _. by apply: norm_continuous. - case: solP => _ _. + have cont : {in `[0, Delta[, continuous sol}. + move=> t' t'0D. + rewrite inE in t'0D. + apply: differentiable_continuous. + apply/derivable1_diffP. + by apply solP. + move/continuous_in_subspaceT : cont. apply: continuous_subspaceW. - rewrite closure_neitv_oo; last by rewrite (lt_trans _ tDelta). - apply: subset_itvl. - by rewrite bnd_simp ltW. + by apply: subset_itvl; rewrite bnd_simp. have : min `|sol 0| `|sol t| <= r <= max `|sol 0| `|sol t|. by rewrite ge_min phi0r/= le_max (ltW phi_t_r) orbT. move=> /(IVT (ltW t0) norm_phi_cont)[c cI norm_phi_c]. @@ -1507,10 +1507,9 @@ rewrite ge_max; apply/andP; split. by rewrite !mulrA ler_pM. Unshelve. all: by end_near. Qed. -Lemma tilt_state_spaceS : - state_space phi Tilt.Gamma1 `<=` Tilt.Gamma1. +Lemma tilt_state_spaceS : state_space phi Tilt.Gamma1 `<=` Tilt.Gamma1. Proof. -move => p [y [Delta [[y0_init1 [/=_ deri conti] ]]]]. +move => p [y [Delta [y0_init1 deri]]]. have [Delta0|Delta0] := leP 0 Delta; last first. move=> -[t [+ x]]. rewrite in_itv/= => -/andP[x0 xDelta]. @@ -1521,8 +1520,12 @@ have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))) move => x xd /=. transitivity ((fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))) x). rewrite !derive1E. - rewrite derive_mx; last first. - by apply deri. + have ? : derivable y x 1. + apply deri. + rewrite inE/= in xd. + apply: subset_itvr xd. + by rewrite bnd_simp. + rewrite derive_mx//. rewrite /dotmul. under eq_fun do rewrite dotmulP /=. rewrite dotmulP. @@ -1530,9 +1533,7 @@ have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))) under eq_fun do rewrite !mxE /= mulr1n. rewrite !derive_dotmul/=; last 2 first. apply: derivableB => //=; apply : derivable_rsubmx => //=. - by apply deri. - apply: derivableB => //=; apply: derivable_rsubmx => //=. - by apply deri. + by apply: derivableB => //=; apply: derivable_rsubmx => //=. rewrite /dotmul /=. rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. @@ -1540,40 +1541,46 @@ have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))) have -> : 'D_1 (fun x2 : K => 'e_2 - Right (y x2)) x = - Right ('D_1 y x). rewrite deriveB /= ; last 2 first. exact: derivable_cst. - apply: derivable_rsubmx. - by apply deri. + by apply: derivable_rsubmx. rewrite derive_cst /= sub0r; congr (- _). - apply: derive_rsubmx. - by apply deri. + by apply: derive_rsubmx. rewrite -(_ : 'D_1 y x = (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. apply/matrixP => a b; rewrite !mxE. - rewrite derive_mx//= ?mxE//. - by apply deri. + by rewrite derive_mx//= ?mxE//. ring. - have Rsu t0 : t0 \in `]0, Delta[ -> Right (y^`()%classic t0) = + have Rsu t0 : t0 \in `[0, Delta[ -> Right (y^`()%classic t0) = (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). + rewrite inE/=. + rewrite /is_sol_on0/= in deri. by move/deri => [_ ->]; rewrite row_mxKr. rewrite /dotmul. transitivity (-2 * (gamma *: (Right (y x) - Left (y x)) *m \S('e_2 - Right (y x)) ^+ 2 *m ('e_2 - Right (y x))^T) 0 0). - by rewrite Rsu. + rewrite Rsu//. + move: xd. + rewrite !inE/=. + by apply: subset_itvr; rewrite bnd_simp. rewrite !mulmxA. apply/eqP. rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. by rewrite !mulmx0 mxE. move => h [t [t0d ->]]. -have norm_constant t0 : t0 \in `[0,Delta] -> +have norm_constant t0 : t0 \in `[0, Delta[ -> `|'e_2 - Right (y t0)|_e ^+ 2 = `|'e_2 - Right (y 0)|_e ^+ 2. have : forall x0, x0 \in `]0,Delta[ -> is_derive x0 (1:K) (fun x : K => `|'e_2 - Right (y x)|_e ^+ 2) 0. move => x0 x0d. + have ? : derivable y x0 1. + apply deri. + rewrite inE/= in x0d. + apply: subset_itvr x0d. + by rewrite bnd_simp. apply: DeriveDef. apply/derivable_enorm_squared => //=. apply/derivableB => //=. - apply/derivable_rsubmx => //. - by apply deri. + by apply/derivable_rsubmx => //. rewrite -derive1E. have := h _ x0d. under eq_fun do rewrite dotmulvv /=. @@ -1581,22 +1588,47 @@ have norm_constant t0 : t0 \in `[0,Delta] -> rewrite /=. move => hd0 t0d'. apply/esym. - have := is_derive_0_is_cst_new' t0d' _ hd0. + have {}t0d'' : t0 \in `[0, t0]. + rewrite inE/= in_itv/= lexx andbT. + move: t0d'. + by rewrite inE/= => /andP[]. + have {}hd0 : forall x0 : K, + x0 \in `]0, t0[ -> is_derive x0 1 (fun x : K => `| 'e_2 - Right (y x) |_e ^+ 2) 0. + move=> x0 x00t0. + apply: hd0. + move: x00t0; rewrite !inE/=. + apply: subset_itvl; rewrite bnd_simp. + by move: t0d'; rewrite inE/= in_itv/= => /andP[_ /ltW]. + have := is_derive_0_is_cst_new' t0d'' _ hd0. + clear t0d'' hd0. apply => //; last first. - by rewrite inE/= in_itv/= lexx/=. + rewrite inE/= in_itv/= lexx/=. + by move: t0d'; rewrite inE/= in_itv/= => /andP[]. apply: (@within_continuous_comp _ _ _ _ _ (fun x => `|'e_2 - Right x|_e ^+ 2) y) => //=. + by move: t0d'; rewrite inE/= in_itv/= => /andP[]. move=> z _. apply: differentiable_continuous => //. apply: differentiable_enorm_squared => /=. exact: differentiableB. move: t0d; rewrite in_itv/= => /andP[t_ge0 tDelta]. - move: conti; rewrite closure_neitv_oo//. - by rewrite (le_lt_trans _ tDelta). + rewrite /is_sol_on0/= in deri. + have cont : {in `[0, t0], continuous y}. + move=> t' t'0D. + rewrite inE/= in t'0D. + apply: differentiable_continuous. + apply/derivable1_diffP. + apply deri. + apply: subset_itvl t'0D. + rewrite bnd_simp. + by move: t0d'; rewrite inE/= in_itv/= => /andP[]. + move/continuous_in_subspaceT : cont. + apply: continuous_subspaceW. + by apply: subset_itvl; rewrite bnd_simp. suff: `|'e_2 - Right (y t)|_e ^+ 2 = 1. move=> /(congr1 Num.sqrt). by rewrite sqrtr1 sqr_sqrtr// dotmulvv sqr_ge0. rewrite norm_constant//; last first. - by rewrite inE; exact: subset_itv_co_cc. + by rewrite inE. move: y0_init1. rewrite inE /Tilt.Gamma1 /= => ->. by rewrite expr2 mulr1. @@ -1613,22 +1645,20 @@ Lemma equilibrium_tilt_point1 : Proof. split. - exact: tilt_point1_in_state_space. -- split => //=. - + move=> t t0Delta. - split; first exact: derivable_cst. - rewrite derive1E derive_cst /Tilt.point1; apply/eqP. - rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP; split. - rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP => i. - by rewrite lsubmx_const. - apply/eqP/rowP; move => i; apply/eqP. - rewrite /eqn14b_rhs. - set N := (X in _ *: X *m _); have : N = 0. - rewrite /N /=; apply /rowP; move => a. - rewrite !mxE. - by rewrite subrr. - by move => n; rewrite n scaler0 mul0mx. - + apply: continuous_subspaceT =>x. - exact: cvg_cst. +- move=> Delta. + move=> t t0Delta. + split; first exact: derivable_cst. + rewrite derive1E derive_cst /Tilt.point1; apply/eqP. + rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP; split. + rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP => i. + by rewrite lsubmx_const. + apply/eqP/rowP; move => i; apply/eqP. + rewrite /eqn14b_rhs. + set N := (X in _ *: X *m _); have : N = 0. + rewrite /N /=; apply /rowP; move => a. + rewrite !mxE. + by rewrite subrr. + by move => n; rewrite n scaler0 mul0mx. Qed. Lemma tilt_point2_in_state_space : @Tilt.point2 K \in Tilt.Gamma1. @@ -1645,38 +1675,37 @@ Lemma equilibrium_tilt_point2 : is_equilibrium_point phi Tilt.Gamma1 Tilt.point2. Proof. split; first exact: tilt_point2_in_state_space. -split => //. -- move=> t t0Delta. - split; first exact: derivable_cst. - rewrite derive1E derive_cst; apply/eqP. - rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. - set N := (X in _ *: X == 0 /\ _). - have N0 : N = 0. - apply/rowP; move=> i; rewrite !mxE; case: splitP. - by move => j _; rewrite mxE. - move=> k /= i3k. - have := ltn_ord i. - by rewrite i3k -ltn_subRL subnn. - split. - by rewrite scaler_eq0 N0 eqxx orbT. - rewrite /eqn14b_rhs. - rewrite -scalemxAl scalemx_eq0 gt_eqF//=. - rewrite -[Left Tilt.point2]/N N0 subr0. - set M := (X in X *m _); rewrite -/M. - have ME : M = 2 *: 'e_2. - apply/rowP => i; rewrite !mxE eqxx/=. - case: splitP => [j ij|j]/=. - have := ltn_ord j. - by rewrite -ij. - move/eqP. - rewrite eqn_add2l => /eqP /ord_inj ->. - by rewrite !mxE eqxx/=. - rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/=. - rewrite [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA. - rewrite subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. - rewrite (_ : 'e_2 *m _ = 0) ?mul0mx//; apply: trmx_inj. - by rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. -- by apply: continuous_subspaceT => x; exact: cvg_cst. +move=> Delta. +move=> t t0Delta. +split; first exact: derivable_cst. +rewrite derive1E derive_cst; apply/eqP. +rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. +set N := (X in _ *: X == 0 /\ _). +have N0 : N = 0. + apply/rowP; move=> i; rewrite !mxE; case: splitP. + by move => j _; rewrite mxE. + move=> k /= i3k. + have := ltn_ord i. + by rewrite i3k -ltn_subRL subnn. +split. + by rewrite scaler_eq0 N0 eqxx orbT. +rewrite /eqn14b_rhs. +rewrite -scalemxAl scalemx_eq0 gt_eqF//=. +rewrite -[Left Tilt.point2]/N N0 subr0. +set M := (X in X *m _); rewrite -/M. +have ME : M = 2 *: 'e_2. + apply/rowP => i; rewrite !mxE eqxx/=. + case: splitP => [j ij|j]/=. + have := ltn_ord j. + by rewrite -ij. + move/eqP. + rewrite eqn_add2l => /eqP /ord_inj ->. + by rewrite !mxE eqxx/=. +rewrite ME -scalemxAl scalemx_eq0 pnatr_eq0/=. +rewrite [X in X *: _](_ : _ = 1 + 1)// scalerDl scale1r opprD addrA. +rewrite subrr sub0r spinN sqrrN expr2 -mulmxE mulmxA. +rewrite (_ : 'e_2 *m _ = 0) ?mul0mx//; apply: trmx_inj. +by rewrite trmx_mul trmx0 tr_spin mulNmx spin_mul_tr oppr0. Qed. End tilt_eqn. @@ -1862,9 +1891,9 @@ Variable Delta : K. Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : is_sol_on0 phi Delta sol -> - t \in `]0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). + t \in `[0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. -move=> /= [_ deri conti] t0Delta. +move=> /= deri /[!inE]/= t0Delta. have [derivable_sol] := deri _ t0Delta. move=> /(congr1 Left). rewrite derive1E. @@ -1875,10 +1904,10 @@ Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : is_sol_on0 phi Delta sol -> - z \in `]0, Delta[ -> 'D_1 (Right \o sol) z = + z \in `[0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. -move=> [_ deriv conti] z0Delta. +move=> deriv /[!inE]/= z0Delta. have [derivable_sol +] := deriv _ z0Delta. move => /(congr1 Right). rewrite derive1E. @@ -1891,8 +1920,7 @@ Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : is_sol_on0 phi Delta sol -> Tilt.Gamma1 (sol t). Proof. -move=> t0Delta sol0. -case=> _ deriv_sol csol. +move=> t0Delta sol0 deriv_sol. move: t0Delta. rewrite in_itv/= => /andP[]. rewrite le_eqVlt => /predU1P[<- Delta0|t0 tDelta]. @@ -1972,7 +2000,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : is_sol_on0 phi Delta sol -> - z \in `]0, Delta[ -> + z \in `[0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + c2 *: (2 *: 'D_1 z2 z *m (Right (sol z))^T) 0 0. @@ -2022,7 +2050,8 @@ rewrite -fctE /= !derive_along_enorm_squared//=. by rewrite /c1 /c2 !invfM. rewrite /= in tilt_eqnx. exact: tilt_eqnx. -- assumption. +- move: t0Delta. + by rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. - exact/differentiable_lsubmx_comp. - exact: dif1. - exact: dif1. @@ -2122,7 +2151,7 @@ Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + 'D~(sol x) (fun x => `|Right x|_e ^+ 2 / (2 * gamma))) z <= 0. Proof. -move=> [_ dtraj btraj] traj0. +move=> dtraj traj0. rewrite fctE !invfM /=. near=> z. under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. @@ -2247,8 +2276,10 @@ rewrite derive_along_V1. - move => t t0Delta. apply/derivable1_diffP => //. move : solves; rewrite /is_sol. - case => _ deri conti. - by apply deri. + move=> deri. + apply deri. + move: t0Delta; rewrite inE/=. + by apply: subset_itvr; rewrite bnd_simp. Unshelve. all: by end_near. Abort. (*Definition is_Lyapunov_stable_at {K : realType} {n} @@ -2395,9 +2426,9 @@ rewrite derive_alongMl => //; last first. rewrite le_eqVlt => /predU1P[<-//|t0]. rewrite V1dotE0 => //. by rewrite !invfM. - - rewrite (V1dotE alpha1_gt0 gamma_gt0 (global_sol_sol tilt_eqnx (t + 1))) //. + - rewrite (V1dotE alpha1_gt0 gamma_gt0 (@global_sol_sol _ _ _ _ tilt_eqnx (t + 1))) //. by rewrite !invfM. - by rewrite inE/=in_itv/=t0 ltrDl;apply /andP. + by rewrite inE/= in_itv/= (ltW t0) ltrDl;apply /andP. - exact/differentiable_lsubmx_comp. exact:dif1. exact:dif1. @@ -2418,7 +2449,7 @@ move => t t0. rewrite derive_along_V1_global//. have t0Delta : t \in `[0, t+1[%R. by rewrite in_itv/=t0 ltrDl ltr01. -have Hub := V1dot_ub sol0 (global_sol_sol solves (t + 1)) t0Delta. +have Hub := V1dot_ub sol0 (@global_sol_sol _ _ _ _ solves (t + 1)) t0Delta. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> `|(Left \o sol) t|_e, @@ -2472,9 +2503,9 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). + by apply/mem_set/Init_in_state/set_mem. + move=> /= t1 t10Delta. rewrite -derivable1_diffP. - case: solP => _ deri _. - apply deri. - by rewrite inE/= in_itv/=. + apply solP. + rewrite in_itv/=. + by case/andP : t10Delta => /ltW -> ->. + case/andP : t0 => t0 tDelta. rewrite tDelta andbT. assumption. @@ -2683,15 +2714,8 @@ split; last first. - move/mem_set : (Kx) => /isSol solA. rewrite (le_trans _ Vx)//. rewrite -[in leRHS](@initp x). - have : is_sol_on (fun=> phi) x 0 (BLeft (t+1)) (sol x). - split. - by rewrite initp// inE. + have : is_sol_on0 phi (t + 1) (sol x). move => t'. - rewrite inE/=in_itv/= => /andP[t0' _]. - by apply solA; rewrite ltW. - rewrite closure_neitv_oo; last by rewrite ltr_wpDl. - apply: derivable_within_continuous. - move => x0. rewrite in_itv/= => /andP[t0' _]. by apply solA. move /(V_nincr ) => /=. From a296a8ca81d2eb48ca930edda2377d7a3500b4f3 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 10 Feb 2026 14:29:51 +0900 Subject: [PATCH 106/144] simplification of is_sol_on hypos --- _CoqProject | 7 +- lasalle.v | 13 +- common.v => ode_common.v | 0 contfun.v => ode_contfun.v | 0 tilt.v => tilt_lyapunov.v | 777 +++---------------------------------- 5 files changed, 63 insertions(+), 734 deletions(-) rename common.v => ode_common.v (100%) rename contfun.v => ode_contfun.v (100%) rename tilt.v => tilt_lyapunov.v (78%) diff --git a/_CoqProject b/_CoqProject index a58a402c..252452da 100644 --- a/_CoqProject +++ b/_CoqProject @@ -17,15 +17,16 @@ scara.v derive_matrix.v differential_kinematics.v extra_trigo.v -common.v -contfun.v +ode_common.v +ode_contfun.v ode.v lasalle.v pendulum.v tilt_mathcomp.v tilt_analysis.v tilt_robot.v -tilt.v +tilt_lyapunov.v +tilt_lasalle.v ode_wip.v diff --git a/lasalle.v b/lasalle.v index ac10caae..dcb6666c 100644 --- a/lasalle.v +++ b/lasalle.v @@ -192,19 +192,12 @@ rewrite lerBrDr addrC -lerBrDr; apply: ybndN; last by exists t. by rewrite ltrBrDr; near: M; exists (N + N)%R; rewrite realD. Unshelve. all: by end_near. Qed. -(* TODO: PR to mathcomp-analysis? *) +(* TODO: update lasalle on github *) Lemma nearN (R : realFieldType) (P : set R) : (\forall x \near (0%R : R^o), P x) = (\forall x \near (0%R : R^o), P (- x)%R). Proof. -rewrite propeqE; split. - move/nbhs_ballP => [e e0 eP]. - near=> x; apply: eP; rewrite /ball/= opprK add0r. - by near: x; exact: (@nbhs0_lt _ R^o). -move/nbhs_ballP => [e e0 eP]. -near=> x. -rewrite -(opprK x); apply: eP; rewrite /ball/= opprK add0r. -by near: x; exact: (@nbhs0_lt _ R^o). -Unshelve. all: by end_near. Qed. +by rewrite propeqE; split; rewrite -nearN oppr0. +Qed. Section DifferentialSystem. Context {R : realType}. diff --git a/common.v b/ode_common.v similarity index 100% rename from common.v rename to ode_common.v diff --git a/contfun.v b/ode_contfun.v similarity index 100% rename from contfun.v rename to ode_contfun.v diff --git a/tilt.v b/tilt_lyapunov.v similarity index 78% rename from tilt.v rename to tilt_lyapunov.v index 6e20d5f6..99110ab6 100644 --- a/tilt.v +++ b/tilt_lyapunov.v @@ -493,46 +493,34 @@ Context {K : realType} {n : nat}. Let U := 'rV[K]_n. Variable phi : U -> U. -Definition is_sol_on0 (Delta : K)(* TODO: generalize to itv_bound*) (f : K -> U) := - {in `[0, Delta[%R, forall t, derivable f t 1 /\ f^`() t = phi (f t)}. +Definition is_sol_on0o (Delta : itv_bound K) (f : K -> U) := + {in Interval (BLeft 0) Delta, forall t, derivable f t 1 /\ f^`() t = phi (f t)}. +(* NB: (BLeft Delta) -> open on right *) -Lemma is_sol_on0P (Delta : K) (f : K -> U) (e : {posnum K} ) : +Lemma is_sol_on0oP (Delta : K) (f : K -> U) (e : {posnum K} ) : is_sol_on (fun=> phi) (f (- e%:num)) (- e%:num) (BLeft Delta) f -> - is_sol_on0 Delta f. + is_sol_on0o (BLeft Delta) f. Proof. by move=> [_ H cf] t t0D; apply H; rewrite inE/=; apply: subset_itv t0D; rewrite bnd_simp. Qed. -Definition is_global_sol (f : K -> U) := - forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). +(* "global" solution *) +Definition is_sol_on0y (f : K -> U) := is_sol_on0o (BInfty K false) f. -Lemma is_global_solP (f : K -> U) : - is_global_sol f <-> is_sol_on (fun=> phi) (f 0) 0 (BInfty K false) f. +(* TODO: generalize this lemma *) +Lemma is_sol_on0yP (f : K -> U) : is_sol_on0o (BInfty K false) f <-> + forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). Proof. -split. - rewrite /is_global_sol => /= H. - split => //=. - move=> x; rewrite inE/= in_itv/= andbT => x0. - by apply: H; exact: ltW. - rewrite [X in {within X, continuous f}](_ : _ = `[0, +oo[); last first. - admit. (* TODO: do that *) - apply: continuous_in_subspaceT => x. - rewrite inE/= in_itv/= andbT => x0. - apply: differentiable_continuous. - apply/derivable1_diffP. - by apply H. -move=> [_ H cf]. -split. - apply H. -Abort. +split=> H t t0oo; apply: H. + by rewrite in_itv/= andbT. +by move: t0oo; rewrite in_itv/= andbT. +Qed. -Lemma global_sol_sol f : is_global_sol f -> - forall Delta, is_sol_on0 Delta f. +Lemma global_sol_sol f : is_sol_on0y f -> forall Delta, is_sol_on0o Delta f. Proof. -move=> solP Delta t t0D. -apply: solP. -move: t0D. -by rewrite in_itv/= => /andP[]. +move=> + Delta t t0D. +apply. +by move: t0D;rewrite !in_itv/= => /andP[->]. Qed. End ode. @@ -542,11 +530,11 @@ Context {K : realType} {n : nat}. Let U := 'rV[K]_n. Variables (phi : U -> U) (Delta : K). -(*Lemma is_sol_on0S (A B : set U) : A `<=` B -> - is_sol_on0 phi Delta A `<=` is_sol_on0 phi Delta B. +(*Lemma is_sol_on0oS (A B : set U) : A `<=` B -> + is_sol_on0o phi Delta A `<=` is_sol_on0o phi Delta B. Proof. move=> AB f. -rewrite /is_sol_on0 inE => -[inD0 [_ deri cont]]; rewrite inE. +rewrite /is_sol_on0o inE => -[inD0 [_ deri cont]]; rewrite inE. split => //. by apply: AB. Qed. @@ -560,7 +548,7 @@ Variable phi : T -> T. (* TODO: two state_space definitions?! *) Definition state_space (Init : set T) : set T := - [set x | exists f Delta, [/\ f 0 \in Init, is_sol_on0 phi Delta f & + [set x | exists f Delta, [/\ f 0 \in Init, is_sol_on0o phi (BLeft Delta) f & (exists t, t \in `[0, Delta[%R /\ x = f t) ]]. End state_space. @@ -573,7 +561,7 @@ Variable Init : set T. Variable Delta : K. Definition is_equilibrium_point (x : T) := - x \in Init /\ forall Delta, is_sol_on0 phi Delta (cst x). + x \in Init /\ forall Delta, is_sol_on0o phi Delta (cst x). End equilibrium_point. @@ -588,7 +576,7 @@ Lemma equilibrium_points_subset (A B : set T) : A `<=` B -> equilibrium_points A `<=` equilibrium_points B. Proof. move=> AB x. -rewrite /equilibrium_points/= /is_equilibrium_point /is_sol_on0 inE => -[Ax H]. +rewrite /equilibrium_points/= /is_equilibrium_point /is_sol_on0o inE => -[Ax H]. split. exact/mem_set/AB. move=> Delta t t0D. @@ -606,13 +594,13 @@ Variable Init : set T. Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n) (Delta : K), f 0 \in Init /\ is_sol_on0 phi Delta f -> + forall (f : K -> 'rV[K]_n) (Delta : K), f 0 \in Init /\ is_sol_on0o phi (BLeft Delta) f -> `| f 0 - x | < d -> forall t, 0 < t < Delta -> `| f t - x | < eps. (* assuming solution exists for all time *) Definition is_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n), f 0 \in Init /\ is_global_sol phi f -> + forall (f : K -> 'rV[K]_n), f 0 \in Init /\ is_sol_on0y phi f -> `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. Lemma locally_stable_stable x : is_locally_stable_at x -> is_stable_at x. @@ -769,7 +757,7 @@ Variable phi : U -> U. Variable Delta : K. Variable u0 : U. Variable sol : K -> U (* TODO(2026-02-08): maybe this should be U -> K -> U to match lasalle *). -Hypothesis solP : is_sol_on0 phi Delta sol. +Hypothesis solP : is_sol_on0o phi (BLeft Delta) sol. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. @@ -863,7 +851,7 @@ Proof. by move=> r0; rewrite /B -closed_ballE. Qed. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall Delta sol, sol 0 \in Init -> is_sol_on0 phi Delta sol -> +Hypothesis V'_le0 : forall Delta sol, sol 0 \in Init -> is_sol_on0o phi (BLeft Delta) sol -> forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. (* khalil theorem 4.1 *) @@ -919,7 +907,7 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta Delta sol : sol 0 \in Init -> is_sol_on0 phi Delta sol -> +have Df_Omega_beta Delta sol : sol 0 \in Init -> is_sol_on0o phi (BLeft Delta) sol -> sol 0 \in Omega_beta -> forall t, 0 < t < Delta -> sol t \in Omega_beta. move=> sol0 solP phi_Omega. have /= V_nincr_consequence : forall t, 0 < t < Delta -> forall u, 0 <= u <= t -> @@ -1552,7 +1540,7 @@ have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))) have Rsu t0 : t0 \in `[0, Delta[ -> Right (y^`()%classic t0) = (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). rewrite inE/=. - rewrite /is_sol_on0/= in deri. + rewrite /is_sol_on0o/= in deri. by move/deri => [_ ->]; rewrite row_mxKr. rewrite /dotmul. transitivity (-2 * (gamma *: (Right (y x) - @@ -1611,7 +1599,7 @@ have norm_constant t0 : t0 \in `[0, Delta[ -> apply: differentiable_enorm_squared => /=. exact: differentiableB. move: t0d; rewrite in_itv/= => /andP[t_ge0 tDelta]. - rewrite /is_sol_on0/= in deri. + rewrite /is_sol_on0o/= in deri. have cont : {in `[0, t0], continuous y}. move=> t' t'0D. rewrite inE/= in t'0D. @@ -1890,7 +1878,7 @@ Let phi := Tilt.eqn alpha1 gamma. Variable Delta : K. Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> t \in `[0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. move=> /= deri /[!inE]/= t0Delta. @@ -1903,7 +1891,7 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> z \in `[0, Delta[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. @@ -1917,7 +1905,7 @@ Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : t \in `[0, Delta[%R -> sol 0 \in Tilt.Gamma1 -> - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> Tilt.Gamma1 (sol t). Proof. move=> t0Delta sol0 deriv_sol. @@ -1935,7 +1923,7 @@ Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> sol 0 \in Tilt.Gamma1 -> - is_sol_on0 phi Delta sol -> `|u|_e = 1. + is_sol_on0o phi (BLeft Delta) sol -> `|u|_e = 1. Proof. move=> z0Delta sol0 dtraj. suff: Tilt.Gamma1 (row_mx (zp1 z) (z2 z)). @@ -1948,7 +1936,7 @@ Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> sol 0 \in Tilt.Gamma1 -> - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> z0Delta sol0 dtraj. @@ -1973,7 +1961,7 @@ Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : z \in `[0, Delta[%R -> sol 0 \in Tilt.Gamma1 -> - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = `|Right (sol z) *m \S('e_2)|_e. Proof. @@ -1999,7 +1987,7 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> z \in `[0, Delta[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + @@ -2026,7 +2014,7 @@ Qed. Lemma derive_along_V1 t (sol : K -> 'rV_6) : t \in `]0, Delta[ -> - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> (forall t, t \in `]0, Delta[ -> differentiable sol t) -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. @@ -2064,7 +2052,7 @@ Definition u1 (sol : K -> 'rV[K]_6) t Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : sol 0 \in Tilt.Gamma1 -> - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> forall t, t \in `[0, Delta[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. @@ -2096,7 +2084,7 @@ by rewrite [leRHS]mulrC. Qed. Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> sol 0 \in Tilt.Gamma1 -> t \in `[0, Delta[%R -> V1dot (sol t) = 0 -> @@ -2145,7 +2133,7 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : - is_sol_on0 phi Delta (sol x) -> + is_sol_on0o phi (BLeft Delta) (sol x) -> sol x 0 = Tilt.point1 -> \forall z \near 0^', ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + @@ -2188,7 +2176,7 @@ Unshelve. all: try by end_near. Abort. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - is_sol_on0 phi Delta (sol x) -> + is_sol_on0o phi (BLeft Delta) (sol x) -> sol x 0 = Tilt.point1 -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. @@ -2228,7 +2216,7 @@ Abort. Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - is_sol_on0 phi Delta (sol x) -> + is_sol_on0o phi (BLeft Delta) (sol x) -> sol x 0 \in Tilt.Gamma1 -> (forall t : K, Tilt.Gamma1 (sol x t)) -> sol x 0 = Tilt.point1 -> @@ -2304,7 +2292,7 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : - is_sol_on0 phi Delta sol -> + is_sol_on0o phi (BLeft Delta) sol -> sol 0 \in Tilt.Gamma1 -> (forall t, 0 < t < Delta -> differentiable sol t) -> forall t : K, 0 < t < Delta -> @@ -2350,9 +2338,10 @@ Let c2 := 2^-1 / gamma. (* todo: copy paste *) Lemma derive_zp10 (sol : K -> 'rV_6) : - is_global_sol phi sol -> + is_sol_on0y phi sol -> 'D_1 (Left \o sol) 0 = - alpha1 *: Left (sol 0). Proof. +move/is_sol_on0yP. move/(_ _ (lexx 0)) => [d0 +]. move=> /(congr1 Left). rewrite derive1E. @@ -2362,10 +2351,11 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z20 (sol : K -> 'rV_6) : - is_global_sol phi sol -> + is_sol_on0y phi sol -> 'D_1 (Right \o sol) 0 = gamma *: (Right (sol 0) - Left (sol 0)) *m \S('e_2 - Right (sol 0)) ^+ 2. Proof. +move/is_sol_on0yP. move /(_ _ (lexx 0)) => [d0 +]. move => /(congr1 Right). rewrite derive1E. @@ -2373,7 +2363,7 @@ by rewrite row_mxKr => ?; rewrite derive_rsubmx. Qed. Lemma V1dotE0 (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_global_sol phi sol -> + is_sol_on0y phi sol -> V1dot (sol 0) = c1 *: (2 *: 'D_1 zp1 0 *m (Left (sol 0))^T) 0 0 + c2 *: (2 *: 'D_1 z2 0 *m (Right (sol 0))^T) 0 0. @@ -2399,13 +2389,14 @@ Qed. Lemma derive_along_V1_global t (sol : K -> 'rV_6) : 0 <= t -> - is_global_sol phi sol -> + is_sol_on0y phi sol -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0 tilt_eqnx. have dif1 : forall (t : K), 0 <= t -> differentiable sol t. move => /= t' t'0. apply/derivable1_diffP. + move/is_sol_on0yP in tilt_eqnx. by apply tilt_eqnx. rewrite /V1 derive_alongD; last 3 first. apply/differentiableM => //=. @@ -2426,7 +2417,7 @@ rewrite derive_alongMl => //; last first. rewrite le_eqVlt => /predU1P[<-//|t0]. rewrite V1dotE0 => //. by rewrite !invfM. - - rewrite (V1dotE alpha1_gt0 gamma_gt0 (@global_sol_sol _ _ _ _ tilt_eqnx (t + 1))) //. + - rewrite (V1dotE alpha1_gt0 gamma_gt0 (@global_sol_sol _ _ _ _ tilt_eqnx (BLeft (t + 1)))) //. by rewrite !invfM. by rewrite inE/= in_itv/= (ltW t0) ltrDl;apply /andP. - exact/differentiable_lsubmx_comp. @@ -2435,7 +2426,7 @@ exact:dif1. Qed. Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : - is_global_sol phi sol -> + is_sol_on0y phi sol -> sol 0 \in Tilt.Gamma1 -> forall t : K, 0 <= t -> 'D~(sol) (V1 alpha1 gamma) t <= 0. @@ -2444,12 +2435,13 @@ move=> solves sol0. have diff : forall (t : K), 0 <= t -> differentiable sol t. move => /= t' t0'. apply/derivable1_diffP. + move/is_sol_on0yP in solves. by apply solves. move => t t0. rewrite derive_along_V1_global//. have t0Delta : t \in `[0, t+1[%R. by rewrite in_itv/=t0 ltrDl ltr01. -have Hub := V1dot_ub sol0 (@global_sol_sol _ _ _ _ solves (t + 1)) t0Delta. +have Hub := V1dot_ub sol0 (@global_sol_sol _ _ _ _ solves (BLeft (t + 1))) t0Delta. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> `|(Left \o sol) t|_e, @@ -2601,660 +2593,3 @@ apply: differentiableX. apply: differentiable_coord. exact: sqrt_continuous. Qed. - -Section LaSalle_tilt. -Context {K : realType}. -Let U := 'rV[K]_6. -Variable sol : U -> K -> U. -Variables gamma alpha1 : K. -Hypothesis gamma_gt0 : 0 < gamma. -Hypothesis alpha1_gt0 : 0 < alpha1. -Let phi := Tilt.eqn alpha1 gamma. - -Hypothesis solP : forall y, y 0 \in Tilt.Gamma1 -> - lasalle.is_sol phi y <-> y = sol (y 0). - -Hypothesis initp: forall p, sol p 0 = p. - -Let isSol p : p \in Tilt.Gamma1 -> is_global_sol phi (sol p). -Proof. -move => Kp. -have : lasalle.is_sol phi (sol p) by apply/solP; rewrite ?initp. -move => [/=_ H]. -move => /= t t0. -split. - by apply: ex_derive; apply H. -by rewrite derive1E;apply H. -Qed. - -Definition Ksub (p : U) := - [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` Tilt.Gamma1. - -(* continuity in initial value: assumption needed for LaSalle *) -Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. - -Lemma V1_bound_compact p : compact [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p]. -Proof. -(* TODO: use something similar to compact_sphere *) -apply: bounded_closed_compact. -- rewrite /V1/=. - rewrite /bounded_near. - near=>R. - move => /= x. - rewrite !addf_div; rewrite ?lt0r_neq0 ?mulr_gt0 //. - rewrite ler_pdivrMr ?mulr_gt0 // divrK; last first. - by rewrite unitfE lt0r_neq0 // ?mulr_gt0. - rewrite !(mulrC 2) !mulrA -!mulrDl ler_pM2r //. - move => h. - set c := `| Left p |_e ^+ 2 * gamma + `| Right p |_e ^+ 2 * alpha1. - have c0 : 0 <= c. - by apply addr_ge0; rewrite mulr_ge0 // ?sqr_ge0 ?ltW. - have hL : `| Left x |_e <= Num.sqrt (c / gamma). - rewrite -(sqr_sqrtr (enorm_ge0 (Left x)) ). - rewrite /GRing.exp/= -sqrtrM ?enorm_ge0 // ler_sqrt ?divr_ge0 ?(@ltW _ _ _ gamma) //. - rewrite ler_pdivlMr //. - move : h;apply le_trans. - rewrite lerDl mulr_ge0 // ?sqr_ge0 ?ltW //. - have hR : `| Right x |_e <= Num.sqrt (c / alpha1). - rewrite -(sqr_sqrtr (enorm_ge0 (Right x)) ). - rewrite /GRing.exp/= -sqrtrM ?enorm_ge0 // ler_sqrt ?divr_ge0 ?(@ltW _ _ _ alpha1) //. - rewrite ler_pdivlMr //. - move : h;apply le_trans. - rewrite addrC lerDl mulr_ge0 // ?sqr_ge0 ?ltW //. - have normb : `|x| <= `| Left x |_e + `|Right x|_e. - have {1}-> : x = row_mx (Left x) (Right x). - by rewrite hsubmxK. - rewrite (norm_rowmx (Left x)). - apply (@le_trans _ _ (`|Left x| + `|Right x|)). - rewrite ge_max. - by apply /andP;split;rewrite ?lerDl ?lerDr normr_ge0 //. - apply lerD. - exact: mxnorm_enorm_le. - exact: mxnorm_enorm_le. - apply: (le_trans normb). - by apply: (le_trans (lerD hL hR)). -- have -> : [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] = - (V1 alpha1 gamma) @^-1` [set r | r <= V1 alpha1 gamma p] by []. - apply: closed_comp. - move => /= x xin. - exact: (differentiable_continuous (V1_diff _ _ _ )). - exact: closed_le. -Unshelve. all: by end_near. Qed. - -Lemma compact_Ksub p : compact (Ksub p). -Proof. -apply: compact_closedI. -exact: V1_bound_compact. -have -> : Tilt.Gamma1 = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. - by []. -apply : closed_comp => //. -move => x xp. -apply : continuous_comp; last by exact:continuous_enorm. -apply: continuousB. -exact: cst_continuous. -exact: continuous_rsubmx. -Qed. - -Lemma invariant_Ksub p : lasalle.is_invariant sol (Ksub p). -Proof. -rewrite /= /is_invariant/=. -move => /= x. (* . [/= sol' [d [solP [t h]]]]*) -rewrite /Ksub/= => -[Vx Kx] t t0. -split; last first. -- apply/(@tilt_state_spaceS _ alpha1 gamma). - exists (sol x), (t + 1) => /=. (* use large enough time *) - split => //. - rewrite initp. - exact/mem_set. - apply global_sol_sol. - apply isSol => //. - by rewrite inE. - exists t; split => //. - by rewrite /=in_itv/=t0/=ltrDl. -- move/mem_set : (Kx) => /isSol solA. - rewrite (le_trans _ Vx)//. - rewrite -[in leRHS](@initp x). - have : is_sol_on0 phi (t + 1) (sol x). - move => t'. - rewrite in_itv/= => /andP[t0' _]. - by apply solA. - move /(V_nincr ) => /=. - move /(_ (V1 alpha1 gamma)). - apply. - exact: V1_diff. - (* apply : (V_nincr solA (V1_diff _ _)); rewrite ?t0 ?lexx //. *) - move => t1 tt1. - apply : (@derive_along_V1_le0 _ _ _ _ _ (t+1))=> //. - apply global_sol_sol => //. - by rewrite initp inE. - move => t2. - move => /andP[t2' _]. - apply/derivable1_diffP. - apply solA. - by rewrite ltW. - by rewrite ltrDl. - by rewrite lexx. -Qed. - -Local Lemma sol_Ksub p u : u \in Ksub p -> is_global_sol phi (sol u). -Proof. -rewrite inE/= => -[h1 h2]. -apply isSol => //. -by rewrite inE. -Qed. - -Lemma V1dot_point1_eq0 : V1dot Tilt.point1 = (0 : K). -Proof. -rewrite /V1dot /Tilt.point1 /=. -rewrite lsubmx_const rsubmx_const enorm0 expr0n /= oppr0 add0r !mul0mx sub0r oppr0. -by rewrite mxE. -Qed. - -Lemma V1dot_point2_eq0 : V1dot Tilt.point2 = (0 : K). -Proof. -rewrite /V1dot /Tilt.point2 /=. -rewrite row_mxKl row_mxKr. -rewrite enorm0 expr0n /= oppr0 add0r. -rewrite -!scalemxAl -scalerBr. -rewrite trmx0 mulmx0 subr0. -rewrite !scalemxAl. -rewrite norm_spin. -rewrite -!scalemxAl enormZ. -rewrite spinE. -suff -> : 'e_2 *v 'e_2 = (0 : 'rV[K]_3). - by rewrite enorm0 /GRing.exp /= !mulr0 oppr0. -by rewrite vece2 /= scale0r. -Qed. - -Local Lemma sol_continuous p : p \in Tilt.Gamma1 -> continuous (sol p). -Proof. -move => sp t. -have [issol0 issol1]: lasalle.is_sol phi (sol p). - apply: (sol_is_sol (sol := sol) (K:=Tilt.Gamma1)) => //. - move => y Ky. - by apply /solP;rewrite inE. - move : sp. - by rewrite inE. -apply : differentiable_continuous. -apply /derivable1_diffP. -have [ht | ht] := ltP t 0; last by apply /ex_derive/issol1. -apply : (@near_eq_derivable _ _ _ (fun t => 2 *: sol p 0 - sol p (-t))) => //. - near=> s. - rewrite -issol0 //. - near: s. - by apply: lt_nbhsl. -apply /derivable1_diffP. -apply: differentiable_comp => //. -apply: differentiable_comp => //. -apply: differentiable_comp => //. -apply /derivable1_diffP. -apply /ex_derive/issol1. -rewrite lerNr oppr0 ltW//. -Unshelve. all: by end_near. Qed. - -Local Lemma q_inKsubq q : q \in Tilt.Gamma1 -> q \in Ksub q. -Proof. rewrite !inE => h;split => //=. Qed. - -Local Lemma limS_subset_V1dot0 p : - p \in Tilt.Gamma1 -> - limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. -Proof. -move => ps. -have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). - move => y Ky. - apply/solP. - rewrite inE. - by apply Ky. -have H : limS sol (Ksub p) `<=` [set x | (V1 alpha1 gamma \o sol x)^`() 0 = 0] `&` Tilt.Gamma1. - rewrite subsetI; split. - apply: (@stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (V1 alpha1 gamma)) => //=. - apply/continuous_subspaceT => x xK. - apply : differentiable_continuous. - apply: V1_diff. - move => /= p0 t K0 t0. - apply /derivable1_diffP. - apply differentiable_comp. - apply /derivable1_diffP. - apply isSol => //. - rewrite inE. - by have [_ +] := K0. - exact: V1_diff. - move => p0 K0. - have p0s : p0 \in Tilt.Gamma1. - by move : K0;rewrite inE/=/Ksub/inE/=;move=>[]. - rewrite derive1E. - rewrite -derive_along_derive. - apply : derive_along_V1_le0_global => //. - by apply isSol. - by rewrite initp. - rewrite initp. - by apply: V1_diff => //. - apply /derivable1_diffP. - by apply isSol => //. - move=>/=x [q qKsub xcl]. - suff [] : (Ksub q) x by []. - rewrite (closure_id (Ksub q)).1;last first. - apply compact_closed => //. - exact: compact_Ksub. - have qs (t :K) : 0 <= t -> state_space phi (Ksub q) (sol q t). - exists (sol q), (t+1). - split. - rewrite initp; apply q_inKsubq. - have/= [_ +] := qKsub. - by move/mem_set. - apply global_sol_sol. - by apply isSol;rewrite inE;apply qKsub. - exists t;split => //. - by rewrite/=in_itv/=H ltrDl ltr01. - have lim_sp : (sol q x @[x --> +oo]) (Ksub q). - exists 0; split => // t t0 /=. - apply invariant_Ksub. - split => /=. - by rewrite lexx. - by have/= [_ +] := qKsub. - by rewrite ltW. - rewrite clusterE in xcl. - by apply:xcl. -apply: (subset_trans H). -move =>/= x [+ h1]. -rewrite derive1E. -rewrite -derive_along_derive. -rewrite derive_along_V1_global //=. -by rewrite initp ?inE. -split => //. -apply isSol => //. -by apply/mem_set. -apply isSol => //. -by apply/mem_set. -by apply: V1_diff. -apply /derivable1_diffP. -apply isSol => //. -by rewrite inE. -Qed. - -Lemma limS_subset_points p : - p \in Tilt.Gamma1 -> limS sol (Ksub p) `<=` Tilt.points. -Proof. -have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. - apply/seteqP; split => x /=. - case => ->;split; [exact: V1dot_point1_eq0 | | exact: V1dot_point2_eq0 | ]. - have := @tilt_point1_in_state_space K. - by rewrite inE. - have := @tilt_point2_in_state_space K. - by rewrite inE. - move => [h1 h2']. - have h2 : x \in Tilt.Gamma1 by rewrite inE. - move : h1. - have hi := initp x. - rewrite -hi => h1. - have sol' : is_sol_on0 phi 1 (sol x) . - apply: global_sol_sol. - by apply isSol. - apply: (V1dot_eq0_p1_or_p2 sol') => //. - rewrite hi. - exact/mem_set. - by rewrite in_itv /= lexx ltr01. -by apply limS_subset_V1dot0. -Qed. - -From mathcomp Require Import finmap. - -(*Todo: generalize + PR? *) -Lemma compact_decreasing_bigcap (X : ptopologicalType) (B : K -> set X) (O : set X) : - hausdorff_space X -> - (forall i, 0 <= i -> compact (B i)) -> - (forall i j, i <= j -> B j `<=` B i) -> - open O -> - (\bigcap_(i in [set i | 0 <= i]) B i `<=` O) -> - exists i0, 0 <= i0 /\ B i0 `<=` O. -Proof. -move => H comp decr openO subO. -set V := fun i => B i `&` ~` O. -have comp' i : 0 <= i -> compact (V i). - move=> i0. - apply: compact_closedI. - by apply comp. - by apply open_closedC. -have decr' i j : i <= j -> V j `<=` V i. - move=>ij. - rewrite /V. - by apply setSI; apply decr. -rewrite /=. -apply/not_existsP. -move => /= hf. -suff /set0P : \bigcap_(i in [set t | 0 <= t]) V i !=set0. - rewrite /V/=. - rewrite bigcapIl; last first. - by exists 0 => /=. - move /eqP => h. - by have /subsets_disjoint := h. -have cf : closed_fam_of (B 0) [set t | t >= 0] V. - exists V => /=t t0 //. - apply closedI. - apply compact_closed => //. - apply comp => //. - by apply open_closedC. - rewrite /V. - rewrite setIA. - apply: congr2 => //. - symmetry. - rewrite setIC. - apply: setIidl. - by apply decr. -have : compact (B 0) by apply comp. -rewrite compact_In0/=. -apply => //. -move => D Ds. -set m := \big[max/0]_(z <- D) z. -have M : forall x, x \in D -> x <= m. - move=>x xD. - rewrite /m. - by apply: le_bigmax_seq. -suff Vm : V m `<=` \bigcap_(i in [set` D]) V i . - apply: (subset_nonempty Vm). - have := (hf m). - apply contra_notP. - rewrite /V. - move /nonemptyPn => Ve. - split => //. - apply: bigmax_ge_id. - by apply subsets_disjoint. -apply sub_bigcap => i Di. -apply decr'. -by apply M. -Qed. -(*Todo: PR? *) -(* NB: should be possible to generalize without normal_space X *) -Lemma compact_connected_cluster - (X : ptopologicalType) (f : K -> X) (A : set X) : - hausdorff_space X -> - normal_space X -> - continuous f -> - compact A -> - (forall t, 0 <= t -> f t \in A) -> - connected (cluster (f t @[t --> +oo])). -Proof. -move => H Hn contf compactf imagef. -set B := fun t => closure (f @` `[t, +oo[). -have Bcon t : connected (B t). - apply: connected_closure. - apply: connected_continuous_connected. - apply /connected_intervalP/interval_is_interval. - by apply continuous_subspaceT. -have Bnonempty t : B t !=set0. - exists (f t);apply subset_closure. - by exists t; rewrite /=?in_itv/=?lexx. -have Bmon (s t : K): s <= t -> B t `<=` B s. - move => st. - apply: closure_subset. - move => _ [t' tt'] <-. - exists t' => //. - move : tt'; rewrite /=!in_itv//= => /andP[ht _];apply /andP;split=>//. - by apply: (le_trans st). -have Bcom t : 0 <= t -> compact (B t). - move => tge0. - apply: (subclosed_compact _ compactf). - exact: closed_closure. - rewrite (closure_id A).1; last by apply compact_closed. - apply: closure_subset. - move => _ [t0 tp] <-. - move /(_ t0): imagef. - have t0ge0 : 0 <= t0. - move : tp. - rewrite /=in_itv/= => /andP[+ _]. - by apply le_trans. - by move /(_ t0ge0) /set_mem. -have -> : cluster (f t @[t --> +oo]) = \bigcap_(t in [set t | 0 <= t]) B t. - rewrite clusterE. - apply/seteqP;split. - apply:sub_bigcap => t0 _. - apply: bigcap_inf. - exists t0; split. - apply num_real. - move => t tx; exists t;rewrite //=in_itv/=ltW//. - apply : sub_bigcap => b /= [t0 [_ /= h]]. - apply: (subset_trans (bigcap_inf (i := (max 0 (t0+1))) _)) => //. - by rewrite /=le_max lexx. - apply closure_subset. - move => _ /= [x xt] <-. - apply h. - have t1: (t0+1 <= x). - move : xt; rewrite /=in_itv/= => /andP[+ _]. - apply le_trans. - by rewrite le_max lexx;apply /orP;right. - apply/lt_le_trans/t1. - by rewrite ltrDl. -apply /connectedP => E [Enonempty Eu Esep]. -have /(separated_closedUP Esep) [E1c E2c] : closed ((E false) `|` (E true)). - rewrite -Eu;apply closed_bigI => i P;apply compact_closed => //. - by apply Bcom. -have /normal_openP := Hn. -move /(_ K (E false) (E true)) => [| | | V1 [V2 [V1o V2o V1E1 V2E2 V12disj]]]//. - by apply separated_disjoint. -have V1V2o : open (V1 `|` V2). - by apply openU. -have V1V2sep : separated V1 V2. - by apply open_disjoint_separated. -have BV1V2 : \bigcap_(t in [set t | 0 <= t]) B t `<=` V1 `|` V2. - by rewrite Eu;apply : setUSS. -case /compact_decreasing_bigcap : BV1V2 => // t0 [t0ge0 Bto] //. -suff: V1 `&` V2 !=set0. - by apply nonemptyPn. -have [e1 E1 ] := Enonempty false. -have [e2 E2 ] := Enonempty true. -have EB : (E false `|` E true `<=` B t0). - rewrite <- Eu. - apply bigcap_inf => //. -case (connected_subset V1V2sep Bto (Bcon _)) => hbv. - exists e2. - split; last by apply V2E2. - apply hbv. - by apply EB;right. - exists e1. -split; first by apply V1E1. -apply hbv. -by apply EB;left. -Qed. - -Lemma cvg_to_set_points p : p \in Tilt.Gamma1 -> - sol p t @[t --> +oo] --> Tilt.points. -Proof. -move=> /set_mem ps. -have : p \in Ksub p by apply/mem_set; split => //=. -move => pK. -have p0K : (forall p0 : 'rV_6, p0 \in Ksub p -> sol p0 0 = p0). - move => q /set_mem[_ h]. - exact: initp. -apply: (cvg_trans (cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) _)). - by move: pK => /set_mem. -move => /= S [eps eps0 Be]. -exists eps => //. -apply bigcup_sub => /= x H. -apply: (subset_trans _ Be). -have ps' : p \in Tilt.Gamma1 by exact/mem_set. -have : Tilt.points x by apply: (limS_subset_points ps'). -move => h x' Bx'. -by exists x. -Qed. - -Lemma avoid_x (x : U) : (~` Tilt.points) x -> - exists S : set U, [/\ open S, Tilt.points `<=` S & ~ closure S x]. -Proof. -move => hx. -have cx : closed [set x]. - by apply accessible_closed_set1; apply hausdorff_accessible. -have cp : closed (@Tilt.points K). - rewrite /Tilt.points. - by apply accessible_finite_set_closed => //; apply hausdorff_accessible. -have /(@normal_openP K) Hn : normal_space U by apply: pseudometric_normal. -have [|V1 [V2 [V1o V2o V1c V2c Vdisj]]] := (Hn _ _ cx cp). - apply disjoints_subset. - by rewrite sub1set; apply/mem_set . -exists V2;split => //. -move => h. -have [_ +] := open_disjoint_separated V1o V2o Vdisj. -apply /nonemptyPn => /=. -rewrite not_notE. -exists x. -split => //. -by apply V1c. -Qed. - -Lemma cluster_contained_points p : p \in Tilt.Gamma1 -> - cluster (sol p t @[t --> +oo]) `<=` Tilt.points. -Proof. -move => ps. -have /cvg_cluster cp12 := cvg_to_set_points ps. -apply: (subset_trans cp12). -rewrite clusterE. -move => /= x H. -suff : (~ (~` Tilt.points) x) by apply contrapT. -move => Hdist. -have [S [So Sc Sx]] := avoid_x Hdist. -have [e1 /= e10 /= P1] : \forall e \near 0^'+, ball Tilt.point1 e `<=` S. - apply: open_subball => //. - by apply Sc;left. -have [e2 /= e20 /= P2] : \forall e \near 0^'+, ball Tilt.point2 e `<=` S. - apply: open_subball => //. - by apply Sc;right. -set eps := min (e1/2) (e2/2). -have eps0 : 0 < eps. - by rewrite lt_min !divr_gt0. -have B1 : ball Tilt.point1 eps `<=` S. - apply P1 => //. - rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ltr_pdivrMr // ltr_pMr ?ltrDr //. - by apply /orP;left. -have B2 : ball Tilt.point2 eps `<=` S. - apply P2 => //. - rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ?ltr_pdivrMr // ltr_pMr ?ltrDr //. - by apply /orP;right. -have nbh' : (nbhs Tilt.points S). - exists eps => //=. - rewrite /ball_set. - by apply: bigcup_sub => /= _ [-> | ->]. -by have := H _ nbh'. -Qed. - -Local Lemma connected2_subset (A : set U) : connected A -> A !=set0 -> - A `<=` Tilt.points -> A = [set Tilt.point1] \/ A = [set Tilt.point2]. -Proof. -move=>Ac Anonempty Asub. -have sep : separated [set (@Tilt.point1 K)] [set Tilt.point2]. - split. - - rewrite -(closure_id _).1; last first. - by apply accessible_closed_set1; apply hausdorff_accessible. - apply/disjoints_subset. - rewrite sub1set. - apply/mem_set => /=. - exact/eqP/Tilt.point1_neq2. - - rewrite setIC -(closure_id _).1; last first. - by apply accessible_closed_set1; apply hausdorff_accessible. - apply/disjoints_subset. - rewrite sub1set. - apply/mem_set => /=. - exact/nesym/eqP/Tilt.point1_neq2. -have [/subset_set1 [/nonemptyPn A0 | ] | /subset_set1 [/nonemptyPn A0 |] ]:= (connected_subset sep Asub Ac) => //. -by left. -by right. -Qed. - -Lemma cluster_nonempty p : p \in Tilt.Gamma1 -> cluster (sol p t @[t --> +oo]) !=set0. -Proof. -move => sp. -suff : (Ksub p) `&` cluster (sol p t @[t --> +oo]) !=set0. - move => [x [_ cx]]. - by exists x. -apply (@compact_Ksub p) => //. - by apply: fmap_proper_filter. -apply sub_image_at_infty => /=. -move => _ [t t0] <-. -apply invariant_Ksub => //. -by have /set_mem := q_inKsubq sp. -Qed. - -Lemma p1_Ksub p : Ksub p Tilt.point1. -Proof. -split => /=; last by have /set_mem := @tilt_point1_in_state_space K. -rewrite /Tilt.point1 /V1. -rewrite lsubmx_const rsubmx_const/= !enorm0 !expr0n /= !mul0r add0r. -by rewrite addr_ge0 // divr_ge0 // ?sqr_ge0 ?mulr_ge0 // ltW. -Qed. - -(*Todo : PR ? *) -Lemma cvg_to_p1_or_p2 p : p \in Tilt.Gamma1 -> - (sol p t @[t --> +oo] --> Tilt.point1 ) \/ ( sol p t @[t --> +oo] --> Tilt.point2). -Proof. -move => ps. -have cluster_con : connected (cluster (sol p t @[t --> +oo])). - apply: (compact_connected_cluster _ _ _ (@compact_Ksub p) ) => //. - by apply: pseudometric_normal. - by apply: sol_continuous. - move => t t0. - apply/mem_set. - apply: invariant_Ksub => //. - by have /set_mem := q_inKsubq ps. -have := connected2_subset cluster_con (cluster_nonempty ps) (cluster_contained_points ps). -suff H (q : U): cluster (sol p t @[t --> +oo]) = [set q] -> sol p t @[t --> +oo] --> q. - move => [h | h]; [left | right];apply H => //. -move => H. - -have Ksubq : Ksub p q. - suff: cluster (sol p t @[t --> +oo]) `<=` Ksub p. - by apply; rewrite H. - rewrite clusterE. - apply :(@subset_trans _ (closure (sol p @` `[0, +oo[))). - apply: bigcap_inf => //=. - exists 0; split => //= x x0. - exists x=>//. - rewrite in_itv/=ltW//. - rewrite (closure_id (Ksub p)).1;last first. - by apply compact_closed =>//; apply compact_Ksub. - apply closure_subset. - move => /= _ [t +] <-. - rewrite in_itv/= => /andP[t0 _]. - apply invariant_Ksub => //. - by have /set_mem := q_inKsubq ps. -have [M [Mr Mp]]: bounded_set (Ksub p). - apply compact_bounded. - exact: compact_Ksub. -have [M0 | M0] := leP 0 M;last first. - suff : `|q| < 0 by rewrite normr_lt0. - have M02 : M < M/2. - by rewrite ltr_pdivlMr // gtr_nMr // ltrDl. - have /= w := (Mp _ M02 _ Ksubq). - apply (le_lt_trans w). - rewrite ltr_pdivrMr // mul0r //. -set V := ball (p : U) (`|p|+(M+1+1) : K). -have VKsub : Ksub p `<=` V. - move => /= x Kx. - rewrite /V -ball_normE/ball_ /=. - by rewrite (le_lt_trans (ler_normB _ _))// ltrD2l ltr_pwDr// Mp// ltrDl. -have B1 : 0 < `|p| + (M + 1 + 1). - by rewrite ltr_wpDl// addr_gt0// ltr_wpDl. -have Vo : open V. - by rewrite /V; exact: ball_open. -have cV : compact (closure V). - rewrite closure_ballE closed_ballE//. - apply: bounded_closed_compact; last by apply: closed_closed_ball_. - exists (`|p| + (`|p| + (M+1 +1))). - rewrite /closed_ball_/=. - split => //= x xB y Hy. - rewrite -(subrKC p y). - apply : (le_trans (ler_normD _ _)). - rewrite distrC. - apply (le_trans (lerD (lexx _ ) Hy)). - by apply ltW. -apply: (compact_cluster_set1 _ cV ) => //. - rewrite nbhsE/=. - exists V; last by apply subset_closure. - split => //. - by apply VKsub. -apply : (filterS (closure_subset VKsub)). -exists 0;split => //= x /ltW x0. -rewrite -(closure_id (Ksub p)).1;last first. - by apply compact_closed =>//; apply compact_Ksub. -apply invariant_Ksub => //. -by have /set_mem := q_inKsubq ps. -Qed. - -End LaSalle_tilt. From 93cbeb58a726379045ab705d48174006624b545d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 10 Feb 2026 16:58:08 +0900 Subject: [PATCH 107/144] fix --- ode.v | 2 +- ode_contfun.v | 2 +- ode_wip.v | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ode.v b/ode.v index c0e41339..582413fb 100644 --- a/ode.v +++ b/ode.v @@ -7,7 +7,7 @@ From mathcomp Require Import functions reals interval_inference topology. From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. -Require Import common contfun. +Require Import ode_common ode_contfun. (**md**************************************************************************) (* # Proof of the Cauchy-Lipschitz theorem *) diff --git a/ode_contfun.v b/ode_contfun.v index 1b61ae06..dffd1251 100644 --- a/ode_contfun.v +++ b/ode_contfun.v @@ -7,7 +7,7 @@ From mathcomp Require Import functions reals interval_inference topology. From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. -Require Import common. +Require Import ode_common. (**md**************************************************************************) (* # ODE *) diff --git a/ode_wip.v b/ode_wip.v index 8a2f004e..4cf7570d 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -8,7 +8,7 @@ From mathcomp Require Import functions reals interval_inference topology. From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. -Require Import common contfun ode. +Require Import ode_common ode_contfun ode. (**md**************************************************************************) (* # ODE wip *) From 17bdc73b6b6c2f7415164735a534cd7135cd8cd7 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 10 Feb 2026 17:04:33 +0900 Subject: [PATCH 108/144] forgot file --- tilt_lasalle.v | 688 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 688 insertions(+) create mode 100644 tilt_lasalle.v diff --git a/tilt_lasalle.v b/tilt_lasalle.v new file mode 100644 index 00000000..6b8af3b8 --- /dev/null +++ b/tilt_lasalle.v @@ -0,0 +1,688 @@ +From HB Require Import structures. +From mathcomp Require Import all_boot all_algebra ring. +From mathcomp Require Import interval_inference finmap. +From mathcomp Require Import boolp classical_sets functions reals order. +From mathcomp Require Import topology normedtype landau sequences derive realfun. +From mathcomp Require Import matrix_normedtype. +Require Import ssr_ext euclidean rigid frame skew derive_matrix. +Require Import tilt_mathcomp tilt_analysis tilt_robot. +Require Import lasalle (* to at least get the structure of filters on sets *). +Require Import ode tilt_lyapunov. + +(**md**************************************************************************) +(* # Tentative formalization of [1] *) +(* *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. +Local Open Scope ring_scope. + +(* finite intersection property *) +Lemma compact_decreasing_bigcap d {K : orderType d} (k0 : K) + (X : ptopologicalType) (B : K -> set X) (O : set X) : + hausdorff_space X -> + (forall i : K, (k0 <= i)%O -> compact (B i)) -> + (forall i j : K, (i <= j)%O -> B j `<=` B i) -> + open O -> + (\bigcap_(i in [set i | (k0 <= i)%O]) B i `<=` O) -> + exists i0, (k0 <= i0)%O /\ B i0 `<=` O. +Proof. +move => H comp decr openO subO. +set V := fun i => B i `&` ~` O. +have comp' i : (k0 <= i)%O -> compact (V i). + move=> i0. + apply: compact_closedI. + by apply comp. + by apply open_closedC. +have decr' i j : (i <= j)%O -> V j `<=` V i. + move=>ij. + rewrite /V. + by apply setSI; apply decr. +rewrite /=. +apply/not_existsP. +move => /= hf. +suff /set0P : \bigcap_(i in [set t | k0 <= t]%O) V i !=set0. + rewrite /V/=. + rewrite bigcapIl; last first. + exists k0 => /=. + exact: lexx. + move /eqP => h. + by have /subsets_disjoint := h. +have cf : closed_fam_of (B k0) [set t | t >= k0]%O V. + exists V => /=t t0 //. + apply closedI. + apply compact_closed => //. + apply comp => //. + by apply open_closedC. + rewrite /V. + rewrite setIA. + apply: congr2 => //. + symmetry. + rewrite setIC. + apply: setIidl. + by apply decr. +have : compact (B k0) by apply comp. +rewrite compact_In0/=. +apply => //. +move => D Ds. +set m := \big[Order.max/k0]_(z <- D) z. +have M x : x \in D -> (x <= m)%O. + move=> xD. + exact: le_bigmax_seq. +suff Vm : V m `<=` \bigcap_(i in [set` D]) V i . + apply: (subset_nonempty Vm). + have := hf m. + apply contra_notP. + rewrite /V. + move /nonemptyPn => Ve. + split => //. + apply: bigmax_ge_id. + by apply subsets_disjoint. +apply sub_bigcap => i Di. +apply decr'. +by apply M. +Qed. + +(* NB: should be possible to generalize without normal_space X *) +Lemma compact_connected_cluster {K : realType} + (X : ptopologicalType) (f : K -> X) (A : set X) : + hausdorff_space X -> + normal_space X -> + continuous f -> + compact A -> + (forall t, 0 <= t -> f t \in A) -> + connected (cluster (f t @[t --> +oo])). +Proof. +move => H Hn contf compactf imagef. +set B := fun t => closure (f @` `[t, +oo[). +have Bcon t : connected (B t). + apply: connected_closure. + apply: connected_continuous_connected. + apply /connected_intervalP/interval_is_interval. + by apply continuous_subspaceT. +have Bnonempty t : B t !=set0. + exists (f t);apply subset_closure. + by exists t; rewrite /=?in_itv/=?lexx. +have Bmon (s t : K): s <= t -> B t `<=` B s. + move => st. + apply: closure_subset. + move => _ [t' tt'] <-. + exists t' => //. + move : tt'; rewrite /=!in_itv//= => /andP[ht _];apply /andP;split=>//. + by apply: (le_trans st). +have Bcom t : 0 <= t -> compact (B t). + move => tge0. + apply: (subclosed_compact _ compactf). + exact: closed_closure. + rewrite (closure_id A).1; last by apply compact_closed. + apply: closure_subset. + move => _ [t0 tp] <-. + move /(_ t0): imagef. + have t0ge0 : 0 <= t0. + move : tp. + rewrite /=in_itv/= => /andP[+ _]. + by apply le_trans. + by move /(_ t0ge0) /set_mem. +have -> : cluster (f t @[t --> +oo]) = \bigcap_(t in [set t | 0 <= t]) B t. + rewrite clusterE. + apply/seteqP;split. + apply:sub_bigcap => t0 _. + apply: bigcap_inf. + exists t0; split. + apply num_real. + move => t tx; exists t;rewrite //=in_itv/=ltW//. + apply : sub_bigcap => b /= [t0 [_ /= h]]. + apply: (subset_trans (bigcap_inf (i := (Num.max 0 (t0+1))) _)) => //. + by rewrite /=le_max lexx. + apply closure_subset. + move => _ /= [x xt] <-. + apply h. + have t1 : t0 + 1 <= x. + move : xt; rewrite /=in_itv/= => /andP[+ _]. + apply le_trans. + by rewrite le_max lexx;apply /orP;right. + apply/lt_le_trans/t1. + by rewrite ltrDl. +apply /connectedP => E [Enonempty Eu Esep]. +have /(separated_closedUP Esep) [E1c E2c] : closed ((E false) `|` (E true)). + rewrite -Eu;apply closed_bigI => i P;apply compact_closed => //. + by apply Bcom. +have /normal_openP := Hn. +move /(_ K (E false) (E true)) => [| | | V1 [V2 [V1o V2o V1E1 V2E2 V12disj]]]//. + by apply separated_disjoint. +have V1V2o : open (V1 `|` V2). + by apply openU. +have V1V2sep : separated V1 V2. + by apply open_disjoint_separated. +have BV1V2 : \bigcap_(t in [set t | 0 <= t]) B t `<=` V1 `|` V2. + by rewrite Eu;apply : setUSS. +case /compact_decreasing_bigcap : BV1V2 => // t0 [t0ge0 Bto] //. +suff: V1 `&` V2 !=set0. + by apply nonemptyPn. +have [e1 E1 ] := Enonempty false. +have [e2 E2 ] := Enonempty true. +have EB : (E false `|` E true `<=` B t0). + rewrite - Eu. + by apply bigcap_inf => //. +case (connected_subset V1V2sep Bto (Bcon _)) => hbv. + exists e2. + split; last by apply V2E2. + apply hbv. + by apply EB;right. + exists e1. +split; first by apply V1E1. +apply hbv. +by apply EB;left. +Qed. + +Section LaSalle_tilt. +Context {K : realType}. +Let U := 'rV[K]_6. +Variable sol : U -> K -> U. +Variables gamma alpha1 : K. +Hypothesis gamma_gt0 : 0 < gamma. +Hypothesis alpha1_gt0 : 0 < alpha1. +Let phi := Tilt.eqn alpha1 gamma. + +Hypothesis solP : forall y, y 0 \in Tilt.Gamma1 -> + lasalle.is_sol phi y <-> y = sol (y 0). + +Hypothesis initp : forall p, sol p 0 = p. + +Let isSol p : p \in Tilt.Gamma1 -> is_sol_on0y phi (sol p). +Proof. +move => Kp. +apply/is_sol_on0yP. +have : lasalle.is_sol phi (sol p) by apply/solP; rewrite ?initp. +move => [/=_ H]. +move => /= t t0. +split. + by apply: ex_derive; apply H. +by rewrite derive1E;apply H. +Qed. + +Definition Ksub (p : U) := + [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` Tilt.Gamma1. + +(* continuity in initial value: assumption needed for LaSalle *) +Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. + +Local Notation Left := (@lsubmx _ 1 3 3). +Local Notation Right := (@rsubmx _ 1 3 3). + +Lemma V1_bound_compact p : compact [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p]. +Proof. +(* TODO: use something similar to compact_sphere *) +apply: bounded_closed_compact. +- rewrite /V1/=. + rewrite /bounded_near. + near=>R. + move => /= x. + rewrite !addf_div; rewrite ?lt0r_neq0 ?mulr_gt0 //. + rewrite ler_pdivrMr ?mulr_gt0 // divrK; last first. + by rewrite unitfE lt0r_neq0 // ?mulr_gt0. + rewrite !(mulrC 2) !mulrA -!mulrDl ler_pM2r //. + move => h. + set c := `| Left p |_e ^+ 2 * gamma + `| Right p |_e ^+ 2 * alpha1. + have c0 : 0 <= c. + by apply addr_ge0; rewrite mulr_ge0 // ?sqr_ge0 ?ltW. + have hL : `| Left x |_e <= Num.sqrt (c / gamma). + rewrite -(sqr_sqrtr (enorm_ge0 (Left x)) ). + rewrite /GRing.exp/= -sqrtrM ?enorm_ge0 // ler_sqrt ?divr_ge0 ?(@ltW _ _ _ gamma) //. + rewrite ler_pdivlMr //. + move : h;apply le_trans. + rewrite lerDl mulr_ge0 // ?sqr_ge0 ?ltW //. + have hR : `| Right x |_e <= Num.sqrt (c / alpha1). + rewrite -(sqr_sqrtr (enorm_ge0 (Right x)) ). + rewrite /GRing.exp/= -sqrtrM ?enorm_ge0 // ler_sqrt ?divr_ge0 ?(@ltW _ _ _ alpha1) //. + rewrite ler_pdivlMr //. + move : h;apply le_trans. + rewrite addrC lerDl mulr_ge0 // ?sqr_ge0 ?ltW //. + have normb : `|x| <= `| Left x |_e + `|Right x|_e. + have {1}-> : x = row_mx (Left x) (Right x). + by rewrite hsubmxK. + rewrite (norm_rowmx (Left x)). + apply (@le_trans _ _ (`|Left x| + `|Right x|)). + rewrite ge_max. + by apply /andP;split;rewrite ?lerDl ?lerDr normr_ge0 //. + apply lerD. + exact: mxnorm_enorm_le. + exact: mxnorm_enorm_le. + apply: (le_trans normb). + by apply: (le_trans (lerD hL hR)). +- have -> : [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] = + (V1 alpha1 gamma) @^-1` [set r | r <= V1 alpha1 gamma p] by []. + apply: closed_comp. + move => /= x xin. + exact: (differentiable_continuous (V1_diff _ _ _ )). + exact: closed_le. +Unshelve. all: by end_near. Qed. + +Lemma compact_Ksub p : compact (Ksub p). +Proof. +apply: compact_closedI. +exact: V1_bound_compact. +have -> : Tilt.Gamma1 = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. + by []. +apply : closed_comp => //. +move => x xp. +apply : continuous_comp; last by exact:continuous_enorm. +apply: continuousB. +exact: cst_continuous. +exact: continuous_rsubmx. +Qed. + +Lemma invariant_Ksub p : lasalle.is_invariant sol (Ksub p). +Proof. +rewrite /= /lasalle.is_invariant/=. +move => /= x. (* . [/= sol' [d [solP [t h]]]]*) +rewrite /Ksub/= => -[Vx Kx] t t0. +split; last first. +- apply/(@tilt_state_spaceS _ alpha1 gamma). + exists (sol x), (t + 1) => /=. (* use large enough time *) + split => //. + rewrite initp. + exact/mem_set. + apply global_sol_sol. + apply isSol => //. + by rewrite inE. + exists t; split => //. + by rewrite /=in_itv/=t0/=ltrDl. +- move/mem_set : (Kx) => /isSol /is_sol_on0yP solA. + rewrite (le_trans _ Vx)//. + rewrite -[in leRHS](@initp x). + have : is_sol_on0o phi (BLeft (t + 1)) (sol x). + move => t'. + rewrite in_itv/= => /andP[t0' _]. + by apply solA. + move /(V_nincr ) => /=. + move /(_ (V1 alpha1 gamma)). + apply. + exact: V1_diff. + (* apply : (V_nincr solA (V1_diff _ _)); rewrite ?t0 ?lexx //. *) + move => t1 tt1. + apply : (@derive_along_V1_le0 _ _ _ _ _ (t+1))=> //. + apply global_sol_sol => //. + apply/is_sol_on0yP. + apply solA. + by rewrite initp inE. + move => t2. + move => /andP[t2' _]. + apply/derivable1_diffP. + apply solA. + by rewrite ltW. + by rewrite ltrDl. + by rewrite lexx. +Qed. + +Local Lemma sol_Ksub p u : u \in Ksub p -> is_sol_on0y phi (sol u). +Proof. +rewrite inE/= => -[h1 h2]. +apply isSol => //. +by rewrite inE. +Qed. + +Lemma V1dot_point1_eq0 : V1dot Tilt.point1 = (0 : K). +Proof. +rewrite /V1dot /Tilt.point1 /=. +rewrite lsubmx_const rsubmx_const enorm0 expr0n /= oppr0 add0r !mul0mx sub0r oppr0. +by rewrite mxE. +Qed. + +Lemma V1dot_point2_eq0 : V1dot Tilt.point2 = (0 : K). +Proof. +rewrite /V1dot /Tilt.point2 /=. +rewrite row_mxKl row_mxKr. +rewrite enorm0 expr0n /= oppr0 add0r. +rewrite -!scalemxAl -scalerBr. +rewrite trmx0 mulmx0 subr0. +rewrite !scalemxAl. +rewrite norm_spin. +rewrite -!scalemxAl enormZ. +rewrite spinE. +suff -> : 'e_2 *v 'e_2 = (0 : 'rV[K]_3). + by rewrite enorm0 /GRing.exp /= !mulr0 oppr0. +by rewrite vece2 /= scale0r. +Qed. + +Local Lemma sol_continuous p : p \in Tilt.Gamma1 -> continuous (sol p). +Proof. +move => sp t. +have [issol0 issol1]: lasalle.is_sol phi (sol p). + apply: (lasalle.sol_is_sol (sol := sol) (K:=Tilt.Gamma1)) => //. + move => y Ky. + by apply /solP;rewrite inE. + move : sp. + by rewrite inE. +apply : differentiable_continuous. +apply /derivable1_diffP. +have [ht | ht] := ltP t 0; last by apply /ex_derive/issol1. +apply : (@near_eq_derivable _ _ _ (fun t => 2 *: sol p 0 - sol p (-t))) => //. + near=> s. + rewrite -issol0 //. + near: s. + by apply: lt_nbhsl. +apply /derivable1_diffP. +apply: differentiable_comp => //. +apply: differentiable_comp => //. +apply: differentiable_comp => //. +apply /derivable1_diffP. +apply /ex_derive/issol1. +rewrite lerNr oppr0 ltW//. +Unshelve. all: by end_near. Qed. + +Local Lemma q_inKsubq q : q \in Tilt.Gamma1 -> q \in Ksub q. +Proof. rewrite !inE => h;split => //=. Qed. + +Local Lemma limS_subset_V1dot0 p : + p \in Tilt.Gamma1 -> + lasalle.limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. +Proof. +move => ps. +have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). + move => y Ky. + apply/solP. + rewrite inE. + by apply Ky. +have H : lasalle.limS sol (Ksub p) `<=` + [set x | (V1 alpha1 gamma \o sol x)^`()%classic 0 = 0] `&` Tilt.Gamma1. + rewrite subsetI; split. + apply: (@lasalle.stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (V1 alpha1 gamma)) => //=. + apply/continuous_subspaceT => x xK. + apply : differentiable_continuous. + apply: V1_diff. + move => /= p0 t K0 t0. + apply /derivable1_diffP. + apply differentiable_comp. + apply /derivable1_diffP. + apply isSol => //; last first. + by rewrite in_itv/= andbT. + rewrite inE. + by have [_ +] := K0. + exact: V1_diff. + move => p0 K0. + have p0s : p0 \in Tilt.Gamma1. + by move : K0;rewrite inE/=/Ksub/inE/=;move=>[]. + rewrite derive1E. + rewrite -derive_along_derive. + apply : derive_along_V1_le0_global => //. + by apply isSol. + by rewrite initp. + rewrite initp. + by apply: V1_diff => //. + apply /derivable1_diffP. + apply isSol => //. + by rewrite in_itv/= lexx. + move=>/=x [q qKsub xcl]. + suff [] : (Ksub q) x by []. + rewrite (closure_id (Ksub q)).1;last first. + apply compact_closed => //. + exact: compact_Ksub. + have qs (t :K) : 0 <= t -> state_space phi (Ksub q) (sol q t). + exists (sol q), (t+1). + split. + rewrite initp; apply q_inKsubq. + have/= [_ +] := qKsub. + by move/mem_set. + apply global_sol_sol. + by apply isSol;rewrite inE;apply qKsub. + exists t;split => //. + by rewrite/=in_itv/=H ltrDl ltr01. + have lim_sp : (sol q x @[x --> +oo]) (Ksub q). + exists 0; split => // t t0 /=. + apply invariant_Ksub. + split => /=. + by rewrite lexx. + by have/= [_ +] := qKsub. + by rewrite ltW. + rewrite clusterE in xcl. + by apply:xcl. +apply: (subset_trans H). +move =>/= x [+ h1]. +rewrite derive1E. +rewrite -derive_along_derive. +rewrite derive_along_V1_global //=. +by rewrite initp ?inE. +split => //. +apply isSol => //. +by apply/mem_set. +apply isSol => //. +by apply/mem_set. +by apply: V1_diff. +apply /derivable1_diffP. +apply isSol => //; last first. + by rewrite in_itv/= lexx. +by rewrite inE. +Qed. + +Lemma limS_subset_points p : + p \in Tilt.Gamma1 -> lasalle.limS sol (Ksub p) `<=` Tilt.points. +Proof. +have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. + apply/seteqP; split => x /=. + case => ->;split; [exact: V1dot_point1_eq0 | | exact: V1dot_point2_eq0 | ]. + have := @tilt_point1_in_state_space K. + by rewrite inE. + have := @tilt_point2_in_state_space K. + by rewrite inE. + move => [h1 h2']. + have h2 : x \in Tilt.Gamma1 by rewrite inE. + move : h1. + have hi := initp x. + rewrite -hi => h1. + have sol' : is_sol_on0o phi (BLeft 1) (sol x) . + apply: global_sol_sol. + by apply isSol. + apply: (V1dot_eq0_p1_or_p2 sol') => //. + rewrite hi. + exact/mem_set. + by rewrite in_itv /= lexx ltr01. +by apply limS_subset_V1dot0. +Qed. + +Lemma cvg_to_set_points p : p \in Tilt.Gamma1 -> + sol p t @[t --> +oo] --> (Tilt.points : set 'rV_6). +Proof. +move=> /set_mem ps. +have : p \in Ksub p by apply/mem_set; split => //=. +move => pK. +have p0K : (forall p0 : 'rV_6, p0 \in Ksub p -> sol p0 0 = p0). + move => q /set_mem[_ h]. + exact: initp. +apply: (cvg_trans (lasalle.cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) _)). + by move: pK => /set_mem. +move => /= S [eps eps0 Be]. +exists eps => //. +apply bigcup_sub => /= x H. +apply: (subset_trans _ Be). +have ps' : p \in Tilt.Gamma1 by exact/mem_set. +have : Tilt.points x by apply: (limS_subset_points ps'). +move => h x' Bx'. +by exists x. +Qed. + +Lemma avoid_x (x : U) : (~` Tilt.points) x -> + exists S : set U, [/\ open S, Tilt.points `<=` S & ~ closure S x]. +Proof. +move => hx. +have cx : closed [set x]. + by apply accessible_closed_set1; apply hausdorff_accessible. +have cp : closed (@Tilt.points K). + rewrite /Tilt.points. + by apply accessible_finite_set_closed => //; apply hausdorff_accessible. +have /(@normal_openP K) Hn : normal_space U by apply: pseudometric_normal. +have [|V1 [V2 [V1o V2o V1c V2c Vdisj]]] := (Hn _ _ cx cp). + apply disjoints_subset. + by rewrite sub1set; apply/mem_set . +exists V2;split => //. +move => h. +have [_ +] := open_disjoint_separated V1o V2o Vdisj. +apply /nonemptyPn => /=. +rewrite not_notE. +exists x. +split => //. +by apply V1c. +Qed. + +Lemma cluster_contained_points p : p \in Tilt.Gamma1 -> + cluster (sol p t @[t --> +oo]) `<=` Tilt.points. +Proof. +move => ps. +have /cvg_cluster cp12 := cvg_to_set_points ps. +apply: (subset_trans cp12). +rewrite clusterE. +move => /= x H. +suff : (~ (~` Tilt.points) x) by apply contrapT. +move => Hdist. +have [S [So Sc Sx]] := avoid_x Hdist. +have [e1 /= e10 /= P1] : \forall e \near 0^'+, ball Tilt.point1 e `<=` S. + apply: open_subball => //. + by apply Sc;left. +have [e2 /= e20 /= P2] : \forall e \near 0^'+, ball Tilt.point2 e `<=` S. + apply: open_subball => //. + by apply Sc;right. +set eps := Num.min (e1 / 2) (e2 / 2). +have eps0 : 0 < eps. + by rewrite lt_min !divr_gt0. +have B1 : ball Tilt.point1 eps `<=` S. + apply P1 => //. + rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ltr_pdivrMr // ltr_pMr ?ltrDr //. + by apply /orP;left. +have B2 : ball Tilt.point2 eps `<=` S. + apply P2 => //. + rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ?ltr_pdivrMr // ltr_pMr ?ltrDr //. + by apply /orP;right. +have nbh' : (nbhs Tilt.points S). + exists eps => //=. + rewrite /ball_set. + by apply: bigcup_sub => /= _ [-> | ->]. +by have := H _ nbh'. +Qed. + +Local Lemma connected2_subset (A : set U) : connected A -> A !=set0 -> + A `<=` Tilt.points -> A = [set Tilt.point1] \/ A = [set Tilt.point2]. +Proof. +move=>Ac Anonempty Asub. +have sep : separated [set (@Tilt.point1 K)] [set Tilt.point2]. + split. + - rewrite -(closure_id _).1; last first. + by apply accessible_closed_set1; apply hausdorff_accessible. + apply/disjoints_subset. + rewrite sub1set. + apply/mem_set => /=. + exact/eqP/Tilt.point1_neq2. + - rewrite setIC -(closure_id _).1; last first. + by apply accessible_closed_set1; apply hausdorff_accessible. + apply/disjoints_subset. + rewrite sub1set. + apply/mem_set => /=. + exact/nesym/eqP/Tilt.point1_neq2. +have [/subset_set1 [/nonemptyPn A0 | ] | /subset_set1 [/nonemptyPn A0 |] ]:= (connected_subset sep Asub Ac) => //. +by left. +by right. +Qed. + +Lemma cluster_nonempty p : p \in Tilt.Gamma1 -> cluster (sol p t @[t --> +oo]) !=set0. +Proof. +move => sp. +suff : (Ksub p) `&` cluster (sol p t @[t --> +oo]) !=set0. + move => [x [_ cx]]. + by exists x. +apply (@compact_Ksub p) => //. + by apply: fmap_proper_filter. +apply sub_image_at_infty => /=. +move => _ [t t0] <-. +apply invariant_Ksub => //. +by have /set_mem := q_inKsubq sp. +Qed. + +Lemma p1_Ksub p : Ksub p Tilt.point1. +Proof. +split => /=; last by have /set_mem := @tilt_point1_in_state_space K. +rewrite /Tilt.point1 /V1. +rewrite lsubmx_const rsubmx_const/= !enorm0 !expr0n /= !mul0r add0r. +by rewrite addr_ge0 // divr_ge0 // ?sqr_ge0 ?mulr_ge0 // ltW. +Qed. + +Lemma tilt_cvg_to_point1_or_point2 p : p \in Tilt.Gamma1 -> + (sol p t @[t --> +oo] --> Tilt.point1) \/ + (sol p t @[t --> +oo] --> Tilt.point2). +Proof. +move => ps. +have cluster_con : connected (cluster (sol p t @[t --> +oo])). + apply: (compact_connected_cluster _ _ _ (@compact_Ksub p) ) => //. + by apply: pseudometric_normal. + by apply: sol_continuous. + move => t t0. + apply/mem_set. + apply: invariant_Ksub => //. + by have /set_mem := q_inKsubq ps. +have := connected2_subset cluster_con (cluster_nonempty ps) (cluster_contained_points ps). +suff H (q : U): cluster (sol p t @[t --> +oo]) = [set q] -> sol p t @[t --> +oo] --> q. + move => [h | h]; [left | right];apply H => //. +move => H. +have Ksubq : Ksub p q. + suff: cluster (sol p t @[t --> +oo]) `<=` Ksub p. + by apply; rewrite H. + rewrite clusterE. + apply :(@subset_trans _ (closure (sol p @` `[0, +oo[))). + apply: bigcap_inf => //=. + exists 0; split => //= x x0. + exists x=>//. + rewrite in_itv/=ltW//. + rewrite (closure_id (Ksub p)).1;last first. + by apply compact_closed =>//; apply compact_Ksub. + apply closure_subset. + move => /= _ [t +] <-. + rewrite in_itv/= => /andP[t0 _]. + apply invariant_Ksub => //. + by have /set_mem := q_inKsubq ps. +have [M [Mr Mp]]: bounded_set (Ksub p). + apply compact_bounded. + exact: compact_Ksub. +have [M0 | M0] := leP 0 M;last first. + suff : `|q| < 0 by rewrite normr_lt0. + have M02 : M < M/2. + by rewrite ltr_pdivlMr // gtr_nMr // ltrDl. + have /= w := (Mp _ M02 _ Ksubq). + apply (le_lt_trans w). + rewrite ltr_pdivrMr // mul0r //. +set V := ball (p : U) (`|p|+(M+1+1) : K). +have VKsub : Ksub p `<=` V. + move => /= x Kx. + rewrite /V -ball_normE/ball_ /=. + by rewrite (le_lt_trans (ler_normB _ _))// ltrD2l ltr_pwDr// Mp// ltrDl. +have B1 : 0 < `|p| + (M + 1 + 1). + by rewrite ltr_wpDl// addr_gt0// ltr_wpDl. +have Vo : open V. + by rewrite /V; exact: ball_open. +have cV : compact (closure V). + rewrite closure_ballE closed_ballE//. + apply: bounded_closed_compact; last by apply: closed_closed_ball_. + exists (`|p| + (`|p| + (M + 1 +1))). + rewrite /closed_ball_/=. + split => //= x xB y Hy. + rewrite -(subrKC p y). + apply: (le_trans (ler_normD _ _)). + rewrite distrC. + apply (le_trans (lerD (lexx _ ) Hy)). + by apply ltW. +apply: (compact_cluster_set1 _ cV ) => //. + rewrite nbhsE/=. + exists V; last by apply subset_closure. + split => //. + by apply VKsub. +apply: (filterS (closure_subset VKsub)). +exists 0; split => //= x /ltW x0. +rewrite -(closure_id (Ksub p)).1;last first. + by apply compact_closed =>//; apply compact_Ksub. +apply invariant_Ksub => //. +by have /set_mem := q_inKsubq ps. +Qed. + +End LaSalle_tilt. From 4457da47aee266b1dcb32644c2cec6ba4b0f6bfb Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Tue, 10 Feb 2026 17:19:53 +0900 Subject: [PATCH 109/144] equilibrium in state space --- tilt_lyapunov.v | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index 99110ab6..34c861f7 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -563,6 +563,17 @@ Variable Delta : K. Definition is_equilibrium_point (x : T) := x \in Init /\ forall Delta, is_sol_on0o phi Delta (cst x). +Lemma equilibrium_point_in_state_space (x : T) : is_equilibrium_point x -> x \in state_space phi Init. +Proof. + move => [xinit solD]. + rewrite inE. + exists (cst x). + exists (1). + split=>//. + exists 0. + split=>//. + by rewrite in_itv/= lexx //= ltW. +Qed. End equilibrium_point. Section equilibrium_point. From ca8e75824781c88d7798e61574d076ba5cfbe8ac Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 13 Feb 2026 09:36:42 +0900 Subject: [PATCH 110/144] minor cleaning --- ode.v | 12 +- ode_common.v | 4 +- ode_contfun.v | 384 ++++++++++++++++++++++---------------------------- ode_wip.v | 1 - 4 files changed, 179 insertions(+), 222 deletions(-) diff --git a/ode.v b/ode.v index 582413fb..e6a6b7c0 100644 --- a/ode.v +++ b/ode.v @@ -639,8 +639,7 @@ rewrite closed_ballE// /img_cball. apply eq_set => /= f'; apply propext; split => h. - rewrite -(@reprK _ V f'). rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. - rewrite norm_piE. - apply: infty_norm0_le => /=. + rewrite infty_norm_pi infty_norm0_le //=. exact: leDl_delta_max. move=> x adx. move /(_ (f' x)) : h. @@ -656,10 +655,10 @@ apply eq_set => /= f'; apply propext; split => h. by rewrite !eval_mod_on_itv// inE. rewrite -(@reprK _ V f'). rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. - rewrite eval_mod_on_itv;last by rewrite inE. + rewrite eval_mod_on_itv; last by rewrite inE. rewrite -inE in xad. apply: (le_trans (infty_norm0_ge (leDl_delta_max phi ab u0 r k0 rho) _ xad)). - rewrite -(norm_piE (leDl_delta_max phi ab u0 r k0 rho)). + rewrite -(infty_norm_pi (leDl_delta_max phi ab u0 r k0 rho)). by rewrite Quotient.pi_add Quotient.pi_opp reprK. Qed. @@ -1145,7 +1144,7 @@ exists (NngNum (ge0 rho)); split => //=. move=> /= [/= x y] [Vrx Vry]. rewrite /picard/=. rewrite !piE/=. -rewrite norm_piE/=. +rewrite infty_norm_pi/=. rewrite /infty_norm0/=. apply: ge_sup => //=. set u := _ \o _; exists (u a) => /=; exists a => //. @@ -1760,7 +1759,8 @@ Lemma solution_continuous : {within `[a, a + delta_max], continuous local_solution}. Proof. exact: cts_fun. Qed. -Definition cauchy_lipschitz_local_f : continuousFunType `[a, a + delta_max] [set: 'rV[R]_n] := +Definition cauchy_lipschitz_local_f : + continuousFunType `[a, a + delta_max] [set: 'rV[R]_n] := repr (picard_fix ab k0 lip2 cont1 rho1). Let f := cauchy_lipschitz_local_f. diff --git a/ode_common.v b/ode_common.v index fa93cbef..67381be3 100644 --- a/ode_common.v +++ b/ode_common.v @@ -784,9 +784,9 @@ Lemma infty_norm0_le (g : T) (u : R) : {in K, forall x, `| g x | <= u} -> infty_norm0 g <= u. Proof. have [c Kc] := seg_nonempty ab. - move => h; rewrite /infty_norm0; apply: ge_sup. +move=> h; rewrite /infty_norm0; apply: ge_sup. by exists (normr (g c)); exists c => //; rewrite /= in_itv/= lexx. - by move => _ [x xab] <-;apply h; rewrite inE. +by move => _ [x xab] <-;apply h; rewrite inE. Qed. Lemma infty_norm0_ge (g : T) x : x \in K -> `|g x| <= infty_norm0 g. diff --git a/ode_contfun.v b/ode_contfun.v index dffd1251..bbea222b 100644 --- a/ode_contfun.v +++ b/ode_contfun.v @@ -49,17 +49,6 @@ Check continuousFunType `[a, b] [set: V] : lmodType _. End cont_on_seg_zlmodtype. End Cont_on_seg_zlmodtype. -(* point V does not need to be 0, so rewrite f\_K explicitly *) -Section submod_itv. -Context {R : realType} {V : normedModType R} (a b : R). -Local Notation T := (continuousFunType `[a, b] [set: V]). - -Definition submod_itv (ab : a <= b) : {pred T} := - [pred f : T | patch 0 `[a, b] f == 0]. - -End submod_itv. -Arguments submod_itv {R} V {a b} ab. - Section contFun_seminorm. Context {R : realType} {W : normedModType R}. Variables a b : R. @@ -103,8 +92,20 @@ Qed. End contFun_seminorm. +(* point V does not need to be 0, so rewrite f\_K explicitly *) +Section submod_itv. +Context {R : realType} {V : normedModType R} (a b : R). +Local Notation T := (continuousFunType `[a, b] [set: V]). + +Definition submod_itv (ab : a <= b) : {pred T} := + [pred f : T | patch 0 `[a, b] f == 0]. + +End submod_itv. +Arguments submod_itv {R} V {a b} ab. + Module Cont_on_seg_quot. Export Cont_on_seg_zlmodtype. + Section submod_definition. Context {R : realType} {V : normedModType R}. Variables a b : R. @@ -199,6 +200,18 @@ apply: (@eqmod_on_itv (repr (\pi_T f)) f) => //. by rewrite reprK. Qed. +Lemma quot_continuousFunType_fctB (f g : T) t : t \in `[a, b] -> + (f - g : T) t = (f : T) t - (g : T) t. +Proof. +move=> tab. +rewrite -(reprK f) -(reprK g). +rewrite /GRing.opp/=. +rewrite -Quotient.pi_opp. +rewrite /GRing.add/=. +rewrite -Quotient.pi_add. +by rewrite !eval_mod_on_itv. +Qed. + End cont_on_seg_quotient. End Cont_on_seg_quot. @@ -280,7 +293,7 @@ rewrite Quotient.pi_add reprK. by move : IHn' <-. Qed. -Let infty_norm_pi x : infty_norm (\pi_V x) = infty_norm0 x. +Let infty_norm_pi0 x : infty_norm (\pi_V x) = infty_norm0 x. Proof. rewrite /infty_norm /=. have /eqmod_on_itv Heq : repr (\pi_V x) = x %[mod V] by rewrite reprK. @@ -289,7 +302,7 @@ Qed. Lemma infty_normrN (x : V) : infty_norm (- x) = infty_norm x. Proof. -rewrite -(reprK x) /GRing.opp /= -Quotient.pi_opp !infty_norm_pi /infty_norm /infty_norm0. +rewrite -(reprK x) /GRing.opp /= -Quotient.pi_opp !infty_norm_pi0 /infty_norm /infty_norm0. congr sup. apply eq_set => /= x0. apply propext; split => [[x1 in_itv] | [x1 in_itv]] H; exists x1 =>//. @@ -303,8 +316,24 @@ Fail Check V : normedZmodType R. HB.instance Definition _ := @Num.Zmodule_isNormed.Build R V infty_norm ler_infty_normD infty_normr0_eq0 infty_normrMn infty_normrN. -Lemma norm_piE x : `|\pi_V x| = infty_norm0 x. -Proof. by rewrite /Num.norm /= infty_norm_pi. Qed. +Lemma infty_norm_pi x : `|\pi_V x| = infty_norm0 x. +Proof. by rewrite /Num.norm /= infty_norm_pi0. Qed. + +Lemma infty_norm_lt (f : V) e : + `| f | < e -> {in `[a, b], forall x : R, `|f x| < e}. +Proof. +rewrite -{1}(reprK f) infty_norm_pi => h x xab. +exact/le_lt_trans/h/infty_norm0_ge. +Qed. + +Lemma infty_norm_leP (f : V) e : + `| f | <= e <-> {in `[a, b], forall x : R, `|f x| <= e}. +Proof. +split. + rewrite -{1}(reprK f) infty_norm_pi => h x xab. + exact/le_trans/h/infty_norm0_ge. +by move => h; by rewrite -(reprK f) infty_norm_pi infty_norm0_le. +Qed. Check V : normedZmodType R. @@ -315,7 +344,7 @@ Fail Check (pseudoMetric_normed V) : normedModType R. End zmodule_normed. -Section V_normedtype. +Section quot_continuousFunType_normedtype. Context {R : realType} {W : normedModType R} {r s : R} (rs : r <= s). Import Cont_on_seg_quot. @@ -440,14 +469,13 @@ by rewrite normrZ. Qed. HB.instance Definition _ := is_pmnormedZmod_contFunBallType. -End V_normedtype. +End quot_continuousFunType_normedtype. From mathcomp Require Import all_algebra. From mathcomp Require Import matrix_topology. Section completeness. -Context {R : realType} (*{n : nat}*) {W : completeNormedModType R}. -(*Let W := 'rV[R]_n.*) +Context {R : realType} {W : completeNormedModType R}. Variables a b : R. Hypothesis ab : a <= b. @@ -458,20 +486,9 @@ Notation V := (@quot_continuousFunType R W _ _ ab). Check (V : pseudoMetricType R). Check (V : normedModType R). -Lemma infty_norm_gt_V (f : V) e : - `| f | < e -> {in `[a, b], forall x : R, `|f x| < e}. -Proof. -rewrite -{1}(reprK f) norm_piE => h x xab. -exact/le_lt_trans/h/infty_norm0_ge. -Qed. - -Lemma infty_norm_le_V (f : V) e : - {in `[a, b], forall x : R, `|f x| <= e} -> `| f | <= e. -Proof. by move => h; by rewrite -(reprK f) norm_piE infty_norm0_le. Qed. - Definition lim_fun (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : subspace `[a, b] -> W := - fun t => lim (@^~t @ F). + fun t => lim (@^~ t @ F). Lemma lim_fun_is_fun (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : @isFun (subspace `[a, b]) W `[a, b] [set: W] (@lim_fun F FF Fc). @@ -480,63 +497,52 @@ Proof. by constructor. Qed. HB.instance Definition _ F FF Fc := (@lim_fun_is_fun F FF Fc). Lemma lim_fun_cvg_pt (F : set_system V) (FF: ProperFilter F) (Fc : cauchy F) : - forall (e : R), e > 0 -> forall t, t \in `[a,b] -> + forall e : R, e > 0 -> forall t, t \in `[a,b] -> \forall f \near F, `|lim_fun FF Fc t - (f : V) t| <= e. Proof. have /(_ _ _) /cauchy_cvg /cvg_app_entourageP cvF : forall t : R, t \in `[a,b] -> - cauchy (fmap (fun (h : V) => h t) (fun x : set V => nbhs F (fun x0 : V => x x0))). + cauchy (fmap (fun h : V => h t) (fun A : set V => nbhs F (fun g => A g))). move=> t tab A /=. - rewrite -entourage_ballE. - move=> [e /= e0 eA]. + rewrite -entourage_ballE => -[e /= e0 eA]. rewrite near_simpl -near2E near_map2. - apply : Fc. - rewrite -entourage_ballE. - rewrite /nbhs/=. - exists e => //. - move => /= [f g] /=. - move /infty_norm_gt_V => h. - apply eA => /=. + apply: Fc. + rewrite -entourage_ballE /nbhs/= /entourage_/=. + exists e => // -[f g]/= /infty_norm_lt => h. + apply: eA => /=. rewrite -ball_normE /ball/=. - have <- : (f - g : V) t = (f : V) t - (g : V) t. - rewrite -(reprK f) -(reprK g) /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. - by rewrite !eval_mod_on_itv. - by apply h. -have cvg_pt : forall (t : R), t \in `[a,b] -> x @[x --> fmap (fun h : V => h t) F] --> lim_fun FF Fc t. - move => t tab. - apply /cvg_entourageP. - by apply cvF. -move => e e0 t tab. -move /(_ t tab) : cvg_pt. -move/cvgrPdist_le/(_ _ e0). + rewrite -quot_continuousFunType_fctB//. + exact: h. +have cvg_pt (t : R) : t \in `[a,b] -> + x @[x --> fmap (fun h : V => h t) F] --> lim_fun FF Fc t. + move=> tab. + apply/cvg_entourageP. + exact: cvF. +move=> e e0 t /cvg_pt /cvgrPdist_le. exact. Qed. Lemma lim_fun_cvg_uniform (F : set_system V) (FF: ProperFilter F) (Fc : cauchy F) : - forall (e : R), e > 0 -> \forall f \near F, forall t, t \in `[a,b] -> `|lim_fun FF Fc t - (f : V) t| <= e. + forall e : R, e > 0 -> \forall f \near F, forall t, t \in `[a, b] -> + `|lim_fun FF Fc t - (f : V) t| <= e. Proof. -move => e e0. -have e20 : 0 < e/2 by rewrite divr_gt0. +move=> e e0. +have e20 : 0 < e / 2 by rewrite divr_gt0. have := Fc _ (entourage_ball V (PosNum e20)). -move => [/= [ha hb] /= [n1 n2]] H. -near=>f. -move=>t tab. +move => [/= [A B] /= [n1 n2]] H. +near=> f. +move=> t tab. near F => g. rewrite -(subrKA (g t) (lim_fun FF Fc t)). rewrite (le_trans (ler_normD _ _))// (splitr e) lerD//. near: g. - by apply lim_fun_cvg_pt;rewrite // divr_gt0. -have c1 : ball f (e/2) g. - apply (H (f, g)); split => //=. - by near: f. - by near: g. -rewrite /ball /= /pseudoMetric_from_normedZmodType.ball /= in c1. + by apply: lim_fun_cvg_pt => //; rewrite divr_gt0. +have : ball f (e /2 ) g. + by apply: (H (f, g)); split => //=; [near: f|near: g]. +rewrite /ball /= /pseudoMetric_from_normedZmodType.ball /=. rewrite distrC. -have <- : (f - g : V) t = (f : V) t - (g : V) t. - rewrite -(reprK f) -(reprK g) /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. - by rewrite !eval_mod_on_itv. -rewrite ltW //. -exact: infty_norm_gt_V. +rewrite -quot_continuousFunType_fctB//. +by move/ltW/infty_norm_leP; exact. Unshelve. all: by end_near. Qed. Lemma lim_fun_cont (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : @@ -544,124 +550,94 @@ Lemma lim_fun_cont (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : Proof. move: ab; rewrite le_eqVlt => /predU1P[<-| ab']. by rewrite set_itv1; exact: continuous_subspace1. -have H : forall (e : R), e > 0 ->forall t, t \in `[a,b] -> \forall t' \near t, t' \in `[a,b] -> +have H (e : R) : e > 0 -> forall t, t \in `[a, b] -> + \forall t' \near t, t' \in `[a, b] -> `|lim_fun FF Fc t - lim_fun FF Fc t'| <= e. - move => e e0 t tab. + move=> e0 t tab. near F => f. - move /(continuous_within_itvP _ ab') : (@cts_fun _ _ f ) => [mc lc rc]. - move : (tab). + have lim_fune2 : forall u, u \in `[a, b] -> `|lim_fun FF Fc u - f u| <= e / 2. + by near: f; apply: lim_fun_cvg_uniform => //; rewrite divr_gt0. + move/(continuous_within_itvP _ ab') : (@cts_fun _ _ f ) => [mc lc rc]. + move: (tab). rewrite -{1}setUitv1/=; last by rewrite bnd_simp ltW. rewrite -{1}setU1itv/=; last by rewrite bnd_simp. - (* split t=a, t \in ]a,b[, t=b *) rewrite inE/= in_itv/= => -[[->|tab']|->]. - near=> t' => t'ab. rewrite -(subrKA (f a) (lim_fun FF Fc a)). - rewrite (le_trans (ler_normD _ _))//. - rewrite (splitr e) lerD//. - suff: forall t, t \in `[a,b] -> `|lim_fun FF Fc t - f t| <= e / 2 by apply;rewrite inE /= in_itv/= lexx ltW //. - near:f. - by apply lim_fun_cvg_uniform;rewrite // divr_gt0 //. - rewrite -(subrKA (f t') (f a)). - rewrite (le_trans (ler_normD _ _))//. - rewrite (splitr (e/2)) lerD//. - move : t'ab. - rewrite -{1}setU1itv/=; last by rewrite bnd_simp. - rewrite inE/= in_itv/= => -[-> | ]. - rewrite subrr normr0 ltW //. - do 2 rewrite divr_gt0 //. - near:t'. - move /cvgrPdist_le : lc . - move /( _ (e/ 2/ 2)) => [| e1 e10 eh]. - do 2 rewrite divr_gt0 //. - exists e1 => //. - move => x bx /andP [xa _]. - by apply eh. - rewrite distrC. - move : (t') t'ab. - near:f. - by apply lim_fun_cvg_uniform; do 2 rewrite divr_gt0 //. + rewrite (le_trans (ler_normD _ _))// (splitr e) lerD//. + + by rewrite lim_fune2// inE/= bound_itvE ltW. + + rewrite -(subrKA (f t') (f a)). + rewrite (le_trans (ler_normD _ _))// (splitr (e/2)) lerD//. + * move: t'ab. + rewrite -{1}setU1itv/=; last by rewrite bnd_simp. + rewrite inE/= in_itv/= => -[-> | ]. + by rewrite subrr normr0 ltW// !divr_gt0. + near: t'. + move/cvgrPdist_le : lc => /( _ (e/ 2/ 2)). + rewrite !divr_gt0// => /(_ isT)[e1 e10 eh]. + by exists e1 => // => x ae1x /andP [xa _]; exact: eh. + * rewrite distrC. + move: (t') t'ab. + near: f. + by apply lim_fun_cvg_uniform; rewrite !divr_gt0. - near=> t' => t'ab. rewrite -(subrKA (f t) (lim_fun FF Fc t)). - rewrite (le_trans (ler_normD _ _))//. - rewrite (splitr e) lerD//. - move : (t) (tab). - near:f. - by apply lim_fun_cvg_uniform;rewrite // divr_gt0 //. + rewrite (le_trans (ler_normD _ _))// (splitr e) lerD//. + move: (t) tab. + near: f. + by apply: lim_fun_cvg_uniform => //; rewrite divr_gt0. rewrite -(subrKA (f t') (f t)). - rewrite (le_trans (ler_normD _ _))//. - rewrite (splitr (e/2)) lerD//. - near:t'. - move /(_ _ tab'): mc. - rewrite /continuous_at cvgrPdist_le /=. - apply. - do 2 rewrite divr_gt0 //. + rewrite (le_trans (ler_normD _ _))// (splitr (e/2)) lerD//. + near: t'. + move /(_ _ tab') : mc => /cvgrPdist_le /=; apply. + by rewrite !divr_gt0. rewrite distrC. - move : (t') t'ab. - near:f. - apply lim_fun_cvg_uniform; do 2 rewrite divr_gt0 //. -(* Todo: same as 1 *) + move: (t') t'ab. + near: f. + by apply: lim_fun_cvg_uniform; rewrite !divr_gt0. - near=> t' => t'ab. rewrite -(subrKA (f b) (lim_fun FF Fc b)). - rewrite (le_trans (ler_normD _ _))//. - rewrite (splitr e) lerD//. - suff: forall t, t \in `[a,b] -> `|lim_fun FF Fc t - f t| <= e / 2 by apply;rewrite inE /= in_itv/= lexx ltW //. - near:f. - by apply lim_fun_cvg_uniform;rewrite // divr_gt0 //. + rewrite (le_trans (ler_normD _ _))// (splitr e) lerD//. + by rewrite lim_fune2// inE/= bound_itvE ltW. rewrite -(subrKA (f t') (f b)). - rewrite (le_trans (ler_normD _ _))//. - rewrite (splitr (e/2)) lerD//. - move : t'ab. - rewrite -{1}setUitv1/=; last by rewrite bnd_simp ltW. - rewrite inE/= in_itv/= => -[ | -> ];last first. - rewrite subrr normr0 ltW //. - do 2 rewrite divr_gt0 //. - near:t'. - move /cvgrPdist_le : rc . - move /( _ (e/ 2/ 2)) => [| e1 e10 eh]. - do 2 rewrite divr_gt0 //. - exists e1 => //. - move => x bx /andP [_ xb]. - by apply eh. + rewrite (le_trans (ler_normD _ _))// (splitr (e / 2)) lerD//. + move: t'ab. + rewrite -{1}setUitv1/=; last by rewrite bnd_simp ltW. + rewrite inE/= in_itv/= => -[ | -> ]; last first. + by rewrite subrr normr0 ltW// !divr_gt0. + near: t'. + move/cvgrPdist_le : rc => /( _ (e / 2 / 2)). + rewrite !divr_gt0// => /(_ isT)[e1 e10 eh]. + by exists e1 => // x be1x /andP [_ xb]; exact: eh. rewrite distrC. - move : (t') t'ab. - near:f. - by apply lim_fun_cvg_uniform; do 2 rewrite divr_gt0 //. + move: (t') t'ab. + near: f. + by apply: lim_fun_cvg_uniform; rewrite !divr_gt0. apply/continuous_within_itvP => //; split. -- move => t tab. - apply/cvgrPdist_le => /= e e0. - near=>t'. - have : t' \in `[a,b]. +- move=> t tab; apply/cvgrPdist_le => /= e e0. + near=> t'. + have : t' \in `[a, b]. rewrite inE; apply: subset_itv_oo_cc. - near: t'. - apply/at_right_in_segment. - by apply: open_itvcc_subset. - near:t'. + by near: t'; exact/at_right_in_segment/open_itvcc_subset. + near: t'. apply: H => //. - by rewrite inE; apply subset_itv_oo_cc. + by rewrite inE; exact: subset_itv_oo_cc. - apply/cvgrPdist_le => /= e e0. - near=>t'. + near=> t'. have : t' \in `[a,b]. - rewrite inE /= in_itv/=. - apply/andP; split; near:t'. - exact: nbhs_right_ge. - exact: nbhs_right_le. - near:t'. - apply : cvg_at_right_filter. - by apply cvg_id. - apply: H => //. + rewrite inE/= in_itv/=. + by apply/andP; split; near: t'; [exact: nbhs_right_ge|exact: nbhs_right_le]. + near: t'. + apply/(cvg_at_right_filter cvg_id)/H => //. by rewrite inE/= bound_itvE// ltW. -apply/cvgrPdist_le => /= e e0. -near=>t'. -have : t' \in `[a,b]. - rewrite inE /= in_itv/=. - apply /andP;split;near:t'. - exact: nbhs_left_ge. - exact: nbhs_left_le. -near:t'. -apply: cvg_at_left_filter. - exact: cvg_id. -apply: H => //. -by rewrite inE /= bound_itvE/= ltW. +- apply/cvgrPdist_le => /= e e0. + near=> t'. + have : t' \in `[a,b]. + rewrite inE /= in_itv/=. + by apply/andP; split; near: t'; [exact: nbhs_left_ge|exact: nbhs_left_le]. + near: t'. + apply/(cvg_at_left_filter cvg_id)/H => //. + by rewrite inE /= bound_itvE/= ltW. Unshelve. all: by end_near. Qed. HB.instance Definition _ F FF Fc := @@ -670,8 +646,7 @@ HB.instance Definition _ F FF Fc := Fail Check (V : completeType). -Lemma cvg_V_entourageP (F : set_system V) (FF : Filter F) - (f : V) : +Lemma cvg_V_entourageP (F : set_system V) (FF : Filter F) (f : V) : F --> f <-> forall A, entourage A -> \forall g \near F, {in `[a, b], forall t : R, A (f t, (g : V) t)}. Proof. @@ -680,26 +655,20 @@ split => [/cvg_entourageP /= Ff A|/=Ff]. apply: (Ff [set fg : V * V| {in `[a, b], forall t : R, A (fg.1 t, fg.2 t)}]). exists eps => //. rewrite /pseudoMetric_from_normedZmodType.ball /=. - move => /= x bx t tab. - apply H => /=. + move=> /= x bx t tab. + apply: H => /=. rewrite -ball_normE /ball/=. - have -> : (x.1 : V) t - (x.2 : V) t = (x.1 - x.2 :V) t. - rewrite -(reprK x.1) -(reprK x.2) /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. - by rewrite !eval_mod_on_itv. - exact: infty_norm_gt_V. + rewrite -quot_continuousFunType_fctB//. + exact: infty_norm_lt. apply/cvg_entourageP => /= A [e e0 sPA]. have e20 : 0 < e / 2 by rewrite divr_gt0. -have e2 : e / 2 < e by rewrite ltr_pdivrMr// mulrC ltr_pMl //= ltrDr. -near=>g. +have e2 : e / 2 < e by rewrite gtr_pMr// invf_lt1// ltr1n. +near=> g. apply: sPA. -apply/le_lt_trans/e2/infty_norm_le_V => /= t tab. -have -> : (f - g : V) t = f t - (g : V) t. - rewrite -(reprK f) -(reprK g) /GRing.opp /=. - rewrite -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. - by rewrite !eval_mod_on_itv. -rewrite ltW //. -suff: ball (f t) (e / 2) (g t). - by rewrite -ball_normE /ball/=. +apply/le_lt_trans/e2/infty_norm_leP => /= t tab. +rewrite quot_continuousFunType_fctB//. +rewrite ltW//. +suff: ball (f t) (e / 2) (g t) by rewrite -ball_normE. move: t tab. near: g. exact: (Ff [set xy : W * W | ball xy.1 (PosNum e20)%:num xy.2] (entourage_ball _ _)). @@ -709,47 +678,36 @@ Lemma quot_cont_on_segType_cauchy_cvg (F : set_system V) : ProperFilter F -> cauchy F -> cvg F. Proof. move=> FF Fc. -have /(_ _ _)/cauchy_cvg /cvg_app_entourageP cvF : - forall t : R, t \in `[a,b] -> - cauchy (fmap (fun (h : V) => h t) (fun x : set V => nbhs F (fun x0 : V => x x0))). - move=> t tab A /=. +have /(_ _ _)/cauchy_cvg/cvg_app_entourageP cvF : + forall t, t \in `[a, b] -> + cauchy (fmap (fun h : V => h t) (fun A : set V => nbhs F (fun g => A g))). + move=> t tab A/=. rewrite -entourage_ballE => -[e e0 ee]; rewrite near_simpl -near2E near_map2. - apply : Fc. - exists e => //. - move => /= [f g]. - move /infty_norm_gt_V => h. - apply ee => /=. + apply: Fc. + exists e => //= -[f g]. + move/infty_norm_lt => h. + apply: ee => /=. rewrite -ball_normE /ball_/=. - have <- : (f - g : V) t = (f : V) t - (g : V) t. - rewrite -(reprK f) -(reprK g) /GRing.opp /=. - rewrite -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. - by rewrite !eval_mod_on_itv. - exact: h. + by rewrite -quot_continuousFunType_fctB// h. apply/cvg_ex; exists (pi V (@lim_fun F FF Fc : continuousFunType `[a, b] [set: W])). -apply /cvg_V_entourageP => /=. +apply/cvg_V_entourageP => /=. move=> A /= entA. -near=>f. -move => t tab. +near=> f. +move=> t tab. near F => g. apply : (entourage_split (g t)) => //. - by rewrite eval_mod_on_itv => //; first by near:g;apply: cvF. + by rewrite eval_mod_on_itv => //; first by near: g; exact: cvF. move: (t) (tab); near: g; near: f; apply: nearP_dep; apply: Fc. rewrite /nbhs /=. have := entourage_split_ent entA. rewrite -entourage_ballE => -[e e0 ee]. rewrite -entourage_ballE. -exists e => //. -move => [/= x y]. -rewrite /pseudoMetric_from_normedZmodType.ball/=. -move /infty_norm_gt_V => h t tab. -apply ee => /=. +exists e => // -[/= f1 f2]. +move/infty_norm_lt => h t tab. +apply: ee => /=. rewrite -ball_normE /ball_ /=. rewrite distrC. -have -> : (x : V) t - (y : V) t = (x - y :V) t. - rewrite -(reprK y) -(reprK x) /GRing.opp /=. - rewrite -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. - by rewrite !eval_mod_on_itv. -exact: h. +by rewrite -quot_continuousFunType_fctB// h. Unshelve. all: by end_near. Qed. HB.instance Definition _ := Uniform_isComplete.Build V diff --git a/ode_wip.v b/ode_wip.v index 4cf7570d..ad404cb5 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -1,4 +1,3 @@ -(* mathcomp analysis (c) 2025 Inria and AIST. License: CeCILL-C. *) From HB Require Import structures. From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. From mathcomp Require Import archimedean generic_quotient ring_quotient. From 7ac66614824e70735642dfe69aa9982754da64b5 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 14 Feb 2026 11:39:23 +0900 Subject: [PATCH 111/144] rm dup, ContSeg --- ode.v | 290 ++++++++++++++++++++++++-------------------------- ode_contfun.v | 193 +++++++++++++++++---------------- 2 files changed, 244 insertions(+), 239 deletions(-) diff --git a/ode.v b/ode.v index e6a6b7c0..ac710c66 100644 --- a/ode.v +++ b/ode.v @@ -12,6 +12,9 @@ Require Import ode_common ode_contfun. (**md**************************************************************************) (* # Proof of the Cauchy-Lipschitz theorem *) (* *) +(* The main purpose of this file is to formalized the Cauchy-Lipschitz *) +(* theorem (a.k.a. Picard-Lindelof). *) +(* *) (* We consider an ODE defined by a function phi : K -> 'rV[K]_n -> 'rV[K]_n. *) (* The idea of the proof is to define a function *) (* picard := fun t => u0 + \int[mu]_(x in `[a, t]) phi x (g x) *) @@ -611,12 +614,12 @@ Variables (u0 : U) (r : {posnum R}). Hypothesis k0 : 0 < k. Variable rho : {posnum R}. (* rho < 1 *) -Import Cont_on_seg_quot. +Import ContSeg_quot. Local Notation delta_max := (@delta_max R n phi a b k u0 r rho). Local Notation V := - (quot_continuousFunType (@leDl_delta_max _ _ phi a b k ab u0 r k0 rho)). + (quot_contSeg (@leDl_delta_max _ _ phi a b k ab u0 r k0 rho)). Definition img_cball : set V := [set f : V | f @` `[a, a + delta_max] `<=` closed_ball u0 r%:num]. @@ -624,9 +627,9 @@ Definition img_cball : set V := Lemma img_cball_nonempty : img_cball !=set0. Proof. exists (pi V (cst u0)) => _ [y aay] <-. -suff -> : quot_continuousFunType_to_fun (\pi_(V)%qT (cst u0)) y = u0. +suff -> : fun_of_quot_contSeg (\pi_(V)%qT (cst u0)) y = u0. exact: closed_ballxx. -rewrite /quot_continuousFunType_to_fun/=. +rewrite /fun_of_quot_contSeg/=. have /eqmod_on_itv : (repr (\pi_(V)%qT (cst u0)) = cst u0 %[mod V])%qT. by rewrite reprK. by apply; rewrite inE. @@ -715,10 +718,10 @@ Proof. by move => h; rewrite picard_funE// set_itv1 rowRintegral_set1 addr0. Qed. -Import Cont_on_seg_quot. +Import ContSeg_quot. -Local Notation V := (quot_continuousFunType - (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Local Notation V := + (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). Let set_fun_picard_fun (g : V) : set_fun `[a, a + delta_max] [set: U] (picard_fun g). @@ -750,10 +753,10 @@ Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k (@lip2_delta_max R n phi a b k u0 r lip2 rho) (@cont1_delta_max R n phi a b k u0 r cont1 rho)). -Import Cont_on_seg_quot. +Import ContSeg_quot. -Local Notation V := (quot_continuousFunType - (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Local Notation V := + (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). Let continuous_picard_fun (g : V) : {within `[a, a + delta_max], continuous (picard_fun g)}. @@ -796,9 +799,10 @@ Variable rho : {posnum R}. (* rho < 1 *) Local Notation delta_max := (delta_max phi a b k u0 r rho). -Import Cont_on_seg_quot. +Import ContSeg_quot. -Local Notation V := (quot_continuousFunType (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Local Notation V := + (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). Lemma integrable_comp (F : V) y : y \in `[a, a + delta_max]%R -> F @` `[a, y] `<=` B -> @@ -824,6 +828,90 @@ Qed. End integrable_comp. +(* PR to MCA *) +Section Rintegral. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Implicit Types (D : set T). + +Lemma Rintegral_cst D : d.-measurable D -> + forall r, \int[mu]_(_ in D) r = r * fine (mu D). +Proof. +move=> mD r; rewrite /Rintegral/= integral_cst//. +have := leey (mu D); rewrite le_eqVlt => /predU1P[->/=|muy]; last first. + by rewrite fineM// ge0_fin_numE. +rewrite mulr0 mulr_infty/=; have [_|r0|r0] := sgrP r. +- by rewrite mul0e. +- by rewrite mul1e. +- by rewrite mulN1e. +Qed. + +End Rintegral. + +(* PR to MCA *) +Section continuous_patch. +Context {R : realType} {n : nat} {U : normedModType R}. +Variables (a b c : R) (f : R -> U) (g : R->U). +Hypothesis ab : a < b. +Hypothesis bc : b < c. +Hypothesis cont1 : {within `[a, b], continuous f}. +Hypothesis cont2 : {within `[b, c], continuous g}. +Hypothesis matchb : f b = g b. + +Lemma within_continuous_patch : {within `[a, c], continuous (patch g `[a, b] f)}. +Proof. +have -> : `[a, c] = `[a, b] `|` `[b, c]. + rewrite (@itv_bndbnd_setU _ _ _ (BRight b)) // ?bnd_simp//=; [|exact: ltW..]. + apply/seteqP; split => [x []|x []]. + by left. + by right; exact: subset_itv_oc_cc b0. + by left. + rewrite -setU1itv ?bnd_simp//; last exact: ltW. + case; last by right. + move=> ->; left => /=. + by rewrite bound_itvE ltW. +apply: (withinU_continuous (@itv_closed _ _ a b) (@itv_closed _ _ b c)). + have eq1 : {in `[a, b], f =1 patch g `[a, b] f }. + by move=> r rab; rewrite /patch rab. + apply: (continuous_within_ext eq1). + exact: cont1. +have eq2 : {in `[b, c], g =1 patch g `[a, b] f }. + move=> r rab. + rewrite /patch; case: ifPn => [xab | xabnot] => //. + suff -> : r = b by rewrite matchb. + apply: le_anti. + move: rab xab. + by rewrite !inE/=!in_itv/= => /andP [-> _] /andP [_ ->]. +apply/continuous_subspaceW/(continuous_within_ext eq2)/cont2. +by apply: subset_itvl; rewrite bnd_simp. +Qed. + +End continuous_patch. + +(* TODO: PR to MCA *) +Lemma nbhs_ge {R : realFieldType} (t x : R) : + t < x -> \forall x0 \near nbhs x, t <= x0. +Proof. +move=> tx. +exists ((x - t) / 2). + by rewrite /= divr_gt0// subr_gt0. +move=> y/=. +have [xy|yx] := lerP x y. + rewrite ltrBlDl => H. + by rewrite (le_trans (ltW tx)). +rewrite ltrBlDl -ltrBlDr => /ltW; apply: le_trans. +rewrite -lerBlDr opprK. +by rewrite -lerBrDl ler_piMr ?invf_le1 ?ler1n// subr_ge0 ltW. +Qed. + +(* TODO: PR to MC *) +Definition And31 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := + let: And3 p1 p2 p3 := a in p1. +Definition And32 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := + let: And3 p1 p2 p3 := a in p2. +Definition And33 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := + let: And3 p1 p2 p3 := a in p3. + Section picard. Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. @@ -844,11 +932,12 @@ Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k (@lip2_delta_max R n phi a b k u0 r lip2 rho) (@cont1_delta_max R n phi a b k u0 r cont1 rho)). -Import Cont_on_seg_quot. +Import ContSeg_quot. -Local Notation V := (quot_continuousFunType (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Local Notation V := + (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). -Definition picard (x : V) : V := \pi_V%qT (picard_fun x). +Definition picard (f : V) : V := \pi_V%qT (picard_fun f). Local Notation img_cball := (@img_cball R n phi a b k ab u0 r k0 rho). @@ -954,9 +1043,8 @@ rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * `|F x - u0 | + sup_phi)) apply: subset_itvl; rewrite bnd_simp. by rewrite (itvP yaaDelta). exact: closed_ballxx. - apply: (@le_trans _ _ `|phi x u0 |). - rewrite {2}/Num.norm/= mx_normrE /=. - by apply: (le_bigmax _ _ (ord0, i)). + apply: (@le_trans _ _ `|phi x u0 |). + by rewrite {2}/Num.norm/= mx_normrE /= (le_bigmax _ _ (ord0, i)). rewrite /sup_phi ub_le_sup//. have [M [Mb1 Mb2]] : bounded_set [set `|phi t u0| | t in `[a,b]]. apply/compact_bounded/continuous_compact; last exact: segment_compact. @@ -1086,26 +1174,6 @@ End picard. (* have /integrableP[_]/= := intf i. *) (* exact. *) -(* PR: to master *) -Section Rintegral. -Context d {T : measurableType d} {R : realType}. -Variable mu : {measure set T -> \bar R}. -Implicit Types (D : set T). - -Lemma Rintegral_cst D : d.-measurable D -> - forall r, \int[mu]_(_ in D) r = r * fine (mu D). -Proof. -move=> mD r; rewrite /Rintegral/= integral_cst//. -have := leey (mu D); rewrite le_eqVlt => /predU1P[->/=|muy]; last first. - by rewrite fineM// ge0_fin_numE. -rewrite mulr0 mulr_infty/=; have [_|r0|r0] := sgrP r. -- by rewrite mul0e. -- by rewrite mul1e. -- by rewrite mulN1e. -Qed. - -End Rintegral. - Section is_contraction_picard. Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. @@ -1122,9 +1190,9 @@ Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Variable rho : {posnum R}. (* rho < 1 *) Hypothesis rho1 : (rho%:num < 1). -Import Cont_on_seg_quot. +Import ContSeg_quot. -Notation V := (quot_continuousFunType (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Notation V := (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). Notation img_cball := (@img_cball _ n phi a b k ab u0 r k0 rho). Notation delta_max := (delta_max phi a b k u0 r rho). @@ -1426,14 +1494,14 @@ Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous f ^~ y}}. Variable rho : {posnum R}. Hypothesis rho1 : rho%:num < 1. -Import Cont_on_seg_quot. +Import ContSeg_quot. Check U : completeType. Check U : completePseudoMetricType R. Check U : normedModType R. Check U : completeNormedModType R. -Notation V := (@quot_continuousFunType R U _ _ (leDl_delta_max f ab u0 r k0 rho)). +Notation V := (@quot_contSeg R U _ _ (leDl_delta_max f ab u0 r k0 rho)). Check V : completeNormedModType _. @@ -1498,14 +1566,14 @@ apply: (contraction_fixpoint_unique rewrite -(reprK picard_fix'). apply/eqquotP. rewrite /Quotient.equiv/=. -rewrite inE /submod_itv. +rewrite inE. apply/funext => x. -rewrite /patch;case: ifPn => [xK | xKnot] => //. -rewrite /quot_continuousFunType_to_fun /=. +rewrite /patch; case: ifPn => [xK|xKnot]; last by []. +rewrite /fun_of_quot_contSeg/=. rewrite !fctE. rewrite !reprK. rewrite picard_funE//=. -have -> : repr picard_fix' x = picard_fix' x by []. +rewrite (_ : repr picard_fix' x = picard_fix' x)//. by rewrite h// subrr. Qed. @@ -1566,48 +1634,6 @@ Proof. by move=> taad; apply: img_cball_picard_fix => /=; exists t. Qed. End picard. -Section continuous_patch. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables (a b c : R) (f : R -> U) (g : R->U). -Hypothesis ab : a < b. -Hypothesis bc : b < c. -Hypothesis cont1 : {within `[a, b], continuous f}. -Hypothesis cont2 : {within `[b, c], continuous g}. -Hypothesis matchb : f b = g b. - -Lemma within_continuous_patch : {within `[a,c], continuous (patch g `[a, b] f)}. - have -> : `[a, c] = `[a, b] `|` `[b, c]. - rewrite (@itv_bndbnd_setU _ _ _ (BRight b)) // ?bnd_simp//=; last 2 first. - exact: ltW. - exact: ltW. - apply/seteqP; split => x. - move=> []; [by left|right]. - exact: subset_itv_oc_cc b0. - move=> []; [by left|]. - rewrite -setU1itv ?bnd_simp//; last first. - exact: ltW. - case; [|by right]. - move=> ->; left => /=. - by rewrite in_itv/= (ltW ab) lexx. - apply: (withinU_continuous (@itv_closed _ _ a b) (@itv_closed _ _ b c)). - have eq1 : {in `[a, b], f =1 patch g `[a, b] f }. - move => x0 x0ab. - by rewrite /patch x0ab. - apply: (continuous_within_ext eq1). - exact: cont1. - have eq2 : {in `[b, c], g =1 patch g `[a, b] f }. - move => x0 x0ab. - rewrite /patch;case: ifPn => [xab | xabnot] => //. - suff -> : x0 = b by rewrite matchb. - apply: le_anti. - move: x0ab xab. - by rewrite !inE/=!in_itv/= => /andP [-> _] /andP [_ ->]. - apply /continuous_subspaceW/(continuous_within_ext eq2)/cont2. - by apply: subset_itvl; rewrite bnd_simp. -Qed. -End continuous_patch. - Section picard_extension. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -1768,17 +1794,16 @@ Let f := cauchy_lipschitz_local_f. Theorem cauchy_lipschitz_local : delta_max > 0 /\ is_sol_on phi u0 a (BLeft (a + delta_max)) f /\ - {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f t)} /\ - {within `[a, a + delta_max], continuous f}. + {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f t)}. Proof. split; first exact: delta_max_gt0. -split; [| split]. +split. - exact: solution_local_solution. - exact: solution_stays_in_ball. -- exact: solution_continuous. Qed. -Local Notation V := (Cont_on_seg_quot.quot_continuousFunType (@leDl_delta_max _ _ phi a b k ab u0 r k0 rho)). +Local Notation V := + (ContSeg_quot.quot_contSeg (@leDl_delta_max _ _ phi a b k ab u0 r k0 rho)). Theorem cauchy_lipschitz_local_unique f' : {within `[a, a + delta_max], continuous f'} -> @@ -1802,23 +1827,23 @@ have pieq : \pi_V%qT f = \pi_V%qT (cont_on_seg_Sub fc). rewrite reprK. apply: cauchy_lipschitz_unique. move => /= _ [t' tad' ] <- /=. - rewrite /Cont_on_seg_quot.quot_continuousFunType_to_fun. + rewrite /ContSeg_quot.fun_of_quot_contSeg. suff -> : (repr (\pi_V%qT (cont_on_seg_Sub fc))) t' = f' t'. by apply: bnd; rewrite inE. - by apply: Cont_on_seg_quot.eval_mod_on_itv; rewrite inE. + by apply: ContSeg_quot.eval_mod_on_itv; rewrite inE. move=> t0 t0ad. - rewrite Cont_on_seg_quot.eval_mod_on_itv //=. + rewrite ContSeg_quot.eval_mod_on_itv //=. rewrite h1//. rewrite f'au0; congr (u0 + _). apply: eq_rowRintegral => t' tad'. - rewrite Cont_on_seg_quot.eval_mod_on_itv //=. + rewrite ContSeg_quot.eval_mod_on_itv //=. move: tad'; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp. rewrite inE/= in t0ad. by move/itvP : t0ad => ->. -suff -> : f t = (Cont_on_seg_quot.quot_continuousFunType_to_fun (\pi_V%qT (cont_on_seg_Sub fc))) t. - by rewrite /Cont_on_seg_quot.quot_continuousFunType_to_fun/=;apply Cont_on_seg_quot.eval_mod_on_itv. +suff -> : f t = (ContSeg_quot.fun_of_quot_contSeg (\pi_V%qT (cont_on_seg_Sub fc))) t. + by rewrite /ContSeg_quot.fun_of_quot_contSeg/=;apply ContSeg_quot.eval_mod_on_itv. rewrite -pieq. -by rewrite Cont_on_seg_quot.eval_mod_on_itv. +by rewrite ContSeg_quot.eval_mod_on_itv. Qed. End cauchy_lipschitz_local. @@ -1862,14 +1887,6 @@ Qed. End continuous_confined. -(* TODO: move *) -Definition And31 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := - let: And3 p1 p2 p3 := a in p1. -Definition And32 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := - let: And3 p1 p2 p3 := a in p2. -Definition And33 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := - let: And3 p1 p2 p3 := a in p3. - Section solution_locally_unique. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -1883,7 +1900,7 @@ Hypothesis cf : {within `[a, b], continuous f}. Hypothesis sol1 : is_sol_on phi u0 a (BLeft b) f. Let rho_max : {posnum R} := (2^-1)%:pos. -Let dmax rho := delta_max phi a b k u0 r rho. +Let dmax rho := delta_max phi a b k u0 r rho. Let fc := local_solution ab k0 lip2 cont1. Lemma initial_solution_unique f' : {within `[a, b], continuous f'} -> @@ -1965,8 +1982,8 @@ Proof. move=> ab. set c := (a + b) / 2%:R. set d := (b - a) / 2%:R. -rewrite (_:a = c - d); last by rewrite /c/d !mulrDl addrKA mulNr opprK -splitr. -rewrite (_:b = c + d); last by rewrite addrC /c/d !mulrDl mulNr subrKA -splitr. +rewrite (_ : a = c - d); last by rewrite /c/d !mulrDl addrKA mulNr opprK -splitr. +rewrite (_ : b = c + d); last by rewrite addrC /c/d !mulrDl mulNr subrKA -splitr. rewrite -ball_itv -closed_ball_itv ?closure_ballE//. apply: divr_gt0 => //. by rewrite subr_gt0. @@ -1997,11 +2014,10 @@ Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. Theorem cauchy_lipschitz_autonomous a : exists f delta, delta > 0 /\ is_sol_on (phi_) u0 a (BLeft (a + delta)) f /\ - {in `[a, a + delta], forall t, closed_ball u0 r%:num (f t)} /\ - {within `[a, a + delta], continuous f}. + {in `[a, a + delta], forall t, closed_ball u0 r%:num (f t)}. Proof. have aa1 : a < a + 1 by rewrite ltrDl. -have [d0 [solf [cball cf]]] := +have [d0 [solf cball]] := cauchy_lipschitz_local aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho1. exists (@cauchy_lipschitz_local_f R n phi_ a _ k u0 r aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho rho1). @@ -2010,21 +2026,6 @@ Qed. End picard_autonomous. -(* TODO: move *) -Lemma nbhs_ge {R : realFieldType} (t x : R) : t < x -> \forall x0 \near nbhs x, t <= x0. -Proof. -move=> tx. -exists ((x - t) / 2). - by rewrite /= divr_gt0// subr_gt0. -move=> y/=. -have [xy|yx] := lerP x y. - rewrite ltrBlDl => H. - by rewrite (le_trans (ltW tx)). -rewrite ltrBlDl -ltrBlDr => /ltW; apply: le_trans. -rewrite -lerBlDr opprK. -by rewrite -lerBrDl ler_piMr ?invf_le1 ?ler1n// subr_ge0 ltW. -Qed. - Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. @@ -2040,7 +2041,7 @@ Theorem cauchy_lipschitz_ll u0 a : exists f delta r, {in `[a, a + delta], forall t, closed_ball u0 r (f t)}. Proof. have [/= r [k lip]] := phi_locally_lipschitz u0. -have [//|f [delta [delta_ft0 [solf [cball cf]]]]] := cauchy_lipschitz_autonomous _ lip a. +have [//|f [delta [delta_ft0 [solf cball]]]] := cauchy_lipschitz_autonomous _ lip a. by exists f, delta, r%:num. Qed. @@ -2128,9 +2129,9 @@ have Eclosed : closed E. have [xab|xnab] := boolP (x \in `[a, b]%R); last first. suff : \forall y \near x, ~ (y \in `[a,b]%R). move=> h. - near=>y. + near=> y. rewrite not_andP;left. - near:y. + near: y. exact: h. move: xnab; rewrite in_itv/= negb_and/= -!ltNge => /orP[xa|xb]. near=> y. @@ -2223,28 +2224,21 @@ have supeq : f' (sup E) = f (sup E). by rewrite inE/= in_itv/= lexx sup_itv. have [h|h] := leP b (sup E). apply: (mon _ supE) => //. - by apply/andP; rewrite ltW. -have [| Delta Hdelta] := locally_unique_extends _ supeq; first by apply/andP. + by rewrite (ltW ab). +have [|Delta Hdelta] := locally_unique_extends _ supeq; first by apply/andP. have Delta0 : 0 < Delta%:num by []. suff : Num.min b (sup E + Delta%:num) <= sup E. rewrite ge_min => /orP[bE|]. - suff : b < b by rewrite ltxx. - exact: (le_lt_trans bE h). - rewrite gerDl. - rewrite ltNge in Delta0. - by have /negP := Delta0. -apply sup_upper_bound => //. + by have := lt_le_trans h bE; rewrite ltxx. + by rewrite gerDl leNgt Delta0. +apply: sup_upper_bound => //. split. - rewrite in_itv/=. - apply/andP; split. - rewrite le_min; apply/andP; split; first by apply ltW. - by rewrite (le_trans sup_itv)// lerDl. - by rewrite ge_min lexx. -move => t. + by rewrite in_itv/= le_min (ltW ab)/= ler_wpDr//= ge_min lexx. +move=> t. rewrite inE/= in_itv/= => -/andP[t1 t2]. -have [ht| ht] := leP t (sup E). +have [ht|ht] := leP t (sup E). by apply supE; rewrite inE/= in_itv/= t1 ht. -by apply Hdelta; rewrite inE/= in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. +by apply: Hdelta; rewrite inE/= in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. Unshelve. all: by end_near. Qed. End uniqueness. diff --git a/ode_contfun.v b/ode_contfun.v index bbea222b..183ee93d 100644 --- a/ode_contfun.v +++ b/ode_contfun.v @@ -1,6 +1,6 @@ From HB Require Import structures. -From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. -From mathcomp Require Import generic_quotient ring_quotient. +From mathcomp Require Import all_boot all_order ssralg ssrnum matrix interval. +From mathcomp Require Import poly generic_quotient ring_quotient. From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. From mathcomp Require Import constructive_ereal. From mathcomp Require Import functions reals interval_inference topology. @@ -10,8 +10,17 @@ From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. Require Import ode_common. (**md**************************************************************************) -(* # ODE *) +(* # Continuous functions over a closed interval *) +(* *) +(* The main purpose of this file is to define the quotient of continuous *) +(* function over a closed interval. It is shown to form a complete normed *) +(* type. *) +(* *) +(* ``` *) (* infty_norm f := infty_norm0 (repr f) *) +(* quot_contSeg := quotient of continuous functions over a closed interval *) +(* ``` *) +(* *) (******************************************************************************) Set Implicit Arguments. @@ -22,13 +31,14 @@ Import numFieldNormedType.Exports. Open Scope ring_scope. Open Scope classical_set_scope. -Locate continuousEP. -Module Cont_on_seg_zlmodtype. -Section cont_on_seg_zlmodtype. + +Module ContSeg_zlmodType. +Section contSeg_zlmodtype. Context {R : realType} {V : normedModType R} (a b : R). HB.instance Definition _ := GRing.isZmodClosed.Build _ _ (@cont_on_seg_zmod_closed R V a b). + Fail Check continuousFunType `[a, b] [set: V] : zmodType. HB.instance Definition _ := @@ -46,72 +56,29 @@ HB.instance Definition _ := Check continuousFunType `[a, b] [set: V] : lmodType _. -End cont_on_seg_zlmodtype. -End Cont_on_seg_zlmodtype. - -Section contFun_seminorm. -Context {R : realType} {W : normedModType R}. -Variables a b : R. -Hypothesis ab : a <= b. -Let K := `[a, b]. -Local Notation T := (continuousFunType K [set: W]). - -Import Cont_on_seg_zlmodtype. - -(* NB: require Nmodule properties *) -Lemma infty_norm0_eq0 : infty_norm0 (0 : T) = 0. -Proof. -rewrite /infty_norm0 -(sup1 0); congr sup. -apply eq_set => /= z ;apply propext; split => [[x _ <- ] | ->]; rewrite ?normr0 => //. -have [c Kc] := seg_nonempty ab. -by exists c; [ | rewrite normr0 ]. -Qed. - -(* NB: require Nmodule properties *) -Lemma infty_norm0rMn (x : T) n : infty_norm0 (x *+ n) = infty_norm0 x *+ n. -Proof. -rewrite /infty_norm0 -sup_Mn; last exact: normr_has_sup. -rewrite image_comp/=; congr (sup _). -apply eq_imagel => z Kz /=. -rewrite -normrMn /=. -have /(congr1 (fun a => a z)) <- := natmulfctE x n. -congr (normr (_ z)). -(* This is strange *) -elim: n x => //= n IH x. -by rewrite !mulrS -IH. -Qed. - -Lemma infty_norm0N (x : T) : infty_norm0 (- x) = infty_norm0 x. -Proof. -rewrite /infty_norm0; congr sup. -apply: eq_set => /= x0. -apply propext; split => [[x1 in_itv] | [x1 in_itv]] H; exists x1 =>//. -by rewrite -normrN. -by rewrite normrN. -Qed. - -End contFun_seminorm. +End contSeg_zlmodtype. +End ContSeg_zlmodType. -(* point V does not need to be 0, so rewrite f\_K explicitly *) -Section submod_itv. +Section submod_contSeg. Context {R : realType} {V : normedModType R} (a b : R). Local Notation T := (continuousFunType `[a, b] [set: V]). -Definition submod_itv (ab : a <= b) : {pred T} := +(* NB: point does not need to be 0, so rewrite f \_ K explicitly *) +Definition patch_contSeg0 (ab : a <= b) : {pred T} := [pred f : T | patch 0 `[a, b] f == 0]. -End submod_itv. -Arguments submod_itv {R} V {a b} ab. +End submod_contSeg. +Arguments patch_contSeg0 {R} V {a b} ab. -Module Cont_on_seg_quot. -Export Cont_on_seg_zlmodtype. +Module ContSeg_submod. +Export ContSeg_zlmodType. Section submod_definition. Context {R : realType} {V : normedModType R}. Variables a b : R. Hypothesis ab : a <= b. -Lemma submod_closed_itv : submod_closed (submod_itv V ab). +Lemma submod_closed_contSeg : submod_closed (patch_contSeg0 V ab). Proof. split => /=. - rewrite inE/=; apply/funext => x. @@ -126,18 +93,65 @@ split => /=. by rewrite -[LHS]/(f *: u u1 + v u1) uu1 vu1 addr0 scaler0. Qed. -Fail Check (submod_itv V ab) : zmodClosed _. +Fail Check (patch_contSeg0 V ab) : zmodClosed _. HB.instance Definition _ := - GRing.isZmodClosed.Build _ _ (GRing.submod_closedB submod_closed_itv). + GRing.isZmodClosed.Build _ _ (GRing.submod_closedB submod_closed_contSeg). -Check (submod_itv V ab) : zmodClosed _. +Check (patch_contSeg0 V ab) : zmodClosed _. End submod_definition. +End ContSeg_submod. + +Section contSeg_seminorm. +Context {R : realType} {W : normedModType R}. +Variables a b : R. +Hypothesis ab : a <= b. +Let K := `[a, b]. +Local Notation T := (continuousFunType K [set: W]). + +Import ContSeg_zlmodType. + +(* NB: require Nmodule properties *) +Lemma infty_norm0_eq0 : infty_norm0 (0 : T) = 0. +Proof. +rewrite /infty_norm0 -(sup1 0); congr sup. +apply: eq_set => /= z. +apply propext; split => [[x _ <- ] | ->]; rewrite ?normr0 => //. +have [c Kc] := seg_nonempty ab. +by exists c => //; rewrite normr0. +Qed. + +(* NB: require Nmodule properties *) +Lemma infty_norm0rMn (f : T) n : infty_norm0 (f *+ n) = infty_norm0 f *+ n. +Proof. +rewrite /infty_norm0 -sup_Mn; last exact: normr_has_sup. +rewrite image_comp/=; congr (sup _). +apply: eq_imagel => z Kz /=; rewrite -normrMn /=. +have /(congr1 (@^~ z)) <- := natmulfctE f n. +congr (normr (_ z)). +(* NB: investigate *) +elim: n f => //= n IH f. +by rewrite !mulrS -IH. +Qed. + +Lemma infty_norm0N (f : T) : infty_norm0 (- f) = infty_norm0 f. +Proof. +rewrite /infty_norm0; congr sup; apply: eq_set => /= x0. +apply: propext; split => [[x1 in_itv] | [x1 in_itv]] H; exists x1 => //. + by rewrite -normrN. +by rewrite normrN. +Qed. + +End contSeg_seminorm. + +Module ContSeg_quot. +Export ContSeg_zlmodType. +Import ContSeg_submod. Import Quotient. -Section cont_on_seg_quotient. +Section contSeg_quotient. Context {R : realType} {W : normedModType R} (a b : R). Hypothesis ab : a <= b. @@ -160,16 +174,14 @@ Canonical eq_seg_canonical := Local Open Scope quotient_scope. -Definition quot_continuousFunType := {quot (@submod_itv _ W _ _ ab)}. -Local Notation T := quot_continuousFunType. +Definition quot_contSeg := {quot (@patch_contSeg0 _ W _ _ ab)}. +Local Notation T := quot_contSeg. (* NB: ZmodQuotient is defined in ring_quotient.v *) HB.instance Definition _ := ZmodQuotient.on T. -Definition quot_continuousFunType_to_fun (f : T) : - (* NB: was R -> R before 2025-12-26 *) - subspace `[a, b] -> W := repr f. -Coercion quot_continuousFunType_to_fun : T >-> Funclass. +Definition fun_of_quot_contSeg (f : T) : subspace `[a, b] -> W := repr f. +Coercion fun_of_quot_contSeg : T >-> Funclass. Lemma eq_segP (f g : T) : reflect ({in `[a, b], f =1 g}) (f == g %[mod T]). Proof. @@ -200,7 +212,7 @@ apply: (@eqmod_on_itv (repr (\pi_T f)) f) => //. by rewrite reprK. Qed. -Lemma quot_continuousFunType_fctB (f g : T) t : t \in `[a, b] -> +Lemma quot_contSeg_fctB (f g : T) t : t \in `[a, b] -> (f - g : T) t = (f : T) t - (g : T) t. Proof. move=> tab. @@ -212,8 +224,8 @@ rewrite -Quotient.pi_add. by rewrite !eval_mod_on_itv. Qed. -End cont_on_seg_quotient. -End Cont_on_seg_quot. +End contSeg_quotient. +End ContSeg_quot. Section zmodule_normed. Context {R : realType} {W : normedModType R}. @@ -221,9 +233,9 @@ Variables a b : R. Hypothesis ab : a <= b. Let K := `[a, b]. -Import Cont_on_seg_quot. +Import ContSeg_quot. -Local Notation V := (@quot_continuousFunType R W a b ab). +Local Notation V := (@quot_contSeg R W a b ab). Definition infty_norm (f : V) := infty_norm0 (repr f). @@ -244,17 +256,17 @@ apply: sup_le. by exists s. reflexivity. suff -> : repr (x + y) s = repr x s + repr y s by exact: ler_normD. - suff : (repr (x+y) = repr x + repr y %[mod V]). + suff : repr (x + y) = repr x + repr y %[mod V]. move=> /eqmod_on_itv ->. by []. by rewrite inE. by rewrite Quotient.pi_add !reprK. - exact: (normr_has_sup _ _).1. - split. - + exists ((normr \o repr x) a + (normr \o repr y) a)=> /=. - exists ((normr \o repr x) a) => //; [exists a => //; rewrite in_itv/= lexx ab // | ]. - by exists ((normr \o repr y) a) => //; exists a => //; rewrite bound_itvE. - + exists (sup [set (normr \o repr x) x0 | x0 in K] + sup [set (normr \o repr y) x0 | x0 in K]). + + exists (`|x a| + `|repr y a|)=> /=. + exists (`|repr x a|) => //; [exists a => //; by rewrite in_itv/= lexx ab|]. + by exists `|repr y a| => //; exists a => //; rewrite bound_itvE. + + exists (sup [set `|repr x r| | r in K] + sup [set `|repr y r| | r in K]). apply ubP => _ [x0 xs] [y0 ys] <-. rewrite lerD// ub_le_sup//. exact: (normr_has_sup x _).2. @@ -347,9 +359,9 @@ End zmodule_normed. Section quot_continuousFunType_normedtype. Context {R : realType} {W : normedModType R} {r s : R} (rs : r <= s). -Import Cont_on_seg_quot. +Import ContSeg_quot. -Local Notation V := (@quot_continuousFunType R W r s rs). +Local Notation V := (@quot_contSeg R W r s rs). Fail Check (pseudoMetric_normed V) : normedModType R. HB.instance Definition _ := PseudoMetric.copy V (pseudoMetric_normed V). @@ -479,9 +491,9 @@ Context {R : realType} {W : completeNormedModType R}. Variables a b : R. Hypothesis ab : a <= b. -Import Cont_on_seg_quot. +Import ContSeg_quot. -Notation V := (@quot_continuousFunType R W _ _ ab). +Notation V := (@quot_contSeg R W _ _ ab). Check (V : pseudoMetricType R). Check (V : normedModType R). @@ -511,7 +523,7 @@ have /(_ _ _) /cauchy_cvg /cvg_app_entourageP cvF : exists e => // -[f g]/= /infty_norm_lt => h. apply: eA => /=. rewrite -ball_normE /ball/=. - rewrite -quot_continuousFunType_fctB//. + rewrite -quot_contSeg_fctB//. exact: h. have cvg_pt (t : R) : t \in `[a,b] -> x @[x --> fmap (fun h : V => h t) F] --> lim_fun FF Fc t. @@ -541,7 +553,7 @@ have : ball f (e /2 ) g. by apply: (H (f, g)); split => //=; [near: f|near: g]. rewrite /ball /= /pseudoMetric_from_normedZmodType.ball /=. rewrite distrC. -rewrite -quot_continuousFunType_fctB//. +rewrite -quot_contSeg_fctB//. by move/ltW/infty_norm_leP; exact. Unshelve. all: by end_near. Qed. @@ -658,7 +670,7 @@ split => [/cvg_entourageP /= Ff A|/=Ff]. move=> /= x bx t tab. apply: H => /=. rewrite -ball_normE /ball/=. - rewrite -quot_continuousFunType_fctB//. + rewrite -quot_contSeg_fctB//. exact: infty_norm_lt. apply/cvg_entourageP => /= A [e e0 sPA]. have e20 : 0 < e / 2 by rewrite divr_gt0. @@ -666,8 +678,7 @@ have e2 : e / 2 < e by rewrite gtr_pMr// invf_lt1// ltr1n. near=> g. apply: sPA. apply/le_lt_trans/e2/infty_norm_leP => /= t tab. -rewrite quot_continuousFunType_fctB//. -rewrite ltW//. +rewrite quot_contSeg_fctB// ltW//. suff: ball (f t) (e / 2) (g t) by rewrite -ball_normE. move: t tab. near: g. @@ -688,14 +699,14 @@ have /(_ _ _)/cauchy_cvg/cvg_app_entourageP cvF : move/infty_norm_lt => h. apply: ee => /=. rewrite -ball_normE /ball_/=. - by rewrite -quot_continuousFunType_fctB// h. + by rewrite -quot_contSeg_fctB// h. apply/cvg_ex; exists (pi V (@lim_fun F FF Fc : continuousFunType `[a, b] [set: W])). apply/cvg_V_entourageP => /=. move=> A /= entA. near=> f. move=> t tab. near F => g. -apply : (entourage_split (g t)) => //. +apply: (entourage_split (g t)) => //. by rewrite eval_mod_on_itv => //; first by near: g; exact: cvF. move: (t) (tab); near: g; near: f; apply: nearP_dep; apply: Fc. rewrite /nbhs /=. @@ -707,7 +718,7 @@ move/infty_norm_lt => h t tab. apply: ee => /=. rewrite -ball_normE /ball_ /=. rewrite distrC. -by rewrite -quot_continuousFunType_fctB// h. +by rewrite -quot_contSeg_fctB// h. Unshelve. all: by end_near. Qed. HB.instance Definition _ := Uniform_isComplete.Build V From 86648497d6e77f8204b019e39b5af36763fcc9ff Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 14 Feb 2026 16:17:56 +0900 Subject: [PATCH 112/144] rm ab from quot_contSeg --- ode.v | 208 +++++++++++++++++++++++-------------------- ode_common.v | 241 +++++++++++++++++++++++++++++++------------------- ode_contfun.v | 147 +++++++++++++++++++----------- ode_wip.v | 3 +- 4 files changed, 362 insertions(+), 237 deletions(-) diff --git a/ode.v b/ode.v index ac710c66..fe07163a 100644 --- a/ode.v +++ b/ode.v @@ -1,6 +1,6 @@ From HB Require Import structures. -From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. -From mathcomp Require Import archimedean generic_quotient ring_quotient. +From mathcomp Require Import all_boot all_order ssralg ssrnum matrix interval. +From mathcomp Require Import poly archimedean generic_quotient ring_quotient. From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. From mathcomp Require Import constructive_ereal. From mathcomp Require Import functions reals interval_inference topology. @@ -107,7 +107,7 @@ Unshelve. all: by end_near. Qed. End pointwise_derivable. -(* NB: PR to MathComp-Analysis in progress *) +(* NB: PR to MCA *) Section pointwise_derive. Local Open Scope classical_set_scope. Context {R : realFieldType} {V W : normedModType R} . @@ -375,7 +375,7 @@ Let U := 'rV[R]_n. Variables (phi : R -> U -> U) (a b : R) (k : R). Variables (u0 : U) (r : {posnum R}). Let B := closed_ball u0 r%:num. -Hypothesis k0 : 0 < k. +Hypothesis k0 : 0 <= k. Lemma lipschitz_componentE x : k.-lipschitz_B (phi x) <-> forall i, k.-lipschitz_B (fun y => phi x y ord0 i). @@ -456,12 +456,11 @@ Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. Let U := 'rV[R]_n. Variables (phi : R -> U -> U) (a b : R). -Hypothesis ab : a <= b. Variables (u0 : U) (r : {posnum R}). Let B : set U := closed_ball u0 r%:num. Variable k : R. -Hypothesis k0 : k > 0. +Hypothesis k0 : k != 0. Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Variable g : R -> U. @@ -471,6 +470,13 @@ Hypothesis gabB : g @` `[a, b] `<=` B. Lemma within_continuous_picard_fun_subdef : {within `[a, b], continuous (picard_fun_subdef phi gabB)}. Proof. +have [ab|] := ltP a b; last first. + rewrite le_eqVlt => /predU1P[ab|ab]. + rewrite [X in {within X, continuous _}](_ : _ = [set a]); last first. + by rewrite ab set_itv1. + exact: continuous_subspace1. + rewrite set_itv_ge// ?bnd_simp -?ltNge//. + exact: continuous_subspace0. apply/within_continuous_coord => i. rewrite /picard_fun_subdef. suff: {within `[a, b], @@ -481,11 +487,12 @@ suff: {within `[a, b], by apply: cvgD; [exact: cvg_cst|exact: abf]. by apply/funext=> r0; rewrite mxE rowRintegralE. move=> /= x. -apply: parameterized_integral_continuous => //. +apply: parameterized_integral_continuous. + exact: ltW. apply: continuous_compact_integrable; first exact: segment_compact. move=> {x}. move: i; apply/within_continuous_coord. -exact: (within_continuous_lipschitz cg k0 lip2 cont1). +exact: (within_continuous_lipschitz cg _ lip2 cont1). Qed. HB.instance Definition _ := isContinuous.Build (subspace `[a, b]) U @@ -506,7 +513,7 @@ Variables (u0 : U) (r : {posnum R}). Let B := closed_ball u0 r%:num. Definition picard_fun - (k : R) (lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}) + (k : R) (k0 : k != 0) (lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}) (cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}) (g : R -> U) : R -> U := match pselect (g @` `[a, b] `<=` B) with @@ -529,7 +536,7 @@ Proof. by rewrite /sup_phi sup_ge0//= => x [y _ <-]. Qed. End sup_phi. -(* PR 1802 om porgress *) +(* PR to MCA *) Lemma EVT_max_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : A !=set0 -> compact A -> {within A, continuous f} -> exists2 c, c \in A & forall t, t \in A -> f t <= f c. @@ -609,7 +616,6 @@ Section image_in_closed_ball. Context {R : realType} {n : nat}. Let U := 'rV[R]_n. Variables (phi : R -> U -> U) (a b : R) (k : R). -Hypothesis ab : a < b. Variables (u0 : U) (r : {posnum R}). Hypothesis k0 : 0 < k. Variable rho : {posnum R}. (* rho < 1 *) @@ -618,8 +624,7 @@ Import ContSeg_quot. Local Notation delta_max := (@delta_max R n phi a b k u0 r rho). -Local Notation V := - (quot_contSeg (@leDl_delta_max _ _ phi a b k ab u0 r k0 rho)). +Local Notation V := (@quot_contSeg R a (a + delta_max) U). Definition img_cball : set V := [set f : V | f @` `[a, a + delta_max] `<=` closed_ball u0 r%:num]. @@ -635,15 +640,16 @@ have /eqmod_on_itv : (repr (\pi_(V)%qT (cst u0)) = cst u0 %[mod V])%qT. by apply; rewrite inE. Qed. -Lemma img_cballE : img_cball = +Lemma img_cballE (ab : a < b) : img_cball = @closed_ball R V (pi V (@cst (subspace `[a, a + delta_max]) U u0)) r%:num. Proof. -rewrite closed_ballE// /img_cball. -apply eq_set => /= f'; apply propext; split => h. +rewrite closed_ballE//. +rewrite /img_cball. +apply: eq_set => /= f'; apply propext; split => h. - rewrite -(@reprK _ V f'). rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. rewrite infty_norm_pi infty_norm0_le //=. - exact: leDl_delta_max. + by rewrite /= lerDl ltW// delta_max_gt0. move=> x adx. move /(_ (f' x)) : h. rewrite closed_ballE//. @@ -661,12 +667,12 @@ apply eq_set => /= f'; apply propext; split => h. rewrite eval_mod_on_itv; last by rewrite inE. rewrite -inE in xad. apply: (le_trans (infty_norm0_ge (leDl_delta_max phi ab u0 r k0 rho) _ xad)). - rewrite -(infty_norm_pi (leDl_delta_max phi ab u0 r k0 rho)). + rewrite -infty_norm_pi. by rewrite Quotient.pi_add Quotient.pi_opp reprK. Qed. -Lemma closed_img_cball : closed img_cball. -Proof. by rewrite img_cballE; exact: closed_ball_closed. Qed. +Lemma closed_img_cball (ab : a < b) : closed img_cball. +Proof. by rewrite img_cballE//; exact: closed_ball_closed. Qed. End image_in_closed_ball. @@ -675,10 +681,9 @@ Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. Let U := 'rV[R]_n. Variables (phi : R -> U -> U) (a b : R) (k : R). -Hypothesis ab : a < b. Variables (u0 : U) (r : {posnum R}). Let B := closed_ball u0 r%:num. -Hypothesis k0 : 0 < k. +Hypothesis k0 : k != 0. Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. @@ -706,7 +711,7 @@ by rewrite bnd_simp -lerBrDl; exact: delta_max_itv. Qed. Local Notation picard_fun := - (@picard_fun _ n phi a (a + delta_max) u0 r k lip2_delta_max cont1_delta_max). + (@picard_fun _ n phi a (a + delta_max) u0 r k k0 lip2_delta_max cont1_delta_max). Lemma picard_funE g t : g @` `[a, a + delta_max] `<=` B -> picard_fun g t = u0 + \vint[mu]_(x in `[a, t]) phi x (g x). @@ -720,8 +725,7 @@ Qed. Import ContSeg_quot. -Local Notation V := - (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Local Notation V := (@quot_contSeg R a (a + delta_max) U). Let set_fun_picard_fun (g : V) : set_fun `[a, a + delta_max] [set: U] (picard_fun g). @@ -738,10 +742,9 @@ Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. Let U := 'rV[R]_n. Variables (phi : R -> U -> U) (a b : R) (k : R). -Hypothesis ab : a < b. Variables (u0 : U) (r : {posnum R}). Let B := closed_ball u0 r%:num. -Hypothesis k0 : 0 < k. +Hypothesis k0 : k != 0. Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. @@ -749,23 +752,29 @@ Variable rho : {posnum R}. (* rho < 1 *) Local Notation delta_max := (delta_max phi a b k u0 r rho). -Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k +Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k k0 (@lip2_delta_max R n phi a b k u0 r lip2 rho) (@cont1_delta_max R n phi a b k u0 r cont1 rho)). Import ContSeg_quot. -Local Notation V := - (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Local Notation V := (@quot_contSeg R a (a + delta_max) U). Let continuous_picard_fun (g : V) : {within `[a, a + delta_max], continuous (picard_fun g)}. Proof. +have [aaD|] := ltP a (a + delta_max); last first. + rewrite le_eqVlt => /predU1P[aaD|aaD]. + rewrite [X in {within X, continuous _}](_ : _ = [set a]); last first. + by rewrite aaD set_itv1. + exact: continuous_subspace1. + rewrite set_itv_ge// ?bnd_simp -?ltNge//. + exact: continuous_subspace0. have := @cts_fun _ _ g. rewrite /picard_fun; case: pselect => /=. move => z cg. - apply: (@cts_fun (subspace `[a, a + delta_max])). - + exact: leDl_delta_max. + have := (@cts_fun (subspace `[a, a + delta_max]) U (picard_fun_subdef phi z)). + apply. + exact: k0. + exact : lip2_delta_max. + exact : cont1_delta_max. @@ -779,7 +788,7 @@ HB.instance Definition _ (g : V) := @isContinuous.Build _ _ Check fun g : V => picard_fun g : continuousFunType _ _. -Check fun g : V => (\pi_(V)%qT (picard_fun g )) : V. +Check fun g : V => (\pi_(V)%qT (picard_fun g)) : V. End picard_fun_isContinuous. @@ -788,10 +797,9 @@ Context {R : realType} {n : nat}. Let U := 'rV[R]_n. Local Notation mu := lebesgue_measure. Variables (phi : R -> U -> U) (a b : R) (k : R). -Hypothesis ab : a < b. Variables (u0 : U) (r : {posnum R}). Let B := closed_ball u0 r%:num. -Hypothesis k0 : 0 < k. +Hypothesis k0 : k != 0. Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. @@ -801,8 +809,7 @@ Local Notation delta_max := (delta_max phi a b k u0 r rho). Import ContSeg_quot. -Local Notation V := - (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Local Notation V := (@quot_contSeg R a (a + delta_max) U). Lemma integrable_comp (F : V) y : y \in `[a, a + delta_max]%R -> F @` `[a, y] `<=` B -> @@ -851,7 +858,7 @@ End Rintegral. (* PR to MCA *) Section continuous_patch. Context {R : realType} {n : nat} {U : normedModType R}. -Variables (a b c : R) (f : R -> U) (g : R->U). +Variables (a b c : R) (f : R -> U) (g : R -> U). Hypothesis ab : a < b. Hypothesis bc : b < c. Hypothesis cont1 : {within `[a, b], continuous f}. @@ -917,10 +924,11 @@ Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. Let U := 'rV[R]_n. Variables (phi : R -> U -> U) (a b : R) (k : R). -Hypothesis ab : a < b. Variables (u0 : U) (r : {posnum R}). Let B := closed_ball u0 r%:num. Hypothesis k0 : 0 < k. +Let k0' : k != 0. Proof. by rewrite gt_eqF. Qed. + Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. @@ -928,18 +936,17 @@ Variable rho : {posnum R}. (* rho < 1 *) Local Notation delta_max := (delta_max phi a b k u0 r rho). -Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k +Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k k0' (@lip2_delta_max R n phi a b k u0 r lip2 rho) (@cont1_delta_max R n phi a b k u0 r cont1 rho)). Import ContSeg_quot. -Local Notation V := - (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). +Local Notation V := (@quot_contSeg R a (a + delta_max) U). Definition picard (f : V) : V := \pi_V%qT (picard_fun f). -Local Notation img_cball := (@img_cball R n phi a b k ab u0 r k0 rho). +Local Notation img_cball := (@img_cball R n phi a b k u0 r rho). Local Notation sup_phi := (@sup_phi R n phi a b u0). @@ -1000,7 +1007,7 @@ rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) - exact: integrable_norm. - move=> x xay. by rewrite (le_trans _ (ler_normD _ _))// subrK. -rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * `|F x - u0 | + sup_phi)))//. +rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * `|F x - u0| + sup_phi)))//. apply: le_Rintegral => //=. under [x in integrable _ _ x]eq_fun do rewrite EFinD. rewrite integrableD //=. @@ -1033,7 +1040,7 @@ rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * `|F x - u0 | + sup_phi)) apply: subset_itvl; rewrite bnd_simp. by rewrite (itvP yaaDelta). move/(lip2_delta_max lip2) : xaaDelta. - rewrite lipschitz_componentE//. + rewrite lipschitz_componentE//; last exact: ltW. move/(_ i (F x, u0)) => /=. apply. split => /=. @@ -1043,11 +1050,18 @@ rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * `|F x - u0 | + sup_phi)) apply: subset_itvl; rewrite bnd_simp. by rewrite (itvP yaaDelta). exact: closed_ballxx. - apply: (@le_trans _ _ `|phi x u0 |). - by rewrite {2}/Num.norm/= mx_normrE /= (le_bigmax _ _ (ord0, i)). + apply: (@le_trans _ _ `|phi x u0|) => //. + by rewrite /Num.norm/= mx_normrE /= (le_bigmax _ _ (ord0, i)). rewrite /sup_phi ub_le_sup//. have [M [Mb1 Mb2]] : bounded_set [set `|phi t u0| | t in `[a,b]]. apply/compact_bounded/continuous_compact; last exact: segment_compact. + have [ab|] := ltP a b; last first. + rewrite le_eqVlt => /predU1P[ab|ab]. + rewrite [X in {within X, continuous _}](_ : _ = [set a]); last first. + by rewrite ab set_itv1. + exact: continuous_subspace1. + rewrite set_itv_ge// ?bnd_simp -?ltNge//. + exact: continuous_subspace0. apply: within_continuous_comp_norm. by rewrite ltW. by apply cont1;rewrite inE; exact: closed_ballxx. @@ -1125,7 +1139,7 @@ HB.instance Definition _ := @isFun.Build _ _ _ _ picard set_fun_picard. Check picard : {fun img_cball >-> img_cball}. (* still, we can't state that it is a contraction for typing reasons *) -Fail Lemma tmp : is_contraction (picard : {fun [set: W] >-> [set: W]}). +Fail Lemma tmp : is_contraction (picard : {fun [set: _] >-> [set: _]}). About is_contraction. End picard. @@ -1192,9 +1206,10 @@ Hypothesis rho1 : (rho%:num < 1). Import ContSeg_quot. -Notation V := (quot_contSeg (@leDl_delta_max R n phi a b k ab u0 r k0 rho)). -Notation img_cball := (@img_cball _ n phi a b k ab u0 r k0 rho). -Notation delta_max := (delta_max phi a b k u0 r rho). +Local Notation delta_max := (delta_max phi a b k u0 r rho). + +Notation V := (@quot_contSeg R a (a + delta_max) U). +Notation img_cball := (@img_cball _ n phi a b k u0 r rho). Check @cst (subspace `[a, a + delta_max]) U u0 : {fun `[a, a + delta_max] >-> [set: U]}. @@ -1202,7 +1217,7 @@ Check @cst (subspace `[a, a + delta_max]) U u0 Check @cst (subspace `[a, a + delta_max]) U u0 : continuousType (subspace `[a, a + delta_max]) U. -Local Notation picard := (@picard R n phi a b k ab u0 r k0 lip2 cont1 rho). +Local Notation picard := (@picard R n phi a b k u0 r k0 lip2 cont1 rho). Lemma is_contraction_picard : is_contraction picard. Proof. @@ -1234,11 +1249,14 @@ rewrite {i}(ord1 i)/=. rewrite mxE rowRintegralE mxE rowRintegralE. have integrable1 : mu.-integrable `[a, t] (EFin \o (fun x0 => phi x0 (x x0) ord0 j)). apply: integrable_comp => //=. + by rewrite gt_eqF. apply: subset_trans Hg; apply: image_subset. apply/subset_itvl; rewrite bnd_simp. by move: tNdd; rewrite !in_itv/= => /andP[]. have integrable2 : mu.-integrable `[a, t] (EFin \o (fun x0 => phi x0 (y x0) ord0 j)). - apply: integrable_comp => //= => _ [x0 h] <-. + apply: integrable_comp => //=. + by rewrite gt_eqF. + move=> _ [x0 h] <-. apply: Hg2 => /=. exists x0 => //. apply/subset_itvl/h; rewrite bnd_simp. @@ -1309,7 +1327,7 @@ rewrite (@le_trans _ _ (k * \int[mu]_(t0 in `[a, t]) `|x - y| ))//. apply: subset_itvl x0at; rewrite bnd_simp. by move: tNdd; rewrite in_itv/= => /andP[]. have -> : x x0 - y x0 = (x - y : V) x0. - apply (@eqmod_on_itv _ _ _ _ (leDl_delta_max phi ab u0 r k0 rho) (repr x - repr y)) => //. + apply (@eqmod_on_itv _ _ _ _ (repr x - repr y)) => //. by rewrite Quotient.pi_add Quotient.pi_opp !reprK. by rewrite infty_norm0_ge// leDl_delta_max. rewrite (@le_trans _ _ (k * `|x - y| * (t - a)))//. @@ -1366,7 +1384,7 @@ Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. Variables (phi : R -> U -> U) (u0 : U) (a b : R) (sol : R -> U) (k : R) (r : {posnum R}). -Hypothesis k0 : 0 < k. +Hypothesis k0 : k != 0. Hypothesis ab : a < b. Let B := closed_ball u0 r%:num. @@ -1380,7 +1398,7 @@ Lemma picard_iterator_within_continuous i : Proof. move: i. apply/within_continuous_coord. -exact: (within_continuous_lipschitz _ k0 _ (u0 := u0) (r := r)). +exact: (@within_continuous_lipschitz _ _ _ a b u0 r _ _ _ k0). Qed. Lemma picard_iterator_continuous i t : t \in `]a, b[ -> @@ -1485,12 +1503,13 @@ Section picard. Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. Notation U := (@row_vector R n). -Variables (f : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}). +Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}). Hypothesis ab : a < b. Hypothesis k0 : 0 < k. +Let k0' : k != 0. Proof. by rewrite gt_eqF. Qed. Let B := closed_ball u0 r%:num. -Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (f x)}. -Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous f ^~ y}}. +Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Variable rho : {posnum R}. Hypothesis rho1 : rho%:num < 1. @@ -1501,30 +1520,31 @@ Check U : completePseudoMetricType R. Check U : normedModType R. Check U : completeNormedModType R. -Notation V := (@quot_contSeg R U _ _ (leDl_delta_max f ab u0 r k0 rho)). +Local Notation delta_max := (@delta_max R n phi a b k u0 r rho). +Local Notation V := (@quot_contSeg R a (a + delta_max) U). Check V : completeNormedModType _. -Local Notation img_cball := (@img_cball R n f a b k ab u0 r k0 rho). +Local Notation img_cball := (@img_cball R n phi a b k u0 r rho). +Local Notation img_cball_nonempty := (img_cball_nonempty phi a b k u0 r rho). +Local Notation closed_img_cball := (@closed_img_cball R n phi a b k u0 r k0 rho ab). -Local Notation img_cball_nonempty := (img_cball_nonempty f ab u0 r k0 rho). -Local Notation closed_img_cball := (@closed_img_cball R n f a b k ab u0 r k0 rho). +Local Notation picard := (@picard _ n phi a b k u0 r k0 lip2 cont1 rho). Definition picard_fix : V := sval (cid2 (@banach_fixed_point R V img_cball - (@picard R n f a b k ab u0 r k0 lip2 cont1 rho) - (@is_contraction_picard _ n f a b ab k k0 u0 r lip2 cont1 rho rho1) + picard + (@is_contraction_picard _ n phi a b ab k k0 u0 r lip2 cont1 rho rho1) closed_img_cball img_cball_nonempty)). -Let picard_fixE : - picard_fix = (@picard _ n f a b k ab u0 r k0 lip2 cont1 rho) picard_fix. +Let picard_fixE : picard_fix = picard picard_fix. Proof. by rewrite {}/picard_fix; case: cid2. Qed. Lemma img_cball_picard_fix : img_cball picard_fix. Proof. by apply (svalP (cid2 (@banach_fixed_point R V img_cball _ - (@is_contraction_picard R n f _ _ ab k k0 u0 r lip2 cont1 _ rho1) + (@is_contraction_picard R n phi _ _ ab k k0 u0 r lip2 cont1 _ rho1) closed_img_cball img_cball_nonempty))). Qed. @@ -1535,17 +1555,14 @@ rewrite picard_fixE eval_mod_on_itv. by rewrite inE/= in_itv/= lexx leDl_delta_max. Qed. -Local Notation delta_max := (delta_max f a b k u0 r rho). - Lemma picardE g t : img_cball g -> t \in `[a, a + delta_max] -> - (@picard _ n f a b k ab u0 r k0 lip2 cont1 rho) g t = - u0 + \vint[mu]_(x in `[a, t]) f x (g x). + picard g t = u0 + \vint[mu]_(x in `[a, t]) phi x (g x). Proof. by move=> Hg taad; rewrite eval_mod_on_itv//; exact: picard_funE. Qed. Lemma cauchy_lipschitz_integral_version : - is_integral_sol_on f u0 a (a + delta_max) picard_fix. + is_integral_sol_on phi u0 a (a + delta_max) picard_fix. Proof. split; first exact: picard_fix_init. move=> t tad. @@ -1556,12 +1573,12 @@ Qed. Theorem cauchy_lipschitz_unique (picard_fix' : V) : img_cball picard_fix' -> (forall t, t \in `[a, a + delta_max] -> - picard_fix' t = u0 + \vint[mu]_(x in `[a, t]) f x (picard_fix' x)) -> + picard_fix' t = u0 + \vint[mu]_(x in `[a, t]) phi x (picard_fix' x)) -> picard_fix = picard_fix'. Proof. move=> imgpicard_fix'_cball h. apply: (contraction_fixpoint_unique - (@is_contraction_picard R n f a b ab k k0 u0 r lip2 cont1 rho rho1) + (@is_contraction_picard R n phi a b ab k k0 u0 r lip2 cont1 rho rho1) img_cball_picard_fix imgpicard_fix'_cball) => //=. rewrite -(reprK picard_fix'). apply/eqquotP. @@ -1578,40 +1595,40 @@ by rewrite h// subrr. Qed. Theorem cauchy_lipschitz_existence : picard_fix a = u0 /\ - {in `]a, a + delta_max[, forall x, picard_fix^`() x = f x (picard_fix x)}. + {in `]a, a + delta_max[, forall x, picard_fix^`() x = phi x (picard_fix x)}. Proof. split; first exact: picard_fix_init. move => t tad. rewrite {1}picard_fixE. apply/rowP => j. -suff -> : (picard lip2 cont1 picard_fix)^`() t = - (fun x0 => u0 + \vint[mu]_(x in `[a, x0]) f x (picard_fix x))^`() t. +suff -> : (picard picard_fix)^`() t = + (fun t => u0 + \vint[mu]_(x in `[a, t]) phi x (picard_fix x))^`() t. move: (tad); rewrite inE /= in_itv /= => /andP[ta tadelta]. have Fint i : mu.-integrable `[a, a + delta_max] - (EFin \o (fun x => f x (picard_fix x) ord0 i)). + (EFin \o (fun x => phi x (picard_fix x) ord0 i)). apply: integrable_comp => //. by rewrite in_itv /= lexx andbT leDl_delta_max. exact: img_cball_picard_fix. - have Fcont i : {for t, continuous (fun x => f x (picard_fix x) ord0 i)}. + have Fcont i : {for t, continuous (fun x => phi x (picard_fix x) ord0 i)}. move: tad; rewrite inE. apply/within_continuous_continuous => //=. exact: ltDl_delta_max. clear Fint. move: i; apply/within_continuous_coord. - apply: (within_continuous_lipschitz _ k0 _ (u0 := u0) (r := r)). + apply: (@within_continuous_lipschitz _ _ _ a _ u0 r _ _ _ k0'). + exact: cts_fun. + exact: lip2_delta_max. + exact: cont1_delta_max. + exact: img_cball_picard_fix. - have [H1 H2] := @continuous_FTC1_closed _ (fun x => f x (picard_fix x) ord0 j) + have [H1 H2] := @continuous_FTC1_closed _ (fun x => phi x (picard_fix x) ord0 j) a t _ tadelta (Fint j) ta (Fcont j). - have Hderivable : derivable (fun x => \vint[mu]_(y in `[a, x]) f y (picard_fix y)) t 1. + have Hderivable : derivable (fun x => \vint[mu]_(y in `[a, x]) phi y (picard_fix y)) t 1. apply/derivable_mxP => i0 i; rewrite (ord1 i0){i0}/=. - have [?] := @continuous_FTC1_closed _ (fun x => f x (picard_fix x) ord0 i) + have [?] := @continuous_FTC1_closed _ (fun x => phi x (picard_fix x) ord0 i) a t _ tadelta (Fint i) ta (Fcont i). rewrite /rowRintegral. rewrite [X in derivable X t 1](_ : _ = - (fun x => \int[mu]_(y in `[a, x]) f y (picard_fix y) ord0 i))//. + (fun x => \int[mu]_(y in `[a, x]) phi y (picard_fix y) ord0 i))//. by apply/funext => x; rewrite mxE. rewrite derive1E deriveD /=; last 2 first. exact: derivable_cst. @@ -1622,7 +1639,7 @@ suff -> : (picard lip2 cont1 picard_fix)^`() t = rewrite /picard /picard_fun. move: t tad. apply: eq_on_itv_deriv => t tad /=. -rewrite -(@picard_funE _ _ _ a b k _ r lip2 cont1 rho)//=. +rewrite -(@picard_funE _ _ _ a b k _ r k0' lip2 cont1 rho)//=. rewrite eval_mod_on_itv// inE; apply: subset_itv_oo_cc. by rewrite inE in tad. exact: img_cball_picard_fix. @@ -1744,6 +1761,7 @@ Notation U := 'rV[R]_n. Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}). Hypothesis ab : a < b. Hypothesis k0 : 0 < k. +Let k0' : k != 0. Proof. by rewrite gt_eqF. Qed. Let B := closed_ball u0 r%:num. Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. @@ -1762,7 +1780,7 @@ Local Notation delta_max := (delta_max phi a b k u0 r rho). Lemma solution_local_solution : is_sol_on phi u0 a (BLeft (a + delta_max)) local_solution. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. -- exact: ltDl_delta_max. +- by rewrite ltDl_delta_max. - move=> t td. apply: lip2. move: td; rewrite /=!in_itv/= => /andP [-> h] /=. @@ -1802,8 +1820,7 @@ split. - exact: solution_stays_in_ball. Qed. -Local Notation V := - (ContSeg_quot.quot_contSeg (@leDl_delta_max _ _ phi a b k ab u0 r k0 rho)). +Local Notation V := (@ContSeg_quot.quot_contSeg R a (a + delta_max) U). Theorem cauchy_lipschitz_local_unique f' : {within `[a, a + delta_max], continuous f'} -> @@ -1812,7 +1829,7 @@ Theorem cauchy_lipschitz_local_unique f' : {in `[a, a + delta_max], f =1 f'}. Proof. move => cont bnd. -move/(@integral_sol_iff_sol _ _ _ _ _ _ _ _ r k0) => []//. +move/(@integral_sol_iff_sol _ _ _ _ _ _ _ _ r k0') => []//. - exact: ltDl_delta_max. - move=> t td. apply: lip2. @@ -1822,13 +1839,13 @@ move/(@integral_sol_iff_sol _ _ _ _ _ _ _ _ r k0) => []//. by apply: subset_itvl => //=; rewrite bnd_simp -lerBrDl delta_max_itv. - by move => _ [t tad] <-;apply bnd;rewrite inE. move=> f'au0 h1 t tab. -have fc : cont_on_seg a (a + delta_max) f' by exact: mem_set. -have pieq : \pi_V%qT f = \pi_V%qT (cont_on_seg_Sub fc). +have fc : contseg a (a + delta_max) f' by exact: mem_set. +have pieq : \pi_V%qT f = \pi_V%qT (contseg_Sub fc). rewrite reprK. apply: cauchy_lipschitz_unique. move => /= _ [t' tad' ] <- /=. rewrite /ContSeg_quot.fun_of_quot_contSeg. - suff -> : (repr (\pi_V%qT (cont_on_seg_Sub fc))) t' = f' t'. + suff -> : (repr (\pi_V%qT (contseg_Sub fc))) t' = f' t'. by apply: bnd; rewrite inE. by apply: ContSeg_quot.eval_mod_on_itv; rewrite inE. move=> t0 t0ad. @@ -1840,8 +1857,9 @@ have pieq : \pi_V%qT f = \pi_V%qT (cont_on_seg_Sub fc). move: tad'; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp. rewrite inE/= in t0ad. by move/itvP : t0ad => ->. -suff -> : f t = (ContSeg_quot.fun_of_quot_contSeg (\pi_V%qT (cont_on_seg_Sub fc))) t. - by rewrite /ContSeg_quot.fun_of_quot_contSeg/=;apply ContSeg_quot.eval_mod_on_itv. +suff -> : f t = (ContSeg_quot.fun_of_quot_contSeg (\pi_V%qT (contseg_Sub fc))) t. + rewrite /ContSeg_quot.fun_of_quot_contSeg/=. + exact: ContSeg_quot.eval_mod_on_itv. rewrite -pieq. by rewrite ContSeg_quot.eval_mod_on_itv. Qed. diff --git a/ode_common.v b/ode_common.v index 67381be3..bdaeb9d9 100644 --- a/ode_common.v +++ b/ode_common.v @@ -7,11 +7,15 @@ From mathcomp Require Import functions reals interval_inference topology. From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. + (**md**************************************************************************) -(* # ODE *) -(* cont_on_seg a b := pred type for functions continuous on [a;b] *) +(* # Preparation steps to ode_contfun.v *) +(* *) +(* ``` *) +(* contseg a b := pred type for functions continuous on [a; b] *) (* infty_norm0 f == sup (|f|(K)) *) (* f has type {fun K >-> [set: _]} *) +(* ``` *) (******************************************************************************) Set Implicit Arguments. @@ -331,7 +335,6 @@ Context {R : realType}. Variables (f : R -> R -> R) (a t1 : R). Hypothesis a1 : a < t1. Variable k : R. -Hypothesis k1 : k > 0. Variables (u0 : R) (r : {posnum R}). Let B := closed_ball u0 r%:num. @@ -367,12 +370,36 @@ split. rewrite ltr_distlC => /andP[_]. by rewrite addrCA subrr addr0 => /ltW. move=> /(_ (conj By By'))/le_trans; apply. + near: y'. + have [k0|k0] := ltP 0 k; last first. + near=> y'. + by rewrite (le_trans _ (ltW e0))// mulr_le0_ge0. + near=> y'. rewrite -ler_pdivlMl// mulrC. near: y'. - (* TODO(rei): investigate *) - exists (e / k); first by rewrite divr_gt0. + exists (e / k). + by rewrite divr_gt0. by move=> z/= => /ltW. - apply/cvgrPdist_le => /= e e0. + have [k0|k0] := ltP 0 k; last first. + (* TODO: clean, bad dup *) + near=> y'. + move: (xa1); have := @lip2 x => /[apply]. + move=> /(_ (u0 - r%:num, y'))/=. + have Bu0r : B (u0 - r%:num). + rewrite /B closed_ball_itv//=. + by rewrite bound_itvE lerD2l gerN. + have By' : B y'. + rewrite /B closed_ball_itv//=. + rewrite in_itv/=; apply/andP; split => //. + near: y'. + exists r%:num => //=. + move=> z/=. + rewrite ltr_distlC. + rewrite subrK => /andP[_ /ltW + _] => /le_trans; apply. + by rewrite lerDl. + move=> /(_ (conj Bu0r By'))/le_trans; apply. + by rewrite (le_trans _ (ltW e0))// mulr_le0_ge0. near=> y'. move: (xa1); have := @lip2 x => /[apply]. move=> /(_ (u0 - r%:num, y'))/=. @@ -391,10 +418,30 @@ split. move=> /(_ (conj Bu0r By'))/le_trans; apply. rewrite -ler_pdivlMl// mulrC. near: y'. - (* TODO(rei): investigate *) exists (e / k) => /=; first by rewrite divr_gt0. by move=> z/= => /ltW. - apply/cvgrPdist_le => /= e e0. + have [k0|k0] := ltP 0 k; last first. + (* TODO: clean, bad dup *) + near=> y'. + move: (xa1); have := @lip2 x => /[apply]. + move=> /(_ (y', u0 + r%:num))/=. + have By' : B y'. + rewrite /B closed_ball_itv//=. + rewrite in_itv/=; apply/andP; split => //. + near: y'. + exists r%:num => //=. + move=> z/=. + rewrite ltr_distlC addrK => /andP[/ltW + _ _]. + rewrite lerBlDl => /le_trans; apply. + by rewrite lerDr. + have Bu0r : B (u0 + r%:num). + rewrite /B closed_ball_itv//=. + by rewrite bound_itvE lerD2l gerN. + move=> /(_ (conj By' Bu0r)). + rewrite distrC. + move=> /le_trans; apply. + by rewrite (le_trans _ (ltW e0))// mulr_le0_ge0. near=> y'. move: (xa1); have := @lip2 x => /[apply]. move=> /(_ (y', u0 + r%:num))/=. @@ -415,7 +462,6 @@ split. move=> /le_trans; apply. rewrite -ler_pdivlMl// mulrC. near: y'. - (* TODO(rei): investigate *) exists (e / k) => /=; first by rewrite divr_gt0. move=> z/= => /ltW. by rewrite distrC. @@ -444,85 +490,84 @@ HB.instance Definition _ (R : realType) (V : topologicalType) (A : set R) := HB.instance Definition _ (R : realType) (V : topologicalType) (A : set R) := gen_choiceMixin (continuousFunType A [set: V]). -Section cont_on_seg_pred. -Context {R : realType} {V : topologicalType}. -Variables a b : R. +Section contseg_pred. +Context {R : realType} (a b : R) (V : topologicalType). -Definition cont_on_seg : {pred R -> V} := +Definition contseg : {pred R -> V} := mem [set f | squashed (@ContinuousFun R V `[a, b] [set: V] f)]. -Definition cont_on_seg_key : pred_key cont_on_seg. Proof. exact. Qed. -Canonical cont_on_seg_keyed := KeyedPred cont_on_seg_key. +Definition contseg_key : pred_key contseg. Proof. exact. Qed. +Canonical contseg_keyed := KeyedPred contseg_key. -End cont_on_seg_pred. +End contseg_pred. +Arguments contseg {R} a b {V}. -(* NB(rei): was this just motivated by generic predicates such as rpredD? -or more generally by stability of "cont. over [a,b]"? -anyway, maybe not needed right now *) -Section cont_on_seg_sub. -Context {R : realType} {V : topologicalType}. -Variables a b : R. +Section contseg_sub. +Context {R : realType} (a b : R) {V : topologicalType}. Notation T := (continuousFunType `[a, b] [set: V]). Section Sub. -Context (f : R -> V) (fP : f \in cont_on_seg a b). +Context (f : R -> V) (fP : f \in contseg a b). -Definition cont_on_seg_Sub_subproof := unsquash (set_mem fP). -#[local] HB.instance Definition _ := cont_on_seg_Sub_subproof. -Definition cont_on_seg_Sub : continuousFunType `[a, b] [set: V] := - {| ContinuousFun.sort := f; ContinuousFun.class := cont_on_seg_Sub_subproof |}. +Definition contseg_Sub_subproof := unsquash (set_mem fP). +#[local] HB.instance Definition _ := contseg_Sub_subproof. +Definition contseg_Sub : continuousFunType `[a, b] [set: V] := + {| ContinuousFun.sort := f; ContinuousFun.class := contseg_Sub_subproof |}. End Sub. -Lemma cont_on_seg_rect (K : T -> Type) : - (forall f (Pf : f \in cont_on_seg a b), K (cont_on_seg_Sub Pf)) -> +Lemma contseg_rect (K : T -> Type) : + (forall f (Pf : f \in contseg a b), K (contseg_Sub Pf)) -> forall u : T, K u. Proof. move=> Ksub [f Pf]. -rewrite (_ : K _ = K (cont_on_seg_Sub (mem_set (squash Pf))))//. -rewrite /cont_on_seg_Sub /cont_on_seg_Sub_subproof /= mem_setK. +rewrite (_ : K _ = K (contseg_Sub (mem_set (squash Pf))))//. +rewrite /contseg_Sub /contseg_Sub_subproof /= mem_setK. rewrite /unsquash; case : cid => // /= => x _. congr (K (ContinuousFun.Pack _)). move : Pf x => [[H1] [H2]] [[K1] [K2]]. by rewrite (Prop_irrelevance H1 K1) (Prop_irrelevance H2 K2). Qed. -Lemma cont_on_seg_valP f (Pf : f \in cont_on_seg a b) : - cont_on_seg_Sub Pf = f :> (_ -> _). +Lemma contseg_valP f (Pf : f \in contseg a b) : contseg_Sub Pf = f :> (_ -> _). Proof. by []. Qed. -HB.instance Definition _ := isSub.Build _ _ T cont_on_seg_rect cont_on_seg_valP. +HB.instance Definition _ := isSub.Build _ _ T contseg_rect contseg_valP. -Lemma cont_on_seg_eqP (f g : continuousFunType `[a, b] [set: V]) : +Lemma contseg_eqP (f g : continuousFunType `[a, b] [set: V]) : f = g <-> f =1 g. Proof. by split=> [->//|fg]; exact/val_inj/funext. Qed. -(* commented out on [2025-12-26] +(* HB.instance Definition _ := [Choice of continuousFunType `[a, b] [set: R] by <:]. *) -End cont_on_seg_sub. +End contseg_sub. -Definition cont_on_segN {R : realType} (a b : R) (ab : a < b) - (g : R -> R) := g \o -%R. -Arguments cont_on_segN {R} _ _. +Definition contsegN {R : realType} (a b : R) (g : R -> R) := + g \o -%R. +Arguments contsegN {R} _ _. -Section cont_on_segN. +Section contsegN. Context {R : realType}. -Variables t0 t1 : R. -Hypothesis t01 : t0 < t1. +Variables a b : R. -Let g'fun (g : continuousFunType `[t0, t1] [set: R]) : - set_fun `[-t1, -t0] setT (cont_on_segN t0 t1 t01 g). +Let g'fun (g : continuousFunType `[a, b] [set: R]) : + set_fun `[- b, - a] setT (contsegN a b g). Proof. by constructor => x/=. Qed. -HB.instance Definition _ (g : continuousFunType `[t0, t1] [set: R]) := - @isFun.Build (subspace `[-t1, -t0]) R `[-t1, -t0] setT (cont_on_segN t0 t1 t01 g) (g'fun g). +HB.instance Definition _ (g : continuousFunType `[a, b] [set: R]) := + @isFun.Build (subspace `[- b, - a]) R `[- b, - a] setT (contsegN a b g) (g'fun g). -(* TODO: should this be a lemma? about balls? *) - -Let cg' (g : continuousFunType `[t0, t1] [set: R]) : - {within `[- t1, - t0], continuous (cont_on_segN t0 t1 t01 g)}. +Let cg' (g : continuousFunType `[a, b] [set: R]) : + {within `[- b, - a], continuous (contsegN a b g)}. Proof. +have [ab|] := ltP a b; last first. + rewrite le_eqVlt => /predU1P[ba|ba]. + subst b. + rewrite set_itv1. + exact: continuous_subspace1. + rewrite set_itv_ge ?bnd_simp ?leNgt ?ltrN2 ?negbK//. + exact: continuous_subspace0. apply/continuous_within_itvP. by rewrite ltrN2. have /continuous_within_itvP[] := @cts_fun _ _ g. @@ -530,18 +575,18 @@ have /continuous_within_itvP[] := @cts_fun _ _ g. move=> cg gR gL; split. - move=> x xdd; apply: continuous_comp; first exact: continuousN. by apply: cg; rewrite oppr_itvoo. -- by apply/cvg_at_leftNP; rewrite /cont_on_segN/= opprK. +- by apply/cvg_at_leftNP; rewrite /contsegN/= opprK. - move/cvg_at_rightNP : gR. - by rewrite /cont_on_segN/= opprK. + by rewrite /contsegN/= opprK. Qed. -HB.instance Definition _ (g : continuousFunType `[t0, t1] [set: R]) := - isContinuous.Build _ _ (cont_on_segN t0 t1 t01 g : subspace `[-t1, -t0] -> R) (@cg' g). +HB.instance Definition _ (g : continuousFunType `[a, b] [set: R]) := + isContinuous.Build _ _ (contsegN a b g : subspace `[- b, - a] -> R) (@cg' g). -End cont_on_segN. +End contsegN. -Lemma cont_on_seg_zmod_closed {R : realType} {V : normedModType R} a b : - zmod_closed (@cont_on_seg R V a b). +Lemma contseg_zmod_closed {R : realType} (a b : R) (V : normedModType R) : + zmod_closed (@contseg _ a b V). Proof. split=> [|f g]; rewrite !inE/=. - apply: squash. @@ -549,8 +594,8 @@ split=> [|f g]; rewrite !inE/=. exact: cst_continuous. - move=> /unsquash cf /unsquash cg. apply: squash. - pose f' : @continuousFunType _ _ `[a, b] setT := HB.pack f cf. - pose g' : @continuousFunType _ _ `[a, b] setT := HB.pack g cg. + pose f' : continuousFunType `[a, b] setT := HB.pack f cf. + pose g' : continuousFunType `[a, b] setT := HB.pack g cg. rewrite [f]/(f' : _ -> _). rewrite [g]/(g' : _ -> _). move: {f g cf cg} f' g' => f g. @@ -561,8 +606,8 @@ split=> [|f g]; rewrite !inE/=. by split. Qed. -Lemma contfun_scaler_closed {R : realType} {V : normedModType R} a b : - GRing.scaler_closed (@cont_on_seg R V a b). +Lemma contfun_scaler_closed {R : realType} (a b : R) (V : normedModType R) : + GRing.scaler_closed (@contseg _ a b V). Proof. move=> r f; rewrite 2!inE/= => /unsquash[[_ cf]]. apply: squash. @@ -572,18 +617,6 @@ apply: continuousZ; first exact: cst_continuous. by case: cf; exact. Qed. -Lemma cont_within_cont_comp {R : realType} {W : normedModType R} (f : W -> R) - (K : set R) (g : continuousFunType K [set: W]) : {in g @` K, continuous f} -> - {within K, continuous (f \o g)}. -Proof. -move=> ctf. -rewrite continuous_subspace_in => /= x Kx. -apply: continuous_comp; first exact: cts_fun. -apply: ctf. -exact: image_f Kx. -Qed. - -(* generalized to higher dimension *) Section within_continuous_lipschitz. Context {R : realType} {U : normedModType R}. Variables (f : R -> U -> U) (a b : R). @@ -595,7 +628,7 @@ Hypothesis cg : {within `[a, b], continuous g}. Let B := closed_ball u0 r%:num. Variable k : R. -Hypothesis k0 : k > 0. +Hypothesis k0 : k != 0. (* properties of the function f defining the differential equation: *) (* k-lipschitz for all t *) Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (f x)}. @@ -611,7 +644,7 @@ apply/cvgrPdist_le => /= e e0. have aab : a \in `[a, b]%R by rewrite bound_itvE ltW. have e20 : 0 < e / 2 by rewrite divr_gt0. (* use continuity in first variable *) -have c1_ineq : \forall t \near a^'+, `|f a (g a) - f t (g a)| <= e / 2. +have c1_ineq : \forall t \near a^'+, `|f a (g a) - f t (g a)| <= e / 2. have : g a \in (B : set U) by apply/mem_set/imageg => /=; exists a. move /cont1/continuous_within_itvP_g => /(_ ab). move=> [_ + _]. @@ -623,14 +656,14 @@ have gtd : \forall t \near a^'+, g t \in (B : set U). rewrite in_itv/=; apply/andP; split => //. by near: t; exact: nbhs_right_le. (* use continuity of g *) -have cg_ineq : \forall t \near a^'+, `|g a - g t| <= k^-1 * (e / 2). +have cg_ineq : \forall t \near a^'+, `|g a - g t| <= `|k|^-1 * (e / 2). have /continuous_within_itvP_g := cg. move/(_ ab) => [_ + _]. - move/cvgrPdist_le => /(_ (k^-1 * (e / 2)) ). + move/cvgrPdist_le => /(_ (`|k|^-1 * (e / 2)) ). apply. - by rewrite mulr_gt0// invr_gt0. + by rewrite mulr_gt0// invr_gt0 normr_gt0. (* use Lipschitz continuity *) -have c2_ineq : \forall t \near a^'+, `|f t (g (a)) - f t (g t)| <= (e/2). +have c2_ineq : \forall t \near a^'+, `|f t (g (a)) - f t (g t)| <= e / 2. near=> t. have td' : t \in `[a, b]%R. by rewrite in_itv /=; apply/andP; split=>//; rewrite ltW. @@ -639,10 +672,15 @@ have c2_ineq : \forall t \near a^'+, `|f t (g (a)) - f t (g t)| <= (e/2). move: lip2 => /(_ _ td'). move /(_ (g a, g t) (conj gNdB Bgt)). move/le_trans; apply. + move: k0; rewrite neq_lt => /orP[k_lt0|k_gt0]. + rewrite (@le_trans _ _ 0)//; last by rewrite divr_ge0// ltW. + by rewrite mulr_le0_ge0// ltW. rewrite -ler_pdivlMl//. - by near: t. + rewrite (_ : k = `|k|). + by near: t. + by rewrite gtr0_norm. near=>t. -rewrite -(subrKA (f t (g a)) (f (a) (g (a)))) (le_trans (ler_normD _ _))//. +rewrite -(subrKA (f t (g a)) (f a (g a))) (le_trans (ler_normD _ _))//. by rewrite (splitr e) lerD//; near: t. Unshelve. all: end_near. Qed. @@ -663,13 +701,13 @@ have gtd : \forall t \near b^'-, g t \in (B : set U). apply/mem_set/imageg => /=; exists t => //. rewrite in_itv/=; apply/andP; split => //. by near: t; exact: nbhs_left_ge. -have cg_ineq : \forall t \near (b)^'-, `|g b - g t| <= k^-1 * (e / 2). +have cg_ineq : \forall t \near (b)^'-, `|g b - g t| <= `|k|^-1 * (e / 2). have /continuous_within_itvP_g := cg. move/(_ ab) => [_ _ +]. - move/cvgrPdist_le => /(_ (k^-1 * (e / 2))). + move/cvgrPdist_le => /(_ (`|k|^-1 * (e / 2))). apply. - by rewrite mulr_gt0// invr_gt0. -have c2_ineq : \forall t \near (b)^'-, `|f t (g b) - f t (g t)| <= (e/2). + by rewrite mulr_gt0// invr_gt0// normr_gt0. +have c2_ineq : \forall t \near (b)^'-, `|f t (g b) - f t (g t)| <= e / 2. near=> t. have td' : t \in `[a, b]%R. by rewrite in_itv /=; apply/andP; split=> //; rewrite ltW. @@ -678,8 +716,13 @@ have c2_ineq : \forall t \near (b)^'-, `|f t (g b) - f t (g t)| <= (e/2). move: lip2 => /(_ _ td'). move /(_ (g b, g t) (conj gNdB Bgt)). move/le_trans; apply. + move: k0; rewrite neq_lt => /orP[k_lt0|k_gt0]. + rewrite (@le_trans _ _ 0)//; last by rewrite divr_ge0// ltW. + by rewrite mulr_le0_ge0// ltW. rewrite -ler_pdivlMl//. - by near: t. + rewrite (_ : k = `|k|). + by near: t. + by rewrite gtr0_norm. near=>t. rewrite -(subrKA (f t (g b)) (f b (g b))) (le_trans (ler_normD _ _))//. by rewrite (splitr e) lerD//; near: t. @@ -740,13 +783,19 @@ apply/continuous_within_itvP_g; [by [] | split]. have Bgt : B (g t) by apply: (imageg) => /=; exists t. move/(_ (g x, g t) (conj gxB Bgt)). move=> /le_trans; apply. + near: t. + move: k0; rewrite neq_lt => /orP[k_lt0|k_gt0]. + near=> t. + rewrite (@le_trans _ _ 0)//; last by rewrite divr_ge0// ltW. + by rewrite mulr_le0_ge0// ltW. + near=> t. rewrite -ler_pdivlMl//. near: t. move/continuous_within_itvP_g : cg => /(_ ab)[+ _ _] => /(_ x). rewrite inE /= in_itv/= ndx dx => /(_ isT). rewrite /continuous_at => /cvgrPdist_le. apply. - by rewrite mulr_gt0 ?divr_gt0 ?invr_gt0. + by rewrite mulr_gt0 ?divr_gt0 ?invr_gt0//. - exact: within_continuous_lipschitz_at_right. - exact: within_continuous_lipschitz_at_left. Unshelve. all: end_near. Qed. @@ -760,7 +809,19 @@ exists (u + 1) => x Ax. by rewrite (le_trans (ler_norm x))// uA// ltrDl. Qed. -Lemma normr_has_sup {R : realType} {W : normedModType R} (a b : R) +(* TODO: PR *) +Lemma cont_within_cont_comp {R : realType} {W : normedModType R} (f : W -> R) + (K : set R) (g : continuousFunType K [set: W]) : {in g @` K, continuous f} -> + {within K, continuous (f \o g)}. +Proof. +move=> ctf. +rewrite continuous_subspace_in => /= x Kx. +apply: continuous_comp; first exact: cts_fun. +apply: ctf. +exact: image_f Kx. +Qed. + +Lemma normr_has_sup {R : realType} (a b : R) {W : normedModType R} (f : continuousFunType `[a, b] [set: W]) : a <= b -> has_sup [set (normr \o f) z | z in `[a, b] ]. Proof. @@ -770,7 +831,7 @@ apply/compact_has_ubound/continuous_compact => //; last exact: segment_compact. by apply:cont_within_cont_comp => w wK; exact: norm_continuous. Qed. -Definition infty_norm0 {R : realType} {W : normedModType R} (K : set R) +Definition infty_norm0 {R : realType} (K : set R) {W : normedModType R} (f : {fun K >-> [set: W]}) := sup ((Num.norm \o f) @` K). Section infty_norm0_lemmas. @@ -811,7 +872,7 @@ End infty_norm0_lemmas. Section intermediate_lemma. Context {R : realType}. Variables (a b : R). -Hypothesis a1 : a < b. +Hypothesis ab : a < b. Variable u0 : R. Variable r : {posnum R}. Let B := closed_ball u0 r%:num. @@ -823,7 +884,7 @@ Proof. move => cont_g imageg _ [] x /= + <-. rewrite in_itv /= => /andP[+ +]/=. have /continuous_within_itvP := cont_g. -move=> /(_ a1)[]/=. +move=> /(_ ab)[]/=. move => gcont gcontl gcontr. have closea1 : closed `[a, b] by exact: interval_closed. have h0 x0 : g x0 \in (interior B : set R) -> g x0 \in B. diff --git a/ode_contfun.v b/ode_contfun.v index 183ee93d..1d714343 100644 --- a/ode_contfun.v +++ b/ode_contfun.v @@ -34,10 +34,10 @@ Open Scope classical_set_scope. Module ContSeg_zlmodType. Section contSeg_zlmodtype. -Context {R : realType} {V : normedModType R} (a b : R). +Context {R : realType} (a b : R) (V : normedModType R). HB.instance Definition _ := GRing.isZmodClosed.Build _ _ - (@cont_on_seg_zmod_closed R V a b). + (contseg_zmod_closed a b V). Fail Check continuousFunType `[a, b] [set: V] : zmodType. @@ -47,7 +47,7 @@ HB.instance Definition _ := Check continuousFunType `[a, b] [set: V] : zmodType. HB.instance Definition _ := GRing.isScaleClosed.Build _ _ - (cont_on_seg a b) (@contfun_scaler_closed R V a b). + (contseg a b) (@contfun_scaler_closed R a b V). Fail Check @continuousFunType R V `[a, b] [set: V] : lmodType _. @@ -60,15 +60,15 @@ End contSeg_zlmodtype. End ContSeg_zlmodType. Section submod_contSeg. -Context {R : realType} {V : normedModType R} (a b : R). +Context {R : realType} (a b : R) {V : normedModType R}. Local Notation T := (continuousFunType `[a, b] [set: V]). (* NB: point does not need to be 0, so rewrite f \_ K explicitly *) -Definition patch_contSeg0 (ab : a <= b) : {pred T} := +Definition patch_contSeg0 : {pred T} := [pred f : T | patch 0 `[a, b] f == 0]. End submod_contSeg. -Arguments patch_contSeg0 {R} V {a b} ab. +Arguments patch_contSeg0 {R} {a b} V ab. Module ContSeg_submod. Export ContSeg_zlmodType. @@ -76,9 +76,8 @@ Export ContSeg_zlmodType. Section submod_definition. Context {R : realType} {V : normedModType R}. Variables a b : R. -Hypothesis ab : a <= b. -Lemma submod_closed_contSeg : submod_closed (patch_contSeg0 V ab). +Lemma submod_closed_contSeg : submod_closed (@patch_contSeg0 _ a b V). Proof. split => /=. - rewrite inE/=; apply/funext => x. @@ -98,7 +97,7 @@ Fail Check (patch_contSeg0 V ab) : zmodClosed _. HB.instance Definition _ := GRing.isZmodClosed.Build _ _ (GRing.submod_closedB submod_closed_contSeg). -Check (patch_contSeg0 V ab) : zmodClosed _. +Check (@patch_contSeg0 _ a b V) : zmodClosed _. End submod_definition. End ContSeg_submod. @@ -106,7 +105,6 @@ End ContSeg_submod. Section contSeg_seminorm. Context {R : realType} {W : normedModType R}. Variables a b : R. -Hypothesis ab : a <= b. Let K := `[a, b]. Local Notation T := (continuousFunType K [set: W]). @@ -115,17 +113,27 @@ Import ContSeg_zlmodType. (* NB: require Nmodule properties *) Lemma infty_norm0_eq0 : infty_norm0 (0 : T) = 0. Proof. -rewrite /infty_norm0 -(sup1 0); congr sup. +rewrite /infty_norm0. +have [K0|K0] := eqVneq K set0. + by rewrite [X in [set _ | _ in X]](_ : _ = set0)// image_set0// sup0. +rewrite -(sup1 0); congr sup. apply: eq_set => /= z. apply propext; split => [[x _ <- ] | ->]; rewrite ?normr0 => //. -have [c Kc] := seg_nonempty ab. +move/set0P : K0 => [c Kc]. by exists c => //; rewrite normr0. Qed. (* NB: require Nmodule properties *) Lemma infty_norm0rMn (f : T) n : infty_norm0 (f *+ n) = infty_norm0 f *+ n. Proof. -rewrite /infty_norm0 -sup_Mn; last exact: normr_has_sup. +rewrite /infty_norm0. +have [K0|K0] := eqVneq K set0. + do 2 rewrite [X in [set _ | _ in X]](_ : _ = set0)// image_set0//. + by rewrite sup0 mul0rn. +rewrite -sup_Mn; last first. + apply: normr_has_sup. + rewrite leNgt; apply: contra K0 => ba. + by rewrite /K set_itv_ge// bnd_simp -ltNge. rewrite image_comp/=; congr (sup _). apply: eq_imagel => z Kz /=; rewrite -normrMn /=. have /(congr1 (@^~ z)) <- := natmulfctE f n. @@ -152,8 +160,7 @@ Import ContSeg_submod. Import Quotient. Section contSeg_quotient. -Context {R : realType} {W : normedModType R} (a b : R). -Hypothesis ab : a <= b. +Context {R : realType} (a b : R) {W : normedModType R}. (*Definition eq_seg (f g : continuousFunType a b) := `[< {in `[a, b], f =1 g} >]. @@ -174,7 +181,7 @@ Canonical eq_seg_canonical := Local Open Scope quotient_scope. -Definition quot_contSeg := {quot (@patch_contSeg0 _ W _ _ ab)}. +Definition quot_contSeg := {quot (@patch_contSeg0 R a b W)}. Local Notation T := quot_contSeg. (* NB: ZmodQuotient is defined in ring_quotient.v *) @@ -230,12 +237,11 @@ End ContSeg_quot. Section zmodule_normed. Context {R : realType} {W : normedModType R}. Variables a b : R. -Hypothesis ab : a <= b. Let K := `[a, b]. Import ContSeg_quot. -Local Notation V := (@quot_contSeg R W a b ab). +Local Notation V := (@quot_contSeg R a b W). Definition infty_norm (f : V) := infty_norm0 (repr f). @@ -244,16 +250,22 @@ Local Open Scope quotient_scope. Lemma ler_infty_normD (x y : V) : infty_norm (x + y) <= infty_norm x + infty_norm y :> R. Proof. -rewrite /infty_norm/= -sup_sumE; [|exact: normr_has_sup..]. +rewrite /infty_norm/=. +have [K0|K0] := eqVneq K set0. + rewrite /infty_norm0. + do ! rewrite [X in [set _ | _ in X]](_ : _ = set0)// image_set0//. + by rewrite sup0 addr0. +have ab : a <= b. + rewrite leNgt; apply: contra K0 => ba. + by rewrite /K set_itv_ge// bnd_simp -ltNge. +rewrite -sup_sumE; [|exact: normr_has_sup..]. apply: sup_le. - move=> A -[s sab] <-{A}. rewrite /down/=. eexists. split. - exists `|repr x s|. - by exists s. - exists `|repr y s|. - by exists s. + exists `|repr x s|; first by exists s. + exists `|repr y s|; first by exists s. reflexivity. suff -> : repr (x + y) s = repr x s + repr y s by exact: ler_normD. suff : repr (x + y) = repr x + repr y %[mod V]. @@ -278,7 +290,7 @@ Proof. rewrite /infty_norm /infty_norm0 /= => H. rewrite -(reprK x) -(reprK 0). apply/eqquotP. -rewrite Quotient.equivE inE; apply: funext => x0 /=. +rewrite Quotient.equivE inE; apply: funext => r /=. rewrite /patch; case : ifPn => // /set_mem in_itv. rewrite 2!fctE. have -> : {in K, repr (0 : V) =1 (0 : @continuousFunType R W K setT)}. @@ -286,10 +298,13 @@ have -> : {in K, repr (0 : V) =1 (0 : @continuousFunType R W K setT)}. by rewrite reprK /GRing.zero /= /Quotient.zero /= -lock. - rewrite [LHS]subr0. apply/eqP; rewrite -normr_le0. - have := sup_upper_bound (normr_has_sup x ab). - rewrite H /ubound /=. - apply. - by exists x0. + have [ab|ab] := leP a b. + have := sup_upper_bound (normr_has_sup x ab). + rewrite H /ubound /=. + apply. + by exists r. + move: in_itv; rewrite /= in_itv/= => /andP[ar rb]. + by have := le_trans ar rb; rewrite leNgt ab. - by rewrite inE. Qed. @@ -332,19 +347,35 @@ Lemma infty_norm_pi x : `|\pi_V x| = infty_norm0 x. Proof. by rewrite /Num.norm /= infty_norm_pi0. Qed. Lemma infty_norm_lt (f : V) e : - `| f | < e -> {in `[a, b], forall x : R, `|f x| < e}. + `| f | < e -> {in `[a, b], forall x : R, `|f x| < e}. Proof. rewrite -{1}(reprK f) infty_norm_pi => h x xab. -exact/le_lt_trans/h/infty_norm0_ge. +have [ab|ab] := leP a b. + exact/le_lt_trans/h/infty_norm0_ge. +move: xab; rewrite inE/= in_itv/= => /andP[/le_trans /[apply]]. +by rewrite leNgt ab. Qed. -Lemma infty_norm_leP (f : V) e : - `| f | <= e <-> {in `[a, b], forall x : R, `|f x| <= e}. +Lemma infty_norm_le (f : V) e : + `| f | <= e -> {in `[a, b], forall x : R, `|f x| <= e}. Proof. -split. - rewrite -{1}(reprK f) infty_norm_pi => h x xab. +rewrite -{1}(reprK f) infty_norm_pi => h x xab. +have [ab|ab] := leP a b. exact/le_trans/h/infty_norm0_ge. -by move => h; by rewrite -(reprK f) infty_norm_pi infty_norm0_le. +move: xab; rewrite inE/= in_itv/= => /andP[/le_trans /[apply]]. +by rewrite leNgt ab. +Qed. + +Lemma infty_norm_le2 (f : V) e (e0 : 0 <= e) : + {in `[a, b], forall x : R, `|f x| <= e} -> `| f | <= e. +Proof. +move=> h. +have [ab|ba] := leP a b. + by rewrite -(reprK f) infty_norm_pi infty_norm0_le. +rewrite [leLHS](_ : _ = 0)//. +rewrite /Num.norm/= /infty_norm /infty_norm0. +rewrite [X in [set _ | _ in X]](_ : _ = set0) ?image_set0 ?sup0//. +by rewrite set_itv_ge// bnd_simp -ltNge. Qed. Check V : normedZmodType R. @@ -356,12 +387,12 @@ Fail Check (pseudoMetric_normed V) : normedModType R. End zmodule_normed. -Section quot_continuousFunType_normedtype. -Context {R : realType} {W : normedModType R} {r s : R} (rs : r <= s). +Section quot_contSeg_normedtype. +Context {R : realType} {W : normedModType R} {r s : R}. Import ContSeg_quot. -Local Notation V := (@quot_contSeg R W r s rs). +Local Notation V := (@quot_contSeg R r s W). Fail Check (pseudoMetric_normed V) : normedModType R. HB.instance Definition _ := PseudoMetric.copy V (pseudoMetric_normed V). @@ -424,7 +455,7 @@ rewrite !fctE. apply/eqP; rewrite scaler_eq0 (negPf k0)/=. rewrite subr_eq0. apply/eqP. -have := @eqmod_on_itv _ _ _ _ rs (repr (b + c)) (repr b + repr c). +have := @eqmod_on_itv _ _ _ _ (repr (b + c)) (repr b + repr c). move=> ->//. rewrite pi_add//=. by rewrite !reprK. @@ -450,7 +481,7 @@ Proof. move =>ars. have : repr (l *: x) = l *: repr x %[mod V]. by case: piP. -move/(@eqmod_on_itv _ _ _ _ rs (repr (l *: x)) (l *: repr x)). +move/(@eqmod_on_itv _ _ _ _ (repr (l *: x)) (l *: repr x)). by move/(_ _ ars). Qed. @@ -459,6 +490,16 @@ Lemma is_pmnormedZmod_contFunBallType : Proof. constructor => l x. rewrite /Num.norm/= /infty_norm /infty_norm0 /=. +have [rs|sr] := leP r s; last first. + rewrite /=. + have rs1 : `[r, s] = set0 by rewrite set_itv_ge// bnd_simp -ltNge. + rewrite (_ : [set (normr \o repr x) x0 | x0 in `[r, s]] = set0); last first. + rewrite -(image_set0 (normr \o repr x)). + by rewrite -rs1. + rewrite (_ : [set (normr \o repr (l *: x)) x0 | x0 in `[r, s]] = set0); last first. + rewrite -(image_set0 (normr \o repr (l *: x))). + by rewrite -rs1. + by rewrite !sup0 mulr0. apply/eqP; rewrite eq_le; apply/andP; split. apply: ge_sup. exists `|repr (l *: x) r|, r => //=. @@ -481,7 +522,7 @@ by rewrite normrZ. Qed. HB.instance Definition _ := is_pmnormedZmod_contFunBallType. -End quot_continuousFunType_normedtype. +End quot_contSeg_normedtype. From mathcomp Require Import all_algebra. From mathcomp Require Import matrix_topology. @@ -489,11 +530,10 @@ From mathcomp Require Import matrix_topology. Section completeness. Context {R : realType} {W : completeNormedModType R}. Variables a b : R. -Hypothesis ab : a <= b. Import ContSeg_quot. -Notation V := (@quot_contSeg R W _ _ ab). +Notation V := (@quot_contSeg R a b W). Check (V : pseudoMetricType R). Check (V : normedModType R). @@ -554,14 +594,17 @@ have : ball f (e /2 ) g. rewrite /ball /= /pseudoMetric_from_normedZmodType.ball /=. rewrite distrC. rewrite -quot_contSeg_fctB//. -by move/ltW/infty_norm_leP; exact. +by move/ltW/infty_norm_le; exact. Unshelve. all: by end_near. Qed. Lemma lim_fun_cont (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : {within `[a, b], continuous (@lim_fun F FF Fc)}. Proof. -move: ab; rewrite le_eqVlt => /predU1P[<-| ab']. - by rewrite set_itv1; exact: continuous_subspace1. +have [ab|] := ltP a b; last first. + rewrite le_eqVlt => /predU1P[<-| ab']. + by rewrite set_itv1; exact: continuous_subspace1. + rewrite set_itv_ge// ?bnd_simp -?ltNge//. + exact: continuous_subspace0. have H (e : R) : e > 0 -> forall t, t \in `[a, b] -> \forall t' \near t, t' \in `[a, b] -> `|lim_fun FF Fc t - lim_fun FF Fc t'| <= e. @@ -569,7 +612,7 @@ have H (e : R) : e > 0 -> forall t, t \in `[a, b] -> near F => f. have lim_fune2 : forall u, u \in `[a, b] -> `|lim_fun FF Fc u - f u| <= e / 2. by near: f; apply: lim_fun_cvg_uniform => //; rewrite divr_gt0. - move/(continuous_within_itvP _ ab') : (@cts_fun _ _ f ) => [mc lc rc]. + move/(continuous_within_itvP _ ab) : (@cts_fun _ _ f ) => [mc lc rc]. move: (tab). rewrite -{1}setUitv1/=; last by rewrite bnd_simp ltW. rewrite -{1}setU1itv/=; last by rewrite bnd_simp. @@ -581,7 +624,7 @@ have H (e : R) : e > 0 -> forall t, t \in `[a, b] -> + rewrite -(subrKA (f t') (f a)). rewrite (le_trans (ler_normD _ _))// (splitr (e/2)) lerD//. * move: t'ab. - rewrite -{1}setU1itv/=; last by rewrite bnd_simp. + rewrite -{1}setU1itv/=; last by rewrite bnd_simp ltW. rewrite inE/= in_itv/= => -[-> | ]. by rewrite subrr normr0 ltW// !divr_gt0. near: t'. @@ -658,7 +701,7 @@ HB.instance Definition _ F FF Fc := Fail Check (V : completeType). -Lemma cvg_V_entourageP (F : set_system V) (FF : Filter F) (f : V) : +Lemma cvg_V_entourageP (F : set_system V) (FF : Filter F) (f : V) : F --> f <-> forall A, entourage A -> \forall g \near F, {in `[a, b], forall t : R, A (f t, (g : V) t)}. Proof. @@ -676,8 +719,10 @@ apply/cvg_entourageP => /= A [e e0 sPA]. have e20 : 0 < e / 2 by rewrite divr_gt0. have e2 : e / 2 < e by rewrite gtr_pMr// invf_lt1// ltr1n. near=> g. -apply: sPA. -apply/le_lt_trans/e2/infty_norm_leP => /= t tab. +apply: sPA => /=. +apply/le_lt_trans/e2. +apply/infty_norm_le2; first exact: ltW. +move => //= t tab. rewrite quot_contSeg_fctB// ltW//. suff: ball (f t) (e / 2) (g t) by rewrite -ball_normE. move: t tab. diff --git a/ode_wip.v b/ode_wip.v index ad404cb5..bb94ebbd 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -57,7 +57,8 @@ Lemma lipschitzT_solution : is_sol_on phi u0 a (BLeft (a + delta_max)) lipschitzT_solution_f. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. -- exact: ltDl_delta_max. +- by rewrite gt_eqF. +- by rewrite ltDl_delta_max. - move=> t td. apply: lip2'. by apply: subset_itvl td; rewrite bnd_simp -lerBrDl delta_max_itv. From c2cf8ac8873ec74c348acc6e6e153ac3d70ae982 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 14 Feb 2026 16:54:24 +0900 Subject: [PATCH 113/144] delta_max -> safe_dist --- ode.v | 289 +++++++++++++++++++++++++-------------------------- ode_common.v | 8 +- ode_wip.v | 57 +++++----- 3 files changed, 172 insertions(+), 182 deletions(-) diff --git a/ode.v b/ode.v index fe07163a..d111de2c 100644 --- a/ode.v +++ b/ode.v @@ -34,13 +34,13 @@ Require Import ode_common ode_contfun. (* *) (* Technical constants need for the proof: *) (* sup_phi == sup {phi t u0 | t \in [a, b]} *) -(* delta_max == min (b - a, r / (k * r + sup_phi), rho / k) *) +(* safe_dist == min (b - a, r / (k * r + sup_phi), rho / k) *) (* upper-bound of delta *) -(* The dependence of delta_max on the initial state u0 comes *) +(* The dependence of safe_dist on the initial state u0 comes *) (* from sup_phi in the second term. *) -(* @img_cball R n f a b k ab u0 r k0 rho == *) -(* set of functions of type (quot_continuousFunType (leDl_delta_max ...)) *) -(* s.t. f @` `[a, a + delta_max] `<=` closed_ball u0 r *) +(* @img_cball R n f a b k u0 r k0 rho == *) +(* set of functions of type (quot_conSet a b U) s.t. *) +(* f @` `[a, a + safe_dist] `<=` closed_ball u0 r *) (* *) (* picard == similar to picard_fun *) (* as a function from/to the quotient of functions continuous over `[a, b] *) @@ -80,7 +80,7 @@ split; rewrite /derivable_mx /derivable. apply/cvgrPdist_le => /= e e0. near=> x. rewrite /Num.Def.normr/= mx_normrE. - apply: (bigmax_le _ (ltW e0)) => /= i _. + apply: (bigmax_le _ (ltW e0)) => /= i _. rewrite !mxE/=. move: i. near: x. @@ -580,7 +580,7 @@ Qed. End sup_phi_lemmas. -Section delta_max. +Section safe_dist. Context {R : realType} {n : nat}. Let U := 'rV[R]_n. Variables (phi : R -> U -> U) (a b : R) (k : R). @@ -591,26 +591,26 @@ Variable rho : {posnum R}. (* rho < 1 *) Local Notation sup_phi := (sup_phi phi a b u0). -Definition delta_max := Num.min (b - a) +Definition safe_dist := Num.min (b - a) (Num.min (r%:num / (k * r%:num + sup_phi)) (rho%:num / k)). -Lemma delta_max_gt0 : 0 < delta_max. +Lemma safe_dist_gt0 : 0 < safe_dist. Proof. rewrite lt_min subr_gt0 ab/= lt_min mulr_gt0 ?divr_gt0//. by rewrite invr_gt0// ltr_wpDr ?sup_phi_ge0// mulr_gt0. Qed. -Lemma ltDl_delta_max : a < a + delta_max. -Proof. by rewrite ltrDl delta_max_gt0. Qed. +Lemma ltDl_safe_dist : a < a + safe_dist. +Proof. by rewrite ltrDl safe_dist_gt0. Qed. -Lemma leDl_delta_max : a <= a + delta_max. -Proof. by rewrite ltW// ltDl_delta_max. Qed. +Lemma leDl_safe_dist : a <= a + safe_dist. +Proof. by rewrite ltW// ltDl_safe_dist. Qed. -Lemma delta_max_itv : delta_max <= b - a. -Proof. by rewrite /delta_max ge_min lexx. Qed. +Lemma safe_dist_itv : safe_dist <= b - a. +Proof. by rewrite /safe_dist ge_min lexx. Qed. -End delta_max. +End safe_dist. Section image_in_closed_ball. Context {R : realType} {n : nat}. @@ -622,57 +622,55 @@ Variable rho : {posnum R}. (* rho < 1 *) Import ContSeg_quot. -Local Notation delta_max := (@delta_max R n phi a b k u0 r rho). - -Local Notation V := (@quot_contSeg R a (a + delta_max) U). +Local Notation safe_dist := (@safe_dist R n phi a b k u0 r rho). +Local Notation V := (@quot_contSeg R a (a + safe_dist) U). Definition img_cball : set V := - [set f : V | f @` `[a, a + delta_max] `<=` closed_ball u0 r%:num]. + [set f : V | f @` `[a, a + safe_dist] `<=` closed_ball u0 r%:num]. Lemma img_cball_nonempty : img_cball !=set0. Proof. exists (pi V (cst u0)) => _ [y aay] <-. -suff -> : fun_of_quot_contSeg (\pi_(V)%qT (cst u0)) y = u0. +suff -> : fun_of_quot_contSeg (\pi_V%qT (cst u0)) y = u0. exact: closed_ballxx. rewrite /fun_of_quot_contSeg/=. -have /eqmod_on_itv : (repr (\pi_(V)%qT (cst u0)) = cst u0 %[mod V])%qT. +have /eqmod_on_itv : (repr (\pi_V%qT (cst u0)) = cst u0 %[mod V])%qT. by rewrite reprK. by apply; rewrite inE. Qed. -Lemma img_cballE (ab : a < b) : img_cball = - @closed_ball R V (pi V (@cst (subspace `[a, a + delta_max]) U u0)) r%:num. +Lemma img_cballE : a < b -> img_cball = + @closed_ball R V (pi V (@cst (subspace `[a, a + safe_dist]) U u0)) r%:num. Proof. -rewrite closed_ballE//. -rewrite /img_cball. -apply: eq_set => /= f'; apply propext; split => h. -- rewrite -(@reprK _ V f'). +move=> ab; rewrite closed_ballE//. +apply: eq_set => /= f; apply propext; split => h. +- rewrite -(@reprK _ V f). rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. - rewrite infty_norm_pi infty_norm0_le //=. - by rewrite /= lerDl ltW// delta_max_gt0. + rewrite infty_norm_pi infty_norm0_le//. + by rewrite /= lerDl ltW// safe_dist_gt0. move=> x adx. - move /(_ (f' x)) : h. + move /(_ (f x)) : h. rewrite closed_ballE//. apply. exists x => //. by rewrite inE in adx. - move => _ [x xad] <-. rewrite closed_ballE// /closed_ball_ /=. - have -> : u0 - f' x = ((pi V (cst u0)) - f' : V) x. - rewrite -(@reprK _ V f') /GRing.opp /=. + have -> : u0 - f x = ((pi V (cst u0)) - f : V) x. + rewrite -(@reprK _ V f) /GRing.opp /=. rewrite -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. by rewrite !eval_mod_on_itv// inE. - rewrite -(@reprK _ V f'). + rewrite -(@reprK _ V f). rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. rewrite eval_mod_on_itv; last by rewrite inE. rewrite -inE in xad. - apply: (le_trans (infty_norm0_ge (leDl_delta_max phi ab u0 r k0 rho) _ xad)). + apply: (le_trans (infty_norm0_ge (leDl_safe_dist phi ab u0 r k0 rho) _ xad)). rewrite -infty_norm_pi. by rewrite Quotient.pi_add Quotient.pi_opp reprK. Qed. -Lemma closed_img_cball (ab : a < b) : closed img_cball. -Proof. by rewrite img_cballE//; exact: closed_ball_closed. Qed. +Lemma closed_img_cball : a < b -> closed img_cball. +Proof. by move=> ?; rewrite img_cballE//; exact: closed_ball_closed. Qed. End image_in_closed_ball. @@ -687,37 +685,36 @@ Hypothesis k0 : k != 0. Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. -Variable rho : {posnum R}. (* rho < 1 *) +Variable rho : {posnum R}. -Local Notation delta_max := (delta_max phi a b k u0 r rho). +Local Notation safe_dist := (safe_dist phi a b k u0 r rho). -Lemma lip2_delta_max : {in `[a, a + delta_max]%R, forall x, k.-lipschitz_B (phi x)}. +Lemma lip2_safe_dist : {in `[a, a + safe_dist]%R, forall x, k.-lipschitz_B (phi x)}. Proof. -(* TODO: generalize to the subset relation *) move/in_switch : lip2 => lip2'. apply/in_switch. apply: lipschitzW lip2'. apply: subset_itvl. -by rewrite bnd_simp -lerBrDl; exact: delta_max_itv. +by rewrite bnd_simp -lerBrDl; exact: safe_dist_itv. Qed. -Lemma cont1_delta_max : - {in B, forall y, {within `[a, a + delta_max], continuous phi ^~ y}}. +Lemma cont1_safe_dist : + {in B, forall y, {within `[a, a + safe_dist], continuous phi ^~ y}}. Proof. move=> /= x xB. apply: continuous_subspaceW; last exact: cont1. apply: subset_itvl. -by rewrite bnd_simp -lerBrDl; exact: delta_max_itv. +by rewrite bnd_simp -lerBrDl; exact: safe_dist_itv. Qed. Local Notation picard_fun := - (@picard_fun _ n phi a (a + delta_max) u0 r k k0 lip2_delta_max cont1_delta_max). + (@picard_fun _ n phi a (a + safe_dist) u0 r k k0 lip2_safe_dist cont1_safe_dist). -Lemma picard_funE g t : g @` `[a, a + delta_max] `<=` B -> +Lemma picard_funE g t : g @` `[a, a + safe_dist] `<=` B -> picard_fun g t = u0 + \vint[mu]_(x in `[a, t]) phi x (g x). Proof. by rewrite /picard_fun; case: pselect. Qed. -Lemma picard_fun_init g : g @` `[a, a + delta_max] `<=` B -> +Lemma picard_fun_init g : g @` `[a, a + safe_dist] `<=` B -> picard_fun g a = u0. Proof. by move => h; rewrite picard_funE// set_itv1 rowRintegral_set1 addr0. @@ -725,15 +722,15 @@ Qed. Import ContSeg_quot. -Local Notation V := (@quot_contSeg R a (a + delta_max) U). +Local Notation V := (@quot_contSeg R a (a + safe_dist) U). Let set_fun_picard_fun (g : V) : - set_fun `[a, a + delta_max] [set: U] (picard_fun g). + set_fun `[a, a + safe_dist] [set: U] (picard_fun g). Proof. by []. Qed. HB.instance Definition _ (g : V) := @isFun.Build - (subspace `[a, a + delta_max]) _ - `[a, a + delta_max] setT (picard_fun g) (set_fun_picard_fun g). + (subspace `[a, a + safe_dist]) _ + `[a, a + safe_dist] setT (picard_fun g) (set_fun_picard_fun g). End picard_fun_isFun. @@ -748,22 +745,22 @@ Hypothesis k0 : k != 0. Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. -Variable rho : {posnum R}. (* rho < 1 *) +Variable rho : {posnum R}. -Local Notation delta_max := (delta_max phi a b k u0 r rho). +Local Notation safe_dist := (safe_dist phi a b k u0 r rho). -Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k k0 - (@lip2_delta_max R n phi a b k u0 r lip2 rho) - (@cont1_delta_max R n phi a b k u0 r cont1 rho)). +Local Notation picard_fun := (@picard_fun _ n phi a (a + safe_dist) u0 r k k0 + (@lip2_safe_dist R n phi a b k u0 r lip2 rho) + (@cont1_safe_dist R n phi a b k u0 r cont1 rho)). Import ContSeg_quot. -Local Notation V := (@quot_contSeg R a (a + delta_max) U). +Local Notation V := (@quot_contSeg R a (a + safe_dist) U). Let continuous_picard_fun (g : V) : - {within `[a, a + delta_max], continuous (picard_fun g)}. + {within `[a, a + safe_dist], continuous (picard_fun g)}. Proof. -have [aaD|] := ltP a (a + delta_max); last first. +have [aaD|] := ltP a (a + safe_dist); last first. rewrite le_eqVlt => /predU1P[aaD|aaD]. rewrite [X in {within X, continuous _}](_ : _ = [set a]); last first. by rewrite aaD set_itv1. @@ -773,14 +770,12 @@ have [aaD|] := ltP a (a + delta_max); last first. have := @cts_fun _ _ g. rewrite /picard_fun; case: pselect => /=. move => z cg. - have := (@cts_fun (subspace `[a, a + delta_max]) U (picard_fun_subdef phi z)). - apply. - + exact: k0. - + exact : lip2_delta_max. - + exact : cont1_delta_max. - + exact : cg. -move=> _ _. -by apply: continuous_subspaceT => z; exact: cvg_cst. + apply: (@cts_fun (subspace `[a, a + safe_dist]) U (picard_fun_subdef phi z)). + - exact: k0. + - exact: lip2_safe_dist. + - exact: cont1_safe_dist. + - exact: cg. +by move=> _ _; apply: continuous_subspaceT => z; exact: cvg_cst. Qed. HB.instance Definition _ (g : V) := @isContinuous.Build _ _ @@ -793,9 +788,9 @@ Check fun g : V => (\pi_(V)%qT (picard_fun g)) : V. End picard_fun_isContinuous. Section integrable_comp. +Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. Let U := 'rV[R]_n. -Local Notation mu := lebesgue_measure. Variables (phi : R -> U -> U) (a b : R) (k : R). Variables (u0 : U) (r : {posnum R}). Let B := closed_ball u0 r%:num. @@ -803,32 +798,30 @@ Hypothesis k0 : k != 0. Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. -Variable rho : {posnum R}. (* rho < 1 *) +Variable rho : {posnum R}. -Local Notation delta_max := (delta_max phi a b k u0 r rho). +Local Notation safe_dist := (safe_dist phi a b k u0 r rho). Import ContSeg_quot. -Local Notation V := (@quot_contSeg R a (a + delta_max) U). +Local Notation V := (@quot_contSeg R a (a + safe_dist) U). -Lemma integrable_comp (F : V) y : y \in `[a, a + delta_max]%R -> +Lemma integrable_comp (F : V) y i : y \in `[a, a + safe_dist]%R -> F @` `[a, y] `<=` B -> - forall i, mu.-integrable `[a, y] (EFin \o (fun t => phi t (F t) ord0 i)). Proof. -move => yaadelta ab0r i. +move=> yaadelta ab0r. apply: continuous_compact_integrable; first exact: segment_compact. -move: (yaadelta); rewrite in_itv/= => /andP[ay yadelta]. -move: i. -apply/within_continuous_coord. +move: (yaadelta); rewrite in_itv/= => /andP[ay yadelta]. +move: i; apply/within_continuous_coord. apply/(within_continuous_lipschitz _ k0). - have := @cts_fun _ _ F. by apply/continuous_subspaceW/subset_itvl; rewrite bnd_simp. - apply/in_switch. - move/in_switch : (@lip2_delta_max R n phi a b k u0 r lip2 rho). + move/in_switch : (@lip2_safe_dist R n phi a b k u0 r lip2 rho). by apply/lipschitzW/subset_itvl; rewrite bnd_simp. - rewrite -/B => x xB. - have := @cont1_delta_max R n phi a b k u0 r cont1 rho _ xB. + have := @cont1_safe_dist R n phi a b k u0 r cont1 rho _ xB. by apply/continuous_subspaceW/subset_itvl; rewrite bnd_simp. - exact: ab0r. Qed. @@ -932,22 +925,20 @@ Let k0' : k != 0. Proof. by rewrite gt_eqF. Qed. Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. -Variable rho : {posnum R}. (* rho < 1 *) - -Local Notation delta_max := (delta_max phi a b k u0 r rho). +Variable rho : {posnum R}. -Local Notation picard_fun := (@picard_fun _ n phi a (a + delta_max) u0 r k k0' - (@lip2_delta_max R n phi a b k u0 r lip2 rho) - (@cont1_delta_max R n phi a b k u0 r cont1 rho)). +Local Notation safe_dist := (safe_dist phi a b k u0 r rho). +Local Notation picard_fun := (@picard_fun _ n phi a (a + safe_dist) u0 r k k0' + (@lip2_safe_dist R n phi a b k u0 r lip2 rho) + (@cont1_safe_dist R n phi a b k u0 r cont1 rho)). Import ContSeg_quot. -Local Notation V := (@quot_contSeg R a (a + delta_max) U). +Local Notation V := (@quot_contSeg R a (a + safe_dist) U). Definition picard (f : V) : V := \pi_V%qT (picard_fun f). Local Notation img_cball := (@img_cball R n phi a b k u0 r rho). - Local Notation sup_phi := (@sup_phi R n phi a b u0). Let set_fun_picard : set_fun img_cball img_cball picard. @@ -989,14 +980,14 @@ have integrable1 : mu.-integrable `[a, y] rewrite integrableN //=. apply: continuous_compact_integrable => //=; first exact: segment_compact. apply within_continuous_coord. - apply/continuous_subspaceW/(@cont1_delta_max R n phi a b k u0 r cont1 rho). + apply/continuous_subspaceW/(@cont1_safe_dist R n phi a b k u0 r cont1 rho). apply: subset_itvl; rewrite bnd_simp. by move : yaaDelta;rewrite in_itv /= => /andP[]. by rewrite /B inE; exact: closed_ballxx. apply integrable_norm => /=. apply continuous_compact_integrable => //=; first exact: segment_compact. apply within_continuous_coord. - apply/continuous_subspaceW/(@cont1_delta_max R n phi a b k u0 r cont1 rho). + apply/continuous_subspaceW/(@cont1_safe_dist R n phi a b k u0 r cont1 rho). apply: subset_itvl; rewrite bnd_simp. by move : yaaDelta;rewrite in_itv /= => /andP[]. rewrite /B inE. @@ -1035,11 +1026,11 @@ rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * `|F x - u0| + sup_phi)))//. exact: bounded_cst. move=> x xay. rewrite lerD//. - have xaaDelta : x \in `[a, a + delta_max]%R. + have xaaDelta : x \in `[a, a + safe_dist]%R. move: x xay. apply: subset_itvl; rewrite bnd_simp. by rewrite (itvP yaaDelta). - move/(lip2_delta_max lip2) : xaaDelta. + move/(lip2_safe_dist lip2) : xaaDelta. rewrite lipschitz_componentE//; last exact: ltW. move/(_ i (F x, u0)) => /=. apply. @@ -1075,7 +1066,7 @@ rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * `|F x - u0| + sup_phi)))//. move/le_trans; apply. move : yaaDelta; rewrite in_itv /= => /andP[]. move => _ /le_trans; apply. - by rewrite -lerBrDl delta_max_itv. + by rewrite -lerBrDl safe_dist_itv. rewrite (@le_trans _ _ (\int[mu]_(x in `[a, y]) (k * r%:num + sup_phi)))//. apply: le_Rintegral => //=. - under [x in integrable _ _ x]eq_fun do rewrite EFinD. @@ -1123,7 +1114,7 @@ rewrite lte_fin. move: (yaaDelta); rewrite in_itv/= => /andP[+ yadelta]. rewrite le_eqVlt => /predU1P[->|ay]. by rewrite ltxx/= mulr0. -rewrite (@le_trans _ _ ((k * r%:num + sup_phi) * delta_max))//. +rewrite (@le_trans _ _ ((k * r%:num + sup_phi) * safe_dist))//. rewrite ler_wpM2l//. by rewrite addr_ge0 ?mulr_ge0 ?(ltW k0)// sup_phi_ge0. by rewrite ay//= lerBlDl. @@ -1206,16 +1197,16 @@ Hypothesis rho1 : (rho%:num < 1). Import ContSeg_quot. -Local Notation delta_max := (delta_max phi a b k u0 r rho). +Local Notation safe_dist := (safe_dist phi a b k u0 r rho). -Notation V := (@quot_contSeg R a (a + delta_max) U). +Notation V := (@quot_contSeg R a (a + safe_dist) U). Notation img_cball := (@img_cball _ n phi a b k u0 r rho). -Check @cst (subspace `[a, a + delta_max]) U u0 - : {fun `[a, a + delta_max] >-> [set: U]}. +Check @cst (subspace `[a, a + safe_dist]) U u0 + : {fun `[a, a + safe_dist] >-> [set: U]}. -Check @cst (subspace `[a, a + delta_max]) U u0 - : continuousType (subspace `[a, a + delta_max]) U. +Check @cst (subspace `[a, a + safe_dist]) U u0 + : continuousType (subspace `[a, a + safe_dist]) U. Local Notation picard := (@picard R n phi a b k u0 r k0 lip2 cont1 rho). @@ -1231,13 +1222,13 @@ rewrite infty_norm_pi/=. rewrite /infty_norm0/=. apply: ge_sup => //=. set u := _ \o _; exists (u a) => /=; exists a => //. - by rewrite in_itv/= lexx leDl_delta_max. + by rewrite in_itv/= lexx leDl_safe_dist. move=> _ /= [t tNdd <-]. have tb : t <= b. move: tNdd. rewrite in_itv/= => /andP[Ndt]. move=> /le_trans; apply. - by rewrite -lerBrDl; exact: delta_max_itv. + by rewrite -lerBrDl; exact: safe_dist_itv. rewrite /picard_fun/=; case: pselect => //= Hg; case: pselect => [Hg2|//]. rewrite /picard_fun_subdef/=. rewrite !fctE. @@ -1322,14 +1313,14 @@ rewrite (@le_trans _ _ (k * \int[mu]_(t0 in `[a, t]) `|x - y| ))//. by rewrite -EFinD ltry. exact: bounded_cst. move=> x0 x0at. - have x0ad : x0 \in `[a, a + delta_max]. + have x0ad : x0 \in `[a, a + safe_dist]. rewrite inE/=. apply: subset_itvl x0at; rewrite bnd_simp. by move: tNdd; rewrite in_itv/= => /andP[]. have -> : x x0 - y x0 = (x - y : V) x0. apply (@eqmod_on_itv _ _ _ _ (repr x - repr y)) => //. by rewrite Quotient.pi_add Quotient.pi_opp !reprK. - by rewrite infty_norm0_ge// leDl_delta_max. + by rewrite infty_norm0_ge// leDl_safe_dist. rewrite (@le_trans _ _ (k * `|x - y| * (t - a)))//. rewrite -mulrA ler_wpM2l//; first exact: ltW. rewrite Rintegral_cst// ler_pM//. @@ -1340,7 +1331,7 @@ rewrite (@le_trans _ _ (k * `|x - y| * (t - a)))//. rewrite [leLHS]mulrAC ler_wpM2r//. move: tNdd; rewrite in_itv/= => /andP[Ndt]. rewrite -lerBlDl. -rewrite /delta_max !le_min => /andP[_ /andP[_]]. +rewrite /safe_dist !le_min => /andP[_ /andP[_]]. by rewrite ler_pdivlMr// mulrC. Qed. @@ -1520,8 +1511,8 @@ Check U : completePseudoMetricType R. Check U : normedModType R. Check U : completeNormedModType R. -Local Notation delta_max := (@delta_max R n phi a b k u0 r rho). -Local Notation V := (@quot_contSeg R a (a + delta_max) U). +Local Notation safe_dist := (@safe_dist R n phi a b k u0 r rho). +Local Notation V := (@quot_contSeg R a (a + safe_dist) U). Check V : completeNormedModType _. @@ -1552,17 +1543,17 @@ Lemma picard_fix_init : picard_fix a = u0. Proof. rewrite picard_fixE eval_mod_on_itv. by rewrite /picard_fun /= picard_fun_init//; exact: img_cball_picard_fix. -by rewrite inE/= in_itv/= lexx leDl_delta_max. +by rewrite inE/= in_itv/= lexx leDl_safe_dist. Qed. -Lemma picardE g t : img_cball g -> t \in `[a, a + delta_max] -> +Lemma picardE g t : img_cball g -> t \in `[a, a + safe_dist] -> picard g t = u0 + \vint[mu]_(x in `[a, t]) phi x (g x). Proof. by move=> Hg taad; rewrite eval_mod_on_itv//; exact: picard_funE. Qed. Lemma cauchy_lipschitz_integral_version : - is_integral_sol_on phi u0 a (a + delta_max) picard_fix. + is_integral_sol_on phi u0 a (a + safe_dist) picard_fix. Proof. split; first exact: picard_fix_init. move=> t tad. @@ -1572,7 +1563,7 @@ exact: picard_funE img_cball_picard_fix. Qed. Theorem cauchy_lipschitz_unique (picard_fix' : V) : img_cball picard_fix' -> - (forall t, t \in `[a, a + delta_max] -> + (forall t, t \in `[a, a + safe_dist] -> picard_fix' t = u0 + \vint[mu]_(x in `[a, t]) phi x (picard_fix' x)) -> picard_fix = picard_fix'. Proof. @@ -1595,7 +1586,7 @@ by rewrite h// subrr. Qed. Theorem cauchy_lipschitz_existence : picard_fix a = u0 /\ - {in `]a, a + delta_max[, forall x, picard_fix^`() x = phi x (picard_fix x)}. + {in `]a, a + safe_dist[, forall x, picard_fix^`() x = phi x (picard_fix x)}. Proof. split; first exact: picard_fix_init. move => t tad. @@ -1604,21 +1595,21 @@ apply/rowP => j. suff -> : (picard picard_fix)^`() t = (fun t => u0 + \vint[mu]_(x in `[a, t]) phi x (picard_fix x))^`() t. move: (tad); rewrite inE /= in_itv /= => /andP[ta tadelta]. - have Fint i : mu.-integrable `[a, a + delta_max] + have Fint i : mu.-integrable `[a, a + safe_dist] (EFin \o (fun x => phi x (picard_fix x) ord0 i)). apply: integrable_comp => //. - by rewrite in_itv /= lexx andbT leDl_delta_max. + by rewrite in_itv /= lexx andbT leDl_safe_dist. exact: img_cball_picard_fix. have Fcont i : {for t, continuous (fun x => phi x (picard_fix x) ord0 i)}. move: tad; rewrite inE. apply/within_continuous_continuous => //=. - exact: ltDl_delta_max. + exact: ltDl_safe_dist. clear Fint. move: i; apply/within_continuous_coord. apply: (@within_continuous_lipschitz _ _ _ a _ u0 r _ _ _ k0'). + exact: cts_fun. - + exact: lip2_delta_max. - + exact: cont1_delta_max. + + exact: lip2_safe_dist. + + exact: cont1_safe_dist. + exact: img_cball_picard_fix. have [H1 H2] := @continuous_FTC1_closed _ (fun x => phi x (picard_fix x) ord0 j) a t _ tadelta (Fint j) ta (Fcont j). @@ -1645,7 +1636,7 @@ rewrite -(@picard_funE _ _ _ a b k _ r k0' lip2 cont1 rho)//=. exact: img_cball_picard_fix. Qed. -Lemma cauchy_lipschitz_in_cball (t : R) : `[a, a + delta_max] t -> +Lemma cauchy_lipschitz_in_cball (t : R) : `[a, a + safe_dist] t -> closed_ball u0 r%:num (picard_fix t). Proof. by move=> taad; apply: img_cball_picard_fix => /=; exists t. Qed. @@ -1775,20 +1766,20 @@ Hypothesis rho1 : rho%:num < 1. Definition local_solution := repr (picard_fix ab k0 lip2 cont1 rho1). -Local Notation delta_max := (delta_max phi a b k u0 r rho). +Local Notation safe_dist := (safe_dist phi a b k u0 r rho). -Lemma solution_local_solution : is_sol_on phi u0 a (BLeft (a + delta_max)) local_solution. +Lemma solution_local_solution : is_sol_on phi u0 a (BLeft (a + safe_dist)) local_solution. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. -- by rewrite ltDl_delta_max. +- by rewrite ltDl_safe_dist. - move=> t td. apply: lip2. move: td; rewrite /=!in_itv/= => /andP [-> h] /=. - by rewrite (le_trans h)// -lerBrDl; exact: delta_max_itv. + by rewrite (le_trans h)// -lerBrDl; exact: safe_dist_itv. - move=> /= x xB . apply/continuous_subspaceW/cont1 => //. apply: subset_itvl => //=. - by rewrite bnd_simp -lerBrDl delta_max_itv. + by rewrite bnd_simp -lerBrDl safe_dist_itv. - rewrite /local_solution. exact: cts_fun. - by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. @@ -1796,50 +1787,50 @@ apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. Qed. Lemma solution_stays_in_ball : - {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (local_solution t)}. + {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (local_solution t)}. Proof. by move=> t; rewrite inE => /cauchy_lipschitz_in_cball; exact. Qed. Lemma solution_continuous : - {within `[a, a + delta_max], continuous local_solution}. + {within `[a, a + safe_dist], continuous local_solution}. Proof. exact: cts_fun. Qed. Definition cauchy_lipschitz_local_f : - continuousFunType `[a, a + delta_max] [set: 'rV[R]_n] := + continuousFunType `[a, a + safe_dist] [set: 'rV[R]_n] := repr (picard_fix ab k0 lip2 cont1 rho1). Let f := cauchy_lipschitz_local_f. Theorem cauchy_lipschitz_local : - delta_max > 0 /\ - is_sol_on phi u0 a (BLeft (a + delta_max)) f /\ - {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f t)}. + safe_dist > 0 /\ + is_sol_on phi u0 a (BLeft (a + safe_dist)) f /\ + {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (f t)}. Proof. -split; first exact: delta_max_gt0. +split; first exact: safe_dist_gt0. split. - exact: solution_local_solution. - exact: solution_stays_in_ball. Qed. -Local Notation V := (@ContSeg_quot.quot_contSeg R a (a + delta_max) U). +Local Notation V := (@ContSeg_quot.quot_contSeg R a (a + safe_dist) U). Theorem cauchy_lipschitz_local_unique f' : - {within `[a, a + delta_max], continuous f'} -> - {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f' t)} -> - is_sol_on phi u0 a (BLeft (a + delta_max)) f' -> - {in `[a, a + delta_max], f =1 f'}. + {within `[a, a + safe_dist], continuous f'} -> + {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (f' t)} -> + is_sol_on phi u0 a (BLeft (a + safe_dist)) f' -> + {in `[a, a + safe_dist], f =1 f'}. Proof. move => cont bnd. move/(@integral_sol_iff_sol _ _ _ _ _ _ _ _ r k0') => []//. -- exact: ltDl_delta_max. +- exact: ltDl_safe_dist. - move=> t td. apply: lip2. - by apply: subset_itvl td; rewrite bnd_simp -lerBrDl delta_max_itv. + by apply: subset_itvl td; rewrite bnd_simp -lerBrDl safe_dist_itv. - move=> /= x xB. apply/continuous_subspaceW/cont1 => //. - by apply: subset_itvl => //=; rewrite bnd_simp -lerBrDl delta_max_itv. + by apply: subset_itvl => //=; rewrite bnd_simp -lerBrDl safe_dist_itv. - by move => _ [t tad] <-;apply bnd;rewrite inE. move=> f'au0 h1 t tab. -have fc : contseg a (a + delta_max) f' by exact: mem_set. +have fc : contseg a (a + safe_dist) f' by exact: mem_set. have pieq : \pi_V%qT f = \pi_V%qT (contseg_Sub fc). rewrite reprK. apply: cauchy_lipschitz_unique. @@ -1918,7 +1909,7 @@ Hypothesis cf : {within `[a, b], continuous f}. Hypothesis sol1 : is_sol_on phi u0 a (BLeft b) f. Let rho_max : {posnum R} := (2^-1)%:pos. -Let dmax rho := delta_max phi a b k u0 r rho. +Let dmax rho := safe_dist phi a b k u0 r rho. Let fc := local_solution ab k0 lip2 cont1. Lemma initial_solution_unique f' : {within `[a, b], continuous f'} -> @@ -1938,7 +1929,7 @@ suff [rho [Delta [Hrho [Db P1 P2]]]] : exists rho Delta : {posnum R}, exists (Hr have [d1 D1] := continuous_confined r ab cf (And31 sol1). have [d2 D2] := continuous_confined r ab cf' (And31 sol2). have [rho [drho1 drho2]] : exists rho, dmax rho <= (Num.min d1%:num d2%:num) /\ rho%:num < 1. - rewrite /dmax/delta_max. + rewrite /dmax/safe_dist. have posk : 0 < Num.min rho_max%:num (Num.min (k * rho_max%:num) (k * (Num.min d1%:num d2%:num))). by rewrite lt_min/= invr_gt0// ltr0n/= lt_min divr_gt0//= mulr_gt0. exists (PosNum posk); split => //=. @@ -1948,13 +1939,13 @@ have [rho [drho1 drho2]] : exists rho, dmax rho <= (Num.min d1%:num d2%:num) /\ apply/orP; right. by rewrite mulrAC divff ?mul1r// gt_eqF//. by rewrite gt_min; apply/orP; left; rewrite invf_lt1// ltr1n. -have drho_pos : 0 < dmax rho by exact: delta_max_gt0. +have drho_pos : 0 < dmax rho by exact: safe_dist_gt0. exists rho, (PosNum drho_pos), drho2; split => //. - move => t tad. apply/esym; apply: cauchy_lipschitz_local_unique. - apply/continuous_subspaceW/cf => //. apply: subset_itvl => //=. - by rewrite bnd_simp -lerBrDl;apply delta_max_itv. + by rewrite bnd_simp -lerBrDl;apply safe_dist_itv. - move=> t0 t0ad. suff : f t0 \in closed_ball u0 r%:num by rewrite inE. apply D1. @@ -1963,15 +1954,15 @@ exists rho, (PosNum drho_pos), drho2; split => //. - split; first by apply sol1. move=> t0 t0ad. have [_ + _] := sol1; apply. - by move: t0ad; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp -lerBrDl delta_max_itv. + by move: t0ad; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp -lerBrDl safe_dist_itv. - apply: continuous_subspaceW cf. apply: subset_trans; first exact: itv_closure. - by apply: subset_itvl; rewrite bnd_simp -lerBrDl delta_max_itv. + by apply: subset_itvl; rewrite bnd_simp -lerBrDl safe_dist_itv. - exact: tad. move => t tad. apply/esym; apply : cauchy_lipschitz_local_unique. - apply/continuous_subspaceW/cf' => //. - by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl;apply delta_max_itv. + by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl;apply safe_dist_itv. - move=> t0 t0ad. suff : f' t0 \in closed_ball u0 r%:num by rewrite inE. apply D2. @@ -1980,10 +1971,10 @@ apply/esym; apply : cauchy_lipschitz_local_unique. - split; first by apply sol2. move=> t0 t0ad. have [_ + _] := sol2; apply. - by move: t0ad; rewrite !inE; apply: subset_itvl; rewrite bnd_simp -lerBrDl delta_max_itv. + by move: t0ad; rewrite !inE; apply: subset_itvl; rewrite bnd_simp -lerBrDl safe_dist_itv. - apply/continuous_subspaceW/cf' => //. apply: subset_trans; first exact: itv_closure. - by apply: subset_itvl; rewrite bnd_simp -lerBrDl;apply delta_max_itv. + by apply: subset_itvl; rewrite bnd_simp -lerBrDl;apply safe_dist_itv. exact: tad. Qed. @@ -2039,7 +2030,7 @@ have [d0 [solf cball]] := cauchy_lipschitz_local aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho1. exists (@cauchy_lipschitz_local_f R n phi_ a _ k u0 r aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho rho1). -by exists (delta_max phi_ a (a + 1) k u0 r rho). +by exists (safe_dist phi_ a (a + 1) k u0 r rho). Qed. End picard_autonomous. diff --git a/ode_common.v b/ode_common.v index bdaeb9d9..cdbf1e88 100644 --- a/ode_common.v +++ b/ode_common.v @@ -28,15 +28,15 @@ Import numFieldNormedType.Exports. Open Scope ring_scope. Open Scope classical_set_scope. -(* NB: merged to MathComp *) +(* NB: PR to MC *) Lemma gerN {R : numDomainType} (x : R) : 0 <= x -> - x <= x. Proof. by move=> x0; rewrite ge0_cp. Qed. -(* TODO : rename *) +(* TODO: rename, generalize to the subset relation *) Lemma in_switch {R : numDomainType} (I : interval R) P : - {in [set` I],forall x, P x} <-> {in I,forall x, P x}. + {in [set` I], forall x, P x} <-> {in I, forall x, P x}. Proof. -split => [h x xI| h x xI];apply h. +split => [h x xI| h x xI]; apply h. by rewrite inE. by rewrite inE in xI. Qed. diff --git a/ode_wip.v b/ode_wip.v index bb94ebbd..db6380ce 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -48,23 +48,23 @@ Qed. Let cont1' : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Proof. by move=> t tab /=; apply: cont1; rewrite in_setT. Qed. -Local Notation delta_max := (delta_max phi a b k u0 r rho). +Local Notation safe_dist := (safe_dist phi a b k u0 r rho). -Definition lipschitzT_solution_f : continuousFunType `[a, a + delta_max] [set: 'rV[R]_n] := +Definition lipschitzT_solution_f : continuousFunType `[a, a + safe_dist] [set: 'rV[R]_n] := repr (picard_fix ab k0 lip2' cont1' rho1). Lemma lipschitzT_solution : - is_sol_on phi u0 a (BLeft (a + delta_max)) lipschitzT_solution_f. + is_sol_on phi u0 a (BLeft (a + safe_dist)) lipschitzT_solution_f. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. - by rewrite gt_eqF. -- by rewrite ltDl_delta_max. +- by rewrite ltDl_safe_dist. - move=> t td. apply: lip2'. - by apply: subset_itvl td; rewrite bnd_simp -lerBrDl delta_max_itv. + by apply: subset_itvl td; rewrite bnd_simp -lerBrDl safe_dist_itv. - move=> /= x xB. apply/continuous_subspaceW/cont1 => //. - by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl delta_max_itv. + by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl safe_dist_itv. by rewrite inE. - rewrite /local_solution. exact: cts_fun. @@ -73,26 +73,24 @@ apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. Qed. Lemma lipschitzT_solution_stays_in_ball : - {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (lipschitzT_solution_f t)}. + {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (lipschitzT_solution_f t)}. Proof. by move=> t; rewrite inE => /cauchy_lipschitz_in_cball; exact. Qed. Lemma lipschitzT_solution_continuous : - {within `[a, a + delta_max], continuous lipschitzT_solution_f}. + {within `[a, a + safe_dist], continuous lipschitzT_solution_f}. Proof. exact: cts_fun. Qed. Let f := lipschitzT_solution_f. Theorem lipschitzT_cauchy_lipschitz_local : - delta_max > 0 /\ - is_sol_on phi u0 a (BLeft (a + delta_max)) f /\ - {in `[a, a + delta_max], forall t, closed_ball u0 r%:num (f t)} /\ - {within `[a, a + delta_max], continuous f}. + safe_dist > 0 /\ + is_sol_on phi u0 a (BLeft (a + safe_dist)) f /\ + {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (f t)}. Proof. -split; first exact: delta_max_gt0. -split; [| split]. +split; first exact: safe_dist_gt0. +split. - exact: lipschitzT_solution. - exact: lipschitzT_solution_stays_in_ball. -- exact: lipschitzT_solution_continuous. Qed. End cauchy_lipschitzT. @@ -292,32 +290,33 @@ have [barhok|barhok] := leP (b - a) (rho%:num / k). rewrite mulrDr -ltrBrDl -[X in _ < X - _]mul1r (mulrC k). rewrite -mulrBl mulrCA -ltr_pdivrMr; last by rewrite mulr_gt0// subr_gt0. admit. (* for any finite sup_phi, we can choose r large enough so that this holds *) - have delta_maxba : delta_max phi a b k u0 r rho = b - a. - rewrite /delta_max; apply/min_idPl. + have safe_distba : safe_dist phi a b k u0 r rho = b - a. + rewrite /safe_dist; apply/min_idPl. rewrite (le_trans barhok)// le_min lexx andbT -/sup_phi ltW//. apply: Hr. exact: sup_phi_ge0. exists (@lipschitzT_solution_f R n phi a b k u0 r rho rho1 ab k0 lip2 cont1). - have [d0 [[fau0 H1] H2 [H3 H4]]] := + have [d0 [[fau0 H1] H2 H3]] := @lipschitzT_cauchy_lipschitz_local R n phi a b k u0 r rho rho1 ab k0 lip2 cont1. split => //. move=> t tab. apply H1; apply/mem_set. move/set_mem : tab. - by apply: subset_itvl; rewrite bnd_simp delta_maxba subrKC. - apply: continuous_subspaceW H4. + by apply: subset_itvl; rewrite bnd_simp safe_distba subrKC. + apply: continuous_subspaceW H2. apply: subset_trans; first exact: itv_closure. + rewrite closure_neitv_oo ?ltDl_safe_dist//. apply: subset_itvl; rewrite bnd_simp -lerBlDl. - by rewrite delta_maxba. + by rewrite safe_distba. have @r : {posnum R}. admit. have Hr : rho%:num / k < r%:num / ((k * r%:num)%R + sup_phi phi a b u0)%E. admit. -pose delta : R := delta_max phi a b k u0 r rho. -have Hdelta_max : delta = rho%:num / k. - rewrite /delta /delta_max minA; apply/min_idPr. +pose delta : R := safe_dist phi a b k u0 r rho. +have Hsafe_dist : delta = rho%:num / k. + rewrite /delta /safe_dist minA; apply/min_idPr. by rewrite le_min (ltW Hr) andbT ltW. -have delta0 : 0 < delta by rewrite /delta delta_max_gt0. +have delta0 : 0 < delta by rewrite /delta safe_dist_gt0. have [delta' [s [/andP[delta'0 delta'delta] [abs nthdelta']]]] : exists (delta' : R) s, 0 < delta' < delta /\ itv_partition a b s /\ @@ -427,14 +426,14 @@ suff: forall i, (i < size s)%N -> admit. rewrite (le_lt_trans ti)//. rewrite -[ltLHS]/(nth b (a :: s) i.+1). - have : delta_max phi (nth b (a :: s) i) (nth b s i)%E k u0 r rho = delta. - rewrite Hdelta_max. - rewrite /delta_max. + have : safe_dist phi (nth b (a :: s) i) (nth b s i)%E k u0 r rho = delta. + rewrite Hsafe_dist. + rewrite /safe_dist. rewrite minA. apply/min_idPr. rewrite le_min. apply/andP; split. - rewrite -Hdelta_max. + rewrite -Hsafe_dist. admit. (* pbm: rho must be defined after s!*) rewrite (le_trans (ltW Hr))//. rewrite ler_wpM2l//. From 517e877f6b2adf6484fd7f6b477814663cca60fc Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Sat, 14 Feb 2026 19:38:05 +0900 Subject: [PATCH 114/144] tilt_stability.v --- _CoqProject | 1 + derive_matrix.v | 2 + differential_kinematics.v | 2 +- ode.v | 8 +- ode_common.v | 36 +- ode_wip.v | 9 +- tilt_analysis.v | 409 ++++++++++--- tilt_lasalle.v | 45 +- tilt_lyapunov.v | 1176 ++----------------------------------- tilt_mathcomp.v | 8 + tilt_robot.v | 65 +- tilt_stability.v | 745 +++++++++++++++++++++++ 12 files changed, 1227 insertions(+), 1279 deletions(-) create mode 100644 tilt_stability.v diff --git a/_CoqProject b/_CoqProject index 252452da..ae927bfe 100644 --- a/_CoqProject +++ b/_CoqProject @@ -25,6 +25,7 @@ pendulum.v tilt_mathcomp.v tilt_analysis.v tilt_robot.v +tilt_stability.v tilt_lyapunov.v tilt_lasalle.v ode_wip.v diff --git a/derive_matrix.v b/derive_matrix.v index 855256a2..f8dd444d 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -13,7 +13,9 @@ Require Import ssr_ext euclidean rigid skew. (**md**************************************************************************) (* # Derivatives of time-varying matrices *) (* *) +(* ``` *) (* ang_vel_mx M == angular velocity matrix of M(t) *) +(* ``` *) (* *) (******************************************************************************) diff --git a/differential_kinematics.v b/differential_kinematics.v index 8d7fa48e..0417f93f 100644 --- a/differential_kinematics.v +++ b/differential_kinematics.v @@ -1,4 +1,4 @@ -(* robot-rocq (c) 2026 AIST and INRIA. License: LGPL-2.1-or-later. *) +(* robot-rocq (c) 2017 AIST and INRIA. License: LGPL-2.1-or-later. *) From mathcomp Require Import all_ssreflect ssralg ssrint ssrnum rat. From mathcomp Require Import interval_inference. From mathcomp Require Import closed_field polyrcf matrix mxalgebra mxpoly zmodp. diff --git a/ode.v b/ode.v index d111de2c..83968993 100644 --- a/ode.v +++ b/ode.v @@ -7,7 +7,7 @@ From mathcomp Require Import functions reals interval_inference topology. From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. -Require Import ode_common ode_contfun. +Require Import tilt_analysis ode_common ode_contfun. (**md**************************************************************************) (* # Proof of the Cauchy-Lipschitz theorem *) @@ -536,12 +536,6 @@ Proof. by rewrite /sup_phi sup_ge0//= => x [y _ <-]. Qed. End sup_phi. -(* PR to MCA *) -Lemma EVT_max_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : - A !=set0 -> compact A -> {within A, continuous f} -> - exists2 c, c \in A & forall t, t \in A -> f t <= f c. -Admitted. - Section sup_phi_lemmas. Context {R : realType} {n : nat}. Let U := 'rV[R]_n. diff --git a/ode_common.v b/ode_common.v index cdbf1e88..c225547c 100644 --- a/ode_common.v +++ b/ode_common.v @@ -7,6 +7,7 @@ From mathcomp Require Import functions reals interval_inference topology. From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. +Require Import tilt_mathcomp. (**md**************************************************************************) (* # Preparation steps to ode_contfun.v *) @@ -28,19 +29,6 @@ Import numFieldNormedType.Exports. Open Scope ring_scope. Open Scope classical_set_scope. -(* NB: PR to MC *) -Lemma gerN {R : numDomainType} (x : R) : 0 <= x -> - x <= x. -Proof. by move=> x0; rewrite ge0_cp. Qed. - -(* TODO: rename, generalize to the subset relation *) -Lemma in_switch {R : numDomainType} (I : interval R) P : - {in [set` I], forall x, P x} <-> {in I, forall x, P x}. -Proof. -split => [h x xI| h x xI]; apply h. - by rewrite inE. -by rewrite inE in xI. -Qed. - Lemma eq_on_itv_deriv {R : realType} {W : normedModType R} c d (g h : R -> W) : {in `]c,d[, g =1 h} -> {in `]c,d[, g^`() =1 h^`()}. Proof. @@ -162,13 +150,13 @@ Qed. End about_sup. -(* TODO: PR to MathComp-Analysis *) +(* TODO: PR to MCA *) Lemma cst_is_fun {T1 T2} (A : set T1) x : @isFun T1 T2 A [set: T2] (cst x). Proof. by constructor. Qed. HB.instance Definition _ {T1 T2} (A : set T1) x := @cst_is_fun T1 T2 A x. -Lemma seg_nonempty {R : realType} (c d : R) : c <= d -> `[c,d] !=set0. +Lemma seg_nonempty {R : realType} (c d : R) : c <= d -> `[c, d] !=set0. Proof. move => h. exists c. @@ -249,7 +237,7 @@ move: b ab {cf} => [b0 b/= /[!bnd_simp] ab|[//|_]]. - by exists 2%R => //= c ca1 + ac; apply; rewrite ?gt_eqF ?in_itv/= ?ltW. Qed. -(* NB: PR in progress *) +(* NB: PR *) Lemma continuous_within_itvP_g a b f : a < b -> {within `[a, b], continuous f} <-> [/\ {in `]a, b[, continuous f}, f @ a^'+ --> f a & f @b^'- --> f b]. @@ -282,6 +270,7 @@ Qed. End continuous_within_itvP. +(* TODO *) Lemma proveme {R : realType} (a b : R) (g : R -> R) : {within `[a, b], continuous g} -> {within `[a, b], continuous (g \o -%R)}. @@ -309,18 +298,6 @@ apply: H3. by apply: cvg_norm. Qed. -(* NB: it is now in master *) -Lemma integrable_norm d {T : measurableType d} {R : realType} - (mu : {measure set T -> \bar R}) (D : set T) (f : T -> R) : - mu.-integrable D (EFin \o f) -> - mu.-integrable D (EFin \o (normr \o f)). -Proof. -move=> /integrableP[mf foo]; apply/integrableP; split. - do 2 apply: measurableT_comp => //. - exact/measurable_EFinP. -by under eq_integral do rewrite /= normr_id. -Qed. - Lemma lipschitzW {R : realType} {T U W : normedModType R} (A B : set T) C (f : T -> U -> W) k : A `<=` B -> {in B, forall x, k.-lipschitz_C (f x)} -> {in A, forall x, k.-lipschitz_C (f x)}. Proof. @@ -328,6 +305,7 @@ move=> AB H x xA. apply: H. by apply/mem_set/AB/set_mem. Qed. + (* NB: why is in1_subset_itv so specialized?! *) Section lip_implies_cont. @@ -802,7 +780,7 @@ Unshelve. all: end_near. Qed. End within_continuous_lipschitz. -Lemma compact_has_ubound {R : realType} (A : set R) : compact A -> has_ubound A . +Lemma compact_has_ubound {R : realType} (A : set R) : compact A -> has_ubound A. Proof. move=> /compact_bounded[u [_ /= uA]]. exists (u + 1) => x Ax. diff --git a/ode_wip.v b/ode_wip.v index db6380ce..5da5e90a 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -1,13 +1,12 @@ From HB Require Import structures. -From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. -From mathcomp Require Import archimedean generic_quotient ring_quotient. -From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. -From mathcomp Require Import constructive_ereal. +From mathcomp Require Import all_boot all_order ssralg ssrnum matrix interval. +From mathcomp Require Import poly archimedean generic_quotient ring_quotient. +From mathcomp Require Import mathcomp_extra boolp classical_sets. From mathcomp Require Import functions reals interval_inference topology. From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. -Require Import ode_common ode_contfun ode. +Require Import tilt_analysis ode_common ode_contfun ode. (**md**************************************************************************) (* # ODE wip *) diff --git a/tilt_analysis.v b/tilt_analysis.v index 536bc891..e5917ce5 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -1,8 +1,14 @@ +From HB Require Import structures. From mathcomp Require Import all_boot all_order all_algebra ring. +From mathcomp Require Import interval_inference. From mathcomp Require Import boolp classical_sets functions reals. From mathcomp Require Import topology normedtype derive realfun landau. -From HB Require Import structures. -Require Import ssr_ext euclidean rigid frame skew derive_matrix. +Require Import ssr_ext derive_matrix. + +(**md**************************************************************************) +(* # Additions to the MathComp-Analysis library *) +(* *) +(******************************************************************************) Set Implicit Arguments. Unset Strict Implicit. @@ -10,9 +16,9 @@ Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. + Local Open Scope ring_scope. -(* Todo: Maybe useful generally? (PR) *) Lemma norm_rowmx {K : rcfType} {m n1 n2 : nat} (A1 : 'M[K]_(m.+1, n1.+1)) (A2 : 'M[K]_(m.+1, n2.+1)) : `|row_mx A1 A2| = Num.max `|A1| `|A2|. @@ -45,7 +51,6 @@ rewrite -(row_mxEr A1). exact: (le_bigmax _ _ (i, rshift n1.+1 j)). Qed. -(*Todo: This also seems useful in general (PR) *) Lemma mx_norm_mul {K : rcfType} {m n p} (A : 'M[K]_(m.+1, n.+1)) (B : 'M_(n.+1, p.+1)) : `|A *m B| <= n.+1%:R * `| A| * `|B|. Proof. @@ -71,7 +76,7 @@ rewrite iter_addr_0. by rewrite /Num.norm/= !mx_normrE. Qed. -Lemma differentiable_scalar_mx {R : realType} n (r : R) : +Lemma differentiable_scalar_mx {R : numFieldType} n (r : R) : differentiable (@scalar_mx _ n) r. Proof. apply/derivable1_diffP/cvg_ex => /=. @@ -82,66 +87,12 @@ rewrite scaler1 -raddfB/= addrK (scale_scalar_mx _ t^-1) mulVf. by near: t; exact: nbhs_dnbhs_neq. Unshelve. all: by end_near. Qed. -(*Lemma derivable_norm_squared {K : realType} n (f : K -> 'rV[K]_n) (x0 : K) : - derivable f x0 1 -> - derivable (fun x => norm (f x) ^+ 2) x0 1. -Proof. -move => dif1. -apply/diff_derivable. -rewrite /=. -under eq_fun do rewrite -dotmulvv dotmulE. -have -> : (fun x : K => \sum_k (f x)``_k * (f x)``_k) = - \sum_k (fun x => (f x)``_k * (f x)``_k ). - apply/funext => x => //=. - by rewrite fct_sumE. -apply/differentiable_sum => k => //=. -apply/differentiableM => //=. - apply/derivable1_diffP. - by apply/derivable_coord => //. -apply/derivable1_diffP. -by apply/derivable_coord => //. -Qed.*) - -(*Lemma derive_norm_squared {K : realType} n (u : K -> 'rV[K]_n) (t : K) : - derivable u t 1 -> - 'D_1 (fun x => norm (u x) ^+ 2) t = - 2 * ('D_1 u t *m (u t)^T)``_0. -Proof. -move=> ut1. -under eq_fun do rewrite -dotmulvv. -rewrite dotmulP mxE /= mulr1n derive_dotmul// dotmulC. -by field. -Qed.*) - Lemma derivable_sqrt {K: realType} (u : K) : u > 0 -> derivable Num.sqrt u 1. Proof. move=> u0. apply: ex_derive. exact: (is_derive1_sqrt u0). Qed. -(* should go to tilt_robot*) -(*Lemma differentiable_norm {K : realType} m n (f : 'rV[K]_m -> 'rV_n) - (g : K -> 'rV[K]_m) t : - differentiable f (g t) -> f (g t) != 0 -> - differentiable (fun x => norm (f x)) (g t) . -Proof. -move=> fgt fgt0; rewrite /norm -fctE. -apply: differentiable_comp. - exact: differentiable_dotmul. -apply/derivable1_diffP/derivable_sqrt. -by rewrite dotmulvv expr2 mulr_gt0 //= !norm_gt0. -Qed.*) - -(*Lemma differentiable_norm_squared {R : rcfType} m n - (f : 'rV[R]_m -> 'rV[R]_n) (v : 'rV[R]_m) : - differentiable f v -> - differentiable (fun x => norm (f x) ^+ 2) v. -Proof. -move=> dif1. -under eq_fun do rewrite -dotmulvv. -exact: differentiable_dotmul. -Qed.*) -(* this one too *) Lemma differentiable_rsubmx_comp {R : realFieldType} (V : normedModType R) {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t : @@ -264,6 +215,15 @@ Qed.*) Local Open Scope classical_set_scope. +(* TODO: rename, generalize to the subset relation *) +Lemma in_switch {R : numDomainType} (I : interval R) P : + {in [set` I], forall x, P x} <-> {in I, forall x, P x}. +Proof. +split => [h x xI| h x xI]; apply h. + by rewrite inE. +by rewrite inE in xI. +Qed. + Lemma within_continuous_comp {R : realType} {K : numDomainType} {U : pseudoMetricNormedZmodType K} a y (g : U -> R) (f : R -> U) : a <= y -> @@ -329,19 +289,324 @@ case: eqP => /= _; last by rewrite normr0. by rewrite normr1. Qed. -Lemma enorm_mxnorm {K : rcfType} {n} (x : 'rV[K]_n.+1) : - `|x|_e ^+ 2 <= n.+1%:R * `|x| ^ 2. -Proof. -rewrite sqr_enorm /=. -apply : (@le_trans _ _ (\sum_(i0 < n.+1) `|x| ^+ 2)). - apply: ler_sum => k _. - rewrite -sqr_normr. - suff h : `|x ord0 k| <= `|x| by exact: ler_pM. - rewrite {2}/Num.norm/= !mx_normrE /=. - exact: (le_bigmax _ _ (ord0, k)). -by rewrite big_const_ord mulr_natl iter_addr_0. -Qed. - Lemma mx_norm_sq_le {K : rcfType} {n} (A : 'M[K]_n.+1) : `|A ^+ 2| <= n.+1%:R * `|A| ^+ 2. Proof. by rewrite !expr2 mulrA; exact: mx_norm_mul. Qed. + +Local Open Scope classical_set_scope. +(* PR to MCA *) +Lemma EVT_max_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : + A !=set0 -> + compact A -> + {within A, continuous f} -> exists2 c, c \in A & + forall t, t \in A -> f t <= f c. +Proof. +move=> A0 compactA fcont; set imf := f @` A. +have imf_sup : has_sup imf. + split. + case: A0 => a Aa. + by exists (f a); apply/imageP. + have [M [Mreal imfltM]] : bounded_set (f @` A). + exact/compact_bounded/continuous_compact. + exists (M + 1) => y /imfltM yleM. + by rewrite (le_trans _ (yleM _ _)) ?ler_norm ?ltrDl. +have [|imf_ltsup] := pselect (exists2 c, c \in A & f c = sup imf). + move=> [c cab fceqsup]; exists c => // t tab; rewrite fceqsup. + apply/sup_upper_bound => //. + exact/imageP/set_mem. +have {}imf_ltsup t : t \in A -> f t < sup imf. + move=> tab; case: (ltrP (f t) (sup imf)) => // supleft. + rewrite falseE; apply: imf_ltsup; exists t => //; apply/eqP. + rewrite eq_le supleft andbT sup_upper_bound//. + exact/imageP/set_mem. +pose g t : R := (sup imf - f t)^-1. +have invf_continuous : {within A, continuous g}. + rewrite continuous_subspace_in => t tab; apply: cvgV => //=. + by rewrite subr_eq0 gt_eqF // imf_ltsup //; rewrite inE in tab. + by apply: cvgD; [exact: cst_continuous | apply: cvgN; exact: (fcont t)]. +have /ex_strict_bound_gt0 [k k_gt0 /= imVfltk] : bounded_set (g @` A). + by apply/compact_bounded/continuous_compact. +have [_ [t tab <-]] : exists2 y, imf y & sup imf - k^-1 < y. + by apply: sup_adherent => //; rewrite invr_gt0. +rewrite ltrBlDr -ltrBlDl. +suff : sup imf - f t > k^-1 by move=> /ltW; rewrite leNgt => /negbTE ->. +rewrite -[ltRHS]invrK ltf_pV2// ?qualifE/= ?invr_gt0 ?subr_gt0 ?imf_ltsup//; last first. + exact/mem_set. +by rewrite (le_lt_trans (ler_norm _) _) ?imVfltk//; exact: imageP. +Qed. + +(* PR to MCA *) +Lemma EVT_min_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : + A !=set0 -> + compact A -> + {within A, continuous f} -> exists2 c, c \in A & + forall t, t \in A -> f c <= f t. +Proof. +move=> A0 cA fcont. +have /(EVT_max_rV A0 cA) [c clr fcmax] : {within A, continuous (- f)}. + by move=> ?; apply: continuousN => ?; exact: fcont. +by exists c => // ? /fcmax; rewrite lerN2. +Qed. + +(* TODO: move *) +Lemma open_disjoint_separated (X : topologicalType) (A B : set X) : + open A -> open B -> A `&` B = set0 -> separated A B. +Proof. +move=>Ao Bo ABdisj. +split. +apply /disjoints_subset. +rewrite (closure_id (~` B)).1; last by apply open_closedC. +by apply /closure_subset/disjoints_subset. +rewrite setIC;apply /disjoints_subset. +rewrite (closure_id (~` A)).1; last by apply open_closedC. +apply /closure_subset/disjoints_subset. +by rewrite setIC. +Qed. + +(* TODO: move *) +Lemma separated_closedUP {T : topologicalType} (A B : set T) : separated A B -> + closed (A `|` B) <-> closed A /\ closed B. +Proof. +move => ABsep. +split => [/closure_id h | [h1 h2]]; last by apply closedU. +rewrite closureU in h. +split;apply /closure_id/seteqP;split => [|x cx]; try by apply subset_closure. +have /orP[] : (x \in A) || (x \in B). + by rewrite -in_setU h inE/=;left. +by rewrite inE. +rewrite inE => xB. +have [/seteqP[+ _] _] := ABsep. +case /(_ x). +by split. +have /orP[] : (x \in A) || (x \in B). + by rewrite -in_setU h inE/=;right. +rewrite inE => xB. +have [_ /seteqP[+ _]] := ABsep. +case /(_ x). +by split. +by rewrite inE. +Qed. + +Lemma cst_oo_cc {R : realType} (f : R -> R) y (a b : R) : + y \in `[a, b] -> + {within `[a, b], continuous f} -> + {in `]a, b[, f =1 cst (f y)} -> + {in `[a, b], f =1 cst (f y)}. +Proof. +have [ab|ba] := ltP a b; last first. + move=> yab _ H x. + rewrite inE/= in_itv/= => /andP[ax xb]. + have /eqP ? : a == x by rewrite eq_le ax (le_trans xb _). + subst x. + move: yab; rewrite inE/= in_itv/= => /andP[ay yb]. + have /eqP ? : a == y by rewrite eq_le ay (le_trans yb _). + by subst. +move=> yab cf H x. +rewrite inE/= in_itv/= => /andP[]. +rewrite le_eqVlt => /predU1P[<-{x} _|]. + move: yab; rewrite inE/= in_itv/= => /andP[]. + rewrite le_eqVlt => /predU1P[->//|ay yb]. + move/continuous_within_itvP : cf => /(_ ab)[_ fafa _]. + move/cvgrPdist_le in fafa. + rewrite /= in fafa. + apply/eqP. + rewrite -subr_eq0. + rewrite -normr_le0. + apply/ler_addgt0Pr => /= e e0. + rewrite add0r. + have := fafa _ e0 => -[d /= d0] H'. + near a^'+ => a0. + rewrite (_ : f y = f a0)//; last first. + apply/esym/H. + rewrite inE/= in_itv/=. + by apply/andP; split => //. + apply: H' => //=. + rewrite ltr0_norm ?subr_lt0// opprB. + rewrite ltrBlDl. + near: a0. + apply: nbhs_right_lt. + by rewrite ltrDl. +move=> ax. +rewrite le_eqVlt => /predU1P[->|]; last first. + move=> xb. + apply: H => //. + by rewrite inE/= in_itv/= ax. +clear x ax. +move: yab. +rewrite inE/= in_itv/= => /andP[ay]. +rewrite le_eqVlt => /predU1P[<-//|yb]. +move/continuous_within_itvP : cf => /(_ ab)[_ _ fbfb]. +move/cvgrPdist_le in fbfb. +rewrite /= in fbfb. +apply/eqP. +rewrite -subr_eq0. +rewrite -normr_le0. +apply/ler_addgt0Pr => /= e e0. +rewrite add0r. +have := fbfb _ e0 => -[d /= d0] H'. +near b^'- => b0. +rewrite (_ : f y = f b0)//; last first. + apply/esym/H. + rewrite inE/= in_itv/=. + by apply/andP; split => //. +apply: H' => //=. +rewrite distrC. +rewrite ltr0_norm ?subr_lt0// opprB. +rewrite ltrBlDr. +rewrite -ltrBlDl. +near: b0. +apply: nbhs_left_gt. +by rewrite ltrBlDl ltrDr. +Unshelve. all: by end_near. Qed. + +Lemma is_derive_0_is_cst_new {R : realType} (f : R -> R) y (a b : R) : + y \in `]a, b[ -> + {within `[a, b], continuous f} -> + (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. +Proof. +move=> yab cf Hd. +apply: cst_oo_cc => //. + move: yab. + rewrite !inE/=. + by apply: subset_itv_oo_cc. +move=> x xab. +wlog xLy : x y xab yab/ x <= y. + move=> H; case: (leP x y) => [/H |/ltW xy]. + exact. + by apply/esym/H => //. +rewrite -(subKr (f y) (f x)). +have [| |] := @MVT_segment R f 0 _ _ xLy. +- move=> z zxy. + apply: Hd. + move: zxy. + rewrite inE/=. + apply: subset_itvSoo; rewrite bnd_simp. + by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. + by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. +- apply: continuous_subspaceW(* NB: should be , do a PRS*) cf. + apply: subset_itvScc; rewrite bnd_simp. + by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. + by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. +move=> r rxy. +rewrite mul0r => ->. +by rewrite subr0. +Qed. + +Lemma is_derive_0_is_cst_new' {R : realType} (f : R -> R) y (a b : R) : + y \in `[a, b] -> + {within `[a, b], continuous f} -> + (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. +Proof. +move => yab cont d x xab /=. +have : (a <= b). + move: xab. + rewrite inE/=in_itv/= => /andP[]. + by apply le_trans. +rewrite le_eqVlt => /predU1P[ab|ab]. +suff [-> ->] : b = x /\ b = y by []. +split;apply /eqP;rewrite eq_le. +by move : xab;rewrite !ab !inE/=!in_itv/=. +by move : yab;rewrite !ab !inE/=!in_itv/=. +suff [-> ->] : f x = f ((a + b) / 2) /\ f y = f ((a+b )/2) by []. +have ab2: (a+b)/2 \in `]a,b[. + rewrite inE/=in_itv/=. + apply/andP;split. + by rewrite ltr_pdivlMr // mulrDr mulr1 ler_ltD //. + rewrite ltr_pdivrMr // mulrDr mulr1 ltr_leD //. +by split;apply /is_derive_0_is_cst_new. +Qed. + +Lemma closed_ball_bounded {K : realType} {n} (x y : 'rV[K]_n) r : 0 < r -> closed_ball x r y -> + `|y| <= `|x| + r. +Proof. +move=> r0. +rewrite closed_ballE// /closed_ball_/= => dxy. +rewrite ler_distlCDr//. +by rewrite (le_trans (ler_dist_dist _ _)). +Qed. + +Lemma ball0_le0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : + ball a r = set0 -> r <= 0. +Proof. +rewrite -subset0 => ar0; rewrite leNgt; apply/negP => r0. +by have /(_ (ballxx _ r0)) := ar0 a. +Qed. + +Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n) : + 0 < e -> closed_ball x e = closed_ball_ (@mx_norm _ _ _) x e. +Proof. +by move=> e0; rewrite closed_ballE. +Qed. + +Local Close Scope classical_set_scope. + +Lemma maxE {K : realType} (x y : {nonneg K}) : + (Num.max x%:num y%:num) = (Num.max x y)%:num. +Proof. +rewrite /Num.max /maxr; apply/esym. +case: ifPn => // xy. + case: ifPn => //. + rewrite -leNgt => yx. + by apply/eqP; rewrite eq_le yx/= ltW. +case: ifPn => // yx. +apply/eqP; rewrite eq_le (ltW yx)/=. +by rewrite -leNgt in xy. +Qed. + +Section gradient. + +Definition jacobian1 {R : numFieldType} n (f : 'rV[R]_n -> R) + : 'rV_n -> 'cV_n := + jacobian (scalar_mx \o f). + +(* NB: not used *) +Definition partial {R : numFieldType} {n : nat} (f : 'rV[R]_n -> R) (a : 'rV[R]_n) i := + lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. + +Lemma partial_diff {R : realFieldType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) + (i : 'I_n) : + derivable f a 'e_i -> + partial f a i = ('D_'e_i (@scalar_mx _ 1 \o f) a) 0 0. +Proof. +move=> fa1. +rewrite derive_mx ?mxE//=; last first. + exact: derivable_scalar_mx. +rewrite /partial. +under eq_fun do rewrite (addrC a). +by under [in RHS]eq_fun do rewrite !mxE/= !mulr1n. +Qed. + +(* NB: not used *) +Definition err_vec {R : pzRingType} n (i : 'I_n) : 'rV[R]_n := + \row_(j < n) (i == j)%:R. + +Lemma err_vecE {R : pzRingType} n (i : 'I_n) : + err_vec i = 'e_i :> 'rV[R]_n. +Proof. +apply/rowP => j. +by rewrite !mxE eqxx /= eq_sym. +Qed. + +Definition gradient_partial {R : numFieldType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) := + \row_(i < n) partial f a i. + +Lemma gradient_partial_sum {R : numFieldType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) : + gradient_partial f a = \sum_(i < n) partial f a i *: 'e_i. +Proof. +rewrite /gradient_partial [LHS]row_sum_delta. +by under eq_bigr do rewrite mxE. +Qed. + +Lemma gradient_partial_jacobian1 {R : realFieldType} n (f : 'rV[R]_n -> R) + (v : 'rV[R]_n) : differentiable f v -> + gradient_partial f v = (jacobian1 f v)^T. +Proof. +move=> fa; apply/rowP => i. +rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. + apply: differentiable_comp => //. + exact: differentiable_scalar_mx. +rewrite partial_diff//. +exact/diff_derivable. +Qed. + +End gradient. diff --git a/tilt_lasalle.v b/tilt_lasalle.v index 6b8af3b8..ef2a17af 100644 --- a/tilt_lasalle.v +++ b/tilt_lasalle.v @@ -7,11 +7,14 @@ From mathcomp Require Import matrix_normedtype. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. Require Import lasalle (* to at least get the structure of filters on sets *). -Require Import ode tilt_lyapunov. +Require Import ode tilt_stability tilt_lyapunov. (**md**************************************************************************) -(* # Tentative formalization of [1] *) +(* # Formalization of [benallegue2023itac] (2/2) *) (* *) +(* Reference: *) +(* - [benallegue2023itac] *) +(* https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) (******************************************************************************) Set Implicit Arguments. @@ -189,12 +192,12 @@ Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. Let phi := Tilt.eqn alpha1 gamma. -Hypothesis solP : forall y, y 0 \in Tilt.Gamma1 -> +Hypothesis solP : forall y, y 0 \in Tilt.Upsilon1 -> lasalle.is_sol phi y <-> y = sol (y 0). Hypothesis initp : forall p, sol p 0 = p. -Let isSol p : p \in Tilt.Gamma1 -> is_sol_on0y phi (sol p). +Let isSol p : p \in Tilt.Upsilon1 -> is_sol_on0y phi (sol p). Proof. move => Kp. apply/is_sol_on0yP. @@ -207,7 +210,7 @@ by rewrite derive1E;apply H. Qed. Definition Ksub (p : U) := - [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` Tilt.Gamma1. + [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` Tilt.Upsilon1. (* continuity in initial value: assumption needed for LaSalle *) Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. @@ -267,7 +270,7 @@ Lemma compact_Ksub p : compact (Ksub p). Proof. apply: compact_closedI. exact: V1_bound_compact. -have -> : Tilt.Gamma1 = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. +have -> : Tilt.Upsilon1 = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. by []. apply : closed_comp => //. move => x xp. @@ -350,11 +353,11 @@ suff -> : 'e_2 *v 'e_2 = (0 : 'rV[K]_3). by rewrite vece2 /= scale0r. Qed. -Local Lemma sol_continuous p : p \in Tilt.Gamma1 -> continuous (sol p). +Local Lemma sol_continuous p : p \in Tilt.Upsilon1 -> continuous (sol p). Proof. move => sp t. have [issol0 issol1]: lasalle.is_sol phi (sol p). - apply: (lasalle.sol_is_sol (sol := sol) (K:=Tilt.Gamma1)) => //. + apply: (lasalle.sol_is_sol (sol := sol) (K:=Tilt.Upsilon1)) => //. move => y Ky. by apply /solP;rewrite inE. move : sp. @@ -376,12 +379,12 @@ apply /ex_derive/issol1. rewrite lerNr oppr0 ltW//. Unshelve. all: by end_near. Qed. -Local Lemma q_inKsubq q : q \in Tilt.Gamma1 -> q \in Ksub q. +Local Lemma q_inKsubq q : q \in Tilt.Upsilon1 -> q \in Ksub q. Proof. rewrite !inE => h;split => //=. Qed. Local Lemma limS_subset_V1dot0 p : - p \in Tilt.Gamma1 -> - lasalle.limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. + p \in Tilt.Upsilon1 -> + lasalle.limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Upsilon1. Proof. move => ps. have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). @@ -390,7 +393,7 @@ have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y rewrite inE. by apply Ky. have H : lasalle.limS sol (Ksub p) `<=` - [set x | (V1 alpha1 gamma \o sol x)^`()%classic 0 = 0] `&` Tilt.Gamma1. + [set x | (V1 alpha1 gamma \o sol x)^`()%classic 0 = 0] `&` Tilt.Upsilon1. rewrite subsetI; split. apply: (@lasalle.stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (V1 alpha1 gamma)) => //=. apply/continuous_subspaceT => x xK. @@ -406,7 +409,7 @@ have H : lasalle.limS sol (Ksub p) `<=` by have [_ +] := K0. exact: V1_diff. move => p0 K0. - have p0s : p0 \in Tilt.Gamma1. + have p0s : p0 \in Tilt.Upsilon1. by move : K0;rewrite inE/=/Ksub/inE/=;move=>[]. rewrite derive1E. rewrite -derive_along_derive. @@ -461,9 +464,9 @@ by rewrite inE. Qed. Lemma limS_subset_points p : - p \in Tilt.Gamma1 -> lasalle.limS sol (Ksub p) `<=` Tilt.points. + p \in Tilt.Upsilon1 -> lasalle.limS sol (Ksub p) `<=` Tilt.points. Proof. -have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. +have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Upsilon1. apply/seteqP; split => x /=. case => ->;split; [exact: V1dot_point1_eq0 | | exact: V1dot_point2_eq0 | ]. have := @tilt_point1_in_state_space K. @@ -471,7 +474,7 @@ have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. have := @tilt_point2_in_state_space K. by rewrite inE. move => [h1 h2']. - have h2 : x \in Tilt.Gamma1 by rewrite inE. + have h2 : x \in Tilt.Upsilon1 by rewrite inE. move : h1. have hi := initp x. rewrite -hi => h1. @@ -485,7 +488,7 @@ have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Gamma1. by apply limS_subset_V1dot0. Qed. -Lemma cvg_to_set_points p : p \in Tilt.Gamma1 -> +Lemma cvg_to_set_points p : p \in Tilt.Upsilon1 -> sol p t @[t --> +oo] --> (Tilt.points : set 'rV_6). Proof. move=> /set_mem ps. @@ -500,7 +503,7 @@ move => /= S [eps eps0 Be]. exists eps => //. apply bigcup_sub => /= x H. apply: (subset_trans _ Be). -have ps' : p \in Tilt.Gamma1 by exact/mem_set. +have ps' : p \in Tilt.Upsilon1 by exact/mem_set. have : Tilt.points x by apply: (limS_subset_points ps'). move => h x' Bx'. by exists x. @@ -529,7 +532,7 @@ split => //. by apply V1c. Qed. -Lemma cluster_contained_points p : p \in Tilt.Gamma1 -> +Lemma cluster_contained_points p : p \in Tilt.Upsilon1 -> cluster (sol p t @[t --> +oo]) `<=` Tilt.points. Proof. move => ps. @@ -587,7 +590,7 @@ by left. by right. Qed. -Lemma cluster_nonempty p : p \in Tilt.Gamma1 -> cluster (sol p t @[t --> +oo]) !=set0. +Lemma cluster_nonempty p : p \in Tilt.Upsilon1 -> cluster (sol p t @[t --> +oo]) !=set0. Proof. move => sp. suff : (Ksub p) `&` cluster (sol p t @[t --> +oo]) !=set0. @@ -609,7 +612,7 @@ rewrite lsubmx_const rsubmx_const/= !enorm0 !expr0n /= !mul0r add0r. by rewrite addr_ge0 // divr_ge0 // ?sqr_ge0 ?mulr_ge0 // ltW. Qed. -Lemma tilt_cvg_to_point1_or_point2 p : p \in Tilt.Gamma1 -> +Lemma tilt_cvg_to_point1_or_point2 p : p \in Tilt.Upsilon1 -> (sol p t @[t --> +oo] --> Tilt.point1) \/ (sol p t @[t --> +oo] --> Tilt.point2). Proof. diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index 34c861f7..0324cc74 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -6,1055 +6,30 @@ From mathcomp Require Import topology normedtype landau sequences derive realfun From mathcomp Require Import matrix_normedtype. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot. -Require Import ode lasalle. +Require Import ode tilt_stability. (**md**************************************************************************) -(* # Tentative formalization of [1] *) +(* # Formalization of [benallegue2023itac] (1/2) *) (* *) (* ``` *) -(* posdefmx M == M is definite positive *) -(* locposdef V x == V is locally positive definite at x *) -(* is_Lyapunov_candidate V := locposdef V *) -(* locnegsemidef V x == V is locally negative semidefinite *) -(* 'D~(sol, x0) V == derivative of V along the solution sol *) -(* starting at x0 *) -(* is_equilibrium_point f p := solves_equation f (cst p) *) -(* state_space f == the set points attainable by a solution *) -(* (in the sense of `is_sol`) *) -(* is_Lyapunov_stable_at f V x == Lyapunov stability *) +(* Tilt.Upsilon1 == state-space *) (* ``` *) (* *) (* Reference: *) (* - [benallegue2023itac] *) (* https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) -(* - [2]: Hassan K. Khalil, Nonlinear systems, 2002 *) (******************************************************************************) -Reserved Notation "''D~(' sol , x ) f" (at level 10, sol, x, f at next level, - format "''D~(' sol , x ) f"). - Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. -Local Open Scope ring_scope. - -(* additions to MathComp-Analysis *) - -Lemma ball0_le0 (R : realDomainType) (V : pseudoMetricNormedZmodType R) (a : V) (r : R) : - ball a r = set0 -> r <= 0. -Proof. -rewrite -subset0 => ar0; rewrite leNgt; apply/negP => r0. -by have /(_ (ballxx _ r0)) := ar0 a. -Qed. - -Lemma closed_ballAE {K : realType} n (e : K) (x : 'rV[K]_n) : - 0 < e -> closed_ball x e = closed_ball_ (@mx_norm _ _ _) x e. -Proof. -by move=> e0; rewrite closed_ballE. -Qed. - -Import Order.Def. - -Lemma maxE {K : realType} (x y : {nonneg K}) : - (max x%:num y%:num) = (max x y)%:num. -Proof. -rewrite /max; apply/esym. -case: ifPn => // xy. - case: ifPn => //. - rewrite -leNgt => yx. - by apply/eqP; rewrite eq_le yx/= ltW. -case: ifPn => // yx. -apply/eqP; rewrite eq_le (ltW yx)/=. -by rewrite -leNgt in xy. -Qed. - -Local Open Scope classical_set_scope. - -(* PR in progress: https://github.com/math-comp/analysis/pull/1802 *) -Lemma EVT_max_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : - A !=set0 -> - compact A -> - {within A, continuous f} -> exists2 c, c \in A & - forall t, t \in A -> f t <= f c. -Proof. -move=> A0 compactA fcont; set imf := f @` A. -have imf_sup : has_sup imf. - split. - case: A0 => a Aa. - by exists (f a); apply/imageP. - have [M [Mreal imfltM]] : bounded_set (f @` A). - exact/compact_bounded/continuous_compact. - exists (M + 1) => y /imfltM yleM. - by rewrite (le_trans _ (yleM _ _)) ?ler_norm ?ltrDl. -have [|imf_ltsup] := pselect (exists2 c, c \in A & f c = sup imf). - move=> [c cab fceqsup]; exists c => // t tab; rewrite fceqsup. - apply/sup_upper_bound => //. - exact/imageP/set_mem. -have {}imf_ltsup t : t \in A -> f t < sup imf. - move=> tab; case: (ltrP (f t) (sup imf)) => // supleft. - rewrite falseE; apply: imf_ltsup; exists t => //; apply/eqP. - rewrite eq_le supleft andbT sup_upper_bound//. - exact/imageP/set_mem. -pose g t : R := (sup imf - f t)^-1. -have invf_continuous : {within A, continuous g}. - rewrite continuous_subspace_in => t tab; apply: cvgV => //=. - by rewrite subr_eq0 gt_eqF // imf_ltsup //; rewrite inE in tab. - by apply: cvgD; [exact: cst_continuous | apply: cvgN; exact: (fcont t)]. -have /ex_strict_bound_gt0 [k k_gt0 /= imVfltk] : bounded_set (g @` A). - by apply/compact_bounded/continuous_compact. -have [_ [t tab <-]] : exists2 y, imf y & sup imf - k^-1 < y. - by apply: sup_adherent => //; rewrite invr_gt0. -rewrite ltrBlDr -ltrBlDl. -suff : sup imf - f t > k^-1 by move=> /ltW; rewrite leNgt => /negbTE ->. -rewrite -[ltRHS]invrK ltf_pV2// ?qualifE/= ?invr_gt0 ?subr_gt0 ?imf_ltsup//; last first. - exact/mem_set. -by rewrite (le_lt_trans (ler_norm _) _) ?imVfltk//; exact: imageP. -Qed. - -(* PR in progress: https://github.com/math-comp/analysis/pull/1802 *) -Lemma EVT_min_rV (R : realType) n (f : 'rV[R]_n -> R) (A : set 'rV[R]_n) : - A !=set0 -> - compact A -> - {within A, continuous f} -> exists2 c, c \in A & - forall t, t \in A -> f c <= f t. -Proof. -move=> A0 cA fcont. -have /(EVT_max_rV A0 cA) [c clr fcmax] : {within A, continuous (- f)}. - by move=> ?; apply: continuousN => ?; exact: fcont. -by exists c => // ? /fcmax; rewrite lerN2. -Qed. -Local Close Scope classical_set_scope. - -Section gradient. - -Definition jacobian1 {R : numFieldType} n (f : 'rV[R]_n -> R) - : 'rV_n -> 'cV_n := - jacobian (scalar_mx \o f). - -(* NB: not used*) -Definition partial {R : realType} {n : nat} (f : 'rV[R]_n -> R) (a : 'rV[R]_n) i := - lim (h^-1 * (f (a + h *: 'e_i) - f a) @[h --> 0^'])%classic. - -Lemma partial_diff {R : realType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) - (i : 'I_n) : - derivable f a 'e_i -> - partial f a i = ('D_'e_i (@scalar_mx _ 1 \o f) a) 0 0. -Proof. -move=> fa1. -rewrite derive_mx ?mxE//=; last first. - exact: derivable_scalar_mx. -rewrite /partial. -under eq_fun do rewrite (addrC a). -by under [in RHS]eq_fun do rewrite !mxE/= !mulr1n. -Qed. - -(* NB: not used *) -Definition err_vec {R : pzRingType} n (i : 'I_n) : 'rV[R]_n := - \row_(j < n) (i == j)%:R. - -Lemma err_vecE {R : pzRingType} n (i : 'I_n) : - err_vec i = 'e_i :> 'rV[R]_n. -Proof. -apply/rowP => j. -by rewrite !mxE eqxx /= eq_sym. -Qed. - -Definition gradient_partial {R : realType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) := - \row_(i < n) partial f a i. - -Lemma gradient_partial_sum {R : realType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) : - gradient_partial f a = \sum_(i < n) partial f a i *: 'e_i. -Proof. -rewrite /gradient_partial [LHS]row_sum_delta. -by under eq_bigr do rewrite mxE. -Qed. - -(* TODO: generalize with MCA 1.15.0 *) -Lemma gradient_partial_jacobian1 {R : realType} n (f : 'rV[R]_n -> R) - (v : 'rV[R]_n) : differentiable f v -> - gradient_partial f v = (jacobian1 f v)^T. -Proof. -move=> fa; apply/rowP => i. -rewrite /gradient_partial mxE mxE /jacobian mxE -deriveE; last first. - apply: differentiable_comp => //. - exact: differentiable_scalar_mx. -rewrite partial_diff//. -exact/diff_derivable. -Qed. - -End gradient. - -Section posdefmx. - -Definition posdefmx {K : realType} m (M : 'M[K]_m) : Prop := - M \is sym m K /\ forall a, eigenvalue M a -> a > 0. - -Lemma posdefmxP_direct {R : realType} m (M : 'M[R]_m) : - posdefmx M -> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). -Proof. -Abort. - -Lemma posdefmxP_converse {R : realType} m (M : 'M[R]_m) : - (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0) -> posdefmx M. -Proof. -Abort. - -End posdefmx. +Local Open Scope ring_scope. Local Open Scope classical_set_scope. -Lemma cst_oo_cc {R : realType} (f : R -> R) y (a b : R) : - y \in `[a, b] -> - {within `[a, b], continuous f} -> - {in `]a, b[, f =1 cst (f y)} -> - {in `[a, b], f =1 cst (f y)}. -Proof. -have [ab|ba] := ltP a b; last first. - move=> yab _ H x. - rewrite inE/= in_itv/= => /andP[ax xb]. - have /eqP ? : a == x by rewrite eq_le ax (le_trans xb _). - subst x. - move: yab; rewrite inE/= in_itv/= => /andP[ay yb]. - have /eqP ? : a == y by rewrite eq_le ay (le_trans yb _). - by subst. -move=> yab cf H x. -rewrite inE/= in_itv/= => /andP[]. -rewrite le_eqVlt => /predU1P[<-{x} _|]. - move: yab; rewrite inE/= in_itv/= => /andP[]. - rewrite le_eqVlt => /predU1P[->//|ay yb]. - move/continuous_within_itvP : cf => /(_ ab)[_ fafa _]. - move/cvgrPdist_le in fafa. - rewrite /= in fafa. - apply/eqP. - rewrite -subr_eq0. - rewrite -normr_le0. - apply/ler_addgt0Pr => /= e e0. - rewrite add0r. - have := fafa _ e0 => -[d /= d0] H'. - near a^'+ => a0. - rewrite (_ : f y = f a0)//; last first. - apply/esym/H. - rewrite inE/= in_itv/=. - by apply/andP; split => //. - apply: H' => //=. - rewrite ltr0_norm ?subr_lt0// opprB. - rewrite ltrBlDl. - near: a0. - apply: nbhs_right_lt. - by rewrite ltrDl. -move=> ax. -rewrite le_eqVlt => /predU1P[->|]; last first. - move=> xb. - apply: H => //. - by rewrite inE/= in_itv/= ax. -clear x ax. -move: yab. -rewrite inE/= in_itv/= => /andP[ay]. -rewrite le_eqVlt => /predU1P[<-//|yb]. -move/continuous_within_itvP : cf => /(_ ab)[_ _ fbfb]. -move/cvgrPdist_le in fbfb. -rewrite /= in fbfb. -apply/eqP. -rewrite -subr_eq0. -rewrite -normr_le0. -apply/ler_addgt0Pr => /= e e0. -rewrite add0r. -have := fbfb _ e0 => -[d /= d0] H'. -near b^'- => b0. -rewrite (_ : f y = f b0)//; last first. - apply/esym/H. - rewrite inE/= in_itv/=. - by apply/andP; split => //. -apply: H' => //=. -rewrite distrC. -rewrite ltr0_norm ?subr_lt0// opprB. -rewrite ltrBlDr. -rewrite -ltrBlDl. -near: b0. -apply: nbhs_left_gt. -by rewrite ltrBlDl ltrDr. -Unshelve. all: by end_near. Qed. - -Lemma is_derive_0_is_cst_new {R : realType} (f : R -> R) y (a b : R) : - y \in `]a, b[ -> - {within `[a, b], continuous f} -> - (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. -Proof. -move=> yab cf Hd. -apply: cst_oo_cc => //. - move: yab. - rewrite !inE/=. - by apply: subset_itv_oo_cc. -move=> x xab. -wlog xLy : x y xab yab/ x <= y. - move=> H; case: (leP x y) => [/H |/ltW xy]. - exact. - by apply/esym/H => //. -rewrite -(subKr (f y) (f x)). -have [| |] := @MVT_segment R f 0 _ _ xLy. -- move=> z zxy. - apply: Hd. - move: zxy. - rewrite inE/=. - apply: subset_itvSoo; rewrite bnd_simp. - by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. - by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. -- apply: continuous_subspaceW(* NB: should be , do a PRS*) cf. - apply: subset_itvScc; rewrite bnd_simp. - by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. - by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. -move=> r rxy. -rewrite mul0r => ->. -by rewrite subr0. -Qed. - -Lemma is_derive_0_is_cst_new' {R : realType} (f : R -> R) y (a b : R) : - y \in `[a, b] -> - {within `[a, b], continuous f} -> - (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. -Proof. -move => yab cont d x xab /=. -have : (a <= b). - move: xab. - rewrite inE/=in_itv/= => /andP[]. - by apply le_trans. -rewrite le_eqVlt => /predU1P[ab|ab]. -suff [-> ->] : b = x /\ b = y by []. -split;apply /eqP;rewrite eq_le. -by move : xab;rewrite !ab !inE/=!in_itv/=. -by move : yab;rewrite !ab !inE/=!in_itv/=. -suff [-> ->] : f x = f ((a + b) / 2) /\ f y = f ((a+b )/2) by []. -have ab2: (a+b)/2 \in `]a,b[. - rewrite inE/=in_itv/=. - apply/andP;split. - by rewrite ltr_pdivlMr // mulrDr mulr1 ler_ltD //. - rewrite ltr_pdivrMr // mulrDr mulr1 ltr_leD //. -by split;apply /is_derive_0_is_cst_new. -Qed. - -Lemma closed_ball_bounded {K : realType} {n} (x y : 'rV[K]_n) r : 0 < r -> closed_ball x r y -> - `|y| <= `|x| + r. -Proof. -move=> r0. -rewrite closed_ballE// /closed_ball_/= => dxy. -rewrite ler_distlCDr//. -by rewrite (le_trans (ler_dist_dist _ _)). -Qed. - -Section locdef. -Context {R : realType} {T : normedModType R}. -Implicit Types V : T -> R. - -Definition is_Lyapunov_candidate V (D : set T) (x : T) := - x \in D /\ V x = 0 /\ forall z, z \in D -> z != x -> V z > 0. - -(* NB: useful? mettre dans un fichier wip.v? *) -Definition locnegdef V (x : T) := V x = 0 /\ \forall z \near x^', V z < 0. - -(* NB: useful? mettre dans un fichier wip.v? *) -(* locally negative semidefinite *) -Definition locnegsemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z <= 0. - -End locdef. - -(* derivation along the trajectory h *) -Definition derive_along {R : realType} {n : nat} - (V : 'rV[R]_n -> R) (f : R -> 'rV[R]_n) - (t : R) : R := - (jacobian1 V (f t))^T *d 'D_1 f t. - -Notation "''D~(' sol ) f" := (derive_along f (sol)). - -Section derive_along. -Context {R : realType} {n : nat}. -Variable sol : R -> 'rV[R]_n. -(* sol represents a solution of a differential equation *) - -Lemma derive_along_derive (V : 'rV[R]_n -> R) (t : R) : - differentiable V (sol t) -> differentiable sol t -> - 'D~(sol) V t = 'D_1 (V \o sol) t. -(* Warning: we are not representing the initial state at t = 0 of the trajectory sol - see Khalil p.114 *) -Proof. -move=> dif1 dif2. -rewrite /derive_along /=. -rewrite /jacobian1. -rewrite /jacobian. -rewrite /dotmul. -rewrite -trmx_mul. -rewrite mul_rV_lin1. -rewrite mxE. -rewrite -deriveE=> /=; last first. - apply: differentiable_comp => //. - exact/differentiable_scalar_mx. -rewrite derive_mx /=; last first. - apply: derivable_scalar_mx => //. - exact: diff_derivable. -rewrite mxE. -rewrite [in RHS]deriveE/=; last first. - exact: differentiable_comp. -rewrite [in RHS]diff_comp//=. -do 2 (rewrite -[in RHS]deriveE; last by []). -by under eq_fun do rewrite mxE /= mulr1n /=. -Qed. - -Lemma derive_alongMl (f : 'rV_n -> R) (k : R) t : - differentiable f (sol t) -> differentiable sol t -> - 'D~(sol) (k *: f) t = k *: 'D~(sol) f t. -Proof. -move=> dfx dpx. -rewrite derive_along_derive; last 2 first. - exact: differentiable_comp. - by []. -rewrite deriveZ/=; last first. - apply: diff_derivable => /=. - rewrite -fctE. - exact: differentiable_comp. -congr (_ *: _). -by rewrite derive_along_derive. -Qed. - -Lemma derive_alongD (f g : 'rV_n -> R) t : - differentiable f (sol t) -> differentiable g (sol t) -> - differentiable sol t -> - 'D~(sol) (f + g) t = 'D~(sol) f t + 'D~(sol) g t. -Proof. -move=> dfx dgx difp. -rewrite derive_along_derive; last 2 first. - exact: differentiableD. - by []. -rewrite deriveD/=; last 2 first. - apply: diff_derivable => //. - rewrite -fctE. - exact: differentiable_comp. - apply: diff_derivable => //. - rewrite -fctE. - exact: differentiable_comp. -rewrite derive_along_derive; [|by []..]. -by rewrite derive_along_derive. -Qed. - -Lemma derivative_derive_along_eq0 (f : 'rV_n -> R) (t : R) : - differentiable f (sol t) -> - 'D_1 sol t = 0 -> 'D~(sol) f t = 0. -Proof. -move=> df dsol0. -rewrite /derive_along /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. -by rewrite dsol0 mul0mx !mxE. -Qed. - -Lemma derive_along_enorm_squared m (f : 'rV[R]_n -> 'rV[R]_m) (t : R) : - differentiable f (sol t) -> - differentiable sol t -> - 'D~(sol) (fun y => `|f y|_e ^+ 2) t = - (2 *: 'D_1 (f \o sol) t *m (f (sol t))^T) 0 0. -Proof. -move=> difff diffphi. -rewrite derive_along_derive//; last exact: differentiable_enorm_squared. -rewrite fctE derive_enorm_squared //=; last first. - by apply: diff_derivable=> //=; exact: differentiable_comp. -by rewrite mulrDl mul1r scalerDl scale1r mulmxDl [in RHS]mxE. -Qed. - -End derive_along. - -(* NB: not used, can be shown to be equivalent to derive_along *) -Definition derive_along_partial {R : realType} n (V : 'rV[R]_n -> R) - (a : R -> 'rV[R]_n) (t : R) : R := - \sum_(i < n) (partial V (a t) i * ('D_1 a t) ``_ i). - -(*Section picard. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variable u0 : U. -Variable phi : U -> U. -Variable r : {posnum R}. -Let B := closed_ball u0 r%:num. - -Definition stays_in_ball (t0 t1 : R) (f : R -> U) := - {in `[t0, t1], forall t, closed_ball u0 r%:num (f t)}. - -Variable k : R. -Hypothesis k0 : 0 < k. -Hypothesis lip2 : k.-lipschitz_B phi. - -Theorem picard_lindeloeff_autonomous t0 : - exists sol delta, - delta > 0 /\ is_sol_on (fun=> phi) u0 t0 (BLeft (t0 + delta)) sol. -Admitted. - -End picard.*) - -Section ode. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n. -Variable phi : U -> U. - -Definition is_sol_on0o (Delta : itv_bound K) (f : K -> U) := - {in Interval (BLeft 0) Delta, forall t, derivable f t 1 /\ f^`() t = phi (f t)}. -(* NB: (BLeft Delta) -> open on right *) - -Lemma is_sol_on0oP (Delta : K) (f : K -> U) (e : {posnum K} ) : - is_sol_on (fun=> phi) (f (- e%:num)) (- e%:num) (BLeft Delta) f -> - is_sol_on0o (BLeft Delta) f. -Proof. -by move=> [_ H cf] t t0D; apply H; rewrite inE/=; apply: subset_itv t0D; rewrite bnd_simp. -Qed. - -(* "global" solution *) -Definition is_sol_on0y (f : K -> U) := is_sol_on0o (BInfty K false) f. - -(* TODO: generalize this lemma *) -Lemma is_sol_on0yP (f : K -> U) : is_sol_on0o (BInfty K false) f <-> - forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). -Proof. -split=> H t t0oo; apply: H. - by rewrite in_itv/= andbT. -by move: t0oo; rewrite in_itv/= andbT. -Qed. - -Lemma global_sol_sol f : is_sol_on0y f -> forall Delta, is_sol_on0o Delta f. -Proof. -move=> + Delta t t0D. -apply. -by move: t0D;rewrite !in_itv/= => /andP[->]. -Qed. - -End ode. - -Section is_sol. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n. -Variables (phi : U -> U) (Delta : K). - -(*Lemma is_sol_on0oS (A B : set U) : A `<=` B -> - is_sol_on0o phi Delta A `<=` is_sol_on0o phi Delta B. -Proof. -move=> AB f. -rewrite /is_sol_on0o inE => -[inD0 [_ deri cont]]; rewrite inE. -split => //. -by apply: AB. -Qed. -*) -End is_sol. - -Section state_space. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. - -(* TODO: two state_space definitions?! *) -Definition state_space (Init : set T) : set T := - [set x | exists f Delta, [/\ f 0 \in Init, is_sol_on0o phi (BLeft Delta) f & - (exists t, t \in `[0, Delta[%R /\ x = f t) ]]. - -End state_space. - -Section equilibrium_point. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. (* was (K -> T) -> K -> T *) -Variable Init : set T. -Variable Delta : K. - -Definition is_equilibrium_point (x : T) := - x \in Init /\ forall Delta, is_sol_on0o phi Delta (cst x). - -Lemma equilibrium_point_in_state_space (x : T) : is_equilibrium_point x -> x \in state_space phi Init. -Proof. - move => [xinit solD]. - rewrite inE. - exists (cst x). - exists (1). - split=>//. - exists 0. - split=>//. - by rewrite in_itv/= lexx //= ltW. -Qed. -End equilibrium_point. - -Section equilibrium_point. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. - -Definition equilibrium_points A := [set p : T | is_equilibrium_point phi A p]. - -Lemma equilibrium_points_subset (A B : set T) : A `<=` B -> - equilibrium_points A `<=` equilibrium_points B. -Proof. -move=> AB x. -rewrite /equilibrium_points/= /is_equilibrium_point /is_sol_on0o inE => -[Ax H]. -split. - exact/mem_set/AB. -move=> Delta t t0D. -have [deriv1 deriv2] := H Delta t t0D. -by split => //. -Qed. - -End equilibrium_point. - -Section stability. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. -Variable Init : set T. - -Definition is_locally_stable_at (x : T) := - forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n) (Delta : K), f 0 \in Init /\ is_sol_on0o phi (BLeft Delta) f -> - `| f 0 - x | < d -> forall t, 0 < t < Delta -> `| f t - x | < eps. - -(* assuming solution exists for all time *) -Definition is_stable_at (x : T) := - forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n), f 0 \in Init /\ is_sol_on0y phi f -> - `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. - -Lemma locally_stable_stable x : is_locally_stable_at x -> is_stable_at x. -Proof. -move => lstable e e0. -move /(_ _ e0) : lstable => [d d0 stable]. -exists d => // z [z0Init zglob] zd t t0. -apply (stable _ (t + 1)) => //. - split => //. - by apply global_sol_sol. -by rewrite t0/= ltrDl. -Qed. - -Definition is_asymptotically_stable_at (x : T) (f : K -> 'rV[K]_n) : Prop := - exists2 d, d > 0 & `| f 0 - x | < d -> f t @[t --> +oo] --> x. - -End stability. - -Section bounded. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. -(* Variable sol : K->T. *) -Variable Init : set T. -Variable x0 : T. -(* Hypothesis solP: is_sol phi Delta sol Init. *) -(* Lemma stable_bounded : is_locally_stable_at phi Init x0 -> forall eps, exists d, forall u0 Delta sol, `|u0 - x0| <= d -> is_sol_autonomous u0 phi 0 Delta sol -> forall t, 0<=t<=Delta -> `|sol t - x0| <= eps. *) -(* Proof. *) -(* move => stable eps. *) -(* have := *) -End bounded. -(* f' = phi f *) -(* phi_robot f =def= fun f t => phi t (f t) *) -(*Definition existence_uniqueness {K : realType} {n} - (phi : K -> 'rV[K]_n -> 'rV[K]_n) (Init : set 'rV[K]_n) Delta - (sol : K -> 'rV[K]_n) := - forall y, y 0 \in Init -> is_sol phi Init Delta y <-> sol (y 0) = y. -*) - -Definition initial_condition {K : realType} {n} (sol : K -> 'rV[K]_n) x0 := - sol 0 = x0. - -(*Section solutions_unique. -Context {K : realType} {n : nat}. -Variable phi : K -> 'rV[K]_n -> 'rV[K]_n. -Variable Init : set 'rV[K]_n. -Variable Delta : K. - -Definition solutions_unique := forall (f g : K -> 'rV_n) (x0 : 'rV_n), - is_sol phi Init Delta f -> - is_sol phi Init Delta g -> - f 0 = x0 -> g 0 = x0 -> - f = g. - -End solutions_unique. - -Section solutions_unique_lemmas. -Context {K : realType} {n : nat}. -Variables (phi : K -> 'rV[K]_n -> 'rV[K]_n) (Init : set 'rV[K]_n). -Variable Delta : K. - -Lemma existence_uniqueness_unique (sol : 'rV[K]_n -> K -> 'rV[K]_n) : - existence_uniqueness phi Init Delta sol -> - solutions_unique phi Init Delta. -Proof. -move=> solP f g x0 solf solg f0 g0. -apply/funext => x. -case : (solf) => //=. -move => a0D Da fa. -have := solP _ a0D. -case. -move => /(_ solf). -move => a0a _. -case : (solg) => //=. -move => b0D Db fb. -have := solP _ b0D. -case. -move => /(_ solg). -move => b0b _. -by rewrite -b0b -a0a f0 g0. -Qed. - -Lemma existence_uniqueness_exists (sol : K -> 'rV[K]_n) : - existence_uniqueness phi Init Delta sol -> forall p, p \in Init -> - initial_condition sol p -> is_sol phi Init Delta (sol p). -Proof. -move=> solP sol0 p pD. -have H := solP (sol p). -apply H. - by rewrite sol0. -by rewrite sol0. -Qed. - -End solutions_unique_lemmas.*) - -Section sphere. -Context {K : realType} {n : nat}. - -Definition sphere r := [set x : 'rV[K]_n | `|x| = r]. - -Lemma sphere_nonempty r : n != 0 -> 0 < r -> sphere r !=set0. -Proof. -move=> n0. -move=> r_gt0. -rewrite /sphere. -exists (const_mx r). -rewrite /sphere /= /normr/=. -(* TODO: need lemma? *) -rewrite mx_normrE/=. -apply/eqP; rewrite eq_le; apply/andP; split. - apply: bigmax_le. - exact: ltW. - by move=> i _; rewrite mxE gtr0_norm. -under eq_bigr do rewrite mxE gtr0_norm//. -apply/le_bigmax => /=. -destruct n as [|n'] => //. -exact: (ord0, ord0). -Qed. - -Lemma compact_sphere r : compact (sphere r). -Proof. -apply: bounded_closed_compact. - suff : \forall M \near +oo, forall p, sphere r p -> forall i, `|p ord0 i| < M. - rewrite /bounded_set; apply: filter_app; near=> M0. - move=> Kbnd /= p /Kbnd ltpM0. - rewrite /normr/= mx_normrE. - apply/bigmax_leP; split => //= i _. - by rewrite ord1; exact/ltW/ltpM0. - near=> M => v. - rewrite /sphere /= => vr i. - rewrite (@le_lt_trans _ _ r)//. - rewrite -vr [leRHS]/normr/= mx_normE. - under eq_bigr do rewrite ord1. - rewrite -(pair_big xpredT xpredT (fun _ j => `|v ord0 j|%:nng))//=. - rewrite big_ord_recr/= big_ord0. - rewrite max_r; last exact/bigmax_ge_id. - rewrite (bigD1 i)//= -maxE le_max. - by apply/orP; left. - clear v vr i. - by near: M; apply: nbhs_pinfty_gt; rewrite num_real. -pose d := fun x : 'rV[K]_n => `|x| : K. -have contd : continuous d by move=> /= z; exact: norm_continuous. -rewrite [X in closed X](_ : _ = d @^-1` [set r]); last first. - by apply/seteqP; split. -by apply continuous_closedP. -Unshelve. all: by end_near. Qed. - -End sphere. - -Section Lyapunov_stability0. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n.+1. -Variable phi : U -> U. -Variable Delta : K. -Variable u0 : U. -Variable sol : K -> U (* TODO(2026-02-08): maybe this should be U -> K -> U to match lasalle *). -Hypothesis solP : is_sol_on0o phi (BLeft Delta) sol. - -Variable V : U -> K. -Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. - -Lemma V_nincr a b : b < Delta -> 0 <= a <= b -> - V (sol b) <= V (sol a). -Proof. -move=> bDelta /andP[a_ge0 ab]. -apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. -- move=> y yb. - apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. - rewrite -derivable1_diffP. - move: solP. - move/(_ y) /(_ _) => []. - move: yb. - apply: subset_itv; rewrite bnd_simp//. - exact: ltW. - by []. -- move=> y yb. - rewrite derive1E -derive_along_derive//. - + apply: V'_le0. - move : yb; rewrite in_itv/= => /andP[->/= /lt_le_trans]; apply. - exact: ltW. - + rewrite -derivable1_diffP. - move: solP. - move/(_ y) /(_ _) => []. - move: yb. - apply: subset_itv; rewrite bnd_simp//. - exact/ltW. - by []. -- (* `[0, b] *) - have [b0|] := ltP 0 b; last first. - move=> b0. - have ? : b = 0. - by apply/eqP; rewrite eq_le b0 (le_trans a_ge0)//. - subst b. - rewrite set_itv1. - exact: continuous_subspace1. - apply/continuous_within_itvP => //; split. - + move=> z z0b. - apply: continuous_comp; last exact: differentiable_continuous. - apply: differentiable_continuous => //. - rewrite -derivable1_diffP. - move: solP. - move/(_ z) /(_ _) => []. - move: z0b. - by apply: subset_itv; rewrite bnd_simp// ltW. - by []. - + have d0 : 0 < Delta by apply /lt_trans/bDelta. - have cont : {in `[0, Delta[%R, continuous sol}. - move=> t t0D. - apply: differentiable_continuous. - apply/derivable1_diffP. - by apply solP. - apply: cvg_comp. - apply: cvg_at_right_filter. - apply: cont. - by rewrite in_itv/= lexx. - by apply (differentiable_continuous (Vdiff (sol 0))). - + apply: cvg_at_left_filter. - apply: differentiable_continuous => //. - apply: differentiable_comp. - rewrite -derivable1_diffP. - move: solP. - move/(_ b) /(_ _) => []. - by rewrite in_itv/= (ltW b0)// bDelta. - by []. - by apply: Vdiff. -- by rewrite !in_itv/= lexx (le_trans a_ge0). -- by rewrite in_itv/= ab andbT. -Qed. - -End Lyapunov_stability0. - -Section Lyapunov_stability. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n.+1. -Variable phi : U -> U. -Variable Init : set U. -Let u0 : U := 0. -Hypothesis u0Init : u0 \in Init. - -Hypothesis openInit : open Init. (* Init est forcement un ouvert *) -(* see Cohen Rouhling ITP 2017 Sect 3.2 *) - -Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. - -Let BE s : 0 < s -> B s = closed_ball 0 s. -Proof. by move=> r0; rewrite /B -closed_ballE. Qed. - -Variable V : U -> K. -Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall Delta sol, sol 0 \in Init -> is_sol_on0o phi (BLeft Delta) sol -> - forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. - -(* khalil theorem 4.1 *) -Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) : - is_Lyapunov_candidate V Init x -> - is_equilibrium_point phi Init x -> - is_locally_stable_at phi Init x. -Proof. -move=> VDx eq /= eps eps0/=. -move: VDx => [/= xD [Vx0 DxV]]. -have [r r_gt0 [r_eps BrD]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` Init. - move: xD; rewrite inE => /(open_subball openInit)[r0/= r0_gt0] q. - pose r := Num.min (r0 / 2) eps. - have r_gt0 : 0 < r by rewrite /r lt_min eps0 divr_gt0. - exists (r / 2); first by rewrite divr_gt0. - split; first by rewrite /r ler_pdivrMr// ge_min ler_pMr// ler1n orbT. - move=> v Brv; apply (q r) => //. - rewrite /ball/= sub0r normrN gtr0_norm//. - by rewrite /r gt_min ltr_pdivrMr// ltr_pMr// ltr1n. - by move: Brv; rewrite BE ?divr_gt0//; exact: subset_closure_half. -have alpha_min : {x : 'rV[K]_n.+1 | x \in sphere r /\ - forall y, y \in sphere r -> V x <= V y}. - have : {within sphere r, continuous V}. - apply: continuous_subspaceT => /= v. - by apply/differentiable_continuous; exact/Vdiff. - move/(EVT_min_rV (sphere_nonempty _ r_gt0) (@compact_sphere _ _ r)). - have m0 : n.+1 != 0 by []. - move=> /(_ m0). - by move=> /cid2[c sphere_r_c sphere_r_V]; exists c. -pose alpha := V (sval alpha_min). -have alpha_gt0 : 0 < alpha. - have sphere_pos y : y \in sphere r -> 0 < V y. - move=> yr; apply: DxV; last first. - rewrite gtr0_norm_neq0//. - by move: yr; rewrite inE /sphere/= => ->. - apply/mem_set/BrD. - move : yr; rewrite inE /sphere/= => <-. - by rewrite /B /closed_ball_/= sub0r normrN. - rewrite /alpha sphere_pos// /sphere inE/=. - by have [+ _] := svalP alpha_min; rewrite inE. -have [beta /andP[beta_gt0 beta_alpha]] : exists beta, 0 < beta < alpha. - by exists (alpha / 2); rewrite divr_gt0//= ltr_pdivrMr//= ltr_pMr// ltr1n. -set Omega_beta := [set x : 'rV[K]_n.+1 | B r x /\ V x <= beta]. -have Omega_beta_Br : Omega_beta `<=` (B r)°. - move=> y [Bry Vybeta]. - rewrite BE// interior_closed_ballE => //=. - have yr : `|y| <= r by move: Bry; rewrite /B /closed_ball_/= sub0r normrN. - have [{}yr | ry | {}yr] := ltgtP (`|y|) r. - - by rewrite mx_norm_ball /ball_/= sub0r normrN. - - by have := le_lt_trans yr ry; rewrite ltxx. - - have alphaVy : alpha <= V y. - by rewrite /alpha; case: (svalP alpha_min) => [_]; apply; rewrite inE. - by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. -(* any trajectory starting in Omega_beta at t = 0 - stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta Delta sol : sol 0 \in Init -> is_sol_on0o phi (BLeft Delta) sol -> - sol 0 \in Omega_beta -> forall t, 0 < t < Delta -> sol t \in Omega_beta. - move=> sol0 solP phi_Omega. - have /= V_nincr_consequence : forall t, 0 < t < Delta -> forall u, 0 <= u <= t -> - 'D~(sol) V u <= 0 -> - V (sol t) <= V (sol 0) <= beta. - move=> /= t1 /andP[t10 t1Delta] u ut1 Vle0. - apply/andP; split. - move : phi_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. - apply: (@V_nincr _ _ phi Delta sol). - assumption. - move=> t. - by apply: Vdiff. - move=> /= t t0. - apply: V'_le0 => //. - exact: solP. - assumption. - assumption. - by rewrite lexx/= (ltW t10). - by move: phi_Omega; rewrite inE => -[Brh0 Vh0beta]. - move=> t /andP[t0 tDelta]. - rewrite inE; split; last first. - have : 'D~(sol) V t <= 0. - apply: V'_le0 => //. - exact: solP. - by rewrite t0/=. - have := @V_nincr_consequence t. - rewrite t0 /= tDelta => /(_ isT t). - rewrite lexx (ltW t0)/= => /(_ isT). - move=> /[apply]. - by move=> /andP[/le_trans] => /[apply]. - move: phi_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. - rewrite !sub0r !normrN => -[phi0r Vphi0beta]. - rewrite leNgt; apply/negP => phi_t_r. - have [t1 [/andP[t1_ge0 t1t] phit1r]] : exists t0, 0 <= t0 <= t/\ `|sol t0| = r. - have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o sol)}. - (* `[0, t] *) - apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) (sol)) => //. - exact: ltW. - move=> z _. - by apply: norm_continuous. - have cont : {in `[0, Delta[, continuous sol}. - move=> t' t'0D. - rewrite inE in t'0D. - apply: differentiable_continuous. - apply/derivable1_diffP. - by apply solP. - move/continuous_in_subspaceT : cont. - apply: continuous_subspaceW. - by apply: subset_itvl; rewrite bnd_simp. - have : min `|sol 0| `|sol t| <= r <= max `|sol 0| `|sol t|. - by rewrite ge_min phi0r/= le_max (ltW phi_t_r) orbT. - move=> /(IVT (ltW t0) norm_phi_cont)[c cI norm_phi_c]. - by exists c; split => //; move/itvP: cI => ->. - have alphaVphit1 : alpha <= V (sol t1). - rewrite {alpha_gt0 beta_alpha} /alpha; case: alpha_min => /=. - by move=> y [_ +]; apply; rewrite inE. - have : beta < V (sol t1). - by rewrite (lt_le_trans _ alphaVphit1)//; case/andP : beta_alpha. - apply/negP; rewrite -leNgt. - move: t1_ge0; rewrite le_eqVlt => /predU1P[<-//|t10]. - have := @V_nincr_consequence t1. - rewrite t10 (le_lt_trans t1t tDelta) => /(_ isT). - move=> /(_ t1). - rewrite (ltW t10) lexx => /(_ isT). - have : 'D~(sol) V t1 <= 0. - apply: V'_le0 => //. - exact: solP. - by rewrite t10/= (le_lt_trans _ tDelta). - move=> /[swap] /[apply]. - by move=> /andP[/le_trans] => /[apply]. -have _ : compact Omega_beta. - apply: bounded_closed_compact; rewrite /Omega_beta. - - rewrite /bounded_set /= /globally. - exists r; split => //= t rt v. - rewrite /B /closed_ball_/= sub0r normrN. - by move=> [/le_trans vr _]; rewrite vr// ltW. - - apply: closedI => /=. - by rewrite BE//; exact: closed_ball_closed. - rewrite [X in closed X](_ : _ = V @^-1` [set x | x <= beta]); last first. - by apply/seteqP; split. - apply: closed_comp => //= v _. - apply: continuous_comp; first by []. - exact: differentiable_continuous. -have [d0 d0_gt0 Vbeta] : exists2 d, d > 0 & forall x, `|x| <= d -> V x < beta. - have [d d_gt0 xdV] : exists2 d : K, 0 < d & - forall y, `|y - x| < d -> `|V y - V x| < beta. - have /cvgrPdist_lt /(_ _ beta_gt0) : V x @[x --> nbhs x] --> V x. - exact/differentiable_continuous/Vdiff. - rewrite nearE /= => /nbhs_ballP[d /= d_pos xdV]. - exists d => // y. - move: xdV; rewrite mx_norm_ball /ball_ /= distrC => /[apply]. - by rewrite distrC. - exists (d / 2); first exact: divr_gt0. - move=> v vd; have /(xdV v) : `|v - x| < d. - by rewrite subr0 (le_lt_trans vd)// ltr_pdivrMr // ltr_pMr // ltr1n. - by rewrite Vx0 subr0; apply: le_lt_trans; rewrite ler_normlW. -pose delta := Num.min d0 r. -have delta_gt0 : 0 < delta by rewrite /delta lt_min d0_gt0 r_gt0. -have deltaV y : `|y| <= delta -> V y < beta. - move=> /= ydelta. - have : `|y| <= d0 by rewrite (le_trans ydelta)// /delta ge_min lexx. - exact: Vbeta. -have B_delta_Omega_beta : B delta `<=` Omega_beta. - rewrite /Omega_beta => /= v. - rewrite /B /closed_ball_/= sub0r normrN => vdelta. - split; last exact/ltW/deltaV. - by rewrite (le_trans vdelta)// /delta ge_min lexx orbT. -(*have _ : (B delta) (sol x 0) -> - forall t, t >= 0 -> sol x t \in Omega_beta -> (B r) (sol x t). - by move => ball0 t1 t1_ge0; rewrite /Omega_beta inE => -[].*) -rewrite /x. -exists delta => //. -move=> sol Delta' [sol0 solP] sol_delta t0 t0_ge0. -rewrite subr0. -have : sol 0 \in Omega_beta. - rewrite inE; apply: B_delta_Omega_beta. - rewrite /B /closed_ball_/= sub0r normrN; apply/ltW. - by rewrite subr0 in sol_delta. -rewrite inE => -[+ _]. -rewrite /B /closed_ball_/= sub0r normrN => solx0r. -have : (B r)° (sol t0). - apply: Omega_beta_Br; apply/set_mem. - apply: Df_Omega_beta => //. - exact: solP. - rewrite inE; split; first by rewrite /B /closed_ball_/= sub0r normrN. - have : B delta (sol 0). - rewrite /closed_ball_; apply: ltW; rewrite sub0r normrN. - by rewrite subr0 in sol_delta. - by move/B_delta_Omega_beta => []. - assumption. -rewrite BE//= interior_closed_ballE//=. -rewrite mx_norm_ball /ball_/= sub0r normrN => /lt_le_trans; exact. -Unshelve. all: by end_near. Qed. - -End Lyapunov_stability. - Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). @@ -1387,11 +362,11 @@ Definition eqn_functional (f : K -> 'rV[K]_6) : K -> 'rV[K]_6 := (- alpha1 *: error1_p_dot t) (eqn14b_rhs gamma (error1_p_dot t) (error2_p_dot t)). -Definition eqn (zp1_z2_point : 'rV[K]_6) : 'rV[K]_6 := - let zp1_point := Left zp1_z2_point in - let z2_point := Right zp1_z2_point in - row_mx (- alpha1 *: zp1_point) - (eqn14b_rhs gamma zp1_point z2_point). +Definition eqn (dot_zp1_z2 : 'rV[K]_6) : 'rV[K]_6 := + let dot_zp1 := Left dot_zp1_z2 in + let dot_z2 := Right dot_zp1_z2 in + row_mx (- alpha1 *: dot_zp1) + (eqn14b_rhs gamma dot_zp1 dot_z2). Lemma eqnE (f : K -> 'rV[K]_6) t : eqn (f t) = eqn_functional f t. Proof. by []. Qed. @@ -1399,7 +374,7 @@ Proof. by []. Qed. Lemma eqn_functionalE f t : eqn_functional f t = eqn (f t). Proof. by []. Qed. -Definition Gamma1 := [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. +Definition Upsilon1 := [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). @@ -1506,7 +481,7 @@ rewrite ge_max; apply/andP; split. by rewrite !mulrA ler_pM. Unshelve. all: by end_near. Qed. -Lemma tilt_state_spaceS : state_space phi Tilt.Gamma1 `<=` Tilt.Gamma1. +Lemma tilt_state_spaceS : state_space phi Tilt.Upsilon1 `<=` Tilt.Upsilon1. Proof. move => p [y [Delta [y0_init1 deri]]]. have [Delta0|Delta0] := leP 0 Delta; last first. @@ -1514,7 +489,7 @@ have [Delta0|Delta0] := leP 0 Delta; last first. rewrite in_itv/= => -/andP[x0 xDelta]. have := lt_trans xDelta Delta0. by rewrite ltNge x0. -rewrite /Tilt.Gamma1. +rewrite /Tilt.Upsilon1. have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))))^`() =1 0}. move => x xd /=. transitivity ((fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))) x). @@ -1629,18 +604,18 @@ suff: `|'e_2 - Right (y t)|_e ^+ 2 = 1. rewrite norm_constant//; last first. by rewrite inE. move: y0_init1. -rewrite inE /Tilt.Gamma1 /= => ->. +rewrite inE /Tilt.Upsilon1 /= => ->. by rewrite expr2 mulr1. Qed. -Lemma tilt_point1_in_state_space : @Tilt.point1 K \in Tilt.Gamma1. +Lemma tilt_point1_in_state_space : @Tilt.point1 K \in Tilt.Upsilon1. Proof. -rewrite inE /Tilt.Gamma1 /Tilt.point1/=. +rewrite inE /Tilt.Upsilon1 /Tilt.point1/=. by rewrite rsubmx_const /= subr0 enormeE. Qed. Lemma equilibrium_tilt_point1 : - is_equilibrium_point phi Tilt.Gamma1 Tilt.point1. + is_equilibrium_point phi Tilt.Upsilon1 Tilt.point1. Proof. split. - exact: tilt_point1_in_state_space. @@ -1660,9 +635,9 @@ split. by move => n; rewrite n scaler0 mul0mx. Qed. -Lemma tilt_point2_in_state_space : @Tilt.point2 K \in Tilt.Gamma1. +Lemma tilt_point2_in_state_space : @Tilt.point2 K \in Tilt.Upsilon1. Proof. -rewrite inE /Tilt.Gamma1 /Tilt.point2 /=. +rewrite inE /Tilt.Upsilon1 /Tilt.point2 /=. rewrite row_mxKr. rewrite -[X in X - _ ]scale1r. rewrite -scalerBl enormZ enormeE mulr1 distrC. @@ -1671,7 +646,7 @@ by rewrite -natrB //= normr1. Qed. Lemma equilibrium_tilt_point2 : - is_equilibrium_point phi Tilt.Gamma1 Tilt.point2. + is_equilibrium_point phi Tilt.Upsilon1 Tilt.point2. Proof. split; first exact: tilt_point2_in_state_space. move=> Delta. @@ -1915,9 +890,9 @@ Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : t \in `[0, Delta[%R -> - sol 0 \in Tilt.Gamma1 -> + sol 0 \in Tilt.Upsilon1 -> is_sol_on0o phi (BLeft Delta) sol -> - Tilt.Gamma1 (sol t). + Tilt.Upsilon1 (sol t). Proof. move=> t0Delta sol0 deriv_sol. move: t0Delta. @@ -1933,12 +908,12 @@ Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - sol 0 \in Tilt.Gamma1 -> + sol 0 \in Tilt.Upsilon1 -> is_sol_on0o phi (BLeft Delta) sol -> `|u|_e = 1. Proof. move=> z0Delta sol0 dtraj. -suff: Tilt.Gamma1 (row_mx (zp1 z) (z2 z)). - by rewrite /Tilt.Gamma1/= row_mxKr. +suff: Tilt.Upsilon1 (row_mx (zp1 z) (z2 z)). + by rewrite /Tilt.Upsilon1/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. by apply: is_sol_state_space_tilt => //. Qed. @@ -1946,7 +921,7 @@ Qed. Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, Delta[%R -> - sol 0 \in Tilt.Gamma1 -> + sol 0 \in Tilt.Upsilon1 -> is_sol_on0o phi (BLeft Delta) sol -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. @@ -1971,7 +946,7 @@ Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : z \in `[0, Delta[%R -> - sol 0 \in Tilt.Gamma1 -> + sol 0 \in Tilt.Upsilon1 -> is_sol_on0o phi (BLeft Delta) sol -> `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = `|Right (sol z) *m \S('e_2)|_e. @@ -1981,7 +956,7 @@ rewrite mulmxN enormN. pose zp1 := fun r => Left (sol r). pose z2 := fun r => Right (sol r). set w := (z2 z) *m \S('e_2). -have Gamma1_traj : Tilt.Gamma1 (sol z) by apply/is_sol_state_space_tilt. +have Upsilon1_traj : Tilt.Upsilon1 (sol z) by apply/is_sol_state_space_tilt. rewrite /enorm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. have Hnorm_sq : `|w *m \S('e_2 - Right (sol z))|_e ^+ 2 = `|w|_e ^+ 2. @@ -2062,7 +1037,7 @@ Definition u1 (sol : K -> 'rV[K]_6) t \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 t|_e, 1 |-> `|w|_e] i. Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - sol 0 \in Tilt.Gamma1 -> + sol 0 \in Tilt.Upsilon1 -> is_sol_on0o phi (BLeft Delta) sol -> forall t, t \in `[0, Delta[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. @@ -2096,7 +1071,7 @@ Qed. Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : is_sol_on0o phi (BLeft Delta) sol -> - sol 0 \in Tilt.Gamma1 -> + sol 0 \in Tilt.Upsilon1 -> t \in `[0, Delta[%R -> V1dot (sol t) = 0 -> sol t = Tilt.point1 \/ sol t = Tilt.point2. @@ -2126,7 +1101,7 @@ suff [-> | -> ] : Right (sol t) = 0 \/ Right (sol t) = (2 *: 'e_2). right;apply /matrixP => i j;rewrite mxE. by case: splitP => // k _. have := is_sol_state_space_tilt t0d sol0 solP. -rewrite /Tilt.Gamma1/=. +rewrite /Tilt.Upsilon1/=. have /sub_rVP [k ->] : (Right (sol t) <= ('e_2 : 'rV[K]_3))%MS. apply: (@submx_trans _ _ _ _ _ _ (kermx \S('e_2))). by apply /sub_kermxP. @@ -2228,14 +1203,14 @@ Abort. Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : is_sol_on0o phi (BLeft Delta) (sol x) -> - sol x 0 \in Tilt.Gamma1 -> - (forall t : K, Tilt.Gamma1 (sol x t)) -> + sol x 0 \in Tilt.Upsilon1 -> + (forall t : K, Tilt.Upsilon1 (sol x t)) -> sol x 0 = Tilt.point1 -> locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. move=> solves sol0 state y0. split. - rewrite /is_sol in solves. + rewrite /is_sol_on0o in solves. rewrite /= derivative_derive_along_eq0 => //; last first. admit. rewrite /V1. @@ -2274,7 +1249,7 @@ rewrite derive_along_V1. - by []. - move => t t0Delta. apply/derivable1_diffP => //. - move : solves; rewrite /is_sol. + move : solves; rewrite /is_sol_on0o. move=> deri. apply deri. move: t0Delta; rewrite inE/=. @@ -2304,7 +1279,7 @@ Qed.*) Abort.*) Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : is_sol_on0o phi (BLeft Delta) sol -> - sol 0 \in Tilt.Gamma1 -> + sol 0 \in Tilt.Upsilon1 -> (forall t, 0 < t < Delta -> differentiable sol t) -> forall t : K, 0 < t < Delta -> 'D~(sol) (V1 alpha1 gamma) t <= 0. @@ -2438,7 +1413,7 @@ Qed. Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : is_sol_on0y phi sol -> - sol 0 \in Tilt.Gamma1 -> + sol 0 \in Tilt.Upsilon1 -> forall t : K, 0 <= t -> 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. @@ -2492,7 +1467,7 @@ exact/differentiable_enorm_squared/differentiable_rsubmx_comp. Qed. Lemma equilibrium_zero_stable : - 0 \in Init -> open Init -> Init `<=` Tilt.Gamma1 -> + 0 \in Init -> open Init -> Init `<=` Tilt.Upsilon1 -> is_locally_stable_at phi Init Tilt.point1. Proof. move=> Init0 openInit Init_in_state. @@ -2527,80 +1502,3 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). Qed. End equilibrium_zero_stable. - -(* TODO: move *) -Lemma open_disjoint_separated (X : topologicalType) (A B : set X) : - open A -> open B -> A `&` B = set0 -> separated A B. -Proof. -move=>Ao Bo ABdisj. -split. -apply /disjoints_subset. -rewrite (closure_id (~` B)).1; last by apply open_closedC. -by apply /closure_subset/disjoints_subset. -rewrite setIC;apply /disjoints_subset. -rewrite (closure_id (~` A)).1; last by apply open_closedC. -apply /closure_subset/disjoints_subset. -by rewrite setIC. -Qed. - -(* TODO: move *) -Lemma separated_closedUP {T : topologicalType} (A B : set T) : separated A B -> - closed (A `|` B) <-> closed A /\ closed B. -Proof. -move => ABsep. -split => [/closure_id h | [h1 h2]]; last by apply closedU. -rewrite closureU in h. -split;apply /closure_id/seteqP;split => [|x cx]; try by apply subset_closure. -have /orP[] : (x \in A) || (x \in B). - by rewrite -in_setU h inE/=;left. -by rewrite inE. -rewrite inE => xB. -have [/seteqP[+ _] _] := ABsep. -case /(_ x). -by split. -have /orP[] : (x \in A) || (x \in B). - by rewrite -in_setU h inE/=;right. -rewrite inE => xB. -have [_ /seteqP[+ _]] := ABsep. -case /(_ x). -by split. -by rewrite inE. -Qed. - -(* TODO: move *) -Lemma mxnorm_enorm_le {K : realType} {n} (x : 'rV[K]_n) : `|x| <= `|x|_e. -Proof. -rewrite /Num.norm/=mx_normrE. -apply/bigmax_leP; split. - exact: enorm_ge0. -move=> /= [i j] _ /=. -rewrite {i}ord1. -rewrite -sqrtr_sqr. -rewrite /enorm dotmulvv sqr_enorm. -rewrite ler_sqrt; last by apply sumr_ge0 => k _;apply sqr_ge0. -rewrite (bigD1 j) //=. -rewrite lerDl. -by apply sumr_ge0 => k _;apply sqr_ge0. -Qed. - -Lemma continuous_enorm {K : realType} {n : nat} : - continuous (fun u : 'rV[K]_n => `|u|_e). -Proof. -move=> /= x. -rewrite /enorm/=. -apply/ continuous_comp=>/=. -apply: differentiable_continuous. -under eq_fun do rewrite dotmulvv sqr_enorm. -rewrite /=. -have <- : (\sum_(i < n) (fun x0 : 'rV[K]_n => x0``_i ^+ 2)) = - (fun x0 : 'rV[K]_n => \sum_(i < n) x0``_i ^+ 2). - apply funext => x0 /=. - by apply: (big_morph (fun f : 'rV[K]_n -> K => f x0)). -apply : differentiable_sum. -move => i. -have -> : (fun x0 : 'rV[K]_n => x0``_i ^+ 2) = - (fun x0 : 'rV_n => x0``_i ) ^+2 by []. -apply: differentiableX. -apply: differentiable_coord. -exact: sqrt_continuous. -Qed. diff --git a/tilt_mathcomp.v b/tilt_mathcomp.v index f7eb01d5..140e080c 100644 --- a/tilt_mathcomp.v +++ b/tilt_mathcomp.v @@ -1,6 +1,11 @@ From mathcomp Require Import all_boot all_order all_algebra ring. Require Import ssr_ext euclidean rigid frame skew. +(**md**************************************************************************) +(* # Additions to the MathComp library *) +(* *) +(******************************************************************************) + Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -12,3 +17,6 @@ Lemma sqr_inj {R : rcfType} : {in Num.nneg &, injective (fun x : R => x ^+ 2)}. Proof. by move=> x y x0 y0 /(congr1 (@Num.sqrt R)); rewrite !sqrtr_sqr! ger0_norm. Qed. + +Lemma gerN {R : numDomainType} (x : R) : 0 <= x -> - x <= x. +Proof. by move=> x0; rewrite ge0_cp. Qed. diff --git a/tilt_robot.v b/tilt_robot.v index 12fd4b2a..26015119 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -2,9 +2,14 @@ From HB Require Import structures. From mathcomp Require Import all_boot all_order all_algebra ring. From mathcomp Require Import interval_inference. From mathcomp Require Import boolp classical_sets functions reals. -From mathcomp Require Import topology normedtype derive. +From mathcomp Require Import topology normedtype derive realfun. Require Import ssr_ext euclidean rigid frame skew derive_matrix tilt_analysis. +(**md**************************************************************************) +(* # Additions to the RobotRocq library *) +(* *) +(******************************************************************************) + Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -319,6 +324,43 @@ apply/derivable1_diffP/derivable_sqrt. by rewrite dotmulvv expr2 mulr_gt0 //= !enorm_gt0. Qed. +Lemma mxnorm_enorm_le {K : realType} {n} (x : 'rV[K]_n) : `|x| <= `|x|_e. +Proof. +rewrite /Num.norm/=mx_normrE. +apply/bigmax_leP; split. + exact: enorm_ge0. +move=> /= [i j] _ /=. +rewrite {i}ord1. +rewrite -sqrtr_sqr. +rewrite /enorm dotmulvv sqr_enorm. +rewrite ler_sqrt; last by apply sumr_ge0 => k _;apply sqr_ge0. +rewrite (bigD1 j) //=. +rewrite lerDl. +by apply sumr_ge0 => k _;apply sqr_ge0. +Qed. + +Lemma continuous_enorm {K : realType} {n : nat} : + continuous (fun u : 'rV[K]_n => `|u|_e). +Proof. +move=> /= x. +rewrite /enorm/=. +apply/continuous_comp=>/=. + apply: differentiable_continuous. + under eq_fun do rewrite dotmulvv sqr_enorm. + rewrite /=. + have <- : \sum_(i < n) (fun x0 : 'rV[K]_n => x0``_i ^+ 2) = + (fun x0 : 'rV[K]_n => \sum_(i < n) x0``_i ^+ 2). + apply funext => x0 /=. + exact: (big_morph (fun f : 'rV[K]_n -> K => f x0)). + apply: differentiable_sum. + move => i. + have -> : (fun x0 : 'rV[K]_n => x0``_i ^+ 2) = + (fun x0 : 'rV_n => x0``_i ) ^+2 by []. + apply: differentiableX. + exact: differentiable_coord. +exact: sqrt_continuous. +Qed. + Lemma derivable_enorm_squared {K : realType} n (f : K -> 'rV[K]_n) (x0 : K) : derivable f x0 1 -> derivable (fun x => `|f x|_e ^+ 2) x0 1. @@ -391,9 +433,22 @@ apply: lerD. exact: spin_le_norm. exact: spin_le_norm. rewrite -mulrA (mulrC `|y|) mulrA. -apply: (le_trans (mx_norm_mul _ _)). -apply : ler_pM => //. - apply : ler_pM => //. - exact: spin_le_norm. +rewrite (le_trans (mx_norm_mul _ _))//. +rewrite ler_pM//. + by rewrite ler_pM// spin_le_norm. exact: spin_le_norm. Qed. + +Lemma enorm_mxnorm {K : rcfType} {n} (x : 'rV[K]_n.+1) : + `|x|_e ^+ 2 <= n.+1%:R * `|x| ^ 2. +Proof. +rewrite sqr_enorm /=. +apply : (@le_trans _ _ (\sum_(i0 < n.+1) `|x| ^+ 2)). + apply: ler_sum => k _. + rewrite -sqr_normr. + suff h : `|x ord0 k| <= `|x| by exact: ler_pM. + rewrite {2}/Num.norm/= !mx_normrE /=. + exact: (le_bigmax _ _ (ord0, k)). +by rewrite big_const_ord mulr_natl iter_addr_0. +Qed. + diff --git a/tilt_stability.v b/tilt_stability.v new file mode 100644 index 00000000..040b6214 --- /dev/null +++ b/tilt_stability.v @@ -0,0 +1,745 @@ +From HB Require Import structures. +From mathcomp Require Import all_boot all_algebra ring. +From mathcomp Require Import interval_inference. +From mathcomp Require Import boolp classical_sets functions reals order. +From mathcomp Require Import topology normedtype landau sequences derive realfun. +From mathcomp Require Import matrix_normedtype. +Require Import ssr_ext euclidean rigid frame skew derive_matrix. +Require Import tilt_mathcomp tilt_analysis tilt_robot ode. + +(**md**************************************************************************) +(* # Elements of stability theory *) +(* *) +(* ``` *) +(* posdefmx M == M is definite positive *) +(* locposdef V x == V is locally positive definite at x *) +(* is_Lyapunov_candidate V := locposdef V *) +(* locnegsemidef V x == V is locally negative semidefinite *) +(* 'D~(sol, x0) V == derivative of V along the solution sol *) +(* starting at x0 *) +(* is_equilibrium_point f p := solves_equation f (cst p) *) +(* state_space f == the set points attainable by a solution *) +(* (in the sense of `is_sol`) *) +(* is_Lyapunov_stable_at f V x == Lyapunov stability *) +(* ``` *) +(* *) +(* Reference: *) +(* - Hassan K. Khalil, Nonlinear systems, 2002 *) +(******************************************************************************) + +Reserved Notation "''D~(' sol , x ) f" (at level 10, sol, x, f at next level, + format "''D~(' sol , x ) f"). + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. + +Local Open Scope ring_scope. + +Section posdefmx. + +Definition posdefmx {K : realType} m (M : 'M[K]_m) : Prop := + M \is sym m K /\ forall a, eigenvalue M a -> a > 0. + +Lemma posdefmxP_direct {R : realType} m (M : 'M[R]_m) : + posdefmx M -> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). +Proof. +Abort. + +Lemma posdefmxP_converse {R : realType} m (M : 'M[R]_m) : + (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0) -> posdefmx M. +Proof. +Abort. + +End posdefmx. + +Local Open Scope classical_set_scope. + +Section locdef. +Context {R : realType} {T : normedModType R}. +Implicit Types V : T -> R. + +Definition is_Lyapunov_candidate V (D : set T) (x : T) := + x \in D /\ V x = 0 /\ forall z, z \in D -> z != x -> V z > 0. + +(* NB: useful? mettre dans un fichier wip.v? *) +Definition locnegdef V (x : T) := V x = 0 /\ \forall z \near x^', V z < 0. + +(* NB: useful? mettre dans un fichier wip.v? *) +(* locally negative semidefinite *) +Definition locnegsemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z <= 0. + +End locdef. + +(* derivation along the trajectory h *) +Definition derive_along {R : realType} {n : nat} + (V : 'rV[R]_n -> R) (f : R -> 'rV[R]_n) + (t : R) : R := + (jacobian1 V (f t))^T *d 'D_1 f t. + +Notation "''D~(' sol ) f" := (derive_along f (sol)). + +Section derive_along. +Context {R : realType} {n : nat}. +Variable sol : R -> 'rV[R]_n. +(* sol represents a solution of a differential equation *) + +Lemma derive_along_derive (V : 'rV[R]_n -> R) (t : R) : + differentiable V (sol t) -> differentiable sol t -> + 'D~(sol) V t = 'D_1 (V \o sol) t. +(* Warning: we are not representing the initial state at t = 0 of the trajectory sol + see Khalil p.114 *) +Proof. +move=> dif1 dif2. +rewrite /derive_along /=. +rewrite /jacobian1. +rewrite /jacobian. +rewrite /dotmul. +rewrite -trmx_mul. +rewrite mul_rV_lin1. +rewrite mxE. +rewrite -deriveE=> /=; last first. + apply: differentiable_comp => //. + exact/differentiable_scalar_mx. +rewrite derive_mx /=; last first. + apply: derivable_scalar_mx => //. + exact: diff_derivable. +rewrite mxE. +rewrite [in RHS]deriveE/=; last first. + exact: differentiable_comp. +rewrite [in RHS]diff_comp//=. +do 2 (rewrite -[in RHS]deriveE; last by []). +by under eq_fun do rewrite mxE /= mulr1n /=. +Qed. + +Lemma derive_alongMl (f : 'rV_n -> R) (k : R) t : + differentiable f (sol t) -> differentiable sol t -> + 'D~(sol) (k *: f) t = k *: 'D~(sol) f t. +Proof. +move=> dfx dpx. +rewrite derive_along_derive; last 2 first. + exact: differentiable_comp. + by []. +rewrite deriveZ/=; last first. + apply: diff_derivable => /=. + rewrite -fctE. + exact: differentiable_comp. +congr (_ *: _). +by rewrite derive_along_derive. +Qed. + +Lemma derive_alongD (f g : 'rV_n -> R) t : + differentiable f (sol t) -> differentiable g (sol t) -> + differentiable sol t -> + 'D~(sol) (f + g) t = 'D~(sol) f t + 'D~(sol) g t. +Proof. +move=> dfx dgx difp. +rewrite derive_along_derive; last 2 first. + exact: differentiableD. + by []. +rewrite deriveD/=; last 2 first. + apply: diff_derivable => //. + rewrite -fctE. + exact: differentiable_comp. + apply: diff_derivable => //. + rewrite -fctE. + exact: differentiable_comp. +rewrite derive_along_derive; [|by []..]. +by rewrite derive_along_derive. +Qed. + +Lemma derivative_derive_along_eq0 (f : 'rV_n -> R) (t : R) : + differentiable f (sol t) -> + 'D_1 sol t = 0 -> 'D~(sol) f t = 0. +Proof. +move=> df dsol0. +rewrite /derive_along /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. +by rewrite dsol0 mul0mx !mxE. +Qed. + +Lemma derive_along_enorm_squared m (f : 'rV[R]_n -> 'rV[R]_m) (t : R) : + differentiable f (sol t) -> + differentiable sol t -> + 'D~(sol) (fun y => `|f y|_e ^+ 2) t = + (2 *: 'D_1 (f \o sol) t *m (f (sol t))^T) 0 0. +Proof. +move=> difff diffphi. +rewrite derive_along_derive//; last exact: differentiable_enorm_squared. +rewrite fctE derive_enorm_squared //=; last first. + by apply: diff_derivable=> //=; exact: differentiable_comp. +by rewrite mulrDl mul1r scalerDl scale1r mulmxDl [in RHS]mxE. +Qed. + +End derive_along. + +(* NB: not used, can be shown to be equivalent to derive_along *) +Definition derive_along_partial {R : realType} n (V : 'rV[R]_n -> R) + (a : R -> 'rV[R]_n) (t : R) : R := + \sum_(i < n) (partial V (a t) i * ('D_1 a t) ``_ i). + +Section ode. +Context {K : realType} {n : nat}. +Let U := 'rV[K]_n. +Variable phi : U -> U. + +Definition is_sol_on0o (Delta : itv_bound K) (f : K -> U) := + {in Interval (BLeft 0) Delta, forall t, derivable f t 1 /\ f^`() t = phi (f t)}. +(* NB: (BLeft Delta) -> open on right *) + +Lemma is_sol_on0oP (Delta : K) (f : K -> U) (e : {posnum K} ) : + is_sol_on (fun=> phi) (f (- e%:num)) (- e%:num) (BLeft Delta) f -> + is_sol_on0o (BLeft Delta) f. +Proof. +by move=> [_ H cf] t t0D; apply H; rewrite inE/=; apply: subset_itv t0D; rewrite bnd_simp. +Qed. + +(* "global" solution *) +Definition is_sol_on0y (f : K -> U) := is_sol_on0o (BInfty K false) f. + +(* TODO: generalize this lemma *) +Lemma is_sol_on0yP (f : K -> U) : is_sol_on0o (BInfty K false) f <-> + forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). +Proof. +split=> H t t0oo; apply: H. + by rewrite in_itv/= andbT. +by move: t0oo; rewrite in_itv/= andbT. +Qed. + +Lemma global_sol_sol f : is_sol_on0y f -> forall Delta, is_sol_on0o Delta f. +Proof. +move=> + Delta t t0D. +apply. +by move: t0D;rewrite !in_itv/= => /andP[->]. +Qed. + +End ode. + +Section is_sol. +Context {K : realType} {n : nat}. +Let U := 'rV[K]_n. +Variables (phi : U -> U) (Delta : K). + +(*Lemma is_sol_on0oS (A B : set U) : A `<=` B -> + is_sol_on0o phi Delta A `<=` is_sol_on0o phi Delta B. +Proof. +move=> AB f. +rewrite /is_sol_on0o inE => -[inD0 [_ deri cont]]; rewrite inE. +split => //. +by apply: AB. +Qed. +*) +End is_sol. + +Section state_space. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : T -> T. + +(* TODO: two state_space definitions?! *) +Definition state_space (Init : set T) : set T := + [set x | exists f Delta, [/\ f 0 \in Init, is_sol_on0o phi (BLeft Delta) f & + (exists t, t \in `[0, Delta[%R /\ x = f t) ]]. + +End state_space. + +Section equilibrium_point. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : T -> T. (* was (K -> T) -> K -> T *) +Variable Init : set T. +Variable Delta : K. + +Definition is_equilibrium_point (x : T) := + x \in Init /\ forall Delta, is_sol_on0o phi Delta (cst x). + +Lemma equilibrium_point_in_state_space (x : T) : is_equilibrium_point x -> x \in state_space phi Init. +Proof. + move => [xinit solD]. + rewrite inE. + exists (cst x). + exists (1). + split=>//. + exists 0. + split=>//. + by rewrite in_itv/= lexx //= ltW. +Qed. +End equilibrium_point. + +Section equilibrium_point. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : T -> T. + +Definition equilibrium_points A := [set p : T | is_equilibrium_point phi A p]. + +Lemma equilibrium_points_subset (A B : set T) : A `<=` B -> + equilibrium_points A `<=` equilibrium_points B. +Proof. +move=> AB x. +rewrite /equilibrium_points/= /is_equilibrium_point /is_sol_on0o inE => -[Ax H]. +split. + exact/mem_set/AB. +move=> Delta t t0D. +have [deriv1 deriv2] := H Delta t t0D. +by split => //. +Qed. + +End equilibrium_point. + +Section stability. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : T -> T. +Variable Init : set T. + +Definition is_locally_stable_at (x : T) := + forall eps, eps > 0 -> exists2 d, d > 0 & + forall (f : K -> 'rV[K]_n) (Delta : K), f 0 \in Init /\ is_sol_on0o phi (BLeft Delta) f -> + `| f 0 - x | < d -> forall t, 0 < t < Delta -> `| f t - x | < eps. + +(* assuming solution exists for all time *) +Definition is_stable_at (x : T) := + forall eps, eps > 0 -> exists2 d, d > 0 & + forall (f : K -> 'rV[K]_n), f 0 \in Init /\ is_sol_on0y phi f -> + `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. + +Lemma locally_stable_stable x : is_locally_stable_at x -> is_stable_at x. +Proof. +move => lstable e e0. +move /(_ _ e0) : lstable => [d d0 stable]. +exists d => // z [z0Init zglob] zd t t0. +apply (stable _ (t + 1)) => //. + split => //. + by apply global_sol_sol. +by rewrite t0/= ltrDl. +Qed. + +Definition is_asymptotically_stable_at (x : T) (f : K -> 'rV[K]_n) : Prop := + exists2 d, d > 0 & `| f 0 - x | < d -> f t @[t --> +oo] --> x. + +End stability. + +Section bounded. +Context {K : realType} {n : nat}. +Let T := 'rV[K]_n. +Variable phi : T -> T. +(* Variable sol : K->T. *) +Variable Init : set T. +Variable x0 : T. +(* Hypothesis solP: is_sol phi Delta sol Init. *) +(* Lemma stable_bounded : is_locally_stable_at phi Init x0 -> forall eps, exists d, forall u0 Delta sol, `|u0 - x0| <= d -> is_sol_autonomous u0 phi 0 Delta sol -> forall t, 0<=t<=Delta -> `|sol t - x0| <= eps. *) +(* Proof. *) +(* move => stable eps. *) +(* have := *) +End bounded. +(* f' = phi f *) +(* phi_robot f =def= fun f t => phi t (f t) *) +(*Definition existence_uniqueness {K : realType} {n} + (phi : K -> 'rV[K]_n -> 'rV[K]_n) (Init : set 'rV[K]_n) Delta + (sol : K -> 'rV[K]_n) := + forall y, y 0 \in Init -> is_sol phi Init Delta y <-> sol (y 0) = y. +*) + +(*Definition initial_condition {K : realType} {n} (sol : K -> 'rV[K]_n) x0 := + sol 0 = x0.*) + +(*Section solutions_unique. +Context {K : realType} {n : nat}. +Variable phi : K -> 'rV[K]_n -> 'rV[K]_n. +Variable Init : set 'rV[K]_n. +Variable Delta : K. + +Definition solutions_unique := forall (f g : K -> 'rV_n) (x0 : 'rV_n), + is_sol phi Init Delta f -> + is_sol phi Init Delta g -> + f 0 = x0 -> g 0 = x0 -> + f = g. + +End solutions_unique. + +Section solutions_unique_lemmas. +Context {K : realType} {n : nat}. +Variables (phi : K -> 'rV[K]_n -> 'rV[K]_n) (Init : set 'rV[K]_n). +Variable Delta : K. + +Lemma existence_uniqueness_unique (sol : 'rV[K]_n -> K -> 'rV[K]_n) : + existence_uniqueness phi Init Delta sol -> + solutions_unique phi Init Delta. +Proof. +move=> solP f g x0 solf solg f0 g0. +apply/funext => x. +case : (solf) => //=. +move => a0D Da fa. +have := solP _ a0D. +case. +move => /(_ solf). +move => a0a _. +case : (solg) => //=. +move => b0D Db fb. +have := solP _ b0D. +case. +move => /(_ solg). +move => b0b _. +by rewrite -b0b -a0a f0 g0. +Qed. + +Lemma existence_uniqueness_exists (sol : K -> 'rV[K]_n) : + existence_uniqueness phi Init Delta sol -> forall p, p \in Init -> + initial_condition sol p -> is_sol phi Init Delta (sol p). +Proof. +move=> solP sol0 p pD. +have H := solP (sol p). +apply H. + by rewrite sol0. +by rewrite sol0. +Qed. + +End solutions_unique_lemmas.*) + +(* TODO: move? *) +Section sphere. +Context {K : realType} {n : nat}. + +Definition sphere r := [set x : 'rV[K]_n | `|x| = r]. + +Lemma sphere_nonempty r : n != 0 -> 0 < r -> sphere r !=set0. +Proof. +move=> n0 r_gt0. +rewrite /sphere. +exists (const_mx r). +rewrite /sphere /= /normr/=. +(* TODO: need lemma? *) +rewrite mx_normrE/=. +apply/eqP; rewrite eq_le; apply/andP; split. + apply: bigmax_le. + exact: ltW. + by move=> i _; rewrite mxE gtr0_norm. +under eq_bigr do rewrite mxE gtr0_norm//. +apply/le_bigmax => /=. +destruct n as [|n'] => //. +exact: (ord0, ord0). +Qed. + +Lemma compact_sphere r : compact (sphere r). +Proof. +apply: bounded_closed_compact. + suff : \forall M \near +oo, forall p, sphere r p -> forall i, `|p ord0 i| < M. + rewrite /bounded_set; apply: filter_app; near=> M0. + move=> Kbnd /= p /Kbnd ltpM0. + rewrite /normr/= mx_normrE. + apply/bigmax_leP; split => //= i _. + by rewrite ord1; exact/ltW/ltpM0. + near=> M => v. + rewrite /sphere /= => vr i. + rewrite (@le_lt_trans _ _ r)//. + rewrite -vr [leRHS]/normr/= mx_normE. + under eq_bigr do rewrite ord1. + rewrite -(pair_big xpredT xpredT (fun _ j => `|v ord0 j|%:nng))//=. + rewrite big_ord_recr/= big_ord0. + rewrite max_r; last exact/bigmax_ge_id. + rewrite (bigD1 i)//= -maxE le_max. + by apply/orP; left. + clear v vr i. + by near: M; apply: nbhs_pinfty_gt; rewrite num_real. +pose d := fun x : 'rV[K]_n => `|x| : K. +have contd : continuous d by move=> /= z; exact: norm_continuous. +rewrite [X in closed X](_ : _ = d @^-1` [set r]); last first. + by apply/seteqP; split. +by apply continuous_closedP. +Unshelve. all: by end_near. Qed. + +End sphere. + +Section about_Lyapunov_function. +Context {K : realType} {n : nat}. +Let U := 'rV[K]_n.+1. +Variable phi : U -> U. +Variable Delta : K. +Variable u0 : U. +Variable sol : K -> U (* TODO(2026-02-08): maybe this should be U -> K -> U to match lasalle *). +Hypothesis solP : is_sol_on0o phi (BLeft Delta) sol. + +Variable V : U -> K. +Hypothesis Vdiff : forall t : U, differentiable V t. +Hypothesis V'_le0 : forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. + +Lemma V_nincr a b : b < Delta -> 0 <= a <= b -> + V (sol b) <= V (sol a). +Proof. +move=> bDelta /andP[a_ge0 ab]. +apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. +- move=> y yb. + apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. + rewrite -derivable1_diffP. + move: solP. + move/(_ y) /(_ _) => []. + move: yb. + apply: subset_itv; rewrite bnd_simp//. + exact: ltW. + by []. +- move=> y yb. + rewrite derive1E -derive_along_derive//. + + apply: V'_le0. + move : yb; rewrite in_itv/= => /andP[->/= /lt_le_trans]; apply. + exact: ltW. + + rewrite -derivable1_diffP. + move: solP. + move/(_ y) /(_ _) => []. + move: yb. + apply: subset_itv; rewrite bnd_simp//. + exact/ltW. + by []. +- (* `[0, b] *) + have [b0|] := ltP 0 b; last first. + move=> b0. + have ? : b = 0. + by apply/eqP; rewrite eq_le b0 (le_trans a_ge0)//. + subst b. + rewrite set_itv1. + exact: continuous_subspace1. + apply/continuous_within_itvP => //; split. + + move=> z z0b. + apply: continuous_comp; last exact: differentiable_continuous. + apply: differentiable_continuous => //. + rewrite -derivable1_diffP. + move: solP. + move/(_ z) /(_ _) => []. + move: z0b. + by apply: subset_itv; rewrite bnd_simp// ltW. + by []. + + have d0 : 0 < Delta by apply /lt_trans/bDelta. + have cont : {in `[0, Delta[%R, continuous sol}. + move=> t t0D. + apply: differentiable_continuous. + apply/derivable1_diffP. + by apply solP. + apply: cvg_comp. + apply: cvg_at_right_filter. + apply: cont. + by rewrite in_itv/= lexx. + by apply (differentiable_continuous (Vdiff (sol 0))). + + apply: cvg_at_left_filter. + apply: differentiable_continuous => //. + apply: differentiable_comp. + rewrite -derivable1_diffP. + move: solP. + move/(_ b) /(_ _) => []. + by rewrite in_itv/= (ltW b0)// bDelta. + by []. + by apply: Vdiff. +- by rewrite !in_itv/= lexx (le_trans a_ge0). +- by rewrite in_itv/= ab andbT. +Qed. + +End about_Lyapunov_function. + +(* khalil theorem 4.1 *) +Section Lyapunov_stability. +Context {K : realType} {n : nat}. +Let U := 'rV[K]_n.+1. +Variable phi : U -> U. +Variable Init : set U. +Let u0 : U := 0. +Hypothesis u0Init : u0 \in Init. + +Hypothesis openInit : open Init. (* Init est forcement un ouvert *) +(* see Cohen Rouhling ITP 2017 Sect 3.2 *) + +Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. + +Let BE s : 0 < s -> B s = closed_ball 0 s. +Proof. by move=> r0; rewrite /B -closed_ballE. Qed. + +Variable V : U -> K. +Hypothesis Vdiff : forall t : U, differentiable V t. +Hypothesis V'_le0 : forall Delta sol, sol 0 \in Init -> is_sol_on0o phi (BLeft Delta) sol -> + forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. + +Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) : + is_Lyapunov_candidate V Init x -> + is_equilibrium_point phi Init x -> + is_locally_stable_at phi Init x. +Proof. +move=> VDx eq /= eps eps0/=. +move: VDx => [/= xD [Vx0 DxV]]. +have [r r_gt0 [r_eps BrD]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` Init. + move: xD; rewrite inE => /(open_subball openInit)[r0/= r0_gt0] q. + pose r := Num.min (r0 / 2) eps. + have r_gt0 : 0 < r by rewrite /r lt_min eps0 divr_gt0. + exists (r / 2); first by rewrite divr_gt0. + split; first by rewrite /r ler_pdivrMr// ge_min ler_pMr// ler1n orbT. + move=> v Brv; apply (q r) => //. + rewrite /ball/= sub0r normrN gtr0_norm//. + by rewrite /r gt_min ltr_pdivrMr// ltr_pMr// ltr1n. + by move: Brv; rewrite BE ?divr_gt0//; exact: subset_closure_half. +have alpha_min : {x : 'rV[K]_n.+1 | x \in sphere r /\ + forall y, y \in sphere r -> V x <= V y}. + have : {within sphere r, continuous V}. + apply: continuous_subspaceT => /= v. + by apply/differentiable_continuous; exact/Vdiff. + move/(EVT_min_rV (sphere_nonempty _ r_gt0) (@compact_sphere _ _ r)). + have m0 : n.+1 != 0 by []. + move=> /(_ m0). + by move=> /cid2[c sphere_r_c sphere_r_V]; exists c. +pose alpha := V (sval alpha_min). +have alpha_gt0 : 0 < alpha. + have sphere_pos y : y \in sphere r -> 0 < V y. + move=> yr; apply: DxV; last first. + rewrite gtr0_norm_neq0//. + by move: yr; rewrite inE /sphere/= => ->. + apply/mem_set/BrD. + move : yr; rewrite inE /sphere/= => <-. + by rewrite /B /closed_ball_/= sub0r normrN. + rewrite /alpha sphere_pos// /sphere inE/=. + by have [+ _] := svalP alpha_min; rewrite inE. +have [beta /andP[beta_gt0 beta_alpha]] : exists beta, 0 < beta < alpha. + by exists (alpha / 2); rewrite divr_gt0//= ltr_pdivrMr//= ltr_pMr// ltr1n. +set Omega_beta := [set x : 'rV[K]_n.+1 | B r x /\ V x <= beta]. +have Omega_beta_Br : Omega_beta `<=` (B r)°. + move=> y [Bry Vybeta]. + rewrite BE// interior_closed_ballE => //=. + have yr : `|y| <= r by move: Bry; rewrite /B /closed_ball_/= sub0r normrN. + have [{}yr | ry | {}yr] := ltgtP (`|y|) r. + - by rewrite mx_norm_ball /ball_/= sub0r normrN. + - by have := le_lt_trans yr ry; rewrite ltxx. + - have alphaVy : alpha <= V y. + by rewrite /alpha; case: (svalP alpha_min) => [_]; apply; rewrite inE. + by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. +(* any trajectory starting in Omega_beta at t = 0 + stays in Omega_beta for all t >= 0 *) +have Df_Omega_beta Delta sol : sol 0 \in Init -> is_sol_on0o phi (BLeft Delta) sol -> + sol 0 \in Omega_beta -> forall t, 0 < t < Delta -> sol t \in Omega_beta. + move=> sol0 solP phi_Omega. + have /= V_nincr_consequence : forall t, 0 < t < Delta -> forall u, 0 <= u <= t -> + 'D~(sol) V u <= 0 -> + V (sol t) <= V (sol 0) <= beta. + move=> /= t1 /andP[t10 t1Delta] u ut1 Vle0. + apply/andP; split. + move : phi_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. + apply: (@V_nincr _ _ phi Delta sol). + assumption. + move=> t. + by apply: Vdiff. + move=> /= t t0. + apply: V'_le0 => //. + exact: solP. + assumption. + assumption. + by rewrite lexx/= (ltW t10). + by move: phi_Omega; rewrite inE => -[Brh0 Vh0beta]. + move=> t /andP[t0 tDelta]. + rewrite inE; split; last first. + have : 'D~(sol) V t <= 0. + apply: V'_le0 => //. + exact: solP. + by rewrite t0/=. + have := @V_nincr_consequence t. + rewrite t0 /= tDelta => /(_ isT t). + rewrite lexx (ltW t0)/= => /(_ isT). + move=> /[apply]. + by move=> /andP[/le_trans] => /[apply]. + move: phi_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. + rewrite !sub0r !normrN => -[phi0r Vphi0beta]. + rewrite leNgt; apply/negP => phi_t_r. + have [t1 [/andP[t1_ge0 t1t] phit1r]] : exists t0, 0 <= t0 <= t/\ `|sol t0| = r. + have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o sol)}. + (* `[0, t] *) + apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) (sol)) => //. + exact: ltW. + move=> z _. + by apply: norm_continuous. + have cont : {in `[0, Delta[, continuous sol}. + move=> t' t'0D. + rewrite inE in t'0D. + apply: differentiable_continuous. + apply/derivable1_diffP. + by apply solP. + move/continuous_in_subspaceT : cont. + apply: continuous_subspaceW. + by apply: subset_itvl; rewrite bnd_simp. + have : Num.min `|sol 0| `|sol t| <= r <= Num.max `|sol 0| `|sol t|. + by rewrite ge_min phi0r/= le_max (ltW phi_t_r) orbT. + move=> /(IVT (ltW t0) norm_phi_cont)[c cI norm_phi_c]. + by exists c; split => //; move/itvP: cI => ->. + have alphaVphit1 : alpha <= V (sol t1). + rewrite {alpha_gt0 beta_alpha} /alpha; case: alpha_min => /=. + by move=> y [_ +]; apply; rewrite inE. + have : beta < V (sol t1). + by rewrite (lt_le_trans _ alphaVphit1)//; case/andP : beta_alpha. + apply/negP; rewrite -leNgt. + move: t1_ge0; rewrite le_eqVlt => /predU1P[<-//|t10]. + have := @V_nincr_consequence t1. + rewrite t10 (le_lt_trans t1t tDelta) => /(_ isT). + move=> /(_ t1). + rewrite (ltW t10) lexx => /(_ isT). + have : 'D~(sol) V t1 <= 0. + apply: V'_le0 => //. + exact: solP. + by rewrite t10/= (le_lt_trans _ tDelta). + move=> /[swap] /[apply]. + by move=> /andP[/le_trans] => /[apply]. +have _ : compact Omega_beta. + apply: bounded_closed_compact; rewrite /Omega_beta. + - rewrite /bounded_set /= /globally. + exists r; split => //= t rt v. + rewrite /B /closed_ball_/= sub0r normrN. + by move=> [/le_trans vr _]; rewrite vr// ltW. + - apply: closedI => /=. + by rewrite BE//; exact: closed_ball_closed. + rewrite [X in closed X](_ : _ = V @^-1` [set x | x <= beta]); last first. + by apply/seteqP; split. + apply: closed_comp => //= v _. + apply: continuous_comp; first by []. + exact: differentiable_continuous. +have [d0 d0_gt0 Vbeta] : exists2 d, d > 0 & forall x, `|x| <= d -> V x < beta. + have [d d_gt0 xdV] : exists2 d : K, 0 < d & + forall y, `|y - x| < d -> `|V y - V x| < beta. + have /cvgrPdist_lt /(_ _ beta_gt0) : V x @[x --> nbhs x] --> V x. + exact/differentiable_continuous/Vdiff. + rewrite nearE /= => /nbhs_ballP[d /= d_pos xdV]. + exists d => // y. + move: xdV; rewrite mx_norm_ball /ball_ /= distrC => /[apply]. + by rewrite distrC. + exists (d / 2); first exact: divr_gt0. + move=> v vd; have /(xdV v) : `|v - x| < d. + by rewrite subr0 (le_lt_trans vd)// ltr_pdivrMr // ltr_pMr // ltr1n. + by rewrite Vx0 subr0; apply: le_lt_trans; rewrite ler_normlW. +pose delta := Num.min d0 r. +have delta_gt0 : 0 < delta by rewrite /delta lt_min d0_gt0 r_gt0. +have deltaV y : `|y| <= delta -> V y < beta. + move=> /= ydelta. + have : `|y| <= d0 by rewrite (le_trans ydelta)// /delta ge_min lexx. + exact: Vbeta. +have B_delta_Omega_beta : B delta `<=` Omega_beta. + rewrite /Omega_beta => /= v. + rewrite /B /closed_ball_/= sub0r normrN => vdelta. + split; last exact/ltW/deltaV. + by rewrite (le_trans vdelta)// /delta ge_min lexx orbT. +rewrite /x. +exists delta => //. +move=> sol Delta' [sol0 solP] sol_delta t0 t0_ge0. +rewrite subr0. +have : sol 0 \in Omega_beta. + rewrite inE; apply: B_delta_Omega_beta. + rewrite /B /closed_ball_/= sub0r normrN; apply/ltW. + by rewrite subr0 in sol_delta. +rewrite inE => -[+ _]. +rewrite /B /closed_ball_/= sub0r normrN => solx0r. +have : (B r)° (sol t0). + apply: Omega_beta_Br; apply/set_mem. + apply: Df_Omega_beta => //. + exact: solP. + rewrite inE; split; first by rewrite /B /closed_ball_/= sub0r normrN. + have : B delta (sol 0). + rewrite /closed_ball_; apply: ltW; rewrite sub0r normrN. + by rewrite subr0 in sol_delta. + by move/B_delta_Omega_beta => []. + assumption. +rewrite BE//= interior_closed_ballE//=. +rewrite mx_norm_ball /ball_/= sub0r normrN => /lt_le_trans; exact. +Unshelve. all: by end_near. Qed. + +End Lyapunov_stability. From 377e117ec398c56a2c81a39d7b4b3f94faff37ac Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Sun, 15 Feb 2026 21:17:29 +0900 Subject: [PATCH 115/144] added file for autonomous odes --- _CoqProject | 1 + ode_autonomous.v | 579 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 580 insertions(+) create mode 100644 ode_autonomous.v diff --git a/_CoqProject b/_CoqProject index ae927bfe..bcd47ee0 100644 --- a/_CoqProject +++ b/_CoqProject @@ -20,6 +20,7 @@ extra_trigo.v ode_common.v ode_contfun.v ode.v +ode_autonomous.v lasalle.v pendulum.v tilt_mathcomp.v diff --git a/ode_autonomous.v b/ode_autonomous.v new file mode 100644 index 00000000..46b90cf8 --- /dev/null +++ b/ode_autonomous.v @@ -0,0 +1,579 @@ +From HB Require Import structures. +From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. +From mathcomp Require Import archimedean generic_quotient ring_quotient. +From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. +From mathcomp Require Import constructive_ereal. +From mathcomp Require Import functions reals interval_inference topology. +From mathcomp Require Import prodnormedzmodule tvs normedtype landau. +From mathcomp Require Import ereal sequences derive numfun measure realfun. +From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. +Require Import ode_common ode_contfun ode. +(**md**************************************************************************) +(* # Proofs of properties of autonomous ODEs *) +(* *) +(* TODO: fill *) +(******************************************************************************) + +Set Implicit Arguments. +Unset Strict Implicit. +Unset Printing Implicit Defensive. + +Import Order.TTheory GRing.Theory Num.Def Num.Theory. +Import numFieldNormedType.Exports. + +Open Scope ring_scope. +Open Scope classical_set_scope. + + +Section picard_autonomous. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : U -> U) (k : R) (u0 : U) (r : {posnum R}). +Hypothesis k0 : 0 < k. +Let B := closed_ball u0 r%:num. +Hypothesis lip2 : k.-lipschitz_B phi. + +Definition phi_ (t : R) x := phi x. + +Definition is_sol_sym u0 t0 d (sol : R -> U):= + sol t0 = u0 /\ {in `]t0-d,t0+d[, + forall x, derivable sol x 1 /\ sol^`() x = phi_ x (sol x)}. + +Lemma phi_lip2 a b: {in `[a, b]%R, forall x, k.-lipschitz_B (phi_ x)}. +Proof. by move => x abx; exact: lip2. Qed. + +Lemma phi_cont1 a b : {in B, forall y, {within `[a, b], continuous phi_ ^~ y}}. +Proof. by move => /= x Bx; exact: cst_continuous_subspace. Qed. + + +Let rho : {posnum R} := (2^-1)%:pos. + +Let rho1 : rho%:num < 1. +Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. + +Local Lemma cauchy_lipschitz_autofwd a : exists f delta, + delta > 0 /\ is_sol_on (phi_) u0 a (BLeft (a + delta)) f /\ + {in `[a, a + delta], forall t, closed_ball u0 r%:num (f t)}. +Proof. +have aa1 : a < a + 1 by rewrite ltrDl. +have [d0 [solf cball]] := + cauchy_lipschitz_local aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho1. +exists (@cauchy_lipschitz_local_f R n phi_ a _ k u0 r aa1 k0 + (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho rho1). +by exists (safe_dist phi_ a (a + 1) k u0 r rho). +Qed. + +Lemma patch_in {X : Type} (f g : R -> X) S x : x \in S -> patch f S g x = g x. +Proof. + move => xs. + rewrite /patch. + by rewrite xs. +Qed. + + +Lemma closed_ball_split (x1 x2 y :U) q : 0 < q -> closed_ball x1 (q/2) y -> closed_ball x2 (q/2) x1 -> closed_ball x2 q y. +Proof. + move => hq. + have hq2: (0 < q /2). + by rewrite divr_gt0. + rewrite !closed_ballE// /closed_ball_ /=. + move => h1 h2. + rewrite -(subrKA x1 x2). + by apply: (le_trans (ler_normD _ _)); rewrite (splitr q) lerD//. +Qed. + +(*todo : move or PR? *) +Lemma within_continuous_minus (f : R -> U) (a b : R) : + {within `[-b,-a], continuous f} -> {within `[a,b], continuous f \o -%R}. +Proof. +have [ab|ba _ |-> _] := ltgtP a b; last 2 first. + by rewrite set_itv_ge ?bnd_simp -?ltNge//; exact: continuous_subspace0. + by rewrite set_itv1; exact: continuous_subspace1. +move/continuous_within_itvP; rewrite ltrN2 => /(_ ab)[cf fb fa]. +apply/(continuous_within_itvP _ ab); split. +- move=> t tab. + apply: (@cvg_comp _ _ _ -%R f); first exact: oppr_continuous. + by apply: cf; rewrite oppr_itvoo !opprK. +- by rewrite -{1}(opprK a); apply/cvg_at_leftNP; exact: fa. +- by rewrite -{1}(opprK b); apply/cvg_at_rightNP; exact: fb. +Qed. + +Local Lemma phi_lip2' a b: {in `[a, b]%R, forall x, k.-lipschitz_B (-phi_ x)}. +Proof. +move => y _ x B12. +rewrite /= -normrN opprD !opprK /Algebra.opp /=. +exact: (lip2 B12). +Qed. + +Local Lemma phi_cont1' a b : {in B, forall y, {within `[a, b], continuous -phi_ ^~ y}}. +Proof. + move => y _. + move => t. + apply: continuousN. + exact: cst_continuous_subspace. +Qed. +(* TODO: extending in both directions should be generalized to non-autonomous *) +Lemma cauchy_lipschitz_autonomous a : exists f delta, delta > 0 /\ is_sol_sym u0 a delta f. +Proof. +have [fplus [dplus [dplus0 [solplus cplus]]]] := cauchy_lipschitz_autofwd a. +have amin1 : -a < -a + 1 by rewrite ltrDl. +have [dminus0 [solminus cminus]] := + cauchy_lipschitz_local amin1 k0 + (@phi_lip2' (-a) (-a + 1)) (@phi_cont1' (-a) (-a + 1)) rho1. + +set fminus0 := + @cauchy_lipschitz_local_f R n (fun t x => - phi x) (-a) _ k u0 r + amin1 k0 (@phi_lip2' (-a) (-a + 1)) (@phi_cont1' (-a) (-a + 1)) rho rho1. +set dminus := safe_dist (fun t x => - phi x) (-a) (-a + 1) k u0 r rho. +set fminus := fminus0 \o -%R. +set r2 := (r%:num/2)%:pos. +set r4 := (r%:num/4)%:pos. +have ler4 : r4%:num <= r%:num. + by rewrite /r4/= ler_pdivrMr // ler_pMr // lerDl. +have ler42 : r4%:num <= r2%:num. + by rewrite /r4/r2/= ler_pdivrMr// -mulrA ler_pMr // ler_pdivlMl // mulr1 lerD // lerDl. +have adplus : a < a + dplus by rewrite ltrDl dplus0. +have cfplus := And33 solplus. +rewrite closure_neitv_oo in cfplus; last by rewrite ltrDl. +have [rpos hropos] := ode.continuous_confined (a:=a) (b:=a + dplus) (u0:=u0) r4 adplus cfplus (And31 solplus). +have amind : -a < -a + dminus by rewrite ltrDl dminus0. +have cfminus' := And33 solminus. +rewrite closure_neitv_oo in cfminus'; last by rewrite ltrDl. +have cfminus : {within `[a-dminus, a], continuous fminus}. + rewrite /fminus. + apply: within_continuous_minus. + apply /continuous_subspaceW/cfminus'. + apply: subset_itvl. + rewrite -/dminus. + by rewrite bnd_simp/= opprD opprK. +have [rneg hrneg] := ode.continuous_confined (a:=-a) (b:=-a + dminus) (u0:=u0) r4 amind cfminus' (And31 solminus). +set dboth := Num.min dplus (Num.min dminus (Num.min rneg%:num rpos%:num)). +have dboth0 : 0 < dboth. + rewrite lt_min dplus0 //= lt_min dminus0 //=. +pose f := patch fplus `[a - dboth, a] fminus. +set uneg := f (a - dboth). +have Buneg : closed_ball uneg (r%:num/2) `<=` closed_ball u0 r%:num. + rewrite /uneg/f patch_in/f/=;last first. + by rewrite inE/=in_itv/= gerBl lexx ltW. + move => /=x xb. + apply: (closed_ball_split _ xb) => //. + suff : fminus (a - dboth) \in closed_ball u0 (r%:num/4). + rewrite !inE. + apply le_closed_ball. + rewrite ler_pdivrMr//= -mulrA /=ler_peMr//. + by rewrite ler_pdivlMl //= mulr1 ltW // ler_ltD //= ltrDl. + apply hrneg. + rewrite inE/=in_itv/= opprB lerDr ltW //= addrC lerD //. + by rewrite /dboth ge_min; do 2 (apply /orP; right; rewrite ge_min);apply /orP;left. +have f01intersect : fminus a = fplus a. + by rewrite /fminus/= (And31 solminus) (And31 solplus). +have fa : f a = u0. + rewrite /f patch_in /fminus /=. + apply solminus. + by rewrite inE/=in_itv/= lexx gerBl ltW. +set B' := closed_ball uneg (r2%:num). +have lip2' : k.-lipschitz_B' phi. + move => /= [x1 x2] [Bx1 Bx2]. + apply lip2. + by split;apply Buneg. +have contf_minus : {within `[a - dboth, a], continuous fminus}. + apply /continuous_subspaceW/cfminus. + apply: subset_itvr. + by rewrite bnd_simp /= lerD //= lerNr opprK ge_min; apply /orP;right; rewrite ge_min lexx. + +have contf_plus : {within `[a, a+dboth], continuous fplus}. + apply /continuous_subspaceW/cfplus. + apply: subset_itvl. + by rewrite bnd_simp /= lerD //= ge_min lexx. +have contf : {within `[a - dboth, (a + dboth)%E], continuous f}. + apply : within_continuous_patch => //. + by rewrite gtrBl. + by rewrite ltrDl. +have r42 : r4%:num = (r2%:num / 2). + rewrite /r4/r2/=. + rewrite -mulrA. + apply congr2 => //. + by rewrite -invfM -natrM. +have fc : {in `[a-dboth, (a + dboth)], forall t : R, closed_ball (fminus (a - dboth)) r2%:num (f t)}. + move => t tad. + rewrite /f/=/patch/=. + have : (closed_ball (fminus (a-dboth)) (r4%:num)) u0. + suff: (fminus (a-dboth)) \in closed_ball u0 (r4%:num). + by rewrite inE/= !closed_ballE/closed_ball_/= // distrC . + apply: hrneg. + rewrite !inE/=!in_itv/= lerNr lerNl opprD !opprK gerBl ltW //= lerB //. + by do 2 (rewrite ge_min;apply /orP;right); rewrite ge_min lexx. + rewrite r42. + move => c1. + case : ifP => ht. + - have : (fminus t) \in closed_ball u0 (r4%:num). + apply: hrneg. + move : ht. + rewrite !inE/=!in_itv/= lerNr lerNl opprD !opprK => /andP[h1 ->//=]. + apply: (le_trans _ h1). + by rewrite lerB //; do 2 (rewrite ge_min;apply /orP;right); rewrite ge_min lexx. + rewrite inE. + rewrite !r42. + move => c2. + apply: (closed_ball_split _ c2) =>//. + - have : (fplus t) \in closed_ball u0 (r4%:num). + have ht' : t \in `[a, a + dboth]. + have := tad. + rewrite !inE /=!in_itv/= => /andP[h1 ->]; apply /andP; split => //. + have [hat | hat] := lerP a t => //. + rewrite -ht. + by rewrite inE/=in_itv/= h1//= ltW. + apply: hropos. + move : ht'. + rewrite !inE/= !in_itv/= => /andP[-> h1//=]. + apply: (le_trans h1). + by rewrite lerD //; do 3 (rewrite ge_min;apply /orP;right). + rewrite inE. + rewrite !r42. + move => c2. + apply: (closed_ball_split _ c2) =>//. +exists f, dboth. +split => //. +suff h: is_sol_on phi_ (f (a-dboth)) (a-dboth) (BLeft (a+dboth)) f. + by split => //;apply:(And32 h). + +have kn0 : k != 0 by apply lt0r_neq0. +apply /(integral_sol_iff_sol (r := r2) kn0) => //. + by rewrite ler_ltD // gtrN. + move => x _; exact: cst_continuous_subspace. + move => _ [t tp] <-. + rewrite {1}/f patch_in;last first. + by rewrite inE/=in_itv/= lexx //= gerBl ltW. + by apply fc; rewrite inE. +apply solution_extends => //. +- by rewrite gtrBl. +- apply : (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). + exact: contf_minus. + by move => x _. + move => x _ ;exact: cst_continuous_subspace. + move => _ [/= t' tp] <-. + apply (le_closed_ball (e1:=r4%:num)) => //. + suff : (fminus t') \in closed_ball u0 r4%:num by rewrite inE. + apply hrneg. + move : tp. + rewrite in_itv/=inE/=in_itv/= lerNl opprK => /andP[h0 ->//=]. + rewrite lerNl opprD opprK //=. + apply: (le_trans _ h0). + by rewrite lerB //; do 2 (rewrite ge_min;apply /orP;right); rewrite ge_min lexx. +- apply : (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). + exact: contf_plus. + by move => x _. + move => x _ ;exact: cst_continuous_subspace. + move => _ [/= t' tp] <-. + apply (le_closed_ball (e1:=r4%:num)) => //. + suff : (fplus t') \in closed_ball u0 r4%:num by rewrite inE. + apply hropos. + move : tp. + rewrite in_itv/=inE/=in_itv/= => /andP[-> h0 //=]. + apply: (le_trans h0). + by rewrite lerD //=; do 3 (rewrite ge_min;apply /orP;right). +- apply /(integral_sol_iff_sol (r:=r2) kn0). + + by rewrite gtrBl. + + move=>x _; exact: lip2'. + + move=>x _; exact: cst_continuous_subspace. + + by []. + + move => _ [t tp] <-. + rewrite {1}/f patch_in;last first. + by rewrite inE/=in_itv/= lexx //= gerBl ltW. + have tin : t \in `[a-dboth, a+dboth]. + move : tp. + rewrite !inE/=!in_itv/= => /andP[-> h1//=]. + by apply (le_trans h1); rewrite lerDl ltW. + have := fc _ tin. + rewrite {1}/f patch_in; last by rewrite inE. + apply. + split. + * by rewrite /f patch_in; last rewrite inE/=in_itv/= lexx //= gerBl ltW. + * move => t tad. + case : (And32 solminus (-t)). + move : tad. + rewrite -/dminus !inE/=!in_itv/= ltrNr ltrNl opprD !opprK => /andP[h1 ->//=]. + apply: (le_lt_trans _ h1). + by rewrite lerD// lerNl opprK; rewrite ge_min;apply /orP;right;rewrite ge_min lexx. + move => h1 h2. + have hd : (derivable fminus t 1). + rewrite /fminus/=. + apply /derivable1_diffP. + apply /differentiable_comp => //. + apply /derivable1_diffP. + apply h1. + split=>//. + rewrite /fminus/=. + apply /rowP => i /=. + rewrite derive1E/=. + rewrite !derive_mx //= !mxE. + rewrite -derive1E/=. + have -> : (fun t0 : R => fminus0 (- t0) ord0 i) = ((fun t => fminus0 t ord0 i) \o -%R). + by apply funext. + rewrite derive1_comp//=. + rewrite !derive1N//=derive1_id/=. + move /rowP : h2. + move /(_ i). + rewrite !derive1E /=!derive_mx. + rewrite /=!mxE => ->. + by rewrite mulrN1 opprK. + apply h1. + by move /derivable_mxP: h1. + * by rewrite closure_neitv_oo; last rewrite gtrBl. +- apply /(integral_sol_iff_sol (r:=r2) kn0). + + by rewrite ltrDl. + + move=>x _. + rewrite /fminus/=. + rewrite (And31 solminus). + move => [x1 x2] [ Bx1 Bx2]. + apply: lip2. + split => /=. + rewrite /B. + apply: (le_closed_ball _ Bx1). + by rewrite ler_pdivrMr // ler_pMr // lerDr. + apply: (le_closed_ball _ Bx2). + by rewrite ler_pdivrMr // ler_pMr // lerDr. + + move=>x _; exact: cst_continuous_subspace. + + by []. + + move => _ [t tp] <-. + rewrite /fminus /=(And31 solminus). + apply : (le_closed_ball ler42). + suff : fplus t \in closed_ball u0 r4%:num by rewrite inE. + apply hropos. + move : tp. + rewrite !inE/=!in_itv/= => /andP[-> h0]//=. + apply (le_trans h0). + by rewrite lerD //=; do 3 (rewrite ge_min;apply /orP;right). + rewrite /fminus /=(And31 solminus). + split. + apply solplus. + move => t tad. + apply solplus. + move : tad. + rewrite !inE/=!in_itv/= => /andP[-> h0]//=. + apply (lt_le_trans h0). + by rewrite lerD //= ge_min lexx. + apply /continuous_subspaceW/cfplus. + rewrite closure_neitv_oo;last by rewrite ltrDl. + apply subset_itvl. + rewrite bnd_simp /=. + by rewrite lerD //= ge_min lexx. +Qed. +End picard_autonomous. + +Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := + forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. + +(* Section locally_lipschitz. *) +(* Context {R : realType} {n : nat}. *) +(* Notation U := 'rV[R]_n. *) +(* Variables phi : U -> U. *) + +(* Hypothesis phi_locally_lipschitz : locally_lipschitz phi. *) + +(* Theorem cauchy_lipschitz_ll u0 a : exists f delta r, *) +(* delta > 0 /\ is_sol_sym phi u0 a (a + delta) f /\ *) +(* {in `[a, a + delta], forall t, closed_ball u0 r (f t)}. *) +(* Proof. *) +(* have [/= r [k lip]] := phi_locally_lipschitz u0. *) +(* have [//|f [delta [delta_ft0 [solf cball]]]] := cauchy_lipschitz_autonomous _ lip a. *) +(* by exists f, delta, r%:num. *) +(* Qed. *) + +(* End locally_lipschitz. *) + +Section uniqueness. +Context {R : realType} {n : nat} (a b : R). +Notation U := 'rV[R]_n. +Variable phi : U -> U. +Hypothesis ab : a < b. + +Hypothesis phi_locally_lipschitz : locally_lipschitz phi. + +Variables (u0 : U) (f : R -> U) (f' : R -> U). +Hypothesis sol1 : is_sol_on (fun=> phi) u0 a (BLeft b) f. +Hypothesis sol2 : is_sol_on (fun=> phi) u0 a (BLeft b) f'. + +Lemma locally_unique_extends t : a <= t < b -> f' t = f t -> + exists Delta : {posnum R}, {in `[t, t + Delta%:num], f =1 f'}. +Proof. +move=> /andP[ta tb] eq. +have taab : `[t, b] `<=` `[a, b]. + by move=> ?/=; apply: subset_itvr; rewrite bnd_simp. +have [r [k L]] := phi_locally_lipschitz (f t). +have cf0 : {within `[t, b], continuous f}. + have := And33 sol1. + rewrite closure_neitv_oo//; exact: continuous_subspaceW. +have cf'0 : {within `[t, b], continuous f'}. + have := And33 sol2. + by rewrite closure_neitv_oo//; exact: continuous_subspaceW. +have sol10 : is_sol_on (fun => phi) (f t) t (BLeft b) f. + split => //; last by rewrite closure_neitv_oo. + move=> t0 tab. + apply sol1. + by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. +have sol20 : is_sol_on (fun => phi) (f t) t (BLeft b) f'. + split => //; last by rewrite closure_neitv_oo. + move=> t0 tab. + apply sol2. + by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. +have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) phi}. + by move => ? _; apply L. +have k0 : 0 < k%:num by []. +have cont1 : {in closed_ball (f t) r%:num, + forall y : 'rV_n, {within `[t, b], continuous fun=> phi y}}. + by move => y _; exact: cst_continuous_subspace. +have [D [P1 P2]] := initial_solution_unique tb k0 lip20 cont1 cf0 sol10 cf'0 sol20. +by exists D. +Qed. + +Lemma solution_unique : {in `[a, b], f =1 f'}. +Proof. +set E := [set t | t \in `[a, b]%R /\ {in `[a, t], f =1 f'}]. +suff : E b by case. +have Enonempty : E !=set0. + exists a; split; first by rewrite in_itv/= lexx ltW. + rewrite set_itv1 => t; rewrite inE/= => ->. + by rewrite (And31 sol1) (And31 sol2). +have mon c : E c -> forall c', a <= c' <= c -> E c'. + move=> -[+ h c'] /andP[ac' cc']. + rewrite in_itv/= => /andP[ac cb]. + split. + by rewrite in_itv/= ac' (le_trans cc'). + move => t tac'. + apply: h. + by move: tac'; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp. +have monC c c' : a <= c' -> E c -> ~ E c' -> c < c'. + move => ac' Ec nEc'. + rewrite ltNge; apply/negP => c'c. + apply/nEc'/(mon c) => //. + by rewrite ac'. +have [hP|hP] := lem (has_sup E); last first. + have /(has_supPn Enonempty) := hP. + move=> /(_ b)[x Ex bx]. + apply/(mon x) => //. + by rewrite !ltW. +have Eclosed : closed E. + rewrite closedE/= => p pn. + suff : forall x, ~ E x -> \forall y \near x, ~ E y. + move => H. + apply/not_notP => Ec. + apply: pn. + exact: H. + move=> x Ex1. + have [xab|xnab] := boolP (x \in `[a, b]%R); last first. + suff : \forall y \near x, ~ (y \in `[a,b]%R). + move=> h. + near=> y. + rewrite not_andP;left. + near: y. + exact: h. + move: xnab; rewrite in_itv/= negb_and/= -!ltNge => /orP[xa|xb]. + near=> y. + apply/negP; rewrite in_itv/= negb_and/= -!ltNge; apply/orP; left. + by near: y; exact: lt_nbhsl. + near=>y. + apply/negP. + rewrite in_itv/=negb_and/= -!ltNge; apply/orP; right. + by near: y; exact: lt_nbhsr. + rewrite not_andP in Ex1. + case: Ex1 => // {}Ex1. + have [t Et] : exists t, t \in `[a, x] /\ ~ (f t = f' t). + rewrite not_existsP => h. + apply Ex1 => t tax. + have := h t. + by rewrite not_andP => -[//|/contrapT]. + have [xt|xt]:= eqVneq x t. + subst t. + set g := fun x => `|f x - f' x|. + have contg : {within `[a,b], continuous g}. + apply: (within_continuous_comp_norm (ltW ab)) => t. + apply: continuousB. + - have := And33 sol1. + rewrite closure_neitv_oo//. + exact. + - have := And33 sol2. + rewrite closure_neitv_oo//. + exact. + have g0x : g x > 0. + rewrite normr_gt0 subr_eq0. + by apply/eqP; case: Et. + have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t], f =1 f'}. + move => tab gt Et'. + move : gt. + suff -> : g t = 0 by rewrite ltxx. + apply/normr0P. + rewrite Et' ?subrr//. + by move: tab; rewrite inE/= !in_itv/= lexx => /andP[->]. + suff hgx: \forall y \near x^'-, 0 < g y. + near=>y. + have [yx|xy Ey] := ltP y x; last first. + have := mon _ Ey x. + move: xab. + by rewrite /=in_itv/= xy => /andP[-> _] // /(_ isT)[]. + apply/not_andP. + rewrite -implyE => yab. + apply g0 => //. + by move: yx; near: y. + apply: (@cvgr_gt R R (nbhs x^'-) _ g (g x)) => //. + have xa : a < x. + rewrite ltNge. + apply: contra_notN Ex1. + move: xab; rewrite in_itv/= => /andP[+ _] ax. + move/(conj ax) => /andP; rewrite -eq_le => /eqP ->. + rewrite set_itv1/= => y; rewrite inE/= => ->. + by rewrite (And31 sol1) (And31 sol2). + have /(continuous_within_itvP _ ab) := contg => -[h1 _ h2]. + move: xab; rewrite in_itv/= => /andP[_ ]. + rewrite le_eqVlt => /predU1P[-> //|xb]. + apply/cvg_at_left_filter/h1. + by rewrite in_itv/= xb xa. + have xt' : t < x. + case: Et; rewrite inE/=in_itv/= => /andP[_ ]. + by rewrite le_eqVlt eq_sym (negbTE xt) . + near=> y. + move => Ey. + have : ~ E t. + rewrite not_andP. + right. + move=> /(_ t). + case: Et; rewrite !inE/= !in_itv/= => /andP[-> _/=]. + by rewrite lexx => /[swap] => /(_ isT). + have ta : a <= t. + by case: Et; rewrite inE/= in_itv/= => /andP[]. + move/(monC y t ta Ey). + apply/negP; rewrite -leNgt. + by near: y; exact: nbhs_ge. +have supE : E (sup E). + rewrite {1}(closure_id E).1 //. + apply: closure_sup => //. + by apply hP. +have sup_itv : a <= sup E. + apply sup_upper_bound => //. + split; first by rewrite in_itv/= lexx ltW. + move => t. + rewrite set_itv1 inE/= => ->. + by rewrite (And31 sol1) (And31 sol2). +have supeq : f' (sup E) = f (sup E). + apply/esym; apply supE. + by rewrite inE/= in_itv/= lexx sup_itv. +have [h|h] := leP b (sup E). + apply: (mon _ supE) => //. + by rewrite (ltW ab). +have [|Delta Hdelta] := locally_unique_extends _ supeq; first by apply/andP. +have Delta0 : 0 < Delta%:num by []. +suff : Num.min b (sup E + Delta%:num) <= sup E. + rewrite ge_min => /orP[bE|]. + by have := lt_le_trans h bE; rewrite ltxx. + by rewrite gerDl leNgt Delta0. +apply: sup_upper_bound => //. +split. + by rewrite in_itv/= le_min (ltW ab)/= ler_wpDr//= ge_min lexx. +move=> t. +rewrite inE/= in_itv/= => -/andP[t1 t2]. +have [ht|ht] := leP t (sup E). + by apply supE; rewrite inE/= in_itv/= t1 ht. +by apply: Hdelta; rewrite inE/= in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. +Unshelve. all: by end_near. Qed. + +End uniqueness. From bddc92409eb879484b1e1a93e344ef11cd00d5cc Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Mon, 16 Feb 2026 11:06:36 +0900 Subject: [PATCH 116/144] tentative gen of lyapunov stability --- ode_autonomous.v | 80 +++----- tilt_analysis.v | 20 +- tilt_lasalle.v | 65 ++++--- tilt_lyapunov.v | 122 ++++++------ tilt_stability.v | 493 ++++++++++++++++++++++++++++------------------- 5 files changed, 437 insertions(+), 343 deletions(-) diff --git a/ode_autonomous.v b/ode_autonomous.v index 46b90cf8..1cb02228 100644 --- a/ode_autonomous.v +++ b/ode_autonomous.v @@ -7,7 +7,8 @@ From mathcomp Require Import functions reals interval_inference topology. From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. -Require Import ode_common ode_contfun ode. +Require Import ode_common ode_contfun ode tilt_analysis. + (**md**************************************************************************) (* # Proofs of properties of autonomous ODEs *) (* *) @@ -24,7 +25,6 @@ Import numFieldNormedType.Exports. Open Scope ring_scope. Open Scope classical_set_scope. - Section picard_autonomous. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -36,16 +36,15 @@ Hypothesis lip2 : k.-lipschitz_B phi. Definition phi_ (t : R) x := phi x. Definition is_sol_sym u0 t0 d (sol : R -> U):= - sol t0 = u0 /\ {in `]t0-d,t0+d[, - forall x, derivable sol x 1 /\ sol^`() x = phi_ x (sol x)}. + sol t0 = u0 /\ {in `]t0 - d, t0 + d[, + forall x, derivable sol x 1 /\ sol^`() x = phi_ x (sol x)}. -Lemma phi_lip2 a b: {in `[a, b]%R, forall x, k.-lipschitz_B (phi_ x)}. +Lemma phi_lip2 a b : {in `[a, b]%R, forall x, k.-lipschitz_B (phi_ x)}. Proof. by move => x abx; exact: lip2. Qed. Lemma phi_cont1 a b : {in B, forall y, {within `[a, b], continuous phi_ ^~ y}}. Proof. by move => /= x Bx; exact: cst_continuous_subspace. Qed. - Let rho : {posnum R} := (2^-1)%:pos. Let rho1 : rho%:num < 1. @@ -63,6 +62,7 @@ exists (@cauchy_lipschitz_local_f R n phi_ a _ k u0 r aa1 k0 by exists (safe_dist phi_ a (a + 1) k u0 r rho). Qed. +(* TODO: move *) Lemma patch_in {X : Type} (f g : R -> X) S x : x \in S -> patch f S g x = g x. Proof. move => xs. @@ -70,32 +70,16 @@ Proof. by rewrite xs. Qed. - -Lemma closed_ball_split (x1 x2 y :U) q : 0 < q -> closed_ball x1 (q/2) y -> closed_ball x2 (q/2) x1 -> closed_ball x2 q y. -Proof. - move => hq. - have hq2: (0 < q /2). - by rewrite divr_gt0. - rewrite !closed_ballE// /closed_ball_ /=. - move => h1 h2. - rewrite -(subrKA x1 x2). - by apply: (le_trans (ler_normD _ _)); rewrite (splitr q) lerD//. -Qed. - -(*todo : move or PR? *) -Lemma within_continuous_minus (f : R -> U) (a b : R) : - {within `[-b,-a], continuous f} -> {within `[a,b], continuous f \o -%R}. +Lemma closed_ball_split (x1 x2 y : U) q : 0 < q -> + closed_ball x1 (q/2) y -> closed_ball x2 (q/2) x1 -> closed_ball x2 q y. Proof. -have [ab|ba _ |-> _] := ltgtP a b; last 2 first. - by rewrite set_itv_ge ?bnd_simp -?ltNge//; exact: continuous_subspace0. - by rewrite set_itv1; exact: continuous_subspace1. -move/continuous_within_itvP; rewrite ltrN2 => /(_ ab)[cf fb fa]. -apply/(continuous_within_itvP _ ab); split. -- move=> t tab. - apply: (@cvg_comp _ _ _ -%R f); first exact: oppr_continuous. - by apply: cf; rewrite oppr_itvoo !opprK. -- by rewrite -{1}(opprK a); apply/cvg_at_leftNP; exact: fa. -- by rewrite -{1}(opprK b); apply/cvg_at_rightNP; exact: fb. +move => hq. +have hq2: (0 < q /2). + by rewrite divr_gt0. +rewrite !closed_ballE// /closed_ball_ /=. +move => h1 h2. +rewrite -(subrKA x1 x2). +by apply: (le_trans (ler_normD _ _)); rewrite (splitr q) lerD//. Qed. Local Lemma phi_lip2' a b: {in `[a, b]%R, forall x, k.-lipschitz_B (-phi_ x)}. @@ -106,12 +90,13 @@ exact: (lip2 B12). Qed. Local Lemma phi_cont1' a b : {in B, forall y, {within `[a, b], continuous -phi_ ^~ y}}. -Proof. - move => y _. - move => t. - apply: continuousN. - exact: cst_continuous_subspace. +Proof. +move => y _. +move => t. +apply: continuousN. +exact: cst_continuous_subspace. Qed. + (* TODO: extending in both directions should be generalized to non-autonomous *) Lemma cauchy_lipschitz_autonomous a : exists f delta, delta > 0 /\ is_sol_sym u0 a delta f. Proof. @@ -120,7 +105,6 @@ have amin1 : -a < -a + 1 by rewrite ltrDl. have [dminus0 [solminus cminus]] := cauchy_lipschitz_local amin1 k0 (@phi_lip2' (-a) (-a + 1)) (@phi_cont1' (-a) (-a + 1)) rho1. - set fminus0 := @cauchy_lipschitz_local_f R n (fun t x => - phi x) (-a) _ k u0 r amin1 k0 (@phi_lip2' (-a) (-a + 1)) (@phi_cont1' (-a) (-a + 1)) rho rho1. @@ -128,9 +112,9 @@ set dminus := safe_dist (fun t x => - phi x) (-a) (-a + 1) k u0 r rho. set fminus := fminus0 \o -%R. set r2 := (r%:num/2)%:pos. set r4 := (r%:num/4)%:pos. -have ler4 : r4%:num <= r%:num. +have ler4 : r4%:num <= r%:num. by rewrite /r4/= ler_pdivrMr // ler_pMr // lerDl. -have ler42 : r4%:num <= r2%:num. +have ler42 : r4%:num <= r2%:num. by rewrite /r4/r2/= ler_pdivrMr// -mulrA ler_pMr // ler_pdivlMl // mulr1 lerD // lerDl. have adplus : a < a + dplus by rewrite ltrDl dplus0. have cfplus := And33 solplus. @@ -154,7 +138,7 @@ pose f := patch fplus `[a - dboth, a] fminus. set uneg := f (a - dboth). have Buneg : closed_ball uneg (r%:num/2) `<=` closed_ball u0 r%:num. rewrite /uneg/f patch_in/f/=;last first. - by rewrite inE/=in_itv/= gerBl lexx ltW. + by rewrite inE/=in_itv/= gerBl lexx ltW. move => /=x xb. apply: (closed_ball_split _ xb) => //. suff : fminus (a - dboth) \in closed_ball u0 (r%:num/4). @@ -168,7 +152,7 @@ have Buneg : closed_ball uneg (r%:num/2) `<=` closed_ball u0 r%:num. have f01intersect : fminus a = fplus a. by rewrite /fminus/= (And31 solminus) (And31 solplus). have fa : f a = u0. - rewrite /f patch_in /fminus /=. + rewrite /f patch_in /fminus /=. apply solminus. by rewrite inE/=in_itv/= lexx gerBl ltW. set B' := closed_ball uneg (r2%:num). @@ -198,7 +182,7 @@ have fc : {in `[a-dboth, (a + dboth)], forall t : R, closed_ball (fminus (a - d move => t tad. rewrite /f/=/patch/=. have : (closed_ball (fminus (a-dboth)) (r4%:num)) u0. - suff: (fminus (a-dboth)) \in closed_ball u0 (r4%:num). + suff: fminus (a - dboth) \in closed_ball u0 (r4%:num). by rewrite inE/= !closed_ballE/closed_ball_/= // distrC . apply: hrneg. rewrite !inE/=!in_itv/= lerNr lerNl opprD !opprK gerBl ltW //= lerB //. @@ -234,9 +218,8 @@ have fc : {in `[a-dboth, (a + dboth)], forall t : R, closed_ball (fminus (a - d apply: (closed_ball_split _ c2) =>//. exists f, dboth. split => //. -suff h: is_sol_on phi_ (f (a-dboth)) (a-dboth) (BLeft (a+dboth)) f. - by split => //;apply:(And32 h). - +suff h : is_sol_on phi_ (f (a-dboth)) (a-dboth) (BLeft (a+dboth)) f. + by split => //; apply: (And32 h). have kn0 : k != 0 by apply lt0r_neq0. apply /(integral_sol_iff_sol (r := r2) kn0) => //. by rewrite ler_ltD // gtrN. @@ -329,9 +312,9 @@ apply solution_extends => //. apply: lip2. split => /=. rewrite /B. - apply: (le_closed_ball _ Bx1). + apply: (le_closed_ball _ Bx1). by rewrite ler_pdivrMr // ler_pMr // lerDr. - apply: (le_closed_ball _ Bx2). + apply: (le_closed_ball _ Bx2). by rewrite ler_pdivrMr // ler_pMr // lerDr. + move=>x _; exact: cst_continuous_subspace. + by []. @@ -352,13 +335,14 @@ apply solution_extends => //. move : tad. rewrite !inE/=!in_itv/= => /andP[-> h0]//=. apply (lt_le_trans h0). - by rewrite lerD //= ge_min lexx. + by rewrite lerD //= ge_min lexx. apply /continuous_subspaceW/cfplus. rewrite closure_neitv_oo;last by rewrite ltrDl. apply subset_itvl. rewrite bnd_simp /=. by rewrite lerD //= ge_min lexx. Qed. + End picard_autonomous. Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := diff --git a/tilt_analysis.v b/tilt_analysis.v index e5917ce5..aad72f1f 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -245,10 +245,26 @@ apply/continuous_within_itvP => //; split => //. by rewrite inE/= in_itv/= lexx/= ltW. Qed. +Lemma within_continuous_minus {R : realType} {K : numDomainType} + {U : pseudoMetricNormedZmodType K} (f : R -> U) (a b : R) : + {within `[- b, - a], continuous f} -> {within `[a,b], continuous f \o -%R}. +Proof. +have [ab|ba _ |-> _] := ltgtP a b; last 2 first. + by rewrite set_itv_ge ?bnd_simp -?ltNge//; exact: continuous_subspace0. + by rewrite set_itv1; exact: continuous_subspace1. +move/continuous_within_itvP; rewrite ltrN2 => /(_ ab)[cf fb fa]. +apply/(continuous_within_itvP _ ab); split. +- move=> t tab. + apply: (@cvg_comp _ _ _ -%R f); first exact: oppr_continuous. + by apply: cf; rewrite oppr_itvoo !opprK. +- by rewrite -{1}(opprK a); apply/cvg_at_leftNP; exact: fa. +- by rewrite -{1}(opprK b); apply/cvg_at_rightNP; exact: fb. +Qed. + Local Notation Left := (@lsubmx _ 1 _ _). Local Notation Right := (@rsubmx _ 1 _ _). -Lemma left_norm_le {K : rcfType} n1 n2 (x : 'rV[K]_(n1.+1 + n2.+1)) : +Lemma lsubmx_norm_le {K : rcfType} n1 n2 (x : 'rV[K]_(n1.+1 + n2.+1)) : `|Left x| <= `|x|. Proof. rewrite /Num.norm/= !mx_normrE; apply: bigmax_le. @@ -258,7 +274,7 @@ rewrite mxE. exact: (le_bigmax _ _ (i, lshift n2.+1 j)). Qed. -Lemma right_norm_le {K : rcfType} n1 n2 (x : 'rV[K]_(n1.+1 + n2.+1)) : +Lemma rsubmx_norm_le {K : rcfType} n1 n2 (x : 'rV[K]_(n1.+1 + n2.+1)) : `|Right x| <= `|x|. Proof. rewrite /Num.norm/= !mx_normrE; apply: bigmax_le. diff --git a/tilt_lasalle.v b/tilt_lasalle.v index ef2a17af..865b9123 100644 --- a/tilt_lasalle.v +++ b/tilt_lasalle.v @@ -12,7 +12,12 @@ Require Import ode tilt_stability tilt_lyapunov. (**md**************************************************************************) (* # Formalization of [benallegue2023itac] (2/2) *) (* *) +(* The main result of this file is to show that all solutions converge to one *) +(* of the two equilibrium points. *) +(* *) (* Reference: *) +(* - [cohen2017itp] C. Cohen, D. Rouhling. A formal proof in Coq of LaSalle’s *) +(* invariance principle. ITP 2017 *) (* - [benallegue2023itac] *) (* https://hal.science/hal-04271257v1/file/benallegue2019tac_October_2022.pdf *) (******************************************************************************) @@ -286,41 +291,39 @@ rewrite /= /lasalle.is_invariant/=. move => /= x. (* . [/= sol' [d [solP [t h]]]]*) rewrite /Ksub/= => -[Vx Kx] t t0. split; last first. -- apply/(@tilt_state_spaceS _ alpha1 gamma). + apply/(@tilt_state_spaceS _ alpha1 gamma). exists (sol x), (t + 1) => /=. (* use large enough time *) split => //. - rewrite initp. - exact/mem_set. - apply global_sol_sol. - apply isSol => //. - by rewrite inE. - exists t; split => //. - by rewrite /=in_itv/=t0/=ltrDl. -- move/mem_set : (Kx) => /isSol /is_sol_on0yP solA. - rewrite (le_trans _ Vx)//. - rewrite -[in leRHS](@initp x). - have : is_sol_on0o phi (BLeft (t + 1)) (sol x). - move => t'. - rewrite in_itv/= => /andP[t0' _]. - by apply solA. - move /(V_nincr ) => /=. - move /(_ (V1 alpha1 gamma)). - apply. - exact: V1_diff. - (* apply : (V_nincr solA (V1_diff _ _)); rewrite ?t0 ?lexx //. *) - move => t1 tt1. - apply : (@derive_along_V1_le0 _ _ _ _ _ (t+1))=> //. - apply global_sol_sol => //. + + rewrite initp. + exact/mem_set. + + apply global_sol_sol. + apply isSol => //. + by rewrite inE. + + exists t; split => //. + by rewrite /= in_itv/=t0/=ltrDl. +move/mem_set : (Kx) => /isSol /is_sol_on0yP solA. +rewrite (le_trans _ Vx)//. +rewrite -[in leRHS](@initp x). +have : {in `[0, t + 1[, forall t : K, derivable (sol x) t 1}. + move=> t'. + rewrite in_itv/= => /andP[t0' _]. + by apply solA. +move/V_nincr => /= => /(_ (V1 alpha1 gamma)). +apply. +- exact: V1_diff. +- move => t1 tt1. + apply : (@derive_along_V1_le0 _ _ _ _ _ (t + 1))=> //. + + apply global_sol_sol => //. apply/is_sol_on0yP. + by apply solA. + + by rewrite initp inE. + + move => t2. + move => /andP[t2' _]. + apply/derivable1_diffP. apply solA. - by rewrite initp inE. - move => t2. - move => /andP[t2' _]. - apply/derivable1_diffP. - apply solA. - by rewrite ltW. - by rewrite ltrDl. - by rewrite lexx. + by rewrite ltW. +- by rewrite ltrDl. +- by rewrite lexx. Qed. Local Lemma sol_Ksub p u : u \in Ksub p -> is_sol_on0y phi (sol u). diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index 0324cc74..93858a84 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -11,8 +11,17 @@ Require Import ode tilt_stability. (**md**************************************************************************) (* # Formalization of [benallegue2023itac] (1/2) *) (* *) +(* This file starts with a formal description of the physical model. *) +(* The final result of this file is the proof that the equilibrium point 0 is *) +(* stable. *) +(* *) (* ``` *) -(* Tilt.Upsilon1 == state-space *) +(* S2 == unit sphere centered at 0 *) +(* Tilt.point{1.2} == equilibrium points *) +(* Tilt.Upsilon1 == state-space *) +(* Tilt.eqn == equation (14) in [benallegue2023itac] *) +(* u2 == 2x2 matrix to prove the Lyapunov function *) +(* V1 == Lyapunov function *) (* ``` *) (* *) (* Reference: *) @@ -33,9 +42,12 @@ Local Open Scope classical_set_scope. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -(* Modelization of the physical problem *) +Definition S2 {K : realType} := [set x : 'rV[K]_3 | `|x|_e = 1]. + +Module PhysicalModel. + Section ya. -(* mesure de l'accelerometre *) +(* accelerometer measure *) Variable K : realType. Variable R : K -> 'M[K]_3. (* L/W *) Variable g0 : K. (*standard gravity constant*) @@ -73,8 +85,6 @@ Qed. End ya. -Definition S2 {K : realType} := [set x : 'rV[K]_3 | `|x|_e = 1]. - (* section III.A of [benallegue2023itac] *) Section state_dynamics. Variable K : realType. @@ -350,6 +360,8 @@ Qed. End two_steps_first_order_estimator. +End PhysicalModel. + Module Tilt. Section tilt. Context {K : realType}. @@ -360,13 +372,13 @@ Definition eqn_functional (f : K -> 'rV[K]_6) : K -> 'rV[K]_6 := let error2_p_dot := Right \o f in fun t => row_mx (- alpha1 *: error1_p_dot t) - (eqn14b_rhs gamma (error1_p_dot t) (error2_p_dot t)). + (PhysicalModel.eqn14b_rhs gamma (error1_p_dot t) (error2_p_dot t)). Definition eqn (dot_zp1_z2 : 'rV[K]_6) : 'rV[K]_6 := let dot_zp1 := Left dot_zp1_z2 in let dot_z2 := Right dot_zp1_z2 in row_mx (- alpha1 *: dot_zp1) - (eqn14b_rhs gamma dot_zp1 dot_z2). + (PhysicalModel.eqn14b_rhs gamma dot_zp1 dot_z2). Lemma eqnE (f : K -> 'rV[K]_6) t : eqn (f t) = eqn_functional f t. Proof. by []. Qed. @@ -391,6 +403,7 @@ Definition points := [set point1; point2]. End tilt. End Tilt. +(* properties of Tilt.eqn *) Section tilt_eqn. Context {K : realType}. Variables alpha1 gamma : K. @@ -408,7 +421,7 @@ exists (PosNum k0) => /= => -[/= x0 x1] [x0B x1B]. rewrite (opp_row_mx (n1:=3)) (add_row_mx (n1:=3)). rewrite !scaleNr opprK/=. rewrite addrC -scalerBr. -rewrite /eqn14b_rhs. +rewrite /PhysicalModel.eqn14b_rhs. rewrite -!scalemxAl -scalerBr. rewrite (norm_rowmx (m:=0) (n1:=2) (n2:=2)). rewrite ge_max; apply/andP; split. @@ -416,7 +429,7 @@ rewrite ge_max; apply/andP; split. rewrite -linearB/=. rewrite ler_pM//. rewrite distrC. - exact/le_trans/(@left_norm_le _ 2 2). + exact/le_trans/(@lsubmx_norm_le _ 2). - rewrite mx_normZ. set a := Right x0 - Left x0. set b := Right x1 - Left x1. @@ -424,16 +437,16 @@ rewrite ge_max; apply/andP; split. set d := \S('e_2 - Right x1) ^+ 2. have abound : `|a| <= 2 * (`|x| + 1). rewrite (le_trans (ler_normB _ _ ))// mulrDl lerD// mul1r. - rewrite (le_trans (right_norm_le _))//. + rewrite (le_trans (rsubmx_norm_le _))//. exact: closed_ball_bounded. - rewrite (le_trans (left_norm_le _))//. + rewrite (le_trans (lsubmx_norm_le _))//. exact: closed_ball_bounded. (* todo: find some bound and show *) have sbound x' : closed_ball x 1 x' -> `|'e_2 - Right x'| <= 2+`|x|. move=> cb. rewrite (le_trans (ler_normB _ _))// [in leRHS](natrD _ 1 1) -addrA lerD//. exact: mx_norm_delta_mx. - by rewrite (le_trans (right_norm_le _))// addrC closed_ball_bounded. + by rewrite (le_trans (rsubmx_norm_le _))// addrC closed_ball_bounded. have dbound : `|d| <= 3 * (2 + `|x|) ^+ 2. rewrite /d. apply: (le_trans (spin_sq_norm_bound _)). @@ -455,9 +468,9 @@ rewrite ge_max; apply/andP; split. have -> : 'e_2 - Right x0 - ('e_2 - Right x1) = Right x1 - Right x0. by rewrite opprB addrC addrA subrK. rewrite !mulrA. - apply ler_pM => //; last by rewrite distrC -linearB; exact: right_norm_le. + apply ler_pM => //; last by rewrite distrC -linearB; exact: rsubmx_norm_le. rewrite (mulrC 3) -!mulrA. - apply : (le_trans (ler_pM _ _ abound (le_refl _))) => //. + apply: (le_trans (ler_pM _ _ abound (lexx _))) => //. rewrite !mulrA. rewrite ler_pdivlMl; last first. by rewrite mulr_gt0// gtr0_norm. @@ -473,8 +486,8 @@ rewrite ge_max; apply/andP; split. rewrite [in leRHS](natrM _ 3 2)// -mulrA ler_pM//. rewrite (le_trans (ler_normD _ _))//. rewrite mulrDl lerD// mul1r. - by rewrite -linearB; apply: right_norm_le. - by rewrite distrC -linearB/=; apply: left_norm_le. + by rewrite -linearB; exact: rsubmx_norm_le. + by rewrite distrC -linearB/=; exact: lsubmx_norm_le. rewrite (le_trans (ler_pM _ _ dbound (lexx _ )))//. rewrite ler_pdivlMl; last first. by rewrite mulr_gt0// gtr0_norm. @@ -627,7 +640,7 @@ split. rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP => i. by rewrite lsubmx_const. apply/eqP/rowP; move => i; apply/eqP. - rewrite /eqn14b_rhs. + rewrite /PhysicalModel.eqn14b_rhs. set N := (X in _ *: X *m _); have : N = 0. rewrite /N /=; apply /rowP; move => a. rewrite !mxE. @@ -663,7 +676,7 @@ have N0 : N = 0. by rewrite i3k -ltn_subRL subnn. split. by rewrite scaler_eq0 N0 eqxx orbT. -rewrite /eqn14b_rhs. +rewrite /PhysicalModel.eqn14b_rhs. rewrite -scalemxAl scalemx_eq0 gt_eqF//=. rewrite -[Left Tilt.point2]/N N0 subr0. set M := (X in X *m _); rewrite -/M. @@ -684,7 +697,6 @@ Qed. End tilt_eqn. -(* technical section, skip on a first reading *) Section u2. Context {K : realType}. @@ -789,6 +801,15 @@ Definition V1 (zp1_z2 : 'rV[K]_6) : K := let z2 := Right zp1_z2 in `|zp1|_e ^+ 2 / (2 * alpha1) + `|z2|_e ^+ 2 / (2 * gamma). +Lemma V1_diff (t : 'rV_6) : differentiable V1 t. +Proof. +apply/differentiableD => //=. + apply/differentiableM => //=. + exact/differentiable_enorm_squared/differentiable_lsubmx_comp. +apply/differentiableM => //=. +exact/differentiable_enorm_squared/differentiable_rsubmx_comp. +Qed. + Lemma V1_is_Lyapunov_candidate : is_Lyapunov_candidate V1 [set: 'rV_6] Tilt.point1. Proof. @@ -835,11 +856,12 @@ Definition locally_exponentially_stable_at n (eqn : 'rV[K]_n -> 'rV[K]_n) (point : 'rV[K]_n) : Prop := hurwitz (jacobian eqn point). +(* TODO: rm? *) Lemma tilt_eqn_is_locally_exponentially_stable_at_0 alpha1 gamma : locally_exponentially_stable_at (Tilt.eqn alpha1 gamma) Tilt.point1. Proof. rewrite /locally_exponentially_stable_at /jacobian /hurwitz. -rewrite /lin1_mx/= /Tilt.eqn /eqn14b_rhs/=. +rewrite /lin1_mx/= /Tilt.eqn /PhysicalModel.eqn14b_rhs/=. move => a. move/eigenvalueP => [u] /[swap] u0 H. have a_eigen : eigenvalue (jacobian (Tilt.eqn alpha1 gamma) Tilt.point1) a. @@ -1026,8 +1048,8 @@ rewrite -fctE /= !derive_along_enorm_squared//=. exact: tilt_eqnx. - move: t0Delta. by rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. -- exact/differentiable_lsubmx_comp. - exact: dif1. +- exact/differentiable_lsubmx_comp. - exact: dif1. Qed. @@ -1213,12 +1235,7 @@ split. rewrite /is_sol_on0o in solves. rewrite /= derivative_derive_along_eq0 => //; last first. admit. - rewrite /V1. - apply: differentiableD => //; last first. - apply: differentiableM; last exact: differentiable_cst. - exact/differentiable_enorm_squared/differentiable_rsubmx_comp. - apply: differentiableM => //. - exact/differentiable_enorm_squared/differentiable_lsubmx_comp. + exact: V1_diff. near=> z0. rewrite derive_along_V1. - have z00Delta : z0 \in `[0, Delta[%R. @@ -1392,23 +1409,21 @@ rewrite /V1 derive_alongD; last 3 first. exact: dif1. under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. -rewrite derive_alongMl => //; last first. +rewrite derive_alongMl//; last first. exact: dif1. exact/differentiable_enorm_squared/differentiable_lsubmx_comp. rewrite derive_alongMl => //; last first. exact: dif1. exact/differentiable_enorm_squared/differentiable_rsubmx_comp. - rewrite -fctE /= !derive_along_enorm_squared//=. - move : t0. - rewrite le_eqVlt => /predU1P[<-//|t0]. - rewrite V1dotE0 => //. +rewrite -fctE /= !derive_along_enorm_squared//=; last 3 first. + exact:dif1. + exact/differentiable_lsubmx_comp. + exact:dif1. +move: t0; rewrite le_eqVlt => /predU1P[<-//|t0]. + by rewrite V1dotE0// !invfM. +rewrite (V1dotE alpha1_gt0 gamma_gt0 (@global_sol_sol _ _ _ _ tilt_eqnx (BLeft (t + 1)))) //. by rewrite !invfM. - - rewrite (V1dotE alpha1_gt0 gamma_gt0 (@global_sol_sol _ _ _ _ tilt_eqnx (BLeft (t + 1)))) //. - by rewrite !invfM. - by rewrite inE/= in_itv/= (ltW t0) ltrDl;apply /andP. -- exact/differentiable_lsubmx_comp. -exact:dif1. -exact:dif1. +by rewrite inE/= in_itv/= (ltW t0) ltrDl; apply /andP. Qed. Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : @@ -1454,39 +1469,27 @@ Hypothesis alpha1_gt0 : 0 < alpha1. Let phi := Tilt.eqn alpha1 gamma. Variable Init : set 'rV[K]_6. -(* Hypothesis y_sol : is_sol Delta (sol 0). *) -(* Hypothesis y00 : sol 0 0 = 0. *) - -Lemma V1_diff : forall t : 'rV_6, differentiable (V1 alpha1 gamma) t. -Proof. -move=> t; apply/differentiableD => //=. - apply/differentiableM => //=. - exact/differentiable_enorm_squared/differentiable_lsubmx_comp. -apply/differentiableM => //=. -exact/differentiable_enorm_squared/differentiable_rsubmx_comp. -Qed. - Lemma equilibrium_zero_stable : - 0 \in Init -> open Init -> Init `<=` Tilt.Upsilon1 -> + Tilt.point1 \in Init -> open Init -> Init `<=` Tilt.Upsilon1 -> is_locally_stable_at phi Init Tilt.point1. Proof. move=> Init0 openInit Init_in_state. -apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). +apply: (@Lyapunov_stability0 K _ phi Init openInit (V1 alpha1 gamma)). - exact: V1_diff. -- move=> Delta sol sol0 solP t t0. +- move=> Delta /= sol sol0 solP t t0. apply: (@derive_along_V1_le0 _ _ _ _ _ Delta sol). + assumption. + assumption. + assumption. - + by apply/mem_set/Init_in_state/set_mem. + + rewrite inE. + apply: Init_in_state. + by rewrite inE in sol0. + move=> /= t1 t10Delta. - rewrite -derivable1_diffP. + apply/derivable1_diffP. apply solP. rewrite in_itv/=. by case/andP : t10Delta => /ltW -> ->. - + case/andP : t0 => t0 tDelta. - rewrite tDelta andbT. - assumption. + + assumption. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. rewrite /is_Lyapunov_candidate /Tilt.point1 => Hpos. rewrite /V1 lsubmx_const rsubmx_const; split => //. @@ -1496,9 +1499,6 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). case : Hpos => // _ [V1_eq0 V1_gt0]. apply: V1_gt0 => //. by rewrite inE. -- split => // Delta. - have [_] := equilibrium_tilt_point1 alpha1 gamma. - exact. Qed. End equilibrium_zero_stable. diff --git a/tilt_stability.v b/tilt_stability.v index 040b6214..35d4d559 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -1,34 +1,36 @@ From HB Require Import structures. -From mathcomp Require Import all_boot all_algebra ring. +From mathcomp Require Import all_boot all_order all_algebra ring. From mathcomp Require Import interval_inference. -From mathcomp Require Import boolp classical_sets functions reals order. -From mathcomp Require Import topology normedtype landau sequences derive realfun. -From mathcomp Require Import matrix_normedtype. +From mathcomp Require Import boolp classical_sets functions filter reals. +From mathcomp Require Import topology prodnormedzmodule normedtype landau. +From mathcomp Require Import sequences derive realfun. Require Import ssr_ext euclidean rigid frame skew derive_matrix. Require Import tilt_mathcomp tilt_analysis tilt_robot ode. (**md**************************************************************************) (* # Elements of stability theory *) (* *) +(* This file provides elements of stability theory including a proof of *) +(* Lyapunov's stability theorem. *) +(* *) (* ``` *) (* posdefmx M == M is definite positive *) -(* locposdef V x == V is locally positive definite at x *) (* is_Lyapunov_candidate V := locposdef V *) -(* locnegsemidef V x == V is locally negative semidefinite *) -(* 'D~(sol, x0) V == derivative of V along the solution sol *) -(* starting at x0 *) +(* 'D~(f) V == derivative of V along the solution f *) (* is_equilibrium_point f p := solves_equation f (cst p) *) -(* state_space f == the set points attainable by a solution *) -(* (in the sense of `is_sol`) *) -(* is_Lyapunov_stable_at f V x == Lyapunov stability *) +(* state_space phi Init == the set points attainable by a solution *) +(* of the autonomous ODE phi starting from *) +(* Init *) +(* is_locally_stable_at f V x == Lyapunov stability *) +(* is_stable_at f V x == TODO *) (* ``` *) (* *) (* Reference: *) (* - Hassan K. Khalil, Nonlinear systems, 2002 *) (******************************************************************************) -Reserved Notation "''D~(' sol , x ) f" (at level 10, sol, x, f at next level, - format "''D~(' sol , x ) f"). +Reserved Notation "''D~(' f ) V" (at level 10, f, V at next level, + format "''D~(' f ) V"). Set Implicit Arguments. Unset Strict Implicit. @@ -39,12 +41,10 @@ Import numFieldNormedType.Exports. Local Open Scope ring_scope. -Section posdefmx. - Definition posdefmx {K : realType} m (M : 'M[K]_m) : Prop := M \is sym m K /\ forall a, eigenvalue M a -> a > 0. -Lemma posdefmxP_direct {R : realType} m (M : 'M[R]_m) : +(*Lemma posdefmxP_direct {R : realType} m (M : 'M[R]_m) : posdefmx M -> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). Proof. Abort. @@ -52,9 +52,7 @@ Abort. Lemma posdefmxP_converse {R : realType} m (M : 'M[R]_m) : (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0) -> posdefmx M. Proof. -Abort. - -End posdefmx. +Abort.*) Local Open Scope classical_set_scope. @@ -65,36 +63,31 @@ Implicit Types V : T -> R. Definition is_Lyapunov_candidate V (D : set T) (x : T) := x \in D /\ V x = 0 /\ forall z, z \in D -> z != x -> V z > 0. -(* NB: useful? mettre dans un fichier wip.v? *) Definition locnegdef V (x : T) := V x = 0 /\ \forall z \near x^', V z < 0. -(* NB: useful? mettre dans un fichier wip.v? *) (* locally negative semidefinite *) Definition locnegsemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z <= 0. End locdef. -(* derivation along the trajectory h *) -Definition derive_along {R : realType} {n : nat} - (V : 'rV[R]_n -> R) (f : R -> 'rV[R]_n) - (t : R) : R := +(* derivation along the solution f, see Khalil p.114 *) +(* NB: we are not representing the initial state at t = 0 of the trajectory sol *) +Definition derive_along {R : numFieldType} {n : nat} (V : 'rV[R]_n -> R) + (f : R -> 'rV[R]_n) (t : R) : R := (jacobian1 V (f t))^T *d 'D_1 f t. -Notation "''D~(' sol ) f" := (derive_along f (sol)). +Notation "''D~(' f ) V" := (derive_along V f). Section derive_along. Context {R : realType} {n : nat}. Variable sol : R -> 'rV[R]_n. -(* sol represents a solution of a differential equation *) Lemma derive_along_derive (V : 'rV[R]_n -> R) (t : R) : differentiable V (sol t) -> differentiable sol t -> 'D~(sol) V t = 'D_1 (V \o sol) t. -(* Warning: we are not representing the initial state at t = 0 of the trajectory sol - see Khalil p.114 *) Proof. -move=> dif1 dif2. -rewrite /derive_along /=. +move=> difV difsol. +rewrite /derive_along/=. rewrite /jacobian1. rewrite /jacobian. rewrite /dotmul. @@ -131,12 +124,12 @@ congr (_ *: _). by rewrite derive_along_derive. Qed. -Lemma derive_alongD (f g : 'rV_n -> R) t : - differentiable f (sol t) -> differentiable g (sol t) -> +Lemma derive_alongD (V1 V2 : 'rV_n -> R) t : + differentiable V1 (sol t) -> differentiable V2 (sol t) -> differentiable sol t -> - 'D~(sol) (f + g) t = 'D~(sol) f t + 'D~(sol) g t. + 'D~(sol) (V1 + V2) t = 'D~(sol) V1 t + 'D~(sol) V2 t. Proof. -move=> dfx dgx difp. +move=> dfV1 dfV2 dfsol. rewrite derive_along_derive; last 2 first. exact: differentiableD. by []. @@ -222,6 +215,7 @@ Context {K : realType} {n : nat}. Let U := 'rV[K]_n. Variables (phi : U -> U) (Delta : K). +(* TODO: rm? *) (*Lemma is_sol_on0oS (A B : set U) : A `<=` B -> is_sol_on0o phi Delta A `<=` is_sol_on0o phi Delta B. Proof. @@ -238,7 +232,6 @@ Context {K : realType} {n : nat}. Let T := 'rV[K]_n. Variable phi : T -> T. -(* TODO: two state_space definitions?! *) Definition state_space (Init : set T) : set T := [set x | exists f Delta, [/\ f 0 \in Init, is_sol_on0o phi (BLeft Delta) f & (exists t, t \in `[0, Delta[%R /\ x = f t) ]]. @@ -248,32 +241,21 @@ End state_space. Section equilibrium_point. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. -Variable phi : T -> T. (* was (K -> T) -> K -> T *) -Variable Init : set T. -Variable Delta : K. +Variable phi : T -> T. -Definition is_equilibrium_point (x : T) := - x \in Init /\ forall Delta, is_sol_on0o phi Delta (cst x). +Definition is_equilibrium_point (Init : set T) (x : T) := + x \in Init /\ forall d, is_sol_on0o phi d (cst x). -Lemma equilibrium_point_in_state_space (x : T) : is_equilibrium_point x -> x \in state_space phi Init. +Lemma equilibrium_point_in_state_space (Init : set T) : + is_equilibrium_point Init `<=` state_space phi Init. Proof. - move => [xinit solD]. - rewrite inE. - exists (cst x). - exists (1). - split=>//. - exists 0. - split=>//. - by rewrite in_itv/= lexx //= ltW. +move=> x [xinit solf]. +exists (cst x), 1; split => //. +exists 0; split =>//. +by rewrite bound_itvE ltr01. Qed. -End equilibrium_point. - -Section equilibrium_point. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. -Definition equilibrium_points A := [set p : T | is_equilibrium_point phi A p]. +Definition equilibrium_points Init := [set p | is_equilibrium_point Init p]. Lemma equilibrium_points_subset (A B : set T) : A `<=` B -> equilibrium_points A `<=` equilibrium_points B. @@ -282,9 +264,9 @@ move=> AB x. rewrite /equilibrium_points/= /is_equilibrium_point /is_sol_on0o inE => -[Ax H]. split. exact/mem_set/AB. -move=> Delta t t0D. -have [deriv1 deriv2] := H Delta t t0D. -by split => //. +move=> d t t0d. +have [H1 H2] := H d t t0d. +by split. Qed. End equilibrium_point. @@ -297,23 +279,21 @@ Variable Init : set T. Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n) (Delta : K), f 0 \in Init /\ is_sol_on0o phi (BLeft Delta) f -> - `| f 0 - x | < d -> forall t, 0 < t < Delta -> `| f t - x | < eps. + forall (f : K -> 'rV[K]_n) (D : K), f 0 \in Init /\ is_sol_on0o phi (BLeft D) f -> + `| f 0 - x | < d -> forall t, 0 < t < D -> `| f t - x | < eps. (* assuming solution exists for all time *) Definition is_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & forall (f : K -> 'rV[K]_n), f 0 \in Init /\ is_sol_on0y phi f -> - `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. + `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. -Lemma locally_stable_stable x : is_locally_stable_at x -> is_stable_at x. +Lemma locally_stable_stable : is_locally_stable_at `<=` is_stable_at. Proof. -move => lstable e e0. -move /(_ _ e0) : lstable => [d d0 stable]. -exists d => // z [z0Init zglob] zd t t0. -apply (stable _ (t + 1)) => //. - split => //. - by apply global_sol_sol. +move=> x H e /H [d d0 stable]. +exists d => // z [z0Init zglob] zd /= t t0. +apply: (stable _ (t + 1)) => //. + by split => //; exact: global_sol_sol. by rewrite t0/= ltrDl. Qed. @@ -322,6 +302,7 @@ Definition is_asymptotically_stable_at (x : T) (f : K -> 'rV[K]_n) : Prop := End stability. +(* TODO: rm? *) Section bounded. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. @@ -458,13 +439,12 @@ Context {K : realType} {n : nat}. Let U := 'rV[K]_n.+1. Variable phi : U -> U. Variable Delta : K. -Variable u0 : U. -Variable sol : K -> U (* TODO(2026-02-08): maybe this should be U -> K -> U to match lasalle *). -Hypothesis solP : is_sol_on0o phi (BLeft Delta) sol. +Variable sol : K -> U. +Hypothesis solP : {in `[0, Delta[%R, forall t, derivable sol t 1}. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. +Hypothesis DV_le0 : forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. Lemma V_nincr a b : b < Delta -> 0 <= a <= b -> V (sol b) <= V (sol a). @@ -474,24 +454,18 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. - move=> y yb. apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. rewrite -derivable1_diffP. - move: solP. - move/(_ y) /(_ _) => []. - move: yb. - apply: subset_itv; rewrite bnd_simp//. - exact: ltW. - by []. + apply: solP. + move: yb. + by apply: subset_itv; rewrite bnd_simp// ltW. - move=> y yb. rewrite derive1E -derive_along_derive//. - + apply: V'_le0. + + apply: DV_le0. move : yb; rewrite in_itv/= => /andP[->/= /lt_le_trans]; apply. exact: ltW. + rewrite -derivable1_diffP. - move: solP. - move/(_ y) /(_ _) => []. - move: yb. - apply: subset_itv; rewrite bnd_simp//. - exact/ltW. - by []. + apply: solP. + move: yb. + by apply: subset_itv; rewrite bnd_simp// ltW. - (* `[0, b] *) have [b0|] := ltP 0 b; last first. move=> b0. @@ -505,11 +479,9 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. apply: continuous_comp; last exact: differentiable_continuous. apply: differentiable_continuous => //. rewrite -derivable1_diffP. - move: solP. - move/(_ z) /(_ _) => []. - move: z0b. - by apply: subset_itv; rewrite bnd_simp// ltW. - by []. + apply: solP. + move: z0b. + by apply: subset_itv; rewrite bnd_simp// ltW. + have d0 : 0 < Delta by apply /lt_trans/bDelta. have cont : {in `[0, Delta[%R, continuous sol}. move=> t t0D. @@ -525,28 +497,21 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. apply: differentiable_continuous => //. apply: differentiable_comp. rewrite -derivable1_diffP. - move: solP. - move/(_ b) /(_ _) => []. - by rewrite in_itv/= (ltW b0)// bDelta. - by []. - by apply: Vdiff. -- by rewrite !in_itv/= lexx (le_trans a_ge0). + apply: solP. + by rewrite in_itv/= (ltW b0)// bDelta. + exact: Vdiff. +- by rewrite bound_itvE (le_trans a_ge0). - by rewrite in_itv/= ab andbT. Qed. End about_Lyapunov_function. -(* khalil theorem 4.1 *) Section Lyapunov_stability. Context {K : realType} {n : nat}. Let U := 'rV[K]_n.+1. Variable phi : U -> U. Variable Init : set U. -Let u0 : U := 0. -Hypothesis u0Init : u0 \in Init. - -Hypothesis openInit : open Init. (* Init est forcement un ouvert *) -(* see Cohen Rouhling ITP 2017 Sect 3.2 *) +Hypothesis openInit : open Init. Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. @@ -555,46 +520,48 @@ Proof. by move=> r0; rewrite /B -closed_ballE. Qed. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall Delta sol, sol 0 \in Init -> is_sol_on0o phi (BLeft Delta) sol -> - forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. +Hypothesis DV_le0 : forall D f, f 0 \in Init -> + is_sol_on0o phi (BLeft D) f -> + forall t, 0 < t < D -> 'D~(f) V t <= 0. -Theorem Lyapunov_stability (x : 'rV[K]_n.+1 := 0) : - is_Lyapunov_candidate V Init x -> - is_equilibrium_point phi Init x -> - is_locally_stable_at phi Init x. +(* khalil theorem 4.1 *) +Theorem Lyapunov_stability0 : + is_Lyapunov_candidate V Init 0 -> is_locally_stable_at phi Init 0. Proof. -move=> VDx eq /= eps eps0/=. -move: VDx => [/= xD [Vx0 DxV]]. -have [r r_gt0 [r_eps BrD]] : exists2 r : K, 0 < r & r <= eps /\ B r `<=` Init. - move: xD; rewrite inE => /(open_subball openInit)[r0/= r0_gt0] q. +move=> VInitx /= eps eps0/=. +move: VInitx => [/= xInit [Vx0 InitxV]]. +have [r [r_gt0 r_eps BrD]] : exists r : K, [/\ 0 < r, r <= eps & B r `<=` Init]. + move: xInit; rewrite inE => /(open_subball openInit)[r0/= r0_gt0] q. pose r := Num.min (r0 / 2) eps. have r_gt0 : 0 < r by rewrite /r lt_min eps0 divr_gt0. - exists (r / 2); first by rewrite divr_gt0. - split; first by rewrite /r ler_pdivrMr// ge_min ler_pMr// ler1n orbT. - move=> v Brv; apply (q r) => //. - rewrite /ball/= sub0r normrN gtr0_norm//. - by rewrite /r gt_min ltr_pdivrMr// ltr_pMr// ltr1n. - by move: Brv; rewrite BE ?divr_gt0//; exact: subset_closure_half. + exists (r / 2); split. + - by rewrite divr_gt0. + - by rewrite /r ler_pdivrMr// ge_min ler_pMr// ler1n orbT. + - move=> v Brv; apply: (q r) => //. + rewrite /ball/= sub0r normrN gtr0_norm// gt_min. + by rewrite gtr_pMr ?invf_lt1 ?ltr1n. + move: Brv; rewrite BE ?divr_gt0//. + exact: subset_closure_half(*TODO: naming seems off, report*). +rewrite {xInit}. have alpha_min : {x : 'rV[K]_n.+1 | x \in sphere r /\ forall y, y \in sphere r -> V x <= V y}. have : {within sphere r, continuous V}. apply: continuous_subspaceT => /= v. by apply/differentiable_continuous; exact/Vdiff. move/(EVT_min_rV (sphere_nonempty _ r_gt0) (@compact_sphere _ _ r)). - have m0 : n.+1 != 0 by []. - move=> /(_ m0). - by move=> /cid2[c sphere_r_c sphere_r_V]; exists c. + by move=> /(_ isT)/cid2[c sphere_r_c sphere_r_V]; exists c. pose alpha := V (sval alpha_min). have alpha_gt0 : 0 < alpha. have sphere_pos y : y \in sphere r -> 0 < V y. - move=> yr; apply: DxV; last first. - rewrite gtr0_norm_neq0//. - by move: yr; rewrite inE /sphere/= => ->. + move=> yr; apply: InitxV; last first. + rewrite gtr0_norm_neq0//. + by move: yr; rewrite inE /sphere/= => ->. apply/mem_set/BrD. - move : yr; rewrite inE /sphere/= => <-. + move: yr; rewrite inE /sphere/= => <-. by rewrite /B /closed_ball_/= sub0r normrN. rewrite /alpha sphere_pos// /sphere inE/=. by have [+ _] := svalP alpha_min; rewrite inE. +rewrite {InitxV}. have [beta /andP[beta_gt0 beta_alpha]] : exists beta, 0 < beta < alpha. by exists (alpha / 2); rewrite divr_gt0//= ltr_pdivrMr//= ltr_pMr// ltr1n. set Omega_beta := [set x : 'rV[K]_n.+1 | B r x /\ V x <= beta]. @@ -602,7 +569,7 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. move=> y [Bry Vybeta]. rewrite BE// interior_closed_ballE => //=. have yr : `|y| <= r by move: Bry; rewrite /B /closed_ball_/= sub0r normrN. - have [{}yr | ry | {}yr] := ltgtP (`|y|) r. + have [{}yr|ry|{}yr] := ltgtP `|y| r. - by rewrite mx_norm_ball /ball_/= sub0r normrN. - by have := le_lt_trans yr ry; rewrite ltxx. - have alphaVy : alpha <= V y. @@ -610,75 +577,55 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta Delta sol : sol 0 \in Init -> is_sol_on0o phi (BLeft Delta) sol -> - sol 0 \in Omega_beta -> forall t, 0 < t < Delta -> sol t \in Omega_beta. - move=> sol0 solP phi_Omega. - have /= V_nincr_consequence : forall t, 0 < t < Delta -> forall u, 0 <= u <= t -> - 'D~(sol) V u <= 0 -> - V (sol t) <= V (sol 0) <= beta. - move=> /= t1 /andP[t10 t1Delta] u ut1 Vle0. - apply/andP; split. - move : phi_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. - apply: (@V_nincr _ _ phi Delta sol). - assumption. - move=> t. - by apply: Vdiff. - move=> /= t t0. - apply: V'_le0 => //. - exact: solP. - assumption. - assumption. - by rewrite lexx/= (ltW t10). - by move: phi_Omega; rewrite inE => -[Brh0 Vh0beta]. - move=> t /andP[t0 tDelta]. - rewrite inE; split; last first. - have : 'D~(sol) V t <= 0. - apply: V'_le0 => //. - exact: solP. - by rewrite t0/=. - have := @V_nincr_consequence t. - rewrite t0 /= tDelta => /(_ isT t). - rewrite lexx (ltW t0)/= => /(_ isT). - move=> /[apply]. +have Df_Omega_beta D f : f 0 \in Init -> is_sol_on0o phi (BLeft D) f -> + f 0 \in Omega_beta -> forall t, 0 < t < D -> f t \in Omega_beta. + move=> f0 solf f0_Omega. + have /= V_nincr_consequence t : 0 < t < D -> forall u, 0 <= u <= t -> + 'D~(f) V u <= 0 -> V (f t) <= V (f 0) <= beta. + move=> /= /andP[t0 tD] u ut Vle0l; apply/andP; split. + - move: f0_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. + apply: (@V_nincr _ _ D f). + + by move=> t' t'0D; apply solf. + + by move=> t'; exact: Vdiff. + + exact: DV_le0. + + assumption. + + by rewrite lexx/= (ltW t0). + - by move: f0_Omega; rewrite inE => -[]. + move=> t /andP[t0 tD]; rewrite inE; split; last first. + have : 'D~(f) V t <= 0 by apply: DV_le0 => //; [exact: solf|rewrite t0]. + have := @V_nincr_consequence t; rewrite t0 /= tD => /(_ isT t). + rewrite lexx (ltW t0)/= => /(_ isT) => /[apply]. by move=> /andP[/le_trans] => /[apply]. - move: phi_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. - rewrite !sub0r !normrN => -[phi0r Vphi0beta]. - rewrite leNgt; apply/negP => phi_t_r. - have [t1 [/andP[t1_ge0 t1t] phit1r]] : exists t0, 0 <= t0 <= t/\ `|sol t0| = r. - have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o sol)}. - (* `[0, t] *) - apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) (sol)) => //. - exact: ltW. - move=> z _. - by apply: norm_continuous. - have cont : {in `[0, Delta[, continuous sol}. - move=> t' t'0D. - rewrite inE in t'0D. - apply: differentiable_continuous. - apply/derivable1_diffP. - by apply solP. - move/continuous_in_subspaceT : cont. + move: f0_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. + rewrite !sub0r !normrN => -[f0r Vf0beta]. + rewrite leNgt; apply/negP => rft. + have [t1 /andP[t1_ge0 t1t] phit1r] : exists2 t0 : K , 0 <= t0 <= t & `|f t0| = r. + have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o f)}. + apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) f (ltW t0)) => //. + by move=> z _; exact: norm_continuous. + have : {in `[0, D[, continuous f}. + move=> t' /[!inE] t'0D. + by apply/differentiable_continuous/derivable1_diffP; apply solf. + move/continuous_in_subspaceT. apply: continuous_subspaceW. by apply: subset_itvl; rewrite bnd_simp. - have : Num.min `|sol 0| `|sol t| <= r <= Num.max `|sol 0| `|sol t|. - by rewrite ge_min phi0r/= le_max (ltW phi_t_r) orbT. + have : Num.min `|f 0| `|f t| <= r <= Num.max `|f 0| `|f t|. + by rewrite ge_min f0r/= le_max (ltW rft) orbT. move=> /(IVT (ltW t0) norm_phi_cont)[c cI norm_phi_c]. - by exists c; split => //; move/itvP: cI => ->. - have alphaVphit1 : alpha <= V (sol t1). + by exists c => //; move/itvP: cI => ->. + have alphaVphit1 : alpha <= V (f t1). rewrite {alpha_gt0 beta_alpha} /alpha; case: alpha_min => /=. by move=> y [_ +]; apply; rewrite inE. - have : beta < V (sol t1). - by rewrite (lt_le_trans _ alphaVphit1)//; case/andP : beta_alpha. + have : beta < V (f t1). + by rewrite (lt_le_trans _ alphaVphit1)//; case/andP: beta_alpha. apply/negP; rewrite -leNgt. move: t1_ge0; rewrite le_eqVlt => /predU1P[<-//|t10]. have := @V_nincr_consequence t1. - rewrite t10 (le_lt_trans t1t tDelta) => /(_ isT). - move=> /(_ t1). - rewrite (ltW t10) lexx => /(_ isT). - have : 'D~(sol) V t1 <= 0. - apply: V'_le0 => //. - exact: solP. - by rewrite t10/= (le_lt_trans _ tDelta). + rewrite t10 (le_lt_trans t1t tD) => /(_ isT). + move=> /(_ t1); rewrite (ltW t10) lexx => /(_ isT). + have : 'D~(f) V t1 <= 0. + apply: (@DV_le0 _ _ _ solf) => //. + by rewrite t10/= (le_lt_trans _ tD). move=> /[swap] /[apply]. by move=> /andP[/le_trans] => /[apply]. have _ : compact Omega_beta. @@ -696,15 +643,15 @@ have _ : compact Omega_beta. exact: differentiable_continuous. have [d0 d0_gt0 Vbeta] : exists2 d, d > 0 & forall x, `|x| <= d -> V x < beta. have [d d_gt0 xdV] : exists2 d : K, 0 < d & - forall y, `|y - x| < d -> `|V y - V x| < beta. - have /cvgrPdist_lt /(_ _ beta_gt0) : V x @[x --> nbhs x] --> V x. + forall y, `|y - 0| < d -> `|V y - V 0| < beta. + have /cvgrPdist_lt /(_ _ beta_gt0) : V x @[x --> nbhs (0 : 'rV_n.+1) ] --> V 0. exact/differentiable_continuous/Vdiff. rewrite nearE /= => /nbhs_ballP[d /= d_pos xdV]. exists d => // y. move: xdV; rewrite mx_norm_ball /ball_ /= distrC => /[apply]. by rewrite distrC. exists (d / 2); first exact: divr_gt0. - move=> v vd; have /(xdV v) : `|v - x| < d. + move=> v vd; have /(xdV v) : `|v - 0| < d. by rewrite subr0 (le_lt_trans vd)// ltr_pdivrMr // ltr_pMr // ltr1n. by rewrite Vx0 subr0; apply: le_lt_trans; rewrite ler_normlW. pose delta := Num.min d0 r. @@ -718,28 +665,172 @@ have B_delta_Omega_beta : B delta `<=` Omega_beta. rewrite /B /closed_ball_/= sub0r normrN => vdelta. split; last exact/ltW/deltaV. by rewrite (le_trans vdelta)// /delta ge_min lexx orbT. -rewrite /x. exists delta => //. -move=> sol Delta' [sol0 solP] sol_delta t0 t0_ge0. +move=> f Delta' [f0 solf] f0xdelta t0 t0_ge0. rewrite subr0. -have : sol 0 \in Omega_beta. +have : f 0 \in Omega_beta. rewrite inE; apply: B_delta_Omega_beta. rewrite /B /closed_ball_/= sub0r normrN; apply/ltW. - by rewrite subr0 in sol_delta. + by rewrite subr0 in f0xdelta. rewrite inE => -[+ _]. rewrite /B /closed_ball_/= sub0r normrN => solx0r. -have : (B r)° (sol t0). +have : (B r)° (f t0). apply: Omega_beta_Br; apply/set_mem. - apply: Df_Omega_beta => //. - exact: solP. + apply: (Df_Omega_beta Delta') => //. rewrite inE; split; first by rewrite /B /closed_ball_/= sub0r normrN. - have : B delta (sol 0). + have : B delta (f 0). rewrite /closed_ball_; apply: ltW; rewrite sub0r normrN. - by rewrite subr0 in sol_delta. + by rewrite subr0 in f0xdelta. by move/B_delta_Omega_beta => []. - assumption. rewrite BE//= interior_closed_ballE//=. rewrite mx_norm_ball /ball_/= sub0r normrN => /lt_le_trans; exact. Unshelve. all: by end_near. Qed. End Lyapunov_stability. + +Section is_equilibrium_point_change_of_variables. +Context {K : realType} {n : nat}. +Let U := 'rV[K]_n.+1. +Variable phi : U -> U. +Variable Init : set U. + +Lemma is_sol_on0o_substitution Delta f x : + is_sol_on0o phi (BLeft Delta) f -> + is_sol_on0o (fun y : 'rV_n.+1 => phi (y + x)) + (BLeft Delta) (f \- cst x). +Proof. +rewrite /is_sol_on0o => /= H t t0Delta; split. + apply: derivableB => //. + by apply H. +rewrite subrK. +rewrite derive1E deriveB//; last first. + by apply H. +by rewrite derive_cst subr0 -derive1E; apply H. +Qed. + +Lemma is_locally_stable_at_substitution x : + is_locally_stable_at (fun y => phi (y + x)) [set y - x | y in Init] 0 -> + is_locally_stable_at phi Init x. +Proof. +move=> H. +rewrite /is_locally_stable_at => /= e e0. +have [/= d d0 {}H] := H _ e0. +exists d => // f Delta [f0Init solf] f0xd t t0. +rewrite -[_ - _]subr0. +rewrite -[f t - x]/((f \- cst x) t). +apply: (H _ Delta) => //; last first. + by rewrite /= subr0. +split. + exact/image_f. +exact: is_sol_on0o_substitution. +Qed. + +Lemma is_equilibrium_point_substitutionP x : + is_equilibrium_point (fun y => phi (y + x)) [set y - x | y in Init] 0 <-> + is_equilibrium_point phi Init x. +Proof. +split. +- move=> [u0Init issol]; split. + move: u0Init; rewrite !inE/= => -[v Initv]. + by move/subr0_eq => <-. + move=> Delta /= t t0Delta. + have [Hderivable Hderiv] := issol Delta _ t0Delta. + split. + exact: derivable_cst. + rewrite add0r in Hderiv. + by rewrite -Hderiv !derive1_cst. +- move=> [u0Init issol]; split. + move: u0Init; rewrite !inE/= => xInit. + exists x => //. + by rewrite subrr. + move=> Delta /= t t0Delta. + have [Hderivable Hderiv] := issol Delta _ t0Delta. + split. + exact: derivable_cst. + rewrite add0r. + by rewrite -Hderiv !derive1_cst. +Qed. + +Lemma is_Lyapunov_candidate_substitution V x : + is_Lyapunov_candidate V Init x -> + is_Lyapunov_candidate (fun y => V (y + x)) [set y - x | y in Init] 0. +Proof. +move=> [xInit [Vx0/= InitV]]. +split. + rewrite inE/=. + exists x; rewrite ?subrr//. + by rewrite inE in xInit. +split. + by rewrite add0r. +rewrite /=. +move=> z. +rewrite inE/= => -[x0 x0Init <-{z}]. +rewrite subr_eq0 => x0x. +apply: InitV => //. + by rewrite subrK inE. +by rewrite subrK. +Qed. + +End is_equilibrium_point_change_of_variables. + +Section Lyapunov_stability. +Context {K : realType} {n : nat}. +Let U := 'rV[K]_n.+1. +Variable phi : U -> U. +Variable Init : set U. +Hypothesis openInit : open Init. (* Init est forcement un ouvert *) + +Variable V : U -> K. +Hypothesis Vdiff : forall t : U, differentiable V t. +Hypothesis V'_le0 : forall Delta (sol : K -> U), + is_sol_on0o phi (BLeft Delta) sol -> + forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. + +Theorem Lyapunov_stability : + is_Lyapunov_candidate V Init `<=` is_locally_stable_at phi Init. +Proof. +move=> x VInitx. +apply: is_locally_stable_at_substitution. +apply: (@Lyapunov_stability0 _ _ _ _ _ (fun y => V (y + x))). +- rewrite [X in open X](_ : _ = (fun y => y + x) @^-1` Init); last first. + apply/seteqP; split. + by move=> /= z [v vInit <-]; rewrite subrK. + by move=> /= z zxInit; exists (z + x) => //; rewrite addrK. + apply: open_comp => // z _. + rewrite /continuous_at. + apply: (@cvgD _ 'rV_n.+1) => //=. + by apply: filter_filter; exact: mx_nbhs_filter. (* TODO: should be automatic! *) + by apply: cvg_cst; apply: filter_filter; exact: mx_nbhs_filter. +- by move=> t; exact: differentiable_comp. +- move=> /= Delta sol sol0 sol0Init /= t t0Delta. + rewrite [leLHS](_ : _ = ('D~((fun y => y + x) \o sol) V) t); last first. + rewrite derive_along_derive; last 2 first. + exact: differentiable_comp. + apply/derivable1_diffP. + apply sol0Init. + rewrite in_itv/=. + by move/andP : t0Delta => [/ltW-> ->]. + have -> : (fun y : 'rV_n.+1 => V (y + x)) \o sol = [eta V] \o (+%R^~ (x) \o sol). + exact/funext. + rewrite derive_along_derive; last 2 first. + exact: differentiable_comp. + apply: differentiable_comp => //. + apply/derivable1_diffP. + apply sol0Init. + rewrite in_itv/=. + by move/andP : t0Delta => [/ltW-> ->]. + by []. + apply: (@V'_le0 Delta); last by assumption. + move=> /= z z0Delta. + split. + apply/derivable1_diffP. + apply: differentiable_comp => //. + apply/derivable1_diffP. + by apply sol0Init. + rewrite derive1E deriveD//; last by apply sol0Init. + rewrite derive_cst addr0 -derive1E. + by apply sol0Init. +exact: is_Lyapunov_candidate_substitution. +Qed. + +End Lyapunov_stability. From 335bc4018452755cc5e2cc8e8c2ae8a84e1dec81 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 17 Feb 2026 09:54:46 +0900 Subject: [PATCH 117/144] wip (global) --- ode_wip.v | 473 ++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 315 insertions(+), 158 deletions(-) diff --git a/ode_wip.v b/ode_wip.v index 5da5e90a..65a41123 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -94,6 +94,14 @@ Qed. End cauchy_lipschitzT. +Lemma min2r (T : realDomainType) (a b c : T) : a <= c -> + (Num.min a b <= Num.min c b). +Proof. +rewrite /minr; have [ab|ba] := ltP a b; have [cb|bc] := ltP c b => //. +- by move=> _; exact: ltW. +- by move=> /le_lt_trans => /(_ _ cb); rewrite ltNge ba. +Qed. + Section itv_partition_lemmas. Context {R : realType}. Variables a b : R. @@ -260,8 +268,127 @@ Qed. End itv_partition_lemmas. +Section itv_partition_porder. +Context {d} {T : porderType d}. +Implicit Types (a b x : T) (s : seq T). + +Let itv_partition_in_itv a b s : + itv_partition a b s -> {in s, forall x, x \in `]a, b]%R}. +Proof. +move=> /[dup]parts. +move=> [/[dup]/lt_path_min/allP sa]. +move=> /[dup]pas. +rewrite lt_path_pairwise. +move/pairwiseP => pwltas. +move/eqP => lsb. +move=> x xs. +rewrite in_itv/=; apply/andP; split; first exact: sa. +rewrite -lsb (last_nth a). +have xas : x \in a :: s by rewrite in_cons; apply/orP; right. +rewrite -(nth_index a xas). +rewrite le_eqVlt; apply/predU1P. +rewrite -implyNp => nlast. +apply: pwltas. +- rewrite inE/=. + case: ifP => // _. + by rewrite ltnS index_mem. +- by rewrite inE//. +- rewrite /=. + move: s lsb parts sa pas x nlast xs xas. + apply: last_ind => // s t IH. + rewrite last_rcons => ->. + move=> patsb asb psb x/[swap] xsb. + rewrite nth_index; last first. + by rewrite in_cons; apply/orP; right. + move/[swap] => _. + rewrite -last_nth last_rcons => xb. + rewrite ifN; last first. + by rewrite lt_eqF// asb. + rewrite (_ : index x (rcons s b) = index x s); last first. + rewrite -cats1 index_cat. + rewrite ifT//. + move: xsb. + by rewrite mem_rcons in_cons => /predU1P; case. + rewrite size_rcons ltnS. + rewrite index_mem. + move: xsb. + rewrite mem_rcons in_cons. + by move/predU1P; case. +Qed. + +Lemma itv_partition_gt_lb a b s : (a < b)%O -> + itv_partition a b s -> forall n, (a < nth b s n)%O. +Proof. +move=> ab ps n. +have [ns|ns] := ltnP n (size s). + suff : nth b s n \in `]a, b]%R. + by rewrite in_itv/= => /andP[]. + apply: (itv_partition_in_itv ps). + exact: mem_nth. +by rewrite nth_default. +Qed. + +Lemma itv_partition_le_ub a b s : + itv_partition a b s -> forall n, (nth b s n <= b)%O. +Proof. +move=> ps n. +have [ns|ns] := ltnP n (size s). + suff : nth b s n \in `]a, b]%R. + by rewrite in_itv/= => /andP[]. + apply: (itv_partition_in_itv ps). + exact: mem_nth. +by rewrite nth_default. +Qed. + +Lemma itv_partition_head_in_itv a b s t : + itv_partition a b (rcons s t) -> {in s, forall x, x \in `]a, b[%R}. +Proof. +move=> pst x xs. +have in_ab := itv_partition_in_itv pst. +rewrite in_itv/=; apply/andP; split. + have := in_ab x. + rewrite mem_rcons in_cons. + have H : (x == t) || (x \in s) by apply/orP; right. + by move/(_ H); rewrite in_itv/= => /andP[ax xb]. +have [] := pst. +rewrite lt_path_pairwise. +move/pairwiseP => lt_ast. +move/eqP <-; rewrite (last_nth a). +have : x \in a :: (rcons s t). + rewrite in_cons; apply/orP; right. + by rewrite mem_rcons in_cons xs orbT. +move/(nth_index a) <-. +apply: lt_ast; last 2 first. +- by rewrite inE. +- rewrite /=. + rewrite ifF; last first. + rewrite lt_eqF => //. + have [/lt_path_min/allP + _] := pst. + by apply; rewrite mem_rcons in_cons xs orbT. + by rewrite size_rcons -cats1 index_cat xs ltnS index_mem. +rewrite inE index_mem. +rewrite in_cons; apply/orP; right. +by rewrite mem_rcons in_cons xs orbT. +Qed. + +Lemma itv_partition_lt_ub a b s : + itv_partition a b s -> forall n, (n.+1 < size s)%N -> (nth b s n < b)%O. +Proof. +elim/last_ind : s => // s0 s1 _ ps n. +rewrite size_rcons ltnS => ns0. +pose s := rcons s0 s1. +rewrite -/s. +suff : nth b s n \in `]a, b[%R. + by rewrite in_itv/= => /andP[]. +apply: (@itv_partition_head_in_itv _ _ s0 s1) => //. +apply/(nthP b). +exists n => //. +by rewrite nth_rcons ns0. +Qed. + +End itv_partition_porder. + (* Theorem 3.2: global existence and uniqueness *) -(* what happens when globally lipschitz? *) Section cauchy_lipschitz_global. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -271,6 +398,17 @@ Hypothesis k0 : 0 < k. Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_[set: 'rV[R]_n] (phi x)}. Hypothesis cont1 : {in [set: 'rV[R]_n], forall y, {within `[a, b], continuous phi ^~ y}}. +Let elt_prop (f : (R -> U) * (R * R) * nat) := True. + +Let elt_type := {f : (R -> U) * (R * R) * nat | elt_prop f}. + +Let f_ (x : elt_type) := (proj1_sig x).1.1. +Let a_ (x : elt_type) := (proj1_sig x).1.2.1. +Let b_ (x : elt_type) := (proj1_sig x).1.2.2. +Let i_ (x : elt_type) := (proj1_sig x).2. + +Let elt_rel i j := f_ j (a_ j) = f_ i (b_ i). + Theorem cauchy_lipschitz_global : exists f : R -> 'rV_n (*: continuousFunType `[a, b] [set: 'rV[R]_n]*), is_sol_on phi u0 a (BLeft b) f. Proof. @@ -279,21 +417,30 @@ have rho'_gt0 : 0 < rho' by []. have rho'_lt1 : rho' < 1 by []. pose rho := PosNum rho'_gt0. have rho1 : rho%:num < 1 by []. +have r_gt0 init a' b' : 0 < (rho%:num * sup_phi phi a' b' init / ((1 - rho%:num) * k)) + 1. + rewrite ltr_wpDl// mulr_ge0 ?invr_ge0// mulr_ge0// ?subr_ge0. + exact: sup_phi_ge0. + exact: ltW. + exact: ltW. have [barhok|barhok] := leP (b - a) (rho%:num / k). - have @r : {posnum R}. - admit. (* can be chosen arbitrary large because the Lipschitz condition holds globally *) - have Hr h : 0 <= h -> r%:num / (k * r%:num + h) > rho%:num / k. - move=> h0. - rewrite ltr_pdivlMr; last by rewrite ltr_wpDr// mulr_gt0. + pose h := sup [set `|phi t u0| | t in `[a, b]]. + have {}r_gt0 : 0 < (rho%:num * h / ((1 - rho%:num) * k)) + 1. + by rewrite r_gt0// sup_phi_ge0. + pose r := PosNum r_gt0. + have Hr : r%:num / (k * r%:num + h) > rho%:num / k. + rewrite ltr_pdivlMr; last first. + rewrite ltr_wpDr//. + exact: sup_phi_ge0. + by rewrite mulr_gt0. rewrite mulrAC -ltr_pdivlMr ?invr_gt0// invrK. rewrite mulrDr -ltrBrDl -[X in _ < X - _]mul1r (mulrC k). rewrite -mulrBl mulrCA -ltr_pdivrMr; last by rewrite mulr_gt0// subr_gt0. - admit. (* for any finite sup_phi, we can choose r large enough so that this holds *) - have safe_distba : safe_dist phi a b k u0 r rho = b - a. + by rewrite /= ltrDl. + have safe_distba : safe_dist phi a b k u0 (PosNum r_gt0) rho = b - a. rewrite /safe_dist; apply/min_idPl. - rewrite (le_trans barhok)// le_min lexx andbT -/sup_phi ltW//. - apply: Hr. - exact: sup_phi_ge0. + rewrite le_min barhok andbT. + rewrite (le_trans barhok)//. + exact: ltW. exists (@lipschitzT_solution_f R n phi a b k u0 r rho rho1 ab k0 lip2 cont1). have [d0 [[fau0 H1] H2 H3]] := @lipschitzT_cauchy_lipschitz_local R n phi a b k u0 r rho rho1 ab k0 lip2 cont1. @@ -307,172 +454,182 @@ have [barhok|barhok] := leP (b - a) (rho%:num / k). rewrite closure_neitv_oo ?ltDl_safe_dist//. apply: subset_itvl; rewrite bnd_simp -lerBlDl. by rewrite safe_distba. -have @r : {posnum R}. +have [delta /andP[delta_gt0 delta_rhok]] : exists delta, 0 < delta <= rho%:num / k. admit. -have Hr : rho%:num / k < r%:num / ((k * r%:num)%R + sup_phi phi a b u0)%E. - admit. -pose delta : R := safe_dist phi a b k u0 r rho. -have Hsafe_dist : delta = rho%:num / k. - rewrite /delta /safe_dist minA; apply/min_idPr. - by rewrite le_min (ltW Hr) andbT ltW. -have delta0 : 0 < delta by rewrite /delta safe_dist_gt0. have [delta' [s [/andP[delta'0 delta'delta] [abs nthdelta']]]] : exists (delta' : R) s, 0 < delta' < delta /\ itv_partition a b s /\ forall i, (i < size s)%N -> nth b (a :: s) i.+1 - nth b (a :: s) i < delta. exact: itv_partition_lt. +have sizes_gt0 : (0 < size s)%N. + move: abs. + destruct s => //. + case => /= _ /eqP ?; subst b. + move: ab. + by rewrite ltxx. have Ilt i : (i < size s)%N -> nth b (a :: s) i < nth b (a :: s) i.+1. move=> si; case: abs => sa /eqP asb. by move/(pathP b) : sa; apply. pose I i := `[nth b (a :: s) i, nth b (a :: s) i.+1]%R. -have Iiab i : (i <= size s)%N -> [set` I i] `<=` `[a, b]. - move=> si x/=. - rewrite !in_itv/= => /andP[ix xi]; apply/andP. - destruct i as [|i] => //. - rewrite ix; split => //. +have Iiab i : [set` I i] `<=` `[a, b]. + have [si|si] := leqP i (size s). + move=> x/=. + rewrite !in_itv/= => /andP[ix xi]; apply/andP. + destruct i as [|i] => //. + rewrite ix; split => //. + rewrite (le_trans xi)//. + destruct s as [|s0 s1] => //=. + case: abs => /= /andP[as0]. + move/order_path_min => /(_ lt_trans)/allP H /eqP s0s1b. + destruct s1 as [|s1 s2]. + by rewrite /= in s0s1b; rewrite s0s1b. + by apply/ltW/H; rewrite -s0s1b /= mem_last. + split. + rewrite (le_trans _ ix)// ltW//. + case: abs => /order_path_min => /(_ lt_trans)/allP + _. + apply. + by apply/(nthP b); exists i. rewrite (le_trans xi)//. - destruct s as [|s0 s1] => //=. - case: abs => /= /andP[as0]. - move/order_path_min => /(_ lt_trans)/allP H /eqP s0s1b. - destruct s1 as [|s1 s2]. - by rewrite /= in s0s1b; rewrite s0s1b. - by apply/ltW/H; rewrite -s0s1b /= mem_last. - split. - rewrite (le_trans _ ix)// ltW//. - case: abs => /order_path_min => /(_ lt_trans)/allP + _. - apply. - by apply/(nthP b); exists i. - rewrite (le_trans xi)//. - case: abs => sa /eqP asb. - move: si; rewrite leq_eqVlt => /predU1P[->|si]. - by rewrite nth_default. - rewrite -{2} asb (last_nth b) -(@prednK (size s)); last by rewrite (leq_trans _ si). - apply: sorted_leq_nth => //. - - exact: le_trans. - - apply: path_sorted. - apply: sub_path sa. - by move=> ? ? /ltW. - - by rewrite inE prednK// (leq_trans _ si). - - by rewrite -(ltn_add2r 1) !addn1 (leq_trans si)// prednK// (leq_trans _ si). -suff: forall i, (i < size s)%N -> - exists f : R -> 'rV_n, is_sol_on phi u0 (nth b (a :: s) i) (BLeft (nth b (a :: s) i.+1)) f. - move=> suf. - have pickup_itv (x : R) : x \in `[a, b] -> exists2 i : nat, (i < size s)%N & x \in I i. - move=> xab; apply: itv_partition_ex => //. - by move: xab; rewrite inE/= in_itv/=. - pose pickup_itv_fun (x : R) : nat := - match pselect (x \in `[a, b]) with - | left H => sval (cid2 (pickup_itv x H)) - | right _ => 0 - end. - have lip2'' (i : nat) : (i <= size s)%N -> - {in I i, forall x : R, k.-lipschitz (phi x)}. - move=> im. - apply/in_switch/(@lipschitzW _ _ _ _ _ `[a, b]). - exact: Iiab. - apply/in_switch => t tab [X Y] [/= u0rX u0rY]. - have /(_ (X, Y)) := lip2 tab. - exact. - have cont1'' (i : nat) : (i <= size s)%N -> - {in [set: 'rV_n], forall y : 'rV_n, {within [set` I i], continuous phi^~ y}}. - move=> si /= t tu0r. - apply: (@continuous_subspaceW _ _ _ `[a, b]); last exact: cont1. + case: abs => sa /eqP asb. + move: si; rewrite leq_eqVlt => /predU1P[->|si]. + by rewrite nth_default. + rewrite -{2} asb (last_nth b) -(@prednK (size s)); last by rewrite (leq_trans _ si). + apply: sorted_leq_nth => //. + - exact: le_trans. + - apply: path_sorted. + apply: sub_path sa. + by move=> ? ? /ltW. + - by rewrite inE prednK// (leq_trans _ si). + - by rewrite -(ltn_add2r 1) !addn1 (leq_trans si)// prednK// (leq_trans _ si). + have -> : [set` I i] = [set b]. + apply/seteqP; split => [x/=|]. + rewrite in_itv/=. + rewrite nth_default/=//. + rewrite nth_default; last exact: ltnW. + by rewrite -eq_le => /eqP. + move=> _ /= ->. + rewrite in_itv/=. + rewrite nth_default/=//. + rewrite nth_default; last exact: ltnW. + by rewrite !lexx. + move=> x/= ->. + by rewrite bound_itvE ltW. +have pickup_itv (x : R) : x \in `[a, b] -> exists2 i : nat, (i < size s)%N & x \in I i. + move=> xab; apply: itv_partition_ex => //. + by move: xab; rewrite inE/= in_itv. +have lip2'' (i : nat) : (i <= size s)%N -> {in I i, forall x : R, k.-lipschitz (phi x)}. + move=> im. + apply/in_switch/(@lipschitzW _ _ _ _ _ `[a, b]). exact: Iiab. - pose F (x : R) : 'rV_n := + apply/in_switch => t tab [X Y] [/= u0rX u0rY]. + have /(_ (X, Y)) := lip2 tab. + exact. +have cont1'' (i : nat) : (i <= size s)%N -> + {in [set: 'rV_n], forall y : 'rV_n, {within [set` I i], continuous phi^~ y}}. + move=> si /= t tu0r. + apply: (@continuous_subspaceW _ _ _ `[a, b]); last exact: cont1. + exact: Iiab. +pose h0 := sup_phi phi a (nth b (a :: s) 1). +pose f_0 : R -> U := + @lipschitzT_solution_f R n phi a (nth b (a :: s) 1) k u0 + (PosNum (r_gt0 u0 a (nth b (a :: s) 1))) rho rho1 + (Ilt _ sizes_gt0) k0 (lip2'' _ (ltnW sizes_gt0)) (cont1'' _ (ltnW sizes_gt0)). +have [v [v0 Pv]] : {v : nat -> elt_type | + v 0%N = exist _ (f_0, (a, nth b (a :: s) 1), O) Logic.I /\ + forall n, elt_rel (v n) (v n.+1)}. + apply: dependent_choice => -[[[f [a' b']] i']] []. + pose init0 : U := f b'. + pose a'' := nth b (a :: s) i'.+1. + have [i's|i's] := ltnP (i'.+1) (size s)%N. + pose b'' := nth b (a :: s) i'.+2. + pose f_i : R -> U := + @lipschitzT_solution_f R n phi a'' b'' k init0 + (PosNum (r_gt0 init0 a'' b'')) + rho rho1 (Ilt _ i's) k0 (lip2'' _ (ltnW i's)) (cont1'' _ (ltnW i's)). + exists (exist _ (f_i, (a'', b''), i'.+1) Logic.I). + rewrite /elt_rel. + rewrite /f_/=. + have [/=] := lipschitzT_solution init0 (PosNum (r_gt0 init0 a'' b'')) rho1 + (Ilt i'.+1 i's) k0 (lip2'' i'.+1 (ltnW i's)) (cont1'' i'.+1 (ltnW i's)). + move=> + _ _. + rewrite -/f_i. + rewrite /init0. + rewrite /a_/=. + rewrite /b_/= => <-. + by rewrite /a''/=. + apply/cid. + move: i's; rewrite leq_eqVlt => /predU1P[i's|i's]. + have a''E : a'' = last b s. + rewrite /a'' -i's. + rewrite -last_nth//. + rewrite -!nth_last. + apply: set_nth_default. + by rewrite prednK. + case: abs => _ /eqP asb. + have {}a''E : a'' = b. + rewrite a''E. + rewrite -nth_last -[RHS]asb -nth_last. + apply: set_nth_default. + by rewrite prednK. + exists (exist _ ((cst (f b')), (b, b), i'.+1) Logic.I). + rewrite /elt_rel/=. + rewrite /f_/=. + by rewrite /a_ /b_ /=. + have a''E : a'' = last b s. + rewrite /a'' /= nth_default//. + case: abs => _ /eqP asb. + rewrite -[LHS]asb -!nth_last. + apply: set_nth_default. + by rewrite prednK. + exists (exist _ ((cst (f b')), (b, b), i'.+1) Logic.I). + rewrite /elt_rel/=. + rewrite /f_/=. + by rewrite /a_ /b_ /=. +pose pickup_itv_fun (x : R) : nat := + match pselect (x \in `[a, b]) with + | left H => sval (cid2 (pickup_itv x H)) + | right _ => 0 + end. +exists (fun x => match pselect (x \in `[a, b]) with | left H => let i := sval (cid2 (pickup_itv x H)) in let im : (i < size s)%N := (svalP (cid2 (pickup_itv x H))).1 in let xIi : x \in I i := (svalP (cid2 (pickup_itv x H))).2 in - (@lipschitzT_solution_f R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) k u0 r - rho rho1 (Ilt _ im) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im))) x + f_ (v i) x | right _ => \row_(i < n) 0 - end. - exists F; split. - rewrite /F; case: pselect; last first. - by rewrite inE/= in_itv/= lexx (ltW ab). - move=> aab. - case: cid2 => /= x xs aIx. - set K1 := Ilt _ _. - set K2 := lip2'' _ _. - set K3 := cont1'' _ _. - have [d0 [[H1 fiu0] _ _]] := - @lipschitzT_cauchy_lipschitz_local R n phi (nth b (a :: s) x) (nth b (a :: s) x.+1) k u0 r - rho rho1 K1 k0 (lip2'' _ (ltnW xs)) (cont1'' _ (ltnW xs)). - rewrite -[RHS]H1. - have <- : K2 = lip2'' x (ltnW xs) by apply: Prop_irrelevance. - have <- : K3 = (cont1'' x (ltnW xs)) by apply: Prop_irrelevance. - have x0 : x = 0. - admit. - by subst x. - move=> t tab. - have [i im tIi] : exists2 i : nat, (i < size s)%N & t \in I i. - apply: itv_partition_ex => //. - by move: tab; rewrite inE/= in_itv/= => /andP[] /ltW -> /ltW ->. - split. - move: tIi; rewrite /I in_itv/= => /andP[it ti]. - pose f := @lipschitzT_solution_f R n phi - (nth b (a :: s) i) (nth b (a :: s) i.+1) k u0 r rho rho1 (Ilt _ im) k0 - (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)). - suff : derivable f t 1. - admit. - have [d0 [[fau0 H1] _ _]] := - @lipschitzT_cauchy_lipschitz_local R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) - k u0 r rho rho1 (Ilt _ im) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)). - rewrite /= in H1. - apply H1. - rewrite inE/= in_itv/=. - apply/andP; split. - admit. - rewrite (le_lt_trans ti)//. - rewrite -[ltLHS]/(nth b (a :: s) i.+1). - have : safe_dist phi (nth b (a :: s) i) (nth b s i)%E k u0 r rho = delta. - rewrite Hsafe_dist. - rewrite /safe_dist. - rewrite minA. - apply/min_idPr. - rewrite le_min. - apply/andP; split. - rewrite -Hsafe_dist. - admit. (* pbm: rho must be defined after s!*) - rewrite (le_trans (ltW Hr))//. - rewrite ler_wpM2l//. - rewrite lef_pV2 ?posrE; last 2 first. - admit. - admit. - rewrite lerD2l. - apply: sup_phiS. - apply: cont1. - by rewrite inE. - exact: ltW. - apply: subset_itv; rewrite bnd_simp. - admit. - admit. - move=> ->. + end). +split. +- case: pselect; last first. + by rewrite inE/= bound_itvE (ltW ab). + move=> ?. + rewrite /=. + case: cid2 => // i/= si aIi. + rewrite /f_/=. + have i0 : i = 0. + apply/eqP/negPn. + rewrite -lt0n; apply/negP => i0. + move: aIi. + rewrite in_itv/= => /andP[ia ai]. + move: ia. + rewrite leNgt => /negP; apply. + destruct i as [|i] => //=. + apply: itv_partition_gt_lb. + done. + done. + rewrite i0 v0/=. + have := lipschitzT_solution u0 (PosNum (r_gt0 u0 a (nth b (a :: s) 1))) rho1 + (Ilt 0%N sizes_gt0) k0 (lip2'' 0%N (ltnW sizes_gt0)) (cont1'' 0%N (ltnW sizes_gt0)). + by case => //. +- move=> t tab; split. admit. admit. -admit. -move=> i im. -have Ilti1 : nth b (a :: s) i < nth b (a :: s) i.+1. - by apply: Ilt. -have lip2'' (j : nat) : (j <= size s)%N -> - {in I j, forall x : R, k.-lipschitz_(closed_ball u0 r%:num) (phi x)}. - admit. -have cont1'' (j : nat) : (j <= size s)%N -> - {in closed_ball u0 r%:num, forall y : 'rV_n, {within [set` I j], continuous phi^~ y}}. - admit. -exists (@cauchy_lipschitz_local_f R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) - k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)) rho rho1). -have [d0 [[fau0 H1] H2 H3]] := - @cauchy_lipschitz_local R n phi (nth b (a :: s) i) (nth b (a :: s) i.+1) - k u0 r (Ilti1) k0 (lip2'' _ (ltnW im)) (cont1'' _ (ltnW im)) rho rho1. -split => // t tab. -apply H1. -apply/mem_set. -move/set_mem : tab. -apply: subset_itvl. -rewrite bnd_simp. -rewrite -lerBlDl. -admit. +- rewrite closure_neitv_oo//. + apply/(continuous_within_itvP _ ab); split. + + move=> t tab. + rewrite /continuous_at. + admit. + + admit. + + admit. Abort. End cauchy_lipschitz_global. From bf796fbedd290c97d579e1370635828a099c37db Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 17 Feb 2026 18:16:37 +0900 Subject: [PATCH 118/144] is_sol renaming --- ode.v | 220 +++++++++++++++++++++++++---------------------- ode_autonomous.v | 88 +++++++++---------- ode_common.v | 19 ++-- ode_contfun.v | 64 +++++++------- ode_wip.v | 49 +++++++++-- tilt_lasalle.v | 42 ++++----- tilt_lyapunov.v | 184 +++++++++++++++++++-------------------- tilt_robot.v | 1 - tilt_stability.v | 85 +++++++++--------- 9 files changed, 390 insertions(+), 362 deletions(-) diff --git a/ode.v b/ode.v index 83968993..6866144a 100644 --- a/ode.v +++ b/ode.v @@ -189,6 +189,7 @@ Let mu := @lebesgue_measure R. Lemma rowRintegral_set1 n (f : R -> 'rV[R]_n) (r : R) : \vint[mu]_(x in [set r]) f x = 0. Proof. by apply/rowP => i; rewrite !mxE Rintegral_set1. Qed. + Lemma eq_rowRintegral n (D : set R) (f : R -> 'rV[R]_n) (g : R -> 'rV[R]_n): {in D, f =1 g} -> \vint[mu]_(x in D) f x = \vint[mu]_(x in D) g x. Proof. @@ -646,8 +647,7 @@ apply: eq_set => /= f; apply propext; split => h. move /(_ (f x)) : h. rewrite closed_ballE//. apply. - exists x => //. - by rewrite inE in adx. + by exists x. - move => _ [x xad] <-. rewrite closed_ballE// /closed_ball_ /=. have -> : u0 - f x = ((pi V (cst u0)) - f : V) x. @@ -657,7 +657,6 @@ apply: eq_set => /= f; apply propext; split => h. rewrite -(@reprK _ V f). rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. rewrite eval_mod_on_itv; last by rewrite inE. - rewrite -inE in xad. apply: (le_trans (infty_norm0_ge (leDl_safe_dist phi ab u0 r k0 rho) _ xad)). rewrite -infty_norm_pi. by rewrite Quotient.pi_add Quotient.pi_opp reprK. @@ -1307,8 +1306,7 @@ rewrite (@le_trans _ _ (k * \int[mu]_(t0 in `[a, t]) `|x - y| ))//. by rewrite -EFinD ltry. exact: bounded_cst. move=> x0 x0at. - have x0ad : x0 \in `[a, a + safe_dist]. - rewrite inE/=. + have x0ad : x0 \in `[a, a + safe_dist]%R. apply: subset_itvl x0at; rewrite bnd_simp. by move: tNdd; rewrite in_itv/= => /andP[]. have -> : x x0 - y x0 = (x - y : V) x0. @@ -1340,16 +1338,27 @@ HB.instance Definition _ {R : realType} (n : nat) := NormedModule.on (@row_vecto Section is_sol. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (u0 : U) (a : R) (b : itv_bound R) (sol : R -> U). +Variable (phi : R -> U -> U). + +Definition sol_is_deriv_cbnd (a : R) (b : itv_bound R) (f : R -> U) := + {in Interval (BLeft a) b, forall t, derivable f t 1 /\ f^`() t = phi t (f t)}. + +Definition sol_is_deriv_co a b := sol_is_deriv_cbnd a (BLeft b). + +Definition sol_is_deriv_obnd (a : R) (b : itv_bound R) (f : R -> U) := + {in Interval (BRight a) b, forall t, derivable f t 1 /\ f^`() t = phi t (f t)}. + +Definition sol_is_deriv_oo a b := sol_is_deriv_obnd a (BLeft b). (*NB: b = (BLeft r) is open, b = (BRight r) is closed, b = +oo%R is +oo *) -Definition is_sol_on := - [/\ sol a = u0, - {in [set` Interval (BRight a)(*open*) b], - forall x, derivable sol x 1 /\ sol^`() x = phi x (sol x)} & - {within (closure [set` Interval (BRight a) b]), continuous sol}]. +Definition is_sol_obnd (u0 : U) (a : R) (b : itv_bound R) (f : R -> U) := + [/\ f a = u0, + sol_is_deriv_obnd a b f & + {within (closure [set` Interval (BRight a) b]), continuous f}]. + +Definition is_sol_oo u0 a b := is_sol_obnd u0 a (BLeft b). End is_sol. @@ -1359,8 +1368,8 @@ Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. Variables (phi : R -> U -> U) (u0 : U) (a b : R) (sol : R -> U). -Definition is_integral_sol_on := sol a = u0 /\ - forall t, t \in `[a, b] -> sol t = sol a + (\vint[mu]_(s in `[a, t]) phi s (sol s))%R. +Definition is_integral_sol := sol a = u0 /\ + forall t, t \in `[a, b]%R -> sol t = sol a + (\vint[mu]_(s in `[a, t]) phi s (sol s))%R. End is_integral_sol. @@ -1386,10 +1395,10 @@ apply/within_continuous_coord. exact: (@within_continuous_lipschitz _ _ _ a b u0 r _ _ _ k0). Qed. -Lemma picard_iterator_continuous i t : t \in `]a, b[ -> +Lemma picard_iterator_continuous i t : t \in `]a, b[%R -> {for t, continuous (fun x => phi x (sol x) ord0 i)}. Proof. -rewrite inE => /within_continuous_continuous; apply => //. +move/within_continuous_continuous; apply => //. exact: picard_iterator_within_continuous. Qed. @@ -1400,7 +1409,8 @@ apply: continuous_compact_integrable; first exact: segment_compact. exact: picard_iterator_within_continuous. Qed. -Lemma integral_sol_iff_sol : is_integral_sol_on phi u0 a b sol <-> is_sol_on phi u0 a (BLeft b) sol. +Lemma integral_sol_iff_sol : + is_integral_sol phi u0 a b sol <-> is_sol_oo phi u0 a b sol. Proof. split. - move => [hinit h]. @@ -1408,7 +1418,7 @@ split. apply: continuous_subspaceW cont_sol. exact: itv_closure (* TODO: why not equality? *). move=> t tab. - move: (tab); rewrite inE /= in_itv /= => /andP[ta tb]. + move: (tab); rewrite in_itv /= => /andP[ta tb]. have -> : sol^`() t = (fun x => sol a + \vint[mu]_(s in `[a, x]) phi s (sol s))^`() t. apply/eq_on_itv_deriv/tab => x xt01; apply h. rewrite inE/= in xt01. @@ -1442,13 +1452,13 @@ split. apply: (near_eq_derivable (f := (fun x => (sol a + \vint[mu]_(s in `[a, x]) phi s (sol s)) ord0 j))) => //=. near=> t'. - rewrite (h t') //= inE/= in_itv/=. + rewrite (h t')//= in_itv/=. apply/andP; split. - by apply: ltW; near: t'; exact: lt_nbhsr. - by apply: ltW; near: t'; exact: lt_nbhsl. have -> : (fun x => (sol a + \vint[mu]_(s in `[a, x]) phi s (sol s))%E ord0 j) = cst (sol a ord0 j) + - (fun x => (\vint[mu]_(s in `[a, x]) (phi s (sol s))) ord0 j). + (fun x => (\vint[mu]_(s in `[a, x]) (phi s (sol s))) ord0 j). by apply funext => x; rewrite mxE. apply: derivableD. exact: derivable_cst. @@ -1457,7 +1467,7 @@ split. congr ('D_1 _ t). by apply/funext => t'; rewrite mxE. move => [hinit h]; split => // t tab. -have /= := tab; rewrite inE/= in_itv/= => /andP[ta tb]. +have /= := tab; rewrite in_itv/= => /andP[ta tb]. apply/rowP => i. rewrite mxE rowRintegralE. move: ta; rewrite le_eqVlt => /predU1P[<-|ta]. @@ -1471,14 +1481,14 @@ rewrite (@continuous_FTC2 _ (fun x => phi x (sol x) ord0 i) (fun x => sol x ord0 exact: subset_itvl. - split. + move=> t' tx'. - by have /h[/derivable_mxP] : t' \in `]a, b[ by rewrite inE; exact/subset_itvl/tx'. + by have /h[/derivable_mxP] : t' \in `]a, b[%R by exact/subset_itvl/tx'. + by move /(continuous_within_itvP _ ab) : cont_soli => [_ + _]. + have cont_phii' : {within `[a, t], continuous fun x0 : R => sol x0 ord0 i}. apply: continuous_subspaceW; last exact: cont_soli. exact: subset_itvl. by move/(continuous_within_itvP _ ta) : cont_phii' => [_ _ +]. - move=> x xt. - have /h[? +] : x \in `]a, b[ by rewrite inE; exact/subset_itvl/xt. + have /h[? +] : x \in `]a, b[%R by exact/subset_itvl/xt. by rewrite !derive1E derive_mx//= => <-; rewrite mxE. Unshelve. all: by end_near. Qed. @@ -1537,27 +1547,27 @@ Lemma picard_fix_init : picard_fix a = u0. Proof. rewrite picard_fixE eval_mod_on_itv. by rewrite /picard_fun /= picard_fun_init//; exact: img_cball_picard_fix. -by rewrite inE/= in_itv/= lexx leDl_safe_dist. +by rewrite in_itv/= lexx leDl_safe_dist. Qed. -Lemma picardE g t : img_cball g -> t \in `[a, a + safe_dist] -> +Lemma picardE g t : img_cball g -> t \in `[a, a + safe_dist]%R -> picard g t = u0 + \vint[mu]_(x in `[a, t]) phi x (g x). Proof. by move=> Hg taad; rewrite eval_mod_on_itv//; exact: picard_funE. Qed. Lemma cauchy_lipschitz_integral_version : - is_integral_sol_on phi u0 a (a + safe_dist) picard_fix. + is_integral_sol phi u0 a (a + safe_dist) picard_fix. Proof. split; first exact: picard_fix_init. move=> t tad. -rewrite {1}picard_fixE eval_mod_on_itv//. +rewrite {1}picard_fixE// eval_mod_on_itv//. rewrite picard_fix_init. exact: picard_funE img_cball_picard_fix. Qed. Theorem cauchy_lipschitz_unique (picard_fix' : V) : img_cball picard_fix' -> - (forall t, t \in `[a, a + safe_dist] -> + (forall t, t \in `[a, a + safe_dist]%R -> picard_fix' t = u0 + \vint[mu]_(x in `[a, t]) phi x (picard_fix' x)) -> picard_fix = picard_fix'. Proof. @@ -1570,7 +1580,7 @@ apply/eqquotP. rewrite /Quotient.equiv/=. rewrite inE. apply/funext => x. -rewrite /patch; case: ifPn => [xK|xKnot]; last by []. +rewrite /patch mem_setE; case: ifPn => [xK|xKnot]; last by []. rewrite /fun_of_quot_contSeg/=. rewrite !fctE. rewrite !reprK. @@ -1580,7 +1590,7 @@ by rewrite h// subrr. Qed. Theorem cauchy_lipschitz_existence : picard_fix a = u0 /\ - {in `]a, a + safe_dist[, forall x, picard_fix^`() x = phi x (picard_fix x)}. + {in `]a, a + safe_dist[%R, forall x, picard_fix^`() x = phi x (picard_fix x)}. Proof. split; first exact: picard_fix_init. move => t tad. @@ -1588,7 +1598,7 @@ rewrite {1}picard_fixE. apply/rowP => j. suff -> : (picard picard_fix)^`() t = (fun t => u0 + \vint[mu]_(x in `[a, t]) phi x (picard_fix x))^`() t. - move: (tad); rewrite inE /= in_itv /= => /andP[ta tadelta]. + move: (tad); rewrite in_itv /= => /andP[ta tadelta]. have Fint i : mu.-integrable `[a, a + safe_dist] (EFin \o (fun x => phi x (picard_fix x) ord0 i)). apply: integrable_comp => //. @@ -1646,9 +1656,9 @@ Hypothesis cont1 : {within `[a, b], continuous (fun x => phi x (sol1 x))}. Hypothesis cont2 : {within `[b, c], continuous (fun x => phi x (sol2 x))}. Hypothesis matchb : sol1 b = sol2 b. -Lemma solution_extends : is_integral_sol_on phi u0 a b sol1 -> - is_integral_sol_on phi (sol1 b) b c sol2 -> - is_integral_sol_on phi u0 a c (patch sol2 `[a, b] sol1). +Lemma solution_extends : is_integral_sol phi u0 a b sol1 -> + is_integral_sol phi (sol1 b) b c sol2 -> + is_integral_sol phi u0 a c (patch sol2 `[a, b] sol1). Proof. move => [p0a p0s ] [p1a p1s]. have h0 : patch sol2 `[a, b] sol1 a = u0. @@ -1656,59 +1666,63 @@ have h0 : patch sol2 `[a, b] sol1 a = u0. case: ifPn => [xK | xKnot] => //. move /negP : xKnot. by rewrite inE/=in_itv/=lexx ltW. -split => //. -rewrite h0. -move => t tac. -rewrite /patch. +split=> //. +move=> t tac. +rewrite /patch mem_setE bound_itvE (ltW ab). case: ifPn => [xK | xKnot] => /=. rewrite p0s // p0a. - apply /rowP => i. + apply/rowP => i. rewrite !mxE. congr (_ + _)%E. apply eq_Rintegral => /= x xat. - suff ->: (x \in `[a,b]) by []. + suff -> : x \in `[a, b]%R by []. move : xat xK. - rewrite !inE /= !in_itv /= => /andP [xat1 xat2] /andP [tab1 tab2]. - apply /andP; split => //. + rewrite mem_setE /= !in_itv /= => /andP [xat1 xat2] /andP [tab1 tab2]. + apply/andP; split => //. exact/le_trans/tab2. -have tbc : t \in `[b, c]. +have tbc : t \in `[b, c]%R. move : tac. - move /negP : xKnot. - rewrite !inE /= !in_itv /=. + move/negP : xKnot. + rewrite !in_itv /=. have /orP := le_total b t. case => // -> h1 /andP [h2 ->] //. - by move : h1;rewrite h2. + by move: h1; rewrite h2. +transitivity (sol1 a + \vint[lebesgue_measure]_(s in `[a, t]) + phi s (if (s \in `[a, b])%classic then sol1 s else sol2 s))%E; last first. + by under eq_rowRintegral do rewrite mem_setE. rewrite (rowRintegral_itv_split (c := b) (F := (fun x => phi x (patch sol2 `[a, b] sol1 x)))). -- rewrite inE in tbc. - rewrite p1s//; last by rewrite inE. +- rewrite p1s//. suff : sol2 b = u0 + \vint[lebesgue_measure]_(s in `[a, b]) phi s (patch sol2 `[a, b] sol1 s). - rewrite /GRing.add /= addmxA => ->;congr (addmx _). + move=> ->. + rewrite -p0a. + rewrite [in RHS]addrA. + congr +%R. apply eq_rowRintegral => /= x xbt. - rewrite /patch;case: ifPn => [ | ] => //. + rewrite /patch; case: ifPn => [ | ] => //. rewrite inE/=in_itv/= => /andP [_ xleb]. move : xbt. rewrite !inE/=!in_itv/= => /andP [h _]. suff -> : x = b by rewrite p1a. apply le_anti. by rewrite xleb. - rewrite p1a p0s;last by rewrite inE/= in_itv/=ltW/=. + rewrite p1a p0s;last by rewrite in_itv/= ltW/=. rewrite p0a. congr (u0 + _)%E. rewrite /patch. by apply eq_rowRintegral => /= x ->. -- by rewrite ltW //=; move : tbc; rewrite inE /= in_itv /= => /andP [-> _]. +- by rewrite ltW //=; move : tbc; rewrite in_itv/= => /andP [-> _]. - move=> i. have cont' : {within `[a, t], continuous (fun x => phi x (patch sol2 `[a, b] sol1 x) ord0 i)}. have -> : `[a, t] = `[a, b] `|` `[b, t]. rewrite (@itv_bndbnd_setU _ _ _ (BRight b))// ?bnd_simp//=; last 2 first. exact: ltW. - by move: tbc; rewrite inE/= in_itv/= => /andP[]. + by move: tbc; rewrite in_itv/= => /andP[]. apply/seteqP; split => x. move=> []; [by left|right]. exact: subset_itv_oc_cc b0. move=> []; [by left|]. rewrite -setU1itv ?bnd_simp//; last first. - by move: tbc; rewrite inE/= in_itv/= => /andP[]. + by move: tbc; rewrite in_itv/= => /andP[]. case; [|by right]. move=> ->; left => /=. by rewrite in_itv/= (ltW ab) lexx. @@ -1726,14 +1740,14 @@ rewrite (rowRintegral_itv_split (c := b) (F := (fun x => phi x (patch sol2 `[a, have eq2 : {in `[b, c], (fun x0 => phi x0 (sol2 x0)) =1 (fun x0 => phi x0 (patch sol2 `[a,b] sol1 x0))}. move => x0 x0ab. - rewrite /patch;case: ifPn => [xab | xabnot] => //. + rewrite /patch mem_setE;case: ifPn => [xab | xabnot] => //. suff -> : x0 = b by rewrite matchb. apply: le_anti. move: x0ab xab. - by rewrite !inE/=!in_itv/= => /andP [-> _] /andP [_ ->]. - apply /continuous_subspaceW/(continuous_within_ext eq2)/cont2. + by rewrite inE/= !in_itv/= => /andP [-> _] /andP [_ ->]. + apply/continuous_subspaceW/(continuous_within_ext eq2)/cont2. apply: subset_itvl; rewrite bnd_simp. - by move : tbc; rewrite inE/= in_itv/= => /andP[]. + by move : tbc; rewrite in_itv/= => /andP[]. apply: continuous_compact_integrable => //. exact: segment_compact. Qed. @@ -1762,7 +1776,7 @@ Definition local_solution := repr (picard_fix ab k0 lip2 cont1 rho1). Local Notation safe_dist := (safe_dist phi a b k u0 r rho). -Lemma solution_local_solution : is_sol_on phi u0 a (BLeft (a + safe_dist)) local_solution. +Lemma solution_local_solution : is_sol_oo phi u0 a (a + safe_dist) local_solution. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. - by rewrite ltDl_safe_dist. @@ -1796,7 +1810,7 @@ Let f := cauchy_lipschitz_local_f. Theorem cauchy_lipschitz_local : safe_dist > 0 /\ - is_sol_on phi u0 a (BLeft (a + safe_dist)) f /\ + is_sol_oo phi u0 a (a + safe_dist) f /\ {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (f t)}. Proof. split; first exact: safe_dist_gt0. @@ -1809,9 +1823,9 @@ Local Notation V := (@ContSeg_quot.quot_contSeg R a (a + safe_dist) U). Theorem cauchy_lipschitz_local_unique f' : {within `[a, a + safe_dist], continuous f'} -> - {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (f' t)} -> - is_sol_on phi u0 a (BLeft (a + safe_dist)) f' -> - {in `[a, a + safe_dist], f =1 f'}. + {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (f' t)} -> + is_sol_oo phi u0 a (a + safe_dist) f' -> + {in `[a, a + safe_dist]%R, f =1 f'}. Proof. move => cont bnd. move/(@integral_sol_iff_sol _ _ _ _ _ _ _ _ r k0') => []//. @@ -1900,23 +1914,23 @@ Let B := closed_ball u0 r%:num. Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Hypothesis cf : {within `[a, b], continuous f}. -Hypothesis sol1 : is_sol_on phi u0 a (BLeft b) f. +Hypothesis sol1 : is_sol_oo phi u0 a b f. Let rho_max : {posnum R} := (2^-1)%:pos. Let dmax rho := safe_dist phi a b k u0 r rho. Let fc := local_solution ab k0 lip2 cont1. Lemma initial_solution_unique f' : {within `[a, b], continuous f'} -> - is_sol_on phi u0 a (BLeft b) f' -> - exists Delta : {posnum R}, {in `[a, a + Delta%:num], f =1 f'} /\ - {in `[a, a + Delta%:num], forall t, closed_ball u0 r%:num (f t)}. + is_sol_oo phi u0 a b f' -> + exists D : {posnum R}, {in `[a, a + D%:num]%R, f =1 f'} /\ + {in `[a, a + D%:num]%R, forall t, closed_ball u0 r%:num (f t)}. Proof. move => cf' sol2. -suff [rho [Delta [Hrho [Db P1 P2]]]] : exists rho Delta : {posnum R}, exists (Hrho : rho%:num < 1), - [/\ Delta%:num <= dmax rho, - {in `[a, a + Delta%:num], f =1 fc Hrho } & - {in `[a, a + Delta%:num], f' =1 fc Hrho} ]. - exists Delta; split => t tab; first by rewrite P1// P2. +suff [rho [D [Hrho [Db P1 P2]]]] : exists rho D : {posnum R}, exists (Hrho : rho%:num < 1), + [/\ D%:num <= dmax rho, + {in `[a, a + D%:num]%R, f =1 fc Hrho } & + {in `[a, a + D%:num]%R, f' =1 fc Hrho} ]. + exists D; split => t tab; first by rewrite P1// P2. rewrite P1//. apply: solution_stays_in_ball. by move: tab; rewrite !inE; apply: subset_itvl; rewrite bnd_simp lerD2l. @@ -2015,9 +2029,9 @@ Let rho : {posnum R} := (2^-1)%:pos. Let rho1 : rho%:num < 1. Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. -Theorem cauchy_lipschitz_autonomous a : exists f delta, - delta > 0 /\ is_sol_on (phi_) u0 a (BLeft (a + delta)) f /\ - {in `[a, a + delta], forall t, closed_ball u0 r%:num (f t)}. +Theorem cauchy_lipschitz_autonomous a : exists f D, + D > 0 /\ is_sol_oo (phi_) u0 a (a + D) f /\ + {in `[a, a + D], forall t, closed_ball u0 r%:num (f t)}. Proof. have aa1 : a < a + 1 by rewrite ltrDl. have [d0 [solf cball]] := @@ -2039,13 +2053,13 @@ Variables phi : U -> U. Hypothesis phi_locally_lipschitz : locally_lipschitz phi. -Theorem cauchy_lipschitz_ll u0 a : exists f delta r, - delta > 0 /\ is_sol_on (fun=> phi) u0 a (BLeft (a + delta)) f /\ - {in `[a, a + delta], forall t, closed_ball u0 r (f t)}. +Theorem cauchy_lipschitz_ll u0 a : exists f D r, + D > 0 /\ is_sol_oo (fun=> phi) u0 a (a + D) f /\ + {in `[a, a + D], forall t, closed_ball u0 r (f t)}. Proof. have [/= r [k lip]] := phi_locally_lipschitz u0. -have [//|f [delta [delta_ft0 [solf cball]]]] := cauchy_lipschitz_autonomous _ lip a. -by exists f, delta, r%:num. +have [//|f [D [D_gt0 [solf cball]]]] := cauchy_lipschitz_autonomous _ lip a. +by exists f, D, r%:num. Qed. End locally_lipschitz. @@ -2059,11 +2073,11 @@ Hypothesis ab : a < b. Hypothesis phi_locally_lipschitz : locally_lipschitz phi. Variables (u0 : U) (f : R -> U) (f' : R -> U). -Hypothesis sol1 : is_sol_on (fun=> phi) u0 a (BLeft b) f. -Hypothesis sol2 : is_sol_on (fun=> phi) u0 a (BLeft b) f'. +Hypothesis sol1 : is_sol_oo (fun=> phi) u0 a b f. +Hypothesis sol2 : is_sol_oo (fun=> phi) u0 a b f'. Lemma locally_unique_extends t : a <= t < b -> f' t = f t -> - exists Delta : {posnum R}, {in `[t, t + Delta%:num], f =1 f'}. + exists D : {posnum R}, {in `[t, t + D%:num]%R, f =1 f'}. Proof. move=> /andP[ta tb] eq. have taab : `[t, b] `<=` `[a, b]. @@ -2075,17 +2089,17 @@ have cf0 : {within `[t, b], continuous f}. have cf'0 : {within `[t, b], continuous f'}. have := And33 sol2. by rewrite closure_neitv_oo//; exact: continuous_subspaceW. -have sol10 : is_sol_on (fun => phi) (f t) t (BLeft b) f. +have sol10 : is_sol_oo (fun=> phi) (f t) t b f. split => //; last by rewrite closure_neitv_oo. move=> t0 tab. apply sol1. by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. -have sol20 : is_sol_on (fun => phi) (f t) t (BLeft b) f'. +have sol20 : is_sol_oo (fun=> phi) (f t) t b f'. split => //; last by rewrite closure_neitv_oo. move=> t0 tab. apply sol2. by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. -have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) phi}. +have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) phi}. by move => ? _; apply L. have k0 : 0 < k%:num by []. have cont1 : {in closed_ball (f t) r%:num, @@ -2095,13 +2109,13 @@ have [D [P1 P2]] := initial_solution_unique tb k0 lip20 cont1 cf0 sol10 cf'0 sol by exists D. Qed. -Lemma solution_unique : {in `[a, b], f =1 f'}. +Lemma solution_unique : {in `[a, b]%R, f =1 f'}. Proof. -set E := [set t | t \in `[a, b]%R /\ {in `[a, t], f =1 f'}]. +set E := [set t | t \in `[a, b]%R /\ {in `[a, t]%R, f =1 f'}]. suff : E b by case. have Enonempty : E !=set0. exists a; split; first by rewrite in_itv/= lexx ltW. - rewrite set_itv1 => t; rewrite inE/= => ->. + move=> t; rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). have mon c : E c -> forall c', a <= c' <= c -> E c'. move=> -[+ h c'] /andP[ac' cc']. @@ -2146,7 +2160,7 @@ have Eclosed : closed E. by near: y; exact: lt_nbhsr. rewrite not_andP in Ex1. case: Ex1 => // {}Ex1. - have [t Et] : exists t, t \in `[a, x] /\ ~ (f t = f' t). + have [t Et] : exists t, t \in `[a, x]%R /\ ~ (f t = f' t). rewrite not_existsP => h. apply Ex1 => t tax. have := h t. @@ -2166,15 +2180,15 @@ have Eclosed : closed E. have g0x : g x > 0. rewrite normr_gt0 subr_eq0. by apply/eqP; case: Et. - have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t], f =1 f'}. + have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t]%R, f =1 f'}. move => tab gt Et'. move : gt. suff -> : g t = 0 by rewrite ltxx. apply/normr0P. rewrite Et' ?subrr//. - by move: tab; rewrite inE/= !in_itv/= lexx => /andP[->]. - suff hgx: \forall y \near x^'-, 0 < g y. - near=>y. + by move: tab; rewrite !in_itv/= lexx => /andP[->]. + suff hgx : \forall y \near x^'-, 0 < g y. + near=> y. have [yx|xy Ey] := ltP y x; last first. have := mon _ Ey x. move: xab. @@ -2189,7 +2203,7 @@ have Eclosed : closed E. apply: contra_notN Ex1. move: xab; rewrite in_itv/= => /andP[+ _] ax. move/(conj ax) => /andP; rewrite -eq_le => /eqP ->. - rewrite set_itv1/= => y; rewrite inE/= => ->. + move=> y; rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). have /(continuous_within_itvP _ ab) := contg => -[h1 _ h2]. move: xab; rewrite in_itv/= => /andP[_ ]. @@ -2197,7 +2211,7 @@ have Eclosed : closed E. apply/cvg_at_left_filter/h1. by rewrite in_itv/= xb xa. have xt' : t < x. - case: Et; rewrite inE/=in_itv/= => /andP[_ ]. + case: Et; rewrite in_itv/= => /andP[_ ]. by rewrite le_eqVlt eq_sym (negbTE xt) . near=> y. move => Ey. @@ -2205,10 +2219,10 @@ have Eclosed : closed E. rewrite not_andP. right. move=> /(_ t). - case: Et; rewrite !inE/= !in_itv/= => /andP[-> _/=]. + case: Et; rewrite !in_itv/= => /andP[-> _/=]. by rewrite lexx => /[swap] => /(_ isT). have ta : a <= t. - by case: Et; rewrite inE/= in_itv/= => /andP[]. + by case: Et; rewrite in_itv/= => /andP[]. move/(monC y t ta Ey). apply/negP; rewrite -leNgt. by near: y; exact: nbhs_ge. @@ -2219,12 +2233,12 @@ have supE : E (sup E). have sup_itv : a <= sup E. apply sup_upper_bound => //. split; first by rewrite in_itv/= lexx ltW. - move => t. - rewrite set_itv1 inE/= => ->. + move=> t. + rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). have supeq : f' (sup E) = f (sup E). apply/esym; apply supE. - by rewrite inE/= in_itv/= lexx sup_itv. + by rewrite in_itv/= lexx sup_itv. have [h|h] := leP b (sup E). apply: (mon _ supE) => //. by rewrite (ltW ab). @@ -2238,10 +2252,10 @@ apply: sup_upper_bound => //. split. by rewrite in_itv/= le_min (ltW ab)/= ler_wpDr//= ge_min lexx. move=> t. -rewrite inE/= in_itv/= => -/andP[t1 t2]. +rewrite in_itv/= => -/andP[t1 t2]. have [ht|ht] := leP t (sup E). - by apply supE; rewrite inE/= in_itv/= t1 ht. -by apply: Hdelta; rewrite inE/= in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. + by apply supE; rewrite in_itv/= t1 ht. +by apply: Hdelta; rewrite in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. Unshelve. all: by end_near. Qed. End uniqueness. diff --git a/ode_autonomous.v b/ode_autonomous.v index 1cb02228..77b6c838 100644 --- a/ode_autonomous.v +++ b/ode_autonomous.v @@ -33,11 +33,10 @@ Hypothesis k0 : 0 < k. Let B := closed_ball u0 r%:num. Hypothesis lip2 : k.-lipschitz_B phi. -Definition phi_ (t : R) x := phi x. +Definition phi_ (t : R) := phi. Definition is_sol_sym u0 t0 d (sol : R -> U):= - sol t0 = u0 /\ {in `]t0 - d, t0 + d[, - forall x, derivable sol x 1 /\ sol^`() x = phi_ x (sol x)}. + sol t0 = u0 /\ sol_is_deriv_oo phi_ (t0 - d) (t0 + d) sol. Lemma phi_lip2 a b : {in `[a, b]%R, forall x, k.-lipschitz_B (phi_ x)}. Proof. by move => x abx; exact: lip2. Qed. @@ -51,7 +50,7 @@ Let rho1 : rho%:num < 1. Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. Local Lemma cauchy_lipschitz_autofwd a : exists f delta, - delta > 0 /\ is_sol_on (phi_) u0 a (BLeft (a + delta)) f /\ + delta > 0 /\ is_sol_oo phi_ u0 a (a + delta) f /\ {in `[a, a + delta], forall t, closed_ball u0 r%:num (f t)}. Proof. have aa1 : a < a + 1 by rewrite ltrDl. @@ -65,13 +64,13 @@ Qed. (* TODO: move *) Lemma patch_in {X : Type} (f g : R -> X) S x : x \in S -> patch f S g x = g x. Proof. - move => xs. - rewrite /patch. - by rewrite xs. +move => xs. +rewrite /patch. +by rewrite xs. Qed. Lemma closed_ball_split (x1 x2 y : U) q : 0 < q -> - closed_ball x1 (q/2) y -> closed_ball x2 (q/2) x1 -> closed_ball x2 q y. + closed_ball x1 (q / 2) y -> closed_ball x2 (q / 2) x1 -> closed_ball x2 q y. Proof. move => hq. have hq2: (0 < q /2). @@ -82,7 +81,7 @@ rewrite -(subrKA x1 x2). by apply: (le_trans (ler_normD _ _)); rewrite (splitr q) lerD//. Qed. -Local Lemma phi_lip2' a b: {in `[a, b]%R, forall x, k.-lipschitz_B (-phi_ x)}. +Local Lemma phi_lip2' a b : {in `[a, b]%R, forall x, k.-lipschitz_B (-phi_ x)}. Proof. move => y _ x B12. rewrite /= -normrN opprD !opprK /Algebra.opp /=. @@ -218,7 +217,7 @@ have fc : {in `[a-dboth, (a + dboth)], forall t : R, closed_ball (fminus (a - d apply: (closed_ball_split _ c2) =>//. exists f, dboth. split => //. -suff h : is_sol_on phi_ (f (a-dboth)) (a-dboth) (BLeft (a+dboth)) f. +suff h : is_sol_oo phi_ (f (a - dboth)) (a - dboth) (a + dboth) f. by split => //; apply: (And32 h). have kn0 : k != 0 by apply lt0r_neq0. apply /(integral_sol_iff_sol (r := r2) kn0) => //. @@ -275,16 +274,16 @@ apply solution_extends => //. * move => t tad. case : (And32 solminus (-t)). move : tad. - rewrite -/dminus !inE/=!in_itv/= ltrNr ltrNl opprD !opprK => /andP[h1 ->//=]. + rewrite -/dminus !in_itv/= ltrNr ltrNl opprD !opprK => /andP[h1 ->//=]. apply: (le_lt_trans _ h1). by rewrite lerD// lerNl opprK; rewrite ge_min;apply /orP;right;rewrite ge_min lexx. move => h1 h2. - have hd : (derivable fminus t 1). + have hd : derivable fminus t 1. rewrite /fminus/=. - apply /derivable1_diffP. - apply /differentiable_comp => //. - apply /derivable1_diffP. - apply h1. + apply/derivable1_diffP. + apply/differentiable_comp => //. + apply/derivable1_diffP. + by apply h1. split=>//. rewrite /fminus/=. apply /rowP => i /=. @@ -332,15 +331,13 @@ apply solution_extends => //. apply solplus. move => t tad. apply solplus. - move : tad. - rewrite !inE/=!in_itv/= => /andP[-> h0]//=. - apply (lt_le_trans h0). - by rewrite lerD //= ge_min lexx. - apply /continuous_subspaceW/cfplus. - rewrite closure_neitv_oo;last by rewrite ltrDl. - apply subset_itvl. - rewrite bnd_simp /=. - by rewrite lerD //= ge_min lexx. + move: tad; rewrite !in_itv/= => /andP[-> h0]//=. + by rewrite (lt_le_trans h0)// lerD2l ge_min lexx. + apply /continuous_subspaceW/cfplus. + rewrite closure_neitv_oo;last by rewrite ltrDl. + apply subset_itvl. + rewrite bnd_simp /=. + by rewrite lerD //= ge_min lexx. Qed. End picard_autonomous. @@ -375,11 +372,11 @@ Hypothesis ab : a < b. Hypothesis phi_locally_lipschitz : locally_lipschitz phi. Variables (u0 : U) (f : R -> U) (f' : R -> U). -Hypothesis sol1 : is_sol_on (fun=> phi) u0 a (BLeft b) f. -Hypothesis sol2 : is_sol_on (fun=> phi) u0 a (BLeft b) f'. +Hypothesis sol1 : is_sol_oo (fun=> phi) u0 a b f. +Hypothesis sol2 : is_sol_oo (fun=> phi) u0 a b f'. Lemma locally_unique_extends t : a <= t < b -> f' t = f t -> - exists Delta : {posnum R}, {in `[t, t + Delta%:num], f =1 f'}. + exists Delta : {posnum R}, {in `[t, t + Delta%:num]%R, f =1 f'}. Proof. move=> /andP[ta tb] eq. have taab : `[t, b] `<=` `[a, b]. @@ -391,12 +388,12 @@ have cf0 : {within `[t, b], continuous f}. have cf'0 : {within `[t, b], continuous f'}. have := And33 sol2. by rewrite closure_neitv_oo//; exact: continuous_subspaceW. -have sol10 : is_sol_on (fun => phi) (f t) t (BLeft b) f. +have sol10 : is_sol_oo (fun=> phi) (f t) t b f. split => //; last by rewrite closure_neitv_oo. move=> t0 tab. apply sol1. by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. -have sol20 : is_sol_on (fun => phi) (f t) t (BLeft b) f'. +have sol20 : is_sol_oo (fun=> phi) (f t) t b f'. split => //; last by rewrite closure_neitv_oo. move=> t0 tab. apply sol2. @@ -411,13 +408,13 @@ have [D [P1 P2]] := initial_solution_unique tb k0 lip20 cont1 cf0 sol10 cf'0 sol by exists D. Qed. -Lemma solution_unique : {in `[a, b], f =1 f'}. +Lemma solution_unique : {in `[a, b]%R, f =1 f'}. Proof. -set E := [set t | t \in `[a, b]%R /\ {in `[a, t], f =1 f'}]. +set E := [set t | t \in `[a, b]%R /\ {in `[a, t]%R, f =1 f'}]. suff : E b by case. have Enonempty : E !=set0. exists a; split; first by rewrite in_itv/= lexx ltW. - rewrite set_itv1 => t; rewrite inE/= => ->. + move=> t; rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). have mon c : E c -> forall c', a <= c' <= c -> E c'. move=> -[+ h c'] /andP[ac' cc']. @@ -462,7 +459,7 @@ have Eclosed : closed E. by near: y; exact: lt_nbhsr. rewrite not_andP in Ex1. case: Ex1 => // {}Ex1. - have [t Et] : exists t, t \in `[a, x] /\ ~ (f t = f' t). + have [t Et] : exists t, t \in `[a, x]%R /\ ~ (f t = f' t). rewrite not_existsP => h. apply Ex1 => t tax. have := h t. @@ -482,13 +479,13 @@ have Eclosed : closed E. have g0x : g x > 0. rewrite normr_gt0 subr_eq0. by apply/eqP; case: Et. - have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t], f =1 f'}. + have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t]%R, f =1 f'}. move => tab gt Et'. move : gt. suff -> : g t = 0 by rewrite ltxx. apply/normr0P. rewrite Et' ?subrr//. - by move: tab; rewrite inE/= !in_itv/= lexx => /andP[->]. + by move: tab; rewrite !in_itv/= lexx => /andP[->]. suff hgx: \forall y \near x^'-, 0 < g y. near=>y. have [yx|xy Ey] := ltP y x; last first. @@ -505,7 +502,7 @@ have Eclosed : closed E. apply: contra_notN Ex1. move: xab; rewrite in_itv/= => /andP[+ _] ax. move/(conj ax) => /andP; rewrite -eq_le => /eqP ->. - rewrite set_itv1/= => y; rewrite inE/= => ->. + move=> t; rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). have /(continuous_within_itvP _ ab) := contg => -[h1 _ h2]. move: xab; rewrite in_itv/= => /andP[_ ]. @@ -513,7 +510,7 @@ have Eclosed : closed E. apply/cvg_at_left_filter/h1. by rewrite in_itv/= xb xa. have xt' : t < x. - case: Et; rewrite inE/=in_itv/= => /andP[_ ]. + case: Et; rewrite in_itv/= => /andP[_ ]. by rewrite le_eqVlt eq_sym (negbTE xt) . near=> y. move => Ey. @@ -521,10 +518,10 @@ have Eclosed : closed E. rewrite not_andP. right. move=> /(_ t). - case: Et; rewrite !inE/= !in_itv/= => /andP[-> _/=]. + case: Et; rewrite !in_itv/= => /andP[-> _/=]. by rewrite lexx => /[swap] => /(_ isT). have ta : a <= t. - by case: Et; rewrite inE/= in_itv/= => /andP[]. + by case: Et; rewrite in_itv/= => /andP[]. move/(monC y t ta Ey). apply/negP; rewrite -leNgt. by near: y; exact: nbhs_ge. @@ -535,12 +532,11 @@ have supE : E (sup E). have sup_itv : a <= sup E. apply sup_upper_bound => //. split; first by rewrite in_itv/= lexx ltW. - move => t. - rewrite set_itv1 inE/= => ->. + move=> t; rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). have supeq : f' (sup E) = f (sup E). apply/esym; apply supE. - by rewrite inE/= in_itv/= lexx sup_itv. + by rewrite in_itv/= lexx sup_itv. have [h|h] := leP b (sup E). apply: (mon _ supE) => //. by rewrite (ltW ab). @@ -554,10 +550,10 @@ apply: sup_upper_bound => //. split. by rewrite in_itv/= le_min (ltW ab)/= ler_wpDr//= ge_min lexx. move=> t. -rewrite inE/= in_itv/= => -/andP[t1 t2]. +rewrite in_itv/= => -/andP[t1 t2]. have [ht|ht] := leP t (sup E). - by apply supE; rewrite inE/= in_itv/= t1 ht. -by apply: Hdelta; rewrite inE/= in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. + by apply supE; rewrite in_itv/= t1 ht. +by apply: Hdelta; rewrite in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. Unshelve. all: by end_near. Qed. End uniqueness. diff --git a/ode_common.v b/ode_common.v index c225547c..a26d0d0a 100644 --- a/ode_common.v +++ b/ode_common.v @@ -1,5 +1,5 @@ From HB Require Import structures. -From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. +From mathcomp Require Import all_boot all_order ssralg ssrnum matrix interval poly. From mathcomp Require Import generic_quotient ring_quotient. From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. From mathcomp Require Import constructive_ereal. @@ -30,15 +30,13 @@ Open Scope ring_scope. Open Scope classical_set_scope. Lemma eq_on_itv_deriv {R : realType} {W : normedModType R} c d (g h : R -> W) : - {in `]c,d[, g =1 h} -> {in `]c,d[, g^`() =1 h^`()}. + {in `]c, d[%R, g =1 h} -> {in `]c, d[%R, g^`() =1 h^`()}. Proof. move=> gh x xcd; rewrite !derive1E; apply: near_eq_derive => //. near=> x0. apply gh. -rewrite inE. near: x0. -apply/near_in_itvoo. -by rewrite -inE. +exact/near_in_itvoo. Unshelve. all: by end_near. Qed. Section about_sup. @@ -816,15 +814,15 @@ Section infty_norm0_lemmas. Context {R : realType} {W : normedModType R}. Variables a b : R. Hypothesis ab : a <= b. -Let K := `[a, b]. -Local Notation T := (continuousFunType K [set: W]). +Let K := `[a, b]%R. +Local Notation T := (continuousFunType [set` K] [set: W]). Lemma infty_norm0_le (g : T) (u : R) : {in K, forall x, `| g x | <= u} -> infty_norm0 g <= u. Proof. have [c Kc] := seg_nonempty ab. move=> h; rewrite /infty_norm0; apply: ge_sup. - by exists (normr (g c)); exists c => //; rewrite /= in_itv/= lexx. + by exists `|g c|; exists c => //; rewrite /= in_itv/= lexx. by move => _ [x xab] <-;apply h; rewrite inE. Qed. @@ -833,11 +831,10 @@ Proof. move=> xK. rewrite sup_upper_bound //=. exact: normr_has_sup. -exists x => //. -by rewrite inE in xK. +by exists x. Qed. -Lemma infty_norm0_itv_eq (f g : T): {in K, f =1 g} -> +Lemma infty_norm0_itv_eq (f g : T) : {in K, f =1 g} -> infty_norm0 f = infty_norm0 g. Proof. move=> inK. diff --git a/ode_contfun.v b/ode_contfun.v index 1d714343..820082ce 100644 --- a/ode_contfun.v +++ b/ode_contfun.v @@ -203,23 +203,23 @@ apply/(iffP idP); rewrite eqmodE//=. by apply/eqP; rewrite subr_eq0; exact/eqP/abfg. Qed. -Lemma eqmod_on_itv f g : f = g %[mod T] -> {in `[a, b], f =1 g}. +Lemma eqmod_on_itv f g : f = g %[mod T] -> {in `[a, b]%R, f =1 g}. Proof. move=> /eqmodP + x xab. move/set_mem => abfg0. apply: subr0_eq. move/(congr1 (fun z => z x)) : abfg0. -by rewrite /patch xab. +by rewrite /patch mem_setE/= xab. Qed. -Lemma eval_mod_on_itv f x : x \in `[a, b] -> (\pi_T f : T) x = f x. +Lemma eval_mod_on_itv f x : x \in `[a, b]%R -> (\pi_T f : T) x = f x. Proof. move => xab. apply: (@eqmod_on_itv (repr (\pi_T f)) f) => //. by rewrite reprK. Qed. -Lemma quot_contSeg_fctB (f g : T) t : t \in `[a, b] -> +Lemma quot_contSeg_fctB (f g : T) t : t \in `[a, b]%R -> (f - g : T) t = (f : T) t - (g : T) t. Proof. move=> tab. @@ -237,7 +237,7 @@ End ContSeg_quot. Section zmodule_normed. Context {R : realType} {W : normedModType R}. Variables a b : R. -Let K := `[a, b]. +Let K := `[a, b]%R. Import ContSeg_quot. @@ -251,7 +251,7 @@ Lemma ler_infty_normD (x y : V) : infty_norm (x + y) <= infty_norm x + infty_norm y :> R. Proof. rewrite /infty_norm/=. -have [K0|K0] := eqVneq K set0. +have [K0|K0] := eqVneq [set` K] set0. rewrite /infty_norm0. do ! rewrite [X in [set _ | _ in X]](_ : _ = set0)// image_set0//. by rewrite sup0 addr0. @@ -278,7 +278,7 @@ apply: sup_le. + exists (`|x a| + `|repr y a|)=> /=. exists (`|repr x a|) => //; [exists a => //; by rewrite in_itv/= lexx ab|]. by exists `|repr y a| => //; exists a => //; rewrite bound_itvE. - + exists (sup [set `|repr x r| | r in K] + sup [set `|repr y r| | r in K]). + + exists (sup [set `|repr x r| | r in [set` K]] + sup [set `|repr y r| | r in [set` K]]). apply ubP => _ [x0 xs] [y0 ys] <-. rewrite lerD// ub_le_sup//. exact: (normr_has_sup x _).2. @@ -293,7 +293,7 @@ apply/eqquotP. rewrite Quotient.equivE inE; apply: funext => r /=. rewrite /patch; case : ifPn => // /set_mem in_itv. rewrite 2!fctE. -have -> : {in K, repr (0 : V) =1 (0 : @continuousFunType R W K setT)}. +have -> : {in K, repr (0 : V) =1 (0 : @continuousFunType R W [set` K] setT)}. - apply/eqmod_on_itv. by rewrite reprK /GRing.zero /= /Quotient.zero /= -lock. - rewrite [LHS]subr0. @@ -347,27 +347,27 @@ Lemma infty_norm_pi x : `|\pi_V x| = infty_norm0 x. Proof. by rewrite /Num.norm /= infty_norm_pi0. Qed. Lemma infty_norm_lt (f : V) e : - `| f | < e -> {in `[a, b], forall x : R, `|f x| < e}. + `| f | < e -> {in `[a, b]%R, forall x : R, `|f x| < e}. Proof. rewrite -{1}(reprK f) infty_norm_pi => h x xab. have [ab|ab] := leP a b. exact/le_lt_trans/h/infty_norm0_ge. -move: xab; rewrite inE/= in_itv/= => /andP[/le_trans /[apply]]. +move: xab; rewrite in_itv/= => /andP[/le_trans /[apply]]. by rewrite leNgt ab. Qed. Lemma infty_norm_le (f : V) e : - `| f | <= e -> {in `[a, b], forall x : R, `|f x| <= e}. + `| f | <= e -> {in `[a, b]%R, forall x : R, `|f x| <= e}. Proof. rewrite -{1}(reprK f) infty_norm_pi => h x xab. have [ab|ab] := leP a b. exact/le_trans/h/infty_norm0_ge. -move: xab; rewrite inE/= in_itv/= => /andP[/le_trans /[apply]]. +move: xab; rewrite in_itv/= => /andP[/le_trans /[apply]]. by rewrite leNgt ab. Qed. Lemma infty_norm_le2 (f : V) e (e0 : 0 <= e) : - {in `[a, b], forall x : R, `|f x| <= e} -> `| f | <= e. + {in `[a, b]%R, forall x : R, `|f x| <= e} -> `| f | <= e. Proof. move=> h. have [ab|ba] := leP a b. @@ -424,6 +424,7 @@ apply/eqP; rewrite scaler_eq0. rewrite (negPf a0)/= subr_eq0. apply/eqP. case: piP => f. +rewrite mem_setE in xrs. by move/eqmod_on_itv => /(_ _ xrs) <-. Qed. @@ -456,7 +457,7 @@ apply/eqP; rewrite scaler_eq0 (negPf k0)/=. rewrite subr_eq0. apply/eqP. have := @eqmod_on_itv _ _ _ _ (repr (b + c)) (repr b + repr c). -move=> ->//. +move=> ->//; last by rewrite mem_setE in xrs. rewrite pi_add//=. by rewrite !reprK. Qed. @@ -475,10 +476,10 @@ HB.instance Definition _ := @GRing.Zmodule_isLmodule.Build R V cont_scale cont_scalerA cont_scale1r cont_scalerDr cont_scalerDl. -Local Lemma repr_mult l (x : V) a : a \in `[r, s] -> +Local Lemma repr_mult l (x : V) a : a \in `[r, s]%R -> repr (l *: x) a = l *: (repr x a). Proof. -move =>ars. +move=> ars. have : repr (l *: x) = l *: repr x %[mod V]. by case: piP. move/(@eqmod_on_itv _ _ _ _ (repr (l *: x)) (l *: repr x)). @@ -549,11 +550,11 @@ Proof. by constructor. Qed. HB.instance Definition _ F FF Fc := (@lim_fun_is_fun F FF Fc). Lemma lim_fun_cvg_pt (F : set_system V) (FF: ProperFilter F) (Fc : cauchy F) : - forall e : R, e > 0 -> forall t, t \in `[a,b] -> + forall e : R, e > 0 -> forall t, t \in `[a, b]%R -> \forall f \near F, `|lim_fun FF Fc t - (f : V) t| <= e. Proof. have /(_ _ _) /cauchy_cvg /cvg_app_entourageP cvF : - forall t : R, t \in `[a,b] -> + forall t : R, t \in `[a, b]%R -> cauchy (fmap (fun h : V => h t) (fun A : set V => nbhs F (fun g => A g))). move=> t tab A /=. rewrite -entourage_ballE => -[e /= e0 eA]. @@ -565,7 +566,7 @@ have /(_ _ _) /cauchy_cvg /cvg_app_entourageP cvF : rewrite -ball_normE /ball/=. rewrite -quot_contSeg_fctB//. exact: h. -have cvg_pt (t : R) : t \in `[a,b] -> +have cvg_pt (t : R) : t \in `[a, b]%R -> x @[x --> fmap (fun h : V => h t) F] --> lim_fun FF Fc t. move=> tab. apply/cvg_entourageP. @@ -575,7 +576,7 @@ exact. Qed. Lemma lim_fun_cvg_uniform (F : set_system V) (FF: ProperFilter F) (Fc : cauchy F) : - forall e : R, e > 0 -> \forall f \near F, forall t, t \in `[a, b] -> + forall e : R, e > 0 -> \forall f \near F, forall t, t \in `[a, b]%R -> `|lim_fun FF Fc t - (f : V) t| <= e. Proof. move=> e e0. @@ -605,22 +606,22 @@ have [ab|] := ltP a b; last first. by rewrite set_itv1; exact: continuous_subspace1. rewrite set_itv_ge// ?bnd_simp -?ltNge//. exact: continuous_subspace0. -have H (e : R) : e > 0 -> forall t, t \in `[a, b] -> +have H (e : R) : e > 0 -> forall t, t \in `[a, b]%R -> \forall t' \near t, t' \in `[a, b] -> `|lim_fun FF Fc t - lim_fun FF Fc t'| <= e. move=> e0 t tab. near F => f. - have lim_fune2 : forall u, u \in `[a, b] -> `|lim_fun FF Fc u - f u| <= e / 2. + have lim_fune2 : forall u, u \in `[a, b]%R -> `|lim_fun FF Fc u - f u| <= e / 2. by near: f; apply: lim_fun_cvg_uniform => //; rewrite divr_gt0. move/(continuous_within_itvP _ ab) : (@cts_fun _ _ f ) => [mc lc rc]. - move: (tab). + have : t \in `[a, b] by rewrite inE. rewrite -{1}setUitv1/=; last by rewrite bnd_simp ltW. rewrite -{1}setU1itv/=; last by rewrite bnd_simp. rewrite inE/= in_itv/= => -[[->|tab']|->]. - near=> t' => t'ab. rewrite -(subrKA (f a) (lim_fun FF Fc a)). rewrite (le_trans (ler_normD _ _))// (splitr e) lerD//. - + by rewrite lim_fune2// inE/= bound_itvE ltW. + + by rewrite lim_fune2// bound_itvE ltW. + rewrite -(subrKA (f t') (f a)). rewrite (le_trans (ler_normD _ _))// (splitr (e/2)) lerD//. * move: t'ab. @@ -632,6 +633,7 @@ have H (e : R) : e > 0 -> forall t, t \in `[a, b] -> rewrite !divr_gt0// => /(_ isT)[e1 e10 eh]. by exists e1 => // => x ae1x /andP [xa _]; exact: eh. * rewrite distrC. + rewrite mem_setE in t'ab. move: (t') t'ab. near: f. by apply lim_fun_cvg_uniform; rewrite !divr_gt0. @@ -647,13 +649,14 @@ have H (e : R) : e > 0 -> forall t, t \in `[a, b] -> move /(_ _ tab') : mc => /cvgrPdist_le /=; apply. by rewrite !divr_gt0. rewrite distrC. + rewrite mem_setE in t'ab. move: (t') t'ab. near: f. by apply: lim_fun_cvg_uniform; rewrite !divr_gt0. - near=> t' => t'ab. rewrite -(subrKA (f b) (lim_fun FF Fc b)). rewrite (le_trans (ler_normD _ _))// (splitr e) lerD//. - by rewrite lim_fune2// inE/= bound_itvE ltW. + by rewrite lim_fune2// bound_itvE ltW. rewrite -(subrKA (f t') (f b)). rewrite (le_trans (ler_normD _ _))// (splitr (e / 2)) lerD//. move: t'ab. @@ -665,6 +668,7 @@ have H (e : R) : e > 0 -> forall t, t \in `[a, b] -> rewrite !divr_gt0// => /(_ isT)[e1 e10 eh]. by exists e1 => // x be1x /andP [_ xb]; exact: eh. rewrite distrC. + rewrite mem_setE in t'ab. move: (t') t'ab. near: f. by apply: lim_fun_cvg_uniform; rewrite !divr_gt0. @@ -684,7 +688,7 @@ apply/continuous_within_itvP => //; split. by apply/andP; split; near: t'; [exact: nbhs_right_ge|exact: nbhs_right_le]. near: t'. apply/(cvg_at_right_filter cvg_id)/H => //. - by rewrite inE/= bound_itvE// ltW. + by rewrite bound_itvE// ltW. - apply/cvgrPdist_le => /= e e0. near=> t'. have : t' \in `[a,b]. @@ -692,7 +696,7 @@ apply/continuous_within_itvP => //; split. by apply/andP; split; near: t'; [exact: nbhs_left_ge|exact: nbhs_left_le]. near: t'. apply/(cvg_at_left_filter cvg_id)/H => //. - by rewrite inE /= bound_itvE/= ltW. + by rewrite bound_itvE/= ltW. Unshelve. all: by end_near. Qed. HB.instance Definition _ F FF Fc := @@ -703,11 +707,11 @@ Fail Check (V : completeType). Lemma cvg_V_entourageP (F : set_system V) (FF : Filter F) (f : V) : F --> f <-> forall A, entourage A -> - \forall g \near F, {in `[a, b], forall t : R, A (f t, (g : V) t)}. + \forall g \near F, {in `[a, b]%R, forall t : R, A (f t, (g : V) t)}. Proof. split => [/cvg_entourageP /= Ff A|/=Ff]. rewrite -entourage_ballE => -[eps eps0 /= H]. - apply: (Ff [set fg : V * V| {in `[a, b], forall t : R, A (fg.1 t, fg.2 t)}]). + apply: (Ff [set fg : V * V| {in `[a, b]%R, forall t : R, A (fg.1 t, fg.2 t)}]). exists eps => //. rewrite /pseudoMetric_from_normedZmodType.ball /=. move=> /= x bx t tab. @@ -735,7 +739,7 @@ Lemma quot_cont_on_segType_cauchy_cvg (F : set_system V) : Proof. move=> FF Fc. have /(_ _ _)/cauchy_cvg/cvg_app_entourageP cvF : - forall t, t \in `[a, b] -> + forall t, t \in `[a, b]%R -> cauchy (fmap (fun h : V => h t) (fun A : set V => nbhs F (fun g => A g))). move=> t tab A/=. rewrite -entourage_ballE => -[e e0 ee]; rewrite near_simpl -near2E near_map2. diff --git a/ode_wip.v b/ode_wip.v index 65a41123..655df58f 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -53,7 +53,7 @@ Definition lipschitzT_solution_f : continuousFunType `[a, a + safe_dist] [set: ' repr (picard_fix ab k0 lip2' cont1' rho1). Lemma lipschitzT_solution : - is_sol_on phi u0 a (BLeft (a + safe_dist)) lipschitzT_solution_f. + is_sol_oo phi u0 a (a + safe_dist) lipschitzT_solution_f. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. - by rewrite gt_eqF. @@ -83,7 +83,7 @@ Let f := lipschitzT_solution_f. Theorem lipschitzT_cauchy_lipschitz_local : safe_dist > 0 /\ - is_sol_on phi u0 a (BLeft (a + safe_dist)) f /\ + is_sol_oo phi u0 a (a + safe_dist) f /\ {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (f t)}. Proof. split; first exact: safe_dist_gt0. @@ -388,6 +388,38 @@ Qed. End itv_partition_porder. +Definition piecewise {R : realType} (U : normedModType R) + (f : nat -> R -> U) (a b : R) (s : seq R) (P : (R -> U) -> R -> Prop) := + forall i : nat, (i < size s)%N -> + forall x : R, + nth b (a :: s) i <= x <= nth b (a :: s) i.+1 -> + P (f i) x. + +Definition patched {R : realType} (U : normedModType R) + (f : nat -> R -> U) (a b : R) (s : seq R) (F : R -> U) := + forall x : R, + forall i : nat, (i < size s)%N -> + nth b (a :: s) i <= x <= nth b (a :: s) i.+1 -> + f i x = F x. + +Lemma piecewise_derivable {R : realType} (U : normedModType R) + (f : nat -> R -> U) (a b : R) (s : seq R) (abs : itv_partition a b s) + (F : R -> U) : + patched f a b s F -> + piecewise f a b s (fun g x => derivable g x 1) -> + forall x, x \in `[a, b] -> derivable F x 1. +Proof. +Admitted. + +Lemma piecewise_continuous {R : realType} (U : normedModType R) + (f : nat -> R -> U) (a b : R) (s : seq R) (abs : itv_partition a b s) + (F : R -> U) : + patched f a b s F -> + piecewise f a b s (fun g x => continuous_at x g) -> + forall x, x \in `[a, b] -> continuous_at x F. +Proof. +Admitted. + (* Theorem 3.2: global existence and uniqueness *) Section cauchy_lipschitz_global. Context {R : realType} {n : nat}. @@ -410,7 +442,7 @@ Let i_ (x : elt_type) := (proj1_sig x).2. Let elt_rel i j := f_ j (a_ j) = f_ i (b_ i). Theorem cauchy_lipschitz_global : exists f : R -> 'rV_n (*: continuousFunType `[a, b] [set: 'rV[R]_n]*), - is_sol_on phi u0 a (BLeft b) f. + is_sol_oo phi u0 a b f. Proof. near (0:R)^'+ => rho'. have rho'_gt0 : 0 < rho' by []. @@ -446,9 +478,8 @@ have [barhok|barhok] := leP (b - a) (rho%:num / k). @lipschitzT_cauchy_lipschitz_local R n phi a b k u0 r rho rho1 ab k0 lip2 cont1. split => //. move=> t tab. - apply H1; apply/mem_set. - move/set_mem : tab. - by apply: subset_itvl; rewrite bnd_simp safe_distba subrKC. + apply H1. + by apply: subset_itvl tab; rewrite bnd_simp safe_distba subrKC. apply: continuous_subspaceW H2. apply: subset_trans; first exact: itv_closure. rewrite closure_neitv_oo ?ltDl_safe_dist//. @@ -662,11 +693,11 @@ Lemma exe325b1 : forall t, t \in `[a, T[ -> f t \in W. Proof. Admitted. -Lemma exe325b2 : is_sol_on phi u0 a (BLeft T) f. +Lemma exe325b2 : is_sol_oo phi u0 a T f. Proof. Admitted. -Lemma exe325b3 : exists delta, delta > 0 /\ is_sol_on phi u0 a (BLeft (T + delta)) f. +Lemma exe325b3 : exists2 delta, delta > 0 & is_sol_oo phi u0 a (T + delta) f. Proof. Admitted. @@ -685,7 +716,7 @@ Variable T : R. Hypothesis aTab : `[a, T[ `<=` `[a, b]. Variable f : R -> U. Variable u0 : U. -Hypothesis fsol : is_sol_on phi u0 a (BLeft T)(*exluded*) f. +Hypothesis fsol : is_sol_oo phi u0 a T f. Variable W : set U. Hypothesis compactW : compact W. diff --git a/tilt_lasalle.v b/tilt_lasalle.v index 865b9123..68c92818 100644 --- a/tilt_lasalle.v +++ b/tilt_lasalle.v @@ -202,16 +202,16 @@ Hypothesis solP : forall y, y 0 \in Tilt.Upsilon1 -> Hypothesis initp : forall p, sol p 0 = p. -Let isSol p : p \in Tilt.Upsilon1 -> is_sol_on0y phi (sol p). +Let isSol p : p \in Tilt.Upsilon1 -> sol_is_deriv_c0y phi (sol p). Proof. move => Kp. -apply/is_sol_on0yP. +apply/sol_is_deriv_c0yP. have : lasalle.is_sol phi (sol p) by apply/solP; rewrite ?initp. move => [/=_ H]. move => /= t t0. split. by apply: ex_derive; apply H. -by rewrite derive1E;apply H. +by rewrite derive1E; apply H. Qed. Definition Ksub (p : U) := @@ -296,12 +296,12 @@ split; last first. split => //. + rewrite initp. exact/mem_set. - + apply global_sol_sol. + + apply sol_is_deriv_c0yco. apply isSol => //. by rewrite inE. - + exists t; split => //. + + exists t => //. by rewrite /= in_itv/=t0/=ltrDl. -move/mem_set : (Kx) => /isSol /is_sol_on0yP solA. +move/mem_set : (Kx) => /isSol /sol_is_deriv_c0yP solA. rewrite (le_trans _ Vx)//. rewrite -[in leRHS](@initp x). have : {in `[0, t + 1[, forall t : K, derivable (sol x) t 1}. @@ -313,12 +313,11 @@ apply. - exact: V1_diff. - move => t1 tt1. apply : (@derive_along_V1_le0 _ _ _ _ _ (t + 1))=> //. - + apply global_sol_sol => //. - apply/is_sol_on0yP. - by apply solA. + by rewrite initp inE. - + move => t2. - move => /andP[t2' _]. + + apply: sol_is_deriv_c0yco => //. + apply/sol_is_deriv_c0yP. + by apply solA. + + move=> t2 /andP[t2' _]. apply/derivable1_diffP. apply solA. by rewrite ltW. @@ -326,7 +325,7 @@ apply. - by rewrite lexx. Qed. -Local Lemma sol_Ksub p u : u \in Ksub p -> is_sol_on0y phi (sol u). +Local Lemma sol_Ksub p u : u \in Ksub p -> sol_is_deriv_c0y phi (sol u). Proof. rewrite inE/= => -[h1 h2]. apply isSol => //. @@ -417,8 +416,8 @@ have H : lasalle.limS sol (Ksub p) `<=` rewrite derive1E. rewrite -derive_along_derive. apply : derive_along_V1_le0_global => //. - by apply isSol. by rewrite initp. + by apply isSol. rewrite initp. by apply: V1_diff => //. apply /derivable1_diffP. @@ -435,9 +434,9 @@ have H : lasalle.limS sol (Ksub p) `<=` rewrite initp; apply q_inKsubq. have/= [_ +] := qKsub. by move/mem_set. - apply global_sol_sol. + apply: sol_is_deriv_c0yco. by apply isSol;rewrite inE;apply qKsub. - exists t;split => //. + exists t => //. by rewrite/=in_itv/=H ltrDl ltr01. have lim_sp : (sol q x @[x --> +oo]) (Ksub q). exists 0; split => // t t0 /=. @@ -481,13 +480,14 @@ have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Upsilon1. move : h1. have hi := initp x. rewrite -hi => h1. - have sol' : is_sol_on0o phi (BLeft 1) (sol x) . - apply: global_sol_sol. + have sol' : sol_is_deriv_co (fun=> phi) 0 1 (sol x). + apply: sol_is_deriv_c0yco. by apply isSol. - apply: (V1dot_eq0_p1_or_p2 sol') => //. - rewrite hi. - exact/mem_set. - by rewrite in_itv /= lexx ltr01. + rewrite /Tilt.points/=. + apply: (V1dot_eq0_p1_or_p2 _ sol') => //. + rewrite hi. + exact/mem_set. + by rewrite bound_itvE ltr01. by apply limS_subset_V1dot0. Qed. diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index 93858a84..f2034039 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -539,7 +539,6 @@ have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))) have Rsu t0 : t0 \in `[0, Delta[ -> Right (y^`()%classic t0) = (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). rewrite inE/=. - rewrite /is_sol_on0o/= in deri. by move/deri => [_ ->]; rewrite row_mxKr. rewrite /dotmul. transitivity (-2 * (gamma *: (Right (y x) - @@ -598,12 +597,11 @@ have norm_constant t0 : t0 \in `[0, Delta[ -> apply: differentiable_enorm_squared => /=. exact: differentiableB. move: t0d; rewrite in_itv/= => /andP[t_ge0 tDelta]. - rewrite /is_sol_on0o/= in deri. + rewrite /sol_is_deriv_co/= in deri. have cont : {in `[0, t0], continuous y}. move=> t' t'0D. rewrite inE/= in t'0D. - apply: differentiable_continuous. - apply/derivable1_diffP. + apply/differentiable_continuous/derivable1_diffP. apply deri. apply: subset_itvl t'0D. rewrite bnd_simp. @@ -632,19 +630,17 @@ Lemma equilibrium_tilt_point1 : Proof. split. - exact: tilt_point1_in_state_space. -- move=> Delta. - move=> t t0Delta. +- move=> D t t0D. split; first exact: derivable_cst. rewrite derive1E derive_cst /Tilt.point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP; split. - rewrite scaler_eq0; apply/orP; right; apply/eqP/rowP => i. + rewrite scaler_eq0 oppr_eq0 gt_eqF//=. by rewrite lsubmx_const. apply/eqP/rowP; move => i; apply/eqP. rewrite /PhysicalModel.eqn14b_rhs. set N := (X in _ *: X *m _); have : N = 0. - rewrite /N /=; apply /rowP; move => a. - rewrite !mxE. - by rewrite subrr. + rewrite /N /=; apply/rowP => j. + by rewrite !mxE subrr. by move => n; rewrite n scaler0 mul0mx. Qed. @@ -883,68 +879,64 @@ Context {K : realType}. Variables alpha1 gamma : K. Hypotheses (alpha1_gt0 : 0 < alpha1) (gamma_gt0 : 0 < gamma). Let phi := Tilt.eqn alpha1 gamma. -Variable Delta : K. +Variable D : K. Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : - is_sol_on0o phi (BLeft Delta) sol -> - t \in `[0, Delta[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). + sol_is_deriv_co (fun=> phi) 0 D sol -> + t \in `[0, D[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. -move=> /= deri /[!inE]/= t0Delta. -have [derivable_sol] := deri _ t0Delta. +move=> /= deri /[!inE]/= t0D. +have [derivable_sol] := deri _ t0D. move=> /(congr1 Left). -rewrite derive1E. -rewrite row_mxKl. -move=> <-. +rewrite derive1E row_mxKl => <-. by rewrite derive_lsubmx. Qed. Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : - is_sol_on0o phi (BLeft Delta) sol -> - z \in `[0, Delta[ -> 'D_1 (Right \o sol) z = + sol_is_deriv_co (fun=> phi) 0 D sol -> + z \in `[0, D[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. Proof. -move=> deriv /[!inE]/= z0Delta. -have [derivable_sol +] := deriv _ z0Delta. +move=> deriv /[!inE]/= z0D. +have [derivable_sol +] := deriv _ z0D. move => /(congr1 Right). -rewrite derive1E. -by rewrite row_mxKr => ?; rewrite derive_rsubmx. +by rewrite derive1E row_mxKr => ?; rewrite derive_rsubmx. Qed. Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : - t \in `[0, Delta[%R -> + t \in `[0, D[%R -> sol 0 \in Tilt.Upsilon1 -> - is_sol_on0o phi (BLeft Delta) sol -> + sol_is_deriv_co (fun=> phi) 0 D sol -> Tilt.Upsilon1 (sol t). Proof. -move=> t0Delta sol0 deriv_sol. -move: t0Delta. +move=> + sol0 deriv_sol. rewrite in_itv/= => /andP[]. -rewrite le_eqVlt => /predU1P[<- Delta0|t0 tDelta]. +rewrite le_eqVlt => /predU1P[<- D0|t0 tD]. exact/set_mem. apply: (@tilt_state_spaceS _ alpha1 gamma) => //=. -exists sol, Delta; split => //=. -exists t; split => //. -by rewrite in_itv/= (ltW t0) tDelta. +exists sol, D; split => //=. +exists t => //. +by rewrite in_itv/= (ltW t0) tD. Qed. Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : - z \in `[0, Delta[%R -> + z \in `[0, D[%R -> sol 0 \in Tilt.Upsilon1 -> - is_sol_on0o phi (BLeft Delta) sol -> `|u|_e = 1. + sol_is_deriv_co (fun=> phi) 0 D sol -> `|u|_e = 1. Proof. -move=> z0Delta sol0 dtraj. +move=> z0D sol0 dtraj. suff: Tilt.Upsilon1 (row_mx (zp1 z) (z2 z)). by rewrite /Tilt.Upsilon1/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. -by apply: is_sol_state_space_tilt => //. +exact: is_sol_state_space_tilt. Qed. -Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) +Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : - z \in `[0, Delta[%R -> + z \in `[0, D[%R -> sol 0 \in Tilt.Upsilon1 -> - is_sol_on0o phi (BLeft Delta) sol -> + sol_is_deriv_co (fun=> phi) 0 D sol -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> z0Delta sol0 dtraj. @@ -967,13 +959,13 @@ by rewrite 2!mulNmx mulmx1 mxE. Qed. Lemma neg_spin (sol : K -> 'rV_6) (z : K) : - z \in `[0, Delta[%R -> + z \in `[0, D[%R -> sol 0 \in Tilt.Upsilon1 -> - is_sol_on0o phi (BLeft Delta) sol -> + sol_is_deriv_co (fun=> phi) 0 D sol -> `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = `|Right (sol z) *m \S('e_2)|_e. Proof. -move=> z0Delta sol0 dtraj. +move=> z0D sol0 dtraj. rewrite mulmxN enormN. pose zp1 := fun r => Left (sol r). pose z2 := fun r => Right (sol r). @@ -995,13 +987,13 @@ Let c2 := 2^-1 / gamma. Lemma V1dotE (z : K) (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol_on0o phi (BLeft Delta) sol -> - z \in `[0, Delta[ -> + sol_is_deriv_co (fun=> phi) 0 D sol -> + z \in `[0, D[ -> V1dot (sol z) = c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + c2 *: (2 *: 'D_1 z2 z *m (Right (sol z))^T) 0 0. Proof. -move=> ? zd. +move=> solP zd. rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC. rewrite mulVf// div1r. @@ -1021,12 +1013,12 @@ by rewrite mulmxA. Qed. Lemma derive_along_V1 t (sol : K -> 'rV_6) : - t \in `]0, Delta[ -> - is_sol_on0o phi (BLeft Delta) sol -> - (forall t, t \in `]0, Delta[ -> differentiable sol t) -> + t \in `]0, D[ -> + sol_is_deriv_co (fun=> phi) 0 D sol -> + (forall t, t \in `]0, D[ -> differentiable sol t) -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. -move=> t0Delta tilt_eqnx dif1. +move=> t0D tilt_eqnx dif1. rewrite /V1 derive_alongD; last 3 first. apply/differentiableM => //=. exact/differentiable_enorm_squared/differentiable_lsubmx_comp. @@ -1046,7 +1038,7 @@ rewrite -fctE /= !derive_along_enorm_squared//=. by rewrite /c1 /c2 !invfM. rewrite /= in tilt_eqnx. exact: tilt_eqnx. -- move: t0Delta. +- move: t0D. by rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. - exact: dif1. - exact/differentiable_lsubmx_comp. @@ -1060,11 +1052,11 @@ Definition u1 (sol : K -> 'rV[K]_6) t Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : sol 0 \in Tilt.Upsilon1 -> - is_sol_on0o phi (BLeft Delta) sol -> - forall t, t \in `[0, Delta[%R -> + sol_is_deriv_co (fun=> phi) 0 D sol -> + forall t, t \in `[0, D[%R -> V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. Proof. -move=> sol0 dtraj z z0Delta. +move=> sol0 solP z z0D. set w := z2 z *m \S('e_2). rewrite /V1dot. rewrite mxE norm_spin mxE addrA expr2 mulmxA. @@ -1077,9 +1069,9 @@ have cauchy : ((w *m - \S('e_2 - z2 z) *d (zp1 z))%:M : 'rV_1) 0 0 <= rewrite -ler_sqr // ; last first. by rewrite nnegrE // mulr_ge0 ?enorm_ge0. by rewrite exprMn sqr_normr (le_trans (CauchySchwarz_rV _ _)) // !dotmulvv. -apply: (@le_trans _ _ (`|w *m - \S('e_2 - z2 z)|_e * `|zp1 z|_e + (- `|zp1 z|_e ^+ 2 - `|w|_e ^+ 2))). - rewrite lerD2r. - rewrite (le_trans _ cauchy) //. +apply: (@le_trans _ _ (`|w *m - \S('e_2 - z2 z)|_e * `|zp1 z|_e + + (- `|zp1 z|_e ^+ 2 - `|w|_e ^+ 2))). + rewrite lerD2r (le_trans _ cauchy)//. by rewrite mxE eqxx mulr1n. rewrite neg_spin /u1 /u2 //. rewrite mxE. @@ -1092,13 +1084,13 @@ by rewrite [leRHS]mulrC. Qed. Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : - is_sol_on0o phi (BLeft Delta) sol -> sol 0 \in Tilt.Upsilon1 -> - t \in `[0, Delta[%R -> + sol_is_deriv_co (fun=> phi) 0 D sol -> + t \in `[0, D[%R -> V1dot (sol t) = 0 -> sol t = Tilt.point1 \/ sol t = Tilt.point2. Proof. -move => solP sol0 t0d V1dsol. +move => sol0 solP t0d V1dsol. have h : u1 sol t = 0. case: (u1 sol t =P 0) => [-> // |/eqP hsol]. have := V1dot_ub sol0 solP t0d. @@ -1141,13 +1133,13 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : - is_sol_on0o phi (BLeft Delta) (sol x) -> sol x 0 = Tilt.point1 -> + sol_is_deriv_co (fun=> phi) 0 D (sol x) -> \forall z \near 0^', ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + 'D~(sol x) (fun x => `|Right x|_e ^+ 2 / (2 * gamma))) z <= 0. Proof. -move=> dtraj traj0. +move=> sol0 solP. rewrite fctE !invfM /=. near=> z. under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. @@ -1184,8 +1176,8 @@ Unshelve. all: try by end_near. Abort. (* NB: should be completed to prove asymptotic stability *) Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - is_sol_on0o phi (BLeft Delta) (sol x) -> sol x 0 = Tilt.point1 -> + sol_is_deriv_co (fun=> phi) 0 D (sol x) -> locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. (* move=> [y033] dy dtraj traj0. *) @@ -1224,23 +1216,23 @@ Abort. Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : - is_sol_on0o phi (BLeft Delta) (sol x) -> sol x 0 \in Tilt.Upsilon1 -> + sol_is_deriv_co (fun=> phi) 0 D (sol x) -> (forall t : K, Tilt.Upsilon1 (sol x t)) -> sol x 0 = Tilt.point1 -> locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. Proof. -move=> solves sol0 state y0. +move=> sol0 solP state y0. split. - rewrite /is_sol_on0o in solves. + rewrite /sol_is_deriv_co in solP. rewrite /= derivative_derive_along_eq0 => //; last first. admit. exact: V1_diff. near=> z0. rewrite derive_along_V1. -- have z00Delta : z0 \in `[0, Delta[%R. +- have z00D : z0 \in `[0, D[%R. admit. - have V1dot_le := V1dot_ub sol0 solves z00Delta => //. + have V1dot_le := V1dot_ub sol0 solP z00D => //. set w := z2 z0 *m \S('e_2). set u1 : 'rV[K]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 z0|_e, 1 |-> `|w|_e] i. @@ -1264,12 +1256,11 @@ rewrite derive_along_V1. admit. - admit. - by []. -- move => t t0Delta. +- move => t t0D. apply/derivable1_diffP => //. - move : solves; rewrite /is_sol_on0o. - move=> deri. - apply deri. - move: t0Delta; rewrite inE/=. + rewrite /sol_is_deriv_co in solP. + apply solP. + move: t0D; rewrite inE/=. by apply: subset_itvr; rewrite bnd_simp. Unshelve. all: by end_near. Abort. @@ -1295,22 +1286,22 @@ split. Qed.*) Abort.*) Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : - is_sol_on0o phi (BLeft Delta) sol -> sol 0 \in Tilt.Upsilon1 -> - (forall t, 0 < t < Delta -> differentiable sol t) -> - forall t : K, 0 < t < Delta -> + sol_is_deriv_co (fun=> phi) 0 D sol -> + (forall t, 0 < t < D -> differentiable sol t) -> + forall t : K, 0 < t < D -> 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. -move=> solves sol0 diff t t0. +move=> sol0 solP diff t t0. rewrite derive_along_V1//; last 2 first. by rewrite inE/= in_itv/=. move=> t1 t10Delta. apply: diff => //. by rewrite inE/= in_itv/= in t10Delta. -have t0Delta : t \in `[0, Delta[%R. +have t0D : t \in `[0, D[%R. rewrite in_itv/=. by move/andP : t0 => [] /ltW -> ->. -have Hub := V1dot_ub sol0 solves t0Delta. +have Hub := V1dot_ub sol0 solP t0D. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> `|(Left \o sol) t|_e, @@ -1341,10 +1332,10 @@ Let c2 := 2^-1 / gamma. (* todo: copy paste *) Lemma derive_zp10 (sol : K -> 'rV_6) : - is_sol_on0y phi sol -> + sol_is_deriv_c0y phi sol -> 'D_1 (Left \o sol) 0 = - alpha1 *: Left (sol 0). Proof. -move/is_sol_on0yP. +move/sol_is_deriv_c0yP. move/(_ _ (lexx 0)) => [d0 +]. move=> /(congr1 Left). rewrite derive1E. @@ -1354,11 +1345,11 @@ by rewrite derive_lsubmx. Qed. Lemma derive_z20 (sol : K -> 'rV_6) : - is_sol_on0y phi sol -> + sol_is_deriv_c0y phi sol -> 'D_1 (Right \o sol) 0 = gamma *: (Right (sol 0) - Left (sol 0)) *m \S('e_2 - Right (sol 0)) ^+ 2. Proof. -move/is_sol_on0yP. +move/sol_is_deriv_c0yP. move /(_ _ (lexx 0)) => [d0 +]. move => /(congr1 Right). rewrite derive1E. @@ -1366,7 +1357,7 @@ by rewrite row_mxKr => ?; rewrite derive_rsubmx. Qed. Lemma V1dotE0 (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - is_sol_on0y phi sol -> + sol_is_deriv_c0y phi sol -> V1dot (sol 0) = c1 *: (2 *: 'D_1 zp1 0 *m (Left (sol 0))^T) 0 0 + c2 *: (2 *: 'D_1 z2 0 *m (Right (sol 0))^T) 0 0. @@ -1392,14 +1383,14 @@ Qed. Lemma derive_along_V1_global t (sol : K -> 'rV_6) : 0 <= t -> - is_sol_on0y phi sol -> + sol_is_deriv_c0y phi sol -> 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0 tilt_eqnx. have dif1 : forall (t : K), 0 <= t -> differentiable sol t. move => /= t' t'0. apply/derivable1_diffP. - move/is_sol_on0yP in tilt_eqnx. + move/sol_is_deriv_c0yP in tilt_eqnx. by apply tilt_eqnx. rewrite /V1 derive_alongD; last 3 first. apply/differentiableM => //=. @@ -1416,33 +1407,33 @@ rewrite derive_alongMl => //; last first. exact: dif1. exact/differentiable_enorm_squared/differentiable_rsubmx_comp. rewrite -fctE /= !derive_along_enorm_squared//=; last 3 first. - exact:dif1. + exact: dif1. exact/differentiable_lsubmx_comp. - exact:dif1. + exact: dif1. move: t0; rewrite le_eqVlt => /predU1P[<-//|t0]. by rewrite V1dotE0// !invfM. -rewrite (V1dotE alpha1_gt0 gamma_gt0 (@global_sol_sol _ _ _ _ tilt_eqnx (BLeft (t + 1)))) //. +rewrite (V1dotE alpha1_gt0 gamma_gt0 (@sol_is_deriv_c0yco _ _ _ _ tilt_eqnx (t + 1))) //. by rewrite !invfM. by rewrite inE/= in_itv/= (ltW t0) ltrDl; apply /andP. Qed. Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : - is_sol_on0y phi sol -> sol 0 \in Tilt.Upsilon1 -> + sol_is_deriv_c0y phi sol -> forall t : K, 0 <= t -> 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. -move=> solves sol0. +move=> sol0 solves. have diff : forall (t : K), 0 <= t -> differentiable sol t. move => /= t' t0'. apply/derivable1_diffP. - move/is_sol_on0yP in solves. + move/sol_is_deriv_c0yP in solves. by apply solves. move => t t0. rewrite derive_along_V1_global//. have t0Delta : t \in `[0, t+1[%R. by rewrite in_itv/=t0 ltrDl ltr01. -have Hub := V1dot_ub sol0 (@global_sol_sol _ _ _ _ solves (BLeft (t + 1))) t0Delta. +have Hub := V1dot_ub sol0 (@sol_is_deriv_c0yco _ _ _ _ solves (t + 1)) t0Delta. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> `|(Left \o sol) t|_e, @@ -1464,8 +1455,7 @@ End tilt_eqn_Lyapunov_global. Section equilibrium_zero_stable. Context {K : realType}. Variables gamma alpha1 : K. -Hypothesis gamma_gt0 : 0 < gamma. -Hypothesis alpha1_gt0 : 0 < alpha1. +Hypotheses (gamma_gt0 : 0 < gamma) (alpha1_gt0 : 0 < alpha1). Let phi := Tilt.eqn alpha1 gamma. Variable Init : set 'rV[K]_6. @@ -1480,23 +1470,23 @@ apply: (@Lyapunov_stability0 K _ phi Init openInit (V1 alpha1 gamma)). apply: (@derive_along_V1_le0 _ _ _ _ _ Delta sol). + assumption. + assumption. - + assumption. + rewrite inE. apply: Init_in_state. by rewrite inE in sol0. + + exact: solP. + move=> /= t1 t10Delta. apply/derivable1_diffP. apply solP. rewrite in_itv/=. by case/andP : t10Delta => /ltW -> ->. - + assumption. + + exact: t0. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. rewrite /is_Lyapunov_candidate /Tilt.point1 => Hpos. rewrite /V1 lsubmx_const rsubmx_const; split => //. split. by rewrite !expr2 !enorm0 !mulr0 !mul0r add0r. move=> z zin z_neq0. - case : Hpos => // _ [V1_eq0 V1_gt0]. + case: Hpos => // _ [V1_eq0 V1_gt0]. apply: V1_gt0 => //. by rewrite inE. Qed. diff --git a/tilt_robot.v b/tilt_robot.v index 26015119..57ecd920 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -451,4 +451,3 @@ apply : (@le_trans _ _ (\sum_(i0 < n.+1) `|x| ^+ 2)). exact: (le_bigmax _ _ (ord0, k)). by rewrite big_const_ord mulr_natl iter_addr_0. Qed. - diff --git a/tilt_stability.v b/tilt_stability.v index 35d4d559..077d873c 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -178,22 +178,20 @@ Context {K : realType} {n : nat}. Let U := 'rV[K]_n. Variable phi : U -> U. -Definition is_sol_on0o (Delta : itv_bound K) (f : K -> U) := - {in Interval (BLeft 0) Delta, forall t, derivable f t 1 /\ f^`() t = phi (f t)}. -(* NB: (BLeft Delta) -> open on right *) - -Lemma is_sol_on0oP (Delta : K) (f : K -> U) (e : {posnum K} ) : - is_sol_on (fun=> phi) (f (- e%:num)) (- e%:num) (BLeft Delta) f -> - is_sol_on0o (BLeft Delta) f. +Lemma sol_is_deriv_c0oP (D : K) (f : K -> U) (e : {posnum K} ) : + is_sol_oo (fun=> phi) (f (- e%:num)) (- e%:num) D f -> + sol_is_deriv_co (fun=> phi) 0 D f. Proof. -by move=> [_ H cf] t t0D; apply H; rewrite inE/=; apply: subset_itv t0D; rewrite bnd_simp. +move=> [_ H cf] t t0D; apply H; rewrite inE/=; apply: subset_itv t0D => //. +by rewrite bnd_simp. Qed. (* "global" solution *) -Definition is_sol_on0y (f : K -> U) := is_sol_on0o (BInfty K false) f. +Definition sol_is_deriv_c0y (f : K -> U) := + sol_is_deriv_cbnd (fun=> phi) 0 (BInfty K false) f. (* TODO: generalize this lemma *) -Lemma is_sol_on0yP (f : K -> U) : is_sol_on0o (BInfty K false) f <-> +Lemma sol_is_deriv_c0yP (f : K -> U) : sol_is_deriv_c0y f <-> forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). Proof. split=> H t t0oo; apply: H. @@ -201,11 +199,12 @@ split=> H t t0oo; apply: H. by move: t0oo; rewrite in_itv/= andbT. Qed. -Lemma global_sol_sol f : is_sol_on0y f -> forall Delta, is_sol_on0o Delta f. +Lemma sol_is_deriv_c0yco f : sol_is_deriv_c0y f -> + forall D, sol_is_deriv_co (fun=> phi) 0 D f. Proof. -move=> + Delta t t0D. +move=> + D t t0D. apply. -by move: t0D;rewrite !in_itv/= => /andP[->]. +by move: t0D; rewrite !in_itv/= => /andP[->]. Qed. End ode. @@ -216,11 +215,11 @@ Let U := 'rV[K]_n. Variables (phi : U -> U) (Delta : K). (* TODO: rm? *) -(*Lemma is_sol_on0oS (A B : set U) : A `<=` B -> - is_sol_on0o phi Delta A `<=` is_sol_on0o phi Delta B. +(*Lemma sol_is_derive_0oS (A B : set U) : A `<=` B -> + sol_is_derive_0o phi Delta A `<=` sol_is_derive_0o phi Delta B. Proof. move=> AB f. -rewrite /is_sol_on0o inE => -[inD0 [_ deri cont]]; rewrite inE. +rewrite /sol_is_derive_0o inE => -[inD0 [_ deri cont]]; rewrite inE. split => //. by apply: AB. Qed. @@ -233,8 +232,8 @@ Let T := 'rV[K]_n. Variable phi : T -> T. Definition state_space (Init : set T) : set T := - [set x | exists f Delta, [/\ f 0 \in Init, is_sol_on0o phi (BLeft Delta) f & - (exists t, t \in `[0, Delta[%R /\ x = f t) ]]. + [set x | exists f D, [/\ f 0 \in Init, sol_is_deriv_co (fun=> phi) 0 D f & + exists2 t, t \in `[0, D[%R & x = f t]]. End state_space. @@ -244,14 +243,14 @@ Let T := 'rV[K]_n. Variable phi : T -> T. Definition is_equilibrium_point (Init : set T) (x : T) := - x \in Init /\ forall d, is_sol_on0o phi d (cst x). + x \in Init /\ forall d, sol_is_deriv_co (fun=> phi) 0 d (cst x). Lemma equilibrium_point_in_state_space (Init : set T) : is_equilibrium_point Init `<=` state_space phi Init. Proof. move=> x [xinit solf]. exists (cst x), 1; split => //. -exists 0; split =>//. +exists 0 => //. by rewrite bound_itvE ltr01. Qed. @@ -261,7 +260,9 @@ Lemma equilibrium_points_subset (A B : set T) : A `<=` B -> equilibrium_points A `<=` equilibrium_points B. Proof. move=> AB x. -rewrite /equilibrium_points/= /is_equilibrium_point /is_sol_on0o inE => -[Ax H]. +rewrite /equilibrium_points/= /is_equilibrium_point. +rewrite /sol_is_deriv_co. +rewrite inE => -[Ax H]. split. exact/mem_set/AB. move=> d t t0d. @@ -279,13 +280,13 @@ Variable Init : set T. Definition is_locally_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n) (D : K), f 0 \in Init /\ is_sol_on0o phi (BLeft D) f -> + forall f D, f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> `| f 0 - x | < d -> forall t, 0 < t < D -> `| f t - x | < eps. (* assuming solution exists for all time *) Definition is_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & - forall (f : K -> 'rV[K]_n), f 0 \in Init /\ is_sol_on0y phi f -> + forall f, f 0 \in Init -> sol_is_deriv_c0y phi f -> `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. Lemma locally_stable_stable : is_locally_stable_at `<=` is_stable_at. @@ -293,7 +294,7 @@ Proof. move=> x H e /H [d d0 stable]. exists d => // z [z0Init zglob] zd /= t t0. apply: (stable _ (t + 1)) => //. - by split => //; exact: global_sol_sol. + exact: sol_is_deriv_c0yco. by rewrite t0/= ltrDl. Qed. @@ -521,7 +522,7 @@ Proof. by move=> r0; rewrite /B -closed_ballE. Qed. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. Hypothesis DV_le0 : forall D f, f 0 \in Init -> - is_sol_on0o phi (BLeft D) f -> + sol_is_deriv_co (fun=> phi) 0 D f -> forall t, 0 < t < D -> 'D~(f) V t <= 0. (* khalil theorem 4.1 *) @@ -577,7 +578,7 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. by have := lt_le_trans beta_alpha (le_trans alphaVy Vybeta); rewrite ltxx. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) -have Df_Omega_beta D f : f 0 \in Init -> is_sol_on0o phi (BLeft D) f -> +have Df_Omega_beta D f : f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> f 0 \in Omega_beta -> forall t, 0 < t < D -> f t \in Omega_beta. move=> f0 solf f0_Omega. have /= V_nincr_consequence t : 0 < t < D -> forall u, 0 <= u <= t -> @@ -694,17 +695,14 @@ Let U := 'rV[K]_n.+1. Variable phi : U -> U. Variable Init : set U. -Lemma is_sol_on0o_substitution Delta f x : - is_sol_on0o phi (BLeft Delta) f -> - is_sol_on0o (fun y : 'rV_n.+1 => phi (y + x)) - (BLeft Delta) (f \- cst x). +Lemma sol_is_deriv_co_substitution D f x : + sol_is_deriv_co (fun=> phi) 0 D f -> + sol_is_deriv_co (fun _ y => phi (y + x)) 0 D (f \- cst x). Proof. -rewrite /is_sol_on0o => /= H t t0Delta; split. +rewrite /sol_is_deriv_co => /= H t t0Delta; split. apply: derivableB => //. by apply H. -rewrite subrK. -rewrite derive1E deriveB//; last first. - by apply H. +rewrite subrK derive1E deriveB//; last by apply H. by rewrite derive_cst subr0 -derive1E; apply H. Qed. @@ -718,11 +716,10 @@ have [/= d d0 {}H] := H _ e0. exists d => // f Delta [f0Init solf] f0xd t t0. rewrite -[_ - _]subr0. rewrite -[f t - x]/((f \- cst x) t). -apply: (H _ Delta) => //; last first. - by rewrite /= subr0. -split. - exact/image_f. -exact: is_sol_on0o_substitution. +apply: (H _ Delta) => //. +- exact/image_f. +- exact: sol_is_deriv_co_substitution. +- by rewrite /= subr0. Qed. Lemma is_equilibrium_point_substitutionP x : @@ -778,13 +775,13 @@ Context {K : realType} {n : nat}. Let U := 'rV[K]_n.+1. Variable phi : U -> U. Variable Init : set U. -Hypothesis openInit : open Init. (* Init est forcement un ouvert *) +Hypothesis openInit : open Init. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall Delta (sol : K -> U), - is_sol_on0o phi (BLeft Delta) sol -> - forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. +Hypothesis V'_le0 : forall D (sol : K -> U), + sol_is_deriv_co (fun=> phi) 0 D sol -> + forall t, 0 < t < D -> 'D~(sol) V t <= 0. Theorem Lyapunov_stability : is_Lyapunov_candidate V Init `<=` is_locally_stable_at phi Init. @@ -810,7 +807,7 @@ apply: (@Lyapunov_stability0 _ _ _ _ _ (fun y => V (y + x))). apply sol0Init. rewrite in_itv/=. by move/andP : t0Delta => [/ltW-> ->]. - have -> : (fun y : 'rV_n.+1 => V (y + x)) \o sol = [eta V] \o (+%R^~ (x) \o sol). + have -> : (fun y => V (y + x)) \o sol = V \o (+%R^~ x \o sol). exact/funext. rewrite derive_along_derive; last 2 first. exact: differentiable_comp. From bb01ca78a5e9419243f3f10c15aaedfffb46fd98 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Tue, 17 Feb 2026 20:18:27 +0900 Subject: [PATCH 119/144] minor cleanup --- _CoqProject | 1 - ode.v | 584 ++++++++++++++++++++++++++++++++++++++++------- ode_autonomous.v | 559 --------------------------------------------- 3 files changed, 499 insertions(+), 645 deletions(-) delete mode 100644 ode_autonomous.v diff --git a/_CoqProject b/_CoqProject index bcd47ee0..ae927bfe 100644 --- a/_CoqProject +++ b/_CoqProject @@ -20,7 +20,6 @@ extra_trigo.v ode_common.v ode_contfun.v ode.v -ode_autonomous.v lasalle.v pendulum.v tilt_mathcomp.v diff --git a/ode.v b/ode.v index 6866144a..3d8157dc 100644 --- a/ode.v +++ b/ode.v @@ -1795,8 +1795,8 @@ apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. Qed. Lemma solution_stays_in_ball : - {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (local_solution t)}. -Proof. by move=> t; rewrite inE => /cauchy_lipschitz_in_cball; exact. Qed. + {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (local_solution t)}. +Proof. by move=> t; move => /cauchy_lipschitz_in_cball; exact. Qed. Lemma solution_continuous : {within `[a, a + safe_dist], continuous local_solution}. @@ -1811,7 +1811,7 @@ Let f := cauchy_lipschitz_local_f. Theorem cauchy_lipschitz_local : safe_dist > 0 /\ is_sol_oo phi u0 a (a + safe_dist) f /\ - {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (f t)}. + {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (f t)}. Proof. split; first exact: safe_dist_gt0. split. @@ -2008,104 +2008,53 @@ Qed. End closure_neitv. -Section picard_autonomous. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables (phi : U -> U) (k : R) (u0 : U) (r : {posnum R}). -Hypothesis k0 : 0 < k. -Let B := closed_ball u0 r%:num. -Hypothesis lip2 : k.-lipschitz_B phi. - -Definition phi_ (t : R) x := phi x. - -Lemma phi_lip2 a b: {in `[a, b]%R, forall x, k.-lipschitz_B (phi_ x)}. -Proof. by move => x abx; exact: lip2. Qed. - -Lemma phi_cont1 a b : {in B, forall y, {within `[a, b], continuous phi_ ^~ y}}. -Proof. by move => /= x Bx; exact: cst_continuous_subspace. Qed. - -Let rho : {posnum R} := (2^-1)%:pos. - -Let rho1 : rho%:num < 1. -Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. - -Theorem cauchy_lipschitz_autonomous a : exists f D, - D > 0 /\ is_sol_oo (phi_) u0 a (a + D) f /\ - {in `[a, a + D], forall t, closed_ball u0 r%:num (f t)}. -Proof. -have aa1 : a < a + 1 by rewrite ltrDl. -have [d0 [solf cball]] := - cauchy_lipschitz_local aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho1. -exists (@cauchy_lipschitz_local_f R n phi_ a _ k u0 r aa1 k0 - (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho rho1). -by exists (safe_dist phi_ a (a + 1) k u0 r rho). -Qed. - -End picard_autonomous. - -Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := - forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. - -Section locally_lipschitz. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables phi : U -> U. - -Hypothesis phi_locally_lipschitz : locally_lipschitz phi. - -Theorem cauchy_lipschitz_ll u0 a : exists f D r, - D > 0 /\ is_sol_oo (fun=> phi) u0 a (a + D) f /\ - {in `[a, a + D], forall t, closed_ball u0 r (f t)}. -Proof. -have [/= r [k lip]] := phi_locally_lipschitz u0. -have [//|f [D [D_gt0 [solf cball]]]] := cauchy_lipschitz_autonomous _ lip a. -by exists f, D, r%:num. -Qed. - -End locally_lipschitz. Section uniqueness. Context {R : realType} {n : nat} (a b : R). Notation U := 'rV[R]_n. -Variable phi : U -> U. +Variable phi : R -> U -> U. Hypothesis ab : a < b. -Hypothesis phi_locally_lipschitz : locally_lipschitz phi. - -Variables (u0 : U) (f : R -> U) (f' : R -> U). -Hypothesis sol1 : is_sol_oo (fun=> phi) u0 a b f. -Hypothesis sol2 : is_sol_oo (fun=> phi) u0 a b f'. - +Variables (u0 : U). +Hypothesis cont1 : forall y, {within `[a, b], continuous phi ^~ y}. +Hypothesis phi_loclip : + forall x, exists r k : {posnum R}, + forall t, k%:num.-lipschitz_(closed_ball x r%:num) (phi t). +Variables (f : R -> U) (f' : R -> U). +Hypothesis sol1 : is_sol_oo phi u0 a b f. +Hypothesis sol2 : is_sol_oo phi u0 a b f'. Lemma locally_unique_extends t : a <= t < b -> f' t = f t -> - exists D : {posnum R}, {in `[t, t + D%:num]%R, f =1 f'}. + exists Delta : {posnum R}, {in `[t, t + Delta%:num]%R, f =1 f'}. Proof. move=> /andP[ta tb] eq. +have [r [k L]] := phi_loclip (f t). have taab : `[t, b] `<=` `[a, b]. by move=> ?/=; apply: subset_itvr; rewrite bnd_simp. -have [r [k L]] := phi_locally_lipschitz (f t). have cf0 : {within `[t, b], continuous f}. have := And33 sol1. rewrite closure_neitv_oo//; exact: continuous_subspaceW. have cf'0 : {within `[t, b], continuous f'}. have := And33 sol2. by rewrite closure_neitv_oo//; exact: continuous_subspaceW. -have sol10 : is_sol_oo (fun=> phi) (f t) t b f. +have sol10 : is_sol_oo phi (f t) t b f. split => //; last by rewrite closure_neitv_oo. move=> t0 tab. apply sol1. by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. -have sol20 : is_sol_oo (fun=> phi) (f t) t b f'. +have sol20 : is_sol_oo phi (f t) t b f'. split => //; last by rewrite closure_neitv_oo. move=> t0 tab. apply sol2. by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. -have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) phi}. - by move => ? _; apply L. +have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) (phi x)}. + by move => t0 _;apply L. +have cont1' : {in closed_ball (f t) r%:num, + forall y : 'rV_n, {within `[t, b], continuous phi^~ y}}. + move => y ytb. + apply /continuous_subspaceW/cont1. + by apply subset_itvr. have k0 : 0 < k%:num by []. -have cont1 : {in closed_ball (f t) r%:num, - forall y : 'rV_n, {within `[t, b], continuous fun=> phi y}}. - by move => y _; exact: cst_continuous_subspace. -have [D [P1 P2]] := initial_solution_unique tb k0 lip20 cont1 cf0 sol10 cf'0 sol20. +have [D [P1 P2]] := initial_solution_unique tb k0 lip20 cont1' cf0 sol10 cf'0 sol20. by exists D. Qed. @@ -2115,7 +2064,7 @@ set E := [set t | t \in `[a, b]%R /\ {in `[a, t]%R, f =1 f'}]. suff : E b by case. have Enonempty : E !=set0. exists a; split; first by rewrite in_itv/= lexx ltW. - move=> t; rewrite in_itv/= -eq_le => /eqP <-. + move => t; rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). have mon c : E c -> forall c', a <= c' <= c -> E c'. move=> -[+ h c'] /andP[ac' cc']. @@ -2180,15 +2129,15 @@ have Eclosed : closed E. have g0x : g x > 0. rewrite normr_gt0 subr_eq0. by apply/eqP; case: Et. - have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t]%R, f =1 f'}. + have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t]%R, f =1 f'}. move => tab gt Et'. move : gt. suff -> : g t = 0 by rewrite ltxx. apply/normr0P. rewrite Et' ?subrr//. by move: tab; rewrite !in_itv/= lexx => /andP[->]. - suff hgx : \forall y \near x^'-, 0 < g y. - near=> y. + suff hgx: \forall y \near x^'-, 0 < g y. + near=>y. have [yx|xy Ey] := ltP y x; last first. have := mon _ Ey x. move: xab. @@ -2203,7 +2152,7 @@ have Eclosed : closed E. apply: contra_notN Ex1. move: xab; rewrite in_itv/= => /andP[+ _] ax. move/(conj ax) => /andP; rewrite -eq_le => /eqP ->. - move=> y; rewrite in_itv/= -eq_le => /eqP <-. + move => t; rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). have /(continuous_within_itvP _ ab) := contg => -[h1 _ h2]. move: xab; rewrite in_itv/= => /andP[_ ]. @@ -2219,10 +2168,10 @@ have Eclosed : closed E. rewrite not_andP. right. move=> /(_ t). - case: Et; rewrite !in_itv/= => /andP[-> _/=]. + case: Et; rewrite !in_itv/= => /andP[-> _/=]. by rewrite lexx => /[swap] => /(_ isT). have ta : a <= t. - by case: Et; rewrite in_itv/= => /andP[]. + by case: Et; rewrite in_itv/= => /andP[]. move/(monC y t ta Ey). apply/negP; rewrite -leNgt. by near: y; exact: nbhs_ge. @@ -2233,12 +2182,11 @@ have supE : E (sup E). have sup_itv : a <= sup E. apply sup_upper_bound => //. split; first by rewrite in_itv/= lexx ltW. - move=> t. - rewrite in_itv/= -eq_le => /eqP <-. + move => t; rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). have supeq : f' (sup E) = f (sup E). apply/esym; apply supE. - by rewrite in_itv/= lexx sup_itv. + by rewrite in_itv/= lexx sup_itv. have [h|h] := leP b (sup E). apply: (mon _ supE) => //. by rewrite (ltW ab). @@ -2259,3 +2207,469 @@ by apply: Hdelta; rewrite in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. Unshelve. all: by end_near. Qed. End uniqueness. + +Section picard_symmetric. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (k : R) (u0 : U) (r : {posnum R}) (a b : R). +Hypothesis k0 : 0 < k. +Let B := closed_ball u0 r%:num. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. +Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. +Definition phi_ (t : R) x := phi x. + +Definition is_sol_sym u0 t0 d (sol : R -> U):= + sol t0 = u0 /\ sol_is_deriv_oo phi (t0-d) (t0+d) sol. + +Let phi_lip2 t0: t0 \in `[a,b]%R -> {in `[t0, b]%R, forall x, k.-lipschitz_B (phi x)}. +Proof. +move => tab x abx; apply: lip2. +move : abx; rewrite !inE/=; apply subset_itvr. +by move : tab; rewrite in_itv/= bnd_simp => /andP[-> _]. +Qed. + +Let phi_cont1 t0 : t0 \in `[a,b]%R -> {in B, forall y, {within `[t0, b], continuous phi ^~ y}}. +Proof. +move => /= tab x Bx. +apply /continuous_subspaceW/cont1 => //. +apply: subset_itvr. +by move : tab; rewrite in_itv/= bnd_simp => /andP[-> _]. +Qed. + + +Let rho : {posnum R} := (2^-1)%:pos. + +Let rho1 : rho%:num < 1. +Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. + +Let cauchy_lipschitz_fwd t0 : t0 \in `]a,b[%R -> exists f delta, + delta > 0 /\ is_sol_oo (phi) u0 t0 (t0 + delta) f /\ + {in `[t0, t0 + delta]%R, forall t, closed_ball u0 r%:num (f t)}. +Proof. +rewrite /=in_itv/= => /andP[t0a t0b]. +have tab : t0 \in `[a,b]%R. + by rewrite in_itv/= !ltW. +have [d0 [solf cball]] := + cauchy_lipschitz_local t0b k0 (phi_lip2 tab) (phi_cont1 tab) rho1. +exists (@cauchy_lipschitz_local_f R n phi t0 _ k u0 r t0b k0 + (phi_lip2 tab) (phi_cont1 tab) rho rho1). +by exists (safe_dist phi t0 b k u0 r rho). +Qed. + +Lemma patch_in {X : Type} (f g : R -> X) S x : x \in S -> patch f S g x = g x. +Proof. + move => xs. + rewrite /patch. + by rewrite xs. +Qed. + + +Lemma closed_ball_split (x1 x2 y :U) q : 0 < q -> closed_ball x1 (q/2) y -> closed_ball x2 (q/2) x1 -> closed_ball x2 q y. +Proof. + move => hq. + have hq2: (0 < q /2). + by rewrite divr_gt0. + rewrite !closed_ballE// /closed_ball_ /=. + move => h1 h2. + rewrite -(subrKA x1 x2). + by apply: (le_trans (ler_normD _ _)); rewrite (splitr q) lerD//. +Qed. + +(*todo : move or PR? *) +Lemma within_continuous_minus (f : R -> U) (c d : R) : + {within `[-d,-c], continuous f} -> {within `[c,d], continuous f \o -%R}. +Proof. +have [ab|ba _ |-> _] := ltgtP c d; last 2 first. + by rewrite set_itv_ge ?bnd_simp -?ltNge//; exact: continuous_subspace0. + by rewrite set_itv1; exact: continuous_subspace1. +move/continuous_within_itvP; rewrite ltrN2 => /(_ ab)[cf fb fa]. +apply/(continuous_within_itvP _ ab); split. +- move=> t tab. + apply: (@cvg_comp _ _ _ -%R f); first exact: oppr_continuous. + by apply: cf; rewrite oppr_itvoo !opprK. +- by rewrite -{1}(opprK c); apply/cvg_at_leftNP; exact: fa. +- by rewrite -{1}(opprK d); apply/cvg_at_rightNP; exact: fb. +Qed. + +Let phi_lip2' t0 : t0 \in `[a,b] -> {in `[-t0, -a]%R, forall x, k.-lipschitz_B (-phi (-x))}. +Proof. +move => t0ab /= y ab x B12. +rewrite /= -normrN opprD !opprK. +apply: (lip2 _ B12). +move : ab. +rewrite !in_itv/= lerNl lerNr => /andP[h1 ->]//=. +apply (le_trans h1). +move : t0ab. +by rewrite inE/=in_itv/= => /andP[]. +Qed. + +Local Lemma phi_cont1' t0 : t0 \in `[a,b] -> {in B, forall y, {within `[-t0, -a], continuous -(fun t => phi (-t) y)}}. +Proof. +move => t0ab /= y By. +move => t. +apply: continuousN. +have /within_continuous_minus : {within `[-(-a), - (-t0)], continuous phi^~ y}. + rewrite !opprK. + apply /continuous_subspaceW/cont1 => //. + apply : subset_itvl. + by move: t0ab; rewrite inE/=in_itv/= bnd_simp => /andP[]. +apply. +Qed. + +Lemma cauchy_lipschitz_sym t0 : t0 \in `]a,b[%R -> exists f delta, delta > 0 /\ is_sol_sym u0 t0 delta f. +Proof. +move => t0ab. +have t0ab' : t0 \in `[a,b]. + by rewrite inE;apply: subset_itv_oo_cc. +have [fplus [dplus [dplus0 [solplus cplus]]]] := cauchy_lipschitz_fwd t0ab. +have amin1 : -t0 < -a. + rewrite ltrNr opprK. + by move : t0ab; rewrite in_itv/= => /andP[]. +have [dminus0 [solminus cminus]] := + cauchy_lipschitz_local amin1 k0 + (phi_lip2' t0ab') (phi_cont1' t0ab') rho1. + +set fminus0 := + @cauchy_lipschitz_local_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r + amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho rho1. +set dminus := safe_dist (fun t x => - phi (-t) x) (-t0) (-a) k u0 r rho. +set fminus := fminus0 \o -%R. +set r2 := (r%:num/2)%:pos. +set r4 := (r%:num/4)%:pos. +have ler4 : r4%:num <= r%:num. + by rewrite /r4/= ler_pdivrMr // ler_pMr // lerDl. +have ler42 : r4%:num <= r2%:num. + by rewrite /r4/r2/= ler_pdivrMr// -mulrA ler_pMr // ler_pdivlMl // mulr1 lerD // lerDl. +have adplus : t0 < t0 + dplus by rewrite ltrDl dplus0. +have cfplus := And33 solplus. +rewrite closure_neitv_oo in cfplus; last by rewrite ltrDl. +have [rpos hropos] := ode.continuous_confined (a:=t0) (b:=t0 + dplus) (u0:=u0) r4 adplus cfplus (And31 solplus). +have amind : -t0 < -t0 + dminus by rewrite ltrDl dminus0. +have cfminus' := And33 solminus. +rewrite closure_neitv_oo in cfminus'; last by rewrite ltrDl. +have cfminus : {within `[t0-dminus, t0], continuous fminus}. + rewrite /fminus. + apply: within_continuous_minus. + apply /continuous_subspaceW/cfminus'. + apply: subset_itvl. + rewrite -/dminus. + by rewrite bnd_simp/= opprD opprK. +have [rneg hrneg] := ode.continuous_confined (a:=-t0) (b:=-t0 + dminus) (u0:=u0) r4 amind cfminus' (And31 solminus). +set dboth := Num.min (b-t0) (Num.min dplus (Num.min dminus (Num.min rneg%:num rpos%:num))). +have dboth0 : 0 < dboth. + rewrite lt_min; apply /andP;split; last by rewrite lt_min dplus0 //= lt_min dminus0 //=. + rewrite subr_gt0. + move : t0ab. + by rewrite in_itv/= => /andP[]. +pose f := patch fplus `[t0 - dboth, t0] fminus. +set uneg := f (t0 - dboth). +have Buneg : closed_ball uneg (r%:num/2) `<=` closed_ball u0 r%:num. + rewrite /uneg/f patch_in/f/=;last first. + by rewrite inE/=in_itv/= gerBl lexx ltW. + move => /=x xb. + apply: (closed_ball_split _ xb) => //. + suff : fminus (t0 - dboth) \in closed_ball u0 (r%:num/4). + rewrite !inE. + apply le_closed_ball. + rewrite ler_pdivrMr//= -mulrA /=ler_peMr//. + by rewrite ler_pdivlMl //= mulr1 ltW // ler_ltD //= ltrDl. + apply hrneg. + rewrite inE/=in_itv/= opprB lerDr ltW //= addrC lerD //. + by rewrite /dboth ge_min; do 3 (apply /orP; right; rewrite ge_min);apply /orP;left. +have f01intersect : fminus t0 = fplus t0. + by rewrite /fminus/= (And31 solminus) (And31 solplus). +have fa : f t0 = u0. + rewrite /f patch_in /fminus /=. + apply solminus. + by rewrite inE/=in_itv/= lexx gerBl ltW. +set B' := closed_ball uneg (r2%:num). +have lip2' : {in `[t0-dboth,t0+dboth], forall x, k.-lipschitz_B' (phi x)}. + move => /= t tab [x1 x2] [Bx1 Bx2]. + apply lip2 => //. + move : tab. + rewrite mem_setE. + apply: subset_itv; rewrite bnd_simp. + rewrite lerBrDl -lerBrDr. + by rewrite !ge_min opprK (addrC t0) lexx /= !orbT. + rewrite -lerBrDl. + by rewrite !ge_min lexx. + by split;apply Buneg. +have contf_minus : {within `[t0 - dboth, t0], continuous fminus}. + apply /continuous_subspaceW/cfminus. + apply: subset_itvr. + by rewrite bnd_simp /= lerD //= lerNr opprK 3!ge_min lexx !orbT. +have contf_plus : {within `[t0, t0+dboth], continuous fplus}. + apply /continuous_subspaceW/cfplus. + apply: subset_itvl. + by rewrite bnd_simp /= lerD //= 3!ge_min lexx !orbT. +have contf : {within `[t0 - dboth, (t0 + dboth)%E], continuous f}. + apply : within_continuous_patch => //. + by rewrite gtrBl. + by rewrite ltrDl. +have r42 : r4%:num = (r2%:num / 2). + rewrite /r4/r2/=. + rewrite -mulrA. + apply congr2 => //. + by rewrite -invfM -natrM. +have fc : {in `[t0-dboth, (t0 + dboth)], forall t : R, closed_ball (fminus (t0 - dboth)) r2%:num (f t)}. + move => t tad. + rewrite /f/=/patch/=. + have : (closed_ball (fminus (t0-dboth)) (r4%:num)) u0. + suff: (fminus (t0-dboth)) \in closed_ball u0 (r4%:num). + by rewrite inE/= !closed_ballE/closed_ball_/= // distrC . + apply: hrneg. + rewrite !inE/=!in_itv/= lerNr lerNl opprD !opprK gerBl ltW //= lerB //. + by rewrite !ge_min lexx !orbT. + rewrite r42. + move => c1. + case : ifP => ht. + - have : (fminus t) \in closed_ball u0 (r4%:num). + apply: hrneg. + move : ht. + rewrite !inE/=!in_itv/= lerNr lerNl opprD !opprK => /andP[h1 ->//=]. + apply: (le_trans _ h1). + rewrite lerB //. + by rewrite !ge_min lexx !orbT. + rewrite inE. + rewrite !r42. + move => c2. + apply: (closed_ball_split _ c2) =>//. + - have : (fplus t) \in closed_ball u0 (r4%:num). + have ht' : t \in `[t0, t0 + dboth]. + have := tad. + rewrite !inE /=!in_itv/= => /andP[h1 ->]; apply /andP; split => //. + have [hat | hat] := lerP t0 t => //. + rewrite -ht. + by rewrite inE/=in_itv/= h1//= ltW. + apply: hropos. + move : ht'. + rewrite !inE/= !in_itv/= => /andP[-> h1//=]. + apply: (le_trans h1). + rewrite lerD //. + by rewrite !ge_min lexx !orbT. + rewrite inE. + rewrite !r42. + move => c2. + apply: (closed_ball_split _ c2) =>//. +exists f, dboth. +split => //. +suff h: is_sol_oo phi (f (t0-dboth)) (t0-dboth) (t0+dboth) f. + by split => //;apply:(And32 h). +have kn0 : k != 0 by apply lt0r_neq0. +apply /(integral_sol_iff_sol (r := r2) kn0) => //. + by rewrite ler_ltD // gtrN. + move => t tab /= x Bx. + apply: lip2. + move : tab. + apply: subset_itv; rewrite bnd_simp. + rewrite lerBrDl -lerBrDr. + by rewrite !ge_min opprK (addrC t0) lexx /= !orbT. + rewrite -lerBrDl. + by rewrite !ge_min lexx. + split. + apply Buneg. + by apply: Bx.1. + apply Buneg. + by apply: Bx.2. + move => t tab. + apply /continuous_subspaceW/cont1. + apply: subset_itv; rewrite bnd_simp. + rewrite lerBrDl -lerBrDr. + by rewrite !ge_min opprK (addrC t0) lexx /= !orbT. + rewrite -lerBrDl. + by rewrite !ge_min lexx. + apply mem_set. + apply Buneg. + by apply set_mem. + move => _ [t tp] <-. + rewrite {1}/f patch_in;last first. + by rewrite inE/=in_itv/= lexx //= gerBl ltW. + by apply fc; rewrite inE. +apply solution_extends => //. +- by rewrite gtrBl. +- apply : (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). + exact: contf_minus. + move => x bx. + apply lip2. + move : bx. + apply: subset_itv; rewrite bnd_simp. + rewrite lerBrDl -lerBrDr. + by rewrite !ge_min opprK (addrC t0) lexx /= !orbT. + move : t0ab. + by rewrite in_itv/= => /andP[_ /ltW//]. + move => t tab. + apply /continuous_subspaceW/cont1. + apply: subset_itv; rewrite bnd_simp. + rewrite lerBrDl -lerBrDr. + by rewrite !ge_min opprK (addrC t0) lexx /= !orbT. + move : t0ab. + by rewrite in_itv/= => /andP[_ /ltW//]. + exact: tab. + move => _ [/= t' tp] <-. + apply (le_closed_ball (e1:=r4%:num)) => //. + suff : (fminus t') \in closed_ball u0 r4%:num by rewrite inE. + apply hrneg. + move : tp. + rewrite in_itv/=inE/=in_itv/= lerNl opprK => /andP[h0 ->//=]. + rewrite lerNl opprD opprK //=. + apply: (le_trans _ h0). + rewrite lerB //. + by rewrite !ge_min lexx !orbT. +- apply : (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). + exact: contf_plus. + move => x bx. + apply lip2. + move : bx. + apply: subset_itv; rewrite bnd_simp. + move : t0ab. + by rewrite in_itv/= => /andP[/ltW//]. + rewrite -lerBrDl. + by rewrite ge_min lexx. + move => t tab. + apply /continuous_subspaceW/cont1. + apply: subset_itv; rewrite bnd_simp. + move : t0ab. + by rewrite in_itv/= => /andP[/ltW//]. + rewrite -lerBrDl. + by rewrite ge_min lexx. + exact: tab. + move => _ [/= t' tp] <-. + apply (le_closed_ball (e1:=r4%:num)) => //. + suff : (fplus t') \in closed_ball u0 r4%:num by rewrite inE. + apply hropos. + move : tp. + rewrite in_itv/=inE/=in_itv/= => /andP[-> h0 //=]. + apply: (le_trans h0). + rewrite lerD //=. + by rewrite !ge_min lexx !orbT. +- apply /(integral_sol_iff_sol (r:=r2) kn0). + + by rewrite gtrBl. + + move => x bx. + apply lip2'. + move : bx. + rewrite !inE. + apply: subset_itvl; rewrite bnd_simp. + by rewrite lerDl ltW. + + move => t tab. + apply /continuous_subspaceW/cont1. + apply: subset_itv; rewrite bnd_simp. + rewrite lerBrDl -lerBrDr. + by rewrite !ge_min opprK (addrC t0) lexx !orbT. + move : t0ab. + by rewrite in_itv/= => /andP[_ /ltW//]. + apply mem_set. + apply Buneg. + by apply set_mem. + + by []. + + move => _ [t tp] <-. + rewrite {1}/f patch_in;last first. + by rewrite inE/=in_itv/= lexx //= gerBl ltW. + have tin : t \in `[t0-dboth, t0+dboth]. + move : tp. + rewrite !inE. + apply: subset_itv; rewrite bnd_simp //. + by rewrite lerDl ltW. + have := fc _ tin. + rewrite {1}/f patch_in; last by rewrite inE. + apply. + split. + * by rewrite /f patch_in; last rewrite inE/=in_itv/= lexx //= gerBl ltW. + * move => t tad. + case : (And32 solminus (-t)). + move : tad. + rewrite -/dminus /=!in_itv/= ltrNr ltrNl opprD !opprK => /andP[h1 ->//=]. + apply: (le_lt_trans _ h1). + by rewrite lerB// 3!ge_min lexx !orbT. + move => h1 h2. + have hd : (derivable fminus t 1). + rewrite /fminus/=. + apply /derivable1_diffP. + apply /differentiable_comp => //. + apply /derivable1_diffP. + apply h1. + split=>//. + rewrite /fminus/=. + apply /rowP => i /=. + rewrite derive1E/=. + rewrite !derive_mx //= !mxE. + rewrite -derive1E/=. + have -> : (fun t0 : R => fminus0 (- t0) ord0 i) = ((fun t => fminus0 t ord0 i) \o -%R). + by apply funext. + rewrite derive1_comp//=. + rewrite !derive1N//=derive1_id/=. + move /rowP : h2. + move /(_ i). + rewrite !derive1E /=!derive_mx. + rewrite /=!mxE => ->. + by rewrite mulrN1 !opprK. + apply h1. + by move /derivable_mxP: h1. + * by rewrite closure_neitv_oo; last rewrite gtrBl. +- apply /(integral_sol_iff_sol (r:=r2) kn0). + + by rewrite ltrDl. + + move=>x bx. + rewrite /fminus/=. + rewrite (And31 solminus). + move => [x1 x2] [ Bx1 Bx2]. + apply: lip2. + move : bx. + rewrite !inE. + apply: subset_itv; rewrite bnd_simp. + move : t0ab. + by rewrite in_itv/= => /andP[/ltW//]. + rewrite -lerBrDl. + by rewrite ge_min lexx. + split => /=. + rewrite /B. + apply: (le_closed_ball _ Bx1). + by rewrite ler_pdivrMr // ler_pMr // lerDr. + apply: (le_closed_ball _ Bx2). + by rewrite ler_pdivrMr // ler_pMr // lerDr. + + move => t tab. + apply /continuous_subspaceW/cont1. + apply: subset_itv; rewrite bnd_simp. + move : t0ab. + by rewrite in_itv/= => /andP[ /ltW//]. + rewrite -lerBrDl. + by rewrite ge_min lexx. + rewrite /B. + suff -> : u0 = fminus t0. + apply mem_set. + apply set_mem in tab. + apply: le_closed_ball tab. + by rewrite /r2/= ler_piMr// invf_le1 // ler1n. + rewrite -fa. + rewrite /f. + rewrite patch_in//. + rewrite inE/= bound_itvE. + by rewrite lerBlDl lerDr ltW. + + by []. + + move => _ [t tp] <-. + rewrite /fminus /=(And31 solminus). + apply : (le_closed_ball ler42). + suff : fplus t \in closed_ball u0 r4%:num by rewrite inE. + apply hropos. + move : tp. + rewrite !inE/=!in_itv/= => /andP[-> h0]//=. + apply (le_trans h0). + rewrite lerD //=. + by rewrite !ge_min lexx !orbT. + rewrite /fminus /=(And31 solminus). + split. + apply solplus. + move => t tad. + apply solplus. + move : tad. + rewrite !in_itv/= => /andP[-> h0]//=. + apply (lt_le_trans h0). + by rewrite lerD //= !ge_min lexx !orbT. + apply /continuous_subspaceW/cfplus. + rewrite closure_neitv_oo;last by rewrite ltrDl. + apply subset_itvl. + rewrite bnd_simp /=. + by rewrite lerD //= !ge_min lexx !orbT. +Qed. +End picard_symmetric. + +Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := + forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. diff --git a/ode_autonomous.v b/ode_autonomous.v deleted file mode 100644 index 77b6c838..00000000 --- a/ode_autonomous.v +++ /dev/null @@ -1,559 +0,0 @@ -From HB Require Import structures. -From mathcomp Require Import all_ssreflect ssralg ssrnum matrix interval poly. -From mathcomp Require Import archimedean generic_quotient ring_quotient. -From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. -From mathcomp Require Import constructive_ereal. -From mathcomp Require Import functions reals interval_inference topology. -From mathcomp Require Import prodnormedzmodule tvs normedtype landau. -From mathcomp Require Import ereal sequences derive numfun measure realfun. -From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. -Require Import ode_common ode_contfun ode tilt_analysis. - -(**md**************************************************************************) -(* # Proofs of properties of autonomous ODEs *) -(* *) -(* TODO: fill *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import Order.TTheory GRing.Theory Num.Def Num.Theory. -Import numFieldNormedType.Exports. - -Open Scope ring_scope. -Open Scope classical_set_scope. - -Section picard_autonomous. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables (phi : U -> U) (k : R) (u0 : U) (r : {posnum R}). -Hypothesis k0 : 0 < k. -Let B := closed_ball u0 r%:num. -Hypothesis lip2 : k.-lipschitz_B phi. - -Definition phi_ (t : R) := phi. - -Definition is_sol_sym u0 t0 d (sol : R -> U):= - sol t0 = u0 /\ sol_is_deriv_oo phi_ (t0 - d) (t0 + d) sol. - -Lemma phi_lip2 a b : {in `[a, b]%R, forall x, k.-lipschitz_B (phi_ x)}. -Proof. by move => x abx; exact: lip2. Qed. - -Lemma phi_cont1 a b : {in B, forall y, {within `[a, b], continuous phi_ ^~ y}}. -Proof. by move => /= x Bx; exact: cst_continuous_subspace. Qed. - -Let rho : {posnum R} := (2^-1)%:pos. - -Let rho1 : rho%:num < 1. -Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. - -Local Lemma cauchy_lipschitz_autofwd a : exists f delta, - delta > 0 /\ is_sol_oo phi_ u0 a (a + delta) f /\ - {in `[a, a + delta], forall t, closed_ball u0 r%:num (f t)}. -Proof. -have aa1 : a < a + 1 by rewrite ltrDl. -have [d0 [solf cball]] := - cauchy_lipschitz_local aa1 k0 (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho1. -exists (@cauchy_lipschitz_local_f R n phi_ a _ k u0 r aa1 k0 - (@phi_lip2 a (a + 1)) (@phi_cont1 a (a + 1)) rho rho1). -by exists (safe_dist phi_ a (a + 1) k u0 r rho). -Qed. - -(* TODO: move *) -Lemma patch_in {X : Type} (f g : R -> X) S x : x \in S -> patch f S g x = g x. -Proof. -move => xs. -rewrite /patch. -by rewrite xs. -Qed. - -Lemma closed_ball_split (x1 x2 y : U) q : 0 < q -> - closed_ball x1 (q / 2) y -> closed_ball x2 (q / 2) x1 -> closed_ball x2 q y. -Proof. -move => hq. -have hq2: (0 < q /2). - by rewrite divr_gt0. -rewrite !closed_ballE// /closed_ball_ /=. -move => h1 h2. -rewrite -(subrKA x1 x2). -by apply: (le_trans (ler_normD _ _)); rewrite (splitr q) lerD//. -Qed. - -Local Lemma phi_lip2' a b : {in `[a, b]%R, forall x, k.-lipschitz_B (-phi_ x)}. -Proof. -move => y _ x B12. -rewrite /= -normrN opprD !opprK /Algebra.opp /=. -exact: (lip2 B12). -Qed. - -Local Lemma phi_cont1' a b : {in B, forall y, {within `[a, b], continuous -phi_ ^~ y}}. -Proof. -move => y _. -move => t. -apply: continuousN. -exact: cst_continuous_subspace. -Qed. - -(* TODO: extending in both directions should be generalized to non-autonomous *) -Lemma cauchy_lipschitz_autonomous a : exists f delta, delta > 0 /\ is_sol_sym u0 a delta f. -Proof. -have [fplus [dplus [dplus0 [solplus cplus]]]] := cauchy_lipschitz_autofwd a. -have amin1 : -a < -a + 1 by rewrite ltrDl. -have [dminus0 [solminus cminus]] := - cauchy_lipschitz_local amin1 k0 - (@phi_lip2' (-a) (-a + 1)) (@phi_cont1' (-a) (-a + 1)) rho1. -set fminus0 := - @cauchy_lipschitz_local_f R n (fun t x => - phi x) (-a) _ k u0 r - amin1 k0 (@phi_lip2' (-a) (-a + 1)) (@phi_cont1' (-a) (-a + 1)) rho rho1. -set dminus := safe_dist (fun t x => - phi x) (-a) (-a + 1) k u0 r rho. -set fminus := fminus0 \o -%R. -set r2 := (r%:num/2)%:pos. -set r4 := (r%:num/4)%:pos. -have ler4 : r4%:num <= r%:num. - by rewrite /r4/= ler_pdivrMr // ler_pMr // lerDl. -have ler42 : r4%:num <= r2%:num. - by rewrite /r4/r2/= ler_pdivrMr// -mulrA ler_pMr // ler_pdivlMl // mulr1 lerD // lerDl. -have adplus : a < a + dplus by rewrite ltrDl dplus0. -have cfplus := And33 solplus. -rewrite closure_neitv_oo in cfplus; last by rewrite ltrDl. -have [rpos hropos] := ode.continuous_confined (a:=a) (b:=a + dplus) (u0:=u0) r4 adplus cfplus (And31 solplus). -have amind : -a < -a + dminus by rewrite ltrDl dminus0. -have cfminus' := And33 solminus. -rewrite closure_neitv_oo in cfminus'; last by rewrite ltrDl. -have cfminus : {within `[a-dminus, a], continuous fminus}. - rewrite /fminus. - apply: within_continuous_minus. - apply /continuous_subspaceW/cfminus'. - apply: subset_itvl. - rewrite -/dminus. - by rewrite bnd_simp/= opprD opprK. -have [rneg hrneg] := ode.continuous_confined (a:=-a) (b:=-a + dminus) (u0:=u0) r4 amind cfminus' (And31 solminus). -set dboth := Num.min dplus (Num.min dminus (Num.min rneg%:num rpos%:num)). -have dboth0 : 0 < dboth. - rewrite lt_min dplus0 //= lt_min dminus0 //=. -pose f := patch fplus `[a - dboth, a] fminus. -set uneg := f (a - dboth). -have Buneg : closed_ball uneg (r%:num/2) `<=` closed_ball u0 r%:num. - rewrite /uneg/f patch_in/f/=;last first. - by rewrite inE/=in_itv/= gerBl lexx ltW. - move => /=x xb. - apply: (closed_ball_split _ xb) => //. - suff : fminus (a - dboth) \in closed_ball u0 (r%:num/4). - rewrite !inE. - apply le_closed_ball. - rewrite ler_pdivrMr//= -mulrA /=ler_peMr//. - by rewrite ler_pdivlMl //= mulr1 ltW // ler_ltD //= ltrDl. - apply hrneg. - rewrite inE/=in_itv/= opprB lerDr ltW //= addrC lerD //. - by rewrite /dboth ge_min; do 2 (apply /orP; right; rewrite ge_min);apply /orP;left. -have f01intersect : fminus a = fplus a. - by rewrite /fminus/= (And31 solminus) (And31 solplus). -have fa : f a = u0. - rewrite /f patch_in /fminus /=. - apply solminus. - by rewrite inE/=in_itv/= lexx gerBl ltW. -set B' := closed_ball uneg (r2%:num). -have lip2' : k.-lipschitz_B' phi. - move => /= [x1 x2] [Bx1 Bx2]. - apply lip2. - by split;apply Buneg. -have contf_minus : {within `[a - dboth, a], continuous fminus}. - apply /continuous_subspaceW/cfminus. - apply: subset_itvr. - by rewrite bnd_simp /= lerD //= lerNr opprK ge_min; apply /orP;right; rewrite ge_min lexx. - -have contf_plus : {within `[a, a+dboth], continuous fplus}. - apply /continuous_subspaceW/cfplus. - apply: subset_itvl. - by rewrite bnd_simp /= lerD //= ge_min lexx. -have contf : {within `[a - dboth, (a + dboth)%E], continuous f}. - apply : within_continuous_patch => //. - by rewrite gtrBl. - by rewrite ltrDl. -have r42 : r4%:num = (r2%:num / 2). - rewrite /r4/r2/=. - rewrite -mulrA. - apply congr2 => //. - by rewrite -invfM -natrM. -have fc : {in `[a-dboth, (a + dboth)], forall t : R, closed_ball (fminus (a - dboth)) r2%:num (f t)}. - move => t tad. - rewrite /f/=/patch/=. - have : (closed_ball (fminus (a-dboth)) (r4%:num)) u0. - suff: fminus (a - dboth) \in closed_ball u0 (r4%:num). - by rewrite inE/= !closed_ballE/closed_ball_/= // distrC . - apply: hrneg. - rewrite !inE/=!in_itv/= lerNr lerNl opprD !opprK gerBl ltW //= lerB //. - by do 2 (rewrite ge_min;apply /orP;right); rewrite ge_min lexx. - rewrite r42. - move => c1. - case : ifP => ht. - - have : (fminus t) \in closed_ball u0 (r4%:num). - apply: hrneg. - move : ht. - rewrite !inE/=!in_itv/= lerNr lerNl opprD !opprK => /andP[h1 ->//=]. - apply: (le_trans _ h1). - by rewrite lerB //; do 2 (rewrite ge_min;apply /orP;right); rewrite ge_min lexx. - rewrite inE. - rewrite !r42. - move => c2. - apply: (closed_ball_split _ c2) =>//. - - have : (fplus t) \in closed_ball u0 (r4%:num). - have ht' : t \in `[a, a + dboth]. - have := tad. - rewrite !inE /=!in_itv/= => /andP[h1 ->]; apply /andP; split => //. - have [hat | hat] := lerP a t => //. - rewrite -ht. - by rewrite inE/=in_itv/= h1//= ltW. - apply: hropos. - move : ht'. - rewrite !inE/= !in_itv/= => /andP[-> h1//=]. - apply: (le_trans h1). - by rewrite lerD //; do 3 (rewrite ge_min;apply /orP;right). - rewrite inE. - rewrite !r42. - move => c2. - apply: (closed_ball_split _ c2) =>//. -exists f, dboth. -split => //. -suff h : is_sol_oo phi_ (f (a - dboth)) (a - dboth) (a + dboth) f. - by split => //; apply: (And32 h). -have kn0 : k != 0 by apply lt0r_neq0. -apply /(integral_sol_iff_sol (r := r2) kn0) => //. - by rewrite ler_ltD // gtrN. - move => x _; exact: cst_continuous_subspace. - move => _ [t tp] <-. - rewrite {1}/f patch_in;last first. - by rewrite inE/=in_itv/= lexx //= gerBl ltW. - by apply fc; rewrite inE. -apply solution_extends => //. -- by rewrite gtrBl. -- apply : (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). - exact: contf_minus. - by move => x _. - move => x _ ;exact: cst_continuous_subspace. - move => _ [/= t' tp] <-. - apply (le_closed_ball (e1:=r4%:num)) => //. - suff : (fminus t') \in closed_ball u0 r4%:num by rewrite inE. - apply hrneg. - move : tp. - rewrite in_itv/=inE/=in_itv/= lerNl opprK => /andP[h0 ->//=]. - rewrite lerNl opprD opprK //=. - apply: (le_trans _ h0). - by rewrite lerB //; do 2 (rewrite ge_min;apply /orP;right); rewrite ge_min lexx. -- apply : (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). - exact: contf_plus. - by move => x _. - move => x _ ;exact: cst_continuous_subspace. - move => _ [/= t' tp] <-. - apply (le_closed_ball (e1:=r4%:num)) => //. - suff : (fplus t') \in closed_ball u0 r4%:num by rewrite inE. - apply hropos. - move : tp. - rewrite in_itv/=inE/=in_itv/= => /andP[-> h0 //=]. - apply: (le_trans h0). - by rewrite lerD //=; do 3 (rewrite ge_min;apply /orP;right). -- apply /(integral_sol_iff_sol (r:=r2) kn0). - + by rewrite gtrBl. - + move=>x _; exact: lip2'. - + move=>x _; exact: cst_continuous_subspace. - + by []. - + move => _ [t tp] <-. - rewrite {1}/f patch_in;last first. - by rewrite inE/=in_itv/= lexx //= gerBl ltW. - have tin : t \in `[a-dboth, a+dboth]. - move : tp. - rewrite !inE/=!in_itv/= => /andP[-> h1//=]. - by apply (le_trans h1); rewrite lerDl ltW. - have := fc _ tin. - rewrite {1}/f patch_in; last by rewrite inE. - apply. - split. - * by rewrite /f patch_in; last rewrite inE/=in_itv/= lexx //= gerBl ltW. - * move => t tad. - case : (And32 solminus (-t)). - move : tad. - rewrite -/dminus !in_itv/= ltrNr ltrNl opprD !opprK => /andP[h1 ->//=]. - apply: (le_lt_trans _ h1). - by rewrite lerD// lerNl opprK; rewrite ge_min;apply /orP;right;rewrite ge_min lexx. - move => h1 h2. - have hd : derivable fminus t 1. - rewrite /fminus/=. - apply/derivable1_diffP. - apply/differentiable_comp => //. - apply/derivable1_diffP. - by apply h1. - split=>//. - rewrite /fminus/=. - apply /rowP => i /=. - rewrite derive1E/=. - rewrite !derive_mx //= !mxE. - rewrite -derive1E/=. - have -> : (fun t0 : R => fminus0 (- t0) ord0 i) = ((fun t => fminus0 t ord0 i) \o -%R). - by apply funext. - rewrite derive1_comp//=. - rewrite !derive1N//=derive1_id/=. - move /rowP : h2. - move /(_ i). - rewrite !derive1E /=!derive_mx. - rewrite /=!mxE => ->. - by rewrite mulrN1 opprK. - apply h1. - by move /derivable_mxP: h1. - * by rewrite closure_neitv_oo; last rewrite gtrBl. -- apply /(integral_sol_iff_sol (r:=r2) kn0). - + by rewrite ltrDl. - + move=>x _. - rewrite /fminus/=. - rewrite (And31 solminus). - move => [x1 x2] [ Bx1 Bx2]. - apply: lip2. - split => /=. - rewrite /B. - apply: (le_closed_ball _ Bx1). - by rewrite ler_pdivrMr // ler_pMr // lerDr. - apply: (le_closed_ball _ Bx2). - by rewrite ler_pdivrMr // ler_pMr // lerDr. - + move=>x _; exact: cst_continuous_subspace. - + by []. - + move => _ [t tp] <-. - rewrite /fminus /=(And31 solminus). - apply : (le_closed_ball ler42). - suff : fplus t \in closed_ball u0 r4%:num by rewrite inE. - apply hropos. - move : tp. - rewrite !inE/=!in_itv/= => /andP[-> h0]//=. - apply (le_trans h0). - by rewrite lerD //=; do 3 (rewrite ge_min;apply /orP;right). - rewrite /fminus /=(And31 solminus). - split. - apply solplus. - move => t tad. - apply solplus. - move: tad; rewrite !in_itv/= => /andP[-> h0]//=. - by rewrite (lt_le_trans h0)// lerD2l ge_min lexx. - apply /continuous_subspaceW/cfplus. - rewrite closure_neitv_oo;last by rewrite ltrDl. - apply subset_itvl. - rewrite bnd_simp /=. - by rewrite lerD //= ge_min lexx. -Qed. - -End picard_autonomous. - -Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := - forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. - -(* Section locally_lipschitz. *) -(* Context {R : realType} {n : nat}. *) -(* Notation U := 'rV[R]_n. *) -(* Variables phi : U -> U. *) - -(* Hypothesis phi_locally_lipschitz : locally_lipschitz phi. *) - -(* Theorem cauchy_lipschitz_ll u0 a : exists f delta r, *) -(* delta > 0 /\ is_sol_sym phi u0 a (a + delta) f /\ *) -(* {in `[a, a + delta], forall t, closed_ball u0 r (f t)}. *) -(* Proof. *) -(* have [/= r [k lip]] := phi_locally_lipschitz u0. *) -(* have [//|f [delta [delta_ft0 [solf cball]]]] := cauchy_lipschitz_autonomous _ lip a. *) -(* by exists f, delta, r%:num. *) -(* Qed. *) - -(* End locally_lipschitz. *) - -Section uniqueness. -Context {R : realType} {n : nat} (a b : R). -Notation U := 'rV[R]_n. -Variable phi : U -> U. -Hypothesis ab : a < b. - -Hypothesis phi_locally_lipschitz : locally_lipschitz phi. - -Variables (u0 : U) (f : R -> U) (f' : R -> U). -Hypothesis sol1 : is_sol_oo (fun=> phi) u0 a b f. -Hypothesis sol2 : is_sol_oo (fun=> phi) u0 a b f'. - -Lemma locally_unique_extends t : a <= t < b -> f' t = f t -> - exists Delta : {posnum R}, {in `[t, t + Delta%:num]%R, f =1 f'}. -Proof. -move=> /andP[ta tb] eq. -have taab : `[t, b] `<=` `[a, b]. - by move=> ?/=; apply: subset_itvr; rewrite bnd_simp. -have [r [k L]] := phi_locally_lipschitz (f t). -have cf0 : {within `[t, b], continuous f}. - have := And33 sol1. - rewrite closure_neitv_oo//; exact: continuous_subspaceW. -have cf'0 : {within `[t, b], continuous f'}. - have := And33 sol2. - by rewrite closure_neitv_oo//; exact: continuous_subspaceW. -have sol10 : is_sol_oo (fun=> phi) (f t) t b f. - split => //; last by rewrite closure_neitv_oo. - move=> t0 tab. - apply sol1. - by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. -have sol20 : is_sol_oo (fun=> phi) (f t) t b f'. - split => //; last by rewrite closure_neitv_oo. - move=> t0 tab. - apply sol2. - by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. -have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) phi}. - by move => ? _; apply L. -have k0 : 0 < k%:num by []. -have cont1 : {in closed_ball (f t) r%:num, - forall y : 'rV_n, {within `[t, b], continuous fun=> phi y}}. - by move => y _; exact: cst_continuous_subspace. -have [D [P1 P2]] := initial_solution_unique tb k0 lip20 cont1 cf0 sol10 cf'0 sol20. -by exists D. -Qed. - -Lemma solution_unique : {in `[a, b]%R, f =1 f'}. -Proof. -set E := [set t | t \in `[a, b]%R /\ {in `[a, t]%R, f =1 f'}]. -suff : E b by case. -have Enonempty : E !=set0. - exists a; split; first by rewrite in_itv/= lexx ltW. - move=> t; rewrite in_itv/= -eq_le => /eqP <-. - by rewrite (And31 sol1) (And31 sol2). -have mon c : E c -> forall c', a <= c' <= c -> E c'. - move=> -[+ h c'] /andP[ac' cc']. - rewrite in_itv/= => /andP[ac cb]. - split. - by rewrite in_itv/= ac' (le_trans cc'). - move => t tac'. - apply: h. - by move: tac'; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp. -have monC c c' : a <= c' -> E c -> ~ E c' -> c < c'. - move => ac' Ec nEc'. - rewrite ltNge; apply/negP => c'c. - apply/nEc'/(mon c) => //. - by rewrite ac'. -have [hP|hP] := lem (has_sup E); last first. - have /(has_supPn Enonempty) := hP. - move=> /(_ b)[x Ex bx]. - apply/(mon x) => //. - by rewrite !ltW. -have Eclosed : closed E. - rewrite closedE/= => p pn. - suff : forall x, ~ E x -> \forall y \near x, ~ E y. - move => H. - apply/not_notP => Ec. - apply: pn. - exact: H. - move=> x Ex1. - have [xab|xnab] := boolP (x \in `[a, b]%R); last first. - suff : \forall y \near x, ~ (y \in `[a,b]%R). - move=> h. - near=> y. - rewrite not_andP;left. - near: y. - exact: h. - move: xnab; rewrite in_itv/= negb_and/= -!ltNge => /orP[xa|xb]. - near=> y. - apply/negP; rewrite in_itv/= negb_and/= -!ltNge; apply/orP; left. - by near: y; exact: lt_nbhsl. - near=>y. - apply/negP. - rewrite in_itv/=negb_and/= -!ltNge; apply/orP; right. - by near: y; exact: lt_nbhsr. - rewrite not_andP in Ex1. - case: Ex1 => // {}Ex1. - have [t Et] : exists t, t \in `[a, x]%R /\ ~ (f t = f' t). - rewrite not_existsP => h. - apply Ex1 => t tax. - have := h t. - by rewrite not_andP => -[//|/contrapT]. - have [xt|xt]:= eqVneq x t. - subst t. - set g := fun x => `|f x - f' x|. - have contg : {within `[a,b], continuous g}. - apply: (within_continuous_comp_norm (ltW ab)) => t. - apply: continuousB. - - have := And33 sol1. - rewrite closure_neitv_oo//. - exact. - - have := And33 sol2. - rewrite closure_neitv_oo//. - exact. - have g0x : g x > 0. - rewrite normr_gt0 subr_eq0. - by apply/eqP; case: Et. - have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t]%R, f =1 f'}. - move => tab gt Et'. - move : gt. - suff -> : g t = 0 by rewrite ltxx. - apply/normr0P. - rewrite Et' ?subrr//. - by move: tab; rewrite !in_itv/= lexx => /andP[->]. - suff hgx: \forall y \near x^'-, 0 < g y. - near=>y. - have [yx|xy Ey] := ltP y x; last first. - have := mon _ Ey x. - move: xab. - by rewrite /=in_itv/= xy => /andP[-> _] // /(_ isT)[]. - apply/not_andP. - rewrite -implyE => yab. - apply g0 => //. - by move: yx; near: y. - apply: (@cvgr_gt R R (nbhs x^'-) _ g (g x)) => //. - have xa : a < x. - rewrite ltNge. - apply: contra_notN Ex1. - move: xab; rewrite in_itv/= => /andP[+ _] ax. - move/(conj ax) => /andP; rewrite -eq_le => /eqP ->. - move=> t; rewrite in_itv/= -eq_le => /eqP <-. - by rewrite (And31 sol1) (And31 sol2). - have /(continuous_within_itvP _ ab) := contg => -[h1 _ h2]. - move: xab; rewrite in_itv/= => /andP[_ ]. - rewrite le_eqVlt => /predU1P[-> //|xb]. - apply/cvg_at_left_filter/h1. - by rewrite in_itv/= xb xa. - have xt' : t < x. - case: Et; rewrite in_itv/= => /andP[_ ]. - by rewrite le_eqVlt eq_sym (negbTE xt) . - near=> y. - move => Ey. - have : ~ E t. - rewrite not_andP. - right. - move=> /(_ t). - case: Et; rewrite !in_itv/= => /andP[-> _/=]. - by rewrite lexx => /[swap] => /(_ isT). - have ta : a <= t. - by case: Et; rewrite in_itv/= => /andP[]. - move/(monC y t ta Ey). - apply/negP; rewrite -leNgt. - by near: y; exact: nbhs_ge. -have supE : E (sup E). - rewrite {1}(closure_id E).1 //. - apply: closure_sup => //. - by apply hP. -have sup_itv : a <= sup E. - apply sup_upper_bound => //. - split; first by rewrite in_itv/= lexx ltW. - move=> t; rewrite in_itv/= -eq_le => /eqP <-. - by rewrite (And31 sol1) (And31 sol2). -have supeq : f' (sup E) = f (sup E). - apply/esym; apply supE. - by rewrite in_itv/= lexx sup_itv. -have [h|h] := leP b (sup E). - apply: (mon _ supE) => //. - by rewrite (ltW ab). -have [|Delta Hdelta] := locally_unique_extends _ supeq; first by apply/andP. -have Delta0 : 0 < Delta%:num by []. -suff : Num.min b (sup E + Delta%:num) <= sup E. - rewrite ge_min => /orP[bE|]. - by have := lt_le_trans h bE; rewrite ltxx. - by rewrite gerDl leNgt Delta0. -apply: sup_upper_bound => //. -split. - by rewrite in_itv/= le_min (ltW ab)/= ler_wpDr//= ge_min lexx. -move=> t. -rewrite in_itv/= => -/andP[t1 t2]. -have [ht|ht] := leP t (sup E). - by apply supE; rewrite in_itv/= t1 ht. -by apply: Hdelta; rewrite in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. -Unshelve. all: by end_near. Qed. - -End uniqueness. From 0400207ee041b2ba1c91159cbd8f43b317aa771c Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Tue, 17 Feb 2026 20:39:21 +0900 Subject: [PATCH 120/144] minor cleanup --- tilt_lyapunov.v | 2 +- tilt_stability.v | 20 ++++++++++---------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index f2034039..cd62e8a6 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -1461,7 +1461,7 @@ Variable Init : set 'rV[K]_6. Lemma equilibrium_zero_stable : Tilt.point1 \in Init -> open Init -> Init `<=` Tilt.Upsilon1 -> - is_locally_stable_at phi Init Tilt.point1. + is_stable_at phi Init Tilt.point1. Proof. move=> Init0 openInit Init_in_state. apply: (@Lyapunov_stability0 K _ phi Init openInit (V1 alpha1 gamma)). diff --git a/tilt_stability.v b/tilt_stability.v index 077d873c..b4ad48af 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -278,18 +278,18 @@ Let T := 'rV[K]_n. Variable phi : T -> T. Variable Init : set T. -Definition is_locally_stable_at (x : T) := +Definition is_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & forall f D, f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> `| f 0 - x | < d -> forall t, 0 < t < D -> `| f t - x | < eps. (* assuming solution exists for all time *) -Definition is_stable_at (x : T) := +Definition is_global_time_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & forall f, f 0 \in Init -> sol_is_deriv_c0y phi f -> `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. -Lemma locally_stable_stable : is_locally_stable_at `<=` is_stable_at. +Lemma stable_global_time : is_stable_at `<=` is_global_time_stable_at. Proof. move=> x H e /H [d d0 stable]. exists d => // z [z0Init zglob] zd /= t t0. @@ -527,7 +527,7 @@ Hypothesis DV_le0 : forall D f, f 0 \in Init -> (* khalil theorem 4.1 *) Theorem Lyapunov_stability0 : - is_Lyapunov_candidate V Init 0 -> is_locally_stable_at phi Init 0. + is_Lyapunov_candidate V Init 0 -> is_stable_at phi Init 0. Proof. move=> VInitx /= eps eps0/=. move: VInitx => [/= xInit [Vx0 InitxV]]. @@ -706,12 +706,12 @@ rewrite subrK derive1E deriveB//; last by apply H. by rewrite derive_cst subr0 -derive1E; apply H. Qed. -Lemma is_locally_stable_at_substitution x : - is_locally_stable_at (fun y => phi (y + x)) [set y - x | y in Init] 0 -> - is_locally_stable_at phi Init x. +Lemma is_stable_at_substitution x : + is_stable_at (fun y => phi (y + x)) [set y - x | y in Init] 0 -> + is_stable_at phi Init x. Proof. move=> H. -rewrite /is_locally_stable_at => /= e e0. +rewrite /is_stable_at => /= e e0. have [/= d d0 {}H] := H _ e0. exists d => // f Delta [f0Init solf] f0xd t t0. rewrite -[_ - _]subr0. @@ -784,10 +784,10 @@ Hypothesis V'_le0 : forall D (sol : K -> U), forall t, 0 < t < D -> 'D~(sol) V t <= 0. Theorem Lyapunov_stability : - is_Lyapunov_candidate V Init `<=` is_locally_stable_at phi Init. + is_Lyapunov_candidate V Init `<=` is_stable_at phi Init. Proof. move=> x VInitx. -apply: is_locally_stable_at_substitution. +apply: is_stable_at_substitution. apply: (@Lyapunov_stability0 _ _ _ _ _ (fun y => V (y + x))). - rewrite [X in open X](_ : _ = (fun y => y + x) @^-1` Init); last first. apply/seteqP; split. From 0dd599b5b56ce53774ebe1b5beb06210a005047b Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Tue, 17 Feb 2026 23:51:44 +0900 Subject: [PATCH 121/144] simp uniqueness --- ode.v | 191 +++++++++++++++++++++++++--------------------------------- 1 file changed, 82 insertions(+), 109 deletions(-) diff --git a/ode.v b/ode.v index 3d8157dc..f6cec108 100644 --- a/ode.v +++ b/ode.v @@ -1,12 +1,12 @@ From HB Require Import structures. From mathcomp Require Import all_boot all_order ssralg ssrnum matrix interval. From mathcomp Require Import poly archimedean generic_quotient ring_quotient. +From mathcomp Require Import interval_inference. From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. -From mathcomp Require Import constructive_ereal. -From mathcomp Require Import functions reals interval_inference topology. -From mathcomp Require Import prodnormedzmodule tvs normedtype landau. -From mathcomp Require Import ereal sequences derive numfun measure realfun. -From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. +From mathcomp Require Import contra functions constructive_ereal reals. +From mathcomp Require Import topology prodnormedzmodule tvs normedtype. +From mathcomp Require Import landau ereal sequences derive numfun measure. +From mathcomp Require Import realfun lebesgue_measure lebesgue_integral ftc. Require Import tilt_analysis ode_common ode_contfun. (**md**************************************************************************) @@ -1988,7 +1988,7 @@ Qed. End solution_locally_unique. -(* move *) +(* TODO: move *) Section closure_neitv. Context {R : realType}. Implicit Type a b : R. @@ -2008,6 +2008,14 @@ Qed. End closure_neitv. +(* TODO: move *) +Lemma within_continuousB {K : realType} {V : normedModType K} + (A : set K) (f g : _ -> V) : + {within A, continuous f} -> {within A, continuous g} -> + {within A, continuous (f - g)}. +Proof. +by move=> cf cg x; apply: cvgB; [exact: cf|exact: cg]. +Qed. Section uniqueness. Context {R : realType} {n : nat} (a b : R). @@ -2023,6 +2031,7 @@ Hypothesis phi_loclip : Variables (f : R -> U) (f' : R -> U). Hypothesis sol1 : is_sol_oo phi u0 a b f. Hypothesis sol2 : is_sol_oo phi u0 a b f'. + Lemma locally_unique_extends t : a <= t < b -> f' t = f t -> exists Delta : {posnum R}, {in `[t, t + Delta%:num]%R, f =1 f'}. Proof. @@ -2058,152 +2067,116 @@ have [D [P1 P2]] := initial_solution_unique tb k0 lip20 cont1' cf0 sol10 cf'0 so by exists D. Qed. -Lemma solution_unique : {in `[a, b]%R, f =1 f'}. +Let in1_eq1 : {in `[a, a]%R, f =1 f'}. +Proof. +move=> t; rewrite in_itv/= -eq_le => /eqP <-. +by rewrite (And31 sol1) (And31 sol2). +Qed. + +Lemma solution_unique : {in `[a, b]%R, f =1 f'}. Proof. -set E := [set t | t \in `[a, b]%R /\ {in `[a, t]%R, f =1 f'}]. +set E := `[a, b]%classic `&` [set t | {in `[a, t]%R, f =1 f'}]. suff : E b by case. -have Enonempty : E !=set0. - exists a; split; first by rewrite in_itv/= lexx ltW. - move => t; rewrite in_itv/= -eq_le => /eqP <-. - by rewrite (And31 sol1) (And31 sol2). -have mon c : E c -> forall c', a <= c' <= c -> E c'. - move=> -[+ h c'] /andP[ac' cc']. - rewrite in_itv/= => /andP[ac cb]. - split. - by rewrite in_itv/= ac' (le_trans cc'). - move => t tac'. - apply: h. - by move: tac'; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp. -have monC c c' : a <= c' -> E c -> ~ E c' -> c < c'. - move => ac' Ec nEc'. - rewrite ltNge; apply/negP => c'c. - apply/nEc'/(mon c) => //. - by rewrite ac'. -have [hP|hP] := lem (has_sup E); last first. - have /(has_supPn Enonempty) := hP. +have Ea : E a by split=> //=; rewrite bound_itvE/= ltW. +have Enonempty : E !=set0 by exists a. +have mon c : E c -> forall d, d \in `[a, c]%R -> E d. + move=> [/= cab] acff' d dac; split => /=. + by apply: subset_itvl dac; rewrite bnd_simp (itvP cab). + move=> t tad; apply: acff'. + by apply: subset_itvl tad; rewrite bnd_simp (itvP dac). +have monC c d : a <= d -> E c -> ~ E d -> c < d. + move=> ad Ec nEd. + rewrite ltNge; apply/negP => cd. + apply/nEd/(mon c) => //. + by rewrite in_itv/= ad. +have [hP|/(has_supPn Enonempty)] := lem (has_sup E); last first. move=> /(_ b)[x Ex bx]. - apply/(mon x) => //. - by rewrite !ltW. + by apply/(mon x) => //; rewrite in_itv/= !ltW. have Eclosed : closed E. rewrite closedE/= => p pn. suff : forall x, ~ E x -> \forall y \near x, ~ E y. - move => H. - apply/not_notP => Ec. - apply: pn. - exact: H. - move=> x Ex1. + by apply: contraPP => Ep /(_ _ Ep). + move=> x notEx. have [xab|xnab] := boolP (x \in `[a, b]%R); last first. suff : \forall y \near x, ~ (y \in `[a,b]%R). - move=> h. - near=> y. - rewrite not_andP;left. - near: y. - exact: h. + by move=> ?; near do (rewrite not_andP; left). move: xnab; rewrite in_itv/= negb_and/= -!ltNge => /orP[xa|xb]. - near=> y. - apply/negP; rewrite in_itv/= negb_and/= -!ltNge; apply/orP; left. - by near: y; exact: lt_nbhsl. - near=>y. - apply/negP. - rewrite in_itv/=negb_and/= -!ltNge; apply/orP; right. - by near: y; exact: lt_nbhsr. - rewrite not_andP in Ex1. - case: Ex1 => // {}Ex1. - have [t Et] : exists t, t \in `[a, x]%R /\ ~ (f t = f' t). + - near do (apply/negP; rewrite in_itv negb_and/= -!ltNge; apply/orP; left). + exact: lt_nbhsl. + - near do (apply/negP; rewrite in_itv negb_and/= -!ltNge; apply/orP; right). + exact: lt_nbhsr. + move: notEx;rewrite not_andP => -[//|notEx]. + have [t Et] : exists t, t \in `[a, x]%R /\ f t != f' t. rewrite not_existsP => h. - apply Ex1 => t tax. + apply: notEx => t tax. have := h t. - by rewrite not_andP => -[//|/contrapT]. + by rewrite not_andP => -[//|/negP/negPn/eqP]. have [xt|xt]:= eqVneq x t. subst t. set g := fun x => `|f x - f' x|. - have contg : {within `[a,b], continuous g}. - apply: (within_continuous_comp_norm (ltW ab)) => t. - apply: continuousB. - - have := And33 sol1. - rewrite closure_neitv_oo//. - exact. - - have := And33 sol2. - rewrite closure_neitv_oo//. - exact. - have g0x : g x > 0. - rewrite normr_gt0 subr_eq0. - by apply/eqP; case: Et. - have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t]%R, f =1 f'}. - move => tab gt Et'. - move : gt. + have contg : {within `[a, b], continuous g}. + apply/(within_continuous_comp_norm (ltW ab))/within_continuousB. + - by have := And33 sol1; rewrite (closure_neitv_oo ab). + - by have := And33 sol2; rewrite (closure_neitv_oo ab). + have g0x : g x > 0 by rewrite normr_gt0 subr_eq0; case: Et. + have g0 t : t \in `[a, b]%R -> g t > 0 -> ~ {in `[a, t]%R, f =1 f'}. + move=> tab + atff'. suff -> : g t = 0 by rewrite ltxx. - apply/normr0P. - rewrite Et' ?subrr//. + apply/normr0P; rewrite atff' ?subrr//. by move: tab; rewrite !in_itv/= lexx => /andP[->]. suff hgx: \forall y \near x^'-, 0 < g y. - near=>y. + near=> y. have [yx|xy Ey] := ltP y x; last first. have := mon _ Ey x. move: xab. - by rewrite /=in_itv/= xy => /andP[-> _] // /(_ isT)[]. - apply/not_andP. - rewrite -implyE => yab. - apply g0 => //. + by rewrite !in_itv/= xy => /andP[-> _] /(_ isT)[]. + apply/not_andP; rewrite -implyE => yab. + apply: g0 => //. by move: yx; near: y. - apply: (@cvgr_gt R R (nbhs x^'-) _ g (g x)) => //. + apply: (@cvgr_gt _ _ (x^'-) _ g (g x)) => //. have xa : a < x. rewrite ltNge. - apply: contra_notN Ex1. + contra: notEx. move: xab; rewrite in_itv/= => /andP[+ _] ax. - move/(conj ax) => /andP; rewrite -eq_le => /eqP ->. - move => t; rewrite in_itv/= -eq_le => /eqP <-. - by rewrite (And31 sol1) (And31 sol2). - have /(continuous_within_itvP _ ab) := contg => -[h1 _ h2]. + by move/(conj ax) => /andP; rewrite -eq_le => /eqP ->. + have /(continuous_within_itvP _ ab)[cg _ gbb] := contg. move: xab; rewrite in_itv/= => /andP[_ ]. rewrite le_eqVlt => /predU1P[-> //|xb]. - apply/cvg_at_left_filter/h1. + apply/cvg_at_left_filter/cg. by rewrite in_itv/= xb xa. - have xt' : t < x. - case: Et; rewrite in_itv/= => /andP[_ ]. - by rewrite le_eqVlt eq_sym (negbTE xt) . + have tx : t < x. + by case: Et; rewrite in_itv/= lt_neqAle (eq_sym t) xt => /andP[_ ->]. near=> y. - move => Ey. - have : ~ E t. - rewrite not_andP. - right. - move=> /(_ t). - case: Et; rewrite !in_itv/= => /andP[-> _/=]. - by rewrite lexx => /[swap] => /(_ isT). - have ta : a <= t. - by case: Et; rewrite in_itv/= => /andP[]. - move/(monC y t ta Ey). + move=> Ey. + have ta : a <= t by case: Et; rewrite in_itv/= => /andP[]. + have /(monC _ _ ta Ey) : ~ E t. + rewrite not_andP; right => /(_ t). + by rewrite bound_itvE/= ta => /(_ isT); apply/eqP; case: Et. apply/negP; rewrite -leNgt. by near: y; exact: nbhs_ge. have supE : E (sup E). - rewrite {1}(closure_id E).1 //. - apply: closure_sup => //. - by apply hP. -have sup_itv : a <= sup E. - apply sup_upper_bound => //. - split; first by rewrite in_itv/= lexx ltW. - move => t; rewrite in_itv/= -eq_le => /eqP <-. - by rewrite (And31 sol1) (And31 sol2). + by rewrite {1}(closure_id E).1//; apply: closure_sup => //; apply hP. +have sup_itv : a <= sup E by rewrite sup_upper_bound. have supeq : f' (sup E) = f (sup E). apply/esym; apply supE. by rewrite in_itv/= lexx sup_itv. have [h|h] := leP b (sup E). apply: (mon _ supE) => //. - by rewrite (ltW ab). + by rewrite in_itv/= (ltW ab). have [|Delta Hdelta] := locally_unique_extends _ supeq; first by apply/andP. have Delta0 : 0 < Delta%:num by []. suff : Num.min b (sup E + Delta%:num) <= sup E. - rewrite ge_min => /orP[bE|]. - by have := lt_le_trans h bE; rewrite ltxx. + rewrite ge_min => /orP[/(lt_le_trans h)|]. + by rewrite ltxx. by rewrite gerDl leNgt Delta0. apply: sup_upper_bound => //. split. - by rewrite in_itv/= le_min (ltW ab)/= ler_wpDr//= ge_min lexx. -move=> t. -rewrite in_itv/= => -/andP[t1 t2]. + by rewrite /= in_itv/= le_min (ltW ab)/= ler_wpDr//= ge_min lexx. +move=> t ta. have [ht|ht] := leP t (sup E). - by apply supE; rewrite in_itv/= t1 ht. -by apply: Hdelta; rewrite in_itv/= ltW// (le_trans t2)// ge_min lexx orbT. + by apply supE; rewrite in_itv/= (itvP ta). +apply: Hdelta; rewrite in_itv/= ltW//=. +by move: ta; rewrite in_itv/= le_min => /and3P[_]. Unshelve. all: by end_near. Qed. End uniqueness. From b5f03b86712d4017658052831f28962c9f92d0fb Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 18 Feb 2026 09:38:46 +0900 Subject: [PATCH 122/144] use gen lyapunov thm --- tilt_lyapunov.v | 66 ++++++++++------------ tilt_stability.v | 139 +++++++++++++++++++++++------------------------ 2 files changed, 96 insertions(+), 109 deletions(-) diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index cd62e8a6..a3c275ee 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -810,26 +810,25 @@ Lemma V1_is_Lyapunov_candidate : is_Lyapunov_candidate V1 [set: 'rV_6] Tilt.point1. Proof. rewrite /V1 /Tilt.point1; split; first by rewrite inE. -split. - by rewrite lsubmx_const rsubmx_const enorm0 expr0n/= !mul0r add0r. -move=> /= z_near _ z0. -have /orP[lz0|rz0] : (Left z_near != 0) || (Right z_near != 0). - rewrite -negb_and. - apply: contra z0 => /andP[/eqP l0 /eqP r0]. - rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. - apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; - by rewrite mxE. -- set rsub := Right z_near. - have : `|rsub|_e >= 0 by rewrite enorm_ge0. - set lsub := Left z_near. - move=> nor. - have normlsub : `|lsub|_e > 0 by rewrite enorm_gt0. - rewrite ltr_pwDl//. - by rewrite divr_gt0 ?exprn_gt0// mulr_gt0. - by rewrite divr_ge0 ?exprn_ge0// mulr_ge0// ltW. -- rewrite ltr_pwDr//. - by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0 ?enorm_gt0. - by rewrite divr_ge0 ?exprn_ge0 ?enorm_ge0 ?mulr_ge0// ltW. +- by rewrite lsubmx_const rsubmx_const enorm0 expr0n/= !mul0r add0r. +- move=> /= z_near _ z0. + have /orP[lz0|rz0] : (Left z_near != 0) || (Right z_near != 0). + rewrite -negb_and. + apply: contra z0 => /andP[/eqP l0 /eqP r0]. + rewrite -[eqbLHS](@hsubmxK _ _ 3 3) l0 r0. + apply/eqP/rowP; move => i; rewrite !mxE /=; case: splitP => ? ?; + by rewrite mxE. + + set rsub := Right z_near. + have : `|rsub|_e >= 0 by rewrite enorm_ge0. + set lsub := Left z_near. + move=> nor. + have normlsub : `|lsub|_e > 0 by rewrite enorm_gt0. + rewrite ltr_pwDl//. + by rewrite divr_gt0 ?exprn_gt0// mulr_gt0. + by rewrite divr_ge0 ?exprn_ge0// mulr_ge0// ltW. + + rewrite ltr_pwDr//. + by rewrite divr_gt0 ?exprn_gt0 ?mulr_gt0 ?enorm_gt0. + by rewrite divr_ge0 ?exprn_ge0 ?enorm_ge0 ?mulr_ge0// ltW. Unshelve. all: by end_near. Qed. Definition V1dot (zp1_z2 : 'rV[K]_6) : K := @@ -1288,7 +1287,7 @@ Qed.*) Abort.*) Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : sol 0 \in Tilt.Upsilon1 -> sol_is_deriv_co (fun=> phi) 0 D sol -> - (forall t, 0 < t < D -> differentiable sol t) -> + (forall t, t \in `]0, D[%R -> differentiable sol t) -> forall t : K, 0 < t < D -> 'D~(sol) (V1 alpha1 gamma) t <= 0. Proof. @@ -1464,31 +1463,24 @@ Lemma equilibrium_zero_stable : is_stable_at phi Init Tilt.point1. Proof. move=> Init0 openInit Init_in_state. -apply: (@Lyapunov_stability0 K _ phi Init openInit (V1 alpha1 gamma)). +apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). - exact: V1_diff. -- move=> Delta /= sol sol0 solP t t0. - apply: (@derive_along_V1_le0 _ _ _ _ _ Delta sol). - + assumption. - + assumption. +- move=> D /= sol sol0 solP t t0. + apply: (@derive_along_V1_le0 _ _ _ _ _ D sol) => //. + rewrite inE. apply: Init_in_state. by rewrite inE in sol0. - + exact: solP. - + move=> /= t1 t10Delta. + + move=> /= t1 t10D. apply/derivable1_diffP. apply solP. - rewrite in_itv/=. - by case/andP : t10Delta => /ltW -> ->. - + exact: t0. + by apply: subset_itvr t10D; rewrite bnd_simp. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. rewrite /is_Lyapunov_candidate /Tilt.point1 => Hpos. rewrite /V1 lsubmx_const rsubmx_const; split => //. - split. - by rewrite !expr2 !enorm0 !mulr0 !mul0r add0r. - move=> z zin z_neq0. - case: Hpos => // _ [V1_eq0 V1_gt0]. - apply: V1_gt0 => //. - by rewrite inE. + + by rewrite !expr2 !enorm0 !mulr0 !mul0r add0r. + + move=> z zin z_neq0. + case: Hpos => // _ [V1_eq0]. + by apply => //; rewrite in_setT. Qed. End equilibrium_zero_stable. diff --git a/tilt_stability.v b/tilt_stability.v index b4ad48af..0e32a0a0 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -61,7 +61,7 @@ Context {R : realType} {T : normedModType R}. Implicit Types V : T -> R. Definition is_Lyapunov_candidate V (D : set T) (x : T) := - x \in D /\ V x = 0 /\ forall z, z \in D -> z != x -> V z > 0. + [/\ x \in D, V x = 0 & forall z, z \in D -> z != x -> V z > 0]. Definition locnegdef V (x : T) := V x = 0 /\ \forall z \near x^', V z < 0. @@ -439,40 +439,34 @@ Section about_Lyapunov_function. Context {K : realType} {n : nat}. Let U := 'rV[K]_n.+1. Variable phi : U -> U. -Variable Delta : K. +Variable D : K. Variable sol : K -> U. -Hypothesis solP : {in `[0, Delta[%R, forall t, derivable sol t 1}. +Hypothesis derivable_sol : {in `[0, D[%R, forall t, derivable sol t 1}. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis DV_le0 : forall t, 0 < t < Delta -> 'D~(sol) V t <= 0. +Hypothesis DV_le0 : forall t, t \in `]0, D[%R -> 'D~(sol) V t <= 0. -Lemma V_nincr a b : b < Delta -> 0 <= a <= b -> - V (sol b) <= V (sol a). +Lemma V_nincr a b : b < D -> 0 <= a <= b -> V (sol b) <= V (sol a). Proof. -move=> bDelta /andP[a_ge0 ab]. +move=> bD /andP[a_ge0 ab]. apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. - move=> y yb. apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. rewrite -derivable1_diffP. - apply: solP. - move: yb. - by apply: subset_itv; rewrite bnd_simp// ltW. + apply: derivable_sol. + by apply: subset_itv yb; rewrite bnd_simp// ltW. - move=> y yb. rewrite derive1E -derive_along_derive//. + apply: DV_le0. - move : yb; rewrite in_itv/= => /andP[->/= /lt_le_trans]; apply. - exact: ltW. + by apply: subset_itvl yb; rewrite bnd_simp ltW. + rewrite -derivable1_diffP. - apply: solP. - move: yb. - by apply: subset_itv; rewrite bnd_simp// ltW. + apply: derivable_sol. + by apply: subset_itv yb; rewrite bnd_simp// ltW. - (* `[0, b] *) have [b0|] := ltP 0 b; last first. move=> b0. - have ? : b = 0. - by apply/eqP; rewrite eq_le b0 (le_trans a_ge0)//. - subst b. + have -> : b = 0 by apply/eqP; rewrite eq_le b0 (le_trans a_ge0). rewrite set_itv1. exact: continuous_subspace1. apply/continuous_within_itvP => //; split. @@ -480,25 +474,23 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. apply: continuous_comp; last exact: differentiable_continuous. apply: differentiable_continuous => //. rewrite -derivable1_diffP. - apply: solP. - move: z0b. - by apply: subset_itv; rewrite bnd_simp// ltW. - + have d0 : 0 < Delta by apply /lt_trans/bDelta. - have cont : {in `[0, Delta[%R, continuous sol}. + apply: derivable_sol. + by apply: subset_itv z0b; rewrite bnd_simp// ltW. + + have d0 : 0 < D by exact/lt_trans/bD. + have cont : {in `[0, D[%R, continuous sol}. move=> t t0D. apply: differentiable_continuous. - apply/derivable1_diffP. - by apply solP. + exact/derivable1_diffP/derivable_sol. apply: cvg_comp. apply: cvg_at_right_filter. apply: cont. - by rewrite in_itv/= lexx. - by apply (differentiable_continuous (Vdiff (sol 0))). + by rewrite bound_itvE. + exact: (differentiable_continuous (Vdiff (sol 0))). + apply: cvg_at_left_filter. apply: differentiable_continuous => //. apply: differentiable_comp. rewrite -derivable1_diffP. - apply: solP. + apply: derivable_sol. by rewrite in_itv/= (ltW b0)// bDelta. exact: Vdiff. - by rewrite bound_itvE (le_trans a_ge0). @@ -523,7 +515,7 @@ Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. Hypothesis DV_le0 : forall D f, f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> - forall t, 0 < t < D -> 'D~(f) V t <= 0. + forall t, t \in `]0, D[%R -> 'D~(f) V t <= 0. (* khalil theorem 4.1 *) Theorem Lyapunov_stability0 : @@ -579,40 +571,41 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) have Df_Omega_beta D f : f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> - f 0 \in Omega_beta -> forall t, 0 < t < D -> f t \in Omega_beta. + f 0 \in Omega_beta -> forall t, t \in `]0, D[%R -> f t \in Omega_beta. move=> f0 solf f0_Omega. - have /= V_nincr_consequence t : 0 < t < D -> forall u, 0 <= u <= t -> + have /= V_nincr_consequence t : t \in `]0, D[%R -> forall u, 0 <= u <= t -> 'D~(f) V u <= 0 -> V (f t) <= V (f 0) <= beta. - move=> /= /andP[t0 tD] u ut Vle0l; apply/andP; split. + move=> /= t0D u ut Vle0l; apply/andP; split. - move: f0_Omega; rewrite inE /Omega_beta/= => -[Brphi0 Vphi0beta]. apply: (@V_nincr _ _ D f). + by move=> t' t'0D; apply solf. + by move=> t'; exact: Vdiff. + exact: DV_le0. - + assumption. - + by rewrite lexx/= (ltW t0). + + by rewrite (itvP t0D). + + by rewrite lexx/= (itvP t0D). - by move: f0_Omega; rewrite inE => -[]. - move=> t /andP[t0 tD]; rewrite inE; split; last first. - have : 'D~(f) V t <= 0 by apply: DV_le0 => //; [exact: solf|rewrite t0]. - have := @V_nincr_consequence t; rewrite t0 /= tD => /(_ isT t). - rewrite lexx (ltW t0)/= => /(_ isT) => /[apply]. + move=> t t0D; rewrite inE; split; last first. + have : 'D~(f) V t <= 0 by exact: (DV_le0 _ solf). + have := @V_nincr_consequence t t0D t. + rewrite lexx (itvP t0D)/= => /(_ isT) => /[apply]. by move=> /andP[/le_trans] => /[apply]. move: f0_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. rewrite !sub0r !normrN => -[f0r Vf0beta]. rewrite leNgt; apply/negP => rft. have [t1 /andP[t1_ge0 t1t] phit1r] : exists2 t0 : K , 0 <= t0 <= t & `|f t0| = r. + have t0 : 0 <= t by rewrite (itvP t0D). have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o f)}. - apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) f (ltW t0)) => //. + apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) f t0) => //. by move=> z _; exact: norm_continuous. have : {in `[0, D[, continuous f}. - move=> t' /[!inE] t'0D. + move=> t'; rewrite inE => t'0D. by apply/differentiable_continuous/derivable1_diffP; apply solf. move/continuous_in_subspaceT. apply: continuous_subspaceW. - by apply: subset_itvl; rewrite bnd_simp. + by apply: subset_itvl; rewrite bnd_simp (itvP t0D). have : Num.min `|f 0| `|f t| <= r <= Num.max `|f 0| `|f t|. by rewrite ge_min f0r/= le_max (ltW rft) orbT. - move=> /(IVT (ltW t0) norm_phi_cont)[c cI norm_phi_c]. + move=> /(IVT t0 norm_phi_cont)[c cI norm_phi_c]. by exists c => //; move/itvP: cI => ->. have alphaVphit1 : alpha <= V (f t1). rewrite {alpha_gt0 beta_alpha} /alpha; case: alpha_min => /=. @@ -622,11 +615,12 @@ have Df_Omega_beta D f : f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> apply/negP; rewrite -leNgt. move: t1_ge0; rewrite le_eqVlt => /predU1P[<-//|t10]. have := @V_nincr_consequence t1. - rewrite t10 (le_lt_trans t1t tD) => /(_ isT). + have tD : t < D by rewrite (itvP t0D). + rewrite in_itv/= t10/= (le_lt_trans t1t tD) => /(_ isT). move=> /(_ t1); rewrite (ltW t10) lexx => /(_ isT). have : 'D~(f) V t1 <= 0. apply: (@DV_le0 _ _ _ solf) => //. - by rewrite t10/= (le_lt_trans _ tD). + by rewrite in_itv/= t10/= (le_lt_trans _ tD). move=> /[swap] /[apply]. by move=> /andP[/le_trans] => /[apply]. have _ : compact Omega_beta. @@ -752,20 +746,18 @@ Lemma is_Lyapunov_candidate_substitution V x : is_Lyapunov_candidate V Init x -> is_Lyapunov_candidate (fun y => V (y + x)) [set y - x | y in Init] 0. Proof. -move=> [xInit [Vx0/= InitV]]. +move=> [xInit Vx0/= InitV]. split. - rewrite inE/=. +- rewrite inE/=. exists x; rewrite ?subrr//. by rewrite inE in xInit. -split. - by rewrite add0r. -rewrite /=. -move=> z. -rewrite inE/= => -[x0 x0Init <-{z}]. -rewrite subr_eq0 => x0x. -apply: InitV => //. - by rewrite subrK inE. -by rewrite subrK. +- by rewrite add0r. +- move=> /= z. + rewrite inE/= => -[x0 x0Init <-{z}]. + rewrite subr_eq0 => x0x. + apply: InitV => //. + by rewrite subrK inE. + by rewrite subrK. Qed. End is_equilibrium_point_change_of_variables. @@ -779,9 +771,10 @@ Hypothesis openInit : open Init. Variable V : U -> K. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall D (sol : K -> U), - sol_is_deriv_co (fun=> phi) 0 D sol -> - forall t, 0 < t < D -> 'D~(sol) V t <= 0. +Hypothesis V'_le0 : forall D (f : K -> U), + f 0 \in Init -> + sol_is_deriv_co (fun=> phi) 0 D f -> + forall t, 0 < t < D -> 'D~(f) V t <= 0. Theorem Lyapunov_stability : is_Lyapunov_candidate V Init `<=` is_stable_at phi Init. @@ -799,14 +792,13 @@ apply: (@Lyapunov_stability0 _ _ _ _ _ (fun y => V (y + x))). by apply: filter_filter; exact: mx_nbhs_filter. (* TODO: should be automatic! *) by apply: cvg_cst; apply: filter_filter; exact: mx_nbhs_filter. - by move=> t; exact: differentiable_comp. -- move=> /= Delta sol sol0 sol0Init /= t t0Delta. +- move=> /= D sol sol0 sol0Init /= t t0D. rewrite [leLHS](_ : _ = ('D~((fun y => y + x) \o sol) V) t); last first. rewrite derive_along_derive; last 2 first. exact: differentiable_comp. apply/derivable1_diffP. apply sol0Init. - rewrite in_itv/=. - by move/andP : t0Delta => [/ltW-> ->]. + by apply: subset_itvr t0D; rewrite bnd_simp. have -> : (fun y => V (y + x)) \o sol = V \o (+%R^~ x \o sol). exact/funext. rewrite derive_along_derive; last 2 first. @@ -814,19 +806,22 @@ apply: (@Lyapunov_stability0 _ _ _ _ _ (fun y => V (y + x))). apply: differentiable_comp => //. apply/derivable1_diffP. apply sol0Init. - rewrite in_itv/=. - by move/andP : t0Delta => [/ltW-> ->]. + by apply: subset_itvr t0D; rewrite bnd_simp. by []. - apply: (@V'_le0 Delta); last by assumption. - move=> /= z z0Delta. - split. - apply/derivable1_diffP. - apply: differentiable_comp => //. - apply/derivable1_diffP. + apply: (@V'_le0 D); last by assumption. + - rewrite inE/=. + move: sol0. + rewrite inE/= => -[x0 x0Init <-]. + by rewrite subrK. + - move=> /= z z0D. + split. + apply/derivable1_diffP. + apply: differentiable_comp => //. + apply/derivable1_diffP. + by apply sol0Init. + rewrite derive1E deriveD//; last by apply sol0Init. + rewrite derive_cst addr0 -derive1E. by apply sol0Init. - rewrite derive1E deriveD//; last by apply sol0Init. - rewrite derive_cst addr0 -derive1E. - by apply sol0Init. exact: is_Lyapunov_candidate_substitution. Qed. From 3c14f593ec72d2b6066666f4df1f3d99df868b15 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Wed, 18 Feb 2026 11:48:05 +0900 Subject: [PATCH 123/144] made interval size for symmetric version explicit --- ode.v | 226 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 120 insertions(+), 106 deletions(-) diff --git a/ode.v b/ode.v index f6cec108..297755b9 100644 --- a/ode.v +++ b/ode.v @@ -2194,40 +2194,12 @@ Definition phi_ (t : R) x := phi x. Definition is_sol_sym u0 t0 d (sol : R -> U):= sol t0 = u0 /\ sol_is_deriv_oo phi (t0-d) (t0+d) sol. -Let phi_lip2 t0: t0 \in `[a,b]%R -> {in `[t0, b]%R, forall x, k.-lipschitz_B (phi x)}. -Proof. -move => tab x abx; apply: lip2. -move : abx; rewrite !inE/=; apply subset_itvr. -by move : tab; rewrite in_itv/= bnd_simp => /andP[-> _]. -Qed. - -Let phi_cont1 t0 : t0 \in `[a,b]%R -> {in B, forall y, {within `[t0, b], continuous phi ^~ y}}. -Proof. -move => /= tab x Bx. -apply /continuous_subspaceW/cont1 => //. -apply: subset_itvr. -by move : tab; rewrite in_itv/= bnd_simp => /andP[-> _]. -Qed. - Let rho : {posnum R} := (2^-1)%:pos. Let rho1 : rho%:num < 1. Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. -Let cauchy_lipschitz_fwd t0 : t0 \in `]a,b[%R -> exists f delta, - delta > 0 /\ is_sol_oo (phi) u0 t0 (t0 + delta) f /\ - {in `[t0, t0 + delta]%R, forall t, closed_ball u0 r%:num (f t)}. -Proof. -rewrite /=in_itv/= => /andP[t0a t0b]. -have tab : t0 \in `[a,b]%R. - by rewrite in_itv/= !ltW. -have [d0 [solf cball]] := - cauchy_lipschitz_local t0b k0 (phi_lip2 tab) (phi_cont1 tab) rho1. -exists (@cauchy_lipschitz_local_f R n phi t0 _ k u0 r t0b k0 - (phi_lip2 tab) (phi_cont1 tab) rho rho1). -by exists (safe_dist phi t0 b k u0 r rho). -Qed. Lemma patch_in {X : Type} (f g : R -> X) S x : x \in S -> patch f S g x = g x. Proof. @@ -2264,19 +2236,55 @@ apply/(continuous_within_itvP _ ab); split. - by rewrite -{1}(opprK d); apply/cvg_at_rightNP; exact: fb. Qed. -Let phi_lip2' t0 : t0 \in `[a,b] -> {in `[-t0, -a]%R, forall x, k.-lipschitz_B (-phi (-x))}. +Let r2 := (r%:num/2)%:pos. +Let r4 := (r%:num/4)%:pos. + +Let ler4 : r4%:num <= r%:num. +Proof. by rewrite /r4/= ler_pdivrMr // ler_pMr // lerDl. Qed. +Let ler42 : r4%:num <= r2%:num. +Proof. by rewrite /r4/r2/= ler_pdivrMr// -mulrA ler_pMr // ler_pdivlMl // mulr1 lerD // lerDl. Qed. + +Let B4 := closed_ball u0 r4%:num. + +Let phi_lip2 t0: t0 \in `[a,b]%R -> {in `[t0, b]%R, forall x, k.-lipschitz_B4 (phi x)}. +Proof. +move => tab x abx /= y By. +apply: lip2. +move : abx; rewrite !inE/=; apply subset_itvr. +by move : tab; rewrite in_itv/= bnd_simp => /andP[-> _]. +split. +by apply /le_closed_ball/By.1. +by apply /le_closed_ball/By.2. +Qed. + +Let phi_cont1 t0 : t0 \in `[a,b]%R -> {in B4, forall y, {within `[t0, b], continuous phi ^~ y}}. +Proof. +move => /= tab x Bx. +apply /continuous_subspaceW/cont1 => //. +apply: subset_itvr. +by move : tab; rewrite in_itv/= bnd_simp => /andP[-> _]. +apply mem_set. +apply set_mem in Bx. +by apply /le_closed_ball/Bx. +Qed. + +Let phi_lip2' t0 : t0 \in `[a,b]%R -> {in `[-t0, -a]%R, forall x, k.-lipschitz_B4 (-phi (-x))}. Proof. move => t0ab /= y ab x B12. rewrite /= -normrN opprD !opprK. -apply: (lip2 _ B12). +have B12' : (B `*` B) x. + split. + by apply /le_closed_ball/B12.1. + by apply /le_closed_ball/B12.2. +apply: (lip2 _ B12'). move : ab. rewrite !in_itv/= lerNl lerNr => /andP[h1 ->]//=. apply (le_trans h1). move : t0ab. -by rewrite inE/=in_itv/= => /andP[]. +by rewrite in_itv/= => /andP[]. Qed. -Local Lemma phi_cont1' t0 : t0 \in `[a,b] -> {in B, forall y, {within `[-t0, -a], continuous -(fun t => phi (-t) y)}}. +Local Lemma phi_cont1' t0 : t0 \in `[a,b]%R -> {in B4, forall y, {within `[-t0, -a], continuous -(fun t => phi (-t) y)}}. Proof. move => t0ab /= y By. move => t. @@ -2285,70 +2293,81 @@ have /within_continuous_minus : {within `[-(-a), - (-t0)], continuous phi^~ y}. rewrite !opprK. apply /continuous_subspaceW/cont1 => //. apply : subset_itvl. - by move: t0ab; rewrite inE/=in_itv/= bnd_simp => /andP[]. + by move: t0ab; rewrite /=in_itv/= bnd_simp => /andP[]. +apply set_mem in By. +apply mem_set. +by apply : le_closed_ball By. apply. Qed. -Lemma cauchy_lipschitz_sym t0 : t0 \in `]a,b[%R -> exists f delta, delta > 0 /\ is_sol_sym u0 t0 delta f. + +Let dplus t0 := safe_dist phi t0 b k u0 (r4%:num)%:pos rho. +Let dminus t0 := safe_dist (fun t x => - phi (-t) x) (-t0) (-a) k u0 (r4%:num)%:pos rho. +Let dboth t0 := Num.min (b-t0) (Num.min (dplus t0) (dminus t0)). +(* Let fplus t0 t0b t0ab := @cauchy_lipschitz_local_f R n phi t0 _ k u0 (r%:num/4)%:pos *) +(* t0b k0 (phi_lip2 t0ab) (phi_cont1 t0ab) rho rho1. *) +(* Let fminus t0 t0a t0ab := *) +(* @cauchy_lipschitz_local_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r *) +(* t0a k0 (phi_lip2' t0ab) (phi_cont1' t0ab) rho rho1. *) +Lemma cauchy_lipschitz_sym t0 : t0 \in `]a,b[%R -> exists f, is_sol_sym u0 t0 (dboth t0) f. Proof. move => t0ab. -have t0ab' : t0 \in `[a,b]. +have t0ab' : t0 \in `[a,b]%R. by rewrite inE;apply: subset_itv_oo_cc. -have [fplus [dplus [dplus0 [solplus cplus]]]] := cauchy_lipschitz_fwd t0ab. +have t0b : t0 < b. + move: t0ab. + by rewrite in_itv/= => /andP[]. +have [dplus0 [solplus cplus]] := + cauchy_lipschitz_local t0b k0 + (phi_lip2 t0ab') (phi_cont1 t0ab') rho1. +set fplus := @cauchy_lipschitz_local_f R n phi t0 _ k u0 r4 t0b k0 + (phi_lip2 t0ab') (phi_cont1 t0ab') rho rho1. have amin1 : -t0 < -a. rewrite ltrNr opprK. by move : t0ab; rewrite in_itv/= => /andP[]. -have [dminus0 [solminus cminus]] := +have dminus0 : 0 < dminus t0. + by apply safe_dist_gt0. + +have [_ [solminus cminus]] := cauchy_lipschitz_local amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho1. - set fminus0 := - @cauchy_lipschitz_local_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r + @cauchy_lipschitz_local_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r4 amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho rho1. -set dminus := safe_dist (fun t x => - phi (-t) x) (-t0) (-a) k u0 r rho. set fminus := fminus0 \o -%R. -set r2 := (r%:num/2)%:pos. -set r4 := (r%:num/4)%:pos. -have ler4 : r4%:num <= r%:num. - by rewrite /r4/= ler_pdivrMr // ler_pMr // lerDl. -have ler42 : r4%:num <= r2%:num. - by rewrite /r4/r2/= ler_pdivrMr// -mulrA ler_pMr // ler_pdivlMl // mulr1 lerD // lerDl. -have adplus : t0 < t0 + dplus by rewrite ltrDl dplus0. +have adplus : t0 < t0 + dplus t0 by rewrite ltrDl dplus0. have cfplus := And33 solplus. rewrite closure_neitv_oo in cfplus; last by rewrite ltrDl. -have [rpos hropos] := ode.continuous_confined (a:=t0) (b:=t0 + dplus) (u0:=u0) r4 adplus cfplus (And31 solplus). -have amind : -t0 < -t0 + dminus by rewrite ltrDl dminus0. +have amind : -t0 < -t0 + dminus t0 by rewrite ltrDl dminus0. have cfminus' := And33 solminus. rewrite closure_neitv_oo in cfminus'; last by rewrite ltrDl. -have cfminus : {within `[t0-dminus, t0], continuous fminus}. +have cfminus : {within `[t0-dminus t0, t0], continuous fminus}. rewrite /fminus. apply: within_continuous_minus. apply /continuous_subspaceW/cfminus'. apply: subset_itvl. rewrite -/dminus. by rewrite bnd_simp/= opprD opprK. -have [rneg hrneg] := ode.continuous_confined (a:=-t0) (b:=-t0 + dminus) (u0:=u0) r4 amind cfminus' (And31 solminus). -set dboth := Num.min (b-t0) (Num.min dplus (Num.min dminus (Num.min rneg%:num rpos%:num))). -have dboth0 : 0 < dboth. +have dboth0 : 0 < dboth t0. rewrite lt_min; apply /andP;split; last by rewrite lt_min dplus0 //= lt_min dminus0 //=. rewrite subr_gt0. move : t0ab. by rewrite in_itv/= => /andP[]. -pose f := patch fplus `[t0 - dboth, t0] fminus. -set uneg := f (t0 - dboth). +pose f := patch fplus `[t0 - dboth t0, t0] fminus. +set uneg := f (t0 - dboth t0). have Buneg : closed_ball uneg (r%:num/2) `<=` closed_ball u0 r%:num. rewrite /uneg/f patch_in/f/=;last first. by rewrite inE/=in_itv/= gerBl lexx ltW. move => /=x xb. apply: (closed_ball_split _ xb) => //. - suff : fminus (t0 - dboth) \in closed_ball u0 (r%:num/4). + suff : fminus (t0 - dboth t0) \in closed_ball u0 (r%:num/4). rewrite !inE. apply le_closed_ball. rewrite ler_pdivrMr//= -mulrA /=ler_peMr//. by rewrite ler_pdivlMl //= mulr1 ltW // ler_ltD //= ltrDl. - apply hrneg. - rewrite inE/=in_itv/= opprB lerDr ltW //= addrC lerD //. - by rewrite /dboth ge_min; do 3 (apply /orP; right; rewrite ge_min);apply /orP;left. + apply mem_set;apply: cminus. + rewrite in_itv/= opprB lerDr ltW //= addrC lerD // . + by rewrite /dboth/dplus 3!ge_min lexx !orbT. have f01intersect : fminus t0 = fplus t0. by rewrite /fminus/= (And31 solminus) (And31 solplus). have fa : f t0 = u0. @@ -2356,7 +2375,7 @@ have fa : f t0 = u0. apply solminus. by rewrite inE/=in_itv/= lexx gerBl ltW. set B' := closed_ball uneg (r2%:num). -have lip2' : {in `[t0-dboth,t0+dboth], forall x, k.-lipschitz_B' (phi x)}. +have lip2' : {in `[t0-dboth t0 ,t0+dboth t0], forall x, k.-lipschitz_B' (phi x)}. move => /= t tab [x1 x2] [Bx1 Bx2]. apply lip2 => //. move : tab. @@ -2367,15 +2386,15 @@ have lip2' : {in `[t0-dboth,t0+dboth], forall x, k.-lipschitz_B' (phi x)}. rewrite -lerBrDl. by rewrite !ge_min lexx. by split;apply Buneg. -have contf_minus : {within `[t0 - dboth, t0], continuous fminus}. +have contf_minus : {within `[t0 - dboth t0, t0], continuous fminus}. apply /continuous_subspaceW/cfminus. apply: subset_itvr. by rewrite bnd_simp /= lerD //= lerNr opprK 3!ge_min lexx !orbT. -have contf_plus : {within `[t0, t0+dboth], continuous fplus}. +have contf_plus : {within `[t0, t0+dboth t0], continuous fplus}. apply /continuous_subspaceW/cfplus. apply: subset_itvl. - by rewrite bnd_simp /= lerD //= 3!ge_min lexx !orbT. -have contf : {within `[t0 - dboth, (t0 + dboth)%E], continuous f}. + by rewrite bnd_simp /= lerD //= 2!ge_min lexx !orbT. +have contf : {within `[t0 - dboth t0, (t0 + dboth t0)%E], continuous f}. apply : within_continuous_patch => //. by rewrite gtrBl. by rewrite ltrDl. @@ -2384,50 +2403,47 @@ have r42 : r4%:num = (r2%:num / 2). rewrite -mulrA. apply congr2 => //. by rewrite -invfM -natrM. -have fc : {in `[t0-dboth, (t0 + dboth)], forall t : R, closed_ball (fminus (t0 - dboth)) r2%:num (f t)}. +have fc : {in `[t0-dboth t0, (t0 + dboth t0)], forall t : R, closed_ball (fminus (t0 - dboth t0)) r2%:num (f t)}. move => t tad. rewrite /f/=/patch/=. - have : (closed_ball (fminus (t0-dboth)) (r4%:num)) u0. - suff: (fminus (t0-dboth)) \in closed_ball u0 (r4%:num). + have : (closed_ball (fminus (t0-dboth t0)) (r4%:num)) u0. + suff: (fminus (t0-dboth t0)) \in closed_ball u0 (r4%:num). by rewrite inE/= !closed_ballE/closed_ball_/= // distrC . - apply: hrneg. - rewrite !inE/=!in_itv/= lerNr lerNl opprD !opprK gerBl ltW //= lerB //. - by rewrite !ge_min lexx !orbT. + apply mem_set;apply cminus. + rewrite !in_itv/= lerNr lerNl opprD !opprK gerBl ltW //= lerB //. + by rewrite /dboth/dminus 3!ge_min lexx !orbT. rewrite r42. move => c1. case : ifP => ht. - have : (fminus t) \in closed_ball u0 (r4%:num). - apply: hrneg. - move : ht. - rewrite !inE/=!in_itv/= lerNr lerNl opprD !opprK => /andP[h1 ->//=]. - apply: (le_trans _ h1). - rewrite lerB //. - by rewrite !ge_min lexx !orbT. + apply mem_set;apply cminus. + move: ht. + rewrite inE/=!in_itv/= lerNr lerNl opprD !opprK => /andP[h1 ->//=]. + apply: (le_trans _ h1). + by rewrite lerB // 3!ge_min lexx !orbT. rewrite inE. rewrite !r42. move => c2. apply: (closed_ball_split _ c2) =>//. - have : (fplus t) \in closed_ball u0 (r4%:num). - have ht' : t \in `[t0, t0 + dboth]. + have ht' : t \in `[t0, t0 + dboth t0]. have := tad. rewrite !inE /=!in_itv/= => /andP[h1 ->]; apply /andP; split => //. have [hat | hat] := lerP t0 t => //. rewrite -ht. by rewrite inE/=in_itv/= h1//= ltW. - apply: hropos. + apply mem_set;apply cplus. move : ht'. - rewrite !inE/= !in_itv/= => /andP[-> h1//=]. - apply: (le_trans h1). - rewrite lerD //. - by rewrite !ge_min lexx !orbT. + rewrite inE/= !in_itv/= => /andP[-> h1//=]. + apply: (le_trans h1). + by rewrite lerD // /dboth /dplus 2!ge_min lexx !orbT. rewrite inE. rewrite !r42. move => c2. apply: (closed_ball_split _ c2) =>//. -exists f, dboth. +exists f. split => //. -suff h: is_sol_oo phi (f (t0-dboth)) (t0-dboth) (t0+dboth) f. - by split => //;apply:(And32 h). +suff h: is_sol_oo phi (f (t0-dboth t0)) (t0-dboth t0) (t0+dboth t0) f by apply (And32 h). have kn0 : k != 0 by apply lt0r_neq0. apply /(integral_sol_iff_sol (r := r2) kn0) => //. by rewrite ler_ltD // gtrN. @@ -2481,13 +2497,12 @@ apply solution_extends => //. move => _ [/= t' tp] <-. apply (le_closed_ball (e1:=r4%:num)) => //. suff : (fminus t') \in closed_ball u0 r4%:num by rewrite inE. - apply hrneg. - move : tp. - rewrite in_itv/=inE/=in_itv/= lerNl opprK => /andP[h0 ->//=]. - rewrite lerNl opprD opprK //=. - apply: (le_trans _ h0). - rewrite lerB //. - by rewrite !ge_min lexx !orbT. + apply mem_set;apply cminus. + move : tp. + rewrite !in_itv/=lerNl opprK => /andP[h0 ->//=]. + rewrite lerNl opprD opprK //=. + apply: (le_trans _ h0). + by rewrite lerB // 3!ge_min lexx !orbT. - apply : (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). exact: contf_plus. move => x bx. @@ -2509,12 +2524,11 @@ apply solution_extends => //. move => _ [/= t' tp] <-. apply (le_closed_ball (e1:=r4%:num)) => //. suff : (fplus t') \in closed_ball u0 r4%:num by rewrite inE. - apply hropos. + apply mem_set;apply cplus. move : tp. - rewrite in_itv/=inE/=in_itv/= => /andP[-> h0 //=]. - apply: (le_trans h0). - rewrite lerD //=. - by rewrite !ge_min lexx !orbT. + rewrite !in_itv/= => /andP[-> h1//=]. + apply: (le_trans h1). + by rewrite lerD // /dboth /dplus 2!ge_min lexx !orbT. - apply /(integral_sol_iff_sol (r:=r2) kn0). + by rewrite gtrBl. + move => x bx. @@ -2537,7 +2551,7 @@ apply solution_extends => //. + move => _ [t tp] <-. rewrite {1}/f patch_in;last first. by rewrite inE/=in_itv/= lexx //= gerBl ltW. - have tin : t \in `[t0-dboth, t0+dboth]. + have tin : t \in `[t0-dboth t0, t0+dboth t0]. move : tp. rewrite !inE. apply: subset_itv; rewrite bnd_simp //. @@ -2621,12 +2635,11 @@ apply solution_extends => //. rewrite /fminus /=(And31 solminus). apply : (le_closed_ball ler42). suff : fplus t \in closed_ball u0 r4%:num by rewrite inE. - apply hropos. - move : tp. - rewrite !inE/=!in_itv/= => /andP[-> h0]//=. - apply (le_trans h0). - rewrite lerD //=. - by rewrite !ge_min lexx !orbT. + apply mem_set;apply cplus. + move /mem_set : tp. + rewrite inE /=!in_itv/= => /andP[-> h1//=]. + apply: (le_trans h1). + by rewrite lerD // /dboth /dplus 2!ge_min lexx !orbT. rewrite /fminus /=(And31 solminus). split. apply solplus. @@ -2635,14 +2648,15 @@ apply solution_extends => //. move : tad. rewrite !in_itv/= => /andP[-> h0]//=. apply (lt_le_trans h0). - by rewrite lerD //= !ge_min lexx !orbT. + by rewrite lerD //= /dboth /dplus 2!ge_min lexx !orbT. apply /continuous_subspaceW/cfplus. rewrite closure_neitv_oo;last by rewrite ltrDl. apply subset_itvl. rewrite bnd_simp /=. - by rewrite lerD //= !ge_min lexx !orbT. + by rewrite lerD //= /dboth /dplus 2!ge_min lexx !orbT. Qed. End picard_symmetric. +(* only for autonomous, used for tilt *) Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. From f3f594006e1c0562ae4123b16e6225a4beb2a45a Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 18 Feb 2026 17:41:55 +0900 Subject: [PATCH 124/144] renaming --- ode.v | 92 +++++++++++++++++++++++++++---------------------------- ode_wip.v | 3 +- 2 files changed, 47 insertions(+), 48 deletions(-) diff --git a/ode.v b/ode.v index 297755b9..ab722d54 100644 --- a/ode.v +++ b/ode.v @@ -1566,7 +1566,7 @@ rewrite picard_fix_init. exact: picard_funE img_cball_picard_fix. Qed. -Theorem cauchy_lipschitz_unique (picard_fix' : V) : img_cball picard_fix' -> +Theorem picard_fix_unique (picard_fix' : V) : img_cball picard_fix' -> (forall t, t \in `[a, a + safe_dist]%R -> picard_fix' t = u0 + \vint[mu]_(x in `[a, t]) phi x (picard_fix' x)) -> picard_fix = picard_fix'. @@ -1589,7 +1589,7 @@ rewrite (_ : repr picard_fix' x = picard_fix' x)//. by rewrite h// subrr. Qed. -Theorem cauchy_lipschitz_existence : picard_fix a = u0 /\ +Theorem cauchy_lipschitz_ex : picard_fix a = u0 /\ {in `]a, a + safe_dist[%R, forall x, picard_fix^`() x = phi x (picard_fix x)}. Proof. split; first exact: picard_fix_init. @@ -1656,7 +1656,8 @@ Hypothesis cont1 : {within `[a, b], continuous (fun x => phi x (sol1 x))}. Hypothesis cont2 : {within `[b, c], continuous (fun x => phi x (sol2 x))}. Hypothesis matchb : sol1 b = sol2 b. -Lemma solution_extends : is_integral_sol phi u0 a b sol1 -> +Lemma is_integral_sol_patch : + is_integral_sol phi u0 a b sol1 -> is_integral_sol phi (sol1 b) b c sol2 -> is_integral_sol phi u0 a c (patch sol2 `[a, b] sol1). Proof. @@ -1772,11 +1773,14 @@ Hypothesis rho1 : rho%:num < 1. (* Let rho1 : rho%:num < 1. *) (* Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. *) -Definition local_solution := repr (picard_fix ab k0 lip2 cont1 rho1). - Local Notation safe_dist := (safe_dist phi a b k u0 r rho). -Lemma solution_local_solution : is_sol_oo phi u0 a (a + safe_dist) local_solution. +Definition cauchy_lipschitz_f : + continuousFunType `[a, a + safe_dist] [set: 'rV[R]_n] := + repr (picard_fix ab k0 lip2 cont1 rho1). + +Lemma is_sol_cauchy_lipschitz_f : + is_sol_oo phi u0 a (a + safe_dist) cauchy_lipschitz_f. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. - by rewrite ltDl_safe_dist. @@ -1788,40 +1792,35 @@ apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. apply/continuous_subspaceW/cont1 => //. apply: subset_itvl => //=. by rewrite bnd_simp -lerBrDl safe_dist_itv. -- rewrite /local_solution. - exact: cts_fun. +- exact: cts_fun. - by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. - exact: cauchy_lipschitz_integral_version. Qed. Lemma solution_stays_in_ball : - {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (local_solution t)}. + {in `[a, a + safe_dist]%R, + forall t, closed_ball u0 r%:num (cauchy_lipschitz_f t)}. Proof. by move=> t; move => /cauchy_lipschitz_in_cball; exact. Qed. Lemma solution_continuous : - {within `[a, a + safe_dist], continuous local_solution}. + {within `[a, a + safe_dist], continuous cauchy_lipschitz_f}. Proof. exact: cts_fun. Qed. -Definition cauchy_lipschitz_local_f : - continuousFunType `[a, a + safe_dist] [set: 'rV[R]_n] := - repr (picard_fix ab k0 lip2 cont1 rho1). - -Let f := cauchy_lipschitz_local_f. +Let f := cauchy_lipschitz_f. -Theorem cauchy_lipschitz_local : - safe_dist > 0 /\ +Theorem cauchy_lipschitz : safe_dist > 0 /\ is_sol_oo phi u0 a (a + safe_dist) f /\ {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (f t)}. Proof. split; first exact: safe_dist_gt0. split. -- exact: solution_local_solution. +- exact: is_sol_cauchy_lipschitz_f. - exact: solution_stays_in_ball. Qed. Local Notation V := (@ContSeg_quot.quot_contSeg R a (a + safe_dist) U). -Theorem cauchy_lipschitz_local_unique f' : +Theorem cauchy_lipschitz_unique f' : {within `[a, a + safe_dist], continuous f'} -> {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (f' t)} -> is_sol_oo phi u0 a (a + safe_dist) f' -> @@ -1841,7 +1840,7 @@ move=> f'au0 h1 t tab. have fc : contseg a (a + safe_dist) f' by exact: mem_set. have pieq : \pi_V%qT f = \pi_V%qT (contseg_Sub fc). rewrite reprK. - apply: cauchy_lipschitz_unique. + apply: picard_fix_unique. move => /= _ [t' tad' ] <- /=. rewrite /ContSeg_quot.fun_of_quot_contSeg. suff -> : (repr (\pi_V%qT (contseg_Sub fc))) t' = f' t'. @@ -1865,6 +1864,7 @@ Qed. End cauchy_lipschitz_local. +(* TODO: move *) Section continuous_confined. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. @@ -1918,7 +1918,7 @@ Hypothesis sol1 : is_sol_oo phi u0 a b f. Let rho_max : {posnum R} := (2^-1)%:pos. Let dmax rho := safe_dist phi a b k u0 r rho. -Let fc := local_solution ab k0 lip2 cont1. +Let fc := cauchy_lipschitz_f ab k0 lip2 cont1. Lemma initial_solution_unique f' : {within `[a, b], continuous f'} -> is_sol_oo phi u0 a b f' -> @@ -1950,7 +1950,7 @@ have [rho [drho1 drho2]] : exists rho, dmax rho <= (Num.min d1%:num d2%:num) /\ have drho_pos : 0 < dmax rho by exact: safe_dist_gt0. exists rho, (PosNum drho_pos), drho2; split => //. - move => t tad. - apply/esym; apply: cauchy_lipschitz_local_unique. + apply/esym; apply: cauchy_lipschitz_unique. - apply/continuous_subspaceW/cf => //. apply: subset_itvl => //=. by rewrite bnd_simp -lerBrDl;apply safe_dist_itv. @@ -1968,7 +1968,7 @@ exists rho, (PosNum drho_pos), drho2; split => //. by apply: subset_itvl; rewrite bnd_simp -lerBrDl safe_dist_itv. - exact: tad. move => t tad. -apply/esym; apply : cauchy_lipschitz_local_unique. +apply/esym; apply : cauchy_lipschitz_unique. - apply/continuous_subspaceW/cf' => //. by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl;apply safe_dist_itv. - move=> t0 t0ad. @@ -2017,6 +2017,10 @@ Proof. by move=> cf cg x; apply: cvgB; [exact: cf|exact: cg]. Qed. +(* only for autonomous, used for tilt *) +Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := + forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. + Section uniqueness. Context {R : realType} {n : nat} (a b : R). Notation U := 'rV[R]_n. @@ -2025,14 +2029,14 @@ Hypothesis ab : a < b. Variables (u0 : U). Hypothesis cont1 : forall y, {within `[a, b], continuous phi ^~ y}. -Hypothesis phi_loclip : - forall x, exists r k : {posnum R}, +(* TODO(urgent): replace loclip w*) +Hypothesis phi_loclip : forall x, exists r k : {posnum R}, forall t, k%:num.-lipschitz_(closed_ball x r%:num) (phi t). Variables (f : R -> U) (f' : R -> U). Hypothesis sol1 : is_sol_oo phi u0 a b f. Hypothesis sol2 : is_sol_oo phi u0 a b f'. -Lemma locally_unique_extends t : a <= t < b -> f' t = f t -> +Local Lemma cauchy_lipschitz_unique_right_extension t : a <= t < b -> f' t = f t -> exists Delta : {posnum R}, {in `[t, t + Delta%:num]%R, f =1 f'}. Proof. move=> /andP[ta tb] eq. @@ -2055,7 +2059,7 @@ have sol20 : is_sol_oo phi (f t) t b f'. move=> t0 tab. apply sol2. by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. -have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) (phi x)}. +have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) (phi x)}. by move => t0 _;apply L. have cont1' : {in closed_ball (f t) r%:num, forall y : 'rV_n, {within `[t, b], continuous phi^~ y}}. @@ -2073,7 +2077,7 @@ move=> t; rewrite in_itv/= -eq_le => /eqP <-. by rewrite (And31 sol1) (And31 sol2). Qed. -Lemma solution_unique : {in `[a, b]%R, f =1 f'}. +Lemma locally_cauchy_lipschitz_unique : {in `[a, b]%R, f =1 f'}. Proof. set E := `[a, b]%classic `&` [set t | {in `[a, t]%R, f =1 f'}]. suff : E b by case. @@ -2163,7 +2167,7 @@ have supeq : f' (sup E) = f (sup E). have [h|h] := leP b (sup E). apply: (mon _ supE) => //. by rewrite in_itv/= (ltW ab). -have [|Delta Hdelta] := locally_unique_extends _ supeq; first by apply/andP. +have [|Delta Hdelta] := cauchy_lipschitz_unique_right_extension _ supeq; first by apply/andP. have Delta0 : 0 < Delta%:num by []. suff : Num.min b (sup E + Delta%:num) <= sup E. rewrite ge_min => /orP[/(lt_le_trans h)|]. @@ -2309,7 +2313,8 @@ Let dboth t0 := Num.min (b-t0) (Num.min (dplus t0) (dminus t0)). (* Let fminus t0 t0a t0ab := *) (* @cauchy_lipschitz_local_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r *) (* t0a k0 (phi_lip2' t0ab) (phi_cont1' t0ab) rho rho1. *) -Lemma cauchy_lipschitz_sym t0 : t0 \in `]a,b[%R -> exists f, is_sol_sym u0 t0 (dboth t0) f. +Lemma cauchy_lipschitz_sym t0 : t0 \in `]a, b[%R -> + exists f, is_sol_sym u0 t0 (dboth t0) f. Proof. move => t0ab. have t0ab' : t0 \in `[a,b]%R. @@ -2318,21 +2323,20 @@ have t0b : t0 < b. move: t0ab. by rewrite in_itv/= => /andP[]. have [dplus0 [solplus cplus]] := - cauchy_lipschitz_local t0b k0 + cauchy_lipschitz t0b k0 (phi_lip2 t0ab') (phi_cont1 t0ab') rho1. -set fplus := @cauchy_lipschitz_local_f R n phi t0 _ k u0 r4 t0b k0 +set fplus := @cauchy_lipschitz_f R n phi t0 _ k u0 r4 t0b k0 (phi_lip2 t0ab') (phi_cont1 t0ab') rho rho1. have amin1 : -t0 < -a. rewrite ltrNr opprK. by move : t0ab; rewrite in_itv/= => /andP[]. have dminus0 : 0 < dminus t0. by apply safe_dist_gt0. - have [_ [solminus cminus]] := - cauchy_lipschitz_local amin1 k0 + cauchy_lipschitz amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho1. set fminus0 := - @cauchy_lipschitz_local_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r4 + @cauchy_lipschitz_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r4 amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho rho1. set fminus := fminus0 \o -%R. have adplus : t0 < t0 + dplus t0 by rewrite ltrDl dplus0. @@ -2474,9 +2478,9 @@ apply /(integral_sol_iff_sol (r := r2) kn0) => //. rewrite {1}/f patch_in;last first. by rewrite inE/=in_itv/= lexx //= gerBl ltW. by apply fc; rewrite inE. -apply solution_extends => //. +apply: is_integral_sol_patch => //. - by rewrite gtrBl. -- apply : (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). +- apply: (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). exact: contf_minus. move => x bx. apply lip2. @@ -2608,9 +2612,9 @@ apply solution_extends => //. by rewrite ge_min lexx. split => /=. rewrite /B. - apply: (le_closed_ball _ Bx1). + apply: (le_closed_ball _ Bx1). by rewrite ler_pdivrMr // ler_pMr // lerDr. - apply: (le_closed_ball _ Bx2). + apply: (le_closed_ball _ Bx2). by rewrite ler_pdivrMr // ler_pMr // lerDr. + move => t tab. apply /continuous_subspaceW/cont1. @@ -2638,7 +2642,7 @@ apply solution_extends => //. apply mem_set;apply cplus. move /mem_set : tp. rewrite inE /=!in_itv/= => /andP[-> h1//=]. - apply: (le_trans h1). + apply: (le_trans h1). by rewrite lerD // /dboth /dplus 2!ge_min lexx !orbT. rewrite /fminus /=(And31 solminus). split. @@ -2648,15 +2652,11 @@ apply solution_extends => //. move : tad. rewrite !in_itv/= => /andP[-> h0]//=. apply (lt_le_trans h0). - by rewrite lerD //= /dboth /dplus 2!ge_min lexx !orbT. + by rewrite lerD //= /dboth /dplus 2!ge_min lexx !orbT. apply /continuous_subspaceW/cfplus. rewrite closure_neitv_oo;last by rewrite ltrDl. apply subset_itvl. rewrite bnd_simp /=. - by rewrite lerD //= /dboth /dplus 2!ge_min lexx !orbT. + by rewrite lerD //= /dboth /dplus 2!ge_min lexx !orbT. Qed. End picard_symmetric. - -(* only for autonomous, used for tilt *) -Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := - forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. diff --git a/ode_wip.v b/ode_wip.v index 655df58f..362e66fc 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -65,8 +65,7 @@ apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. apply/continuous_subspaceW/cont1 => //. by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl safe_dist_itv. by rewrite inE. -- rewrite /local_solution. - exact: cts_fun. +- exact: cts_fun. - by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. - exact: cauchy_lipschitz_integral_version. Qed. From cf45f42be4c966e072215a1565d2ee613e24ef6f Mon Sep 17 00:00:00 2001 From: yosakaon <26559721+yosakaon@users.noreply.github.com> Date: Wed, 18 Feb 2026 16:42:14 +0100 Subject: [PATCH 125/144] proof of dRu + comment on the abort --- tilt_lyapunov.v | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index a3c275ee..3de9cf1b 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -106,22 +106,21 @@ Qed. (* not used but could be interesting *) Lemma dRu t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) (w' := ang_vel T) - : 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(w' t) + 'D_1 u t *m T t. + : (forall t, derivable u t 1) -> (forall t, derivable T t 1) -> (forall t, t \is 'SO[K]_3) -> 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(w' t) + 'D_1 u t *m T t. Proof. -rewrite derive_mulmx; last 2 first. - admit. - admit. +move => deru dert TisSO. +rewrite derive_mulmx => //. rewrite addrC. congr(_+_). -rewrite -ang_vel_mxE; last 2 first. - admit. - admit. +rewrite -ang_vel_mxE ; last 2 first. + by move => t0; rewrite rotation_sub. + exact : dert. rewrite -mulmxA. rewrite mulmxE. rewrite -derive1mx_ang_vel; last first. - admit. + by move => t0; rewrite rotation_sub. by []. -Abort. +Qed. (* eqn (10/11): we write x_1 * S(w) whereas it is - S(w) * x_1 in [benallegue2023itac] *) Notation y_a := (y_a R g0). @@ -852,6 +851,7 @@ Definition locally_exponentially_stable_at n (eqn : 'rV[K]_n -> 'rV[K]_n) hurwitz (jacobian eqn point). (* TODO: rm? *) +(* lynda : future work ? *) Lemma tilt_eqn_is_locally_exponentially_stable_at_0 alpha1 gamma : locally_exponentially_stable_at (Tilt.eqn alpha1 gamma) Tilt.point1. Proof. @@ -1131,6 +1131,8 @@ Qed. (* TODO: rework of this proof is needed *) (* NB: unused *) +(* lynda : rm*) + Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : sol x 0 = Tilt.point1 -> sol_is_deriv_co (fun=> phi) 0 D (sol x) -> @@ -1213,6 +1215,7 @@ Proof. by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0.*) Abort. +(* lynda : remove *) Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) (zp1 := Left \o sol x) (z2 := Right \o sol x) : sol x 0 \in Tilt.Upsilon1 -> From ce6d5373bd2fa1385c2cc1ace8114e1a6fd7c56d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 19 Feb 2026 11:44:23 +0900 Subject: [PATCH 126/144] improve physmod section --- tilt_lyapunov.v | 201 +++++++++++++++++++++--------------------------- 1 file changed, 88 insertions(+), 113 deletions(-) diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index 3de9cf1b..bd7d7aca 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -16,12 +16,16 @@ Require Import ode tilt_stability. (* stable. *) (* *) (* ``` *) -(* S2 == unit sphere centered at 0 *) -(* Tilt.point{1.2} == equilibrium points *) -(* Tilt.Upsilon1 == state-space *) -(* Tilt.eqn == equation (14) in [benallegue2023itac] *) -(* u2 == 2x2 matrix to prove the Lyapunov function *) -(* V1 == Lyapunov function *) +(* S2 == unit sphere centered at 0 *) +(* Module PhysicalModel == This module contains a formalization of the *) +(* transformation of a system of measurements to *) +(* a differential equation that captures the error *) +(* dynamics. *) +(* Tilt.point{1.2} == equilibrium points *) +(* Tilt.Upsilon1 == state-space *) +(* Tilt.eqn == equation (14) in [benallegue2023itac] *) +(* u2 == 2 x 2 matrix to prove the Lyapunov function *) +(* V1 == Lyapunov function *) (* ``` *) (* *) (* Reference: *) @@ -45,36 +49,44 @@ Local Notation Right := (@rsubmx _ 1 3 3). Definition S2 {K : realType} := [set x : 'rV[K]_3 | `|x|_e = 1]. Module PhysicalModel. - -Section ya. -(* accelerometer measure *) +Section physicalmodel. Variable K : realType. -Variable R : K -> 'M[K]_3. (* L/W *) -Variable g0 : K. (*standard gravity constant*) -Let w t := ang_vel R t. (* local frame of the sensor (gyroscope) *) -Definition x2 t : 'rV_3 := 'e_2 *m R t. -Definition y_a x t := - x t *m \S(w t) + 'D_1 x t + g0 *: x2 t. (* world frame *) +Variable g0 : K. (* standard gravitational constant *) +Hypotheses g0_neq0 : g0 != 0. + +Variable R : K -> 'M[K]_3. (* orientation of frame L w.r.t. frame W *) +Hypothesis RisSO : forall t, R t \is 'SO[K]_3. + +Let w t := ang_vel R t. (* angular velocity *) + +(* tilt, eqn (8) *) +Definition x2 t : 'rV[K]_3 := 'e_2 *m R t. + +Lemma x2_S2 t : x2 t \in S2. +Proof. by rewrite /S2 /x2 inE/= orth_preserves_norm ?enormeE ?rotation_sub. Qed. + +(* what the accelerometer measures according to [benallegue2023itac] *) +Definition y_a x t := - x t *m \S(w t) + 'D_1 x t + g0 *: x2 t. + +(* proof that y_a is indeed the sum of linear and gravitational acceleration *) +Section y_aE. Variable p : K -> 'rV[K]_3. Let v := fun t : K => 'D_1 p t *m R t. -Hypothesis RisSO : forall t, R t \is 'SO[K]_3. -Lemma y_aE t (derivableR : forall t, derivable R t 1) - (derivablep : forall t, derivable p t 1) - (derivableDp : forall t, derivable ('D_1 p) t 1) : +Lemma y_aE t : (forall t, derivable R t 1) -> + (forall t, derivable p t 1) -> (forall t, derivable ('D_1 p) t 1) -> ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t = y_a v t. Proof. +move=> derivableR derivablep derivableDp. rewrite mulmxDl. rewrite /y_a/= /= /x2. congr +%R; last by rewrite scalemxAl. rewrite -ang_vel_mxE/=; last 2 first. - move=> t0. - by rewrite rotation_sub. - exact : derivableR. + by move=> ?; rewrite rotation_sub. + exact: derivableR. rewrite [in RHS]derive_mulmx => //. -rewrite derive1mx_ang_vel => //; last first. - by move=> t0; rewrite rotation_sub. -rewrite ang_vel_mxE// => //; last first. - by move=> t0; rewrite rotation_sub. +rewrite derive1mx_ang_vel//; last by move=> ?; rewrite rotation_sub. +rewrite ang_vel_mxE//; last by move=> ?; rewrite rotation_sub. rewrite addrCA. rewrite -mulmxE. rewrite -mulNmx. @@ -83,47 +95,35 @@ rewrite !mulNmx. by rewrite -mulmxA /= addrN addr0. Qed. -End ya. +End y_aE. -(* section III.A of [benallegue2023itac] *) -Section state_dynamics. -Variable K : realType. -Variable g0 : K. -Variable R : K -> 'M[K]_3. -Hypothesis RisSO : forall t, R t \is 'SO[K]_3. Hypothesis derivableR : forall t, derivable R t 1. -Variable v : K -> 'rV[K]_3. +Variable v : K -> 'rV[K]_3. (* linear velocity *) Let x1 t := v t. -Let x2 t : 'rV_3 := ('e_2) *m R t (* eqn (8) *). (* local frame ez ? *) -Let x1_dot t := 'D_1 x1 t. -Let x2_dot t := 'D_1 x2 t. -Let w t := ang_vel R t. -Lemma x2_S2 t : x2 t \in S2. -Proof. -by rewrite /S2 /x2 inE/= orth_preserves_norm ?enormeE ?rotation_sub. -Qed. +(* section III.A of [benallegue2023itac] *) +Section state_dynamics. -(* not used but could be interesting *) -Lemma dRu t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) (w' := ang_vel T) - : (forall t, derivable u t 1) -> (forall t, derivable T t 1) -> (forall t, t \is 'SO[K]_3) -> 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(w' t) + 'D_1 u t *m T t. +(* NB: not used *) +Lemma derive_ang_vel t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) : + (forall t, derivable u t 1) -> (forall t, derivable T t 1) -> + (forall t, t \is 'SO[K]_3) -> + 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(ang_vel T t) + 'D_1 u t *m T t. Proof. -move => deru dert TisSO. +move=> deru dert TisSO. rewrite derive_mulmx => //. -rewrite addrC. -congr(_+_). +rewrite addrC; congr +%R. rewrite -ang_vel_mxE ; last 2 first. by move => t0; rewrite rotation_sub. - exact : dert. + exact: dert. rewrite -mulmxA. rewrite mulmxE. -rewrite -derive1mx_ang_vel; last first. - by move => t0; rewrite rotation_sub. -by []. +by rewrite -derive1mx_ang_vel// => ?; rewrite rotation_sub. Qed. -(* eqn (10/11): we write x_1 * S(w) whereas it is - S(w) * x_1 in [benallegue2023itac] *) -Notation y_a := (y_a R g0). +(* eqn (10/11) *) +(* NB: we write x_i * S(w) whereas it is - S(w) * x_i in [benallegue2023itac], + row convention *) Lemma derive_x1 t : 'D_1 x1 t = x1 t *m \S(w t) + y_a x1 t - g0 *: x2 t. Proof. rewrite /y_a/= -addrA addrK. @@ -132,76 +132,54 @@ rewrite addrCA addrA mulNmx /= /w. by rewrite (addrC(-_)) subrr add0r. Qed. - (* eqn (11b): x_2 * S(w) instead of - S(w) * x_2 in [benallegue2023itac] *) -Lemma derive_x2 (t : K) : x2_dot t = x2 t *m \S( w t ). + (* eqn (11b) *) +Lemma derive_x2 t : 'D_1 x2 t = x2 t *m \S( w t ). Proof. -rewrite /w. -rewrite -ang_vel_mxE; last 2 first. - by move=> ?; rewrite rotation_sub. - by []. -rewrite /x2_dot. -rewrite /x2. -have ->: 'D_1 (fun t0 : K => 'e_2 *m (R t0)) t = - 'e_2 *m 'D_1 (fun t => (R t)) t. - move => n /=. +rewrite /w -ang_vel_mxE//; last by move=> ?; rewrite rotation_sub. +have -> : 'D_1 (fun t0 => 'e_2 *m (R t0)) t = 'e_2 *m 'D_1 R t. + move=> n /=. rewrite derive_mulmx//=. by rewrite derive_cst mul0mx add0r. -rewrite derive1mx_ang_vel /=; last first. - by move=> ?; rewrite rotation_sub. +rewrite derive1mx_ang_vel /=; last by move=> ?; rewrite rotation_sub. by rewrite mulmxA. Qed. End state_dynamics. +Hypothesis v_derivable : forall t, derivable v t 1. + (* section III.A in [benallegue2023itac] *) Section two_steps_first_order_estimator. -Context {K : realType}. +Notation y_a := (y_a v). Variables gamma alpha1 : K. -Variable v : K -> 'rV[K]_3. -Variable R : K -> 'M[K]_3. -Hypothesis derivableR : forall t, derivable R t 1. -Let w t := ang_vel R t. -Variable x1_hat : K -> 'rV[K]_3. + +Variable x1_hat : K -> 'rV[K]_3. (* estimator *) Hypothesis derivable_x1_hat : forall t, derivable x1_hat t 1. -Variable x2_hat : K -> 'rV[K]_3. -Variable g0 : K. -Hypotheses g0_eq0 : g0 != 0. -Notation y_a := (y_a R g0 v). -Let x1 t := v t. + +Variable x2_hat : K -> 'rV[K]_3. (* estimator *) +Hypothesis x2_hat_S2 : x2_hat 0 \in S2. +Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. +Hypothesis norm_x2_hat : forall t, `|x2_hat t|_e = 1. + Let x2'_hat t := - (alpha1 / g0) *: (x1 t - x1_hat t). (* eqn (12b) *) -(* we write x^_1 * S(w) instead - S(w) * x^_1 in [benallegue2023itac] *) + Hypothesis eqn12a : forall t, 'D_1 x1_hat t = x1_hat t *m \S(w t) + y_a t - g0 *: x2'_hat t. (* eqn (12a) *) -(* we write x^_2 * S(...) instead of - S(...) * x^_2 - and + gamma instead of - gamma in [benallegue2023itac] *) + Hypothesis eqn12c : forall t, - 'D_1 x2_hat t = x2_hat t *m \S(w t + gamma *: x2'_hat t *m \S(x2_hat t)). (* eqn (12c) *) -Hypothesis x2_hat_S2 : x2_hat 0 \in S2. -Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. -Hypothesis v_derivable : forall t, derivable v t 1. -Notation x2 := (x2 R). + 'D_1 x2_hat t = x2_hat t *m \S(w t + gamma *: x2'_hat t *m \S(x2_hat t)). + (* eqn (12c) *) + (* estimation error *) Let error1 t := x2 t - x2'_hat t. (* p_1 in [benallegue2023ieeetac] *) Let error2 t := x2 t - x2_hat t. (* \tilde{x_2} in [benallegue2023ieeetac] *) -Let error1_dot t := 'D_1 error1 t. -Let error2_dot t := 'D_1 error2 t. -Hypothesis RisSO : forall t, R t \is 'SO[K]_3. (* projection from the local frame to the world frame(?) *) Let error1_p t := error1 t *m (R t)^T (* z_p_1 in [benallegue2023ieeetac] *). Let error2_p t := error2 t *m (R t)^T. -Hypothesis norm_x2_hat : forall t, `|x2_hat t|_e = 1. - -Let error1E : error1 = fun t => x2 t + (alpha1 / g0) *: (x1 t - x1_hat t). -Proof. -apply/funext => ?. -rewrite /error1 /x2; congr +%R. -by rewrite /x2'_hat scaleNr opprK. -Qed. Let error2E t : error2 t = error2_p t *m R t. Proof. -rewrite /error2 -mulmxA. -by rewrite orthogonal_tr_mul ?rotation_sub// mulmx1. +by rewrite /error2 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. Qed. Let derivable_x2 t : derivable x2 t 1. Proof. exact: derivable_mulmx. Qed. @@ -214,24 +192,23 @@ Let derivable_error1 t : derivable error1 t 1. Proof. exact: derivableB. Qed. Let derivable_error2 t : derivable error2 t 1. Proof. exact: derivableB. Qed. (* eqn (13a) *) -(* we write p_1 * S(w) instead of - S(w) * p1 in [benallegue2023itac] *) Lemma derive_error1 t : 'D_1 error1 t = error1 t *m \S(w t) - alpha1 *: error1 t. Proof. simpl in *. -rewrite error1E. -rewrite deriveD//=; last first. - by apply: derivableZ => /=; exact: derivableB. +rewrite deriveB//=. rewrite deriveZ//=; last exact: derivableB. +rewrite scaleNr opprK. rewrite deriveB//. -rewrite !(derive_x2) // -/(x2 t) /=. -rewrite (derive_x1 g0 R) //. -rewrite -/(x2 t) -/(v t) -/(x1 t) -/(w t). +rewrite !derive_x2 // -/(x2 t) /=. +rewrite derive_x1//. rewrite eqn12a. transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) - alpha1 *: error1 t). - transitivity (x2 t *m \S(w t) + (alpha1 / g0) - *: (x1 t *m \S(w t) - g0 *: x2 t - (x1_hat t *m \S(w t) - g0 *: x2'_hat t))). + transitivity (x2 t *m \S(w t) + (alpha1 / g0) *: (x1 t *m \S(w t) - + g0 *: x2 t - + (x1_hat t *m \S(w t) - + g0 *: x2'_hat t))). congr (_ + _ *: _). rewrite -2![in LHS]addrA -[in RHS]addrA. congr +%R. @@ -246,9 +223,9 @@ transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) rewrite (addrC (y_a t)). by rewrite subrK. rewrite (_ : x1 t *m \S(w t) - g0 *: x2 t - - (x1_hat t *m \S(w t) - g0 *: x2'_hat t) = + (x1_hat t *m \S(w t) - g0 *: x2'_hat t) = (x1 t - x1_hat t) *m \S(w t) - - g0 *: (x2 t - x2'_hat t)); last first. + g0 *: (x2 t - x2'_hat t)); last first. rewrite mulmxBl scalerDr scalerN opprB addrA [LHS]addrC 2!addrA. rewrite -addrA; congr +%R. by rewrite addrC. @@ -256,7 +233,7 @@ transitivity ((x2 t + (alpha1 / g0) *: (x1 t - x1_hat t)) *m \S(w t) rewrite -/(error1 t). rewrite scalerDr addrA scalemxAl -mulmxDl scalerN scalerA. by rewrite divfK. -by rewrite error1E. +by rewrite {2}/error1 /x2'_hat scaleNr opprK. Qed. (* eqn (13b) *) @@ -359,6 +336,7 @@ Qed. End two_steps_first_order_estimator. +End physicalmodel. End PhysicalModel. Module Tilt. @@ -382,9 +360,6 @@ Definition eqn (dot_zp1_z2 : 'rV[K]_6) : 'rV[K]_6 := Lemma eqnE (f : K -> 'rV[K]_6) t : eqn (f t) = eqn_functional f t. Proof. by []. Qed. -Lemma eqn_functionalE f t : eqn_functional f t = eqn (f t). -Proof. by []. Qed. - Definition Upsilon1 := [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. Definition point1 : 'rV[K]_6 := 0. From da257faa48119bb174209c99b3af4c940d2eeaeb Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 19 Feb 2026 14:47:22 +0900 Subject: [PATCH 127/144] Tilt.V1 --- tilt_analysis.v | 7 +- tilt_lasalle.v | 243 ++++++++++++++++++++---------------------------- tilt_lyapunov.v | 49 ++++++---- 3 files changed, 136 insertions(+), 163 deletions(-) diff --git a/tilt_analysis.v b/tilt_analysis.v index aad72f1f..ea153a30 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -261,11 +261,8 @@ apply/(continuous_within_itvP _ ab); split. - by rewrite -{1}(opprK b); apply/cvg_at_rightNP; exact: fb. Qed. -Local Notation Left := (@lsubmx _ 1 _ _). -Local Notation Right := (@rsubmx _ 1 _ _). - Lemma lsubmx_norm_le {K : rcfType} n1 n2 (x : 'rV[K]_(n1.+1 + n2.+1)) : - `|Left x| <= `|x|. + `|lsubmx x| <= `|x|. Proof. rewrite /Num.norm/= !mx_normrE; apply: bigmax_le. exact/le_trans/(le_bigmax _ _ (ord0, ord0)). @@ -275,7 +272,7 @@ exact: (le_bigmax _ _ (i, lshift n2.+1 j)). Qed. Lemma rsubmx_norm_le {K : rcfType} n1 n2 (x : 'rV[K]_(n1.+1 + n2.+1)) : - `|Right x| <= `|x|. + `|rsubmx x| <= `|x|. Proof. rewrite /Num.norm/= !mx_normrE; apply: bigmax_le. exact/le_trans/(le_bigmax _ _ (ord0,ord0)). diff --git a/tilt_lasalle.v b/tilt_lasalle.v index 68c92818..5581cf07 100644 --- a/tilt_lasalle.v +++ b/tilt_lasalle.v @@ -48,52 +48,37 @@ have comp' i : (k0 <= i)%O -> compact (V i). by apply comp. by apply open_closedC. have decr' i j : (i <= j)%O -> V j `<=` V i. - move=>ij. + move=> ij. rewrite /V. - by apply setSI; apply decr. -rewrite /=. -apply/not_existsP. -move => /= hf. + by apply: setSI; exact: decr. +apply/not_existsP => hf. suff /set0P : \bigcap_(i in [set t | k0 <= t]%O) V i !=set0. - rewrite /V/=. - rewrite bigcapIl; last first. - exists k0 => /=. - exact: lexx. - move /eqP => h. - by have /subsets_disjoint := h. + rewrite bigcapIl; last by exists k0 => /=; exact: lexx. + by move/eqP/subsets_disjoint. have cf : closed_fam_of (B k0) [set t | t >= k0]%O V. - exists V => /=t t0 //. - apply closedI. - apply compact_closed => //. - apply comp => //. - by apply open_closedC. - rewrite /V. - rewrite setIA. - apply: congr2 => //. - symmetry. + exists V => t t0 //. + apply closedI. + apply compact_closed => //. + exact: comp. + exact: open_closedC. + rewrite /V setIA. + congr (_ `&` _). rewrite setIC. - apply: setIidl. - by apply decr. + exact/esym/setIidl/decr. have : compact (B k0) by apply comp. -rewrite compact_In0/=. -apply => //. -move => D Ds. +rewrite compact_In0/=; apply => //. +move=> D Ds. set m := \big[Order.max/k0]_(z <- D) z. -have M x : x \in D -> (x <= m)%O. - move=> xD. - exact: le_bigmax_seq. -suff Vm : V m `<=` \bigcap_(i in [set` D]) V i . +have M x : x \in D -> (x <= m)%O by move=> xD; exact: le_bigmax_seq. +suff Vm : V m `<=` \bigcap_(i in [set` D]) V i. apply: (subset_nonempty Vm). have := hf m. - apply contra_notP. - rewrite /V. - move /nonemptyPn => Ve. - split => //. - apply: bigmax_ge_id. + apply: contra_notP. + move/nonemptyPn => Ve; split. + exact: bigmax_ge_id. by apply subsets_disjoint. apply sub_bigcap => i Di. -apply decr'. -by apply M. +exact/decr'/M. Qed. (* NB: should be possible to generalize without normal_space X *) @@ -114,78 +99,53 @@ have Bcon t : connected (B t). apply /connected_intervalP/interval_is_interval. by apply continuous_subspaceT. have Bnonempty t : B t !=set0. - exists (f t);apply subset_closure. - by exists t; rewrite /=?in_itv/=?lexx. -have Bmon (s t : K): s <= t -> B t `<=` B s. - move => st. - apply: closure_subset. - move => _ [t' tt'] <-. - exists t' => //. - move : tt'; rewrite /=!in_itv//= => /andP[ht _];apply /andP;split=>//. - by apply: (le_trans st). -have Bcom t : 0 <= t -> compact (B t). - move => tge0. - apply: (subclosed_compact _ compactf). - exact: closed_closure. - rewrite (closure_id A).1; last by apply compact_closed. - apply: closure_subset. - move => _ [t0 tp] <-. - move /(_ t0): imagef. - have t0ge0 : 0 <= t0. - move : tp. - rewrite /=in_itv/= => /andP[+ _]. - by apply le_trans. - by move /(_ t0ge0) /set_mem. + exists (f t); apply/subset_closure/set_mem/image_f. + by rewrite inE/= in_itv/= lexx. +have Bmon s t : s <= t -> B t `<=` B s. + move=> st; apply/closure_subset/image_subset. + by apply: subset_itvr; rewrite bnd_simp. +have Bcom t : 0 <= t -> compact (B t). + move=> t0; apply: (subclosed_compact _ compactf). + exact: closed_closure. + rewrite (closure_id A).1; last exact: compact_closed. + apply: closure_subset => _ [x tx] <-. + apply/set_mem/imagef. + by move: tx; rewrite /= in_itv/= andbT; exact: le_trans. have -> : cluster (f t @[t --> +oo]) = \bigcap_(t in [set t | 0 <= t]) B t. - rewrite clusterE. - apply/seteqP;split. - apply:sub_bigcap => t0 _. + rewrite clusterE; apply/seteqP; split. + - apply: sub_bigcap => /= t _. apply: bigcap_inf. - exists t0; split. - apply num_real. - move => t tx; exists t;rewrite //=in_itv/=ltW//. - apply : sub_bigcap => b /= [t0 [_ /= h]]. - apply: (subset_trans (bigcap_inf (i := (Num.max 0 (t0+1))) _)) => //. - by rewrite /=le_max lexx. - apply closure_subset. - move => _ /= [x xt] <-. - apply h. - have t1 : t0 + 1 <= x. - move : xt; rewrite /=in_itv/= => /andP[+ _]. - apply le_trans. - by rewrite le_max lexx;apply /orP;right. - apply/lt_le_trans/t1. - by rewrite ltrDl. -apply /connectedP => E [Enonempty Eu Esep]. -have /(separated_closedUP Esep) [E1c E2c] : closed ((E false) `|` (E true)). - rewrite -Eu;apply closed_bigI => i P;apply compact_closed => //. - by apply Bcom. + exists t; split; first exact: num_real. + by move=> x tx; exists x => //; rewrite /= in_itv/= ltW. + - apply: sub_bigcap => b /= [t0 [_ /= h]]. + apply: (subset_trans (bigcap_inf (i := Num.max 0 (t0 + 1)) _)) => //=. + by rewrite le_max lexx. + apply: closure_subset => _ /= [x xt] <-. + apply h. + move: xt; rewrite in_itv/= andbT; apply: lt_le_trans. + by rewrite lt_max ltrDl ltr01 orbT. +apply/connectedP => E [Enonempty Eu Esep]. +have /(separated_closedUP Esep) [E1c E2c] : closed (E false `|` E true). + rewrite -Eu; apply: closed_bigI => i P; apply: compact_closed => //. + exact: Bcom. have /normal_openP := Hn. -move /(_ K (E false) (E true)) => [| | | V1 [V2 [V1o V2o V1E1 V2E2 V12disj]]]//. - by apply separated_disjoint. -have V1V2o : open (V1 `|` V2). - by apply openU. -have V1V2sep : separated V1 V2. - by apply open_disjoint_separated. +move /(_ K (E false) (E true)) => [//|//|| V1 [V2 [? ? EfalseV1 EtrueV2 ?]]]. + exact: separated_disjoint. +have V1V2o : open (V1 `|` V2) by exact: openU. +have V1V2sep : separated V1 V2 by exact: open_disjoint_separated. have BV1V2 : \bigcap_(t in [set t | 0 <= t]) B t `<=` V1 `|` V2. - by rewrite Eu;apply : setUSS. -case /compact_decreasing_bigcap : BV1V2 => // t0 [t0ge0 Bto] //. -suff: V1 `&` V2 !=set0. - by apply nonemptyPn. -have [e1 E1 ] := Enonempty false. -have [e2 E2 ] := Enonempty true. -have EB : (E false `|` E true `<=` B t0). - rewrite - Eu. - by apply bigcap_inf => //. -case (connected_subset V1V2sep Bto (Bcon _)) => hbv. - exists e2. - split; last by apply V2E2. - apply hbv. - by apply EB;right. - exists e1. -split; first by apply V1E1. -apply hbv. -by apply EB;left. + by rewrite Eu; exact: setUSS. +case/compact_decreasing_bigcap : BV1V2 => // t0 [t0ge0 Bto] //. +suff: V1 `&` V2 !=set0 by apply nonemptyPn. +have [e1 E1] := Enonempty false. +have [e2 E2] := Enonempty true. +have EB : E false `|` E true `<=` B t0. + by rewrite - Eu; exact: bigcap_inf. +have [hbv|hbv] := connected_subset V1V2sep Bto (Bcon _). +- exists e2; split; last exact: EtrueV2. + by apply: hbv; apply: EB; right. +- exists e1; split; first exact: EfalseV1. + by apply: hbv; apply: EB; left. Qed. Section LaSalle_tilt. @@ -204,18 +164,17 @@ Hypothesis initp : forall p, sol p 0 = p. Let isSol p : p \in Tilt.Upsilon1 -> sol_is_deriv_c0y phi (sol p). Proof. -move => Kp. +move=> Kp. apply/sol_is_deriv_c0yP. have : lasalle.is_sol phi (sol p) by apply/solP; rewrite ?initp. -move => [/=_ H]. -move => /= t t0. +move=> [/= _ H] t t0. split. - by apply: ex_derive; apply H. + by apply: ex_derive; exact: H. by rewrite derive1E; apply H. Qed. Definition Ksub (p : U) := - [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] `&` Tilt.Upsilon1. + [set x | Tilt.V1 alpha1 gamma x <= Tilt.V1 alpha1 gamma p] `&` Tilt.Upsilon1. (* continuity in initial value: assumption needed for LaSalle *) Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. @@ -223,12 +182,12 @@ Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -Lemma V1_bound_compact p : compact [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p]. +Lemma V1_bound_compact p : + compact [set x | Tilt.V1 alpha1 gamma x <= Tilt.V1 alpha1 gamma p]. Proof. (* TODO: use something similar to compact_sphere *) apply: bounded_closed_compact. -- rewrite /V1/=. - rewrite /bounded_near. +- rewrite /Tilt.V1/= /bounded_near. near=>R. move => /= x. rewrite !addf_div; rewrite ?lt0r_neq0 ?mulr_gt0 //. @@ -241,34 +200,37 @@ apply: bounded_closed_compact. by apply addr_ge0; rewrite mulr_ge0 // ?sqr_ge0 ?ltW. have hL : `| Left x |_e <= Num.sqrt (c / gamma). rewrite -(sqr_sqrtr (enorm_ge0 (Left x)) ). - rewrite /GRing.exp/= -sqrtrM ?enorm_ge0 // ler_sqrt ?divr_ge0 ?(@ltW _ _ _ gamma) //. - rewrite ler_pdivlMr //. - move : h;apply le_trans. - rewrite lerDl mulr_ge0 // ?sqr_ge0 ?ltW //. + rewrite /GRing.exp/= -sqrtrM ?enorm_ge0//. + rewrite ler_sqrt ?divr_ge0 ?(@ltW _ _ _ gamma)//. + rewrite ler_pdivlMr//. + apply: le_trans h. + by rewrite lerDl mulr_ge0// ?sqr_ge0 ?ltW. have hR : `| Right x |_e <= Num.sqrt (c / alpha1). rewrite -(sqr_sqrtr (enorm_ge0 (Right x)) ). - rewrite /GRing.exp/= -sqrtrM ?enorm_ge0 // ler_sqrt ?divr_ge0 ?(@ltW _ _ _ alpha1) //. - rewrite ler_pdivlMr //. - move : h;apply le_trans. - rewrite addrC lerDl mulr_ge0 // ?sqr_ge0 ?ltW //. + rewrite /GRing.exp/= -sqrtrM ?enorm_ge0//. + rewrite ler_sqrt// ?divr_ge0 ?(@ltW _ _ _ alpha1)//. + rewrite ler_pdivlMr//. + apply: le_trans h. + by rewrite addrC lerDl mulr_ge0 // ?sqr_ge0 ?ltW. have normb : `|x| <= `| Left x |_e + `|Right x|_e. have {1}-> : x = row_mx (Left x) (Right x). by rewrite hsubmxK. - rewrite (norm_rowmx (Left x)). - apply (@le_trans _ _ (`|Left x| + `|Right x|)). - rewrite ge_max. - by apply /andP;split;rewrite ?lerDl ?lerDr normr_ge0 //. - apply lerD. - exact: mxnorm_enorm_le. + rewrite (norm_rowmx (Left x)). + apply (@le_trans _ _ (`|Left x| + `|Right x|)). + rewrite ge_max. + by apply /andP; split; rewrite ?lerDl ?lerDr normr_ge0. + apply: lerD. exact: mxnorm_enorm_le. + exact: mxnorm_enorm_le. apply: (le_trans normb). by apply: (le_trans (lerD hL hR)). -- have -> : [set x | V1 alpha1 gamma x <= V1 alpha1 gamma p] = - (V1 alpha1 gamma) @^-1` [set r | r <= V1 alpha1 gamma p] by []. +- have -> : [set x | Tilt.V1 alpha1 gamma x <= Tilt.V1 alpha1 gamma p] = + (Tilt.V1 alpha1 gamma) @^-1` + [set r | r <= Tilt.V1 alpha1 gamma p] by []. apply: closed_comp. - move => /= x xin. + move=> /= x xin. exact: (differentiable_continuous (V1_diff _ _ _ )). - exact: closed_le. + exact: closed_le. Unshelve. all: by end_near. Qed. Lemma compact_Ksub p : compact (Ksub p). @@ -308,11 +270,11 @@ have : {in `[0, t + 1[, forall t : K, derivable (sol x) t 1}. move=> t'. rewrite in_itv/= => /andP[t0' _]. by apply solA. -move/V_nincr => /= => /(_ (V1 alpha1 gamma)). +move/V_nincr => /= => /(_ (Tilt.V1 alpha1 gamma)). apply. - exact: V1_diff. - move => t1 tt1. - apply : (@derive_along_V1_le0 _ _ _ _ _ (t + 1))=> //. + apply: (@derive_along_V1_le0 _ _ _ _ _ (t + 1)) => //. + by rewrite initp inE. + apply: sol_is_deriv_c0yco => //. apply/sol_is_deriv_c0yP. @@ -395,9 +357,10 @@ have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y rewrite inE. by apply Ky. have H : lasalle.limS sol (Ksub p) `<=` - [set x | (V1 alpha1 gamma \o sol x)^`()%classic 0 = 0] `&` Tilt.Upsilon1. + [set x | (Tilt.V1 alpha1 gamma \o sol x)^`()%classic 0 = 0] `&` + Tilt.Upsilon1. rewrite subsetI; split. - apply: (@lasalle.stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (V1 alpha1 gamma)) => //=. + apply: (@lasalle.stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (Tilt.V1 alpha1 gamma)) => //=. apply/continuous_subspaceT => x xK. apply : differentiable_continuous. apply: V1_diff. @@ -446,7 +409,7 @@ have H : lasalle.limS sol (Ksub p) `<=` by have/= [_ +] := qKsub. by rewrite ltW. rewrite clusterE in xcl. - by apply:xcl. + by apply: xcl. apply: (subset_trans H). move =>/= x [+ h1]. rewrite derive1E. @@ -610,7 +573,7 @@ Qed. Lemma p1_Ksub p : Ksub p Tilt.point1. Proof. split => /=; last by have /set_mem := @tilt_point1_in_state_space K. -rewrite /Tilt.point1 /V1. +rewrite /Tilt.point1 /Tilt.V1. rewrite lsubmx_const rsubmx_const/= !enorm0 !expr0n /= !mul0r add0r. by rewrite addr_ge0 // divr_ge0 // ?sqr_ge0 ?mulr_ge0 // ltW. Qed. @@ -624,10 +587,10 @@ have cluster_con : connected (cluster (sol p t @[t --> +oo])). apply: (compact_connected_cluster _ _ _ (@compact_Ksub p) ) => //. by apply: pseudometric_normal. by apply: sol_continuous. - move => t t0. - apply/mem_set. - apply: invariant_Ksub => //. - by have /set_mem := q_inKsubq ps. + move => t t0. + apply/mem_set. + apply: invariant_Ksub => //. + by have /set_mem := q_inKsubq ps. have := connected2_subset cluster_con (cluster_nonempty ps) (cluster_contained_points ps). suff H (q : U): cluster (sol p t @[t --> +oo]) = [set q] -> sol p t @[t --> +oo] --> q. move => [h | h]; [left | right];apply H => //. diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index bd7d7aca..0a8687e0 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -43,9 +43,6 @@ Import numFieldNormedType.Exports. Local Open Scope ring_scope. Local Open Scope classical_set_scope. -Local Notation Left := (@lsubmx _ 1 3 3). -Local Notation Right := (@rsubmx _ 1 3 3). - Definition S2 {K : realType} := [set x : 'rV[K]_3 | `|x|_e = 1]. Module PhysicalModel. @@ -150,7 +147,7 @@ Hypothesis v_derivable : forall t, derivable v t 1. (* section III.A in [benallegue2023itac] *) Section two_steps_first_order_estimator. -Notation y_a := (y_a v). +Local Notation y_a := (y_a v). Variables gamma alpha1 : K. Variable x1_hat : K -> 'rV[K]_3. (* estimator *) @@ -344,6 +341,9 @@ Section tilt. Context {K : realType}. Variables alpha1 gamma : K. +Local Notation Left := (@lsubmx _ 1 3 3). +Local Notation Right := (@rsubmx _ 1 3 3). + Definition eqn_functional (f : K -> 'rV[K]_6) : K -> 'rV[K]_6 := let error1_p_dot := Left \o f in let error2_p_dot := Right \o f in @@ -374,6 +374,11 @@ Qed. Definition points := [set point1; point2]. +Definition V1 (zp1_z2 : 'rV[K]_6) : K := + let zp1 := Left zp1_z2 in + let z2 := Right zp1_z2 in + `|zp1|_e ^+ 2 / (2 * alpha1) + `|z2|_e ^+ 2 / (2 * gamma). + End tilt. End Tilt. @@ -385,6 +390,9 @@ Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. Let phi := Tilt.eqn alpha1 gamma. +Local Notation Left := (@lsubmx _ 1 3 3). +Local Notation Right := (@rsubmx _ 1 3 3). + Lemma tilt_eqn_locally_lipschitz : locally_lipschitz phi. Proof. move=> /= x. @@ -766,10 +774,9 @@ Variables alpha1 gamma : K. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. -Definition V1 (zp1_z2 : 'rV[K]_6) : K := - let zp1 := Left zp1_z2 in - let z2 := Right zp1_z2 in - `|zp1|_e ^+ 2 / (2 * alpha1) + `|z2|_e ^+ 2 / (2 * gamma). +Local Notation Left := (@lsubmx _ 1 3 3). +Local Notation Right := (@rsubmx _ 1 3 3). +Local Notation V1 := (Tilt.V1 alpha1 gamma). Lemma V1_diff (t : 'rV_6) : differentiable V1 t. Proof. @@ -855,6 +862,9 @@ Hypotheses (alpha1_gt0 : 0 < alpha1) (gamma_gt0 : 0 < gamma). Let phi := Tilt.eqn alpha1 gamma. Variable D : K. +Local Notation Left := (@lsubmx _ 1 3 3). +Local Notation Right := (@rsubmx _ 1 3 3). + Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : sol_is_deriv_co (fun=> phi) 0 D sol -> t \in `[0, D[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). @@ -990,10 +1000,10 @@ Lemma derive_along_V1 t (sol : K -> 'rV_6) : t \in `]0, D[ -> sol_is_deriv_co (fun=> phi) 0 D sol -> (forall t, t \in `]0, D[ -> differentiable sol t) -> - 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). + 'D~(sol) (Tilt.V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0D tilt_eqnx dif1. -rewrite /V1 derive_alongD; last 3 first. +rewrite /Tilt.V1 derive_alongD; last 3 first. apply/differentiableM => //=. exact/differentiable_enorm_squared/differentiable_lsubmx_comp. apply/differentiableM => //=. @@ -1154,7 +1164,7 @@ Unshelve. all: try by end_near. Abort. Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : sol x 0 = Tilt.point1 -> sol_is_deriv_co (fun=> phi) 0 D (sol x) -> - locnegsemidef ('D~(sol x) (V1 alpha1 gamma)) 0. + locnegsemidef ('D~(sol x) (Tilt.V1 alpha1 gamma)) 0. Proof. (* move=> [y033] dy dtraj traj0. *) (* rewrite /locnegsemidef /V1. *) @@ -1197,7 +1207,7 @@ Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) sol_is_deriv_co (fun=> phi) 0 D (sol x) -> (forall t : K, Tilt.Upsilon1 (sol x t)) -> sol x 0 = Tilt.point1 -> - locnegdef ('D~(sol x) (V1 alpha1 gamma)) 0. + locnegdef ('D~(sol x) (Tilt.V1 alpha1 gamma)) 0. Proof. move=> sol0 solP state y0. split. @@ -1267,7 +1277,7 @@ Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : sol_is_deriv_co (fun=> phi) 0 D sol -> (forall t, t \in `]0, D[%R -> differentiable sol t) -> forall t : K, 0 < t < D -> - 'D~(sol) (V1 alpha1 gamma) t <= 0. + 'D~(sol) (Tilt.V1 alpha1 gamma) t <= 0. Proof. move=> sol0 solP diff t t0. rewrite derive_along_V1//; last 2 first. @@ -1307,6 +1317,9 @@ Let phi := Tilt.eqn alpha1 gamma. Let c1 := 2^-1 / alpha1. Let c2 := 2^-1 / gamma. +Local Notation Left := (@lsubmx _ 1 3 3). +Local Notation Right := (@rsubmx _ 1 3 3). + (* todo: copy paste *) Lemma derive_zp10 (sol : K -> 'rV_6) : sol_is_deriv_c0y phi sol -> @@ -1361,7 +1374,7 @@ Qed. Lemma derive_along_V1_global t (sol : K -> 'rV_6) : 0 <= t -> sol_is_deriv_c0y phi sol -> - 'D~(sol) (V1 alpha1 gamma) t = V1dot (sol t). + 'D~(sol) (Tilt.V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0 tilt_eqnx. have dif1 : forall (t : K), 0 <= t -> differentiable sol t. @@ -1369,7 +1382,7 @@ have dif1 : forall (t : K), 0 <= t -> differentiable sol t. apply/derivable1_diffP. move/sol_is_deriv_c0yP in tilt_eqnx. by apply tilt_eqnx. -rewrite /V1 derive_alongD; last 3 first. +rewrite /Tilt.V1 derive_alongD; last 3 first. apply/differentiableM => //=. exact/differentiable_enorm_squared/differentiable_lsubmx_comp. apply/differentiableM => //=. @@ -1398,7 +1411,7 @@ Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : sol 0 \in Tilt.Upsilon1 -> sol_is_deriv_c0y phi sol -> forall t : K, 0 <= t -> - 'D~(sol) (V1 alpha1 gamma) t <= 0. + 'D~(sol) (Tilt.V1 alpha1 gamma) t <= 0. Proof. move=> sol0 solves. have diff : forall (t : K), 0 <= t -> differentiable sol t. @@ -1441,7 +1454,7 @@ Lemma equilibrium_zero_stable : is_stable_at phi Init Tilt.point1. Proof. move=> Init0 openInit Init_in_state. -apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). +apply: (@Lyapunov_stability K _ phi Init openInit (Tilt.V1 alpha1 gamma)). - exact: V1_diff. - move=> D /= sol sol0 solP t t0. apply: (@derive_along_V1_le0 _ _ _ _ _ D sol) => //. @@ -1454,7 +1467,7 @@ apply: (@Lyapunov_stability K _ phi Init openInit (V1 alpha1 gamma)). by apply: subset_itvr t10D; rewrite bnd_simp. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. rewrite /is_Lyapunov_candidate /Tilt.point1 => Hpos. - rewrite /V1 lsubmx_const rsubmx_const; split => //. + rewrite /Tilt.V1 lsubmx_const rsubmx_const; split => //. + by rewrite !expr2 !enorm0 !mulr0 !mul0r add0r. + move=> z zin z_neq0. case: Hpos => // _ [V1_eq0]. From 8e8dc9c69af4d9aeaf767c72af25cb1c6cf157bf Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Thu, 19 Feb 2026 17:22:14 +0900 Subject: [PATCH 128/144] removed unnecessary statements from cauchy lipschitz --- ode.v | 35 +++++++++++++++++++++++------------ 1 file changed, 23 insertions(+), 12 deletions(-) diff --git a/ode.v b/ode.v index ab722d54..ae3ed393 100644 --- a/ode.v +++ b/ode.v @@ -1808,16 +1808,25 @@ Proof. exact: cts_fun. Qed. Let f := cauchy_lipschitz_f. -Theorem cauchy_lipschitz : safe_dist > 0 /\ - is_sol_oo phi u0 a (a + safe_dist) f /\ - {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (f t)}. +Theorem cauchy_lipschitz : + is_sol_oo phi u0 a (a + safe_dist) cauchy_lipschitz_f. Proof. -split; first exact: safe_dist_gt0. -split. -- exact: is_sol_cauchy_lipschitz_f. -- exact: solution_stays_in_ball. +apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. +- by rewrite ltDl_safe_dist. +- move=> t td. + apply: lip2. + move: td; rewrite /=!in_itv/= => /andP [-> h] /=. + by rewrite (le_trans h)// -lerBrDl; exact: safe_dist_itv. +- move=> /= x xB . + apply/continuous_subspaceW/cont1 => //. + apply: subset_itvl => //=. + by rewrite bnd_simp -lerBrDl safe_dist_itv. +- exact: cts_fun. +- by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. +- exact: cauchy_lipschitz_integral_version. Qed. + Local Notation V := (@ContSeg_quot.quot_contSeg R a (a + safe_dist) U). Theorem cauchy_lipschitz_unique f' : @@ -2322,9 +2331,10 @@ have t0ab' : t0 \in `[a,b]%R. have t0b : t0 < b. move: t0ab. by rewrite in_itv/= => /andP[]. -have [dplus0 [solplus cplus]] := +have solplus := cauchy_lipschitz t0b k0 (phi_lip2 t0ab') (phi_cont1 t0ab') rho1. +have cplus := solution_stays_in_ball. set fplus := @cauchy_lipschitz_f R n phi t0 _ k u0 r4 t0b k0 (phi_lip2 t0ab') (phi_cont1 t0ab') rho rho1. have amin1 : -t0 < -a. @@ -2332,16 +2342,17 @@ have amin1 : -t0 < -a. by move : t0ab; rewrite in_itv/= => /andP[]. have dminus0 : 0 < dminus t0. by apply safe_dist_gt0. -have [_ [solminus cminus]] := +have solminus := cauchy_lipschitz amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho1. +have cminus := solution_stays_in_ball. set fminus0 := @cauchy_lipschitz_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r4 amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho rho1. set fminus := fminus0 \o -%R. -have adplus : t0 < t0 + dplus t0 by rewrite ltrDl dplus0. +have adplus : t0 < t0 + dplus t0 by rewrite ltrDl safe_dist_gt0. have cfplus := And33 solplus. -rewrite closure_neitv_oo in cfplus; last by rewrite ltrDl. +rewrite closure_neitv_oo in cfplus; last by rewrite ltrDl safe_dist_gt0. have amind : -t0 < -t0 + dminus t0 by rewrite ltrDl dminus0. have cfminus' := And33 solminus. rewrite closure_neitv_oo in cfminus'; last by rewrite ltrDl. @@ -2353,7 +2364,7 @@ have cfminus : {within `[t0-dminus t0, t0], continuous fminus}. rewrite -/dminus. by rewrite bnd_simp/= opprD opprK. have dboth0 : 0 < dboth t0. - rewrite lt_min; apply /andP;split; last by rewrite lt_min dplus0 //= lt_min dminus0 //=. + rewrite lt_min; apply /andP;split; last by rewrite lt_min safe_dist_gt0 //= lt_min dminus0 //=. rewrite subr_gt0. move : t0ab. by rewrite in_itv/= => /andP[]. From 01f14912e10021bea9fb2ea4049401e17b27d2c0 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Thu, 19 Feb 2026 17:39:16 +0900 Subject: [PATCH 129/144] minor renaming --- ode.v | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ode.v b/ode.v index ae3ed393..6ce2849b 100644 --- a/ode.v +++ b/ode.v @@ -1589,7 +1589,7 @@ rewrite (_ : repr picard_fix' x = picard_fix' x)//. by rewrite h// subrr. Qed. -Theorem cauchy_lipschitz_ex : picard_fix a = u0 /\ +Lemma cauchy_lipschitz_quot_ex : picard_fix a = u0 /\ {in `]a, a + safe_dist[%R, forall x, picard_fix^`() x = phi x (picard_fix x)}. Proof. split; first exact: picard_fix_init. @@ -1808,8 +1808,8 @@ Proof. exact: cts_fun. Qed. Let f := cauchy_lipschitz_f. -Theorem cauchy_lipschitz : - is_sol_oo phi u0 a (a + safe_dist) cauchy_lipschitz_f. +Theorem cauchy_lipschitz_ex : + is_sol_oo phi u0 a (a + safe_dist) f. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. - by rewrite ltDl_safe_dist. @@ -2332,7 +2332,7 @@ have t0b : t0 < b. move: t0ab. by rewrite in_itv/= => /andP[]. have solplus := - cauchy_lipschitz t0b k0 + cauchy_lipschitz_ex t0b k0 (phi_lip2 t0ab') (phi_cont1 t0ab') rho1. have cplus := solution_stays_in_ball. set fplus := @cauchy_lipschitz_f R n phi t0 _ k u0 r4 t0b k0 @@ -2343,7 +2343,7 @@ have amin1 : -t0 < -a. have dminus0 : 0 < dminus t0. by apply safe_dist_gt0. have solminus := - cauchy_lipschitz amin1 k0 + cauchy_lipschitz_ex amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho1. have cminus := solution_stays_in_ball. set fminus0 := From 72a21147149fea541848ede35260f8ab36ca3df0 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Thu, 19 Feb 2026 18:46:10 +0900 Subject: [PATCH 130/144] sublevel --- tilt_lasalle.v | 308 ++++++++++++++++++++++++------------------------ tilt_lyapunov.v | 4 + 2 files changed, 156 insertions(+), 156 deletions(-) diff --git a/tilt_lasalle.v b/tilt_lasalle.v index 5581cf07..847c7fe1 100644 --- a/tilt_lasalle.v +++ b/tilt_lasalle.v @@ -148,6 +148,17 @@ have [hbv|hbv] := connected_subset V1V2sep Bto (Bcon _). by apply: hbv; apply: EB; left. Qed. +Section sublevel. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. + +Definition sublevel (V : U -> R) c := [set x : U | V x <= c]. + +Lemma sublevel_preimage (V : U -> R) c : sublevel V c = V @^-1` [set r | r <= c]. +Proof. by []. Qed. + +End sublevel. + Section LaSalle_tilt. Context {K : realType}. Let U := 'rV[K]_6. @@ -173,85 +184,76 @@ split. by rewrite derive1E; apply H. Qed. -Definition Ksub (p : U) := - [set x | Tilt.V1 alpha1 gamma x <= Tilt.V1 alpha1 gamma p] `&` Tilt.Upsilon1. +Definition sublevelUpsilon1 (p : U) := + sublevel (Tilt.V1 alpha1 gamma) (Tilt.V1 alpha1 gamma p) `&` Tilt.Upsilon1. + +Lemma mem_sublevelUpsilon1 p : Tilt.Upsilon1 p -> + p \in sublevelUpsilon1 p. +Proof. by rewrite /sublevelUpsilon1 /sublevel/= inE/=. Qed. (* continuity in initial value: assumption needed for LaSalle *) -Hypothesis cont_sol : forall p t, {within Ksub p, continuous sol^~ t}. +Hypothesis cont_sol : forall p t, {within sublevelUpsilon1 p, continuous sol^~ t}. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). Lemma V1_bound_compact p : - compact [set x | Tilt.V1 alpha1 gamma x <= Tilt.V1 alpha1 gamma p]. + compact (sublevel (Tilt.V1 alpha1 gamma) (Tilt.V1 alpha1 gamma p)). Proof. (* TODO: use something similar to compact_sphere *) apply: bounded_closed_compact. - rewrite /Tilt.V1/= /bounded_near. - near=>R. - move => /= x. - rewrite !addf_div; rewrite ?lt0r_neq0 ?mulr_gt0 //. - rewrite ler_pdivrMr ?mulr_gt0 // divrK; last first. + near=> r. + move=> /= x. + rewrite /sublevel/= !addf_div; rewrite ?lt0r_neq0 ?mulr_gt0//. + rewrite ler_pdivrMr ?mulr_gt0// divrK; last first. by rewrite unitfE lt0r_neq0 // ?mulr_gt0. - rewrite !(mulrC 2) !mulrA -!mulrDl ler_pM2r //. - move => h. - set c := `| Left p |_e ^+ 2 * gamma + `| Right p |_e ^+ 2 * alpha1. + rewrite !(mulrC 2) !mulrA -!mulrDl ler_pM2r// => h. + set c := `| Left p |_e ^+ 2 * gamma + `| Right p |_e ^+ 2 * alpha1. have c0 : 0 <= c. - by apply addr_ge0; rewrite mulr_ge0 // ?sqr_ge0 ?ltW. - have hL : `| Left x |_e <= Num.sqrt (c / gamma). - rewrite -(sqr_sqrtr (enorm_ge0 (Left x)) ). + by rewrite addr_ge0// mulr_ge0 ?sqr_ge0 ?ltW. + have hL : `| Left x |_e <= Num.sqrt (c / gamma). + rewrite -(sqr_sqrtr (enorm_ge0 (Left x))). rewrite /GRing.exp/= -sqrtrM ?enorm_ge0//. rewrite ler_sqrt ?divr_ge0 ?(@ltW _ _ _ gamma)//. rewrite ler_pdivlMr//. apply: le_trans h. by rewrite lerDl mulr_ge0// ?sqr_ge0 ?ltW. - have hR : `| Right x |_e <= Num.sqrt (c / alpha1). - rewrite -(sqr_sqrtr (enorm_ge0 (Right x)) ). + have hR : `| Right x |_e <= Num.sqrt (c / alpha1). + rewrite -(sqr_sqrtr (enorm_ge0 (Right x))). rewrite /GRing.exp/= -sqrtrM ?enorm_ge0//. rewrite ler_sqrt// ?divr_ge0 ?(@ltW _ _ _ alpha1)//. rewrite ler_pdivlMr//. apply: le_trans h. by rewrite addrC lerDl mulr_ge0 // ?sqr_ge0 ?ltW. have normb : `|x| <= `| Left x |_e + `|Right x|_e. - have {1}-> : x = row_mx (Left x) (Right x). - by rewrite hsubmxK. - rewrite (norm_rowmx (Left x)). - apply (@le_trans _ _ (`|Left x| + `|Right x|)). - rewrite ge_max. - by apply /andP; split; rewrite ?lerDl ?lerDr normr_ge0. - apply: lerD. - exact: mxnorm_enorm_le. - exact: mxnorm_enorm_le. - apply: (le_trans normb). - by apply: (le_trans (lerD hL hR)). -- have -> : [set x | Tilt.V1 alpha1 gamma x <= Tilt.V1 alpha1 gamma p] = - (Tilt.V1 alpha1 gamma) @^-1` - [set r | r <= Tilt.V1 alpha1 gamma p] by []. + rewrite -[in leLHS](@hsubmxK _ 1 3 3 x) (norm_rowmx (Left x)) ge_max. + by rewrite !(le_trans (mxnorm_enorm_le _))//= ?lerDl ?lerDr ?enorm_ge0. + exact/(le_trans normb)/(le_trans (lerD hL hR)). +- rewrite sublevel_preimage. apply: closed_comp. move=> /= x xin. - exact: (differentiable_continuous (V1_diff _ _ _ )). + exact: (differentiable_continuous (V1_diff _ _ _)). exact: closed_le. Unshelve. all: by end_near. Qed. -Lemma compact_Ksub p : compact (Ksub p). +Lemma compact_sublevelUpsilon1 p : compact (sublevelUpsilon1 p). Proof. -apply: compact_closedI. -exact: V1_bound_compact. -have -> : Tilt.Upsilon1 = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. - by []. -apply : closed_comp => //. -move => x xp. -apply : continuous_comp; last by exact:continuous_enorm. +apply: compact_closedI; first exact: V1_bound_compact. +rewrite Tilt.Upsilon1_preimage. +apply : closed_comp => // => x xp. +apply : continuous_comp; last exact: continuous_enorm. apply: continuousB. -exact: cst_continuous. + exact: cst_continuous. exact: continuous_rsubmx. Qed. -Lemma invariant_Ksub p : lasalle.is_invariant sol (Ksub p). +Lemma invariant_sublevelUpsilon1 p : + lasalle.is_invariant sol (sublevelUpsilon1 p). Proof. rewrite /= /lasalle.is_invariant/=. -move => /= x. (* . [/= sol' [d [solP [t h]]]]*) -rewrite /Ksub/= => -[Vx Kx] t t0. +move => /= x. +rewrite /sublevelUpsilon1/= => -[Vx Kx] t t0. split; last first. apply/(@tilt_state_spaceS _ alpha1 gamma). exists (sol x), (t + 1) => /=. (* use large enough time *) @@ -264,6 +266,7 @@ split; last first. + exists t => //. by rewrite /= in_itv/=t0/=ltrDl. move/mem_set : (Kx) => /isSol /sol_is_deriv_c0yP solA. +rewrite /sublevel/=. rewrite (le_trans _ Vx)//. rewrite -[in leRHS](@initp x). have : {in `[0, t + 1[, forall t : K, derivable (sol x) t 1}. @@ -287,7 +290,8 @@ apply. - by rewrite lexx. Qed. -Local Lemma sol_Ksub p u : u \in Ksub p -> sol_is_deriv_c0y phi (sol u). +Local Lemma sol_sublevelUpsilon1 p u : + u \in sublevelUpsilon1 p -> sol_is_deriv_c0y phi (sol u). Proof. rewrite inE/= => -[h1 h2]. apply isSol => //. @@ -330,106 +334,98 @@ apply : differentiable_continuous. apply /derivable1_diffP. have [ht | ht] := ltP t 0; last by apply /ex_derive/issol1. apply : (@near_eq_derivable _ _ _ (fun t => 2 *: sol p 0 - sol p (-t))) => //. - near=> s. - rewrite -issol0 //. - near: s. - by apply: lt_nbhsl. -apply /derivable1_diffP. + near do (rewrite -issol0//). + exact: lt_nbhsl. +apply/derivable1_diffP. apply: differentiable_comp => //. apply: differentiable_comp => //. apply: differentiable_comp => //. -apply /derivable1_diffP. -apply /ex_derive/issol1. -rewrite lerNr oppr0 ltW//. +apply/derivable1_diffP. +apply/ex_derive/issol1. +by rewrite lerNr oppr0 ltW. Unshelve. all: by end_near. Qed. -Local Lemma q_inKsubq q : q \in Tilt.Upsilon1 -> q \in Ksub q. -Proof. rewrite !inE => h;split => //=. Qed. - Local Lemma limS_subset_V1dot0 p : p \in Tilt.Upsilon1 -> - lasalle.limS sol (Ksub p) `<=` [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Upsilon1. + lasalle.limS sol (sublevelUpsilon1 p) `<=` + [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Upsilon1. Proof. move => ps. -have lasalle_sol : (forall y : K -> 'rV_6, Ksub p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0)). - move => y Ky. +have lasalle_sol (y : K -> 'rV_6) : + sublevelUpsilon1 p (y 0) -> lasalle.is_sol phi y <-> y = sol (y 0). + move=> Ky. apply/solP. rewrite inE. by apply Ky. -have H : lasalle.limS sol (Ksub p) `<=` +have H : lasalle.limS sol (sublevelUpsilon1 p) `<=` [set x | (Tilt.V1 alpha1 gamma \o sol x)^`()%classic 0 = 0] `&` Tilt.Upsilon1. rewrite subsetI; split. - apply: (@lasalle.stable_limS _ _ _ _ (@compact_Ksub p) _ _ lasalle_sol _ (@invariant_Ksub p) (Tilt.V1 alpha1 gamma)) => //=. - apply/continuous_subspaceT => x xK. - apply : differentiable_continuous. - apply: V1_diff. - move => /= p0 t K0 t0. - apply /derivable1_diffP. - apply differentiable_comp. - apply /derivable1_diffP. - apply isSol => //; last first. - by rewrite in_itv/= andbT. - rewrite inE. - by have [_ +] := K0. - exact: V1_diff. - move => p0 K0. - have p0s : p0 \in Tilt.Upsilon1. - by move : K0;rewrite inE/=/Ksub/inE/=;move=>[]. - rewrite derive1E. - rewrite -derive_along_derive. - apply : derive_along_V1_le0_global => //. - by rewrite initp. - by apply isSol. - rewrite initp. - by apply: V1_diff => //. - apply /derivable1_diffP. - apply isSol => //. + - apply: (@lasalle.stable_limS _ _ _ _ (@compact_sublevelUpsilon1 p) _ _ + lasalle_sol _ (@invariant_sublevelUpsilon1 p) + (Tilt.V1 alpha1 gamma)) => //=. + + apply/continuous_subspaceT => x xK. + apply: differentiable_continuous. + exact: V1_diff. + + move=> /= p0 t K0 t0. + apply/derivable1_diffP. + apply: differentiable_comp. + apply/derivable1_diffP. + apply isSol => //; last first. + by rewrite in_itv/= andbT. + rewrite inE. + by have [_ +] := K0. + exact: V1_diff. + + move=> p0 K0. + have p0s : p0 \in Tilt.Upsilon1. + by move : K0; rewrite inE/= /inE/= => -[]. + rewrite derive1E -derive_along_derive. + * apply : derive_along_V1_le0_global => //. + by rewrite initp. + by apply isSol. + * rewrite initp. + exact: V1_diff. + + apply /derivable1_diffP. + apply isSol => //. + by rewrite in_itv/= lexx. + - move=>/=x [q qKsub xcl]. + suff [] : (sublevelUpsilon1 q) x by []. + rewrite (closure_id (sublevelUpsilon1 q)).1; last first. + apply compact_closed => //. + exact: compact_sublevelUpsilon1. + have qs (t : K) : 0 <= t -> state_space phi (sublevelUpsilon1 q) (sol q t). + move=> t0; exists (sol q), (t + 1); split. + + by rewrite initp; apply: mem_sublevelUpsilon1; case: qKsub. + + apply: sol_is_deriv_c0yco. + by apply isSol; rewrite inE; apply qKsub. + + exists t => //. + by rewrite/=in_itv/= t0 ltrDl ltr01. + have lim_sp : (sol q x @[x --> +oo]) (sublevelUpsilon1 q). + exists 0; split => // t t0 /=. + apply invariant_sublevelUpsilon1. + split => /=. + by rewrite /sublevel/=. + by case: qKsub. + by rewrite ltW. + by move: xcl; rewrite clusterE; exact. +apply: (subset_trans H) =>/= x [+ h1] /=. +rewrite /= derive1E -derive_along_derive. +- rewrite derive_along_V1_global //=. + by rewrite initp ?inE. + split => //. + apply isSol => //. + by apply/mem_set. + apply isSol => //. + by apply/mem_set. +- exact: V1_diff. +- apply/derivable1_diffP. + apply isSol => //; last first. by rewrite in_itv/= lexx. - move=>/=x [q qKsub xcl]. - suff [] : (Ksub q) x by []. - rewrite (closure_id (Ksub q)).1;last first. - apply compact_closed => //. - exact: compact_Ksub. - have qs (t :K) : 0 <= t -> state_space phi (Ksub q) (sol q t). - exists (sol q), (t+1). - split. - rewrite initp; apply q_inKsubq. - have/= [_ +] := qKsub. - by move/mem_set. - apply: sol_is_deriv_c0yco. - by apply isSol;rewrite inE;apply qKsub. - exists t => //. - by rewrite/=in_itv/=H ltrDl ltr01. - have lim_sp : (sol q x @[x --> +oo]) (Ksub q). - exists 0; split => // t t0 /=. - apply invariant_Ksub. - split => /=. - by rewrite lexx. - by have/= [_ +] := qKsub. - by rewrite ltW. - rewrite clusterE in xcl. - by apply: xcl. -apply: (subset_trans H). -move =>/= x [+ h1]. -rewrite derive1E. -rewrite -derive_along_derive. -rewrite derive_along_V1_global //=. -by rewrite initp ?inE. -split => //. -apply isSol => //. -by apply/mem_set. -apply isSol => //. -by apply/mem_set. -by apply: V1_diff. -apply /derivable1_diffP. -apply isSol => //; last first. - by rewrite in_itv/= lexx. -by rewrite inE. + by rewrite inE. Qed. Lemma limS_subset_points p : - p \in Tilt.Upsilon1 -> lasalle.limS sol (Ksub p) `<=` Tilt.points. + p \in Tilt.Upsilon1 -> lasalle.limS sol (sublevelUpsilon1 p) `<=` Tilt.points. Proof. have -> : Tilt.points = [set x : 'rV[K]_6 | V1dot x = 0] `&` Tilt.Upsilon1. apply/seteqP; split => x /=. @@ -458,13 +454,12 @@ Lemma cvg_to_set_points p : p \in Tilt.Upsilon1 -> sol p t @[t --> +oo] --> (Tilt.points : set 'rV_6). Proof. move=> /set_mem ps. -have : p \in Ksub p by apply/mem_set; split => //=. -move => pK. -have p0K : (forall p0 : 'rV_6, p0 \in Ksub p -> sol p0 0 = p0). +have p0K : (forall p0 : 'rV_6, p0 \in sublevelUpsilon1 p -> sol p0 0 = p0). move => q /set_mem[_ h]. exact: initp. -apply: (cvg_trans (lasalle.cvg_to_limS (@compact_Ksub p) (@invariant_Ksub p) _)). - by move: pK => /set_mem. +apply: (cvg_trans (lasalle.cvg_to_limS (@compact_sublevelUpsilon1 p) + (@invariant_sublevelUpsilon1 p) _)). + by apply/set_mem/mem_sublevelUpsilon1. move => /= S [eps eps0 Be]. exists eps => //. apply bigcup_sub => /= x H. @@ -551,7 +546,8 @@ have sep : separated [set (@Tilt.point1 K)] [set Tilt.point2]. rewrite sub1set. apply/mem_set => /=. exact/nesym/eqP/Tilt.point1_neq2. -have [/subset_set1 [/nonemptyPn A0 | ] | /subset_set1 [/nonemptyPn A0 |] ]:= (connected_subset sep Asub Ac) => //. +have [/subset_set1 [/nonemptyPn A0 | ] | /subset_set1 [/nonemptyPn A0 |] ] := + connected_subset sep Asub Ac => //. by left. by right. Qed. @@ -559,21 +555,21 @@ Qed. Lemma cluster_nonempty p : p \in Tilt.Upsilon1 -> cluster (sol p t @[t --> +oo]) !=set0. Proof. move => sp. -suff : (Ksub p) `&` cluster (sol p t @[t --> +oo]) !=set0. +suff : (sublevelUpsilon1 p) `&` cluster (sol p t @[t --> +oo]) !=set0. move => [x [_ cx]]. by exists x. -apply (@compact_Ksub p) => //. +apply (@compact_sublevelUpsilon1 p) => //. by apply: fmap_proper_filter. apply sub_image_at_infty => /=. move => _ [t t0] <-. -apply invariant_Ksub => //. -by have /set_mem := q_inKsubq sp. +apply invariant_sublevelUpsilon1 => //. +by apply/set_mem/mem_sublevelUpsilon1/set_mem. Qed. -Lemma p1_Ksub p : Ksub p Tilt.point1. +Lemma p1_sublevelUpsilon1 p : sublevelUpsilon1 p Tilt.point1. Proof. split => /=; last by have /set_mem := @tilt_point1_in_state_space K. -rewrite /Tilt.point1 /Tilt.V1. +rewrite /sublevel/= /Tilt.point1 /Tilt.V1. rewrite lsubmx_const rsubmx_const/= !enorm0 !expr0n /= !mul0r add0r. by rewrite addr_ge0 // divr_ge0 // ?sqr_ge0 ?mulr_ge0 // ltW. Qed. @@ -584,19 +580,19 @@ Lemma tilt_cvg_to_point1_or_point2 p : p \in Tilt.Upsilon1 -> Proof. move => ps. have cluster_con : connected (cluster (sol p t @[t --> +oo])). - apply: (compact_connected_cluster _ _ _ (@compact_Ksub p) ) => //. + apply: (compact_connected_cluster _ _ _ (@compact_sublevelUpsilon1 p) ) => //. by apply: pseudometric_normal. by apply: sol_continuous. move => t t0. apply/mem_set. - apply: invariant_Ksub => //. - by have /set_mem := q_inKsubq ps. + apply: invariant_sublevelUpsilon1 => //. + by apply/set_mem/mem_sublevelUpsilon1/set_mem. have := connected2_subset cluster_con (cluster_nonempty ps) (cluster_contained_points ps). suff H (q : U): cluster (sol p t @[t --> +oo]) = [set q] -> sol p t @[t --> +oo] --> q. move => [h | h]; [left | right];apply H => //. move => H. -have Ksubq : Ksub p q. - suff: cluster (sol p t @[t --> +oo]) `<=` Ksub p. +have sublevelUpsilon1q : sublevelUpsilon1 p q. + suff: cluster (sol p t @[t --> +oo]) `<=` sublevelUpsilon1 p. by apply; rewrite H. rewrite clusterE. apply :(@subset_trans _ (closure (sol p @` `[0, +oo[))). @@ -604,25 +600,25 @@ have Ksubq : Ksub p q. exists 0; split => //= x x0. exists x=>//. rewrite in_itv/=ltW//. - rewrite (closure_id (Ksub p)).1;last first. - by apply compact_closed =>//; apply compact_Ksub. + rewrite (closure_id (sublevelUpsilon1 p)).1;last first. + by apply compact_closed =>//; apply compact_sublevelUpsilon1. apply closure_subset. move => /= _ [t +] <-. rewrite in_itv/= => /andP[t0 _]. - apply invariant_Ksub => //. - by have /set_mem := q_inKsubq ps. -have [M [Mr Mp]]: bounded_set (Ksub p). + apply invariant_sublevelUpsilon1 => //. + by apply/set_mem/mem_sublevelUpsilon1/set_mem. +have [M [Mr Mp]]: bounded_set (sublevelUpsilon1 p). apply compact_bounded. - exact: compact_Ksub. + exact: compact_sublevelUpsilon1. have [M0 | M0] := leP 0 M;last first. suff : `|q| < 0 by rewrite normr_lt0. have M02 : M < M/2. by rewrite ltr_pdivlMr // gtr_nMr // ltrDl. - have /= w := (Mp _ M02 _ Ksubq). + have /= w := (Mp _ M02 _ sublevelUpsilon1q). apply (le_lt_trans w). rewrite ltr_pdivrMr // mul0r //. set V := ball (p : U) (`|p|+(M+1+1) : K). -have VKsub : Ksub p `<=` V. +have VsublevelUpsilon1 : sublevelUpsilon1 p `<=` V. move => /= x Kx. rewrite /V -ball_normE/ball_ /=. by rewrite (le_lt_trans (ler_normB _ _))// ltrD2l ltr_pwDr// Mp// ltrDl. @@ -645,13 +641,13 @@ apply: (compact_cluster_set1 _ cV ) => //. rewrite nbhsE/=. exists V; last by apply subset_closure. split => //. - by apply VKsub. -apply: (filterS (closure_subset VKsub)). + by apply VsublevelUpsilon1. +apply: (filterS (closure_subset VsublevelUpsilon1)). exists 0; split => //= x /ltW x0. -rewrite -(closure_id (Ksub p)).1;last first. - by apply compact_closed =>//; apply compact_Ksub. -apply invariant_Ksub => //. -by have /set_mem := q_inKsubq ps. +rewrite -(closure_id (sublevelUpsilon1 p)).1;last first. + by apply compact_closed =>//; apply compact_sublevelUpsilon1. +apply invariant_sublevelUpsilon1 => //. +by apply/set_mem/mem_sublevelUpsilon1/set_mem. Qed. End LaSalle_tilt. diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index 0a8687e0..fd8f0717 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -362,6 +362,10 @@ Proof. by []. Qed. Definition Upsilon1 := [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. +Lemma Upsilon1_preimage : + Upsilon1 = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. +Proof. by []. Qed. + Definition point1 : 'rV[K]_6 := 0. Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). From dc4595553eea57e4dd790c6570bfe6227d14178c Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 20 Feb 2026 02:34:18 +0900 Subject: [PATCH 131/144] C[a, b] notation --- ode.v | 639 +++++++++++++---------------------------------- ode_contfun.v | 280 ++++++--------------- tilt_analysis.v | 343 +++++++++++++++++++++---- tilt_lyapunov.v | 433 +++++++++----------------------- tilt_mathcomp.v | 7 + tilt_stability.v | 199 ++++----------- 6 files changed, 727 insertions(+), 1174 deletions(-) diff --git a/ode.v b/ode.v index 6ce2849b..61738ee0 100644 --- a/ode.v +++ b/ode.v @@ -7,7 +7,7 @@ From mathcomp Require Import contra functions constructive_ereal reals. From mathcomp Require Import topology prodnormedzmodule tvs normedtype. From mathcomp Require Import landau ereal sequences derive numfun measure. From mathcomp Require Import realfun lebesgue_measure lebesgue_integral ftc. -Require Import tilt_analysis ode_common ode_contfun. +Require Import tilt_mathcomp tilt_analysis ode_common ode_contfun. (**md**************************************************************************) (* # Proof of the Cauchy-Lipschitz theorem *) @@ -39,7 +39,7 @@ Require Import tilt_analysis ode_common ode_contfun. (* The dependence of safe_dist on the initial state u0 comes *) (* from sup_phi in the second term. *) (* @img_cball R n f a b k u0 r k0 rho == *) -(* set of functions of type (quot_conSet a b U) s.t. *) +(* set of functions of type `C([a, b] U) s.t. *) (* f @` `[a, a + safe_dist] `<=` closed_ball u0 r *) (* *) (* picard == similar to picard_fun *) @@ -62,95 +62,6 @@ Open Scope classical_set_scope. (* start of preliminaries *) -(* NB: PR to MathComp-Analysis in progress *) -Section pointwise_derivable. -Context {R : realFieldType} {V W : normedModType R} {m n : nat}. -Implicit Types M : V -> 'M[R]_(m, n). - -Definition derivable_mx M t v := - forall i j, derivable (fun x => M x i j) t v. - -Lemma derivable_mxP M t v : derivable_mx M t v <-> derivable M t v. -Proof. -split; rewrite /derivable_mx /derivable. -- move=> H. - apply/cvg_ex => /=. - pose l := \matrix_(i < m, j < n) sval (cid ((cvg_ex _).1 (H i j))). - exists l. - apply/cvgrPdist_le => /= e e0. - near=> x. - rewrite /Num.Def.normr/= mx_normrE. - apply: (bigmax_le _ (ltW e0)) => /= i _. - rewrite !mxE/=. - move: i. - near: x. - apply: filter_forall => /= i. - exact: ((@cvgrPdist_le _ _ _ _ (dnbhs_filter 0) _ _).1 - (svalP (cid ((cvg_ex _).1 (H i.1 i.2)))) _ e0). -- move=> /cvg_ex[/= l Hl] i j. - apply/cvg_ex; exists (l i j). - apply/cvgrPdist_le => /= e e0. - move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0] H. - near=> x. - apply: le_trans; last first. - apply: (H x). - rewrite /ball_/=. - rewrite sub0r normrN. - near: x. - exact: dnbhs0_lt. - near: x. - exact: nbhs_dnbhs_neq. - rewrite [leRHS]/Num.Def.normr/= mx_normrE. - apply: le_trans; last exact: le_bigmax. - by rewrite /= !mxE. -Unshelve. all: by end_near. Qed. - -End pointwise_derivable. - -(* NB: PR to MCA *) -Section pointwise_derive. -Local Open Scope classical_set_scope. -Context {R : realFieldType} {V W : normedModType R} . - -Lemma derive_mx {m n : nat} (M : V -> 'M[R]_(m, n)) t v : - derivable M t v -> - 'D_v M t = \matrix_(i < m, j < n) 'D_v (fun t => M t i j) t. -Proof. -move=> /cvg_ex[/= l Hl]; apply/cvg_lim => //=. -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : (Hl) => /(_ (e / 2)). -rewrite divr_gt0// => /(_ isT)[d /= d0 dle]. -near=> x. -rewrite [in leLHS]/Num.Def.normr/= mx_normrE. -apply/(bigmax_le _ (ltW e0)) => -[/= i j] _. -rewrite [in leLHS]mxE/= [X in _ + X]mxE -[X in X - _](subrK (l i j)). -rewrite -(addrA (_ - _)) (le_trans (ler_normD _ _))// (splitr e) lerD//. -- rewrite mxE. - suff : (h^-1 *: (M (h *: v + t) i j - M t i j)) @[h --> 0^'] --> l i j. - move/cvg_lim => /=; rewrite /derive /= => ->//. - by rewrite subrr normr0 divr_ge0// ltW. - apply/cvgrPdist_le => /= r r0. - move/cvgrPdist_le : Hl => /(_ r r0)[/= s s0] sr. - near=> y. - have : `|l - y^-1 *: (M (y *: v + t) - M t)| <= r. - rewrite sr//=; last by near: y; exact: nbhs_dnbhs_neq. - by rewrite sub0r normrN; near: y; exact: dnbhs0_lt. - apply: le_trans. - rewrite [in leRHS]/Num.Def.normr/= mx_normrE. - by under eq_bigr do rewrite !mxE; exact: (le_bigmax _ _ (i, j)). -- rewrite mxE. - have : `|l - x^-1 *: (M (x *: v + t) - M t)| <= e / 2. - apply: dle => //=; last by near: x; exact: nbhs_dnbhs_neq. - by rewrite sub0r normrN; near: x; exact: dnbhs0_lt. - apply: le_trans. - rewrite [in leRHS]/Num.Def.normr/= mx_normrE/=. - under eq_bigr do rewrite !mxE. - apply: le_trans; last exact: le_bigmax. - by rewrite !mxE. -Unshelve. all: by end_near. Qed. - -End pointwise_derive. - Reserved Notation "\vint [ mu ]_ ( i 'in' D ) F" (at level 36, F at level 36, i, D at level 60, format "'[' \vint [ mu ]_ ( i 'in' D ) '/ ' F ']'"). @@ -226,54 +137,15 @@ Qed. End rowRintegral_itv_split. -(* TODO: PR *) -Section vector_continuous. -Context {R : realType} {n : nat}. -Let U := 'rV[R]_n. - -Lemma within_continuous_coord (h : R -> U) D : - {within D, continuous h} <-> forall i, {within D, continuous (fun x => h x ord0 i)}. -Proof. -split=> [Dh i|H]. -- apply/subspace_continuousP => /= x Dx. - have /subspace_continuousP/(_ x Dx) H := Dh. - apply: ((@cvg_comp _ _ _ h (fun z => z ord0 i)) _ _ _ H). - exact: coord_continuous. -- apply/subspace_continuousP => /= x Dx. - apply/cvgrPdist_le => /= e e0. - rewrite near_withinE. - near=> t => Dt. - rewrite /Num.norm/= mx_normrE. - apply/(bigmax_le _ (ltW e0)) => /= -[i j] _ /=. - rewrite {i}(ord1 i) !mxE. - move: j Dt. - near: t. - apply: filter_forall => /= i. - have /subspace_continuousP/(_ x Dx) := H i. - move/cvgrPdist_le => /(_ _ e0). - rewrite near_withinE. - exact. -Unshelve. all: by end_near. Qed. - -End vector_continuous. - -Lemma continuous_within_ext {A B : topologicalType} (g h : A -> B) D : - {in D, g =1 h} -> - {within D, continuous g } -> {within D, continuous h}. +Lemma vec_norm_le_sum {R : realType} {n : nat} (x : 'rV[R]_n) : + `| x | <= \sum_(i < n) `|x ord0 i|. Proof. -move=> h1 h2. -apply subspace_continuousP. -move => x Dx. -apply : cvg_trans. -apply (fmap_within_eq (g := g)) => //. -apply nbhs_filter. -move => x' Dx' . -symmetry. -by apply h1. -rewrite <-h1. -move /subspace_continuousP : h2. -by apply. -by rewrite inE. +rewrite {1}/Num.norm/= mx_normrE. +apply: bigmax_le => /=;first by apply sumr_ge0 => i _; exact: normr_ge0. +move => [i0 i] _ /=. +rewrite {i0}(ord1 i0)/=. +rewrite (bigD1 i) //= lerDl. +by apply: sumr_ge0 => j _; exact: normr_ge0. Qed. (* TODO: PR *) @@ -297,17 +169,6 @@ apply: measurable_maxr. by apply: IH => i; exact: mf. Qed. -Lemma vec_norm_le_sum {R : realType} {n : nat} (x : 'rV[R]_n) : - `| x | <= \sum_(i < n) `|x ord0 i|. -Proof. -rewrite {1}/Num.norm/= mx_normrE. -apply: bigmax_le => /=;first by apply sumr_ge0 => i _; exact: normr_ge0. -move => [i0 i] _ /=. -rewrite {i0}(ord1 i0)/=. -rewrite (bigD1 i) //= lerDl. -by apply: sumr_ge0 => j _; exact: normr_ge0. -Qed. - Lemma vmeasurable_norm {R : realType} {n : nat} (D : set R) (F : R -> 'rV[R]_n): measurable D -> (forall i, measurable_fun D (fun t => F t ord0 i)) -> measurable_fun D (Num.norm \o F). @@ -618,28 +479,28 @@ Variable rho : {posnum R}. (* rho < 1 *) Import ContSeg_quot. Local Notation safe_dist := (@safe_dist R n phi a b k u0 r rho). -Local Notation V := (@quot_contSeg R a (a + safe_dist) U). +Local Notation C := (`C([a, a + safe_dist] U)). -Definition img_cball : set V := - [set f : V | f @` `[a, a + safe_dist] `<=` closed_ball u0 r%:num]. +Definition img_cball : set C := + [set f : C | f @` `[a, a + safe_dist] `<=` closed_ball u0 r%:num]. Lemma img_cball_nonempty : img_cball !=set0. Proof. -exists (pi V (cst u0)) => _ [y aay] <-. -suff -> : fun_of_quot_contSeg (\pi_V%qT (cst u0)) y = u0. +exists (pi C (cst u0)) => _ [y aay] <-. +suff -> : fun_of_quot_contSeg (\pi_C%qT (cst u0)) y = u0. exact: closed_ballxx. rewrite /fun_of_quot_contSeg/=. -have /eqmod_on_itv : (repr (\pi_V%qT (cst u0)) = cst u0 %[mod V])%qT. +have /eqmod_on_itv : (repr (\pi_C%qT (cst u0)) = cst u0 %[mod C])%qT. by rewrite reprK. by apply; rewrite inE. Qed. Lemma img_cballE : a < b -> img_cball = - @closed_ball R V (pi V (@cst (subspace `[a, a + safe_dist]) U u0)) r%:num. + @closed_ball R C (pi C (@cst (subspace `[a, a + safe_dist]) U u0)) r%:num. Proof. move=> ab; rewrite closed_ballE//. apply: eq_set => /= f; apply propext; split => h. -- rewrite -(@reprK _ V f). +- rewrite -(@reprK _ C f). rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. rewrite infty_norm_pi infty_norm0_le//. by rewrite /= lerDl ltW// safe_dist_gt0. @@ -650,11 +511,11 @@ apply: eq_set => /= f; apply propext; split => h. by exists x. - move => _ [x xad] <-. rewrite closed_ballE// /closed_ball_ /=. - have -> : u0 - f x = ((pi V (cst u0)) - f : V) x. - rewrite -(@reprK _ V f) /GRing.opp /=. + have -> : u0 - f x = ((pi C (cst u0)) - f : C) x. + rewrite -(@reprK _ C f) /GRing.opp /=. rewrite -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. by rewrite !eval_mod_on_itv// inE. - rewrite -(@reprK _ V f). + rewrite -(@reprK _ C f). rewrite /GRing.opp /= -Quotient.pi_opp /GRing.add /= -Quotient.pi_add. rewrite eval_mod_on_itv; last by rewrite inE. apply: (le_trans (infty_norm0_ge (leDl_safe_dist phi ab u0 r k0 rho) _ xad)). @@ -715,13 +576,13 @@ Qed. Import ContSeg_quot. -Local Notation V := (@quot_contSeg R a (a + safe_dist) U). +Local Notation C := (`C([a, a + safe_dist] U)). -Let set_fun_picard_fun (g : V) : +Let set_fun_picard_fun (g : C) : set_fun `[a, a + safe_dist] [set: U] (picard_fun g). Proof. by []. Qed. -HB.instance Definition _ (g : V) := @isFun.Build +HB.instance Definition _ (g : C) := @isFun.Build (subspace `[a, a + safe_dist]) _ `[a, a + safe_dist] setT (picard_fun g) (set_fun_picard_fun g). @@ -748,9 +609,9 @@ Local Notation picard_fun := (@picard_fun _ n phi a (a + safe_dist) u0 r k k0 Import ContSeg_quot. -Local Notation V := (@quot_contSeg R a (a + safe_dist) U). +Local Notation C := (`C([a, a + safe_dist] U)). -Let continuous_picard_fun (g : V) : +Let continuous_picard_fun (g : C) : {within `[a, a + safe_dist], continuous (picard_fun g)}. Proof. have [aaD|] := ltP a (a + safe_dist); last first. @@ -771,12 +632,12 @@ rewrite /picard_fun; case: pselect => /=. by move=> _ _; apply: continuous_subspaceT => z; exact: cvg_cst. Qed. -HB.instance Definition _ (g : V) := @isContinuous.Build _ _ +HB.instance Definition _ (g : C) := @isContinuous.Build _ _ (picard_fun g : subspace _ -> _) (@continuous_picard_fun g). -Check fun g : V => picard_fun g : continuousFunType _ _. +Check fun g : C => picard_fun g : continuousFunType _ _. -Check fun g : V => (\pi_(V)%qT (picard_fun g)) : V. +Check fun g : C => (\pi_C%qT (picard_fun g)) : C. End picard_fun_isContinuous. @@ -797,9 +658,9 @@ Local Notation safe_dist := (safe_dist phi a b k u0 r rho). Import ContSeg_quot. -Local Notation V := (@quot_contSeg R a (a + safe_dist) U). +Local Notation C := (`C([a, a + safe_dist] U)). -Lemma integrable_comp (F : V) y i : y \in `[a, a + safe_dist]%R -> +Lemma integrable_comp (F : C) y i : y \in `[a, a + safe_dist]%R -> F @` `[a, y] `<=` B -> mu.-integrable `[a, y] (EFin \o (fun t => phi t (F t) ord0 i)). Proof. @@ -821,90 +682,6 @@ Qed. End integrable_comp. -(* PR to MCA *) -Section Rintegral. -Context d {T : measurableType d} {R : realType}. -Variable mu : {measure set T -> \bar R}. -Implicit Types (D : set T). - -Lemma Rintegral_cst D : d.-measurable D -> - forall r, \int[mu]_(_ in D) r = r * fine (mu D). -Proof. -move=> mD r; rewrite /Rintegral/= integral_cst//. -have := leey (mu D); rewrite le_eqVlt => /predU1P[->/=|muy]; last first. - by rewrite fineM// ge0_fin_numE. -rewrite mulr0 mulr_infty/=; have [_|r0|r0] := sgrP r. -- by rewrite mul0e. -- by rewrite mul1e. -- by rewrite mulN1e. -Qed. - -End Rintegral. - -(* PR to MCA *) -Section continuous_patch. -Context {R : realType} {n : nat} {U : normedModType R}. -Variables (a b c : R) (f : R -> U) (g : R -> U). -Hypothesis ab : a < b. -Hypothesis bc : b < c. -Hypothesis cont1 : {within `[a, b], continuous f}. -Hypothesis cont2 : {within `[b, c], continuous g}. -Hypothesis matchb : f b = g b. - -Lemma within_continuous_patch : {within `[a, c], continuous (patch g `[a, b] f)}. -Proof. -have -> : `[a, c] = `[a, b] `|` `[b, c]. - rewrite (@itv_bndbnd_setU _ _ _ (BRight b)) // ?bnd_simp//=; [|exact: ltW..]. - apply/seteqP; split => [x []|x []]. - by left. - by right; exact: subset_itv_oc_cc b0. - by left. - rewrite -setU1itv ?bnd_simp//; last exact: ltW. - case; last by right. - move=> ->; left => /=. - by rewrite bound_itvE ltW. -apply: (withinU_continuous (@itv_closed _ _ a b) (@itv_closed _ _ b c)). - have eq1 : {in `[a, b], f =1 patch g `[a, b] f }. - by move=> r rab; rewrite /patch rab. - apply: (continuous_within_ext eq1). - exact: cont1. -have eq2 : {in `[b, c], g =1 patch g `[a, b] f }. - move=> r rab. - rewrite /patch; case: ifPn => [xab | xabnot] => //. - suff -> : r = b by rewrite matchb. - apply: le_anti. - move: rab xab. - by rewrite !inE/=!in_itv/= => /andP [-> _] /andP [_ ->]. -apply/continuous_subspaceW/(continuous_within_ext eq2)/cont2. -by apply: subset_itvl; rewrite bnd_simp. -Qed. - -End continuous_patch. - -(* TODO: PR to MCA *) -Lemma nbhs_ge {R : realFieldType} (t x : R) : - t < x -> \forall x0 \near nbhs x, t <= x0. -Proof. -move=> tx. -exists ((x - t) / 2). - by rewrite /= divr_gt0// subr_gt0. -move=> y/=. -have [xy|yx] := lerP x y. - rewrite ltrBlDl => H. - by rewrite (le_trans (ltW tx)). -rewrite ltrBlDl -ltrBlDr => /ltW; apply: le_trans. -rewrite -lerBlDr opprK. -by rewrite -lerBrDl ler_piMr ?invf_le1 ?ler1n// subr_ge0 ltW. -Qed. - -(* TODO: PR to MC *) -Definition And31 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := - let: And3 p1 p2 p3 := a in p1. -Definition And32 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := - let: And3 p1 p2 p3 := a in p2. -Definition And33 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := - let: And3 p1 p2 p3 := a in p3. - Section picard. Local Notation mu := lebesgue_measure. Context {R : realType} {n : nat}. @@ -927,9 +704,9 @@ Local Notation picard_fun := (@picard_fun _ n phi a (a + safe_dist) u0 r k k0' Import ContSeg_quot. -Local Notation V := (@quot_contSeg R a (a + safe_dist) U). +Local Notation C := (`C([a, a + safe_dist] U)). -Definition picard (f : V) : V := \pi_V%qT (picard_fun f). +Definition picard (f : C) : C := \pi_C%qT (picard_fun f). Local Notation img_cball := (@img_cball R n phi a b k u0 r rho). Local Notation sup_phi := (@sup_phi R n phi a b u0). @@ -943,8 +720,8 @@ apply closed_ball_vecE => i. rewrite closed_ball_itv//=. rewrite in_itv//=. rewrite [X in _ <= X <= _](_ : _ = (picard_fun F) y ord0 i); last first. - have /eqmod_on_itv : (repr (\pi_(V)%qT (picard_fun F)) = - picard_fun F %[mod V])%qT. + have /eqmod_on_itv : (repr (\pi_C%qT (picard_fun F)) = + picard_fun F %[mod C])%qT. by rewrite reprK. by move=> <- //; rewrite inE. rewrite /picard_fun; case: pselect => /= abu0r; last by []. @@ -1192,7 +969,7 @@ Import ContSeg_quot. Local Notation safe_dist := (safe_dist phi a b k u0 r rho). -Notation V := (@quot_contSeg R a (a + safe_dist) U). +Notation C := (quot_contSeg a (a + safe_dist) U). Notation img_cball := (@img_cball _ n phi a b k u0 r rho). Check @cst (subspace `[a, a + safe_dist]) U u0 @@ -1309,7 +1086,7 @@ rewrite (@le_trans _ _ (k * \int[mu]_(t0 in `[a, t]) `|x - y| ))//. have x0ad : x0 \in `[a, a + safe_dist]%R. apply: subset_itvl x0at; rewrite bnd_simp. by move: tNdd; rewrite in_itv/= => /andP[]. - have -> : x x0 - y x0 = (x - y : V) x0. + have -> : x x0 - y x0 = (x - y : C) x0. apply (@eqmod_on_itv _ _ _ _ (repr x - repr y)) => //. by rewrite Quotient.pi_add Quotient.pi_opp !reprK. by rewrite infty_norm0_ge// leDl_safe_dist. @@ -1338,7 +1115,7 @@ HB.instance Definition _ {R : realType} (n : nat) := NormedModule.on (@row_vecto Section is_sol. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. -Variable (phi : R -> U -> U). +Variable phi : R -> U -> U. Definition sol_is_deriv_cbnd (a : R) (b : itv_bound R) (f : R -> U) := {in Interval (BLeft a) b, forall t, derivable f t 1 /\ f^`() t = phi t (f t)}. @@ -1997,35 +1774,6 @@ Qed. End solution_locally_unique. -(* TODO: move *) -Section closure_neitv. -Context {R : realType}. -Implicit Type a b : R. - -Lemma closure_neitv_oo a b : a < b -> - closure `]a, b[%classic = `[a, b]%classic. -Proof. -move=> ab. -set c := (a + b) / 2%:R. -set d := (b - a) / 2%:R. -rewrite (_ : a = c - d); last by rewrite /c/d !mulrDl addrKA mulNr opprK -splitr. -rewrite (_ : b = c + d); last by rewrite addrC /c/d !mulrDl mulNr subrKA -splitr. -rewrite -ball_itv -closed_ball_itv ?closure_ballE//. -apply: divr_gt0 => //. -by rewrite subr_gt0. -Qed. - -End closure_neitv. - -(* TODO: move *) -Lemma within_continuousB {K : realType} {V : normedModType K} - (A : set K) (f g : _ -> V) : - {within A, continuous f} -> {within A, continuous g} -> - {within A, continuous (f - g)}. -Proof. -by move=> cf cg x; apply: cvgB; [exact: cf|exact: cg]. -Qed. - (* only for autonomous, used for tilt *) Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. @@ -2194,7 +1942,7 @@ Unshelve. all: by end_near. Qed. End uniqueness. -Section picard_symmetric. +Section cauchy_lipschitz_symmetric. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. Variables (phi : R -> U -> U) (k : R) (u0 : U) (r : {posnum R}) (a b : R). @@ -2204,16 +1952,14 @@ Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Hypothesis lip2 : {in `[a, b]%R, forall x, k.-lipschitz_B (phi x)}. Definition phi_ (t : R) x := phi x. -Definition is_sol_sym u0 t0 d (sol : R -> U):= - sol t0 = u0 /\ sol_is_deriv_oo phi (t0-d) (t0+d) sol. +Definition is_sol_sym u0 t0 d (f : R -> U):= + f t0 = u0 /\ sol_is_deriv_oo phi (t0 - d) (t0 + d) f. - -Let rho : {posnum R} := (2^-1)%:pos. +Let rho : {posnum R} := 2^-1%:pos. Let rho1 : rho%:num < 1. Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. - Lemma patch_in {X : Type} (f g : R -> X) S x : x \in S -> patch f S g x = g x. Proof. move => xs. @@ -2221,45 +1967,27 @@ Proof. by rewrite xs. Qed. - -Lemma closed_ball_split (x1 x2 y :U) q : 0 < q -> closed_ball x1 (q/2) y -> closed_ball x2 (q/2) x1 -> closed_ball x2 q y. -Proof. - move => hq. - have hq2: (0 < q /2). - by rewrite divr_gt0. - rewrite !closed_ballE// /closed_ball_ /=. - move => h1 h2. - rewrite -(subrKA x1 x2). - by apply: (le_trans (ler_normD _ _)); rewrite (splitr q) lerD//. -Qed. - -(*todo : move or PR? *) -Lemma within_continuous_minus (f : R -> U) (c d : R) : - {within `[-d,-c], continuous f} -> {within `[c,d], continuous f \o -%R}. +Lemma closed_ball_split (x1 x2 y : U) q : 0 < q -> + closed_ball x1 (q / 2) y -> closed_ball x2 (q / 2) x1 -> closed_ball x2 q y. Proof. -have [ab|ba _ |-> _] := ltgtP c d; last 2 first. - by rewrite set_itv_ge ?bnd_simp -?ltNge//; exact: continuous_subspace0. - by rewrite set_itv1; exact: continuous_subspace1. -move/continuous_within_itvP; rewrite ltrN2 => /(_ ab)[cf fb fa]. -apply/(continuous_within_itvP _ ab); split. -- move=> t tab. - apply: (@cvg_comp _ _ _ -%R f); first exact: oppr_continuous. - by apply: cf; rewrite oppr_itvoo !opprK. -- by rewrite -{1}(opprK c); apply/cvg_at_leftNP; exact: fa. -- by rewrite -{1}(opprK d); apply/cvg_at_rightNP; exact: fb. +move => hq. +have hq2 : 0 < q / 2 by rewrite divr_gt0. +rewrite !closed_ballE// /closed_ball_ /= => h1 h2. +rewrite -(subrKA x1 x2). +by rewrite (le_trans (ler_normD _ _))// (splitr q) lerD. Qed. Let r2 := (r%:num/2)%:pos. Let r4 := (r%:num/4)%:pos. -Let ler4 : r4%:num <= r%:num. +Let ler4 : r4%:num <= r%:num. Proof. by rewrite /r4/= ler_pdivrMr // ler_pMr // lerDl. Qed. -Let ler42 : r4%:num <= r2%:num. +Let ler42 : r4%:num <= r2%:num. Proof. by rewrite /r4/r2/= ler_pdivrMr// -mulrA ler_pMr // ler_pdivlMl // mulr1 lerD // lerDl. Qed. Let B4 := closed_ball u0 r4%:num. -Let phi_lip2 t0: t0 \in `[a,b]%R -> {in `[t0, b]%R, forall x, k.-lipschitz_B4 (phi x)}. +Let phi_lip2 t0: t0 \in `[a,b]%R -> {in `[t0, b]%R, forall x, k.-lipschitz_B4 (phi x)}. Proof. move => tab x abx /= y By. apply: lip2. @@ -2297,12 +2025,13 @@ move : t0ab. by rewrite in_itv/= => /andP[]. Qed. -Local Lemma phi_cont1' t0 : t0 \in `[a,b]%R -> {in B4, forall y, {within `[-t0, -a], continuous -(fun t => phi (-t) y)}}. -Proof. +Local Lemma phi_cont1' t0 : t0 \in `[a,b]%R -> + {in B4, forall y, {within `[-t0, -a], continuous -(fun t => phi (-t) y)}}. +Proof. move => t0ab /= y By. move => t. apply: continuousN. -have /within_continuous_minus : {within `[-(-a), - (-t0)], continuous phi^~ y}. +have /within_continuous_minus : {within `[-(-a), - (-t0)], continuous phi^~ y}. rewrite !opprK. apply /continuous_subspaceW/cont1 => //. apply : subset_itvl. @@ -2313,43 +2042,39 @@ by apply : le_closed_ball By. apply. Qed. - -Let dplus t0 := safe_dist phi t0 b k u0 (r4%:num)%:pos rho. +Let dplus t0 := safe_dist phi t0 b k u0 (r4%:num)%:pos rho. Let dminus t0 := safe_dist (fun t x => - phi (-t) x) (-t0) (-a) k u0 (r4%:num)%:pos rho. -Let dboth t0 := Num.min (b-t0) (Num.min (dplus t0) (dminus t0)). -(* Let fplus t0 t0b t0ab := @cauchy_lipschitz_local_f R n phi t0 _ k u0 (r%:num/4)%:pos *) -(* t0b k0 (phi_lip2 t0ab) (phi_cont1 t0ab) rho rho1. *) -(* Let fminus t0 t0a t0ab := *) -(* @cauchy_lipschitz_local_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r *) -(* t0a k0 (phi_lip2' t0ab) (phi_cont1' t0ab) rho rho1. *) -Lemma cauchy_lipschitz_sym t0 : t0 \in `]a, b[%R -> - exists f, is_sol_sym u0 t0 (dboth t0) f. +Let dboth t0 := Num.min (b - t0) (Num.min (dplus t0) (dminus t0)). + +Section cauchy_lipschitz_sym. +Variable t0 : R. +Hypothesis t0ab : t0 \in `]a, b[%R. + +Let amin1 : - t0 < - a. Proof. by rewrite ltrN2 (itvP t0ab). Qed. + +Let t0ab' : t0 \in `[a, b]%R. Proof. by exact: subset_itv_oo_cc. Qed. + +Let fminus0 := @cauchy_lipschitz_f R n (fun t x => - phi (- t) x) (- t0) + _ k u0 r4 amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho rho1. + +Let fminus := fminus0 \o -%R. + +Let t0b : t0 < b. Proof. by rewrite (itvP t0ab). Qed. + +Let fplus := @cauchy_lipschitz_f R n phi t0 + _ k u0 r4 t0b k0 (phi_lip2 t0ab') (phi_cont1 t0ab') rho rho1. + +Let f := patch fplus `[t0 - dboth t0, t0] fminus. + +Lemma cauchy_lipschitz_sym : is_sol_sym u0 t0 (dboth t0) f. Proof. -move => t0ab. -have t0ab' : t0 \in `[a,b]%R. - by rewrite inE;apply: subset_itv_oo_cc. -have t0b : t0 < b. - move: t0ab. - by rewrite in_itv/= => /andP[]. have solplus := - cauchy_lipschitz_ex t0b k0 - (phi_lip2 t0ab') (phi_cont1 t0ab') rho1. + cauchy_lipschitz_ex t0b k0 (phi_lip2 t0ab') (phi_cont1 t0ab') rho1. have cplus := solution_stays_in_ball. -set fplus := @cauchy_lipschitz_f R n phi t0 _ k u0 r4 t0b k0 - (phi_lip2 t0ab') (phi_cont1 t0ab') rho rho1. -have amin1 : -t0 < -a. - rewrite ltrNr opprK. - by move : t0ab; rewrite in_itv/= => /andP[]. -have dminus0 : 0 < dminus t0. - by apply safe_dist_gt0. +have dminus0 : 0 < dminus t0 by exact: safe_dist_gt0. have solminus := - cauchy_lipschitz_ex amin1 k0 - (phi_lip2' t0ab') (phi_cont1' t0ab') rho1. + cauchy_lipschitz_ex amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho1. have cminus := solution_stays_in_ball. -set fminus0 := - @cauchy_lipschitz_f R n (fun t x => - phi (-t) x) (-t0) _ k u0 r4 - amin1 k0 (phi_lip2' t0ab') (phi_cont1' t0ab') rho rho1. -set fminus := fminus0 \o -%R. have adplus : t0 < t0 + dplus t0 by rewrite ltrDl safe_dist_gt0. have cfplus := And33 solplus. rewrite closure_neitv_oo in cfplus; last by rewrite ltrDl safe_dist_gt0. @@ -2359,38 +2084,35 @@ rewrite closure_neitv_oo in cfminus'; last by rewrite ltrDl. have cfminus : {within `[t0-dminus t0, t0], continuous fminus}. rewrite /fminus. apply: within_continuous_minus. - apply /continuous_subspaceW/cfminus'. - apply: subset_itvl. - rewrite -/dminus. - by rewrite bnd_simp/= opprD opprK. + apply/continuous_subspaceW/cfminus'. + apply: subset_itvl; rewrite bnd_simp -/dminus. + by rewrite opprD opprK. have dboth0 : 0 < dboth t0. - rewrite lt_min; apply /andP;split; last by rewrite lt_min safe_dist_gt0 //= lt_min dminus0 //=. - rewrite subr_gt0. - move : t0ab. - by rewrite in_itv/= => /andP[]. -pose f := patch fplus `[t0 - dboth t0, t0] fminus. + rewrite lt_min; apply /andP;split; last first. + by rewrite lt_min safe_dist_gt0 //= lt_min dminus0. + by rewrite subr_gt0 (itvP t0ab). set uneg := f (t0 - dboth t0). -have Buneg : closed_ball uneg (r%:num/2) `<=` closed_ball u0 r%:num. - rewrite /uneg/f patch_in/f/=;last first. - by rewrite inE/=in_itv/= gerBl lexx ltW. - move => /=x xb. +have Buneg : closed_ball uneg (r%:num / 2) `<=` closed_ball u0 r%:num. + rewrite /uneg/f patch_in /f/=; last first. + by rewrite inE/=in_itv/= gerBl lexx ltW. + move=> /= x xb. apply: (closed_ball_split _ xb) => //. suff : fminus (t0 - dboth t0) \in closed_ball u0 (r%:num/4). rewrite !inE. apply le_closed_ball. - rewrite ler_pdivrMr//= -mulrA /=ler_peMr//. - by rewrite ler_pdivlMl //= mulr1 ltW // ler_ltD //= ltrDl. - apply mem_set;apply: cminus. - rewrite in_itv/= opprB lerDr ltW //= addrC lerD // . - by rewrite /dboth/dplus 3!ge_min lexx !orbT. + rewrite ler_wpM2l// lef_pV2 ?posrE//. + by rewrite (natrD _ 2 2) lerDl ler0n. + apply/mem_set/cminus. + rewrite in_itv/= opprB lerDr ltW //= addrC lerD//. + by rewrite /dboth /dplus 3!ge_min lexx !orbT. have f01intersect : fminus t0 = fplus t0. by rewrite /fminus/= (And31 solminus) (And31 solplus). have fa : f t0 = u0. - rewrite /f patch_in /fminus /=. - apply solminus. - by rewrite inE/=in_itv/= lexx gerBl ltW. + rewrite /f patch_in /fminus /=. + apply solminus. + by rewrite inE/= in_itv/= lexx gerBl ltW. set B' := closed_ball uneg (r2%:num). -have lip2' : {in `[t0-dboth t0 ,t0+dboth t0], forall x, k.-lipschitz_B' (phi x)}. +have lip2' : {in `[t0 - dboth t0 ,t0 + dboth t0], forall x, k.-lipschitz_B' (phi x)}. move => /= t tab [x1 x2] [Bx1 Bx2]. apply lip2 => //. move : tab. @@ -2404,7 +2126,7 @@ have lip2' : {in `[t0-dboth t0 ,t0+dboth t0], forall x, k.-lipschitz_B' (phi x)} have contf_minus : {within `[t0 - dboth t0, t0], continuous fminus}. apply /continuous_subspaceW/cfminus. apply: subset_itvr. - by rewrite bnd_simp /= lerD //= lerNr opprK 3!ge_min lexx !orbT. + by rewrite bnd_simp /= lerD //= lerNr opprK 3!ge_min lexx !orbT. have contf_plus : {within `[t0, t0+dboth t0], continuous fplus}. apply /continuous_subspaceW/cfplus. apply: subset_itvl. @@ -2418,29 +2140,29 @@ have r42 : r4%:num = (r2%:num / 2). rewrite -mulrA. apply congr2 => //. by rewrite -invfM -natrM. -have fc : {in `[t0-dboth t0, (t0 + dboth t0)], forall t : R, closed_ball (fminus (t0 - dboth t0)) r2%:num (f t)}. +have fc : {in `[t0-dboth t0, (t0 + dboth t0)], + forall t : R, closed_ball (fminus (t0 - dboth t0)) r2%:num (f t)}. move => t tad. - rewrite /f/=/patch/=. - have : (closed_ball (fminus (t0-dboth t0)) (r4%:num)) u0. - suff: (fminus (t0-dboth t0)) \in closed_ball u0 (r4%:num). + rewrite /f/= /patch/=. + have : (closed_ball (fminus (t0 - dboth t0)) (r4%:num)) u0. + suff: (fminus (t0 - dboth t0)) \in closed_ball u0 (r4%:num). by rewrite inE/= !closed_ballE/closed_ball_/= // distrC . - apply mem_set;apply cminus. - rewrite !in_itv/= lerNr lerNl opprD !opprK gerBl ltW //= lerB //. - by rewrite /dboth/dminus 3!ge_min lexx !orbT. - rewrite r42. - move => c1. + apply/mem_set/cminus. + rewrite !in_itv/= lerNr lerNl opprD !opprK gerBl ltW//= lerB//. + by rewrite /dboth/dminus 3!ge_min lexx !orbT. + rewrite r42 => c1. case : ifP => ht. - - have : (fminus t) \in closed_ball u0 (r4%:num). - apply mem_set;apply cminus. + - have : fminus t \in closed_ball u0 r4%:num. + apply/mem_set/cminus. move: ht. - rewrite inE/=!in_itv/= lerNr lerNl opprD !opprK => /andP[h1 ->//=]. - apply: (le_trans _ h1). - by rewrite lerB // 3!ge_min lexx !orbT. - rewrite inE. - rewrite !r42. - move => c2. - apply: (closed_ball_split _ c2) =>//. - - have : (fplus t) \in closed_ball u0 (r4%:num). + rewrite inE/=!in_itv/= lerNr lerNl opprD !opprK => /andP[h1 ->//=]. + apply: (le_trans _ h1). + by rewrite lerB // 3!ge_min lexx !orbT. + rewrite inE. + rewrite !r42. + move => c2. + by apply: (closed_ball_split _ c2) =>//. + - have : (fplus t) \in closed_ball u0 (r4%:num). have ht' : t \in `[t0, t0 + dboth t0]. have := tad. rewrite !inE /=!in_itv/= => /andP[h1 ->]; apply /andP; split => //. @@ -2450,15 +2172,14 @@ have fc : {in `[t0-dboth t0, (t0 + dboth t0)], forall t : R, closed_ball (fminu apply mem_set;apply cplus. move : ht'. rewrite inE/= !in_itv/= => /andP[-> h1//=]. - apply: (le_trans h1). + apply: (le_trans h1). by rewrite lerD // /dboth /dplus 2!ge_min lexx !orbT. rewrite inE. rewrite !r42. move => c2. - apply: (closed_ball_split _ c2) =>//. -exists f. + by apply: (closed_ball_split _ c2). split => //. -suff h: is_sol_oo phi (f (t0-dboth t0)) (t0-dboth t0) (t0+dboth t0) f by apply (And32 h). +suff h : is_sol_oo phi (f (t0-dboth t0)) (t0-dboth t0) (t0+dboth t0) f by apply (And32 h). have kn0 : k != 0 by apply lt0r_neq0. apply /(integral_sol_iff_sol (r := r2) kn0) => //. by rewrite ler_ltD // gtrN. @@ -2506,17 +2227,16 @@ apply: is_integral_sol_patch => //. apply: subset_itv; rewrite bnd_simp. rewrite lerBrDl -lerBrDr. by rewrite !ge_min opprK (addrC t0) lexx /= !orbT. - move : t0ab. - by rewrite in_itv/= => /andP[_ /ltW//]. + by rewrite (itvP t0ab). exact: tab. move => _ [/= t' tp] <-. apply (le_closed_ball (e1:=r4%:num)) => //. suff : (fminus t') \in closed_ball u0 r4%:num by rewrite inE. - apply mem_set;apply cminus. - move : tp. - rewrite !in_itv/=lerNl opprK => /andP[h0 ->//=]. - rewrite lerNl opprD opprK //=. - apply: (le_trans _ h0). + apply mem_set; apply cminus. + move : tp. + rewrite !in_itv/=lerNl opprK => /andP[h0 ->//=]. + rewrite lerNl opprD opprK //=. + apply: (le_trans _ h0). by rewrite lerB // 3!ge_min lexx !orbT. - apply : (within_continuous_lipschitz _ kn0 (u0 := u0) (r:=r)). exact: contf_plus. @@ -2524,53 +2244,44 @@ apply: is_integral_sol_patch => //. apply lip2. move : bx. apply: subset_itv; rewrite bnd_simp. - move : t0ab. - by rewrite in_itv/= => /andP[/ltW//]. - rewrite -lerBrDl. - by rewrite ge_min lexx. + by rewrite (itvP t0ab). + by rewrite -lerBrDl ge_min lexx. move => t tab. - apply /continuous_subspaceW/cont1. + apply/continuous_subspaceW/cont1. apply: subset_itv; rewrite bnd_simp. - move : t0ab. - by rewrite in_itv/= => /andP[/ltW//]. - rewrite -lerBrDl. - by rewrite ge_min lexx. + by rewrite (itvP t0ab). + by rewrite -lerBrDl ge_min lexx. exact: tab. move => _ [/= t' tp] <-. apply (le_closed_ball (e1:=r4%:num)) => //. suff : (fplus t') \in closed_ball u0 r4%:num by rewrite inE. apply mem_set;apply cplus. - move : tp. - rewrite !in_itv/= => /andP[-> h1//=]. - apply: (le_trans h1). - by rewrite lerD // /dboth /dplus 2!ge_min lexx !orbT. + move: tp. + apply: subset_itvl; rewrite bnd_simp lerD2l. + by rewrite /dboth /dplus 2!ge_min lexx !orbT. - apply /(integral_sol_iff_sol (r:=r2) kn0). + by rewrite gtrBl. + move => x bx. apply lip2'. - move : bx. - rewrite !inE. - apply: subset_itvl; rewrite bnd_simp. + rewrite inE. + apply: subset_itvl bx; rewrite bnd_simp. by rewrite lerDl ltW. + move => t tab. apply /continuous_subspaceW/cont1. apply: subset_itv; rewrite bnd_simp. rewrite lerBrDl -lerBrDr. by rewrite !ge_min opprK (addrC t0) lexx !orbT. - move : t0ab. - by rewrite in_itv/= => /andP[_ /ltW//]. - apply mem_set. - apply Buneg. - by apply set_mem. + by rewrite (itvP t0ab). + exact/mem_set/Buneg/set_mem. + by []. + move => _ [t tp] <-. rewrite {1}/f patch_in;last first. by rewrite inE/=in_itv/= lexx //= gerBl ltW. - have tin : t \in `[t0-dboth t0, t0+dboth t0]. + have tin : t \in `[t0 - dboth t0, t0 + dboth t0]. move : tp. rewrite !inE. - apply: subset_itv; rewrite bnd_simp //. - by rewrite lerDl ltW. + apply: subset_itv; rewrite bnd_simp//. + by rewrite lerDl// ltW. have := fc _ tin. rewrite {1}/f patch_in; last by rewrite inE. apply. @@ -2583,12 +2294,12 @@ apply: is_integral_sol_patch => //. apply: (le_lt_trans _ h1). by rewrite lerB// 3!ge_min lexx !orbT. move => h1 h2. - have hd : (derivable fminus t 1). + have hd : derivable fminus t 1. rewrite /fminus/=. - apply /derivable1_diffP. - apply /differentiable_comp => //. - apply /derivable1_diffP. - apply h1. + apply/derivable1_diffP. + apply/differentiable_comp => //. + apply/derivable1_diffP. + by apply h1. split=>//. rewrite /fminus/=. apply /rowP => i /=. @@ -2617,8 +2328,7 @@ apply: is_integral_sol_patch => //. move : bx. rewrite !inE. apply: subset_itv; rewrite bnd_simp. - move : t0ab. - by rewrite in_itv/= => /andP[/ltW//]. + by rewrite (itvP t0ab). rewrite -lerBrDl. by rewrite ge_min lexx. split => /=. @@ -2630,10 +2340,8 @@ apply: is_integral_sol_patch => //. + move => t tab. apply /continuous_subspaceW/cont1. apply: subset_itv; rewrite bnd_simp. - move : t0ab. - by rewrite in_itv/= => /andP[ /ltW//]. - rewrite -lerBrDl. - by rewrite ge_min lexx. + by rewrite (itvP t0ab). + by rewrite -lerBrDl ge_min lexx. rewrite /B. suff -> : u0 = fminus t0. apply mem_set. @@ -2647,27 +2355,26 @@ apply: is_integral_sol_patch => //. by rewrite lerBlDl lerDr ltW. + by []. + move => _ [t tp] <-. + rewrite /fminus /= (And31 solminus). + apply: (le_closed_ball ler42). + suff : fplus t \in closed_ball u0 r4%:num by rewrite inE. + apply/mem_set; apply cplus. + move/mem_set : tp. + rewrite inE /=!in_itv/= => /andP[-> //=]. + move/le_trans; apply. + by rewrite lerD// /dboth /dplus 2!ge_min lexx !orbT. rewrite /fminus /=(And31 solminus). - apply : (le_closed_ball ler42). - suff : fplus t \in closed_ball u0 r4%:num by rewrite inE. - apply mem_set;apply cplus. - move /mem_set : tp. - rewrite inE /=!in_itv/= => /andP[-> h1//=]. - apply: (le_trans h1). - by rewrite lerD // /dboth /dplus 2!ge_min lexx !orbT. - rewrite /fminus /=(And31 solminus). - split. + split; first by apply solplus. + move=> t tad. apply solplus. - move => t tad. - apply solplus. - move : tad. - rewrite !in_itv/= => /andP[-> h0]//=. - apply (lt_le_trans h0). - by rewrite lerD //= /dboth /dplus 2!ge_min lexx !orbT. - apply /continuous_subspaceW/cfplus. + apply: subset_itvl tad; rewrite bnd_simp lerD2l. + by rewrite /dboth /dplus 2!ge_min lexx !orbT. + apply/continuous_subspaceW/cfplus. rewrite closure_neitv_oo;last by rewrite ltrDl. - apply subset_itvl. - rewrite bnd_simp /=. - by rewrite lerD //= /dboth /dplus 2!ge_min lexx !orbT. + apply: subset_itvl; rewrite bnd_simp lerD2l. + by rewrite /dboth /dplus 2!ge_min lexx !orbT. Qed. -End picard_symmetric. + +End cauchy_lipschitz_sym. + +End cauchy_lipschitz_symmetric. diff --git a/ode_contfun.v b/ode_contfun.v index 820082ce..5f4c3f47 100644 --- a/ode_contfun.v +++ b/ode_contfun.v @@ -17,12 +17,19 @@ Require Import ode_common. (* type. *) (* *) (* ``` *) -(* infty_norm f := infty_norm0 (repr f) *) -(* quot_contSeg := quotient of continuous functions over a closed interval *) +(* infty_norm f := infty_norm0 (repr f) *) +(* quot_contSeg a b U := quotient of continuous functions over a closed *) +(* interval [a, b] to some normed module U *) +(* Notation: `C[a, b] or `C([a, b] U) *) (* ``` *) (* *) (******************************************************************************) +Reserved Notation "`C[ a , b ]" (at level 0, a, b at level 0, + format "`C[ a , b ]"). +Reserved Notation "`C([ a , b ] W )" (at level 1, a, b at next level, + format "`C([ a , b ] W )"). + Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. @@ -233,31 +240,32 @@ Qed. End contSeg_quotient. End ContSeg_quot. +Arguments ContSeg_quot.quot_contSeg {R} a b W. + +Notation "`C[ a , b ]" := (ContSeg_quot.quot_contSeg a b _). +Notation "`C([ a , b ] W )" := (ContSeg_quot.quot_contSeg a b W). Section zmodule_normed. Context {R : realType} {W : normedModType R}. Variables a b : R. -Let K := `[a, b]%R. Import ContSeg_quot. -Local Notation V := (@quot_contSeg R a b W). - -Definition infty_norm (f : V) := infty_norm0 (repr f). +Definition infty_norm (f : `C([a , b] W)) := infty_norm0 (repr f). Local Open Scope quotient_scope. -Lemma ler_infty_normD (x y : V) : +Lemma ler_infty_normD (x y : `C[a, b]) : infty_norm (x + y) <= infty_norm x + infty_norm y :> R. Proof. rewrite /infty_norm/=. -have [K0|K0] := eqVneq [set` K] set0. +have [K0|K0] := eqVneq `[a, b] set0. rewrite /infty_norm0. do ! rewrite [X in [set _ | _ in X]](_ : _ = set0)// image_set0//. by rewrite sup0 addr0. have ab : a <= b. rewrite leNgt; apply: contra K0 => ba. - by rewrite /K set_itv_ge// bnd_simp -ltNge. + by rewrite set_itv_ge// bnd_simp -ltNge. rewrite -sup_sumE; [|exact: normr_has_sup..]. apply: sup_le. - move=> A -[s sab] <-{A}. @@ -268,7 +276,7 @@ apply: sup_le. exists `|repr y s|; first by exists s. reflexivity. suff -> : repr (x + y) s = repr x s + repr y s by exact: ler_normD. - suff : repr (x + y) = repr x + repr y %[mod V]. + suff : repr (x + y) = repr x + repr y %[mod `C[a, b]]. move=> /eqmod_on_itv ->. by []. by rewrite inE. @@ -278,14 +286,14 @@ apply: sup_le. + exists (`|x a| + `|repr y a|)=> /=. exists (`|repr x a|) => //; [exists a => //; by rewrite in_itv/= lexx ab|]. by exists `|repr y a| => //; exists a => //; rewrite bound_itvE. - + exists (sup [set `|repr x r| | r in [set` K]] + sup [set `|repr y r| | r in [set` K]]). + + exists (sup [set `|repr x r| | r in `[a, b]] + sup [set `|repr y r| | r in `[a, b]]). apply ubP => _ [x0 xs] [y0 ys] <-. rewrite lerD// ub_le_sup//. exact: (normr_has_sup x _).2. exact: (normr_has_sup y _).2. Qed. -Lemma infty_normr0_eq0 (x : V) : infty_norm x = 0 -> x = 0. +Lemma infty_normr0_eq0 (x : `C[a, b]) : infty_norm x = 0 -> x = 0. Proof. rewrite /infty_norm /infty_norm0 /= => H. rewrite -(reprK x) -(reprK 0). @@ -293,7 +301,7 @@ apply/eqquotP. rewrite Quotient.equivE inE; apply: funext => r /=. rewrite /patch; case : ifPn => // /set_mem in_itv. rewrite 2!fctE. -have -> : {in K, repr (0 : V) =1 (0 : @continuousFunType R W [set` K] setT)}. +have -> : {in `[a, b]%R, repr (0 : `C[a, b]) =1 (0 : @continuousFunType R W `[a, b] setT)}. - apply/eqmod_on_itv. by rewrite reprK /GRing.zero /= /Quotient.zero /= -lock. - rewrite [LHS]subr0. @@ -308,11 +316,11 @@ have -> : {in K, repr (0 : V) =1 (0 : @continuousFunType R W [set` K] setT)}. - by rewrite inE. Qed. -Lemma infty_normrMn (x : V) n : infty_norm (x *+ n) = infty_norm x *+ n. +Lemma infty_normrMn (x : `C[a, b]) n : infty_norm (x *+ n) = infty_norm x *+ n. Proof. rewrite /infty_norm -infty_norm0rMn => //. apply: infty_norm0_itv_eq => r rab. -suff : repr (x *+ n) = repr x *+ n %[mod V] by move=> /eqmod_on_itv ->. +suff : repr (x *+ n) = repr x *+ n %[mod `C[a, b]] by move=> /eqmod_on_itv ->. elim n; [rewrite !mulr0n // reprK /GRing.zero /= /Quotient.zero /= -lock // | ]. move => n' IHn'; rewrite reprK !mulrS. rewrite reprK in IHn'. @@ -320,33 +328,33 @@ rewrite Quotient.pi_add reprK. by move : IHn' <-. Qed. -Let infty_norm_pi0 x : infty_norm (\pi_V x) = infty_norm0 x. +Let infty_norm_pi0 x : infty_norm (\pi_`C[a, b] x) = infty_norm0 x. Proof. rewrite /infty_norm /=. -have /eqmod_on_itv Heq : repr (\pi_V x) = x %[mod V] by rewrite reprK. +have /eqmod_on_itv Heq : repr (\pi_`C[a, b] x) = x %[mod `C[a, b]] by rewrite reprK. exact: infty_norm0_itv_eq. Qed. -Lemma infty_normrN (x : V) : infty_norm (- x) = infty_norm x. +Lemma infty_normrN (x : `C[a, b]) : infty_norm (- x) = infty_norm x. Proof. -rewrite -(reprK x) /GRing.opp /= -Quotient.pi_opp !infty_norm_pi0 /infty_norm /infty_norm0. -congr sup. -apply eq_set => /= x0. -apply propext; split => [[x1 in_itv] | [x1 in_itv]] H; exists x1 =>//. +rewrite -(reprK x) /GRing.opp /= -Quotient.pi_opp !infty_norm_pi0. +rewrite /infty_norm /infty_norm0; congr sup. +apply/eq_set => /= x0. +apply/propext; split => [[x1 in_itv] | [x1 in_itv]] H; exists x1 =>//. by rewrite -normrN. by rewrite normrN. Qed. (* TODO: dev the theory of sup following the theory of ess_sup *) -Fail Check V : normedZmodType R. +Fail Check `C[a, b] : normedZmodType R. -HB.instance Definition _ := @Num.Zmodule_isNormed.Build R V +HB.instance Definition _ := @Num.Zmodule_isNormed.Build R `C[a, b] infty_norm ler_infty_normD infty_normr0_eq0 infty_normrMn infty_normrN. -Lemma infty_norm_pi x : `|\pi_V x| = infty_norm0 x. +Lemma infty_norm_pi x : `|\pi_`C[a, b] x| = infty_norm0 x. Proof. by rewrite /Num.norm /= infty_norm_pi0. Qed. -Lemma infty_norm_lt (f : V) e : +Lemma infty_norm_lt (f : `C[a, b]) e : `| f | < e -> {in `[a, b]%R, forall x : R, `|f x| < e}. Proof. rewrite -{1}(reprK f) infty_norm_pi => h x xab. @@ -356,7 +364,7 @@ move: xab; rewrite in_itv/= => /andP[/le_trans /[apply]]. by rewrite leNgt ab. Qed. -Lemma infty_norm_le (f : V) e : +Lemma infty_norm_le (f : `C[a, b]) e : `| f | <= e -> {in `[a, b]%R, forall x : R, `|f x| <= e}. Proof. rewrite -{1}(reprK f) infty_norm_pi => h x xab. @@ -366,11 +374,10 @@ move: xab; rewrite in_itv/= => /andP[/le_trans /[apply]]. by rewrite leNgt ab. Qed. -Lemma infty_norm_le2 (f : V) e (e0 : 0 <= e) : +Lemma infty_norm_le2 (f : `C[a, b]) e : 0 <= e -> {in `[a, b]%R, forall x : R, `|f x| <= e} -> `| f | <= e. Proof. -move=> h. -have [ab|ba] := leP a b. +move=> e0 h; have [ab|ba] := leP a b. by rewrite -(reprK f) infty_norm_pi infty_norm0_le. rewrite [leLHS](_ : _ = 0)//. rewrite /Num.norm/= /infty_norm /infty_norm0. @@ -378,12 +385,12 @@ rewrite [X in [set _ | _ in X]](_ : _ = set0) ?image_set0 ?sup0//. by rewrite set_itv_ge// bnd_simp -ltNge. Qed. -Check V : normedZmodType R. +Check `C[a, b] : normedZmodType R. -Check (pseudoMetric_normed V) : pseudoMetricType R. -Check (pseudoMetric_normed V) : normedZmodType R. +Check (pseudoMetric_normed `C[a, b]) : pseudoMetricType R. +Check (pseudoMetric_normed `C[a, b]) : normedZmodType R. -Fail Check (pseudoMetric_normed V) : normedModType R. +Fail Check (pseudoMetric_normed `C[a, b]) : normedModType R. End zmodule_normed. @@ -392,25 +399,25 @@ Context {R : realType} {W : normedModType R} {r s : R}. Import ContSeg_quot. -Local Notation V := (@quot_contSeg R r s W). - -Fail Check (pseudoMetric_normed V) : normedModType R. -HB.instance Definition _ := PseudoMetric.copy V (pseudoMetric_normed V). -HB.instance Definition _ := isPointed.Build V 0. +Fail Check (pseudoMetric_normed `C[r, s]) : normedModType R. +HB.instance Definition _ := + PseudoMetric.copy `C([r, s] W) (pseudoMetric_normed `C([r, s] W)). +HB.instance Definition _ := isPointed.Build `C([r, s] W) 0. -Lemma is_normZmod_contFunBallType : NormedZmod_PseudoMetric_eq R V. +Lemma is_normZmod_contFunBallType : NormedZmod_PseudoMetric_eq R `C([r, s] W). Proof. by constructor. Qed. -Fail Check V : pseudoMetricNormedZmodType R. +Fail Check `C([r, s] W) : pseudoMetricNormedZmodType R. HB.instance Definition _ := is_normZmod_contFunBallType. -Check V : pseudoMetricNormedZmodType R. +Check `C([r, s] W) : pseudoMetricNormedZmodType R. Import Quotient. Open Scope quotient_scope. -Definition cont_scale (k : R) (v : V) : V := \pi_V (k *: repr v). +Definition cont_scale (k : R) (f : `C([r, s] W)) : `C[r, s] := + \pi_`C[r, s] (k *: repr f). -Let cont_scalerA a b v : cont_scale a (cont_scale b v) = cont_scale (a * b) v. +Let cont_scalerA a b f : cont_scale a (cont_scale b f) = cont_scale (a * b) f. Proof. rewrite /cont_scale. have [-> | a0] := eqVneq a 0; first by rewrite !(scale0r, mul0r). @@ -423,7 +430,7 @@ rewrite !fctE. apply/eqP; rewrite scaler_eq0. rewrite (negPf a0)/= subr_eq0. apply/eqP. -case: piP => f. +case: piP => g. rewrite mem_setE in xrs. by move/eqmod_on_itv => /(_ _ xrs) <-. Qed. @@ -432,7 +439,7 @@ Let cont_scale1r : left_id 1 cont_scale. Proof. move=> v. rewrite /cont_scale/=. -rewrite [RHS](_ : _ = (\pi_V (repr v))%qT); last by rewrite reprK. +rewrite [RHS](_ : _ = (\pi_`C[r, s] (repr v))%qT); last by rewrite reprK. apply/eqmodP. by rewrite scale1r. Qed. @@ -473,21 +480,21 @@ by apply/funext => x; rewrite /patch; case: ifP. Qed. HB.instance Definition _ := - @GRing.Zmodule_isLmodule.Build R V cont_scale cont_scalerA cont_scale1r + @GRing.Zmodule_isLmodule.Build R `C([r, s] W) cont_scale cont_scalerA cont_scale1r cont_scalerDr cont_scalerDl. -Local Lemma repr_mult l (x : V) a : a \in `[r, s]%R -> +Local Lemma repr_mult l (x : `C[r, s]) a : a \in `[r, s]%R -> repr (l *: x) a = l *: (repr x a). Proof. move=> ars. -have : repr (l *: x) = l *: repr x %[mod V]. +have : repr (l *: x) = l *: repr x %[mod `C[r, s]]. by case: piP. move/(@eqmod_on_itv _ _ _ _ (repr (l *: x)) (l *: repr x)). by move/(_ _ ars). Qed. Lemma is_pmnormedZmod_contFunBallType : - PseudoMetricNormedZmod_Lmodule_isNormedModule R V. + PseudoMetricNormedZmod_Lmodule_isNormedModule R `C([r, s] W). Proof. constructor => l x. rewrite /Num.norm/= /infty_norm /infty_norm0 /=. @@ -534,28 +541,26 @@ Variables a b : R. Import ContSeg_quot. -Notation V := (@quot_contSeg R a b W). +Check (`C([a, b] W) : pseudoMetricType R). +Check (`C([a, b] W) : normedModType R). -Check (V : pseudoMetricType R). -Check (V : normedModType R). - -Definition lim_fun (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : +Definition lim_fun (F : set_system `C[a, b]) (FF : ProperFilter F) (Fc : cauchy F) : subspace `[a, b] -> W := fun t => lim (@^~ t @ F). -Lemma lim_fun_is_fun (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : +Lemma lim_fun_is_fun (F : set_system `C[a, b]) (FF : ProperFilter F) (Fc : cauchy F) : @isFun (subspace `[a, b]) W `[a, b] [set: W] (@lim_fun F FF Fc). Proof. by constructor. Qed. HB.instance Definition _ F FF Fc := (@lim_fun_is_fun F FF Fc). -Lemma lim_fun_cvg_pt (F : set_system V) (FF: ProperFilter F) (Fc : cauchy F) : +Lemma lim_fun_cvg_pt (F : set_system `C[a, b]) (FF: ProperFilter F) (Fc : cauchy F) : forall e : R, e > 0 -> forall t, t \in `[a, b]%R -> - \forall f \near F, `|lim_fun FF Fc t - (f : V) t| <= e. + \forall f \near F, `|lim_fun FF Fc t - (f : `C[a, b]) t| <= e. Proof. have /(_ _ _) /cauchy_cvg /cvg_app_entourageP cvF : forall t : R, t \in `[a, b]%R -> - cauchy (fmap (fun h : V => h t) (fun A : set V => nbhs F (fun g => A g))). + cauchy (fmap (fun h : `C[a, b] => h t) (fun A : set `C[a, b] => nbhs F (fun g => A g))). move=> t tab A /=. rewrite -entourage_ballE => -[e /= e0 eA]. rewrite near_simpl -near2E near_map2. @@ -567,22 +572,19 @@ have /(_ _ _) /cauchy_cvg /cvg_app_entourageP cvF : rewrite -quot_contSeg_fctB//. exact: h. have cvg_pt (t : R) : t \in `[a, b]%R -> - x @[x --> fmap (fun h : V => h t) F] --> lim_fun FF Fc t. - move=> tab. - apply/cvg_entourageP. - exact: cvF. + x @[x --> fmap (fun h : `C[a, b] => h t) F] --> lim_fun FF Fc t. + by move=> tab; exact/cvg_entourageP/cvF. move=> e e0 t /cvg_pt /cvgrPdist_le. exact. Qed. -Lemma lim_fun_cvg_uniform (F : set_system V) (FF: ProperFilter F) (Fc : cauchy F) : +Lemma lim_fun_cvg_uniform (F : set_system `C[a, b]) (FF: ProperFilter F) (Fc : cauchy F) : forall e : R, e > 0 -> \forall f \near F, forall t, t \in `[a, b]%R -> - `|lim_fun FF Fc t - (f : V) t| <= e. + `|lim_fun FF Fc t - (f : `C[a, b]) t| <= e. Proof. move=> e e0. have e20 : 0 < e / 2 by rewrite divr_gt0. -have := Fc _ (entourage_ball V (PosNum e20)). -move => [/= [A B] /= [n1 n2]] H. +have [/= [A B] /= [n1 n2] H] := Fc _ (entourage_ball `C[a, b] (PosNum e20)). near=> f. move=> t tab. near F => g. @@ -598,11 +600,11 @@ rewrite -quot_contSeg_fctB//. by move/ltW/infty_norm_le; exact. Unshelve. all: by end_near. Qed. -Lemma lim_fun_cont (F : set_system V) (FF : ProperFilter F) (Fc : cauchy F) : +Lemma lim_fun_cont (F : set_system `C[a, b]) (FF : ProperFilter F) (Fc : cauchy F) : {within `[a, b], continuous (@lim_fun F FF Fc)}. Proof. have [ab|] := ltP a b; last first. - rewrite le_eqVlt => /predU1P[<-| ab']. + rewrite le_eqVlt => /predU1P[<-|ab']. by rewrite set_itv1; exact: continuous_subspace1. rewrite set_itv_ge// ?bnd_simp -?ltNge//. exact: continuous_subspace0. @@ -705,13 +707,14 @@ HB.instance Definition _ F FF Fc := Fail Check (V : completeType). -Lemma cvg_V_entourageP (F : set_system V) (FF : Filter F) (f : V) : +Lemma cvg_V_entourageP (F : set_system `C([a, b] W)) (FF : Filter F) (f : `C[a, b]) : F --> f <-> forall A, entourage A -> - \forall g \near F, {in `[a, b]%R, forall t : R, A (f t, (g : V) t)}. + \forall g \near F, {in `[a, b]%R, forall t : R, A (f t, (g : `C[a, b]) t)}. Proof. split => [/cvg_entourageP /= Ff A|/=Ff]. rewrite -entourage_ballE => -[eps eps0 /= H]. - apply: (Ff [set fg : V * V| {in `[a, b]%R, forall t : R, A (fg.1 t, fg.2 t)}]). + apply: (Ff [set fg : `C[a, b] * `C[a, b] | + {in `[a, b]%R, forall t : R, A (fg.1 t, fg.2 t)}]). exists eps => //. rewrite /pseudoMetric_from_normedZmodType.ball /=. move=> /= x bx t tab. @@ -734,13 +737,13 @@ near: g. exact: (Ff [set xy : W * W | ball xy.1 (PosNum e20)%:num xy.2] (entourage_ball _ _)). Unshelve. all: by end_near. Qed. -Lemma quot_cont_on_segType_cauchy_cvg (F : set_system V) : +Lemma quot_cont_on_segType_cauchy_cvg (F : set_system `C([a, b] W)) : ProperFilter F -> cauchy F -> cvg F. Proof. move=> FF Fc. have /(_ _ _)/cauchy_cvg/cvg_app_entourageP cvF : forall t, t \in `[a, b]%R -> - cauchy (fmap (fun h : V => h t) (fun A : set V => nbhs F (fun g => A g))). + cauchy (fmap (fun h : `C[a, b] => h t) (fun A : set `C[a, b] => nbhs F (fun g => A g))). move=> t tab A/=. rewrite -entourage_ballE => -[e e0 ee]; rewrite near_simpl -near2E near_map2. apply: Fc. @@ -749,7 +752,7 @@ have /(_ _ _)/cauchy_cvg/cvg_app_entourageP cvF : apply: ee => /=. rewrite -ball_normE /ball_/=. by rewrite -quot_contSeg_fctB// h. -apply/cvg_ex; exists (pi V (@lim_fun F FF Fc : continuousFunType `[a, b] [set: W])). +apply/cvg_ex; exists (pi `C[a, b] (@lim_fun F FF Fc : continuousFunType `[a, b] [set: W])). apply/cvg_V_entourageP => /=. move=> A /= entA. near=> f. @@ -770,131 +773,8 @@ rewrite distrC. by rewrite -quot_contSeg_fctB// h. Unshelve. all: by end_near. Qed. -HB.instance Definition _ := Uniform_isComplete.Build V +HB.instance Definition _ := Uniform_isComplete.Build `C[a, b] quot_cont_on_segType_cauchy_cvg. -Check (V : completeType). +Check (`C[a, b] : completeType). End completeness. - -(* Section vector_contseg. *) - -(* Context {R : realType}. *) -(* Variables (a b : R). *) -(* Hypothesis ab : a <= b. *) - -(* Notation V := (quot_contFunType (seg_nonempty ab) (@segment_compact R _ _)). *) - -(* Definition Vn n := {ffun 'I_n -> V}. *) -(* Check V : normedZmodType R. *) -(* Check (V : pseudoMetricType R). *) -(* Check (V : normedModType R). *) -(* Check (Vn 2 : normedZmodType R). *) -(* Check (Vn 2 : pseudoMetricType R). *) -(* Check (Vn 2 : completeType). *) -(* Fail Check (Vn 2 : normedModType R). *) -(* End vector_contseg. *) -(* (* not neeeded anymore *) *) - -(* Section lip_implies_cont. *) -(* Context {R : realType}. *) -(* Local Notation mu := lebesgue_measure. *) -(* Variables (f : R -> R -> R) (t0 t1 : R). *) -(* Hypothesis t01 : t0 < t1. *) -(* Variable k : R. *) -(* Hypothesis k1 : k > 0. *) -(* Variables (u0 : R) (r : {posnum R}). *) -(* Let B := closed_ball u0 r%:num. *) - -(* Hypothesis lip2 : {in `[t0, t1]%R, forall x, k.-lipschitz_B (f x)}. *) - -(* Lemma cont2 : {in `[t0, t1]%R, forall x, {within B, continuous f x}}. *) -(* Proof. *) -(* move=> x xt01. *) -(* rewrite [B]closed_ball_itv//. *) -(* apply/continuous_within_itvP; first by rewrite ltrD2l gtrN. *) -(* split. *) -(* - move=> y yt01. *) -(* move: (xt01); have := @lip2 x => /[apply] kfx. *) -(* rewrite /continuous_at. *) -(* apply/cvgrPdist_le => /= e e0. *) -(* near=> y'. *) -(* move: kfx => /(_ (y, y'))/=. *) -(* have By : B y. *) -(* rewrite /B closed_ball_itv//=. *) -(* exact: subset_itv_oo_cc yt01. *) -(* have By' : B y'. *) -(* rewrite /B closed_ball_itv//=. *) -(* rewrite in_itv/=; apply/andP; split. *) -(* near: y'. *) -(* exists (y - (u0 - r%:num)). *) -(* by move: yt01; rewrite in_itv/= -subr_gt0 => /andP[]. *) -(* move=> z/=. *) -(* rewrite ltr_distlC. *) -(* by rewrite opprB addrCA subrr addr0 => /andP[/ltW]. *) -(* near: y'. *) -(* exists ((u0 + r%:num) - y). *) -(* by move: yt01; rewrite in_itv/= -(subr_gt0 y) => /andP[]. *) -(* move=> z/=. *) -(* rewrite ltr_distlC => /andP[_]. *) -(* by rewrite addrCA subrr addr0 => /ltW. *) -(* move=> /(_ (conj By By')). *) -(* move=> /le_trans; apply. *) -(* rewrite -ler_pdivlMl// mulrC. *) -(* near: y'. *) -(* (* TODO(rei): investigate *) *) -(* exists (e / k). *) -(* by rewrite divr_gt0//. *) -(* by move=> z/= => /ltW. *) -(* - apply/cvgrPdist_le => /= e e0. *) -(* near=> y'. *) -(* move: (xt01); have := @lip2 x => /[apply]. *) -(* move=> /(_ (u0 - r%:num, y'))/=. *) -(* have Bu0r : B (u0 - r%:num). *) -(* rewrite /B closed_ball_itv//=. *) -(* by rewrite in_itv/= lexx/= lerD2l gerN. *) -(* have By' : B y'. *) -(* rewrite /B closed_ball_itv//=. *) -(* rewrite in_itv/=; apply/andP; split => //. *) -(* near: y'. *) -(* exists r%:num => //=. *) -(* move=> z/=. *) -(* rewrite ltr_distlC. *) -(* rewrite subrK => /andP[_ /ltW + _] => /le_trans; apply. *) -(* by rewrite lerDl. *) -(* move=> /(_ (conj Bu0r By')). *) -(* move=> /le_trans; apply. *) -(* rewrite -ler_pdivlMl// mulrC. *) -(* near: y'. *) -(* (* TODO(rei): investigate *) *) -(* exists (e / k) => /=. *) -(* by rewrite divr_gt0//. *) -(* by move=> z/= => /ltW. *) -(* - apply/cvgrPdist_le => /= e e0. *) -(* near=> y'. *) -(* move: (xt01); have := @lip2 x => /[apply]. *) -(* move=> /(_ (y', u0 + r%:num))/=. *) -(* have By' : B y'. *) -(* rewrite /B closed_ball_itv//=. *) -(* rewrite in_itv/=; apply/andP; split => //. *) -(* near: y'. *) -(* exists r%:num => //=. *) -(* move=> z/=. *) -(* rewrite ltr_distlC addrK => /andP[/ltW + _ _]. *) -(* rewrite lerBlDl => /le_trans; apply. *) -(* by rewrite lerDr. *) -(* have Bu0r : B (u0 + r%:num). *) -(* rewrite /B closed_ball_itv//=. *) -(* by rewrite in_itv/= lexx/= lerD2l andbT gerN. *) -(* move=> /(_ (conj By' Bu0r)). *) -(* rewrite distrC. *) -(* move=> /le_trans; apply. *) -(* rewrite -ler_pdivlMl// mulrC. *) -(* near: y'. *) -(* (* TODO(rei): investigate *) *) -(* exists (e / k) => /=. *) -(* by rewrite divr_gt0//. *) -(* move=> z/= => /ltW. *) -(* by rewrite distrC. *) -(* Unshelve. all: end_near. Qed. *) - -(* End lip_implies_cont. *) diff --git a/tilt_analysis.v b/tilt_analysis.v index ea153a30..f9a6838c 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -1,8 +1,9 @@ From HB Require Import structures. From mathcomp Require Import all_boot all_order all_algebra ring. From mathcomp Require Import interval_inference. -From mathcomp Require Import boolp classical_sets functions reals. +From mathcomp Require Import boolp classical_sets functions reals ereal. From mathcomp Require Import topology normedtype derive realfun landau. +From mathcomp Require Import measure lebesgue_integral. Require Import ssr_ext derive_matrix. (**md**************************************************************************) @@ -18,6 +19,141 @@ Import Order.TTheory GRing.Theory Num.Def Num.Theory. Import numFieldNormedType.Exports. Local Open Scope ring_scope. +Local Open Scope classical_set_scope. + +(* PR to MCA *) +Section Rintegral. +Context d {T : measurableType d} {R : realType}. +Variable mu : {measure set T -> \bar R}. +Implicit Types (D : set T). + +Lemma Rintegral_cst D : d.-measurable D -> + forall r, \int[mu]_(_ in D) r = r * fine (mu D). +Proof. +move=> mD r; rewrite /Rintegral/= integral_cst//. +have := leey (mu D); rewrite le_eqVlt => /predU1P[->/=|muy]; last first. + by rewrite fineM// ge0_fin_numE. +rewrite mulr0 mulr_infty/=; have [_|r0|r0] := sgrP r. +- by rewrite mul0e. +- by rewrite mul1e. +- by rewrite mulN1e. +Qed. + +End Rintegral. + +(* TODO: PR *) +Section vector_continuous. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. + +Lemma within_continuous_coord (h : R -> U) D : + {within D, continuous h} <-> forall i, {within D, continuous (fun x => h x ord0 i)}. +Proof. +split=> [Dh i|H]. +- apply/subspace_continuousP => /= x Dx. + have /subspace_continuousP/(_ x Dx) H := Dh. + apply: ((@cvg_comp _ _ _ h (fun z => z ord0 i)) _ _ _ H). + exact: coord_continuous. +- apply/subspace_continuousP => /= x Dx. + apply/cvgrPdist_le => /= e e0. + rewrite near_withinE. + near=> t => Dt. + rewrite /Num.norm/= mx_normrE. + apply/(bigmax_le _ (ltW e0)) => /= -[i j] _ /=. + rewrite {i}(ord1 i) !mxE. + move: j Dt. + near: t. + apply: filter_forall => /= i. + have /subspace_continuousP/(_ x Dx) := H i. + move/cvgrPdist_le => /(_ _ e0). + rewrite near_withinE. + exact. +Unshelve. all: by end_near. Qed. + +End vector_continuous. + +Lemma continuous_within_ext {A B : topologicalType} (g h : A -> B) D : + {in D, g =1 h} -> + {within D, continuous g } -> {within D, continuous h}. +Proof. +move=> h1 h2. +apply subspace_continuousP. +move => x Dx. +apply : cvg_trans. +apply (fmap_within_eq (g := g)) => //. +apply nbhs_filter. +move => x' Dx' . +symmetry. +by apply h1. +rewrite <-h1. +move /subspace_continuousP : h2. +by apply. +by rewrite inE. +Qed. + +(* PR to MCA *) +Section continuous_patch. +Context {R : realType} {n : nat} {U : normedModType R}. +Variables (a b c : R) (f : R -> U) (g : R -> U). +Hypothesis ab : a < b. +Hypothesis bc : b < c. +Hypothesis cont1 : {within `[a, b], continuous f}. +Hypothesis cont2 : {within `[b, c], continuous g}. +Hypothesis matchb : f b = g b. + +Lemma within_continuous_patch : {within `[a, c], continuous (patch g `[a, b] f)}. +Proof. +have -> : `[a, c] = `[a, b] `|` `[b, c]. + rewrite (@itv_bndbnd_setU _ _ _ (BRight b)) // ?bnd_simp//=; [|exact: ltW..]. + apply/seteqP; split => [x []|x []]. + by left. + by right; exact: subset_itv_oc_cc b0. + by left. + rewrite -setU1itv ?bnd_simp//; last exact: ltW. + case; last by right. + move=> ->; left => /=. + by rewrite bound_itvE ltW. +apply: (withinU_continuous (@itv_closed _ _ a b) (@itv_closed _ _ b c)). + have eq1 : {in `[a, b], f =1 patch g `[a, b] f }. + by move=> r rab; rewrite /patch rab. + apply: (continuous_within_ext eq1). + exact: cont1. +have eq2 : {in `[b, c], g =1 patch g `[a, b] f }. + move=> r rab. + rewrite /patch; case: ifPn => [xab | xabnot] => //. + suff -> : r = b by rewrite matchb. + apply: le_anti. + move: rab xab. + by rewrite !inE/=!in_itv/= => /andP [-> _] /andP [_ ->]. +apply/continuous_subspaceW/(continuous_within_ext eq2)/cont2. +by apply: subset_itvl; rewrite bnd_simp. +Qed. + +End continuous_patch. + +Lemma within_continuousB {K : realType} {V : normedModType K} + (A : set K) (f g : _ -> V) : + {within A, continuous f} -> {within A, continuous g} -> + {within A, continuous (f - g)}. +Proof. +by move=> cf cg x; apply: cvgB; [exact: cf|exact: cg]. +Qed. + +(* TODO: PR to MCA *) +Lemma nbhs_ge {R : realFieldType} (t x : R) : + t < x -> \forall x0 \near nbhs x, t <= x0. +Proof. +move=> tx. +exists ((x - t) / 2). + by rewrite /= divr_gt0// subr_gt0. +move=> y/=. +have [xy|yx] := lerP x y. + rewrite ltrBlDl => H. + by rewrite (le_trans (ltW tx)). +rewrite ltrBlDl -ltrBlDr => /ltW; apply: le_trans. +rewrite -lerBlDr opprK. +by rewrite -lerBrDl ler_piMr ?invf_le1 ?ler1n// subr_ge0 ltW. +Qed. Lemma norm_rowmx {K : rcfType} {m n1 n2 : nat} (A1 : 'M[K]_(m.+1, n1.+1)) (A2 : 'M[K]_(m.+1, n2.+1)) : @@ -76,6 +212,95 @@ rewrite iter_addr_0. by rewrite /Num.norm/= !mx_normrE. Qed. +(* NB: PR to PCA *) +Section pointwise_derivable. +Context {R : realFieldType} {V W : normedModType R} {m n : nat}. +Implicit Types M : V -> 'M[R]_(m, n). + +Definition derivable_mx M t v := + forall i j, derivable (fun x => M x i j) t v. + +Lemma derivable_mxP M t v : derivable_mx M t v <-> derivable M t v. +Proof. +split; rewrite /derivable_mx /derivable. +- move=> H. + apply/cvg_ex => /=. + pose l := \matrix_(i < m, j < n) sval (cid ((cvg_ex _).1 (H i j))). + exists l. + apply/cvgrPdist_le => /= e e0. + near=> x. + rewrite /Num.Def.normr/= mx_normrE. + apply: (bigmax_le _ (ltW e0)) => /= i _. + rewrite !mxE/=. + move: i. + near: x. + apply: filter_forall => /= i. + exact: ((@cvgrPdist_le _ _ _ _ (dnbhs_filter 0) _ _).1 + (svalP (cid ((cvg_ex _).1 (H i.1 i.2)))) _ e0). +- move=> /cvg_ex[/= l Hl] i j. + apply/cvg_ex; exists (l i j). + apply/cvgrPdist_le => /= e e0. + move/cvgrPdist_le : Hl => /(_ _ e0)[/= r r0] H. + near=> x. + apply: le_trans; last first. + apply: (H x). + rewrite /ball_/=. + rewrite sub0r normrN. + near: x. + exact: dnbhs0_lt. + near: x. + exact: nbhs_dnbhs_neq. + rewrite [leRHS]/Num.Def.normr/= mx_normrE. + apply: le_trans; last exact: le_bigmax. + by rewrite /= !mxE. +Unshelve. all: by end_near. Qed. + +End pointwise_derivable. + +(* NB: PR to MCA *) +Section pointwise_derive. +Local Open Scope classical_set_scope. +Context {R : realFieldType} {V W : normedModType R} . + +Lemma derive_mx {m n : nat} (M : V -> 'M[R]_(m, n)) t v : + derivable M t v -> + 'D_v M t = \matrix_(i < m, j < n) 'D_v (fun t => M t i j) t. +Proof. +move=> /cvg_ex[/= l Hl]; apply/cvg_lim => //=. +apply/cvgrPdist_le => /= e e0. +move/cvgrPdist_le : (Hl) => /(_ (e / 2)). +rewrite divr_gt0// => /(_ isT)[d /= d0 dle]. +near=> x. +rewrite [in leLHS]/Num.Def.normr/= mx_normrE. +apply/(bigmax_le _ (ltW e0)) => -[/= i j] _. +rewrite [in leLHS]mxE/= [X in _ + X]mxE -[X in X - _](subrK (l i j)). +rewrite -(addrA (_ - _)) (le_trans (ler_normD _ _))// (splitr e) lerD//. +- rewrite mxE. + suff : (h^-1 *: (M (h *: v + t) i j - M t i j)) @[h --> 0^'] --> l i j. + move/cvg_lim => /=; rewrite /derive /= => ->//. + by rewrite subrr normr0 divr_ge0// ltW. + apply/cvgrPdist_le => /= r r0. + move/cvgrPdist_le : Hl => /(_ r r0)[/= s s0] sr. + near=> y. + have : `|l - y^-1 *: (M (y *: v + t) - M t)| <= r. + rewrite sr//=; last by near: y; exact: nbhs_dnbhs_neq. + by rewrite sub0r normrN; near: y; exact: dnbhs0_lt. + apply: le_trans. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE. + by under eq_bigr do rewrite !mxE; exact: (le_bigmax _ _ (i, j)). +- rewrite mxE. + have : `|l - x^-1 *: (M (x *: v + t) - M t)| <= e / 2. + apply: dle => //=; last by near: x; exact: nbhs_dnbhs_neq. + by rewrite sub0r normrN; near: x; exact: dnbhs0_lt. + apply: le_trans. + rewrite [in leRHS]/Num.Def.normr/= mx_normrE/=. + under eq_bigr do rewrite !mxE. + apply: le_trans; last exact: le_bigmax. + by rewrite !mxE. +Unshelve. all: by end_near. Qed. + +End pointwise_derive. + Lemma differentiable_scalar_mx {R : numFieldType} n (r : R) : differentiable (@scalar_mx _ n) r. Proof. @@ -159,8 +384,6 @@ apply: le_trans; last first. by rewrite !mxE/=. Qed.*) -(* used in derive_along_derive*) -(*TODO*) Lemma derivable_scalar_mx {R : realFieldType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) v : derivable f a v -> @@ -247,7 +470,7 @@ Qed. Lemma within_continuous_minus {R : realType} {K : numDomainType} {U : pseudoMetricNormedZmodType K} (f : R -> U) (a b : R) : - {within `[- b, - a], continuous f} -> {within `[a,b], continuous f \o -%R}. + {within `[- b, - a], continuous f} -> {within `[a, b], continuous f \o -%R}. Proof. have [ab|ba _ |-> _] := ltgtP a b; last 2 first. by rewrite set_itv_ge ?bnd_simp -?ltNge//; exact: continuous_subspace0. @@ -361,6 +584,25 @@ have /(EVT_max_rV A0 cA) [c clr fcmax] : {within A, continuous (- f)}. by exists c => // ? /fcmax; rewrite lerN2. Qed. +Section closure_neitv. +Context {R : realType}. +Implicit Type a b : R. + +Lemma closure_neitv_oo a b : a < b -> + closure `]a, b[%classic = `[a, b]%classic. +Proof. +move=> ab. +set c := (a + b) / 2%:R. +set d := (b - a) / 2%:R. +rewrite (_ : a = c - d); last by rewrite /c/d !mulrDl addrKA mulNr opprK -splitr. +rewrite (_ : b = c + d); last by rewrite addrC /c/d !mulrDl mulNr subrKA -splitr. +rewrite -ball_itv -closed_ball_itv ?closure_ballE//. +apply: divr_gt0 => //. +by rewrite subr_gt0. +Qed. + +End closure_neitv. + (* TODO: move *) Lemma open_disjoint_separated (X : topologicalType) (A B : set X) : open A -> open B -> A `&` B = set0 -> separated A B. @@ -401,23 +643,23 @@ by rewrite inE. Qed. Lemma cst_oo_cc {R : realType} (f : R -> R) y (a b : R) : - y \in `[a, b] -> + y \in `[a, b]%R -> {within `[a, b], continuous f} -> - {in `]a, b[, f =1 cst (f y)} -> - {in `[a, b], f =1 cst (f y)}. + {in `]a, b[%R, f =1 cst (f y)} -> + {in `[a, b]%R, f =1 cst (f y)}. Proof. have [ab|ba] := ltP a b; last first. move=> yab _ H x. - rewrite inE/= in_itv/= => /andP[ax xb]. + rewrite in_itv/= => /andP[ax xb]. have /eqP ? : a == x by rewrite eq_le ax (le_trans xb _). subst x. - move: yab; rewrite inE/= in_itv/= => /andP[ay yb]. + move: yab; rewrite in_itv/= => /andP[ay yb]. have /eqP ? : a == y by rewrite eq_le ay (le_trans yb _). by subst. move=> yab cf H x. -rewrite inE/= in_itv/= => /andP[]. +rewrite in_itv/= => /andP[]. rewrite le_eqVlt => /predU1P[<-{x} _|]. - move: yab; rewrite inE/= in_itv/= => /andP[]. + move: yab; rewrite in_itv/= => /andP[]. rewrite le_eqVlt => /predU1P[->//|ay yb]. move/continuous_within_itvP : cf => /(_ ab)[_ fafa _]. move/cvgrPdist_le in fafa. @@ -431,22 +673,21 @@ rewrite le_eqVlt => /predU1P[<-{x} _|]. near a^'+ => a0. rewrite (_ : f y = f a0)//; last first. apply/esym/H. - rewrite inE/= in_itv/=. - by apply/andP; split => //. + rewrite in_itv/=. + by apply/andP. apply: H' => //=. rewrite ltr0_norm ?subr_lt0// opprB. rewrite ltrBlDl. - near: a0. - apply: nbhs_right_lt. + near: a0; apply: nbhs_right_lt. by rewrite ltrDl. move=> ax. rewrite le_eqVlt => /predU1P[->|]; last first. move=> xb. apply: H => //. - by rewrite inE/= in_itv/= ax. + by rewrite in_itv/= ax. clear x ax. move: yab. -rewrite inE/= in_itv/= => /andP[ay]. +rewrite in_itv/= => /andP[ay]. rewrite le_eqVlt => /predU1P[<-//|yb]. move/continuous_within_itvP : cf => /(_ ab)[_ _ fbfb]. move/cvgrPdist_le in fbfb. @@ -460,77 +701,72 @@ have := fbfb _ e0 => -[d /= d0] H'. near b^'- => b0. rewrite (_ : f y = f b0)//; last first. apply/esym/H. - rewrite inE/= in_itv/=. - by apply/andP; split => //. + rewrite in_itv/=. + by apply/andP; split. apply: H' => //=. rewrite distrC. rewrite ltr0_norm ?subr_lt0// opprB. rewrite ltrBlDr. rewrite -ltrBlDl. -near: b0. -apply: nbhs_left_gt. +near: b0; apply: nbhs_left_gt. by rewrite ltrBlDl ltrDr. Unshelve. all: by end_near. Qed. -Lemma is_derive_0_is_cst_new {R : realType} (f : R -> R) y (a b : R) : - y \in `]a, b[ -> +Lemma oo_is_derive_0_is_cst {R : realType} (f : R -> R) y (a b : R) : + y \in `]a, b[%R -> {within `[a, b], continuous f} -> - (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. + (forall x, x \in `]a, b[%R -> is_derive x (1 : R) f 0) -> + {in `[a, b]%R, f =1 cst (f y)}. Proof. move=> yab cf Hd. apply: cst_oo_cc => //. - move: yab. - rewrite !inE/=. - by apply: subset_itv_oo_cc. + exact: subset_itv_oo_cc yab. move=> x xab. wlog xLy : x y xab yab/ x <= y. move=> H; case: (leP x y) => [/H |/ltW xy]. exact. by apply/esym/H => //. rewrite -(subKr (f y) (f x)). -have [| |] := @MVT_segment R f 0 _ _ xLy. -- move=> z zxy. +have : forall x0, x0 \in `]x, y[%R -> is_derive x0 1 f (0 x0). + move=> z zxy. apply: Hd. move: zxy. - rewrite inE/=. apply: subset_itvSoo; rewrite bnd_simp. - by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. - by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. -- apply: continuous_subspaceW(* NB: should be , do a PRS*) cf. + by rewrite ltW// (itvP xab). + by rewrite ltW// (itvP yab). +move/MVT_segment => /(_ xLy)[]. + apply: continuous_subspaceW(* NB: should be , do a PRS*) cf. apply: subset_itvScc; rewrite bnd_simp. - by move: xab; rewrite inE/= in_itv/= => /andP[/ltW]. - by move: yab; rewrite inE/= in_itv/= => /andP[_ /ltW]. + by rewrite ltW// (itvP xab). + by rewrite ltW// (itvP yab). move=> r rxy. rewrite mul0r => ->. by rewrite subr0. Qed. -Lemma is_derive_0_is_cst_new' {R : realType} (f : R -> R) y (a b : R) : - y \in `[a, b] -> +Lemma cc_is_derive_0_is_cst {R : realType} (f : R -> R) y (a b : R) : + y \in `[a, b]%R -> {within `[a, b], continuous f} -> - (forall x, x \in `]a, b[ -> is_derive x (1 : R) f 0) -> {in `[a, b], f =1 cst (f y)}. + (forall x, x \in `]a, b[%R -> is_derive x (1 : R) f 0) -> + {in `[a, b]%R, f =1 cst (f y)}. Proof. move => yab cont d x xab /=. -have : (a <= b). +have : a <= b. move: xab. - rewrite inE/=in_itv/= => /andP[]. - by apply le_trans. + rewrite in_itv/= => /andP[]. + exact: le_trans. rewrite le_eqVlt => /predU1P[ab|ab]. suff [-> ->] : b = x /\ b = y by []. -split;apply /eqP;rewrite eq_le. -by move : xab;rewrite !ab !inE/=!in_itv/=. -by move : yab;rewrite !ab !inE/=!in_itv/=. -suff [-> ->] : f x = f ((a + b) / 2) /\ f y = f ((a+b )/2) by []. -have ab2: (a+b)/2 \in `]a,b[. - rewrite inE/=in_itv/=. - apply/andP;split. - by rewrite ltr_pdivlMr // mulrDr mulr1 ler_ltD //. - rewrite ltr_pdivrMr // mulrDr mulr1 ltr_leD //. -by split;apply /is_derive_0_is_cst_new. +split; apply/eqP; rewrite eq_le. +by rewrite (itvP xab) -ab (itvP xab). +by rewrite (itvP yab) -ab (itvP yab). +suff [-> ->] : f x = f ((a + b) / 2) /\ f y = f ((a + b)/2) by []. +have ab2 : (a + b)/2 \in `]a, b[%R by rewrite in_itv/= !midf_lt. +by split; exact/oo_is_derive_0_is_cst. Qed. -Lemma closed_ball_bounded {K : realType} {n} (x y : 'rV[K]_n) r : 0 < r -> closed_ball x r y -> - `|y| <= `|x| + r. +Lemma closed_ball_bounded {K : realType} {n} (x y : 'rV[K]_n) r : + 0 < r -> closed_ball x r y -> `|y| <= `|x| + r. Proof. move=> r0. rewrite closed_ballE// /closed_ball_/= => dxy. @@ -623,3 +859,4 @@ exact/diff_derivable. Qed. End gradient. + diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index fd8f0717..4cbe36f3 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -22,7 +22,7 @@ Require Import ode tilt_stability. (* a differential equation that captures the error *) (* dynamics. *) (* Tilt.point{1.2} == equilibrium points *) -(* Tilt.Upsilon1 == state-space *) +(* Tilt.Upsilon1 == state space *) (* Tilt.eqn == equation (14) in [benallegue2023itac] *) (* u2 == 2 x 2 matrix to prove the Lyapunov function *) (* V1 == Lyapunov function *) @@ -47,17 +47,17 @@ Definition S2 {K : realType} := [set x : 'rV[K]_3 | `|x|_e = 1]. Module PhysicalModel. Section physicalmodel. -Variable K : realType. -Variable g0 : K. (* standard gravitational constant *) +Variable R : realType. +Variable g0 : R. (* standard gravitational constant *) Hypotheses g0_neq0 : g0 != 0. -Variable R : K -> 'M[K]_3. (* orientation of frame L w.r.t. frame W *) -Hypothesis RisSO : forall t, R t \is 'SO[K]_3. +Variable M : R -> 'M[R]_3. (* orientation of frame L w.r.t. frame W *) +Hypothesis MisSO : forall t, M t \is 'SO[R]_3. -Let w t := ang_vel R t. (* angular velocity *) +Let w t := ang_vel M t. (* angular velocity *) (* tilt, eqn (8) *) -Definition x2 t : 'rV[K]_3 := 'e_2 *m R t. +Definition x2 t : 'rV[R]_3 := 'e_2 *m M t. Lemma x2_S2 t : x2 t \in S2. Proof. by rewrite /S2 /x2 inE/= orth_preserves_norm ?enormeE ?rotation_sub. Qed. @@ -67,12 +67,12 @@ Definition y_a x t := - x t *m \S(w t) + 'D_1 x t + g0 *: x2 t. (* proof that y_a is indeed the sum of linear and gravitational acceleration *) Section y_aE. -Variable p : K -> 'rV[K]_3. -Let v := fun t : K => 'D_1 p t *m R t. +Variable p : R -> 'rV[R]_3. +Let v := fun t : R => 'D_1 p t *m M t. -Lemma y_aE t : (forall t, derivable R t 1) -> +Lemma y_aE t : (forall t, derivable M t 1) -> (forall t, derivable p t 1) -> (forall t, derivable ('D_1 p) t 1) -> - ('D_1 ('D_1 p) t + g0 *: 'e_2) *m R t = y_a v t. + ('D_1 ('D_1 p) t + g0 *: 'e_2) *m M t = y_a v t. Proof. move=> derivableR derivablep derivableDp. rewrite mulmxDl. @@ -94,17 +94,17 @@ Qed. End y_aE. -Hypothesis derivableR : forall t, derivable R t 1. -Variable v : K -> 'rV[K]_3. (* linear velocity *) +Hypothesis derivableR : forall t, derivable M t 1. +Variable v : R -> 'rV[R]_3. (* linear velocity *) Let x1 t := v t. (* section III.A of [benallegue2023itac] *) Section state_dynamics. (* NB: not used *) -Lemma derive_ang_vel t (u : K -> 'rV[K]_3) (T : K -> 'M[K]_3) : +Lemma derive_ang_vel t (u : R -> 'rV[R]_3) (T : R -> 'M[R]_3) : (forall t, derivable u t 1) -> (forall t, derivable T t 1) -> - (forall t, t \is 'SO[K]_3) -> + (forall t, t \is 'SO[R]_3) -> 'D_1 (fun t => u t *m T t) t = u t *m T t *m \S(ang_vel T t) + 'D_1 u t *m T t. Proof. move=> deru dert TisSO. @@ -133,7 +133,7 @@ Qed. Lemma derive_x2 t : 'D_1 x2 t = x2 t *m \S( w t ). Proof. rewrite /w -ang_vel_mxE//; last by move=> ?; rewrite rotation_sub. -have -> : 'D_1 (fun t0 => 'e_2 *m (R t0)) t = 'e_2 *m 'D_1 R t. +have -> : 'D_1 (fun t0 => 'e_2 *m (M t0)) t = 'e_2 *m 'D_1 M t. move=> n /=. rewrite derive_mulmx//=. by rewrite derive_cst mul0mx add0r. @@ -148,12 +148,12 @@ Hypothesis v_derivable : forall t, derivable v t 1. (* section III.A in [benallegue2023itac] *) Section two_steps_first_order_estimator. Local Notation y_a := (y_a v). -Variables gamma alpha1 : K. +Variables gamma alpha1 : R. -Variable x1_hat : K -> 'rV[K]_3. (* estimator *) +Variable x1_hat : R -> 'rV[R]_3. (* estimator *) Hypothesis derivable_x1_hat : forall t, derivable x1_hat t 1. -Variable x2_hat : K -> 'rV[K]_3. (* estimator *) +Variable x2_hat : R -> 'rV[R]_3. (* estimator *) Hypothesis x2_hat_S2 : x2_hat 0 \in S2. Hypothesis x2_hat_derivable : forall t, derivable x2_hat t 1. Hypothesis norm_x2_hat : forall t, `|x2_hat t|_e = 1. @@ -171,10 +171,10 @@ Hypothesis eqn12c : forall t, Let error1 t := x2 t - x2'_hat t. (* p_1 in [benallegue2023ieeetac] *) Let error2 t := x2 t - x2_hat t. (* \tilde{x_2} in [benallegue2023ieeetac] *) (* projection from the local frame to the world frame(?) *) -Let error1_p t := error1 t *m (R t)^T (* z_p_1 in [benallegue2023ieeetac] *). -Let error2_p t := error2 t *m (R t)^T. +Let error1_p t := error1 t *m (M t)^T (* z_p_1 in [benallegue2023ieeetac] *). +Let error2_p t := error2 t *m (M t)^T. -Let error2E t : error2 t = error2_p t *m R t. +Let error2E t : error2 t = error2_p t *m M t. Proof. by rewrite /error2 -mulmxA orthogonal_tr_mul ?rotation_sub// mulmx1. Qed. @@ -269,10 +269,10 @@ rewrite [X in _ = X + _](_ : _ = 0) ?add0r; last first. by rewrite mulmxN mulmx1 subrr. rewrite expr2 -mulmxE fact215 -mulmxE -spin_crossmul. rewrite [in RHS]mulmxA [in RHS]spinE spinE spinE. -by rewrite [LHS](@lieC _ (vec3 K)). +by rewrite [LHS](@lieC _ (vec3 R)). Qed. -Lemma x2_hatR t : x2_hat t *m (R t)^T = 'e_2 - error2_p t. +Lemma x2_hatR t : x2_hat t *m (M t)^T = 'e_2 - error2_p t. Proof. rewrite /error2_p /error2 mulmxBl opprB addrCA. rewrite [X in _ + X](_ : _ = 0) ?addr0//. @@ -338,36 +338,36 @@ End PhysicalModel. Module Tilt. Section tilt. -Context {K : realType}. -Variables alpha1 gamma : K. +Context {R : realType}. +Variables alpha1 gamma : R. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -Definition eqn_functional (f : K -> 'rV[K]_6) : K -> 'rV[K]_6 := +Definition eqn_functional (f : R -> 'rV[R]_6) : R -> 'rV[R]_6 := let error1_p_dot := Left \o f in let error2_p_dot := Right \o f in fun t => row_mx (- alpha1 *: error1_p_dot t) (PhysicalModel.eqn14b_rhs gamma (error1_p_dot t) (error2_p_dot t)). -Definition eqn (dot_zp1_z2 : 'rV[K]_6) : 'rV[K]_6 := +Definition eqn (dot_zp1_z2 : 'rV[R]_6) : 'rV[R]_6 := let dot_zp1 := Left dot_zp1_z2 in let dot_z2 := Right dot_zp1_z2 in row_mx (- alpha1 *: dot_zp1) (PhysicalModel.eqn14b_rhs gamma dot_zp1 dot_z2). -Lemma eqnE (f : K -> 'rV[K]_6) t : eqn (f t) = eqn_functional f t. +Lemma eqnE (f : R -> 'rV[R]_6) t : eqn (f t) = eqn_functional f t. Proof. by []. Qed. -Definition Upsilon1 := [set x : 'rV[K]_6 | `| 'e_2 - Right x |_e = 1]. +Definition Upsilon1 := [set x : 'rV[R]_6 | `| 'e_2 - Right x |_e = 1]. Lemma Upsilon1_preimage : - Upsilon1 = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : K)]. + Upsilon1 = (fun x => `| 'e_2 - Right x |_e ) @^-1` [set (1 : R)]. Proof. by []. Qed. -Definition point1 : 'rV[K]_6 := 0. -Definition point2 : 'rV[K]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). +Definition point1 : 'rV[R]_6 := 0. +Definition point2 : 'rV[R]_6 := @row_mx _ _ 3 _ 0 (2 *: 'e_2). Lemma point1_neq2 : point1 != point2. Proof. @@ -378,7 +378,7 @@ Qed. Definition points := [set point1; point2]. -Definition V1 (zp1_z2 : 'rV[K]_6) : K := +Definition V1 (zp1_z2 : 'rV[R]_6) : R := let zp1 := Left zp1_z2 in let z2 := Right zp1_z2 in `|zp1|_e ^+ 2 / (2 * alpha1) + `|z2|_e ^+ 2 / (2 * gamma). @@ -388,8 +388,8 @@ End Tilt. (* properties of Tilt.eqn *) Section tilt_eqn. -Context {K : realType}. -Variables alpha1 gamma : K. +Context {R : realType}. +Variables alpha1 gamma : R. Hypothesis gamma_gt0 : 0 < gamma. Hypothesis alpha1_gt0 : 0 < alpha1. Let phi := Tilt.eqn alpha1 gamma. @@ -401,7 +401,7 @@ Lemma tilt_eqn_locally_lipschitz : locally_lipschitz phi. Proof. move=> /= x. exists (PosNum ltr01). -near (pinfty_nbhs K) => k. +near (pinfty_nbhs R) => k. have k0 : 0 < k by []. exists (PosNum k0) => /= => -[/= x0 x1] [x0B x1B]. rewrite (opp_row_mx (n1:=3)) (add_row_mx (n1:=3)). @@ -475,29 +475,27 @@ rewrite ge_max; apply/andP; split. by rewrite -linearB; exact: rsubmx_norm_le. by rewrite distrC -linearB/=; exact: lsubmx_norm_le. rewrite (le_trans (ler_pM _ _ dbound (lexx _ )))//. - rewrite ler_pdivlMl; last first. - by rewrite mulr_gt0// gtr0_norm. + rewrite ler_pdivlMl; last by rewrite mulr_gt0// gtr0_norm. by rewrite !mulrA ler_pM. Unshelve. all: by end_near. Qed. Lemma tilt_state_spaceS : state_space phi Tilt.Upsilon1 `<=` Tilt.Upsilon1. Proof. -move => p [y [Delta [y0_init1 deri]]]. -have [Delta0|Delta0] := leP 0 Delta; last first. - move=> -[t [+ x]]. - rewrite in_itv/= => -/andP[x0 xDelta]. - have := lt_trans xDelta Delta0. +move => p [y [D [y0_init1 deri]]]. +have [D0|D0] := leP 0 D; last first. + move=> -[t + x]. + rewrite in_itv/= => -/andP[x0 xD]. + have := lt_trans xD D0. by rewrite ltNge x0. rewrite /Tilt.Upsilon1. -have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))))^`() =1 0}. +have : {in `]0, D[%R, + (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))))^`() =1 0}. move => x xd /=. transitivity ((fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))) x). rewrite !derive1E. have ? : derivable y x 1. apply deri. - rewrite inE/= in xd. - apply: subset_itvr xd. - by rewrite bnd_simp. + by apply: subset_itvr xd; rewrite bnd_simp. rewrite derive_mx//. rewrite /dotmul. under eq_fun do rewrite dotmulP /=. @@ -506,24 +504,22 @@ have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))) under eq_fun do rewrite !mxE /= mulr1n. rewrite !derive_dotmul/=; last 2 first. apply: derivableB => //=; apply : derivable_rsubmx => //=. - by apply: derivableB => //=; apply: derivable_rsubmx => //=. + by apply: derivableB => //=; apply: derivable_rsubmx. rewrite /dotmul /=. rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. rewrite !mxE /= !mulr1n. - have -> : 'D_1 (fun x2 : K => 'e_2 - Right (y x2)) x = - Right ('D_1 y x). + have -> : 'D_1 (fun x0 => 'e_2 - Right (y x0)) x = - Right ('D_1 y x). rewrite deriveB /= ; last 2 first. exact: derivable_cst. by apply: derivable_rsubmx. rewrite derive_cst /= sub0r; congr (- _). - by apply: derive_rsubmx. - rewrite -(_ : 'D_1 y x = - (\matrix_(i, j) 'D_1 (fun t0 : K => y t0 i j) x)); last first. - apply/matrixP => a b; rewrite !mxE. - by rewrite derive_mx//= ?mxE//. + exact: derive_rsubmx. + rewrite -(_ : 'D_1 y x = \matrix_(i, j) 'D_1 (fun t0 => y t0 i j) x); last first. + by apply/matrixP => a b; rewrite !mxE derive_mx//= ?mxE. ring. - have Rsu t0 : t0 \in `[0, Delta[ -> Right (y^`()%classic t0) = - (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). + have Rsu t0 : t0 \in `[0, D[%R -> Right (y^`()%classic t0) = + (gamma *: (Right (y t0) - Left (y t0)) *m \S('e_2 - Right (y t0)) ^+ 2). rewrite inE/=. by move/deri => [_ ->]; rewrite row_mxKr. rewrite /dotmul. @@ -531,88 +527,72 @@ have : {in `]0, Delta[, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))) Left (y x)) *m \S('e_2 - Right (y x)) ^+ 2 *m ('e_2 - Right (y x))^T) 0 0). rewrite Rsu//. - move: xd. - rewrite !inE/=. - by apply: subset_itvr; rewrite bnd_simp. + by apply: subset_itvr xd; rewrite bnd_simp. rewrite !mulmxA. apply/eqP. rewrite mulf_eq0 /= oppr_eq0 ?pnatr_eq0 /= -!mulmxA spin_mul_tr. by rewrite !mulmx0 mxE. -move => h [t [t0d ->]]. -have norm_constant t0 : t0 \in `[0, Delta[ -> +move => h [t t0d ->]. +have norm_constant t0 : t0 \in `[0, D[%R -> `|'e_2 - Right (y t0)|_e ^+ 2 = `|'e_2 - Right (y 0)|_e ^+ 2. - have : forall x0, x0 \in `]0,Delta[ -> - is_derive x0 (1:K) (fun x : K => `|'e_2 - Right (y x)|_e ^+ 2) 0. + have : forall x0, x0 \in `]0, D[%R -> + is_derive x0 (1 : R) (fun x => `|'e_2 - Right (y x)|_e ^+ 2) 0. move => x0 x0d. have ? : derivable y x0 1. apply deri. - rewrite inE/= in x0d. - apply: subset_itvr x0d. - by rewrite bnd_simp. + by apply: subset_itvr x0d; rewrite bnd_simp. apply: DeriveDef. apply/derivable_enorm_squared => //=. apply/derivableB => //=. - by apply/derivable_rsubmx => //. + exact/derivable_rsubmx. rewrite -derive1E. have := h _ x0d. under eq_fun do rewrite dotmulvv /=. by apply. - rewrite /=. - move => hd0 t0d'. + move=> /= hd0 t0d'. apply/esym. - have {}t0d'' : t0 \in `[0, t0]. - rewrite inE/= in_itv/= lexx andbT. - move: t0d'. - by rewrite inE/= => /andP[]. - have {}hd0 : forall x0 : K, - x0 \in `]0, t0[ -> is_derive x0 1 (fun x : K => `| 'e_2 - Right (y x) |_e ^+ 2) 0. - move=> x0 x00t0. + have {}t0d'' : t0 \in `[0, t0]%R by rewrite bound_itvE/= (itvP t0d'). + have {}hd0 x0 : + x0 \in `]0, t0[%R -> is_derive x0 1 (fun x => `| 'e_2 - Right (y x) |_e ^+ 2) 0. + move=> x00t0. apply: hd0. - move: x00t0; rewrite !inE/=. - apply: subset_itvl; rewrite bnd_simp. - by move: t0d'; rewrite inE/= in_itv/= => /andP[_ /ltW]. - have := is_derive_0_is_cst_new' t0d'' _ hd0. - clear t0d'' hd0. - apply => //; last first. - rewrite inE/= in_itv/= lexx/=. - by move: t0d'; rewrite inE/= in_itv/= => /andP[]. + apply: subset_itvl x00t0; rewrite bnd_simp. + by rewrite ltW// (itvP t0d'). + have {t0d'' hd0} := cc_is_derive_0_is_cst t0d'' _ hd0. + apply => //; last by rewrite bound_itvE (itvP t0d'). apply: (@within_continuous_comp _ _ _ _ _ (fun x => `|'e_2 - Right x|_e ^+ 2) y) => //=. - by move: t0d'; rewrite inE/= in_itv/= => /andP[]. + by rewrite (itvP t0d'). move=> z _. apply: differentiable_continuous => //. apply: differentiable_enorm_squared => /=. exact: differentiableB. - move: t0d; rewrite in_itv/= => /andP[t_ge0 tDelta]. rewrite /sol_is_deriv_co/= in deri. - have cont : {in `[0, t0], continuous y}. + have cont : {in `[0, t0]%R, continuous y}. move=> t' t'0D. - rewrite inE/= in t'0D. apply/differentiable_continuous/derivable1_diffP. apply deri. - apply: subset_itvl t'0D. - rewrite bnd_simp. - by move: t0d'; rewrite inE/= in_itv/= => /andP[]. + apply: subset_itvl t'0D; rewrite bnd_simp. + by rewrite (itvP t0d'). + move/in_switch in cont. move/continuous_in_subspaceT : cont. apply: continuous_subspaceW. by apply: subset_itvl; rewrite bnd_simp. suff: `|'e_2 - Right (y t)|_e ^+ 2 = 1. move=> /(congr1 Num.sqrt). by rewrite sqrtr1 sqr_sqrtr// dotmulvv sqr_ge0. -rewrite norm_constant//; last first. - by rewrite inE. +rewrite norm_constant//. move: y0_init1. rewrite inE /Tilt.Upsilon1 /= => ->. by rewrite expr2 mulr1. Qed. -Lemma tilt_point1_in_state_space : @Tilt.point1 K \in Tilt.Upsilon1. +Lemma tilt_point1_in_state_space : @Tilt.point1 R \in Tilt.Upsilon1. Proof. rewrite inE /Tilt.Upsilon1 /Tilt.point1/=. by rewrite rsubmx_const /= subr0 enormeE. Qed. -Lemma equilibrium_tilt_point1 : - is_equilibrium_point phi Tilt.Upsilon1 Tilt.point1. +Lemma equilibrium_point1 : is_equilibrium_point phi Tilt.Upsilon1 Tilt.point1. Proof. split. - exact: tilt_point1_in_state_space. @@ -630,7 +610,7 @@ split. by move => n; rewrite n scaler0 mul0mx. Qed. -Lemma tilt_point2_in_state_space : @Tilt.point2 K \in Tilt.Upsilon1. +Lemma tilt_point2_in_state_space : @Tilt.point2 R \in Tilt.Upsilon1. Proof. rewrite inE /Tilt.Upsilon1 /Tilt.point2 /=. rewrite row_mxKr. @@ -640,8 +620,7 @@ rewrite [X in _ - X](_:1 = 1%:R) //. by rewrite -natrB //= normr1. Qed. -Lemma equilibrium_tilt_point2 : - is_equilibrium_point phi Tilt.Upsilon1 Tilt.point2. +Lemma equilibrium_point2 : is_equilibrium_point phi Tilt.Upsilon1 Tilt.point2. Proof. split; first exact: tilt_point2_in_state_space. move=> Delta. @@ -680,9 +659,9 @@ Qed. End tilt_eqn. Section u2. -Context {K : realType}. +Context {R : realType}. -Definition u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) [eta (fun=> 0) with +Definition u2 : 'M[R]_(2, 2) := \matrix_(i < 2, j < 2) [eta (fun=> 0) with (0,0) |-> 1, (0,1) |-> -2^-1, (1,0) |-> -2^-1, @@ -691,7 +670,7 @@ Definition u2 : 'M[K]_(2,2) := \matrix_(i < 2, j < 2) [eta (fun=> 0) with Lemma u2neq0 : u2 != 0. Proof. by apply/matrix0Pn; exists 1, 1; rewrite mxE /= oner_neq0. Qed. -Lemma u2_sym : u2 \is sym 2 K. +Lemma u2_sym : u2 \is sym 2 R. Proof. rewrite /= symE. apply/eqP/matrixP. @@ -725,7 +704,7 @@ have : root (char_poly u2) a. exact : a_eigen. rewrite char_poly2 tr_u2 det_u2 rootE => a_root . have char_poly_fact : 'X^2 - 2%:P * 'X + (3/4)%:P = - ('X - (1%:R / 2)%:P) * ('X - (3%:R / 2)%:P) :> {poly K}. + ('X - (1%:R / 2)%:P) * ('X - (3%:R / 2)%:P) :> {poly R}. rewrite mulrBr mulrBl -expr2 -!addrA; congr +%R. rewrite mulrBl opprB addrCA addrC; congr +%R. by rewrite -[RHS]polyCM; congr (_%:P); field. @@ -773,8 +752,8 @@ End u2. Section V1. Local Open Scope classical_set_scope. -Context {K : realType}. -Variables alpha1 gamma : K. +Context {R : realType}. +Variables alpha1 gamma : R. Hypothesis alpha1_gt0 : 0 < alpha1. Hypothesis gamma_gt0 : 0 < gamma. @@ -816,7 +795,7 @@ rewrite /V1 /Tilt.point1; split; first by rewrite inE. by rewrite divr_ge0 ?exprn_ge0 ?enorm_ge0 ?mulr_ge0// ltW. Unshelve. all: by end_near. Qed. -Definition V1dot (zp1_z2 : 'rV[K]_6) : K := +Definition V1dot (zp1_z2 : 'rV[R]_6) : R := let zp1 := Left zp1_z2 in let z2 := Right zp1_z2 in - `|zp1|_e ^+ 2 + (z2 *m (\S('e_2 - z2))^+2 *m z2^T @@ -860,16 +839,16 @@ End hurwitz. Section tilt_eqn_Lyapunov. Local Open Scope classical_set_scope. -Context {K : realType}. -Variables alpha1 gamma : K. +Context {R : realType}. +Variables alpha1 gamma : R. Hypotheses (alpha1_gt0 : 0 < alpha1) (gamma_gt0 : 0 < gamma). Let phi := Tilt.eqn alpha1 gamma. -Variable D : K. +Variable D : R. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -Lemma derive_zp1 (t : K) (sol : K -> 'rV_6) : +Lemma derive_zp1 t (sol : R -> 'rV_6) : sol_is_deriv_co (fun=> phi) 0 D sol -> t \in `[0, D[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). Proof. @@ -880,7 +859,7 @@ rewrite derive1E row_mxKl => <-. by rewrite derive_lsubmx. Qed. -Lemma derive_z2 (z : K) (sol : K -> 'rV_6) : +Lemma derive_z2 z (sol : R -> 'rV_6) : sol_is_deriv_co (fun=> phi) 0 D sol -> z \in `[0, D[ -> 'D_1 (Right \o sol) z = gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. @@ -891,7 +870,7 @@ move => /(congr1 Right). by rewrite derive1E row_mxKr => ?; rewrite derive_rsubmx. Qed. -Lemma is_sol_state_space_tilt (sol : K -> 'rV_6) t : +Lemma is_sol_state_space_tilt (sol : R -> 'rV_6) t : t \in `[0, D[%R -> sol 0 \in Tilt.Upsilon1 -> sol_is_deriv_co (fun=> phi) 0 D sol -> @@ -907,7 +886,7 @@ exists t => //. by rewrite in_itv/= (ltW t0) tD. Qed. -Lemma norm_e2z2 (sol : K -> 'rV_6) (z : K) +Lemma norm_e2z2 (sol : R -> 'rV_6) (z : R) (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : z \in `[0, D[%R -> sol 0 \in Tilt.Upsilon1 -> @@ -920,7 +899,7 @@ rewrite /zp1 /z2 hsubmxK /=. exact: is_sol_state_space_tilt. Qed. -Lemma angvel_sqr (sol : K -> 'rV_6) (z : K) (z2 := fun r : K => Right (sol r) : 'rV_3) +Lemma angvel_sqr (sol : R -> 'rV_6) (z : R) (z2 := fun r : R => Right (sol r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, D[%R -> sol 0 \in Tilt.Upsilon1 -> @@ -933,7 +912,7 @@ have key_ortho : (z2 z *m \S('e_2)) *d u = 0. by rewrite dotmulC; exact/ortho_spin. rewrite key_ortho expr2. rewrite [in RHS]mxE. -rewrite [X in _ = - (w *m (\S('e_2) *m (z2 z)^T)) 0 0 * (u *d u)%:M 0 0 - 0%:M 0 0 * X]mxE. +rewrite [X in _ = - (w *m (\S('e_2) *m (z2 z)^T)) 0 0 * (u *d u)%:M 0 0 - 0%:M 0 0 * X]mxE. rewrite mulr1n mulr0 subr0/=. rewrite /u -/w /dotmul. have Hw_ortho : (w *d u) = 0 by rewrite /u dotmulC ortho_spin. @@ -946,7 +925,7 @@ rewrite [in LHS]mulmxBr mulmxA wu0 sub0r. by rewrite 2!mulNmx mulmx1 mxE. Qed. -Lemma neg_spin (sol : K -> 'rV_6) (z : K) : +Lemma neg_spin (sol : R -> 'rV_6) (z : R) : z \in `[0, D[%R -> sol 0 \in Tilt.Upsilon1 -> sol_is_deriv_co (fun=> phi) 0 D sol -> @@ -973,7 +952,7 @@ Qed. Let c1 := 2^-1 / alpha1. Let c2 := 2^-1 / gamma. -Lemma V1dotE (z : K) (sol : K -> 'rV_6) +Lemma V1dotE z (sol : R -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : sol_is_deriv_co (fun=> phi) 0 D sol -> z \in `[0, D[ -> @@ -1000,7 +979,7 @@ rewrite tr_sqr_spin. by rewrite mulmxA. Qed. -Lemma derive_along_V1 t (sol : K -> 'rV_6) : +Lemma derive_along_V1 t (sol : R -> 'rV_6) : t \in `]0, D[ -> sol_is_deriv_co (fun=> phi) 0 D sol -> (forall t, t \in `]0, D[ -> differentiable sol t) -> @@ -1033,12 +1012,12 @@ rewrite -fctE /= !derive_along_enorm_squared//=. - exact: dif1. Qed. -Definition u1 (sol : K -> 'rV[K]_6) t +Definition u1 (sol : R -> 'rV[R]_6) t (zp1 := Left \o sol) (z2 := Right \o sol) - (w := z2 t *m \S('e_2)) : 'rV[K]_2 := + (w := z2 t *m \S('e_2)) : 'rV[R]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 t|_e, 1 |-> `|w|_e] i. -Lemma V1dot_ub (sol : K -> 'rV[K]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : +Lemma V1dot_ub (sol : R -> 'rV[R]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : sol 0 \in Tilt.Upsilon1 -> sol_is_deriv_co (fun=> phi) 0 D sol -> forall t, t \in `[0, D[%R -> @@ -1071,7 +1050,7 @@ rewrite [in leRHS](mulrC (_ / 2)) (mulrC 2^-1) -mulrDr -splitr. by rewrite [leRHS]mulrC. Qed. -Lemma V1dot_eq0_p1_or_p2 (sol : K -> 'rV[K]_6) (t : K) : +Lemma V1dot_eq0_p1_or_p2 (sol : R -> 'rV[R]_6) t : sol 0 \in Tilt.Upsilon1 -> sol_is_deriv_co (fun=> phi) 0 D sol -> t \in `[0, D[%R -> @@ -1089,11 +1068,11 @@ have h : u1 sol t = 0. by rewrite ltxx. have L0 : Left (sol t) = 0. apply/eqP; rewrite -enorm_eq0; apply /eqP. - have := congr1 (fun v : 'rV[K]_2 => v ord0 ord0) h. + have := congr1 (fun v : 'rV_2 => v ord0 ord0) h. by rewrite !mxE/=. have R0 : (Right (sol t)) *m \S('e_2) = 0. apply/eqP; rewrite -enorm_eq0; apply/eqP. - have := congr1 (fun v : 'rV[K]_2 => v ord0 ord_max) h. + have := congr1 (fun v : 'rV_2 => v ord0 ord_max) h. by rewrite !mxE/=. rewrite -(hsubmxK (n1:=3) (sol t)). rewrite L0. @@ -1104,7 +1083,7 @@ suff [-> | -> ] : Right (sol t) = 0 \/ Right (sol t) = (2 *: 'e_2). by case: splitP => // k _. have := is_sol_state_space_tilt t0d sol0 solP. rewrite /Tilt.Upsilon1/=. -have /sub_rVP [k ->] : (Right (sol t) <= ('e_2 : 'rV[K]_3))%MS. +have /sub_rVP [k ->] : (Right (sol t) <= ('e_2 : 'rV_3))%MS. apply: (@submx_trans _ _ _ _ _ _ (kermx \S('e_2))). by apply /sub_kermxP. rewrite submxElt kernel_spin //. @@ -1118,169 +1097,11 @@ by rewrite subr_eq addrC -subr_eq subrr => /eqP <-;rewrite scale0r;left. by rewrite subr_eq addrC -subr_eq opprK => /eqP <-;right. Qed. -(* TODO: rework of this proof is needed *) -(* NB: unused *) -(* lynda : rm*) - -Lemma derive_along_Left_Right_le0 (sol : _ -> _ -> _) (x : 'rV[K]_6) : - sol x 0 = Tilt.point1 -> - sol_is_deriv_co (fun=> phi) 0 D (sol x) -> - \forall z \near 0^', - ('D~(sol x) (fun x => `|Left x|_e ^+ 2 / (2 * alpha1)) + - 'D~(sol x) (fun x => `|Right x|_e ^+ 2 / (2 * gamma))) z <= 0. -Proof. -move=> sol0 solP. -rewrite fctE !invfM /=. -near=> z. -under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. -under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. -(* move: dtraj => [H0 Hderiv Htilt]. *) -(* have Hz_derivable : derivable (sol x) z 1. *) -(* apply: Hderiv. *) -(* admit. *) -(* rewrite derive_alongMl; last 2 first. *) -(* exact/differentiable_norm_squared/differentiable_lsubmx. *) -(* apply derivable1_diffP. *) -(* apply: Hderiv. *) -(* admit. *) -(* rewrite derive_alongMl; last 2 first. *) -(* exact/differentiable_norm_squared/differentiable_rsubmx. *) -(* exact/derivable1_diffP. *) -(* rewrite /= !derive_along_norm_squared; last 4 first. *) -(* exact/differentiable_rsubmx. *) -(* exact/derivable1_diffP. *) -(* exact/differentiable_lsubmx. *) -(* exact/derivable1_diffP. *) -(* rewrite -V1dotE //. *) -(* pose zp1 := Left \o sol x. *) -(* pose z2 := Right \o sol x. *) -(* set w := (z2 z) *m \S('e_2). *) -(* pose u1 : 'rV[K]_2 := *) -(* \row_(i < 2) [eta (fun=> 0) with 0 |-> norm (zp1 z), 1 |-> norm w] i. *) -(* apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). *) -(* exact: V1dot_ub. *) -(* have [->|H] := eqVneq u1 0. *) -(* by rewrite mulNmx mul0mx mulNmx mul0mx mxE mxE oppr0. *) -(* by rewrite leNgt 2!mulNmx mxE oppr_gt0 -leNgt ltW// u2_quadratic_form_gt0. *) -Unshelve. all: try by end_near. Abort. - -(* NB: should be completed to prove asymptotic stability *) -Lemma locnegsemidef_derive_alone_V1 sol (x : 'rV[K]_6) : - sol x 0 = Tilt.point1 -> - sol_is_deriv_co (fun=> phi) 0 D (sol x) -> - locnegsemidef ('D~(sol x) (Tilt.V1 alpha1 gamma)) 0. -Proof. -(* move=> [y033] dy dtraj traj0. *) -(* rewrite /locnegsemidef /V1. *) -(* rewrite derive_alongD /=; last 3 first. *) -(* apply: differentiableM => /=; last exact: differentiable_cst. *) -(* exact/differentiable_norm_squared/differentiable_lsubmx. *) -(* apply: differentiableM; last exact: differentiable_cst. *) -(* exact/differentiable_norm_squared/differentiable_rsubmx. *) -(* apply/derivable1_diffP. *) -(* admit. *) -(* split; last first. *) -(* near=> z. *) -(* rewrite derive_along_derive //; last first. *) -(* apply/derivable1_diffP. *) -(* admit. *) -(* admit. (* TODO: lynda *) *) -(* admit. (* TODO: lynda *) *) -(* under [X in derive_along X _ _ + _]eq_fun do rewrite mulrC. *) -(* under [X in _ + derive_along X _ _]eq_fun do rewrite mulrC. *) -(* rewrite derive_alongMl; last 2 first. *) -(* exact/differentiable_norm_squared/differentiable_lsubmx. *) -(* apply/derivable1_diffP. *) -(* admit. *) -(* rewrite /= !derivative_derive_along_eq0. *) -(* - by rewrite scaler0 add0r. *) -(* TODO: urgent - apply/differentiable_norm_squared/differentiable_rsubmx. - rewrite [LHS]dtraj /tilt_eqn/= traj0 /tilt_point1. - rewrite /eqn14b_rhs. - by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0. - exact/differentiable_norm_squared/differentiable_lsubmx. - rewrite [LHS]dtraj /tilt_eqn/= traj0 /tilt_point1. - rewrite /eqn14b_rhs. - by rewrite rsubmx_const lsubmx_const !subr0 !scaler0 mul0mx row_mx0.*) -Abort. - -(* lynda : remove *) -Lemma locnegdef_derive_along_V1 (sol : 'rV_6 -> K -> 'rV_6) (x : 'rV[K]_6) - (zp1 := Left \o sol x) (z2 := Right \o sol x) : - sol x 0 \in Tilt.Upsilon1 -> - sol_is_deriv_co (fun=> phi) 0 D (sol x) -> - (forall t : K, Tilt.Upsilon1 (sol x t)) -> - sol x 0 = Tilt.point1 -> - locnegdef ('D~(sol x) (Tilt.V1 alpha1 gamma)) 0. -Proof. -move=> sol0 solP state y0. -split. - rewrite /sol_is_deriv_co in solP. - rewrite /= derivative_derive_along_eq0 => //; last first. - admit. - exact: V1_diff. -near=> z0. -rewrite derive_along_V1. -- have z00D : z0 \in `[0, D[%R. - admit. - have V1dot_le := V1dot_ub sol0 solP z00D => //. - set w := z2 z0 *m \S('e_2). - set u1 : 'rV[K]_2 := \row_(i < 2) - [eta (fun=> 0) with 0 |-> `|zp1 z0|_e, 1 |-> `|w|_e] i. - have Hpos : 0 < (u1 *m u2 *m u1^T) 0 0. - rewrite u2_quadratic_form_gt0//. - rewrite /u1. - admit. - have Hneg : - (u1 *m u2 *m u1^T) 0 0 < 0 by rewrite oppr_lt0. - rewrite lt_neqAle. - apply/andP; split; last first. - apply: (@le_trans _ _ ((- u1 *m u2 *m u1^T) ``_ 0)). - by []. - have -> : (- u1 *m u2 *m u1^T) 0 0 = - (u1 *m u2 *m u1^T) 0 0. - rewrite !mxE -sumrN. - under [in RHS]eq_bigr do rewrite -mulNr. - by under [in LHS]eq_bigr do rewrite mulNmx mxE. - by apply/ltW => //. - rewrite /V1dot. - rewrite mxE/=. - apply/eqP => Habs. - admit. -- admit. -- by []. -- move => t t0D. - apply/derivable1_diffP => //. - rewrite /sol_is_deriv_co in solP. - apply solP. - move: t0D; rewrite inE/=. - by apply: subset_itvr; rewrite bnd_simp. -Unshelve. all: by end_near. Abort. - -(*Definition is_Lyapunov_stable_at {K : realType} {n} - (f : (K -> 'rV[K]_n.+1) -> K -> 'rV[K]_n.+1) - (A : set 'rV[K]_n.+1) - (V : 'rV[K]_n.+1 -> K) - (x0 : 'rV[K]_n.+1) : Prop := - [/\ is_equilibrium_point f x0 A, - is_Lyapunov_candidate V setT x0 & - forall traj1 traj2 : (K -> 'rV[K]_n.+1), - is_sol f traj1 A -> - traj1 0 = x0 -> - locnegsemidef (derive_along V (fun a => traj1) 0 ) 0].*) - -(*Lemma V1_is_Lyapunov_stable : - is_Lyapunov_stable_at (tilt_eqn alpha1 gamma) state_space_tilt (V1 alpha1 gamma) tilt_point1. -Proof. -split. -- exact: equilibrium_tilt_point1. -- exact: V1_is_Lyapunov_candidate. -(*- by move=> traj1 ? ?; exact: V1_point_is_lnsd. -Qed.*) Abort.*) - -Lemma derive_along_V1_le0 (sol : K -> 'rV[K]_6) : +Lemma derive_along_V1_le0 (sol : R -> 'rV_6) : sol 0 \in Tilt.Upsilon1 -> sol_is_deriv_co (fun=> phi) 0 D sol -> (forall t, t \in `]0, D[%R -> differentiable sol t) -> - forall t : K, 0 < t < D -> + forall t, t \in `]0, D[%R -> 'D~(sol) (Tilt.V1 alpha1 gamma) t <= 0. Proof. move=> sol0 solP diff t t0. @@ -1289,11 +1110,9 @@ rewrite derive_along_V1//; last 2 first. move=> t1 t10Delta. apply: diff => //. by rewrite inE/= in_itv/= in t10Delta. -have t0D : t \in `[0, D[%R. - rewrite in_itv/=. - by move/andP : t0 => [] /ltW -> ->. -have Hub := V1dot_ub sol0 solP t0D. -apply: (le_trans Hub). +have /(V1dot_ub sol0 solP) : t \in `[0, D[%R. + by apply: subset_itvr t0; rewrite bnd_simp. +move/le_trans; apply. have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> `|(Left \o sol) t|_e, 1 |-> `|(Right \o sol) t *m \S('e_2)|_e] @@ -1313,8 +1132,8 @@ End tilt_eqn_Lyapunov. Section tilt_eqn_Lyapunov_global. Local Open Scope classical_set_scope. -Context {K : realType}. -Variables alpha1 gamma : K. +Context {R : realType}. +Variables alpha1 gamma : R. Hypotheses (alpha1_gt0 : 0 < alpha1) (gamma_gt0 : 0 < gamma). Let phi := Tilt.eqn alpha1 gamma. @@ -1325,20 +1144,18 @@ Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). (* todo: copy paste *) -Lemma derive_zp10 (sol : K -> 'rV_6) : +Lemma derive_zp10 (sol : R -> 'rV_6) : sol_is_deriv_c0y phi sol -> 'D_1 (Left \o sol) 0 = - alpha1 *: Left (sol 0). Proof. move/sol_is_deriv_c0yP. move/(_ _ (lexx 0)) => [d0 +]. move=> /(congr1 Left). -rewrite derive1E. -rewrite row_mxKl. -move=> <-. +rewrite derive1E row_mxKl => <-. by rewrite derive_lsubmx. Qed. -Lemma derive_z20 (sol : K -> 'rV_6) : +Lemma derive_z20 (sol : R -> 'rV_6) : sol_is_deriv_c0y phi sol -> 'D_1 (Right \o sol) 0 = gamma *: (Right (sol 0) - Left (sol 0)) *m \S('e_2 - Right (sol 0)) ^+ 2. @@ -1350,7 +1167,7 @@ rewrite derive1E. by rewrite row_mxKr => ?; rewrite derive_rsubmx. Qed. -Lemma V1dotE0 (sol : K -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : +Lemma V1dotE0 (sol : R -> 'rV_6) (zp1 := Left \o sol) (z2 := Right \o sol) : sol_is_deriv_c0y phi sol -> V1dot (sol 0) = c1 *: (2 *: 'D_1 zp1 0 *m (Left (sol 0))^T) 0 0 + @@ -1375,13 +1192,13 @@ rewrite tr_sqr_spin. by rewrite mulmxA. Qed. -Lemma derive_along_V1_global t (sol : K -> 'rV_6) : +Lemma derive_along_V1_global t (sol : R -> 'rV_6) : 0 <= t -> sol_is_deriv_c0y phi sol -> 'D~(sol) (Tilt.V1 alpha1 gamma) t = V1dot (sol t). Proof. move=> t0 tilt_eqnx. -have dif1 : forall (t : K), 0 <= t -> differentiable sol t. +have dif1 : forall t : R, 0 <= t -> differentiable sol t. move => /= t' t'0. apply/derivable1_diffP. move/sol_is_deriv_c0yP in tilt_eqnx. @@ -1411,14 +1228,14 @@ rewrite (V1dotE alpha1_gt0 gamma_gt0 (@sol_is_deriv_c0yco _ _ _ _ tilt_eqnx (t + by rewrite inE/= in_itv/= (ltW t0) ltrDl; apply /andP. Qed. -Lemma derive_along_V1_le0_global (sol : K -> 'rV[K]_6) : +Lemma derive_along_V1_le0_global (sol : R -> 'rV[R]_6) : sol 0 \in Tilt.Upsilon1 -> sol_is_deriv_c0y phi sol -> - forall t : K, 0 <= t -> + forall t : R, 0 <= t -> 'D~(sol) (Tilt.V1 alpha1 gamma) t <= 0. Proof. move=> sol0 solves. -have diff : forall (t : K), 0 <= t -> differentiable sol t. +have diff : forall (t : R), 0 <= t -> differentiable sol t. move => /= t' t0'. apply/derivable1_diffP. move/sol_is_deriv_c0yP in solves. @@ -1447,18 +1264,18 @@ Qed. End tilt_eqn_Lyapunov_global. Section equilibrium_zero_stable. -Context {K : realType}. -Variables gamma alpha1 : K. +Context {R : realType}. +Variables gamma alpha1 : R. Hypotheses (gamma_gt0 : 0 < gamma) (alpha1_gt0 : 0 < alpha1). Let phi := Tilt.eqn alpha1 gamma. -Variable Init : set 'rV[K]_6. +Variable Init : set 'rV[R]_6. Lemma equilibrium_zero_stable : Tilt.point1 \in Init -> open Init -> Init `<=` Tilt.Upsilon1 -> is_stable_at phi Init Tilt.point1. Proof. move=> Init0 openInit Init_in_state. -apply: (@Lyapunov_stability K _ phi Init openInit (Tilt.V1 alpha1 gamma)). +apply: (@Lyapunov_stability R _ phi Init openInit (Tilt.V1 alpha1 gamma)). - exact: V1_diff. - move=> D /= sol sol0 solP t t0. apply: (@derive_along_V1_le0 _ _ _ _ _ D sol) => //. diff --git a/tilt_mathcomp.v b/tilt_mathcomp.v index 140e080c..ff7855a9 100644 --- a/tilt_mathcomp.v +++ b/tilt_mathcomp.v @@ -20,3 +20,10 @@ Qed. Lemma gerN {R : numDomainType} (x : R) : 0 <= x -> - x <= x. Proof. by move=> x0; rewrite ge0_cp. Qed. + +Definition And31 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := + let: And3 p1 p2 p3 := a in p1. +Definition And32 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := + let: And3 p1 p2 p3 := a in p2. +Definition And33 (P1 P2 P3 : Prop) (a : [/\ P1, P2 & P3]) := + let: And3 p1 p2 p3 := a in p3. diff --git a/tilt_stability.v b/tilt_stability.v index 0e32a0a0..81249745 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -14,15 +14,15 @@ Require Import tilt_mathcomp tilt_analysis tilt_robot ode. (* Lyapunov's stability theorem. *) (* *) (* ``` *) -(* posdefmx M == M is definite positive *) -(* is_Lyapunov_candidate V := locposdef V *) -(* 'D~(f) V == derivative of V along the solution f *) -(* is_equilibrium_point f p := solves_equation f (cst p) *) -(* state_space phi Init == the set points attainable by a solution *) -(* of the autonomous ODE phi starting from *) -(* Init *) -(* is_locally_stable_at f V x == Lyapunov stability *) -(* is_stable_at f V x == TODO *) +(* posdefmx M == M is definite positive *) +(* is_Lyapunov_candidate V := locposdef V *) +(* 'D~(f) V == derivative of V along the solution f *) +(* is_equilibrium_point f p := solves_equation f (cst p) *) +(* state_space phi Init == the set points attainable by a solution *) +(* of the autonomous ODE phi starting from *) +(* Init *) +(* is_stable_at f V x == Lyapunov stability *) +(* is_global_time_stable_at f V x == TODO *) (* ``` *) (* *) (* Reference: *) @@ -80,11 +80,11 @@ Notation "''D~(' f ) V" := (derive_along V f). Section derive_along. Context {R : realType} {n : nat}. -Variable sol : R -> 'rV[R]_n. +Variable f : R -> 'rV[R]_n. Lemma derive_along_derive (V : 'rV[R]_n -> R) (t : R) : - differentiable V (sol t) -> differentiable sol t -> - 'D~(sol) V t = 'D_1 (V \o sol) t. + differentiable V (f t) -> differentiable f t -> + 'D~(f) V t = 'D_1 (V \o f) t. Proof. move=> difV difsol. rewrite /derive_along/=. @@ -108,9 +108,9 @@ do 2 (rewrite -[in RHS]deriveE; last by []). by under eq_fun do rewrite mxE /= mulr1n /=. Qed. -Lemma derive_alongMl (f : 'rV_n -> R) (k : R) t : - differentiable f (sol t) -> differentiable sol t -> - 'D~(sol) (k *: f) t = k *: 'D~(sol) f t. +Lemma derive_alongMl (V : 'rV_n -> R) (k : R) t : + differentiable V (f t) -> differentiable f t -> + 'D~(f) (k *: V) t = k *: 'D~(f) V t. Proof. move=> dfx dpx. rewrite derive_along_derive; last 2 first. @@ -125,9 +125,9 @@ by rewrite derive_along_derive. Qed. Lemma derive_alongD (V1 V2 : 'rV_n -> R) t : - differentiable V1 (sol t) -> differentiable V2 (sol t) -> - differentiable sol t -> - 'D~(sol) (V1 + V2) t = 'D~(sol) V1 t + 'D~(sol) V2 t. + differentiable V1 (f t) -> differentiable V2 (f t) -> + differentiable f t -> + 'D~(f) (V1 + V2) t = 'D~(f) V1 t + 'D~(f) V2 t. Proof. move=> dfV1 dfV2 dfsol. rewrite derive_along_derive; last 2 first. @@ -144,20 +144,20 @@ rewrite derive_along_derive; [|by []..]. by rewrite derive_along_derive. Qed. -Lemma derivative_derive_along_eq0 (f : 'rV_n -> R) (t : R) : - differentiable f (sol t) -> - 'D_1 sol t = 0 -> 'D~(sol) f t = 0. +Lemma derivative_derive_along_eq0 (V : 'rV_n -> R) (t : R) : + differentiable V (f t) -> + 'D_1 f t = 0 -> 'D~(f) V t = 0. Proof. move=> df dsol0. rewrite /derive_along /jacobian1 /dotmul dotmulP /dotmul -trmx_mul. by rewrite dsol0 mul0mx !mxE. Qed. -Lemma derive_along_enorm_squared m (f : 'rV[R]_n -> 'rV[R]_m) (t : R) : - differentiable f (sol t) -> - differentiable sol t -> - 'D~(sol) (fun y => `|f y|_e ^+ 2) t = - (2 *: 'D_1 (f \o sol) t *m (f (sol t))^T) 0 0. +Lemma derive_along_enorm_squared m (V : 'rV[R]_n -> 'rV[R]_m) (t : R) : + differentiable V (f t) -> + differentiable f t -> + 'D~(f) (fun y => `|V y|_e ^+ 2) t = + (2 *: 'D_1 (V \o f) t *m (V (f t))^T) 0 0. Proof. move=> difff diffphi. rewrite derive_along_derive//; last exact: differentiable_enorm_squared. @@ -209,23 +209,6 @@ Qed. End ode. -Section is_sol. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n. -Variables (phi : U -> U) (Delta : K). - -(* TODO: rm? *) -(*Lemma sol_is_derive_0oS (A B : set U) : A `<=` B -> - sol_is_derive_0o phi Delta A `<=` sol_is_derive_0o phi Delta B. -Proof. -move=> AB f. -rewrite /sol_is_derive_0o inE => -[inD0 [_ deri cont]]; rewrite inE. -split => //. -by apply: AB. -Qed. -*) -End is_sol. - Section state_space. Context {K : realType} {n : nat}. Let T := 'rV[K]_n. @@ -281,7 +264,7 @@ Variable Init : set T. Definition is_stable_at (x : T) := forall eps, eps > 0 -> exists2 d, d > 0 & forall f D, f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> - `| f 0 - x | < d -> forall t, 0 < t < D -> `| f t - x | < eps. + `| f 0 - x | < d -> forall t, t \in `]0, D[%R -> `| f t - x | < eps. (* assuming solution exists for all time *) Definition is_global_time_stable_at (x : T) := @@ -292,10 +275,10 @@ Definition is_global_time_stable_at (x : T) := Lemma stable_global_time : is_stable_at `<=` is_global_time_stable_at. Proof. move=> x H e /H [d d0 stable]. -exists d => // z [z0Init zglob] zd /= t t0. +exists d => // z0 z0Init zglob zd /= t t0. apply: (stable _ (t + 1)) => //. exact: sol_is_deriv_c0yco. -by rewrite t0/= ltrDl. +by rewrite in_itv/= t0/= ltrDl. Qed. Definition is_asymptotically_stable_at (x : T) (f : K -> 'rV[K]_n) : Prop := @@ -303,84 +286,6 @@ Definition is_asymptotically_stable_at (x : T) (f : K -> 'rV[K]_n) : Prop := End stability. -(* TODO: rm? *) -Section bounded. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. -(* Variable sol : K->T. *) -Variable Init : set T. -Variable x0 : T. -(* Hypothesis solP: is_sol phi Delta sol Init. *) -(* Lemma stable_bounded : is_locally_stable_at phi Init x0 -> forall eps, exists d, forall u0 Delta sol, `|u0 - x0| <= d -> is_sol_autonomous u0 phi 0 Delta sol -> forall t, 0<=t<=Delta -> `|sol t - x0| <= eps. *) -(* Proof. *) -(* move => stable eps. *) -(* have := *) -End bounded. -(* f' = phi f *) -(* phi_robot f =def= fun f t => phi t (f t) *) -(*Definition existence_uniqueness {K : realType} {n} - (phi : K -> 'rV[K]_n -> 'rV[K]_n) (Init : set 'rV[K]_n) Delta - (sol : K -> 'rV[K]_n) := - forall y, y 0 \in Init -> is_sol phi Init Delta y <-> sol (y 0) = y. -*) - -(*Definition initial_condition {K : realType} {n} (sol : K -> 'rV[K]_n) x0 := - sol 0 = x0.*) - -(*Section solutions_unique. -Context {K : realType} {n : nat}. -Variable phi : K -> 'rV[K]_n -> 'rV[K]_n. -Variable Init : set 'rV[K]_n. -Variable Delta : K. - -Definition solutions_unique := forall (f g : K -> 'rV_n) (x0 : 'rV_n), - is_sol phi Init Delta f -> - is_sol phi Init Delta g -> - f 0 = x0 -> g 0 = x0 -> - f = g. - -End solutions_unique. - -Section solutions_unique_lemmas. -Context {K : realType} {n : nat}. -Variables (phi : K -> 'rV[K]_n -> 'rV[K]_n) (Init : set 'rV[K]_n). -Variable Delta : K. - -Lemma existence_uniqueness_unique (sol : 'rV[K]_n -> K -> 'rV[K]_n) : - existence_uniqueness phi Init Delta sol -> - solutions_unique phi Init Delta. -Proof. -move=> solP f g x0 solf solg f0 g0. -apply/funext => x. -case : (solf) => //=. -move => a0D Da fa. -have := solP _ a0D. -case. -move => /(_ solf). -move => a0a _. -case : (solg) => //=. -move => b0D Db fb. -have := solP _ b0D. -case. -move => /(_ solg). -move => b0b _. -by rewrite -b0b -a0a f0 g0. -Qed. - -Lemma existence_uniqueness_exists (sol : K -> 'rV[K]_n) : - existence_uniqueness phi Init Delta sol -> forall p, p \in Init -> - initial_condition sol p -> is_sol phi Init Delta (sol p). -Proof. -move=> solP sol0 p pD. -have H := solP (sol p). -apply H. - by rewrite sol0. -by rewrite sol0. -Qed. - -End solutions_unique_lemmas.*) - (* TODO: move? *) Section sphere. Context {K : realType} {n : nat}. @@ -500,18 +405,18 @@ Qed. End about_Lyapunov_function. Section Lyapunov_stability. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n.+1. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n.+1. Variable phi : U -> U. Variable Init : set U. Hypothesis openInit : open Init. -Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[K]_n.+1) r. +Let B r := closed_ball_ (fun x => `|x|) (0 : 'rV[R]_n.+1) r. Let BE s : 0 < s -> B s = closed_ball 0 s. Proof. by move=> r0; rewrite /B -closed_ballE. Qed. -Variable V : U -> K. +Variable V : U -> R. Hypothesis Vdiff : forall t : U, differentiable V t. Hypothesis DV_le0 : forall D f, f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> @@ -522,8 +427,8 @@ Theorem Lyapunov_stability0 : is_Lyapunov_candidate V Init 0 -> is_stable_at phi Init 0. Proof. move=> VInitx /= eps eps0/=. -move: VInitx => [/= xInit [Vx0 InitxV]]. -have [r [r_gt0 r_eps BrD]] : exists r : K, [/\ 0 < r, r <= eps & B r `<=` Init]. +move: VInitx => [/= xInit Vx0 InitxV]. +have [r [r_gt0 r_eps BrD]] : exists r : R, [/\ 0 < r, r <= eps & B r `<=` Init]. move: xInit; rewrite inE => /(open_subball openInit)[r0/= r0_gt0] q. pose r := Num.min (r0 / 2) eps. have r_gt0 : 0 < r by rewrite /r lt_min eps0 divr_gt0. @@ -536,7 +441,7 @@ have [r [r_gt0 r_eps BrD]] : exists r : K, [/\ 0 < r, r <= eps & B r `<=` Init]. move: Brv; rewrite BE ?divr_gt0//. exact: subset_closure_half(*TODO: naming seems off, report*). rewrite {xInit}. -have alpha_min : {x : 'rV[K]_n.+1 | x \in sphere r /\ +have alpha_min : {x : 'rV[R]_n.+1 | x \in sphere r /\ forall y, y \in sphere r -> V x <= V y}. have : {within sphere r, continuous V}. apply: continuous_subspaceT => /= v. @@ -557,7 +462,7 @@ have alpha_gt0 : 0 < alpha. rewrite {InitxV}. have [beta /andP[beta_gt0 beta_alpha]] : exists beta, 0 < beta < alpha. by exists (alpha / 2); rewrite divr_gt0//= ltr_pdivrMr//= ltr_pMr// ltr1n. -set Omega_beta := [set x : 'rV[K]_n.+1 | B r x /\ V x <= beta]. +set Omega_beta := [set x : 'rV[R]_n.+1 | B r x /\ V x <= beta]. have Omega_beta_Br : Omega_beta `<=` (B r)°. move=> y [Bry Vybeta]. rewrite BE// interior_closed_ballE => //=. @@ -592,7 +497,7 @@ have Df_Omega_beta D f : f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> move: f0_Omega; rewrite inE /Omega_beta/= /B /closed_ball_/=. rewrite !sub0r !normrN => -[f0r Vf0beta]. rewrite leNgt; apply/negP => rft. - have [t1 /andP[t1_ge0 t1t] phit1r] : exists2 t0 : K , 0 <= t0 <= t & `|f t0| = r. + have [t1 /andP[t1_ge0 t1t] phit1r] : exists2 t0, 0 <= t0 <= t & `|f t0| = r. have t0 : 0 <= t by rewrite (itvP t0D). have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o f)}. apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) f t0) => //. @@ -637,7 +542,7 @@ have _ : compact Omega_beta. apply: continuous_comp; first by []. exact: differentiable_continuous. have [d0 d0_gt0 Vbeta] : exists2 d, d > 0 & forall x, `|x| <= d -> V x < beta. - have [d d_gt0 xdV] : exists2 d : K, 0 < d & + have [d d_gt0 xdV] : exists2 d, 0 < d & forall y, `|y - 0| < d -> `|V y - V 0| < beta. have /cvgrPdist_lt /(_ _ beta_gt0) : V x @[x --> nbhs (0 : 'rV_n.+1) ] --> V 0. exact/differentiable_continuous/Vdiff. @@ -661,21 +566,21 @@ have B_delta_Omega_beta : B delta `<=` Omega_beta. split; last exact/ltW/deltaV. by rewrite (le_trans vdelta)// /delta ge_min lexx orbT. exists delta => //. -move=> f Delta' [f0 solf] f0xdelta t0 t0_ge0. +move=> f D' f0 solf f0xD t0 t0_ge0. rewrite subr0. have : f 0 \in Omega_beta. rewrite inE; apply: B_delta_Omega_beta. rewrite /B /closed_ball_/= sub0r normrN; apply/ltW. - by rewrite subr0 in f0xdelta. + by rewrite subr0 in f0xD. rewrite inE => -[+ _]. rewrite /B /closed_ball_/= sub0r normrN => solx0r. have : (B r)° (f t0). apply: Omega_beta_Br; apply/set_mem. - apply: (Df_Omega_beta Delta') => //. + apply: (Df_Omega_beta D') => //. rewrite inE; split; first by rewrite /B /closed_ball_/= sub0r normrN. have : B delta (f 0). rewrite /closed_ball_; apply: ltW; rewrite sub0r normrN. - by rewrite subr0 in f0xdelta. + by rewrite subr0 in f0xD. by move/B_delta_Omega_beta => []. rewrite BE//= interior_closed_ballE//=. rewrite mx_norm_ball /ball_/= sub0r normrN => /lt_le_trans; exact. @@ -684,8 +589,8 @@ Unshelve. all: by end_near. Qed. End Lyapunov_stability. Section is_equilibrium_point_change_of_variables. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n.+1. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n.+1. Variable phi : U -> U. Variable Init : set U. @@ -693,7 +598,7 @@ Lemma sol_is_deriv_co_substitution D f x : sol_is_deriv_co (fun=> phi) 0 D f -> sol_is_deriv_co (fun _ y => phi (y + x)) 0 D (f \- cst x). Proof. -rewrite /sol_is_deriv_co => /= H t t0Delta; split. +rewrite /sol_is_deriv_co => /= H t t0D; split. apply: derivableB => //. by apply H. rewrite subrK derive1E deriveB//; last by apply H. @@ -707,10 +612,10 @@ Proof. move=> H. rewrite /is_stable_at => /= e e0. have [/= d d0 {}H] := H _ e0. -exists d => // f Delta [f0Init solf] f0xd t t0. +exists d => // f D f0Init solf f0xd t t0. rewrite -[_ - _]subr0. rewrite -[f t - x]/((f \- cst x) t). -apply: (H _ Delta) => //. +apply: (H _ D) => //. - exact/image_f. - exact: sol_is_deriv_co_substitution. - by rewrite /= subr0. @@ -763,15 +668,15 @@ Qed. End is_equilibrium_point_change_of_variables. Section Lyapunov_stability. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n.+1. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n.+1. Variable phi : U -> U. Variable Init : set U. Hypothesis openInit : open Init. -Variable V : U -> K. +Variable V : U -> R. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis V'_le0 : forall D (f : K -> U), +Hypothesis V'_le0 : forall D (f : R -> U), f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> forall t, 0 < t < D -> 'D~(f) V t <= 0. From c8096ec9060448bd1d2676e411d5f0b1ef344ead Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 20 Feb 2026 13:13:46 +0900 Subject: [PATCH 132/144] T -> U --- derive_matrix.v | 4 +- ode.v | 6 +- tilt_analysis.v | 87 +------------------ tilt_stability.v | 218 ++++++++++++++++++++++------------------------- 4 files changed, 113 insertions(+), 202 deletions(-) diff --git a/derive_matrix.v b/derive_matrix.v index f8dd444d..1c679a73 100644 --- a/derive_matrix.v +++ b/derive_matrix.v @@ -14,7 +14,9 @@ Require Import ssr_ext euclidean rigid skew. (* # Derivatives of time-varying matrices *) (* *) (* ``` *) -(* ang_vel_mx M == angular velocity matrix of M(t) *) +(* derivable_mx M t v == pointwise derivability of matrices *) +(* ang_vel_mx M == angular velocity matrix of M(t) *) +(* ang_vel M t == angular velocity *) (* ``` *) (* *) (******************************************************************************) diff --git a/ode.v b/ode.v index 61738ee0..bcbe68e6 100644 --- a/ode.v +++ b/ode.v @@ -1585,8 +1585,7 @@ Proof. exact: cts_fun. Qed. Let f := cauchy_lipschitz_f. -Theorem cauchy_lipschitz_ex : - is_sol_oo phi u0 a (a + safe_dist) f. +Theorem cauchy_lipschitz_ex : is_sol_oo phi u0 a (a + safe_dist) f. Proof. apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. - by rewrite ltDl_safe_dist. @@ -1693,7 +1692,8 @@ End continuous_confined. Section solution_locally_unique. Context {R : realType} {n : nat}. Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}) (f : R -> U). +Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}) + (f : R -> U). Hypothesis ab : a < b. Hypothesis k0 : 0 < k. Let B := closed_ball u0 r%:num. diff --git a/tilt_analysis.v b/tilt_analysis.v index f9a6838c..824ccb99 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -1,9 +1,10 @@ From HB Require Import structures. From mathcomp Require Import all_boot all_order all_algebra ring. From mathcomp Require Import interval_inference. -From mathcomp Require Import boolp classical_sets functions reals ereal. -From mathcomp Require Import topology normedtype derive realfun landau. -From mathcomp Require Import measure lebesgue_integral. +From mathcomp Require Import boolp classical_sets functions filter reals. +From mathcomp Require Import topology ereal prodnormedzmodule normedtype. +From mathcomp Require Import sequences derive realfun landau measure. +From mathcomp Require Import lebesgue_integral. Require Import ssr_ext derive_matrix. (**md**************************************************************************) @@ -329,23 +330,6 @@ apply: differentiable_comp => //. exact: differentiable_rsubmx. Qed. -(*Global Instance is_diff_lsubmx {R : realFieldType} {V : normedModType R} {n1 n2} - (f df : V -> 'rV[R]_(n1 + n2)) t : - is_diff t f df -> - is_diff t (fun x => lsubmx (f x)) (fun x => lsubmx (df x)). -Proof. -case=> diff_f dfE. -apply: DiffDef. - by apply: differentiable_comp => //; exact: differentiable_lsubmx0. -apply/funext => v. -rewrite -dfE. -rewrite -[LHS]deriveE; last first. - by apply: differentiable_comp => //; exact: differentiable_lsubmx0. -rewrite -[in RHS]deriveE; last first. - by []. -rewrite derive_lsubmx//. -Abort.*) - Lemma differentiable_lsubmx_comp {R : realFieldType} (V : normedModType R) {n1 n2} (f : V -> 'rV[R]_(n1 + n2)) t : (forall x, differentiable f x) -> @@ -356,34 +340,6 @@ apply: differentiable_comp => //. exact: differentiable_lsubmx. Qed. -(*Lemma derivable_row_mx {R : realFieldType} {n1 n2 : nat} - (f : R -> 'rV[R]_n1) (g : R -> 'rV[R]_n2) t v : - (forall x, derivable f x v) -> (forall x, derivable g x v) -> - derivable (fun x : R => row_mx (f x) (g x)) t v. -Proof. -move=> /= fv gv; apply/derivable_mxP => i j. -rewrite (ord1 i)/=. -have /cvg_ex[/= l Hl]:= fv t. -have /cvg_ex[/= k Hk]:= gv t. -apply/cvg_ex => /=; exists (row_mx l k)``_j. -apply/cvgrPdist_le => /= e e0. -move/cvgrPdist_le : Hl => /(_ _ e0) Hl. -move/cvgrPdist_le : Hk => /(_ _ e0) Hk. -move: Hl Hk; apply: filterS2 => x Hl Hk. -rewrite !mxE. -case: fintype.splitP => j1 jj1. - apply: le_trans Hl. - rewrite [in leRHS]/Num.Def.normr/= mx_normrE. - apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, j1)). - by rewrite !mxE/=. -apply: le_trans Hk. -rewrite [in leRHS]/Num.Def.normr/= mx_normrE. -apply: le_trans; last first. - exact: (le_bigmax _ _ (ord0, j1)). -by rewrite !mxE/=. -Qed.*) - Lemma derivable_scalar_mx {R : realFieldType} n (f : 'rV[R]_n -> R) (a : 'rV[R]_n) v : derivable f a v -> @@ -402,40 +358,6 @@ rewrite !mxE/=. by rewrite !ord1 eqxx !mulr1n. Qed. -(* not used? *) -(*Lemma derive_row_mx {R : realFieldType} {n1 n2 : nat} - (f : R -> 'rV[R]_n1) (g : R -> 'rV[R]_n2) t v : - (forall x : R, derivable f x v) -> - (forall x : R, derivable g x v) -> - 'D_v (fun x => row_mx (f x) (g x)) t = row_mx ('D_v f t) ('D_v g t). -Proof. -move=> fv gv. -apply/matrixP => i j. -rewrite derive_mx ?mxE//=; last first. - by apply: derivable_row_mx; [exact: fv|exact: gv]. -do 2 rewrite derive_mx ?mxE//=. -case: fintype.split_ordP => /= j1 jj1; rewrite !mxE; congr ('D_v _ t). - apply/funext => x; rewrite !mxE. - case: fintype.split_ordP => k jE. - congr (f x i _). - move: jE. - by rewrite jj1 => /(congr1 val) => /= /val_inj. - move: jE. - rewrite jj1 => /(congr1 val)/=. - have /[swap] -> := ltn_ord j1. - by rewrite ltnNge/= leq_addr. -apply/funext => x; rewrite !mxE. -case: fintype.split_ordP => k jE. - move: jE. - rewrite jj1 => /(congr1 val)/=. - have /[swap] <- := ltn_ord k. - by rewrite ltnNge/= leq_addr. -congr (g x i _). -move: jE. -rewrite jj1 => /(congr1 val) => /= /eqP. -by rewrite eqn_add2l => /eqP /val_inj. -Qed.*) - Local Open Scope classical_set_scope. (* TODO: rename, generalize to the subset relation *) @@ -859,4 +781,3 @@ exact/diff_derivable. Qed. End gradient. - diff --git a/tilt_stability.v b/tilt_stability.v index 81249745..0ac15f0e 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -14,15 +14,17 @@ Require Import tilt_mathcomp tilt_analysis tilt_robot ode. (* Lyapunov's stability theorem. *) (* *) (* ``` *) -(* posdefmx M == M is definite positive *) -(* is_Lyapunov_candidate V := locposdef V *) -(* 'D~(f) V == derivative of V along the solution f *) -(* is_equilibrium_point f p := solves_equation f (cst p) *) -(* state_space phi Init == the set points attainable by a solution *) -(* of the autonomous ODE phi starting from *) -(* Init *) -(* is_stable_at f V x == Lyapunov stability *) -(* is_global_time_stable_at f V x == TODO *) +(* posdefmx M == M is definite positive *) +(* is_Lyapunov_candidate V D x := x is in D, V x = 0, and V is positive *) +(* everywhere in D except at x *) +(* 'D~(f) V == derivative of V along the solution f *) +(* is_equilibrium_point phi Init x := x is in Init and cst x satisfies *) +(* sol_is_deriv_co phi *) +(* state_space phi Init == the set points attainable by a solution *) +(* of the autonomous ODE phi starting from *) +(* Init *) +(* is_stable_at f V x == Lyapunov stability *) +(* is_global_time_stable_at f V x == TODO *) (* ``` *) (* *) (* Reference: *) @@ -41,18 +43,8 @@ Import numFieldNormedType.Exports. Local Open Scope ring_scope. -Definition posdefmx {K : realType} m (M : 'M[K]_m) : Prop := - M \is sym m K /\ forall a, eigenvalue M a -> a > 0. - -(*Lemma posdefmxP_direct {R : realType} m (M : 'M[R]_m) : - posdefmx M -> (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0). -Proof. -Abort. - -Lemma posdefmxP_converse {R : realType} m (M : 'M[R]_m) : - (forall v : 'rV[R]_m, v != 0 -> (v *m M *m v^T) 0 0 > 0) -> posdefmx M. -Proof. -Abort.*) +Definition posdefmx {R : realType} m (M : 'M[R]_m) : Prop := + M \is sym m R /\ forall a, eigenvalue M a -> a > 0. Local Open Scope classical_set_scope. @@ -71,7 +63,7 @@ Definition locnegsemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z <= 0. End locdef. (* derivation along the solution f, see Khalil p.114 *) -(* NB: we are not representing the initial state at t = 0 of the trajectory sol *) +(* NB: we are not representing the initial state at t = 0 of the solution f *) Definition derive_along {R : numFieldType} {n : nat} (V : 'rV[R]_n -> R) (f : R -> 'rV[R]_n) (t : R) : R := (jacobian1 V (f t))^T *d 'D_1 f t. @@ -174,11 +166,11 @@ Definition derive_along_partial {R : realType} n (V : 'rV[R]_n -> R) \sum_(i < n) (partial V (a t) i * ('D_1 a t) ``_ i). Section ode. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. Variable phi : U -> U. -Lemma sol_is_deriv_c0oP (D : K) (f : K -> U) (e : {posnum K} ) : +Lemma sol_is_deriv_c0oP (D : R) (f : R -> U) (e : {posnum R}) : is_sol_oo (fun=> phi) (f (- e%:num)) (- e%:num) D f -> sol_is_deriv_co (fun=> phi) 0 D f. Proof. @@ -187,11 +179,11 @@ by rewrite bnd_simp. Qed. (* "global" solution *) -Definition sol_is_deriv_c0y (f : K -> U) := - sol_is_deriv_cbnd (fun=> phi) 0 (BInfty K false) f. +Definition sol_is_deriv_c0y (f : R -> U) := + sol_is_deriv_cbnd (fun=> phi) 0 (BInfty R false) f. (* TODO: generalize this lemma *) -Lemma sol_is_deriv_c0yP (f : K -> U) : sol_is_deriv_c0y f <-> +Lemma sol_is_deriv_c0yP (f : R -> U) : sol_is_deriv_c0y f <-> forall t, t >= 0 -> derivable f t 1 /\ f^`() t = phi (f t). Proof. split=> H t t0oo; apply: H. @@ -210,64 +202,58 @@ Qed. End ode. Section state_space. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variable phi : U -> U. -Definition state_space (Init : set T) : set T := +Definition state_space (Init : set U) : set U := [set x | exists f D, [/\ f 0 \in Init, sol_is_deriv_co (fun=> phi) 0 D f & exists2 t, t \in `[0, D[%R & x = f t]]. End state_space. Section equilibrium_point. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variable phi : U -> U. -Definition is_equilibrium_point (Init : set T) (x : T) := +Definition is_equilibrium_point (Init : set U) (x : U) := x \in Init /\ forall d, sol_is_deriv_co (fun=> phi) 0 d (cst x). -Lemma equilibrium_point_in_state_space (Init : set T) : +Lemma equilibrium_point_in_state_space (Init : set U) : is_equilibrium_point Init `<=` state_space phi Init. Proof. -move=> x [xinit solf]. -exists (cst x), 1; split => //. -exists 0 => //. -by rewrite bound_itvE ltr01. +move=> x [xinit solf]; exists (cst x), 1; split => //=. +by exists 0 => //; rewrite bound_itvE. Qed. Definition equilibrium_points Init := [set p | is_equilibrium_point Init p]. -Lemma equilibrium_points_subset (A B : set T) : A `<=` B -> +Lemma equilibrium_points_subset (A B : set U) : A `<=` B -> equilibrium_points A `<=` equilibrium_points B. Proof. move=> AB x. rewrite /equilibrium_points/= /is_equilibrium_point. -rewrite /sol_is_deriv_co. rewrite inE => -[Ax H]. -split. - exact/mem_set/AB. -move=> d t t0d. -have [H1 H2] := H d t t0d. -by split. +split; first exact/mem_set/AB. +by move=> d t; exact: H. Qed. End equilibrium_point. Section stability. -Context {K : realType} {n : nat}. -Let T := 'rV[K]_n. -Variable phi : T -> T. -Variable Init : set T. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n. +Variable phi : U -> U. +Variable Init : set U. -Definition is_stable_at (x : T) := +Definition is_stable_at (x : U) := forall eps, eps > 0 -> exists2 d, d > 0 & forall f D, f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> `| f 0 - x | < d -> forall t, t \in `]0, D[%R -> `| f t - x | < eps. (* assuming solution exists for all time *) -Definition is_global_time_stable_at (x : T) := +Definition is_global_time_stable_at (x : U) := forall eps, eps > 0 -> exists2 d, d > 0 & forall f, f 0 \in Init -> sol_is_deriv_c0y phi f -> `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. @@ -281,65 +267,11 @@ apply: (stable _ (t + 1)) => //. by rewrite in_itv/= t0/= ltrDl. Qed. -Definition is_asymptotically_stable_at (x : T) (f : K -> 'rV[K]_n) : Prop := +Definition is_asymptotically_stable_at (x : U) (f : R -> U) : Prop := exists2 d, d > 0 & `| f 0 - x | < d -> f t @[t --> +oo] --> x. End stability. -(* TODO: move? *) -Section sphere. -Context {K : realType} {n : nat}. - -Definition sphere r := [set x : 'rV[K]_n | `|x| = r]. - -Lemma sphere_nonempty r : n != 0 -> 0 < r -> sphere r !=set0. -Proof. -move=> n0 r_gt0. -rewrite /sphere. -exists (const_mx r). -rewrite /sphere /= /normr/=. -(* TODO: need lemma? *) -rewrite mx_normrE/=. -apply/eqP; rewrite eq_le; apply/andP; split. - apply: bigmax_le. - exact: ltW. - by move=> i _; rewrite mxE gtr0_norm. -under eq_bigr do rewrite mxE gtr0_norm//. -apply/le_bigmax => /=. -destruct n as [|n'] => //. -exact: (ord0, ord0). -Qed. - -Lemma compact_sphere r : compact (sphere r). -Proof. -apply: bounded_closed_compact. - suff : \forall M \near +oo, forall p, sphere r p -> forall i, `|p ord0 i| < M. - rewrite /bounded_set; apply: filter_app; near=> M0. - move=> Kbnd /= p /Kbnd ltpM0. - rewrite /normr/= mx_normrE. - apply/bigmax_leP; split => //= i _. - by rewrite ord1; exact/ltW/ltpM0. - near=> M => v. - rewrite /sphere /= => vr i. - rewrite (@le_lt_trans _ _ r)//. - rewrite -vr [leRHS]/normr/= mx_normE. - under eq_bigr do rewrite ord1. - rewrite -(pair_big xpredT xpredT (fun _ j => `|v ord0 j|%:nng))//=. - rewrite big_ord_recr/= big_ord0. - rewrite max_r; last exact/bigmax_ge_id. - rewrite (bigD1 i)//= -maxE le_max. - by apply/orP; left. - clear v vr i. - by near: M; apply: nbhs_pinfty_gt; rewrite num_real. -pose d := fun x : 'rV[K]_n => `|x| : K. -have contd : continuous d by move=> /= z; exact: norm_continuous. -rewrite [X in closed X](_ : _ = d @^-1` [set r]); last first. - by apply/seteqP; split. -by apply continuous_closedP. -Unshelve. all: by end_near. Qed. - -End sphere. - Section about_Lyapunov_function. Context {K : realType} {n : nat}. Let U := 'rV[K]_n.+1. @@ -404,6 +336,63 @@ Qed. End about_Lyapunov_function. +(* TODO: move *) +Section sphere. +Context {R : realType} {n : nat}. +Local Open Scope classical_set_scope. + +Definition sphere r := [set x : 'rV[R]_n | `|x| = r]. + +Lemma sphere_nonempty r : n != 0 -> 0 < r -> sphere r !=set0. +Proof. +move=> n0 r_gt0. +rewrite /sphere. +exists (const_mx r). +rewrite /sphere /= /normr/=. +(* TODO: need lemma? *) +rewrite mx_normrE/=. +apply/eqP; rewrite eq_le; apply/andP; split. + apply: bigmax_le. + exact: ltW. + by move=> i _; rewrite mxE gtr0_norm. +under eq_bigr do rewrite mxE gtr0_norm//. +apply/le_bigmax => /=. +destruct n as [|n'] => //. +exact: (ord0, ord0). +Qed. + +Lemma compact_sphere r : compact (sphere r). +Proof. +apply: bounded_closed_compact. + suff : \forall M \near +oo, forall p, sphere r p -> + forall i, `|p ord0 i| < M. + rewrite /bounded_set. + apply: filter_app; near=> M0. + move=> Kbnd /= p /Kbnd ltpM0. + rewrite /normr/= mx_normrE. + apply/bigmax_leP; split => //= i _. + by rewrite ord1; exact/ltW/ltpM0. + near=> M => v. + rewrite /sphere /= => vr i. + rewrite (@le_lt_trans _ _ r)//. + rewrite -vr [leRHS]/normr/= mx_normE. + under eq_bigr do rewrite ord1. + rewrite -(pair_big xpredT xpredT (fun _ j => `|v ord0 j|%:nng))//=. + rewrite big_ord_recr/= big_ord0. + rewrite max_r; last exact/bigmax_ge_id. + rewrite (bigD1 i)//= -maxE le_max. + by apply/orP; left. + clear v vr i. + by near: M; apply: nbhs_pinfty_gt; rewrite num_real. +pose d := fun x : 'rV[R]_n => `|x| : R. +have contd : continuous d by move=> /= z; exact: norm_continuous. +rewrite [X in closed X](_ : _ = d @^-1` [set r]); last first. + by apply/seteqP; split. +by apply continuous_closedP. +Unshelve. all: by end_near. Qed. + +End sphere. + Section Lyapunov_stability. Context {R : realType} {n : nat}. Let U := 'rV[R]_n.+1. @@ -629,8 +618,8 @@ split. - move=> [u0Init issol]; split. move: u0Init; rewrite !inE/= => -[v Initv]. by move/subr0_eq => <-. - move=> Delta /= t t0Delta. - have [Hderivable Hderiv] := issol Delta _ t0Delta. + move=> D /= t t0D. + have [Hderivable Hderiv] := issol D _ t0D. split. exact: derivable_cst. rewrite add0r in Hderiv. @@ -639,12 +628,11 @@ split. move: u0Init; rewrite !inE/= => xInit. exists x => //. by rewrite subrr. - move=> Delta /= t t0Delta. - have [Hderivable Hderiv] := issol Delta _ t0Delta. + move=> D /= t t0D. + have [Hderivable Hderiv] := issol D _ t0D. split. exact: derivable_cst. - rewrite add0r. - by rewrite -Hderiv !derive1_cst. + by rewrite add0r -Hderiv !derive1_cst. Qed. Lemma is_Lyapunov_candidate_substitution V x : From 84a57d66da55963f86ff3aad0f552eda894a97ba Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 20 Feb 2026 14:37:17 +0900 Subject: [PATCH 133/144] change equi pt def --- ode.v | 22 +++++++++++++++------- ode_common.v | 4 ++-- tilt_lyapunov.v | 15 +++++++-------- tilt_stability.v | 28 ++++++++++++++-------------- 4 files changed, 38 insertions(+), 31 deletions(-) diff --git a/ode.v b/ode.v index bcbe68e6..a99825b4 100644 --- a/ode.v +++ b/ode.v @@ -32,7 +32,7 @@ Require Import tilt_mathcomp tilt_analysis ode_common ode_contfun. (* picard_fun lip2 cont1 g == same as picard_fun_subdef when *) (* g @` `[a, b] `<=` closed_ball u0 r and cst 0 o.w. *) (* *) -(* Technical constants need for the proof: *) +(* Technical constants needed for the proof: *) (* sup_phi == sup {phi t u0 | t \in [a, b]} *) (* safe_dist == min (b - a, r / (k * r + sup_phi), rho / k) *) (* upper-bound of delta *) @@ -1122,8 +1122,19 @@ Definition sol_is_deriv_cbnd (a : R) (b : itv_bound R) (f : R -> U) := Definition sol_is_deriv_co a b := sol_is_deriv_cbnd a (BLeft b). +Definition sol_is_deriv_cy a := sol_is_deriv_cbnd a +oo%O. + +Lemma sol_is_deriv_cy_co a b : sol_is_deriv_cy a `<=` + sol_is_deriv_cbnd a (BLeft b). +Proof. +move=> f H t tab. +apply H. +exact: subset_itvl tab. +Qed. + Definition sol_is_deriv_obnd (a : R) (b : itv_bound R) (f : R -> U) := - {in Interval (BRight a) b, forall t, derivable f t 1 /\ f^`() t = phi t (f t)}. + {in Interval (BRight a) b, + forall t, derivable f t 1 /\ f^`() t = phi t (f t)}. Definition sol_is_deriv_oo a b := sol_is_deriv_obnd a (BLeft b). @@ -1545,10 +1556,6 @@ Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Variable rho : {posnum R}. Hypothesis rho1 : rho%:num < 1. -(* Let rho : {posnum R} := (2^-1)%:pos. *) - -(* Let rho1 : rho%:num < 1. *) -(* Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. *) Local Notation safe_dist := (safe_dist phi a b k u0 r rho). @@ -1712,7 +1719,8 @@ Lemma initial_solution_unique f' : {within `[a, b], continuous f'} -> {in `[a, a + D%:num]%R, forall t, closed_ball u0 r%:num (f t)}. Proof. move => cf' sol2. -suff [rho [D [Hrho [Db P1 P2]]]] : exists rho D : {posnum R}, exists (Hrho : rho%:num < 1), +suff [rho [D [Hrho [Db P1 P2]]]] : exists rho D : {posnum R}, + exists (Hrho : rho%:num < 1), [/\ D%:num <= dmax rho, {in `[a, a + D%:num]%R, f =1 fc Hrho } & {in `[a, a + D%:num]%R, f' =1 fc Hrho} ]. diff --git a/ode_common.v b/ode_common.v index a26d0d0a..c0c938ae 100644 --- a/ode_common.v +++ b/ode_common.v @@ -1,6 +1,6 @@ From HB Require Import structures. -From mathcomp Require Import all_boot all_order ssralg ssrnum matrix interval poly. -From mathcomp Require Import generic_quotient ring_quotient. +From mathcomp Require Import all_boot all_order ssralg ssrnum matrix interval. +From mathcomp Require Import poly generic_quotient ring_quotient. From mathcomp Require Import mathcomp_extra unstable boolp classical_sets. From mathcomp Require Import constructive_ereal. From mathcomp Require Import functions reals interval_inference topology. diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index 4cbe36f3..c7bad511 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -351,11 +351,11 @@ Definition eqn_functional (f : R -> 'rV[R]_6) : R -> 'rV[R]_6 := (- alpha1 *: error1_p_dot t) (PhysicalModel.eqn14b_rhs gamma (error1_p_dot t) (error2_p_dot t)). -Definition eqn (dot_zp1_z2 : 'rV[R]_6) : 'rV[R]_6 := - let dot_zp1 := Left dot_zp1_z2 in - let dot_z2 := Right dot_zp1_z2 in - row_mx (- alpha1 *: dot_zp1) - (PhysicalModel.eqn14b_rhs gamma dot_zp1 dot_z2). +Definition eqn (dot_z1_z2 : 'rV[R]_6) : 'rV[R]_6 := + let dot_z1 := Left dot_z1_z2 in + let dot_z2 := Right dot_z1_z2 in + row_mx (- alpha1 *: dot_z1) + (PhysicalModel.eqn14b_rhs gamma dot_z1 dot_z2). Lemma eqnE (f : R -> 'rV[R]_6) t : eqn (f t) = eqn_functional f t. Proof. by []. Qed. @@ -596,7 +596,7 @@ Lemma equilibrium_point1 : is_equilibrium_point phi Tilt.Upsilon1 Tilt.point1. Proof. split. - exact: tilt_point1_in_state_space. -- move=> D t t0D. +- move=> t t0. split; first exact: derivable_cst. rewrite derive1E derive_cst /Tilt.point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP; split. @@ -623,8 +623,7 @@ Qed. Lemma equilibrium_point2 : is_equilibrium_point phi Tilt.Upsilon1 Tilt.point2. Proof. split; first exact: tilt_point2_in_state_space. -move=> Delta. -move=> t t0Delta. +move=> D D0. split; first exact: derivable_cst. rewrite derive1E derive_cst; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. diff --git a/tilt_stability.v b/tilt_stability.v index 0ac15f0e..621720b1 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -218,12 +218,13 @@ Let U := 'rV[R]_n. Variable phi : U -> U. Definition is_equilibrium_point (Init : set U) (x : U) := - x \in Init /\ forall d, sol_is_deriv_co (fun=> phi) 0 d (cst x). + x \in Init /\ sol_is_deriv_cy (fun=> phi) 0 (cst x). Lemma equilibrium_point_in_state_space (Init : set U) : is_equilibrium_point Init `<=` state_space phi Init. Proof. move=> x [xinit solf]; exists (cst x), 1; split => //=. + exact: sol_is_deriv_cy_co. by exists 0 => //; rewrite bound_itvE. Qed. @@ -618,21 +619,20 @@ split. - move=> [u0Init issol]; split. move: u0Init; rewrite !inE/= => -[v Initv]. by move/subr0_eq => <-. - move=> D /= t t0D. - have [Hderivable Hderiv] := issol D _ t0D. - split. - exact: derivable_cst. - rewrite add0r in Hderiv. - by rewrite -Hderiv !derive1_cst. + move=> /= t t0. + split; first exact: derivable_cst. + have := issol 0. + rewrite in_itv/= lexx => /(_ isT)[_]. + rewrite add0r => <-. + by rewrite !derive1_cst. - move=> [u0Init issol]; split. move: u0Init; rewrite !inE/= => xInit. - exists x => //. - by rewrite subrr. - move=> D /= t t0D. - have [Hderivable Hderiv] := issol D _ t0D. - split. - exact: derivable_cst. - by rewrite add0r -Hderiv !derive1_cst. + by exists x => //; rewrite subrr. + move=> t t0. + split; first exact: derivable_cst. + have [_] := issol _ t0. + rewrite /= add0r => <-. + by rewrite !derive1_cst. Qed. Lemma is_Lyapunov_candidate_substitution V x : From 6731fe2d99ff1328af3bb6108f206acbee884757 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 20 Feb 2026 15:08:43 +0900 Subject: [PATCH 134/144] left-end in is_stable_at --- tilt_lyapunov.v | 14 +++++++------- tilt_stability.v | 33 +++++++++++++++++---------------- 2 files changed, 24 insertions(+), 23 deletions(-) diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index c7bad511..f1c81e1e 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -1276,21 +1276,21 @@ Proof. move=> Init0 openInit Init_in_state. apply: (@Lyapunov_stability R _ phi Init openInit (Tilt.V1 alpha1 gamma)). - exact: V1_diff. -- move=> D /= sol sol0 solP t t0. - apply: (@derive_along_V1_le0 _ _ _ _ _ D sol) => //. +- move=> D /= f f0 sol_f t t0. + apply: (@derive_along_V1_le0 _ _ _ _ _ D f) => //. + rewrite inE. apply: Init_in_state. - by rewrite inE in sol0. + exact/set_mem. + move=> /= t1 t10D. apply/derivable1_diffP. - apply solP. + apply sol_f. by apply: subset_itvr t10D; rewrite bnd_simp. - have := V1_is_Lyapunov_candidate alpha1_gt0 gamma_gt0. - rewrite /is_Lyapunov_candidate /Tilt.point1 => Hpos. + rewrite /is_Lyapunov_candidate /Tilt.point1 => H. rewrite /Tilt.V1 lsubmx_const rsubmx_const; split => //. + by rewrite !expr2 !enorm0 !mulr0 !mul0r add0r. - + move=> z zin z_neq0. - case: Hpos => // _ [V1_eq0]. + + move=> z zInit z_neq0. + case: H => // _ _. by apply => //; rewrite in_setT. Qed. diff --git a/tilt_stability.v b/tilt_stability.v index 621720b1..453a9c2a 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -251,13 +251,13 @@ Variable Init : set U. Definition is_stable_at (x : U) := forall eps, eps > 0 -> exists2 d, d > 0 & forall f D, f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> - `| f 0 - x | < d -> forall t, t \in `]0, D[%R -> `| f t - x | < eps. + `| f 0 - x | < d -> forall t, t \in `[0, D[%R -> `| f t - x | < eps. (* assuming solution exists for all time *) Definition is_global_time_stable_at (x : U) := forall eps, eps > 0 -> exists2 d, d > 0 & forall f, f 0 \in Init -> sol_is_deriv_c0y phi f -> - `| f 0 - x | < d -> forall t, 0 < t -> `| f t - x | < eps. + `| f 0 - x | < d -> forall t, 0 <= t -> `| f t - x | < eps. Lemma stable_global_time : is_stable_at `<=` is_global_time_stable_at. Proof. @@ -466,7 +466,7 @@ have Omega_beta_Br : Omega_beta `<=` (B r)°. (* any trajectory starting in Omega_beta at t = 0 stays in Omega_beta for all t >= 0 *) have Df_Omega_beta D f : f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> - f 0 \in Omega_beta -> forall t, t \in `]0, D[%R -> f t \in Omega_beta. + f 0 \in Omega_beta -> forall t, t \in `[0, D[%R -> f t \in Omega_beta. move=> f0 solf f0_Omega. have /= V_nincr_consequence t : t \in `]0, D[%R -> forall u, 0 <= u <= t -> 'D~(f) V u <= 0 -> V (f t) <= V (f 0) <= beta. @@ -479,7 +479,11 @@ have Df_Omega_beta D f : f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> + by rewrite (itvP t0D). + by rewrite lexx/= (itvP t0D). - by move: f0_Omega; rewrite inE => -[]. - move=> t t0D; rewrite inE; split; last first. + move=> t t0D. + have [->//|t0] := eqVneq t 0. + have {t0}t0D : t \in `]0, D[%R. + by rewrite in_itv/= lt_neqAle eq_sym t0/= 2!(itvP t0D). + rewrite inE; split; last first. have : 'D~(f) V t <= 0 by exact: (DV_le0 _ solf). have := @V_nincr_consequence t t0D t. rewrite lexx (itvP t0D)/= => /(_ isT) => /[apply]. @@ -534,7 +538,8 @@ have _ : compact Omega_beta. have [d0 d0_gt0 Vbeta] : exists2 d, d > 0 & forall x, `|x| <= d -> V x < beta. have [d d_gt0 xdV] : exists2 d, 0 < d & forall y, `|y - 0| < d -> `|V y - V 0| < beta. - have /cvgrPdist_lt /(_ _ beta_gt0) : V x @[x --> nbhs (0 : 'rV_n.+1) ] --> V 0. + have /cvgrPdist_lt /(_ _ beta_gt0) : + V x @[x --> nbhs (0 : 'rV_n.+1) ] --> V 0. exact/differentiable_continuous/Vdiff. rewrite nearE /= => /nbhs_ballP[d /= d_pos xdV]. exists d => // y. @@ -562,8 +567,8 @@ have : f 0 \in Omega_beta. rewrite inE; apply: B_delta_Omega_beta. rewrite /B /closed_ball_/= sub0r normrN; apply/ltW. by rewrite subr0 in f0xD. -rewrite inE => -[+ _]. -rewrite /B /closed_ball_/= sub0r normrN => solx0r. +rewrite inE => -[+ Vf0beta]. +rewrite /B /closed_ball_/= sub0r normrN => f0r. have : (B r)° (f t0). apply: Omega_beta_Br; apply/set_mem. apply: (Df_Omega_beta D') => //. @@ -573,7 +578,7 @@ have : (B r)° (f t0). by rewrite subr0 in f0xD. by move/B_delta_Omega_beta => []. rewrite BE//= interior_closed_ballE//=. -rewrite mx_norm_ball /ball_/= sub0r normrN => /lt_le_trans; exact. +by rewrite mx_norm_ball /ball_/= sub0r normrN => /lt_le_trans; exact. Unshelve. all: by end_near. Qed. End Lyapunov_stability. @@ -703,15 +708,11 @@ apply: (@Lyapunov_stability0 _ _ _ _ _ (fun y => V (y + x))). by []. apply: (@V'_le0 D); last by assumption. - rewrite inE/=. - move: sol0. - rewrite inE/= => -[x0 x0Init <-]. + move: sol0; rewrite inE/= => -[x0 x0Init <-]. by rewrite subrK. - - move=> /= z z0D. - split. - apply/derivable1_diffP. - apply: differentiable_comp => //. - apply/derivable1_diffP. - by apply sol0Init. + - move=> /= z z0D; split. + apply/derivable1_diffP/differentiable_comp => //. + by apply/derivable1_diffP; apply sol0Init. rewrite derive1E deriveD//; last by apply sol0Init. rewrite derive_cst addr0 -derive1E. by apply sol0Init. From edd5a8cb3abdd7662470e810cc223aa91de7d40e Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Fri, 20 Feb 2026 15:31:00 +0900 Subject: [PATCH 135/144] unique solution --- ode.v | 193 +++++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 151 insertions(+), 42 deletions(-) diff --git a/ode.v b/ode.v index a99825b4..387eaf9c 100644 --- a/ode.v +++ b/ode.v @@ -1557,11 +1557,42 @@ Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. Variable rho : {posnum R}. Hypothesis rho1 : rho%:num < 1. -Local Notation safe_dist := (safe_dist phi a b k u0 r rho). +Let r2 := (r%:num/2)%:pos. +Let B2 := closed_ball u0 r2%:num. + +Let ler2 : r2%:num <= r%:num. +Proof. by rewrite /r2/= ler_pdivrMr // ler_pMr // lerDl. Qed. + +Let lip2' : {in `[a, b]%R, forall x, k.-lipschitz_B2 (phi x)}. +Proof. +move => x abx /= y By. +apply: lip2. +by move : abx; rewrite !inE/=; apply subset_itvr. +split. +by apply /le_closed_ball/By.1. +by apply /le_closed_ball/By.2. +Qed. + +Let cont1': {in B2, forall y, {within `[a, b], continuous phi ^~ y}}. +Proof. +move => /= x Bx. +apply /continuous_subspaceW/cont1. +by []. +apply mem_set. +apply set_mem in Bx. +by apply /le_closed_ball/Bx. +Qed. + +(* Let rho : {posnum R} := (2^-1)%:pos. *) + +(* Let rho1 : rho%:num < 1. *) +(* Proof. by rewrite /rho/= invf_lt1// ltr1n. Qed. *) + +Local Notation safe_dist := (safe_dist phi a b k u0 r2 rho). Definition cauchy_lipschitz_f : continuousFunType `[a, a + safe_dist] [set: 'rV[R]_n] := - repr (picard_fix ab k0 lip2 cont1 rho1). + repr (picard_fix ab k0 lip2' cont1' rho1). Lemma is_sol_cauchy_lipschitz_f : is_sol_oo phi u0 a (a + safe_dist) cauchy_lipschitz_f. @@ -1577,15 +1608,21 @@ apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. apply: subset_itvl => //=. by rewrite bnd_simp -lerBrDl safe_dist_itv. - exact: cts_fun. -- by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. +- apply (subset_trans (B:=B2)). + by move => _ [t tad] <-;apply: cauchy_lipschitz_in_cball. + by apply le_closed_ball. - exact: cauchy_lipschitz_integral_version. Qed. -Lemma solution_stays_in_ball : +Lemma solution_stays_in_ball2 : {in `[a, a + safe_dist]%R, - forall t, closed_ball u0 r%:num (cauchy_lipschitz_f t)}. + forall t, closed_ball u0 r2%:num (cauchy_lipschitz_f t)}. Proof. by move=> t; move => /cauchy_lipschitz_in_cball; exact. Qed. +Lemma solution_stays_in_ball : + {in `[a, a + safe_dist]%R, + forall t, closed_ball u0 r%:num (cauchy_lipschitz_f t)}. +Proof. Admitted. Lemma solution_continuous : {within `[a, a + safe_dist], continuous cauchy_lipschitz_f}. Proof. exact: cts_fun. Qed. @@ -1605,16 +1642,18 @@ apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. apply: subset_itvl => //=. by rewrite bnd_simp -lerBrDl safe_dist_itv. - exact: cts_fun. -- by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. +- apply (subset_trans (B:=B2)). + by move => _ [t tad] <-;apply: cauchy_lipschitz_in_cball. + by apply le_closed_ball. - exact: cauchy_lipschitz_integral_version. Qed. Local Notation V := (@ContSeg_quot.quot_contSeg R a (a + safe_dist) U). -Theorem cauchy_lipschitz_unique f' : +Lemma cauchy_lipschitz_unique f' : {within `[a, a + safe_dist], continuous f'} -> - {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (f' t)} -> + {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r2%:num (f' t)} -> is_sol_oo phi u0 a (a + safe_dist) f' -> {in `[a, a + safe_dist]%R, f =1 f'}. Proof. @@ -1627,7 +1666,9 @@ move/(@integral_sol_iff_sol _ _ _ _ _ _ _ _ r k0') => []//. - move=> /= x xB. apply/continuous_subspaceW/cont1 => //. by apply: subset_itvl => //=; rewrite bnd_simp -lerBrDl safe_dist_itv. -- by move => _ [t tad] <-;apply bnd;rewrite inE. + apply (subset_trans (B:=B2)). + by move => _ [t tad] <-;apply: bnd. + by apply le_closed_ball. move=> f'au0 h1 t tab. have fc : contseg a (a + safe_dist) f' by exact: mem_set. have pieq : \pi_V%qT f = \pi_V%qT (contseg_Sub fc). @@ -1710,13 +1751,14 @@ Hypothesis cf : {within `[a, b], continuous f}. Hypothesis sol1 : is_sol_oo phi u0 a b f. Let rho_max : {posnum R} := (2^-1)%:pos. -Let dmax rho := safe_dist phi a b k u0 r rho. +Let r2 := (r%:num/2)%:pos. +Let dmax rho := safe_dist phi a b k u0 r2 rho. Let fc := cauchy_lipschitz_f ab k0 lip2 cont1. Lemma initial_solution_unique f' : {within `[a, b], continuous f'} -> is_sol_oo phi u0 a b f' -> exists D : {posnum R}, {in `[a, a + D%:num]%R, f =1 f'} /\ - {in `[a, a + D%:num]%R, forall t, closed_ball u0 r%:num (f t)}. + {in `[a, a + D%:num]%R, forall t, closed_ball u0 (r2%:num) (f t)}. Proof. move => cf' sol2. suff [rho [D [Hrho [Db P1 P2]]]] : exists rho D : {posnum R}, @@ -1726,10 +1768,10 @@ suff [rho [D [Hrho [Db P1 P2]]]] : exists rho D : {posnum R}, {in `[a, a + D%:num]%R, f' =1 fc Hrho} ]. exists D; split => t tab; first by rewrite P1// P2. rewrite P1//. - apply: solution_stays_in_ball. + apply: solution_stays_in_ball2. by move: tab; rewrite !inE; apply: subset_itvl; rewrite bnd_simp lerD2l. -have [d1 D1] := continuous_confined r ab cf (And31 sol1). -have [d2 D2] := continuous_confined r ab cf' (And31 sol2). +have [d1 D1] := continuous_confined r2 ab cf (And31 sol1). +have [d2 D2] := continuous_confined r2 ab cf' (And31 sol2). have [rho [drho1 drho2]] : exists rho, dmax rho <= (Num.min d1%:num d2%:num) /\ rho%:num < 1. rewrite /dmax/safe_dist. have posk : 0 < Num.min rho_max%:num (Num.min (k * rho_max%:num) (k * (Num.min d1%:num d2%:num))). @@ -1749,7 +1791,7 @@ exists rho, (PosNum drho_pos), drho2; split => //. apply: subset_itvl => //=. by rewrite bnd_simp -lerBrDl;apply safe_dist_itv. - move=> t0 t0ad. - suff : f t0 \in closed_ball u0 r%:num by rewrite inE. + suff : f t0 \in closed_ball u0 r2%:num by rewrite inE. apply D1. move: t0ad; rewrite !inE/=; apply: subset_itvl; rewrite bnd_simp/=. by rewrite lerD2l// (le_trans drho1)// ge_min lexx. @@ -1766,7 +1808,7 @@ apply/esym; apply : cauchy_lipschitz_unique. - apply/continuous_subspaceW/cf' => //. by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl;apply safe_dist_itv. - move=> t0 t0ad. - suff : f' t0 \in closed_ball u0 r%:num by rewrite inE. + suff : f' t0 \in closed_ball u0 r2%:num by rewrite inE. apply D2. move: t0ad; rewrite !inE; apply: subset_itvl; rewrite bnd_simp lerD2l. by rewrite (le_trans drho1)// ge_min lexx orbT. @@ -1786,26 +1828,27 @@ End solution_locally_unique. Definition locally_lipschitz {R : realType} n (U := 'rV[R]_n) (phi : U -> U) := forall x, exists r k : {posnum R}, k%:num.-lipschitz_(closed_ball x r%:num) phi. -Section uniqueness. -Context {R : realType} {n : nat} (a b : R). +Section loc_lip_uniqueness. +Context {R : realType} {n : nat} (a b : R) (r0 : {posnum R}). Notation U := 'rV[R]_n. Variable phi : R -> U -> U. Hypothesis ab : a < b. +Variable (u0 : U). + +Let B := closed_ball u0 r0%:num. -Variables (u0 : U). -Hypothesis cont1 : forall y, {within `[a, b], continuous phi ^~ y}. -(* TODO(urgent): replace loclip w*) -Hypothesis phi_loclip : forall x, exists r k : {posnum R}, - forall t, k%:num.-lipschitz_(closed_ball x r%:num) (phi t). Variables (f : R -> U) (f' : R -> U). Hypothesis sol1 : is_sol_oo phi u0 a b f. Hypothesis sol2 : is_sol_oo phi u0 a b f'. +Hypothesis sol1B : forall t, a <= t -> t < b -> B (f t). +Hypothesis phi_local_conds :forall t, a <= t -> t < b -> exists r k : {posnum R}, + forall t', a <= t' <= b -> (k%:num.-lipschitz_(closed_ball (f t) r%:num) (phi t') /\ forall y, closed_ball (f t) r%:num y -> {within `[a, b], continuous phi ^~ y}). -Local Lemma cauchy_lipschitz_unique_right_extension t : a <= t < b -> f' t = f t -> +Local Lemma cauchy_lipschitz_unique_right_extension t : a <= t < b -> f' t = f t -> exists Delta : {posnum R}, {in `[t, t + Delta%:num]%R, f =1 f'}. Proof. move=> /andP[ta tb] eq. -have [r [k L]] := phi_loclip (f t). +have [r [k L]] := phi_local_conds ta tb. have taab : `[t, b] `<=` `[a, b]. by move=> ?/=; apply: subset_itvr; rewrite bnd_simp. have cf0 : {within `[t, b], continuous f}. @@ -1825,11 +1868,18 @@ have sol20 : is_sol_oo phi (f t) t b f'. apply sol2. by move: tab; rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. have lip20 : {in `[t, b]%R, forall x, k%:num.-lipschitz_(closed_ball (f t) r%:num) (phi x)}. - by move => t0 _;apply L. + move => t0 tab; apply L. + move :tab; rewrite in_itv/= => /andP[h1 ->//=]. + by rewrite (le_trans _ h1). have cont1' : {in closed_ball (f t) r%:num, forall y : 'rV_n, {within `[t, b], continuous phi^~ y}}. move => y ytb. - apply /continuous_subspaceW/cont1. + have : {within `[a,b], continuous phi^~ y}. + have [| _ +] := L t. + by rewrite ta ltW. + apply. + by apply set_mem. + apply /continuous_subspaceW. by apply subset_itvr. have k0 : 0 < k%:num by []. have [D [P1 P2]] := initial_solution_unique tb k0 lip20 cont1' cf0 sol10 cf'0 sol20. @@ -1948,6 +1998,74 @@ apply: Hdelta; rewrite in_itv/= ltW//=. by move: ta; rewrite in_itv/= le_min => /and3P[_]. Unshelve. all: by end_near. Qed. +End loc_lip_uniqueness. + +Section uniqueness. +Context {R : realType} {n : nat}. +Notation U := 'rV[R]_n. +Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}). +Hypothesis ab : a < b. +Hypothesis k0 : 0 < k. +Let B := closed_ball u0 r%:num. +Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. +Hypothesis cont1 : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. + +Let r2 := (r%:num/2)%:pos. +Variable rho : {posnum R}. (* rho < 1 *) +Hypothesis rho1 : (rho%:num < 1). +Local Notation safe_dist := (safe_dist phi a b k u0 r2 rho). +Let f := cauchy_lipschitz_f ab k0 lip2 cont1 rho1. + +Lemma closed_ball_split (x1 x2 y : U) q : 0 < q -> + closed_ball x1 (q / 2) y -> closed_ball x2 (q / 2) x1 -> closed_ball x2 q y. +Proof. +move => hq. +have hq2 : 0 < q / 2 by rewrite divr_gt0. +rewrite !closed_ballE// /closed_ball_ /= => h1 h2. +rewrite -(subrKA x1 x2). +by rewrite (le_trans (ler_normD _ _))// (splitr q) lerD. +Qed. +Theorem cauchy_lipschitz_unique' f' : + is_sol_oo phi u0 a (a + safe_dist) f' -> + {in `[a, a + safe_dist]%R, f =1 f'}. +Proof. +move => sol1. +have cont1' : forall y , B y -> {within `[a, (a + safe_dist)%E], continuous phi^~ y}. + move => y By . + apply /continuous_subspaceW/cont1. + apply subset_itvl. + rewrite bnd_simp -lerBrDl; apply safe_dist_itv. + by apply mem_set. +apply: (locally_cauchy_lipschitz_unique _ _ (u0 := u0) sol1 ) => //. +exact: ltDl_safe_dist. +exact: is_sol_cauchy_lipschitz_f. +move => t tad tbd. +have [r' rp] : exists (r' : {posnum R}), closed_ball (f t) r'%:num `<=` closed_ball u0 r%:num. + exists r2. + move => x x0. + have sb: closed_ball u0 (r%:num / 2) (f t). + apply solution_stays_in_ball2=> //. + by rewrite in_itv/= tad//= ltW. + apply/closed_ball_split/sb => //. +exists r',(PosNum k0). +move => t' /andP[at' bt']. +split. +move => /=[x1 x2] [Bx1 Bx2]. +apply lip2. +rewrite in_itv/= at' //=. +apply (le_trans bt'). +rewrite -lerBrDl. +apply safe_dist_itv. +split => /=;by apply rp. +move => y By. +have h : y \in B. + apply mem_set. + by apply: rp. +have := (cont1 h). +apply /continuous_subspaceW. +apply: subset_itvl. +rewrite bnd_simp -lerBrDl; apply safe_dist_itv. +Qed. End uniqueness. Section cauchy_lipschitz_symmetric. @@ -1975,15 +2093,6 @@ Proof. by rewrite xs. Qed. -Lemma closed_ball_split (x1 x2 y : U) q : 0 < q -> - closed_ball x1 (q / 2) y -> closed_ball x2 (q / 2) x1 -> closed_ball x2 q y. -Proof. -move => hq. -have hq2 : 0 < q / 2 by rewrite divr_gt0. -rewrite !closed_ballE// /closed_ball_ /= => h1 h2. -rewrite -(subrKA x1 x2). -by rewrite (le_trans (ler_normD _ _))// (splitr q) lerD. -Qed. Let r2 := (r%:num/2)%:pos. Let r4 := (r%:num/4)%:pos. @@ -2050,8 +2159,8 @@ by apply : le_closed_ball By. apply. Qed. -Let dplus t0 := safe_dist phi t0 b k u0 (r4%:num)%:pos rho. -Let dminus t0 := safe_dist (fun t x => - phi (-t) x) (-t0) (-a) k u0 (r4%:num)%:pos rho. +Let dplus t0 := safe_dist phi t0 b k u0 (r4%:num/2)%:pos rho. +Let dminus t0 := safe_dist (fun t x => - phi (-t) x) (-t0) (-a) k u0 (r4%:num/2)%:pos rho. Let dboth t0 := Num.min (b - t0) (Num.min (dplus t0) (dminus t0)). Section cauchy_lipschitz_sym. @@ -2143,7 +2252,7 @@ have contf : {within `[t0 - dboth t0, (t0 + dboth t0)%E], continuous f}. apply : within_continuous_patch => //. by rewrite gtrBl. by rewrite ltrDl. -have r42 : r4%:num = (r2%:num / 2). +have r42 : r4%:num = (r2%:num / 2). rewrite /r4/r2/=. rewrite -mulrA. apply congr2 => //. @@ -2170,7 +2279,8 @@ have fc : {in `[t0-dboth t0, (t0 + dboth t0)], rewrite !r42. move => c2. by apply: (closed_ball_split _ c2) =>//. - - have : (fplus t) \in closed_ball u0 (r4%:num). + - have : (fplus t) \in closed_ball u0 (r2%:num/2). + rewrite -r42. have ht' : t \in `[t0, t0 + dboth t0]. have := tad. rewrite !inE /=!in_itv/= => /andP[h1 ->]; apply /andP; split => //. @@ -2182,8 +2292,7 @@ have fc : {in `[t0-dboth t0, (t0 + dboth t0)], rewrite inE/= !in_itv/= => /andP[-> h1//=]. apply: (le_trans h1). by rewrite lerD // /dboth /dplus 2!ge_min lexx !orbT. - rewrite inE. - rewrite !r42. + rewrite inE. move => c2. by apply: (closed_ball_split _ c2). split => //. From d0f4c4fbc00f2f7455376548f25eedb9e71dc382 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 20 Feb 2026 15:32:39 +0900 Subject: [PATCH 136/144] ano --- tilt_lyapunov.v | 46 ++++++---------------------------------------- 1 file changed, 6 insertions(+), 40 deletions(-) diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index f1c81e1e..745e201a 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -43,7 +43,7 @@ Import numFieldNormedType.Exports. Local Open Scope ring_scope. Local Open Scope classical_set_scope. -Definition S2 {K : realType} := [set x : 'rV[K]_3 | `|x|_e = 1]. +Definition S2 {R : realType} := [set x : 'rV[R]_3 | `|x|_e = 1]. Module PhysicalModel. Section physicalmodel. @@ -802,40 +802,6 @@ Definition V1dot (zp1_z2 : 'rV[R]_6) : R := End V1. -Section hurwitz. -Context {K : realType}. - -(* thm 4.6 p136*) -Definition hurwitz n (A : 'M[K]_n) : Prop := - (forall a, eigenvalue A a -> a < 0). - -(* thm 4.7 p139 + fact: it is exponentially stable*) -Definition locally_exponentially_stable_at n (eqn : 'rV[K]_n -> 'rV[K]_n) - (point : 'rV[K]_n) : Prop := - hurwitz (jacobian eqn point). - -(* TODO: rm? *) -(* lynda : future work ? *) -Lemma tilt_eqn_is_locally_exponentially_stable_at_0 alpha1 gamma : - locally_exponentially_stable_at (Tilt.eqn alpha1 gamma) Tilt.point1. -Proof. -rewrite /locally_exponentially_stable_at /jacobian /hurwitz. -rewrite /lin1_mx/= /Tilt.eqn /PhysicalModel.eqn14b_rhs/=. -move => a. -move/eigenvalueP => [u] /[swap] u0 H. -have a_eigen : eigenvalue (jacobian (Tilt.eqn alpha1 gamma) Tilt.point1) a. - apply/eigenvalueP. - exists u. - exact: H. - exact: u0. -have : root (char_poly (jacobian (Tilt.eqn alpha1 gamma) Tilt.point1)) a. - rewrite -eigenvalue_root_char. - exact : a_eigen. -rewrite /Tilt.eqn /jacobian. -Abort. - -End hurwitz. - Section tilt_eqn_Lyapunov. Local Open Scope classical_set_scope. Context {R : realType}. @@ -905,7 +871,7 @@ Lemma angvel_sqr (sol : R -> 'rV_6) (z : R) (z2 := fun r : R => Right (sol r) : sol_is_deriv_co (fun=> phi) 0 D sol -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. -move=> z0Delta sol0 dtraj. +move=> z0D sol0 dtraj. rewrite /dotmul !trmx_mul !tr_spin !mulNmx mulmxN opprK mulmxN !dotmulP. have key_ortho : (z2 z *m \S('e_2)) *d u = 0. by rewrite dotmulC; exact/ortho_spin. @@ -1106,9 +1072,9 @@ Proof. move=> sol0 solP diff t t0. rewrite derive_along_V1//; last 2 first. by rewrite inE/= in_itv/=. - move=> t1 t10Delta. + move=> t1 t10D. apply: diff => //. - by rewrite inE/= in_itv/= in t10Delta. + by rewrite inE/= in_itv/= in t10D. have /(V1dot_ub sol0 solP) : t \in `[0, D[%R. by apply: subset_itvr t0; rewrite bnd_simp. move/le_trans; apply. @@ -1241,9 +1207,9 @@ have diff : forall (t : R), 0 <= t -> differentiable sol t. by apply solves. move => t t0. rewrite derive_along_V1_global//. -have t0Delta : t \in `[0, t+1[%R. +have t0D : t \in `[0, t + 1[%R. by rewrite in_itv/=t0 ltrDl ltr01. -have Hub := V1dot_ub sol0 (@sol_is_deriv_c0yco _ _ _ _ solves (t + 1)) t0Delta. +have Hub := V1dot_ub sol0 (@sol_is_deriv_c0yco _ _ _ _ solves (t + 1)) t0D. apply: (le_trans Hub). have Hquad : let u1 := \row_i [eta fun=> 0 with 0 |-> `|(Left \o sol) t|_e, From c03558eb0119c9591b210bc709479f9d36cbfcfd Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 20 Feb 2026 17:12:38 +0900 Subject: [PATCH 137/144] minor renaming --- tilt_lyapunov.v | 235 ++++++++++++++++++++++++----------------------- tilt_stability.v | 56 ++++++----- 2 files changed, 144 insertions(+), 147 deletions(-) diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index 745e201a..c5b90dcd 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -24,8 +24,8 @@ Require Import ode tilt_stability. (* Tilt.point{1.2} == equilibrium points *) (* Tilt.Upsilon1 == state space *) (* Tilt.eqn == equation (14) in [benallegue2023itac] *) +(* Tilt.V1 == Lyapunov function *) (* u2 == 2 x 2 matrix to prove the Lyapunov function *) -(* V1 == Lyapunov function *) (* ``` *) (* *) (* Reference: *) @@ -378,10 +378,10 @@ Qed. Definition points := [set point1; point2]. -Definition V1 (zp1_z2 : 'rV[R]_6) : R := - let zp1 := Left zp1_z2 in - let z2 := Right zp1_z2 in - `|zp1|_e ^+ 2 / (2 * alpha1) + `|z2|_e ^+ 2 / (2 * gamma). +Definition V1 (z1_z2 : 'rV[R]_6) : R := + let z1 := Left z1_z2 in + let z2 := Right z1_z2 in + `|z1|_e ^+ 2 / (2 * alpha1) + `|z2|_e ^+ 2 / (2 * gamma). End tilt. End Tilt. @@ -465,7 +465,7 @@ rewrite ge_max; apply/andP; split. exact: (le_trans (ler_pM _ _ (le_refl _) h)). by rewrite mulrDl mul1r lerD//; apply sbound. + rewrite (le_trans (mx_norm_mul _ _))//. - rewrite opprB -addrA (addrC (-Left x0)) addrA (addrC (Left x1)) addrA -(addrA (Right x0 - _)). + rewrite opprB -addrA (addrC (-Left x0)) addrA (addrC (Left x1)) addrA -(addrA (Right x0 - _)). rewrite mulrC. apply (@le_trans _ _ (`| d| * (6 * `|x0 - x1|))). apply ler_pM => //. @@ -491,7 +491,8 @@ rewrite /Tilt.Upsilon1. have : {in `]0, D[%R, (fun t => ('e_2 - Right (y t)) *d (('e_2 - Right (y t))))^`() =1 0}. move => x xd /=. - transitivity ((fun t => -2 * (Right(y^`()%classic t) *d ('e_2 - Right (y t)))) x). + transitivity ((fun t => -2 * (Right (y^`()%classic t) *d + ('e_2 - Right (y t)))) x). rewrite !derive1E. have ? : derivable y x 1. apply deri. @@ -503,8 +504,8 @@ have : {in `]0, D[%R, rewrite !mxE /= mulr1n. under eq_fun do rewrite !mxE /= mulr1n. rewrite !derive_dotmul/=; last 2 first. - apply: derivableB => //=; apply : derivable_rsubmx => //=. - by apply: derivableB => //=; apply: derivable_rsubmx. + apply: derivableB => //=; apply: derivable_rsubmx => //=. + by apply: derivableB => //=; exact: derivable_rsubmx. rewrite /dotmul /=. rewrite [in RHS]mulr2n [RHS]mulNr [in RHS]mulrDl. rewrite !mul1r !dotmulP /= dotmulC [in RHS]dotmulC !linearD /=. @@ -512,10 +513,11 @@ have : {in `]0, D[%R, have -> : 'D_1 (fun x0 => 'e_2 - Right (y x0)) x = - Right ('D_1 y x). rewrite deriveB /= ; last 2 first. exact: derivable_cst. - by apply: derivable_rsubmx. + exact: derivable_rsubmx. rewrite derive_cst /= sub0r; congr (- _). exact: derive_rsubmx. - rewrite -(_ : 'D_1 y x = \matrix_(i, j) 'D_1 (fun t0 => y t0 i j) x); last first. + rewrite -(_ : 'D_1 y x = + \matrix_(i, j) 'D_1 (fun t0 => y t0 i j) x); last first. by apply/matrixP => a b; rewrite !mxE derive_mx//= ?mxE. ring. have Rsu t0 : t0 \in `[0, D[%R -> Right (y^`()%classic t0) = @@ -552,8 +554,8 @@ have norm_constant t0 : t0 \in `[0, D[%R -> move=> /= hd0 t0d'. apply/esym. have {}t0d'' : t0 \in `[0, t0]%R by rewrite bound_itvE/= (itvP t0d'). - have {}hd0 x0 : - x0 \in `]0, t0[%R -> is_derive x0 1 (fun x => `| 'e_2 - Right (y x) |_e ^+ 2) 0. + have {}hd0 x0 : x0 \in `]0, t0[%R -> + is_derive x0 1 (fun x => `| 'e_2 - Right (y x) |_e ^+ 2) 0. move=> x00t0. apply: hd0. apply: subset_itvl x00t0; rewrite bnd_simp. @@ -596,18 +598,15 @@ Lemma equilibrium_point1 : is_equilibrium_point phi Tilt.Upsilon1 Tilt.point1. Proof. split. - exact: tilt_point1_in_state_space. -- move=> t t0. - split; first exact: derivable_cst. +- move=> t t0; split; first exact: derivable_cst. rewrite derive1E derive_cst /Tilt.point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP; split. - rewrite scaler_eq0 oppr_eq0 gt_eqF//=. - by rewrite lsubmx_const. + by rewrite scaler_eq0 oppr_eq0 gt_eqF//= lsubmx_const. apply/eqP/rowP; move => i; apply/eqP. rewrite /PhysicalModel.eqn14b_rhs. set N := (X in _ *: X *m _); have : N = 0. - rewrite /N /=; apply/rowP => j. - by rewrite !mxE subrr. - by move => n; rewrite n scaler0 mul0mx. + by rewrite /N /=; apply/rowP => j; rewrite !mxE subrr. + by move=> N0; rewrite N0 scaler0 mul0mx. Qed. Lemma tilt_point2_in_state_space : @Tilt.point2 R \in Tilt.Upsilon1. @@ -808,67 +807,68 @@ Context {R : realType}. Variables alpha1 gamma : R. Hypotheses (alpha1_gt0 : 0 < alpha1) (gamma_gt0 : 0 < gamma). Let phi := Tilt.eqn alpha1 gamma. -Variable D : R. +Implicit Types f : R -> 'rV[R]_6. Local Notation Left := (@lsubmx _ 1 3 3). Local Notation Right := (@rsubmx _ 1 3 3). -Lemma derive_zp1 t (sol : R -> 'rV_6) : - sol_is_deriv_co (fun=> phi) 0 D sol -> - t \in `[0, D[ -> 'D_1 (Left \o sol) t = - alpha1 *: Left (sol t). +Lemma derive_zp1 (D : R) t f : + sol_is_deriv_co (fun=> phi) 0 D f -> + t \in `[0, D[ -> 'D_1 (Left \o f) t = - alpha1 *: Left (f t). Proof. move=> /= deri /[!inE]/= t0D. -have [derivable_sol] := deri _ t0D. +have [derivable_f] := deri _ t0D. move=> /(congr1 Left). rewrite derive1E row_mxKl => <-. by rewrite derive_lsubmx. Qed. -Lemma derive_z2 z (sol : R -> 'rV_6) : - sol_is_deriv_co (fun=> phi) 0 D sol -> - z \in `[0, D[ -> 'D_1 (Right \o sol) z = - gamma *: (Right (sol z) - Left (sol z)) *m \S('e_2 - Right (sol z)) ^+ 2. +Lemma derive_z2 (D : R) z f : + sol_is_deriv_co (fun=> phi) 0 D f -> + z \in `[0, D[ -> 'D_1 (Right \o f) z = + gamma *: (Right (f z) - Left (f z)) *m \S('e_2 - Right (f z)) ^+ 2. Proof. move=> deriv /[!inE]/= z0D. -have [derivable_sol +] := deriv _ z0D. +have [derivable_f +] := deriv _ z0D. move => /(congr1 Right). by rewrite derive1E row_mxKr => ?; rewrite derive_rsubmx. Qed. -Lemma is_sol_state_space_tilt (sol : R -> 'rV_6) t : +Lemma is_sol_state_space_tilt (D : R) f t : t \in `[0, D[%R -> - sol 0 \in Tilt.Upsilon1 -> - sol_is_deriv_co (fun=> phi) 0 D sol -> - Tilt.Upsilon1 (sol t). + f 0 \in Tilt.Upsilon1 -> + sol_is_deriv_co (fun=> phi) 0 D f -> + Tilt.Upsilon1 (f t). Proof. -move=> + sol0 deriv_sol. +move=> + f0 deriv_f. rewrite in_itv/= => /andP[]. rewrite le_eqVlt => /predU1P[<- D0|t0 tD]. exact/set_mem. apply: (@tilt_state_spaceS _ alpha1 gamma) => //=. -exists sol, D; split => //=. +exists f, D; split => //=. exists t => //. by rewrite in_itv/= (ltW t0) tD. Qed. -Lemma norm_e2z2 (sol : R -> 'rV_6) (z : R) - (z2 := Right \o sol) (zp1 := Left \o sol) (u := 'e_2 - z2 z) : +Lemma norm_e2z2 (D : R) f (z : R) + (z2 := Right \o f) (zp1 := Left \o f) (u := 'e_2 - z2 z) : z \in `[0, D[%R -> - sol 0 \in Tilt.Upsilon1 -> - sol_is_deriv_co (fun=> phi) 0 D sol -> `|u|_e = 1. + f 0 \in Tilt.Upsilon1 -> + sol_is_deriv_co (fun=> phi) 0 D f -> `|u|_e = 1. Proof. -move=> z0D sol0 dtraj. +move=> z0D sol0 sol_f. suff: Tilt.Upsilon1 (row_mx (zp1 z) (z2 z)). by rewrite /Tilt.Upsilon1/= row_mxKr. rewrite /zp1 /z2 hsubmxK /=. -exact: is_sol_state_space_tilt. +exact: (is_sol_state_space_tilt z0D). Qed. -Lemma angvel_sqr (sol : R -> 'rV_6) (z : R) (z2 := fun r : R => Right (sol r) : 'rV_3) +Lemma angvel_sqr (D : R) (f : R -> 'rV_6) z + (z2 := fun r : R => Right (f r) : 'rV_3) (w := (z2 z) *m \S('e_2)) (u := 'e_2 - z2 z) : z \in `[0, D[%R -> - sol 0 \in Tilt.Upsilon1 -> - sol_is_deriv_co (fun=> phi) 0 D sol -> + f 0 \in Tilt.Upsilon1 -> + sol_is_deriv_co (fun=> phi) 0 D f -> (w *m \S(u)) *d (w *m \S(u)) = (w *d w) * (u *d u) - (w *d u) ^+ 2. Proof. move=> z0D sol0 dtraj. @@ -877,38 +877,39 @@ have key_ortho : (z2 z *m \S('e_2)) *d u = 0. by rewrite dotmulC; exact/ortho_spin. rewrite key_ortho expr2. rewrite [in RHS]mxE. -rewrite [X in _ = - (w *m (\S('e_2) *m (z2 z)^T)) 0 0 * (u *d u)%:M 0 0 - 0%:M 0 0 * X]mxE. +rewrite [X in _ = - (w *m (\S('e_2) *m (z2 z)^T)) 0 0 * (u *d u)%:M 0 0 + - 0%:M 0 0 * X]mxE. rewrite mulr1n mulr0 subr0/=. rewrite /u -/w /dotmul. have Hw_ortho : (w *d u) = 0 by rewrite /u dotmulC ortho_spin. -rewrite !mulmxA dotmulP dotmulvv norm_e2z2 // expr2 mulr1. +rewrite !mulmxA dotmulP dotmulvv (norm_e2z2 z0D)// expr2 mulr1. rewrite [X in _ = - (w *m \S('e_2) *m (z2 z)^T) 0 0 * X]mxE /= mulr1n /=. rewrite [X in _ = - (w *m \S('e_2) *m (z2 z)^T) 0 0 * X]mxE /= mulr1. have wu0 : w *m u^T *m u = 0 by rewrite dotmulP Hw_ortho mul_scalar_mx scale0r. -rewrite -[in LHS](mulmxA w) sqr_spin; last by rewrite -/u norm_e2z2. +rewrite -[in LHS](mulmxA w) sqr_spin; last by rewrite -/u (norm_e2z2 z0D). rewrite [in LHS]mulmxBr mulmxA wu0 sub0r. by rewrite 2!mulNmx mulmx1 mxE. Qed. -Lemma neg_spin (sol : R -> 'rV_6) (z : R) : +Lemma neg_spin (D : R) (f : R -> 'rV_6) z : z \in `[0, D[%R -> - sol 0 \in Tilt.Upsilon1 -> - sol_is_deriv_co (fun=> phi) 0 D sol -> - `|Right (sol z) *m \S('e_2) *m - \S('e_2 - Right (sol z))|_e = - `|Right (sol z) *m \S('e_2)|_e. + f 0 \in Tilt.Upsilon1 -> + sol_is_deriv_co (fun=> phi) 0 D f -> + `|Right (f z) *m \S('e_2) *m - \S('e_2 - Right (f z))|_e = + `|Right (f z) *m \S('e_2)|_e. Proof. -move=> z0D sol0 dtraj. +move=> z0D f0 dtraj. rewrite mulmxN enormN. -pose zp1 := fun r => Left (sol r). -pose z2 := fun r => Right (sol r). +pose zp1 := fun r => Left (f r). +pose z2 := fun r => Right (f r). set w := (z2 z) *m \S('e_2). -have Upsilon1_traj : Tilt.Upsilon1 (sol z) by apply/is_sol_state_space_tilt. +have Upsilon1_traj : Tilt.Upsilon1 (f z) by apply/(is_sol_state_space_tilt z0D). rewrite /enorm. rewrite !dotmulvv [RHS]sqrtr_sqr sqrtr_sqr. -have Hnorm_sq : `|w *m \S('e_2 - Right (sol z))|_e ^+ 2 = `|w|_e ^+ 2. - rewrite -!dotmulvv angvel_sqr// !dotmulvv norm_e2z2//=. +have Hnorm_sq : `|w *m \S('e_2 - Right (f z))|_e ^+ 2 = `|w|_e ^+ 2. + rewrite -!dotmulvv (angvel_sqr z0D)// !dotmulvv (norm_e2z2 z0D)//=. rewrite -!dotmulvv expr2 !mul1r mulr1. - have -> : w *d ('e_2 - Right (sol z)) = 0 by rewrite dotmulC ortho_spin. + have -> : w *d ('e_2 - Right (f z)) = 0 by rewrite dotmulC ortho_spin. by rewrite expr2 mul0r subr0. rewrite !normr_enorm. by move/sqr_inj : Hnorm_sq => ->//; rewrite ?nnegrE ?enorm_ge0. @@ -917,21 +918,22 @@ Qed. Let c1 := 2^-1 / alpha1. Let c2 := 2^-1 / gamma. -Lemma V1dotE z (sol : R -> 'rV_6) - (zp1 := Left \o sol) (z2 := Right \o sol) : - sol_is_deriv_co (fun=> phi) 0 D sol -> +Lemma V1dotE z (D : R) (f : R -> 'rV_6) + (zp1 := Left \o f) (z2 := Right \o f) : + sol_is_deriv_co (fun=> phi) 0 D f -> z \in `[0, D[ -> - V1dot (sol z) = - c1 *: (2 *: 'D_1 zp1 z *m (Left (sol z))^T) 0 0 + - c2 *: (2 *: 'D_1 z2 z *m (Right (sol z))^T) 0 0. + V1dot (f z) = + c1 *: (2 *: 'D_1 zp1 z *m (Left (f z))^T) 0 0 + + c2 *: (2 *: 'D_1 z2 z *m (Right (f z))^T) 0 0. Proof. -move=> solP zd. +move=> fP zd. rewrite -scalemxAl mxE (scalerA c1 2) mulrAC mulVf ?pnatr_eq0// div1r. rewrite -scalemxAl [in X in _ + X]mxE (scalerA c2 2) mulrAC. rewrite mulVf// div1r. -rewrite derive_zp1 // -scalemxAl mxE [X in X + _](mulrA (alpha1^-1) (- alpha1)). +rewrite (derive_zp1 fP)// -scalemxAl mxE. +rewrite [X in X + _](mulrA (alpha1^-1) (- alpha1)). rewrite mulrN mulVf ?gt_eqF// mulN1r. -rewrite derive_z2 // -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE. +rewrite (derive_z2 fP)// -scalemxAl mulmxA -scalemxAl [in X in _ + X]mxE. rewrite scalerA mulVf ?gt_eqF// scale1r. rewrite norm_squared /V1dot. congr +%R. @@ -939,16 +941,16 @@ rewrite -2![in LHS]mulmxA -mulmxBr -mulmxBr -linearB/=. rewrite -[X in (X *m (_ *m _)) 0 0 = _]trmxK. rewrite -[X in (_ *m (X *m _)) 0 0 = _]trmxK. rewrite mulmxA -trmx_mul -trmx_mul [LHS]mxE. -rewrite -(mulmxA (Right (sol z) - (Left (sol z)))) mulmxE -expr2. +rewrite -(mulmxA (Right (f z) - (Left (f z)))) mulmxE -expr2. rewrite tr_sqr_spin. by rewrite mulmxA. Qed. -Lemma derive_along_V1 t (sol : R -> 'rV_6) : +Lemma derive_along_V1 (D : R) t (f : R -> 'rV_6) : t \in `]0, D[ -> - sol_is_deriv_co (fun=> phi) 0 D sol -> - (forall t, t \in `]0, D[ -> differentiable sol t) -> - 'D~(sol) (Tilt.V1 alpha1 gamma) t = V1dot (sol t). + sol_is_deriv_co (fun=> phi) 0 D f -> + (forall t, t \in `]0, D[ -> differentiable f t) -> + 'D~(f) (Tilt.V1 alpha1 gamma) t = V1dot (f t). Proof. move=> t0D tilt_eqnx dif1. rewrite /Tilt.V1 derive_alongD; last 3 first. @@ -966,29 +968,27 @@ rewrite derive_alongMl => //; last 2 first. exact/differentiable_enorm_squared/differentiable_rsubmx_comp. exact: dif1. rewrite -fctE /= !derive_along_enorm_squared//=. -- rewrite V1dotE. - by rewrite /c1 /c2 !invfM. - rewrite /= in tilt_eqnx. - exact: tilt_eqnx. -- move: t0D. - by rewrite !inE/=; apply: subset_itvr; rewrite bnd_simp. +- rewrite (V1dotE tilt_eqnx); last first. + by move: t0D; rewrite !inE; apply: subset_itvr; rewrite bnd_simp. + by rewrite /c1 /c2 !invfM. - exact: dif1. - exact/differentiable_lsubmx_comp. - exact: dif1. Qed. -Definition u1 (sol : R -> 'rV[R]_6) t - (zp1 := Left \o sol) (z2 := Right \o sol) +Definition u1 (f : R -> 'rV[R]_6) t + (zp1 := Left \o f) (z2 := Right \o f) (w := z2 t *m \S('e_2)) : 'rV[R]_2 := \row_(i < 2) [eta (fun=> 0) with 0 |-> `|zp1 t|_e, 1 |-> `|w|_e] i. -Lemma V1dot_ub (sol : R -> 'rV[R]_6) (zp1 := Left \o sol) (z2 := Right \o sol) : - sol 0 \in Tilt.Upsilon1 -> - sol_is_deriv_co (fun=> phi) 0 D sol -> +Lemma V1dot_ub (D : R) (f : R -> 'rV[R]_6) + (zp1 := Left \o f) (z2 := Right \o f) : + f 0 \in Tilt.Upsilon1 -> + sol_is_deriv_co (fun=> phi) 0 D f -> forall t, t \in `[0, D[%R -> - V1dot (sol t) <= (- (u1 sol t) *m u2 *m (u1 sol t)^T) 0 0. + V1dot (f t) <= (- (u1 f t) *m u2 *m (u1 f t)^T) 0 0. Proof. -move=> sol0 solP z z0D. +move=> f0 fP z z0D. set w := z2 z *m \S('e_2). rewrite /V1dot. rewrite mxE norm_spin mxE addrA expr2 mulmxA. @@ -1005,7 +1005,7 @@ apply: (@le_trans _ _ (`|w *m - \S('e_2 - z2 z)|_e * `|zp1 z|_e + (- `|zp1 z|_e ^+ 2 - `|w|_e ^+ 2))). rewrite lerD2r (le_trans _ cauchy)//. by rewrite mxE eqxx mulr1n. -rewrite neg_spin /u1 /u2 //. +rewrite (neg_spin z0D)// /u1 /u2. rewrite mxE. rewrite !sum2E/= ![in leRHS]mxE !sum2E/= ![in leRHS]mxE /=. rewrite !mulr1 mulrN mulNr opprK mulrDl mulNr -expr2. @@ -1015,40 +1015,40 @@ rewrite [in leRHS](mulrC (_ / 2)) (mulrC 2^-1) -mulrDr -splitr. by rewrite [leRHS]mulrC. Qed. -Lemma V1dot_eq0_p1_or_p2 (sol : R -> 'rV[R]_6) t : - sol 0 \in Tilt.Upsilon1 -> - sol_is_deriv_co (fun=> phi) 0 D sol -> +Lemma V1dot_eq0_p1_or_p2 (D : R) (f : R -> 'rV[R]_6) t : + f 0 \in Tilt.Upsilon1 -> + sol_is_deriv_co (fun=> phi) 0 D f -> t \in `[0, D[%R -> - V1dot (sol t) = 0 -> - sol t = Tilt.point1 \/ sol t = Tilt.point2. + V1dot (f t) = 0 -> + f t = Tilt.point1 \/ f t = Tilt.point2. Proof. -move => sol0 solP t0d V1dsol. -have h : u1 sol t = 0. - case: (u1 sol t =P 0) => [-> // |/eqP hsol]. - have := V1dot_ub sol0 solP t0d. - have := u2_quadratic_form_gt0 hsol. - rewrite V1dsol !mulNmx !mxE oppr_ge0. +move => f0 fP t0d V1df. +have h : u1 f t = 0. + case: (u1 f t =P 0) => [-> // |/eqP hf]. + have := V1dot_ub f0 fP t0d. + have := u2_quadratic_form_gt0 hf. + rewrite V1df !mulNmx !mxE oppr_ge0. move => h1 h2. have := lt_le_trans h1 h2. by rewrite ltxx. -have L0 : Left (sol t) = 0. +have L0 : Left (f t) = 0. apply/eqP; rewrite -enorm_eq0; apply /eqP. have := congr1 (fun v : 'rV_2 => v ord0 ord0) h. by rewrite !mxE/=. -have R0 : (Right (sol t)) *m \S('e_2) = 0. +have R0 : (Right (f t)) *m \S('e_2) = 0. apply/eqP; rewrite -enorm_eq0; apply/eqP. have := congr1 (fun v : 'rV_2 => v ord0 ord_max) h. by rewrite !mxE/=. -rewrite -(hsubmxK (n1:=3) (sol t)). +rewrite -(hsubmxK (n1:=3) (f t)). rewrite L0. -suff [-> | -> ] : Right (sol t) = 0 \/ Right (sol t) = (2 *: 'e_2). +suff [-> | -> ] : Right (f t) = 0 \/ Right (f t) = (2 *: 'e_2). left;apply /matrixP => i j;rewrite mxE. case: splitP => // k _;by rewrite !mxE. right;apply /matrixP => i j;rewrite mxE. by case: splitP => // k _. -have := is_sol_state_space_tilt t0d sol0 solP. +have := is_sol_state_space_tilt t0d f0 fP. rewrite /Tilt.Upsilon1/=. -have /sub_rVP [k ->] : (Right (sol t) <= ('e_2 : 'rV_3))%MS. +have /sub_rVP [k ->] : (Right (f t) <= ('e_2 : 'rV_3))%MS. apply: (@submx_trans _ _ _ _ _ _ (kermx \S('e_2))). by apply /sub_kermxP. rewrite submxElt kernel_spin //. @@ -1062,29 +1062,30 @@ by rewrite subr_eq addrC -subr_eq subrr => /eqP <-;rewrite scale0r;left. by rewrite subr_eq addrC -subr_eq opprK => /eqP <-;right. Qed. -Lemma derive_along_V1_le0 (sol : R -> 'rV_6) : - sol 0 \in Tilt.Upsilon1 -> - sol_is_deriv_co (fun=> phi) 0 D sol -> - (forall t, t \in `]0, D[%R -> differentiable sol t) -> +Lemma derive_along_V1_le0 (D : R) (f : R -> 'rV_6) : + f 0 \in Tilt.Upsilon1 -> + sol_is_deriv_co (fun=> phi) 0 D f -> + (forall t, t \in `]0, D[%R -> differentiable f t) -> forall t, t \in `]0, D[%R -> - 'D~(sol) (Tilt.V1 alpha1 gamma) t <= 0. + 'D~(f) (Tilt.V1 alpha1 gamma) t <= 0. Proof. move=> sol0 solP diff t t0. -rewrite derive_along_V1//; last 2 first. - by rewrite inE/= in_itv/=. +have {}t0 : t \in `]0, D[ by rewrite inE. +rewrite (derive_along_V1 t0)//; last first. move=> t1 t10D. apply: diff => //. - by rewrite inE/= in_itv/= in t10D. + by rewrite inE/= in t10D. have /(V1dot_ub sol0 solP) : t \in `[0, D[%R. + rewrite inE in t0. by apply: subset_itvr t0; rewrite bnd_simp. move/le_trans; apply. have Hquad : let u1 := \row_i [eta fun=> 0 - with 0 |-> `|(Left \o sol) t|_e, - 1 |-> `|(Right \o sol) t *m \S('e_2)|_e] + with 0 |-> `|(Left \o f) t|_e, + 1 |-> `|(Right \o f) t *m \S('e_2)|_e] i in 0 <= (u1 *m u2 *m u1^T) 0 0. set u1 := \row_i [eta fun=> 0 - with 0 |-> `|(Left \o sol) t|_e, - 1 |-> `|(Right \o sol) t *m \S('e_2)|_e] + with 0 |-> `|(Left \o f) t|_e, + 1 |-> `|(Right \o f) t *m \S('e_2)|_e] i. rewrite /=. case: (u1 =P 0) => [->|/eqP u1_neq0]. diff --git a/tilt_stability.v b/tilt_stability.v index 453a9c2a..0dfa047f 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -49,23 +49,23 @@ Definition posdefmx {R : realType} m (M : 'M[R]_m) : Prop := Local Open Scope classical_set_scope. Section locdef. -Context {R : realType} {T : normedModType R}. -Implicit Types V : T -> R. +Context {R : realType} {U : normedModType R}. +Implicit Types V : U -> R. -Definition is_Lyapunov_candidate V (D : set T) (x : T) := - [/\ x \in D, V x = 0 & forall z, z \in D -> z != x -> V z > 0]. +Definition is_Lyapunov_candidate V (A : set U) (x : U) := + [/\ x \in A, V x = 0 & forall z, z \in A -> z != x -> V z > 0]. -Definition locnegdef V (x : T) := V x = 0 /\ \forall z \near x^', V z < 0. +Definition locnegdef V (x : U) := V x = 0 /\ \forall z \near x^', V z < 0. (* locally negative semidefinite *) -Definition locnegsemidef V (x : T) := V x = 0 /\ \forall z \near x^', V z <= 0. +Definition locnegsemidef V (x : U) := V x = 0 /\ \forall z \near x^', V z <= 0. End locdef. (* derivation along the solution f, see Khalil p.114 *) (* NB: we are not representing the initial state at t = 0 of the solution f *) -Definition derive_along {R : numFieldType} {n : nat} (V : 'rV[R]_n -> R) - (f : R -> 'rV[R]_n) (t : R) : R := +Definition derive_along {R : numFieldType} {n} (U := 'rV[R]_n) (V : U -> R) + (f : R -> U) t := (jacobian1 V (f t))^T *d 'D_1 f t. Notation "''D~(' f ) V" := (derive_along V f). @@ -74,7 +74,7 @@ Section derive_along. Context {R : realType} {n : nat}. Variable f : R -> 'rV[R]_n. -Lemma derive_along_derive (V : 'rV[R]_n -> R) (t : R) : +Lemma derive_along_derive (U := 'rV[R]_n) (V : U -> R) (t : R) : differentiable V (f t) -> differentiable f t -> 'D~(f) V t = 'D_1 (V \o f) t. Proof. @@ -274,32 +274,30 @@ Definition is_asymptotically_stable_at (x : U) (f : R -> U) : Prop := End stability. Section about_Lyapunov_function. -Context {K : realType} {n : nat}. -Let U := 'rV[K]_n.+1. +Context {R : realType} {n : nat}. +Let U := 'rV[R]_n.+1. Variable phi : U -> U. -Variable D : K. -Variable sol : K -> U. -Hypothesis derivable_sol : {in `[0, D[%R, forall t, derivable sol t 1}. +Variable D : R. +Variable f : R -> U. +Hypothesis derivable_f : {in `[0, D[%R, forall t, derivable f t 1}. -Variable V : U -> K. +Variable V : U -> R. Hypothesis Vdiff : forall t : U, differentiable V t. -Hypothesis DV_le0 : forall t, t \in `]0, D[%R -> 'D~(sol) V t <= 0. +Hypothesis DV_le0 : forall t, t \in `]0, D[%R -> 'D~(f) V t <= 0. -Lemma V_nincr a b : b < D -> 0 <= a <= b -> V (sol b) <= V (sol a). +Lemma V_nincr a b : b < D -> 0 <= a <= b -> V (f b) <= V (f a). Proof. move=> bD /andP[a_ge0 ab]. -apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. +apply: (@ler0_derive1_le_cc _ (V \o f) 0 b) => //=. - move=> y yb. apply/diff_derivable/differentiable_comp; last exact: differentiable_comp. - rewrite -derivable1_diffP. - apply: derivable_sol. + rewrite -derivable1_diffP; apply: derivable_f. by apply: subset_itv yb; rewrite bnd_simp// ltW. - move=> y yb. rewrite derive1E -derive_along_derive//. + apply: DV_le0. by apply: subset_itvl yb; rewrite bnd_simp ltW. - + rewrite -derivable1_diffP. - apply: derivable_sol. + + rewrite -derivable1_diffP; apply: derivable_f. by apply: subset_itv yb; rewrite bnd_simp// ltW. - (* `[0, b] *) have [b0|] := ltP 0 b; last first. @@ -311,24 +309,22 @@ apply: (@ler0_derive1_le_cc _ (V \o sol) 0 b) => //=. + move=> z z0b. apply: continuous_comp; last exact: differentiable_continuous. apply: differentiable_continuous => //. - rewrite -derivable1_diffP. - apply: derivable_sol. + rewrite -derivable1_diffP; apply: derivable_f. by apply: subset_itv z0b; rewrite bnd_simp// ltW. + have d0 : 0 < D by exact/lt_trans/bD. - have cont : {in `[0, D[%R, continuous sol}. + have cont : {in `[0, D[%R, continuous f}. move=> t t0D. apply: differentiable_continuous. - exact/derivable1_diffP/derivable_sol. + exact/derivable1_diffP/derivable_f. apply: cvg_comp. apply: cvg_at_right_filter. apply: cont. by rewrite bound_itvE. - exact: (differentiable_continuous (Vdiff (sol 0))). + exact: (differentiable_continuous (Vdiff (f 0))). + apply: cvg_at_left_filter. apply: differentiable_continuous => //. apply: differentiable_comp. - rewrite -derivable1_diffP. - apply: derivable_sol. + rewrite -derivable1_diffP; apply: derivable_f. by rewrite in_itv/= (ltW b0)// bDelta. exact: Vdiff. - by rewrite bound_itvE (le_trans a_ge0). @@ -672,7 +668,7 @@ Hypothesis Vdiff : forall t : U, differentiable V t. Hypothesis V'_le0 : forall D (f : R -> U), f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> - forall t, 0 < t < D -> 'D~(f) V t <= 0. + forall t, t \in `]0, D[%R -> 'D~(f) V t <= 0. Theorem Lyapunov_stability : is_Lyapunov_candidate V Init `<=` is_stable_at phi Init. From 31f6b8c413afaa9e47cea341e6924a6a8de0da72 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 20 Feb 2026 18:47:09 +0900 Subject: [PATCH 138/144] mv file --- _CoqProject | 2 +- lasalle.v | 4 ++-- ode.v | 2 +- ode_contfun.v => ode_contseg.v | 0 ode_wip.v | 2 +- tilt_robot.v | 10 +++++----- 6 files changed, 10 insertions(+), 10 deletions(-) rename ode_contfun.v => ode_contseg.v (100%) diff --git a/_CoqProject b/_CoqProject index ae927bfe..4090d6d5 100644 --- a/_CoqProject +++ b/_CoqProject @@ -18,7 +18,7 @@ derive_matrix.v differential_kinematics.v extra_trigo.v ode_common.v -ode_contfun.v +ode_contseg.v ode.v lasalle.v pendulum.v diff --git a/lasalle.v b/lasalle.v index dcb6666c..b1114585 100644 --- a/lasalle.v +++ b/lasalle.v @@ -395,8 +395,8 @@ Qed. Lemma stable_limS (V : U -> R^o) : {within K, continuous V} -> (forall p t, K p -> (0 <= t)%R -> derivable (V \o sol p : R^o -> R^o) t 1) -> - (forall (p : U), K p -> derive1 (V \o sol p) 0 <= 0)%R -> - limS K `<=` [set p | derive1 (V \o sol p) 0 = 0]%R. + (forall (p : U), K p -> (V \o sol p)^`() 0 <= 0)%R -> + limS K `<=` [set p | (V \o sol p)^`() 0 = 0]%R. Proof. move=> Vcont Vsol_drvbl Vsol'le0 p [q Kq plimp]. have ssqRpK : sol q @` (>= 0)%R `<=` K by move=> _ [t tge0 <-]; apply: Kinvar. diff --git a/ode.v b/ode.v index 387eaf9c..3359f600 100644 --- a/ode.v +++ b/ode.v @@ -7,7 +7,7 @@ From mathcomp Require Import contra functions constructive_ereal reals. From mathcomp Require Import topology prodnormedzmodule tvs normedtype. From mathcomp Require Import landau ereal sequences derive numfun measure. From mathcomp Require Import realfun lebesgue_measure lebesgue_integral ftc. -Require Import tilt_mathcomp tilt_analysis ode_common ode_contfun. +Require Import tilt_mathcomp tilt_analysis ode_common ode_contseg. (**md**************************************************************************) (* # Proof of the Cauchy-Lipschitz theorem *) diff --git a/ode_contfun.v b/ode_contseg.v similarity index 100% rename from ode_contfun.v rename to ode_contseg.v diff --git a/ode_wip.v b/ode_wip.v index 362e66fc..7bd4bd6b 100644 --- a/ode_wip.v +++ b/ode_wip.v @@ -6,7 +6,7 @@ From mathcomp Require Import functions reals interval_inference topology. From mathcomp Require Import prodnormedzmodule tvs normedtype landau. From mathcomp Require Import ereal sequences derive numfun measure realfun. From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. -Require Import tilt_analysis ode_common ode_contfun ode. +Require Import tilt_analysis ode_common ode_contseg ode. (**md**************************************************************************) (* # ODE wip *) diff --git a/tilt_robot.v b/tilt_robot.v index 57ecd920..87258bfb 100644 --- a/tilt_robot.v +++ b/tilt_robot.v @@ -59,19 +59,19 @@ Lemma fact217 (v : 'rV[K]_3): \S(v) ^+ 3 = - (`|v|_e ^+2) *: \S(v). exact: spin3. Qed. -Lemma fact214 (R : 'M[K]_3) (v_ : seq 'rV[K]_3) : R \is 'SO[K]_3 -> - R^T * (\prod_(i <- v_) \S( i )) * R = (\prod_(i <- v_) \S( i *m R)). +Lemma fact214 (M : 'M[K]_3) (v_ : seq 'rV[K]_3) : M \is 'SO[K]_3 -> + M^T * (\prod_(i <- v_) \S( i )) * M = (\prod_(i <- v_) \S(i *m M)). Proof. -move => RSO. +move=> MSO. elim/big_ind2 : _ => //. by rewrite -!mulmxE mulmx1 rotation_tr_mul. - move => a b c d H1 H2. - rewrite -H1 // -H2 // -!mulmxE -!rotation_inv // !mulmxA -[R^-1 *m b *m R *m R^-1]mulmxA. + rewrite -H1 // -H2 // -!mulmxE -!rotation_inv // !mulmxA -[M^-1 *m b *m M *m M^-1]mulmxA. rewrite mulmxV; last first. rewrite unitmxE. apply: orthogonal_unit. exact: rotation_sub. - by rewrite -[R^-1 *m b *m 1%:M *m d]mulmxA mul1mx. + by rewrite -[M^-1 *m b *m 1%:M *m d]mulmxA mul1mx. - move => i true. exact: spin_similarity. Qed. From 2ecc4648ded5cc495be9eb5b9cca84e5c8abdf87 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Fri, 20 Feb 2026 19:00:08 +0900 Subject: [PATCH 139/144] removed init from equilibrium point --- tilt_lyapunov.v | 11 +++++------ tilt_stability.v | 50 +++++++++++++++++++++--------------------------- 2 files changed, 27 insertions(+), 34 deletions(-) diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index c5b90dcd..55589dcb 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -594,11 +594,10 @@ rewrite inE /Tilt.Upsilon1 /Tilt.point1/=. by rewrite rsubmx_const /= subr0 enormeE. Qed. -Lemma equilibrium_point1 : is_equilibrium_point phi Tilt.Upsilon1 Tilt.point1. +Lemma equilibrium_point1 : is_equilibrium_point phi Tilt.point1. Proof. split. -- exact: tilt_point1_in_state_space. -- move=> t t0; split; first exact: derivable_cst. +- move=> t t0; exact: derivable_cst. rewrite derive1E derive_cst /Tilt.point1; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP; split. by rewrite scaler_eq0 oppr_eq0 gt_eqF//= lsubmx_const. @@ -619,11 +618,11 @@ rewrite [X in _ - X](_:1 = 1%:R) //. by rewrite -natrB //= normr1. Qed. -Lemma equilibrium_point2 : is_equilibrium_point phi Tilt.Upsilon1 Tilt.point2. +Lemma equilibrium_point2 : is_equilibrium_point phi Tilt.point2. Proof. -split; first exact: tilt_point2_in_state_space. move=> D D0. -split; first exact: derivable_cst. +split. +exact: derivable_cst. rewrite derive1E derive_cst; apply/eqP. rewrite eq_sym (@row_mx_eq0 _ 1 3 3); apply/andP. set N := (X in _ *: X == 0 /\ _). diff --git a/tilt_stability.v b/tilt_stability.v index 0dfa047f..0ac77212 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -217,27 +217,27 @@ Context {R : realType} {n : nat}. Let U := 'rV[R]_n. Variable phi : U -> U. -Definition is_equilibrium_point (Init : set U) (x : U) := - x \in Init /\ sol_is_deriv_cy (fun=> phi) 0 (cst x). +Definition is_equilibrium_point (x : U) := + sol_is_deriv_cy (fun=> phi) 0 (cst x). -Lemma equilibrium_point_in_state_space (Init : set U) : - is_equilibrium_point Init `<=` state_space phi Init. -Proof. -move=> x [xinit solf]; exists (cst x), 1; split => //=. - exact: sol_is_deriv_cy_co. -by exists 0 => //; rewrite bound_itvE. -Qed. +(* Lemma equilibrium_point_in_state_space (Init : set U) : *) +(* is_equilibrium_point Init `<=` state_space phi Init. *) +(* Proof. *) +(* move=> x solf; exists (cst x), 1; split => //=. *) +(* apply: sol_is_deriv_cy_co. *) +(* by exists 0 => //; rewrite bound_itvE. *) +(* Qed. *) -Definition equilibrium_points Init := [set p | is_equilibrium_point Init p]. +Definition equilibrium_points Init := [set p | Init p /\ is_equilibrium_point p]. Lemma equilibrium_points_subset (A B : set U) : A `<=` B -> equilibrium_points A `<=` equilibrium_points B. Proof. move=> AB x. rewrite /equilibrium_points/= /is_equilibrium_point. -rewrite inE => -[Ax H]. -split; first exact/mem_set/AB. -by move=> d t; exact: H. +move => [Ax H]. +split => //. +by apply AB. Qed. End equilibrium_point. @@ -613,27 +613,21 @@ apply: (H _ D) => //. Qed. Lemma is_equilibrium_point_substitutionP x : - is_equilibrium_point (fun y => phi (y + x)) [set y - x | y in Init] 0 <-> - is_equilibrium_point phi Init x. + is_equilibrium_point (fun y => phi (y + x)) 0 <-> + is_equilibrium_point phi x. Proof. split. -- move=> [u0Init issol]; split. - move: u0Init; rewrite !inE/= => -[v Initv]. - by move/subr0_eq => <-. - move=> /= t t0. - split; first exact: derivable_cst. +- move=> issol t t0; split. + exact: derivable_cst. have := issol 0. rewrite in_itv/= lexx => /(_ isT)[_]. rewrite add0r => <-. by rewrite !derive1_cst. -- move=> [u0Init issol]; split. - move: u0Init; rewrite !inE/= => xInit. - by exists x => //; rewrite subrr. - move=> t t0. - split; first exact: derivable_cst. - have [_] := issol _ t0. - rewrite /= add0r => <-. - by rewrite !derive1_cst. +- move=> issol t t0; split. + exact: derivable_cst. + have [] := issol _ t0. + rewrite !derive1_cst //=. + by rewrite add0r => _ ->. Qed. Lemma is_Lyapunov_candidate_substitution V x : From e2f825f96638d9296d9652d4ca404daecb681c4d Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Fri, 20 Feb 2026 20:19:39 +0900 Subject: [PATCH 140/144] wip --- ode.v | 1 + tilt_lasalle.v | 77 +++++++++++++++++++++++++------------------------- 2 files changed, 40 insertions(+), 38 deletions(-) diff --git a/ode.v b/ode.v index 3359f600..8d16f79b 100644 --- a/ode.v +++ b/ode.v @@ -1623,6 +1623,7 @@ Lemma solution_stays_in_ball : {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (cauchy_lipschitz_f t)}. Proof. Admitted. + Lemma solution_continuous : {within `[a, a + safe_dist], continuous cauchy_lipschitz_f}. Proof. exact: cts_fun. Qed. diff --git a/tilt_lasalle.v b/tilt_lasalle.v index 847c7fe1..f1cce5fa 100644 --- a/tilt_lasalle.v +++ b/tilt_lasalle.v @@ -506,21 +506,20 @@ move => Hdist. have [S [So Sc Sx]] := avoid_x Hdist. have [e1 /= e10 /= P1] : \forall e \near 0^'+, ball Tilt.point1 e `<=` S. apply: open_subball => //. - by apply Sc;left. + by apply Sc; left. have [e2 /= e20 /= P2] : \forall e \near 0^'+, ball Tilt.point2 e `<=` S. apply: open_subball => //. - by apply Sc;right. + by apply Sc; right. set eps := Num.min (e1 / 2) (e2 / 2). -have eps0 : 0 < eps. - by rewrite lt_min !divr_gt0. +have eps0 : 0 < eps by rewrite lt_min !divr_gt0. have B1 : ball Tilt.point1 eps `<=` S. apply P1 => //. rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ltr_pdivrMr // ltr_pMr ?ltrDr //. - by apply /orP;left. + by apply/orP; left. have B2 : ball Tilt.point2 eps `<=` S. apply P2 => //. rewrite /ball_/= sub0r normrN ger0_norm ?gt_min ?ltW // ?ltr_pdivrMr // ltr_pMr ?ltrDr //. - by apply /orP;right. + by apply/orP; right. have nbh' : (nbhs Tilt.points S). exists eps => //=. rewrite /ball_set. @@ -552,7 +551,8 @@ by left. by right. Qed. -Lemma cluster_nonempty p : p \in Tilt.Upsilon1 -> cluster (sol p t @[t --> +oo]) !=set0. +Lemma cluster_nonempty p : p \in Tilt.Upsilon1 -> + cluster (sol p t @[t --> +oo]) !=set0. Proof. move => sp. suff : (sublevelUpsilon1 p) `&` cluster (sol p t @[t --> +oo]) !=set0. @@ -571,7 +571,7 @@ Proof. split => /=; last by have /set_mem := @tilt_point1_in_state_space K. rewrite /sublevel/= /Tilt.point1 /Tilt.V1. rewrite lsubmx_const rsubmx_const/= !enorm0 !expr0n /= !mul0r add0r. -by rewrite addr_ge0 // divr_ge0 // ?sqr_ge0 ?mulr_ge0 // ltW. +by rewrite addr_ge0// divr_ge0// ?sqr_ge0 ?mulr_ge0// ltW. Qed. Lemma tilt_cvg_to_point1_or_point2 p : p \in Tilt.Upsilon1 -> @@ -581,43 +581,44 @@ Proof. move => ps. have cluster_con : connected (cluster (sol p t @[t --> +oo])). apply: (compact_connected_cluster _ _ _ (@compact_sublevelUpsilon1 p) ) => //. - by apply: pseudometric_normal. - by apply: sol_continuous. - move => t t0. + exact: pseudometric_normal. + exact: sol_continuous. + move=> t t0. apply/mem_set. apply: invariant_sublevelUpsilon1 => //. - by apply/set_mem/mem_sublevelUpsilon1/set_mem. -have := connected2_subset cluster_con (cluster_nonempty ps) (cluster_contained_points ps). -suff H (q : U): cluster (sol p t @[t --> +oo]) = [set q] -> sol p t @[t --> +oo] --> q. - move => [h | h]; [left | right];apply H => //. + exact/set_mem/mem_sublevelUpsilon1/set_mem. +have := connected2_subset cluster_con (cluster_nonempty ps) + (cluster_contained_points ps). +suff H (q : U): cluster (sol p t @[t --> +oo]) = [set q] -> + sol p t @[t --> +oo] --> q. + by move => [h | h]; [left|right]; apply H. move => H. have sublevelUpsilon1q : sublevelUpsilon1 p q. - suff: cluster (sol p t @[t --> +oo]) `<=` sublevelUpsilon1 p. - by apply; rewrite H. - rewrite clusterE. - apply :(@subset_trans _ (closure (sol p @` `[0, +oo[))). - apply: bigcap_inf => //=. - exists 0; split => //= x x0. - exists x=>//. - rewrite in_itv/=ltW//. - rewrite (closure_id (sublevelUpsilon1 p)).1;last first. - by apply compact_closed =>//; apply compact_sublevelUpsilon1. - apply closure_subset. - move => /= _ [t +] <-. - rewrite in_itv/= => /andP[t0 _]. - apply invariant_sublevelUpsilon1 => //. - by apply/set_mem/mem_sublevelUpsilon1/set_mem. -have [M [Mr Mp]]: bounded_set (sublevelUpsilon1 p). + suff: cluster (sol p t @[t --> +oo]) `<=` sublevelUpsilon1 p. + by apply; rewrite H. + rewrite clusterE. + apply: (@subset_trans _ (closure (sol p @` `[0, +oo[))). + apply: bigcap_inf => //=. + exists 0; split => //= x x0. + exists x =>//. + rewrite in_itv/=ltW//. + rewrite (closure_id (sublevelUpsilon1 p)).1; last first. + by apply compact_closed =>//; apply compact_sublevelUpsilon1. + apply closure_subset. + move => /= _ [t +] <-. + rewrite in_itv/= => /andP[t0 _]. + apply invariant_sublevelUpsilon1 => //. + exact/set_mem/mem_sublevelUpsilon1/set_mem. +have [M [Mr Mp]] : bounded_set (sublevelUpsilon1 p). apply compact_bounded. exact: compact_sublevelUpsilon1. -have [M0 | M0] := leP 0 M;last first. +have [M0 | M0] := leP 0 M;last first. suff : `|q| < 0 by rewrite normr_lt0. - have M02 : M < M/2. - by rewrite ltr_pdivlMr // gtr_nMr // ltrDl. - have /= w := (Mp _ M02 _ sublevelUpsilon1q). + have M02 : M < M / 2 by rewrite ltr_pdivlMr // gtr_nMr // ltrDl. + have /= w := Mp _ M02 _ sublevelUpsilon1q. apply (le_lt_trans w). - rewrite ltr_pdivrMr // mul0r //. -set V := ball (p : U) (`|p|+(M+1+1) : K). + by rewrite ltr_pdivrMr// mul0r. +set V := ball (p : U) (`|p| + (M + 1 + 1) : K). have VsublevelUpsilon1 : sublevelUpsilon1 p `<=` V. move => /= x Kx. rewrite /V -ball_normE/ball_ /=. @@ -628,7 +629,7 @@ have Vo : open V. by rewrite /V; exact: ball_open. have cV : compact (closure V). rewrite closure_ballE closed_ballE//. - apply: bounded_closed_compact; last by apply: closed_closed_ball_. + apply: bounded_closed_compact; last exact: closed_closed_ball_. exists (`|p| + (`|p| + (M + 1 +1))). rewrite /closed_ball_/=. split => //= x xB y Hy. From e0a797b5ee301189e46c8b37e06e5763b97df7d6 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Fri, 20 Feb 2026 20:30:01 +0900 Subject: [PATCH 141/144] cleanup --- ode.v | 9 ++++----- ode_common.v | 5 ----- 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/ode.v b/ode.v index 8d16f79b..b96f1121 100644 --- a/ode.v +++ b/ode.v @@ -361,9 +361,6 @@ HB.instance Definition _ := isContinuous.Build (subspace `[a, b]) U (picard_fun_subdef phi gabB : subspace _ -> _) within_continuous_picard_fun_subdef. -Let continuous_picard_fun_subdef : - {within `[a, b], continuous picard_fun_subdef phi gabB}. -Proof. exact: cts_fun. Abort. End picard_fun_subdef_isContinuous. @@ -1622,8 +1619,10 @@ Proof. by move=> t; move => /cauchy_lipschitz_in_cball; exact. Qed. Lemma solution_stays_in_ball : {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r%:num (cauchy_lipschitz_f t)}. -Proof. Admitted. - +Proof. + move => t ta. + apply /le_closed_ball/solution_stays_in_ball2=>//. +Qed. Lemma solution_continuous : {within `[a, a + safe_dist], continuous cauchy_lipschitz_f}. Proof. exact: cts_fun. Qed. diff --git a/ode_common.v b/ode_common.v index c0c938ae..02eec3c2 100644 --- a/ode_common.v +++ b/ode_common.v @@ -268,11 +268,6 @@ Qed. End continuous_within_itvP. -(* TODO *) -Lemma proveme {R : realType} (a b : R) (g : R -> R) : - {within `[a, b], continuous g} -> - {within `[a, b], continuous (g \o -%R)}. -Abort. Lemma within_continuous_comp_norm {R : realType} {U : normedModType R} a y (f : R -> U) : a <= y -> From de04aa553617bd6d69ad9c416e976d35f1360c67 Mon Sep 17 00:00:00 2001 From: Holger Thies Date: Fri, 20 Feb 2026 20:39:18 +0900 Subject: [PATCH 142/144] minor --- ode.v | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ode.v b/ode.v index b96f1121..f7e47538 100644 --- a/ode.v +++ b/ode.v @@ -1651,7 +1651,7 @@ Qed. Local Notation V := (@ContSeg_quot.quot_contSeg R a (a + safe_dist) U). -Lemma cauchy_lipschitz_unique f' : +Lemma cauchy_lipschitz_unique_restr f' : {within `[a, a + safe_dist], continuous f'} -> {in `[a, a + safe_dist]%R, forall t, closed_ball u0 r2%:num (f' t)} -> is_sol_oo phi u0 a (a + safe_dist) f' -> @@ -1786,7 +1786,7 @@ have [rho [drho1 drho2]] : exists rho, dmax rho <= (Num.min d1%:num d2%:num) /\ have drho_pos : 0 < dmax rho by exact: safe_dist_gt0. exists rho, (PosNum drho_pos), drho2; split => //. - move => t tad. - apply/esym; apply: cauchy_lipschitz_unique. + apply/esym; apply: cauchy_lipschitz_unique_restr. - apply/continuous_subspaceW/cf => //. apply: subset_itvl => //=. by rewrite bnd_simp -lerBrDl;apply safe_dist_itv. @@ -1804,7 +1804,7 @@ exists rho, (PosNum drho_pos), drho2; split => //. by apply: subset_itvl; rewrite bnd_simp -lerBrDl safe_dist_itv. - exact: tad. move => t tad. -apply/esym; apply : cauchy_lipschitz_unique. +apply/esym; apply : cauchy_lipschitz_unique_restr. - apply/continuous_subspaceW/cf' => //. by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl;apply safe_dist_itv. - move=> t0 t0ad. @@ -2025,7 +2025,7 @@ rewrite !closed_ballE// /closed_ball_ /= => h1 h2. rewrite -(subrKA x1 x2). by rewrite (le_trans (ler_normD _ _))// (splitr q) lerD. Qed. -Theorem cauchy_lipschitz_unique' f' : +Theorem cauchy_lipschitz_unique f' : is_sol_oo phi u0 a (a + safe_dist) f' -> {in `[a, a + safe_dist]%R, f =1 f'}. Proof. From aebc28bb42ab67113884afdeab891e8117522963 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 25 Feb 2026 17:00:10 +0900 Subject: [PATCH 143/144] gen in tilt_analysis.v --- _CoqProject | 1 - ode.v | 14 +- ode_wip.v | 764 ----------------------------------------------- tilt_analysis.v | 139 ++++----- tilt_lyapunov.v | 11 +- tilt_stability.v | 2 +- 6 files changed, 66 insertions(+), 865 deletions(-) delete mode 100644 ode_wip.v diff --git a/_CoqProject b/_CoqProject index 4090d6d5..8d0d5664 100644 --- a/_CoqProject +++ b/_CoqProject @@ -28,7 +28,6 @@ tilt_robot.v tilt_stability.v tilt_lyapunov.v tilt_lasalle.v -ode_wip.v -R . robot diff --git a/ode.v b/ode.v index f7e47538..5c871b3e 100644 --- a/ode.v +++ b/ode.v @@ -1519,7 +1519,7 @@ rewrite (rowRintegral_itv_split (c := b) (F := (fun x => phi x (patch sol2 `[a, (fun x0 => phi x0 (patch sol2 `[a, b] sol1 x0))}. move => x0 x0ab. by rewrite /patch x0ab. - apply: (continuous_within_ext eq1). + apply: (subspace_eq_continuous eq1). exact: cont1. move : i. apply /within_continuous_coord. @@ -1531,9 +1531,9 @@ rewrite (rowRintegral_itv_split (c := b) (F := (fun x => phi x (patch sol2 `[a, apply: le_anti. move: x0ab xab. by rewrite inE/= !in_itv/= => /andP [-> _] /andP [_ ->]. - apply/continuous_subspaceW/(continuous_within_ext eq2)/cont2. - apply: subset_itvl; rewrite bnd_simp. - by move : tbc; rewrite in_itv/= => /andP[]. + apply: (@continuous_subspaceW _ _ _ `[b, c]). + by apply: subset_itvl; rewrite bnd_simp (itvP tbc). + exact: (subspace_eq_continuous eq2). apply: continuous_compact_integrable => //. exact: segment_compact. Qed. @@ -2148,7 +2148,7 @@ Proof. move => t0ab /= y By. move => t. apply: continuousN. -have /within_continuous_minus : {within `[-(-a), - (-t0)], continuous phi^~ y}. +have /within_continuous_compN : {within `[-(-a), - (-t0)], continuous phi^~ y}. rewrite !opprK. apply /continuous_subspaceW/cont1 => //. apply : subset_itvl. @@ -2200,7 +2200,7 @@ have cfminus' := And33 solminus. rewrite closure_neitv_oo in cfminus'; last by rewrite ltrDl. have cfminus : {within `[t0-dminus t0, t0], continuous fminus}. rewrite /fminus. - apply: within_continuous_minus. + apply: within_continuous_compN. apply/continuous_subspaceW/cfminus'. apply: subset_itvl; rewrite bnd_simp -/dminus. by rewrite opprD opprK. @@ -2240,7 +2240,7 @@ have lip2' : {in `[t0 - dboth t0 ,t0 + dboth t0], forall x, k.-lipschitz_B' (phi rewrite -lerBrDl. by rewrite !ge_min lexx. by split;apply Buneg. -have contf_minus : {within `[t0 - dboth t0, t0], continuous fminus}. +have contf_minus : {within `[t0 - dboth t0, t0], continuous fminus}. apply /continuous_subspaceW/cfminus. apply: subset_itvr. by rewrite bnd_simp /= lerD //= lerNr opprK 3!ge_min lexx !orbT. diff --git a/ode_wip.v b/ode_wip.v deleted file mode 100644 index 7bd4bd6b..00000000 --- a/ode_wip.v +++ /dev/null @@ -1,764 +0,0 @@ -From HB Require Import structures. -From mathcomp Require Import all_boot all_order ssralg ssrnum matrix interval. -From mathcomp Require Import poly archimedean generic_quotient ring_quotient. -From mathcomp Require Import mathcomp_extra boolp classical_sets. -From mathcomp Require Import functions reals interval_inference topology. -From mathcomp Require Import prodnormedzmodule tvs normedtype landau. -From mathcomp Require Import ereal sequences derive numfun measure realfun. -From mathcomp Require Import lebesgue_measure lebesgue_integral ftc. -Require Import tilt_analysis ode_common ode_contseg ode. - -(**md**************************************************************************) -(* # ODE wip *) -(* *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import Order.TTheory GRing.Theory Num.Def Num.Theory. -Import numFieldNormedType.Exports. - -Open Scope ring_scope. -Open Scope classical_set_scope. - -(* global Lipschitz condition -> the solution is always in a set where phi is Lipschitz *) -Section cauchy_lipschitzT. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U) (r : {posnum R}) (rho : {posnum R}). -Hypothesis rho1 : rho%:num < 1. -Hypothesis ab : a < b. -Hypothesis k0 : 0 < k. -(* lip2 and cont1 hold for any vector *) -Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_[set: 'rV_n] (phi x)}. -Hypothesis cont1 : {in [set: 'rV_n], forall y, {within `[a, b], continuous phi ^~ y}}. - -Let B := closed_ball u0 r%:num. - -Let lip2' : {in `[a, b]%R, forall x : R, k.-lipschitz_B (phi x)}. -Proof. -move=> t tab /= [x y] [/= Bx By]. -have : ([set: 'rV_n] `*` [set: 'rV_n]) (x, y) by rewrite setXTT. -by move=> /(lip2 tab); exact. -Qed. - -Let cont1' : {in B, forall y, {within `[a, b], continuous phi ^~ y}}. -Proof. by move=> t tab /=; apply: cont1; rewrite in_setT. Qed. - -Local Notation safe_dist := (safe_dist phi a b k u0 r rho). - -Definition lipschitzT_solution_f : continuousFunType `[a, a + safe_dist] [set: 'rV[R]_n] := - repr (picard_fix ab k0 lip2' cont1' rho1). - -Lemma lipschitzT_solution : - is_sol_oo phi u0 a (a + safe_dist) lipschitzT_solution_f. -Proof. -apply/(integral_sol_iff_sol (k:=k) (r:=r)) => //. -- by rewrite gt_eqF. -- by rewrite ltDl_safe_dist. -- move=> t td. - apply: lip2'. - by apply: subset_itvl td; rewrite bnd_simp -lerBrDl safe_dist_itv. -- move=> /= x xB. - apply/continuous_subspaceW/cont1 => //. - by apply: subset_itvl => /=; rewrite bnd_simp -lerBrDl safe_dist_itv. - by rewrite inE. -- exact: cts_fun. -- by move => _ [t tad] <-; exact: cauchy_lipschitz_in_cball. -- exact: cauchy_lipschitz_integral_version. -Qed. - -Lemma lipschitzT_solution_stays_in_ball : - {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (lipschitzT_solution_f t)}. -Proof. by move=> t; rewrite inE => /cauchy_lipschitz_in_cball; exact. Qed. - -Lemma lipschitzT_solution_continuous : - {within `[a, a + safe_dist], continuous lipschitzT_solution_f}. -Proof. exact: cts_fun. Qed. - -Let f := lipschitzT_solution_f. - -Theorem lipschitzT_cauchy_lipschitz_local : - safe_dist > 0 /\ - is_sol_oo phi u0 a (a + safe_dist) f /\ - {in `[a, a + safe_dist], forall t, closed_ball u0 r%:num (f t)}. -Proof. -split; first exact: safe_dist_gt0. -split. -- exact: lipschitzT_solution. -- exact: lipschitzT_solution_stays_in_ball. -Qed. - -End cauchy_lipschitzT. - -Lemma min2r (T : realDomainType) (a b c : T) : a <= c -> - (Num.min a b <= Num.min c b). -Proof. -rewrite /minr; have [ab|ba] := ltP a b; have [cb|bc] := ltP c b => //. -- by move=> _; exact: ltW. -- by move=> /le_lt_trans => /(_ _ cb); rewrite ltNge ba. -Qed. - -Section itv_partition_lemmas. -Context {R : realType}. -Variables a b : R. -Hypothesis ab : a < b. - -Lemma itv_partition_ex s x : itv_partition a b s -> - a <= x <= b -> - let I i := `[nth b (a :: s) i, nth b (a :: s) i.+1]%R in - exists2 i, (i < size s)%N & x \in I i. -Proof. -elim: s a b ab x => [a0 b0 a0b0 x|s0 s1 ih a0 b0 a0b0 x abs]. - move/itv_partition_nil => a0E. - by rewrite a0E ltxx in a0b0. -move=> /andP[a0x xb0]. -have [s0s1 /= /eqP s0s1b0] := itv_partition_cons abs. -rewrite -s0s1b0. -destruct s1 as [|s2 s3]. - exists O => //. - rewrite in_itv/= a0x/=. - case: abs => /=. - by rewrite andbT => a0s0 /eqP ->. -have s0b0 : s0 < b0. - have [] := itv_partition_cons abs. - move/order_path_min => /(_ lt_trans)/allP + /eqP <-. - apply. - by rewrite /= mem_last. -have [xs0|s0x] := ltP x s0. - exists 0 => //=. - by rewrite in_itv/= a0x (ltW xs0). -have := ih s0 b0 s0b0 x (itv_partition_cons abs). -rewrite s0x xb0 => /(_ isT)[i is3 Hx]. -exists i.+1 => //=. -suff : b0 = last s2 s3 by move=> <-. -have := itv_partition_cons abs. -by case => _ /= /eqP. -Qed. - -Lemma itv_partition_lt (delta : R) : 0 < delta -> - exists (delta' : R) s, - 0 < delta' < delta /\ - itv_partition a b s /\ - forall i, (i < size s)%N -> nth b (a :: s) i.+1 - nth b (a :: s) i < delta. -Proof. -move=> delta0. -pose delta' := delta / 2. -have delta'delta : delta' < delta. - by rewrite gtr_pMr// invf_lt1// ltr1n. -have delta'0 : 0 < delta' by rewrite divr_gt0. -have [Hnat_num|Hnat_num] := pselect ((b - a) / delta' \is a nat_num). - pose m := truncn ((b - a) / delta'). - have m0 : (0 < m)%N. - rewrite -(ltr_nat R). - move: Hnat_num; rewrite natrEtruncn => /eqP; rewrite -/m => ->. - by rewrite divr_gt0// subr_gt0. - have bE : a + delta' *+ m = b. - rewrite -mulr_natl. - move: Hnat_num; rewrite natrEtruncn => /eqP; rewrite -/m => ->. - by rewrite -mulrA mulVf ?mulr1 ?gt_eqF// subrKC. - pose s := (seq.map (fun k => a + delta' *+ k) (iota 1 m)). - have lasts : last b s = b. - rewrite /s -bE (@last_map _ _ (fun k => a + delta' *+ k)). - rewrite (_ : last _ _ = m)//. - rewrite {2}(_ : m = m.-1 + 1)%N//; last by rewrite addn1 prednK. - by rewrite iotaD/= cats1 last_rcons add1n prednK. - (* a - a + delta' - ... - a + m * delta' = b - size = m *) - have sm : size s = m by rewrite /s size_map size_iota. - have nth_itv_partition : - (forall i, (i <= m)%N -> nth b (a :: s) i = a + delta' *+ i). - move=> i im. - rewrite /s; destruct i as [|i] => /=. - by rewrite mulr0n addr0. - by rewrite (nth_map 0) ?size_iota// nth_iota. - exists delta', s. - split. - by apply/andP; split. - split. - split; last first. - rewrite -nth_last -lasts -nth_last; apply/eqP. - apply: set_nth_default. - by rewrite sm prednK. - apply/(pathP b) => i si. - destruct i as [|i] => /=. - by rewrite (nth_map 0) ?size_iota// nth_iota// addn0 mulr1n ltrDl. - have im : (i < m)%N by rewrite -sm (leq_trans _ si). - rewrite /s (nth_map 0) ?size_iota// nth_iota//. - rewrite (nth_map 0) ?size_iota//; last by rewrite -sm. - rewrite nth_iota; last by rewrite -sm. - by rewrite !add1n ltrD2l [in ltRHS]mulrS ltrDr. - move=> i si. - rewrite nth_itv_partition; last by rewrite -sm. - rewrite nth_itv_partition; last by rewrite -sm ltnW. - by rewrite mulrS (addrCA _ delta') addrK. -pose m := (truncn ((b - a) / delta')).+1. -pose s := rcons (seq.map (fun k => a + delta' *+ k) (iota 1 m.-1)) b. -have m0 : (0 < m)%N by []. -(* a - a + delta' - ... - a + (m - 1) * delta' - b - size = m + 1 *) -have sm1 : size s = m by rewrite /s size_rcons size_map size_iota prednK. -have nth_itv_partition : - (forall i, (i < m)%N -> nth b (a :: s) i = a + delta' *+ i). - move=> i im. - rewrite /s; destruct i as [|i] => /=. - by rewrite mulr0n addr0. - rewrite nth_rcons size_map size_iota. - case: ifPn => im1. - by rewrite (nth_map 0) ?size_iota// nth_iota. - move: im1. - by rewrite -(ltn_add2r 1) !addn1 -/m im. -have asrhok_last : nth b (a :: s) m - nth b (a :: s) m.-1 <= delta'. - rewrite {1}(_ : m = (size (a :: s)).-1)// nth_last. - rewrite {1}/s /= last_rcons. - rewrite nth_itv_partition//. - rewrite opprD addrA lerBlDl -mulrSr -/m. - rewrite -mulr_natl -ler_pdivrMr//. - by rewrite /m ltW// real_truncnS_gt// num_real. -exists delta', s. -split. - by apply/andP; split. -split. - split; last by rewrite last_rcons. - apply/(pathP b) => i si. - destruct i as [|i] => /=. - rewrite /s nth_rcons size_map size_iota. - case: ifPn => m10. - by rewrite (nth_map 0) ?size_iota// nth_iota// addn0 mulr1n ltrDl. - by rewrite if_same. - rewrite /s !nth_rcons size_map size_iota. - have im1 : (i < m.-1)%N. - by rewrite -(ltn_add2r 1) !addn1 prednK// -sm1. - rewrite im1 (nth_map 0) ?size_iota// nth_iota//. - case: ifPn => i1m1. - rewrite (nth_map 0) ?size_iota//. - by rewrite nth_iota// !add1n ltrD2l [in ltRHS]mulrS ltrDr. - rewrite if_same add1n. - have {}i1m1 : i.+1 = m.-1 by apply/eqP; rewrite eqn_leq im1 leqNgt i1m1. - rewrite i1m1. - rewrite -ltrBrDl -mulr_natl -ltr_pdivlMr//. - rewrite /m/= lt_neqAle. - apply/andP; split. - by rewrite -natrEtruncn//; exact/negP. - by rewrite truncn_le divr_ge0// ltW// subr_gt0. -move=> i. -rewrite leq_eqVlt => /predU1P[i1s|si1]. - rewrite i1s. - rewrite (_ : (size s) = (size (a :: s)).-1)//. - rewrite nth_last/= last_rcons. - rewrite nth_itv_partition//; last by rewrite -sm1 -i1s. - rewrite (le_lt_trans _ delta'delta)//. - rewrite opprD addrA lerBlDl -mulrSr -/m. - rewrite -mulr_natl -ler_pdivrMr// /m ltW// i1s sm1. - by rewrite real_truncnS_gt// num_real. -rewrite nth_itv_partition//; last by rewrite -sm1. -rewrite nth_itv_partition//; last by rewrite -sm1 (leq_trans _ si1). -by rewrite mulrS (addrCA _ delta') addrK. -Qed. - -End itv_partition_lemmas. - -Section itv_partition_porder. -Context {d} {T : porderType d}. -Implicit Types (a b x : T) (s : seq T). - -Let itv_partition_in_itv a b s : - itv_partition a b s -> {in s, forall x, x \in `]a, b]%R}. -Proof. -move=> /[dup]parts. -move=> [/[dup]/lt_path_min/allP sa]. -move=> /[dup]pas. -rewrite lt_path_pairwise. -move/pairwiseP => pwltas. -move/eqP => lsb. -move=> x xs. -rewrite in_itv/=; apply/andP; split; first exact: sa. -rewrite -lsb (last_nth a). -have xas : x \in a :: s by rewrite in_cons; apply/orP; right. -rewrite -(nth_index a xas). -rewrite le_eqVlt; apply/predU1P. -rewrite -implyNp => nlast. -apply: pwltas. -- rewrite inE/=. - case: ifP => // _. - by rewrite ltnS index_mem. -- by rewrite inE//. -- rewrite /=. - move: s lsb parts sa pas x nlast xs xas. - apply: last_ind => // s t IH. - rewrite last_rcons => ->. - move=> patsb asb psb x/[swap] xsb. - rewrite nth_index; last first. - by rewrite in_cons; apply/orP; right. - move/[swap] => _. - rewrite -last_nth last_rcons => xb. - rewrite ifN; last first. - by rewrite lt_eqF// asb. - rewrite (_ : index x (rcons s b) = index x s); last first. - rewrite -cats1 index_cat. - rewrite ifT//. - move: xsb. - by rewrite mem_rcons in_cons => /predU1P; case. - rewrite size_rcons ltnS. - rewrite index_mem. - move: xsb. - rewrite mem_rcons in_cons. - by move/predU1P; case. -Qed. - -Lemma itv_partition_gt_lb a b s : (a < b)%O -> - itv_partition a b s -> forall n, (a < nth b s n)%O. -Proof. -move=> ab ps n. -have [ns|ns] := ltnP n (size s). - suff : nth b s n \in `]a, b]%R. - by rewrite in_itv/= => /andP[]. - apply: (itv_partition_in_itv ps). - exact: mem_nth. -by rewrite nth_default. -Qed. - -Lemma itv_partition_le_ub a b s : - itv_partition a b s -> forall n, (nth b s n <= b)%O. -Proof. -move=> ps n. -have [ns|ns] := ltnP n (size s). - suff : nth b s n \in `]a, b]%R. - by rewrite in_itv/= => /andP[]. - apply: (itv_partition_in_itv ps). - exact: mem_nth. -by rewrite nth_default. -Qed. - -Lemma itv_partition_head_in_itv a b s t : - itv_partition a b (rcons s t) -> {in s, forall x, x \in `]a, b[%R}. -Proof. -move=> pst x xs. -have in_ab := itv_partition_in_itv pst. -rewrite in_itv/=; apply/andP; split. - have := in_ab x. - rewrite mem_rcons in_cons. - have H : (x == t) || (x \in s) by apply/orP; right. - by move/(_ H); rewrite in_itv/= => /andP[ax xb]. -have [] := pst. -rewrite lt_path_pairwise. -move/pairwiseP => lt_ast. -move/eqP <-; rewrite (last_nth a). -have : x \in a :: (rcons s t). - rewrite in_cons; apply/orP; right. - by rewrite mem_rcons in_cons xs orbT. -move/(nth_index a) <-. -apply: lt_ast; last 2 first. -- by rewrite inE. -- rewrite /=. - rewrite ifF; last first. - rewrite lt_eqF => //. - have [/lt_path_min/allP + _] := pst. - by apply; rewrite mem_rcons in_cons xs orbT. - by rewrite size_rcons -cats1 index_cat xs ltnS index_mem. -rewrite inE index_mem. -rewrite in_cons; apply/orP; right. -by rewrite mem_rcons in_cons xs orbT. -Qed. - -Lemma itv_partition_lt_ub a b s : - itv_partition a b s -> forall n, (n.+1 < size s)%N -> (nth b s n < b)%O. -Proof. -elim/last_ind : s => // s0 s1 _ ps n. -rewrite size_rcons ltnS => ns0. -pose s := rcons s0 s1. -rewrite -/s. -suff : nth b s n \in `]a, b[%R. - by rewrite in_itv/= => /andP[]. -apply: (@itv_partition_head_in_itv _ _ s0 s1) => //. -apply/(nthP b). -exists n => //. -by rewrite nth_rcons ns0. -Qed. - -End itv_partition_porder. - -Definition piecewise {R : realType} (U : normedModType R) - (f : nat -> R -> U) (a b : R) (s : seq R) (P : (R -> U) -> R -> Prop) := - forall i : nat, (i < size s)%N -> - forall x : R, - nth b (a :: s) i <= x <= nth b (a :: s) i.+1 -> - P (f i) x. - -Definition patched {R : realType} (U : normedModType R) - (f : nat -> R -> U) (a b : R) (s : seq R) (F : R -> U) := - forall x : R, - forall i : nat, (i < size s)%N -> - nth b (a :: s) i <= x <= nth b (a :: s) i.+1 -> - f i x = F x. - -Lemma piecewise_derivable {R : realType} (U : normedModType R) - (f : nat -> R -> U) (a b : R) (s : seq R) (abs : itv_partition a b s) - (F : R -> U) : - patched f a b s F -> - piecewise f a b s (fun g x => derivable g x 1) -> - forall x, x \in `[a, b] -> derivable F x 1. -Proof. -Admitted. - -Lemma piecewise_continuous {R : realType} (U : normedModType R) - (f : nat -> R -> U) (a b : R) (s : seq R) (abs : itv_partition a b s) - (F : R -> U) : - patched f a b s F -> - piecewise f a b s (fun g x => continuous_at x g) -> - forall x, x \in `[a, b] -> continuous_at x F. -Proof. -Admitted. - -(* Theorem 3.2: global existence and uniqueness *) -Section cauchy_lipschitz_global. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (a b : R) (k : R) (u0 : U). -Hypothesis ab : a < b. -Hypothesis k0 : 0 < k. -Hypothesis lip2 : {in `[a, b]%R, forall x : R, k.-lipschitz_[set: 'rV[R]_n] (phi x)}. -Hypothesis cont1 : {in [set: 'rV[R]_n], forall y, {within `[a, b], continuous phi ^~ y}}. - -Let elt_prop (f : (R -> U) * (R * R) * nat) := True. - -Let elt_type := {f : (R -> U) * (R * R) * nat | elt_prop f}. - -Let f_ (x : elt_type) := (proj1_sig x).1.1. -Let a_ (x : elt_type) := (proj1_sig x).1.2.1. -Let b_ (x : elt_type) := (proj1_sig x).1.2.2. -Let i_ (x : elt_type) := (proj1_sig x).2. - -Let elt_rel i j := f_ j (a_ j) = f_ i (b_ i). - -Theorem cauchy_lipschitz_global : exists f : R -> 'rV_n (*: continuousFunType `[a, b] [set: 'rV[R]_n]*), - is_sol_oo phi u0 a b f. -Proof. -near (0:R)^'+ => rho'. -have rho'_gt0 : 0 < rho' by []. -have rho'_lt1 : rho' < 1 by []. -pose rho := PosNum rho'_gt0. -have rho1 : rho%:num < 1 by []. -have r_gt0 init a' b' : 0 < (rho%:num * sup_phi phi a' b' init / ((1 - rho%:num) * k)) + 1. - rewrite ltr_wpDl// mulr_ge0 ?invr_ge0// mulr_ge0// ?subr_ge0. - exact: sup_phi_ge0. - exact: ltW. - exact: ltW. -have [barhok|barhok] := leP (b - a) (rho%:num / k). - pose h := sup [set `|phi t u0| | t in `[a, b]]. - have {}r_gt0 : 0 < (rho%:num * h / ((1 - rho%:num) * k)) + 1. - by rewrite r_gt0// sup_phi_ge0. - pose r := PosNum r_gt0. - have Hr : r%:num / (k * r%:num + h) > rho%:num / k. - rewrite ltr_pdivlMr; last first. - rewrite ltr_wpDr//. - exact: sup_phi_ge0. - by rewrite mulr_gt0. - rewrite mulrAC -ltr_pdivlMr ?invr_gt0// invrK. - rewrite mulrDr -ltrBrDl -[X in _ < X - _]mul1r (mulrC k). - rewrite -mulrBl mulrCA -ltr_pdivrMr; last by rewrite mulr_gt0// subr_gt0. - by rewrite /= ltrDl. - have safe_distba : safe_dist phi a b k u0 (PosNum r_gt0) rho = b - a. - rewrite /safe_dist; apply/min_idPl. - rewrite le_min barhok andbT. - rewrite (le_trans barhok)//. - exact: ltW. - exists (@lipschitzT_solution_f R n phi a b k u0 r rho rho1 ab k0 lip2 cont1). - have [d0 [[fau0 H1] H2 H3]] := - @lipschitzT_cauchy_lipschitz_local R n phi a b k u0 r rho rho1 ab k0 lip2 cont1. - split => //. - move=> t tab. - apply H1. - by apply: subset_itvl tab; rewrite bnd_simp safe_distba subrKC. - apply: continuous_subspaceW H2. - apply: subset_trans; first exact: itv_closure. - rewrite closure_neitv_oo ?ltDl_safe_dist//. - apply: subset_itvl; rewrite bnd_simp -lerBlDl. - by rewrite safe_distba. -have [delta /andP[delta_gt0 delta_rhok]] : exists delta, 0 < delta <= rho%:num / k. - admit. -have [delta' [s [/andP[delta'0 delta'delta] [abs nthdelta']]]] : exists (delta' : R) s, - 0 < delta' < delta /\ - itv_partition a b s /\ - forall i, (i < size s)%N -> nth b (a :: s) i.+1 - nth b (a :: s) i < delta. - exact: itv_partition_lt. -have sizes_gt0 : (0 < size s)%N. - move: abs. - destruct s => //. - case => /= _ /eqP ?; subst b. - move: ab. - by rewrite ltxx. -have Ilt i : (i < size s)%N -> nth b (a :: s) i < nth b (a :: s) i.+1. - move=> si; case: abs => sa /eqP asb. - by move/(pathP b) : sa; apply. -pose I i := `[nth b (a :: s) i, nth b (a :: s) i.+1]%R. -have Iiab i : [set` I i] `<=` `[a, b]. - have [si|si] := leqP i (size s). - move=> x/=. - rewrite !in_itv/= => /andP[ix xi]; apply/andP. - destruct i as [|i] => //. - rewrite ix; split => //. - rewrite (le_trans xi)//. - destruct s as [|s0 s1] => //=. - case: abs => /= /andP[as0]. - move/order_path_min => /(_ lt_trans)/allP H /eqP s0s1b. - destruct s1 as [|s1 s2]. - by rewrite /= in s0s1b; rewrite s0s1b. - by apply/ltW/H; rewrite -s0s1b /= mem_last. - split. - rewrite (le_trans _ ix)// ltW//. - case: abs => /order_path_min => /(_ lt_trans)/allP + _. - apply. - by apply/(nthP b); exists i. - rewrite (le_trans xi)//. - case: abs => sa /eqP asb. - move: si; rewrite leq_eqVlt => /predU1P[->|si]. - by rewrite nth_default. - rewrite -{2} asb (last_nth b) -(@prednK (size s)); last by rewrite (leq_trans _ si). - apply: sorted_leq_nth => //. - - exact: le_trans. - - apply: path_sorted. - apply: sub_path sa. - by move=> ? ? /ltW. - - by rewrite inE prednK// (leq_trans _ si). - - by rewrite -(ltn_add2r 1) !addn1 (leq_trans si)// prednK// (leq_trans _ si). - have -> : [set` I i] = [set b]. - apply/seteqP; split => [x/=|]. - rewrite in_itv/=. - rewrite nth_default/=//. - rewrite nth_default; last exact: ltnW. - by rewrite -eq_le => /eqP. - move=> _ /= ->. - rewrite in_itv/=. - rewrite nth_default/=//. - rewrite nth_default; last exact: ltnW. - by rewrite !lexx. - move=> x/= ->. - by rewrite bound_itvE ltW. -have pickup_itv (x : R) : x \in `[a, b] -> exists2 i : nat, (i < size s)%N & x \in I i. - move=> xab; apply: itv_partition_ex => //. - by move: xab; rewrite inE/= in_itv. -have lip2'' (i : nat) : (i <= size s)%N -> {in I i, forall x : R, k.-lipschitz (phi x)}. - move=> im. - apply/in_switch/(@lipschitzW _ _ _ _ _ `[a, b]). - exact: Iiab. - apply/in_switch => t tab [X Y] [/= u0rX u0rY]. - have /(_ (X, Y)) := lip2 tab. - exact. -have cont1'' (i : nat) : (i <= size s)%N -> - {in [set: 'rV_n], forall y : 'rV_n, {within [set` I i], continuous phi^~ y}}. - move=> si /= t tu0r. - apply: (@continuous_subspaceW _ _ _ `[a, b]); last exact: cont1. - exact: Iiab. -pose h0 := sup_phi phi a (nth b (a :: s) 1). -pose f_0 : R -> U := - @lipschitzT_solution_f R n phi a (nth b (a :: s) 1) k u0 - (PosNum (r_gt0 u0 a (nth b (a :: s) 1))) rho rho1 - (Ilt _ sizes_gt0) k0 (lip2'' _ (ltnW sizes_gt0)) (cont1'' _ (ltnW sizes_gt0)). -have [v [v0 Pv]] : {v : nat -> elt_type | - v 0%N = exist _ (f_0, (a, nth b (a :: s) 1), O) Logic.I /\ - forall n, elt_rel (v n) (v n.+1)}. - apply: dependent_choice => -[[[f [a' b']] i']] []. - pose init0 : U := f b'. - pose a'' := nth b (a :: s) i'.+1. - have [i's|i's] := ltnP (i'.+1) (size s)%N. - pose b'' := nth b (a :: s) i'.+2. - pose f_i : R -> U := - @lipschitzT_solution_f R n phi a'' b'' k init0 - (PosNum (r_gt0 init0 a'' b'')) - rho rho1 (Ilt _ i's) k0 (lip2'' _ (ltnW i's)) (cont1'' _ (ltnW i's)). - exists (exist _ (f_i, (a'', b''), i'.+1) Logic.I). - rewrite /elt_rel. - rewrite /f_/=. - have [/=] := lipschitzT_solution init0 (PosNum (r_gt0 init0 a'' b'')) rho1 - (Ilt i'.+1 i's) k0 (lip2'' i'.+1 (ltnW i's)) (cont1'' i'.+1 (ltnW i's)). - move=> + _ _. - rewrite -/f_i. - rewrite /init0. - rewrite /a_/=. - rewrite /b_/= => <-. - by rewrite /a''/=. - apply/cid. - move: i's; rewrite leq_eqVlt => /predU1P[i's|i's]. - have a''E : a'' = last b s. - rewrite /a'' -i's. - rewrite -last_nth//. - rewrite -!nth_last. - apply: set_nth_default. - by rewrite prednK. - case: abs => _ /eqP asb. - have {}a''E : a'' = b. - rewrite a''E. - rewrite -nth_last -[RHS]asb -nth_last. - apply: set_nth_default. - by rewrite prednK. - exists (exist _ ((cst (f b')), (b, b), i'.+1) Logic.I). - rewrite /elt_rel/=. - rewrite /f_/=. - by rewrite /a_ /b_ /=. - have a''E : a'' = last b s. - rewrite /a'' /= nth_default//. - case: abs => _ /eqP asb. - rewrite -[LHS]asb -!nth_last. - apply: set_nth_default. - by rewrite prednK. - exists (exist _ ((cst (f b')), (b, b), i'.+1) Logic.I). - rewrite /elt_rel/=. - rewrite /f_/=. - by rewrite /a_ /b_ /=. -pose pickup_itv_fun (x : R) : nat := - match pselect (x \in `[a, b]) with - | left H => sval (cid2 (pickup_itv x H)) - | right _ => 0 - end. -exists (fun x => - match pselect (x \in `[a, b]) with - | left H => let i := sval (cid2 (pickup_itv x H)) in - let im : (i < size s)%N := (svalP (cid2 (pickup_itv x H))).1 in - let xIi : x \in I i := (svalP (cid2 (pickup_itv x H))).2 in - f_ (v i) x - | right _ => \row_(i < n) 0 - end). -split. -- case: pselect; last first. - by rewrite inE/= bound_itvE (ltW ab). - move=> ?. - rewrite /=. - case: cid2 => // i/= si aIi. - rewrite /f_/=. - have i0 : i = 0. - apply/eqP/negPn. - rewrite -lt0n; apply/negP => i0. - move: aIi. - rewrite in_itv/= => /andP[ia ai]. - move: ia. - rewrite leNgt => /negP; apply. - destruct i as [|i] => //=. - apply: itv_partition_gt_lb. - done. - done. - rewrite i0 v0/=. - have := lipschitzT_solution u0 (PosNum (r_gt0 u0 a (nth b (a :: s) 1))) rho1 - (Ilt 0%N sizes_gt0) k0 (lip2'' 0%N (ltnW sizes_gt0)) (cont1'' 0%N (ltnW sizes_gt0)). - by case => //. -- move=> t tab; split. - admit. - admit. -- rewrite closure_neitv_oo//. - apply/(continuous_within_itvP _ ab); split. - + move=> t tab. - rewrite /continuous_at. - admit. - + admit. - + admit. -Abort. - -End cauchy_lipschitz_global. - -Section exe325. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (a b : R) (k : R). -Hypothesis k0 : 0 < k. -Variable D : set U. -Hypothesis lip2 : {in `[a, b]%R, forall t : R, k.-lipschitz_D (phi t)}. -Hypothesis cont1 : {in D, forall x : U, {within `[a, b], continuous phi ^~ x}}. -Variable W : set U. -Hypothesis compactW : compact W. -Variable u0 : U. -Hypothesis u0W : u0 \in W. - -Variable f : R -> U. -Hypothesis fder : forall t, derivable f t 1 /\ 'D_1 f t = phi t (f t). -Hypothesis fini : f a = u0. - -Variable T : R. -Hypothesis xW : forall t, t \in `[a, T[%R -> t < b. - -Lemma exe325a : @unif_continuous (subspace `[a, T[) U f. -Proof. -Admitted. - -Lemma exe325b1 : forall t, t \in `[a, T[ -> f t \in W. -Proof. -Admitted. - -Lemma exe325b2 : is_sol_oo phi u0 a T f. -Proof. -Admitted. - -Lemma exe325b3 : exists2 delta, delta > 0 & is_sol_oo phi u0 a (T + delta) f. -Proof. -Admitted. - -End exe325. - -Section exe326. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (a b : R) (k : R). -Hypothesis k0 : 0 < k. -Variable D : set U. -Hypothesis lip2 : {in `[a, b]%R, forall t : R, k.-lipschitz_D (phi t)}. -Hypothesis cont1 : {in D, forall x : U, {within `[a, b], continuous phi ^~ x}}. - -Variable T : R. -Hypothesis aTab : `[a, T[ `<=` `[a, b]. -Variable f : R -> U. -Variable u0 : U. -Hypothesis fsol : is_sol_oo phi u0 a T f. - -Variable W : set U. -Hypothesis compactW : compact W. -Hypothesis u0W : u0 \in W. - -Lemma exe326 : exists t, t \in `[a, T[%R /\ f t \notin W. -Proof. -Admitted. - -End exe326. - -Section cauchy_lipschitz_nonlocal. -Context {R : realType} {n : nat}. -Notation U := 'rV[R]_n. -Variables (phi : R -> U -> U) (a : R) (k : R). -Hypothesis k0 : 0 < k. -Variable D : set U. -Hypothesis lip2 : {in `[a, +oo[%R, forall t : R, k.-lipschitz_D (phi t)}. -Hypothesis cont1 : {in D, forall x : U, {within `[a, +oo[, continuous phi ^~ x}}. - -Variable W : set U. -Hypothesis compactW : compact W. -Variable u0 : U. -Hypothesis u0W : u0 \in W. -Hypothesis solW : forall f : R -> U, - (forall t, derivable f t 1 /\ 'D_1 f t = phi t (f t)) /\ f a = u0 - -> forall t, f t \in W. - -Lemma thm33 : exists !f, (forall t, t \in `[a, +oo[ -> derivable f t 1 /\ - 'D_1 f t = phi t (f t)) /\ - f a = u0. -Proof. -have @rho : {posnum R}. - admit. -(* by thm31, there is a unique local solution over `[a, a + delta[*) -have @T : R. - (* [a, T[ is the maximum interval of the solution above *) - admit. -have @y : R -> U. - (* a solution on [a, T[ *) - admit. -(* if T is finite, y must leave W -> absurd *) -(* therefore T = +oo, cqfd *) -Abort. - -End cauchy_lipschitz_nonlocal. diff --git a/tilt_analysis.v b/tilt_analysis.v index 824ccb99..f5cab06e 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -42,6 +42,56 @@ Qed. End Rintegral. +Lemma within_continuousB {T : topologicalType} {K : numFieldType} + {V : pseudoMetricNormedZmodType K} (A : set T) (f g : T -> V) : + {within A, continuous f} -> {within A, continuous g} -> + {within A, continuous (f - g)}. +Proof. by move=> cf cg x; apply: cvgB; [exact: cf|exact: cg]. Qed. + + +Lemma within_continuous_comp {U V W : topologicalType} + (A : set V) (f : V -> U) (g : U -> W) : + {in f @` A, continuous g} -> + {within A, continuous f} -> + {within A, continuous (g \o f)}. +Proof. +move=> cg /subspace_sigL_continuousP cf; apply/subspace_sigL_continuousP. +rewrite /sigL -compA => /= x; apply: continuous_comp; first exact: cf. +by apply/cg/image_f; rewrite inE; exact/set_valP. +Qed. + +Lemma within_continuous_compN {R : realFieldType} {K : numDomainType} + {U : pseudoMetricNormedZmodType K} (f : R -> U) (a b : R) : + {within `[- b, - a], continuous f} -> {within `[a, b], continuous (f \o -%R)}. +Proof. +have [ab|ba _ |-> _] := ltgtP a b; last 2 first. + by rewrite set_itv_ge ?bnd_simp -?ltNge//; exact: continuous_subspace0. + by rewrite set_itv1; exact: continuous_subspace1. +move/continuous_within_itvP; rewrite ltrN2 => /(_ ab)[cf fb fa]. +apply/(continuous_within_itvP _ ab); split. +- move=> t tab. + apply: (@cvg_comp _ _ _ -%R f); first exact: oppr_continuous. + by apply: cf; rewrite oppr_itvoo !opprK. +- by rewrite -{1}(opprK a); apply/cvg_at_leftNP; exact: fa. +- by rewrite -{1}(opprK b); apply/cvg_at_rightNP; exact: fb. +Qed. + +(* TODO: PR to MCA *) +Lemma nbhs_ge {R : realFieldType} (t x : R) : + t < x -> \forall x0 \near nbhs x, t <= x0. +Proof. +move=> tx. +exists ((x - t) / 2). + by rewrite /= divr_gt0// subr_gt0. +move=> y/=. +have [xy|yx] := lerP x y. + rewrite ltrBlDl => H. + by rewrite (le_trans (ltW tx)). +rewrite ltrBlDl -ltrBlDr => /ltW; apply: le_trans. +rewrite -lerBlDr opprK. +by rewrite -lerBrDl ler_piMr ?invf_le1 ?ler1n// subr_ge0 ltW. +Qed. + (* TODO: PR *) Section vector_continuous. Context {R : realType} {n : nat}. @@ -73,25 +123,6 @@ Unshelve. all: by end_near. Qed. End vector_continuous. -Lemma continuous_within_ext {A B : topologicalType} (g h : A -> B) D : - {in D, g =1 h} -> - {within D, continuous g } -> {within D, continuous h}. -Proof. -move=> h1 h2. -apply subspace_continuousP. -move => x Dx. -apply : cvg_trans. -apply (fmap_within_eq (g := g)) => //. -apply nbhs_filter. -move => x' Dx' . -symmetry. -by apply h1. -rewrite <-h1. -move /subspace_continuousP : h2. -by apply. -by rewrite inE. -Qed. - (* PR to MCA *) Section continuous_patch. Context {R : realType} {n : nat} {U : normedModType R}. @@ -115,10 +146,8 @@ have -> : `[a, c] = `[a, b] `|` `[b, c]. move=> ->; left => /=. by rewrite bound_itvE ltW. apply: (withinU_continuous (@itv_closed _ _ a b) (@itv_closed _ _ b c)). - have eq1 : {in `[a, b], f =1 patch g `[a, b] f }. - by move=> r rab; rewrite /patch rab. - apply: (continuous_within_ext eq1). - exact: cont1. + apply: subspace_eq_continuous cont1. + by move=> /=r rab; rewrite /from_subspace /patch rab. have eq2 : {in `[b, c], g =1 patch g `[a, b] f }. move=> r rab. rewrite /patch; case: ifPn => [xab | xabnot] => //. @@ -126,36 +155,11 @@ have eq2 : {in `[b, c], g =1 patch g `[a, b] f }. apply: le_anti. move: rab xab. by rewrite !inE/=!in_itv/= => /andP [-> _] /andP [_ ->]. -apply/continuous_subspaceW/(continuous_within_ext eq2)/cont2. -by apply: subset_itvl; rewrite bnd_simp. +exact: (subspace_eq_continuous eq2). Qed. End continuous_patch. -Lemma within_continuousB {K : realType} {V : normedModType K} - (A : set K) (f g : _ -> V) : - {within A, continuous f} -> {within A, continuous g} -> - {within A, continuous (f - g)}. -Proof. -by move=> cf cg x; apply: cvgB; [exact: cf|exact: cg]. -Qed. - -(* TODO: PR to MCA *) -Lemma nbhs_ge {R : realFieldType} (t x : R) : - t < x -> \forall x0 \near nbhs x, t <= x0. -Proof. -move=> tx. -exists ((x - t) / 2). - by rewrite /= divr_gt0// subr_gt0. -move=> y/=. -have [xy|yx] := lerP x y. - rewrite ltrBlDl => H. - by rewrite (le_trans (ltW tx)). -rewrite ltrBlDl -ltrBlDr => /ltW; apply: le_trans. -rewrite -lerBlDr opprK. -by rewrite -lerBrDl ler_piMr ?invf_le1 ?ler1n// subr_ge0 ltW. -Qed. - Lemma norm_rowmx {K : rcfType} {m n1 n2 : nat} (A1 : 'M[K]_(m.+1, n1.+1)) (A2 : 'M[K]_(m.+1, n2.+1)) : `|row_mx A1 A2| = Num.max `|A1| `|A2|. @@ -369,43 +373,6 @@ split => [h x xI| h x xI]; apply h. by rewrite inE in xI. Qed. -Lemma within_continuous_comp {R : realType} {K : numDomainType} - {U : pseudoMetricNormedZmodType K} a y (g : U -> R) (f : R -> U) : - a <= y -> - {in f @` `[a, y], continuous g} -> - {within `[a, y], continuous (fun x => f x)} -> - {within `[a, y], continuous fun x => (g \o f) x}. -Proof. -rewrite le_eqVlt => /predU1P[<- _ _|ay cg]. - by rewrite set_itv1; exact: continuous_subspace1. -move/(continuous_within_itvP f ay) => -[cf fa fy]. -apply/continuous_within_itvP => //; split => //. -- move=> z zay; apply: continuous_comp => //. - exact: cf. - apply/cg/image_f. - by rewrite inE/=; apply: subset_itv_oo_cc zay. -- apply/(cvg_comp f g fa)/cg/image_f. - by rewrite inE/= in_itv/= lexx/= ltW. -- apply/(cvg_comp f g fy)/cg/image_f. - by rewrite inE/= in_itv/= lexx/= ltW. -Qed. - -Lemma within_continuous_minus {R : realType} {K : numDomainType} - {U : pseudoMetricNormedZmodType K} (f : R -> U) (a b : R) : - {within `[- b, - a], continuous f} -> {within `[a, b], continuous f \o -%R}. -Proof. -have [ab|ba _ |-> _] := ltgtP a b; last 2 first. - by rewrite set_itv_ge ?bnd_simp -?ltNge//; exact: continuous_subspace0. - by rewrite set_itv1; exact: continuous_subspace1. -move/continuous_within_itvP; rewrite ltrN2 => /(_ ab)[cf fb fa]. -apply/(continuous_within_itvP _ ab); split. -- move=> t tab. - apply: (@cvg_comp _ _ _ -%R f); first exact: oppr_continuous. - by apply: cf; rewrite oppr_itvoo !opprK. -- by rewrite -{1}(opprK a); apply/cvg_at_leftNP; exact: fa. -- by rewrite -{1}(opprK b); apply/cvg_at_rightNP; exact: fb. -Qed. - Lemma lsubmx_norm_le {K : rcfType} n1 n2 (x : 'rV[K]_(n1.+1 + n2.+1)) : `|lsubmx x| <= `|x|. Proof. diff --git a/tilt_lyapunov.v b/tilt_lyapunov.v index 55589dcb..56967e71 100644 --- a/tilt_lyapunov.v +++ b/tilt_lyapunov.v @@ -562,12 +562,11 @@ have norm_constant t0 : t0 \in `[0, D[%R -> by rewrite ltW// (itvP t0d'). have {t0d'' hd0} := cc_is_derive_0_is_cst t0d'' _ hd0. apply => //; last by rewrite bound_itvE (itvP t0d'). - apply: (@within_continuous_comp _ _ _ _ _ (fun x => `|'e_2 - Right x|_e ^+ 2) y) => //=. - by rewrite (itvP t0d'). - move=> z _. - apply: differentiable_continuous => //. - apply: differentiable_enorm_squared => /=. - exact: differentiableB. + apply: (@within_continuous_comp _ _ _ `[0, t0] y (fun x => `|'e_2 - Right x|_e ^+ 2)) => //=. + move=> z _. + apply: differentiable_continuous => //. + apply: differentiable_enorm_squared => /=. + exact: differentiableB. rewrite /sol_is_deriv_co/= in deri. have cont : {in `[0, t0]%R, continuous y}. move=> t' t'0D. diff --git a/tilt_stability.v b/tilt_stability.v index 0ac77212..e750dc30 100644 --- a/tilt_stability.v +++ b/tilt_stability.v @@ -490,7 +490,7 @@ have Df_Omega_beta D f : f 0 \in Init -> sol_is_deriv_co (fun=> phi) 0 D f -> have [t1 /andP[t1_ge0 t1t] phit1r] : exists2 t0, 0 <= t0 <= t & `|f t0| = r. have t0 : 0 <= t by rewrite (itvP t0D). have norm_phi_cont : {within `[0, t]%classic, continuous (normr \o f)}. - apply/(@within_continuous_comp _ _ _ _ _ (@normr _ _) f t0) => //. + apply/(@within_continuous_comp _ _ _ `[0, t] f (@normr _ _)) => //. by move=> z _; exact: norm_continuous. have : {in `[0, D[, continuous f}. move=> t'; rewrite inE => t'0D. From e17af88113e4743470d43a115f26a28bd87f1b34 Mon Sep 17 00:00:00 2001 From: Reynald Affeldt Date: Wed, 25 Feb 2026 17:29:36 +0900 Subject: [PATCH 144/144] cleaning --- tilt_analysis.v | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/tilt_analysis.v b/tilt_analysis.v index f5cab06e..2ec25d90 100644 --- a/tilt_analysis.v +++ b/tilt_analysis.v @@ -94,31 +94,29 @@ Qed. (* TODO: PR *) Section vector_continuous. -Context {R : realType} {n : nat}. +Context {R : realFieldType} {n : nat}. Let U := 'rV[R]_n. -Lemma within_continuous_coord (h : R -> U) D : - {within D, continuous h} <-> forall i, {within D, continuous (fun x => h x ord0 i)}. +Lemma within_continuous_coord A (f : R -> U) : + {within A, continuous f} <-> + forall i, {within A, continuous (fun x => f x ord0 i)}. Proof. -split=> [Dh i|H]. +split=> [Af i|Af]. - apply/subspace_continuousP => /= x Dx. - have /subspace_continuousP/(_ x Dx) H := Dh. - apply: ((@cvg_comp _ _ _ h (fun z => z ord0 i)) _ _ _ H). + have /subspace_continuousP/(_ x Dx) Afx := Af. + apply: (cvg_comp f (fun z => z ord0 i) Afx). exact: coord_continuous. -- apply/subspace_continuousP => /= x Dx. - apply/cvgrPdist_le => /= e e0. +- apply/subspace_continuousP => /= x Ax; apply/cvgrPdist_le => /= e e0. rewrite near_withinE. - near=> t => Dt. - rewrite /Num.norm/= mx_normrE. - apply/(bigmax_le _ (ltW e0)) => /= -[i j] _ /=. + near=> t => At. + rewrite /Num.norm/= mx_normrE; apply/(bigmax_le _ (ltW e0)) => /= -[i j] _ /=. rewrite {i}(ord1 i) !mxE. - move: j Dt. + move: j At. near: t. apply: filter_forall => /= i. - have /subspace_continuousP/(_ x Dx) := H i. + have /subspace_continuousP/(_ x Ax) := Af i. move/cvgrPdist_le => /(_ _ e0). - rewrite near_withinE. - exact. + by rewrite near_withinE. Unshelve. all: by end_near. Qed. End vector_continuous.