theory T146
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(x, join(y, z)) = join(undr(x, y), undr(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(x, meet(y, z)) = join(over(x, y), over(x, z)))
"
nitpick[card nat=4,timeout=86400]
oops
end


(* Title:      Quadcopter Controller Verification
   Author:     Omar A. Jasim <oajasim1@sheffield.ac.uk>, Sandor M. Veres <s.veres@sheffield.ac.uk>
   Maintainer: Omar A. Jasim <oajasim1@sheffield.ac.uk>, Sandor M. Veres <s.veres@sheffield.ac.uk>
*)

theory Drone_veri_2
imports  Complex_Main
(*"~~/src/HOL/Probability/Probability" *)
"~~/src/HOL/Matrix_LP/Matrix"
"~~/src/HOL/Library/Function_Algebras"
(*"~~/src/HOL/Probability/Analysis"*)
(*"~~/src/HOL/Analysis/Finite_Cartesian_Product"*)
begin

(**************************************************************************************************)
text \<open>Time definition\<close>
(**************************************************************************************************)
definition T :: "real set"
  where "T ={t. t\<in>{0..\<infinity>} }"

(**************************************************************************************************)
text \<open>Definitions of sets, positive-definite matrix, and positive-definite symmetric matrix\<close>
(**************************************************************************************************)
definition D3_vec_set :: "(real, 3) vec set"
  where "D3_vec_set ={d. (\<forall>i.\<forall>f.\<forall>t\<in>T.  d$i = f t)}"

definition D6_vec_set :: "(real, 6) vec set"
  where "D6_vec_set ={a. (\<forall>i.\<forall>f.\<forall>t\<in>T.  a$i = f t)}"

(*positive-definite matrix*)
definition "pos_def_3x3_matrix X = (\<exists>r. \<exists>M. M=X \<and> (r:: (real,3) vec) \<noteq>0 \<and> (r \<bullet> (M *v r))>0)"

definition "pos_def_6x6_matrix Y = (\<exists>r. \<exists>F. F=Y \<and> (r:: (real,6) vec) \<noteq>0 \<and> (r \<bullet> (F *v r))>0)"

(*from Sylvester theorem : a matrix is a positive definite and symmetric matrix iff its principle
  minors is positive or its eginvalues are positive*)
definition "pos_def_symmetric_matrix A = (pos_def_6x6_matrix A \<and> A = transpose(A) \<and> det(A)\<noteq>0
      \<and> (A$1$1)>0 \<and> ((A$1$1)*(A$2$2) - (A$1$2)*(A$2$1))>0 \<and>
      (\<exists>!(B:: ((real,3) vec,3) vec). B$1$1=A$1$1 \<and> B$2$1=A$2$1 \<and> B$3$1=A$3$1 \<and> B$1$2=A$1$2 \<and>
      B$2$2=A$2$2 \<and> B$3$2=A$3$2 \<and> B$1$3=A$1$3 \<and> B$2$3=A$2$3  \<and> B$3$3=A$3$3 \<and> det(B)>0 )   \<and>
      (\<exists>!(C:: ((real,4) vec,4) vec). C$1$1=A$1$1 \<and> C$2$1=A$2$1 \<and> C$3$1=A$3$1 \<and> C$4$1=A$4$1 \<and>
      C$1$2=A$1$2 \<and> C$2$2=A$2$2 \<and> C$3$2=A$3$2 \<and>  C$4$2=A$4$2 \<and> C$1$3=A$1$3 \<and> C$2$3=A$2$3  \<and>
      C$3$3=A$3$3 \<and> C$4$3=A$4$3 \<and> C$1$4=A$1$4 \<and> C$2$4=A$2$4 \<and> C$3$4=A$3$4 \<and> C$4$4=A$4$4 \<and>
      det(C)>0 ) \<and>  (\<exists>!(D:: ((real,5) vec,5) vec). D$1$1=A$1$1 \<and> D$2$1=A$2$1 \<and> D$3$1=A$3$1 \<and>
      D$4$1=A$4$1 \<and> D$5$1=A$5$1 \<and> D$1$2=A$1$2 \<and> D$2$2=A$2$2 \<and> D$3$2=A$3$2 \<and> D$4$2=A$4$2 \<and>
      D$5$2=A$5$2 \<and> D$1$3=A$1$3 \<and> D$2$3=A$2$3 \<and> D$3$3=A$3$3 \<and> D$4$3=A$4$3 \<and> D$5$3=A$5$3 \<and>
      D$1$4=A$1$4 \<and> D$2$4=A$2$4 \<and> D$3$4=A$3$4 \<and> D$4$4=A$4$4 \<and> D$5$4=A$5$4 \<and> D$1$5=A$1$5 \<and>
      D$2$5=A$2$5 \<and> D$3$5=A$3$5 \<and> D$4$5=A$4$5 \<and> D$5$5=A$5$5 \<and> det(D)>0 )  \<and> det(A)>0 )"

(**************************************************************************************************)
text \<open>Parameters definitions\<close>
(**************************************************************************************************)
definition"(ell :: real)=0.2" (*m*)    (*arm length*)
definition"(k :: real)=0.00000012" (*N/(rad/sec)\<^sup>2*)
definition"(b :: real)=0.00000009" (*N.m/(rad/sec)\<^sup>2*)
definition"(H :: real)=1.2"
definition"(\<sigma> :: real)=0.0000000000009"
definition"(\<xi> :: real)=0.5"
definition"(S :: real)=0.001"
definition"(D :: real)=0.001"
definition"(D\<^sub>b\<^sub>a\<^sub>r :: real)=0.002"
definition"(\<beta>\<^sub>m\<^sub>i\<^sub>n :: real)=170.5"
definition"(\<beta>\<^sub>m\<^sub>a\<^sub>x :: real)=173"
definition"(k\<^sub>q\<^sub>0 :: real)=0.01"
definition"(I\<^sub>x :: real)=0.005831"
definition"(I\<^sub>y :: real)=0.005831"
definition"(I\<^sub>z :: real)=0.01166"
definition"(\<omega>\<^sub>m\<^sub>a\<^sub>x :: real)=707.1068" (*rad/sec*)

(**************************************************************************************************)
text \<open>Euler angles limits / Euler vector\<close>
(**************************************************************************************************)
definition "Euler_ang \<phi> \<theta> \<psi>  = (\<forall>t. t\<in>T \<and> -pi/2 < (\<phi> :: real\<Rightarrow>real)(t) \<and> \<phi>(t) < pi/2
                                       \<and> -pi/2 < (\<theta> :: real\<Rightarrow>real)(t) \<and> \<theta>(t) < pi/2 \<and> (\<psi> :: real\<Rightarrow>real)(t) \<in> \<real>)"

definition "Euler_vec \<eta> \<phi> \<theta> \<psi> = (\<forall>t. t\<in>T \<and> Euler_ang \<phi> \<theta> \<psi> \<and> \<eta>\<in>D3_vec_set \<and>
                                 \<eta>$1=\<phi>(t) \<and> \<eta>$2=\<theta>(t) \<and> \<eta>$3=\<psi>(t))"

(**************************************************************************************************)
text \<open>Matrices definitions\<close>
(**************************************************************************************************)
(* J uncertain matrix -  Eq. 4*)
definition "J_mat J \<phi> \<theta> \<psi> = (\<forall>t. t\<in>T \<and> pos_def_3x3_matrix J \<and> invertible J \<and>
                          J**matrix_inv(J) = mat 1 \<and> norm(matrix_inv(J)) > 0 \<and>
                       \<beta>\<^sub>m\<^sub>i\<^sub>n \<le> norm(matrix_inv(J)) \<and> norm(matrix_inv(J)) \<le> \<beta>\<^sub>m\<^sub>a\<^sub>x \<and> Euler_ang \<phi> \<theta> \<psi> \<and>
                     J$1$1 = I\<^sub>x           \<and> J$2$1 = 0                               \<and> J$3$1 = -I\<^sub>x * sin(\<theta>(t)) \<and>
                     J$1$2 = 0            \<and> J$2$2 =(I\<^sub>y* (cos(\<phi>(t)))\<^sup>2 + I\<^sub>z * (sin(\<phi>(t)))\<^sup>2) \<and> J$3$2 = (I\<^sub>y-I\<^sub>z)* cos(\<phi>(t))* sin(\<phi>(t))* cos(\<theta>(t)) \<and>
                     J$1$3 = -I\<^sub>x * sin(\<theta>(t)) \<and> J$2$3 = (I\<^sub>y-I\<^sub>z)* cos(\<phi>(t))* sin(\<phi>(t))* cos(\<theta>(t)) \<and> J$3$3 = I\<^sub>x*(sin(\<theta>(t)))\<^sup>2 +I\<^sub>y*(sin(\<phi>(t)))\<^sup>2*(cos(\<theta>(t)))\<^sup>2 + I\<^sub>z*(cos(\<phi>(t)))\<^sup>2*(cos(\<theta>(t)))\<^sup>2)"

(* J\<^sub>h\<^sub>a\<^sub>t the assumed  matrix values*)
definition "J\<^sub>h\<^sub>a\<^sub>t_mat (J\<^sub>h\<^sub>a\<^sub>t :: ((real, 3) vec, 3) vec) \<phi> \<theta> \<psi> = (\<forall>t. t\<in>T \<and> pos_def_3x3_matrix J\<^sub>h\<^sub>a\<^sub>t \<and>
                     transpose J\<^sub>h\<^sub>a\<^sub>t = J\<^sub>h\<^sub>a\<^sub>t    \<and> invertible J\<^sub>h\<^sub>a\<^sub>t \<and> Euler_ang \<phi> \<theta> \<psi> \<and>
                     J\<^sub>h\<^sub>a\<^sub>t$1$1 = I\<^sub>x              \<and> J\<^sub>h\<^sub>a\<^sub>t$2$1 = 0                                        \<and> J\<^sub>h\<^sub>a\<^sub>t$3$1 = -I\<^sub>x * sin(\<theta>(t)) \<and>
                     J\<^sub>h\<^sub>a\<^sub>t$1$2 = 0               \<and> J\<^sub>h\<^sub>a\<^sub>t$2$2 =(I\<^sub>y* (cos(\<phi>(t)))\<^sup>2 + I\<^sub>z * (sin(\<phi>(t)))\<^sup>2)    \<and> J\<^sub>h\<^sub>a\<^sub>t$3$2 = (I\<^sub>y-I\<^sub>z)* cos(\<phi>(t))* sin(\<phi>(t))* cos(\<theta>(t)) \<and>
                     J\<^sub>h\<^sub>a\<^sub>t$1$3 = -I\<^sub>x * sin(\<theta>(t)) \<and> J\<^sub>h\<^sub>a\<^sub>t$2$3 = (I\<^sub>y-I\<^sub>z)* cos(\<phi>(t))* sin(\<phi>(t))* cos(\<theta>(t)) \<and> J\<^sub>h\<^sub>a\<^sub>t$3$3 = I\<^sub>x*(sin(\<theta>(t)))\<^sup>2 +I\<^sub>y*(sin(\<phi>(t)))\<^sup>2*(cos(\<theta>(t)))\<^sup>2 + I\<^sub>z*(cos(\<phi>(t)))\<^sup>2*(cos(\<theta>(t)))\<^sup>2)"

(* K\<^sub>\<eta> matrix values*)
definition "K\<^sub>\<eta>_mat (K\<^sub>\<eta> :: ((real, 3) vec, 3) vec)  = (pos_def_3x3_matrix K\<^sub>\<eta> \<and>
                   K\<^sub>\<eta>$1$1 = 17.5 \<and> K\<^sub>\<eta>$2$1 = 0     \<and> K\<^sub>\<eta>$3$1 = 0 \<and>
                   K\<^sub>\<eta>$1$2 = 0    \<and> K\<^sub>\<eta>$2$2 = 17.5  \<and> K\<^sub>\<eta>$3$2 = 0 \<and>
                   K\<^sub>\<eta>$1$3 = 0    \<and> K\<^sub>\<eta>$2$3 = 0     \<and> K\<^sub>\<eta>$3$3 = 1.8)"

(* K\<^sub>r matrix values*)
definition "K\<^sub>r_mat (K\<^sub>r :: ((real, 3) vec, 3) vec)  = (pos_def_3x3_matrix K\<^sub>r \<and>
                   K\<^sub>r$1$1 = 0.004  \<and> K\<^sub>r$2$1 = 0     \<and> K\<^sub>r$3$1 = 0 \<and>
                   K\<^sub>r$1$2 = 0      \<and> K\<^sub>r$2$2 = 0.004 \<and> K\<^sub>r$3$2 = 0 \<and>
                   K\<^sub>r$1$3 = 0      \<and> K\<^sub>r$2$3 = 0     \<and> K\<^sub>r$3$3 = 0.4826)"

(* W matrix values Eq. 2 *)
definition "W_mat (W ::((real, 3)vec,3)vec) \<phi> \<theta> \<psi> = (\<forall>t. t\<in>T \<and> Euler_ang \<phi> \<theta> \<psi> \<and>
            ((W$1)$1) = 1 \<and> ((W$2)$1) = 0           \<and> ((W$3)$1) = - sin(\<theta>(t))            \<and>
            ((W$1)$2) = 0 \<and> ((W$2)$2) = cos(\<phi>(t))   \<and> ((W$3)$2) = cos(\<theta>(t)) * sin(\<phi>(t)) \<and>
            ((W$1)$3) = 0 \<and> ((W$2)$3) = - sin(\<phi>(t)) \<and> ((W$3)$3) = cos(\<theta>(t)) * cos(\<phi>(t)) )"

(* A matrix values Eq. 23*)
definition "A_mat (A :: ((real, 6) vec,6) vec)  =
            (A$1$1=0      \<and>  A$2$1=0     \<and>  A$3$1=0    \<and>  A$4$1=1      \<and>  A$5$1=0      \<and>  A$6$1=0 \<and>
             A$1$2=0      \<and>  A$2$2=0     \<and>  A$3$2=0    \<and>  A$4$2=0      \<and>  A$5$2=1      \<and>  A$6$2=0 \<and>
             A$1$3=0      \<and>  A$2$3=0     \<and>  A$3$3=0    \<and>  A$4$3=0      \<and>  A$5$3=0      \<and>  A$6$3=1 \<and>
             A$1$4=-17.5  \<and>  A$2$4=0     \<and>  A$3$4=0    \<and>  A$4$4=-0.004 \<and>  A$5$4=0      \<and>  A$6$4=0 \<and>
             A$1$5=0      \<and>  A$2$5=-17.5 \<and>  A$3$5=0    \<and>  A$4$5=0      \<and>  A$5$5=-0.004 \<and>  A$6$5=0 \<and>
             A$1$6=0      \<and>  A$2$6=0     \<and>  A$3$6=-1.8 \<and>  A$4$6=0      \<and>  A$5$6=0      \<and>  A$6$6=-0.4826)"

(* B matrix values Eq. 23 *)
definition "B_mat (B :: ((real, 3) vec, 6) vec)  =
            (B$1$1=0     \<and>  B$2$1=0     \<and>  B$3$1=0 \<and>
             B$1$2=0     \<and>  B$2$2=0     \<and>  B$3$2=0 \<and>
             B$1$3=0     \<and>  B$2$3=0     \<and>  B$3$3=0 \<and>
             B$1$4=1     \<and>  B$2$4=0     \<and>  B$3$4=0 \<and>
             B$1$5=0     \<and>  B$2$5=1     \<and>  B$3$5=0 \<and>
             B$1$6=0     \<and>  B$2$6=0     \<and>  B$3$6=1 )"

(* P matrix values Eq. 41*)
definition "P_mat (P :: ((real, 6) vec,6) vec)  = (pos_def_symmetric_matrix P \<and>
             P$1$1 = 0.000000000009 \<and>  P$2$1=0              \<and>  P$3$1=0               \<and>  P$4$1=0            \<and>  P$5$1=0            \<and>  P$6$1=0 \<and>
             P$1$2 = 0              \<and>  P$2$2=0.000000000009 \<and>  P$3$2=0               \<and>  P$4$2=0            \<and>  P$5$2=0            \<and>  P$6$2=0 \<and>
             P$1$3 = 0              \<and>  P$2$3=0              \<and>  P$3$3=0.000000005     \<and>  P$4$3=0            \<and>  P$5$3=0            \<and>  P$6$3=0 \<and>
             P$1$4 = 0              \<and>  P$2$4=0              \<and>  P$3$4=0               \<and>  P$4$4=0.00000003   \<and>  P$5$4=0            \<and>  P$6$4=0 \<and>
             P$1$5 = 0              \<and>  P$2$5=0              \<and>  P$3$5=0               \<and>  P$4$5=0            \<and>  P$5$5=0.00000003   \<and>  P$6$5=0 \<and>
             P$1$6 = 0              \<and>  P$2$6=0              \<and>  P$3$6=0               \<and>  P$4$6=0            \<and>  P$5$6=0            \<and>  P$6$6=0.0008)"

(* Q matrix values Eq. 42*)
definition "Q_mat (Q :: ((real, 6) vec,6) vec)  = (pos_def_symmetric_matrix Q \<and>
             Q$1$1 = 0.0000002 \<and>  Q$2$1= 0         \<and>  Q$3$1= 0       \<and>  Q$4$1= 0         \<and>  Q$5$1= 0         \<and>  Q$6$1=0 \<and>
             Q$1$2 = 0         \<and>  Q$2$2= 0.0000002 \<and>  Q$3$2= 0       \<and>  Q$4$2= 0         \<and>  Q$5$2= 0         \<and>  Q$6$2=0 \<and>
             Q$1$3 = 0         \<and>  Q$2$3= 0         \<and>  Q$3$3= 0.00046 \<and>  Q$4$3= 0         \<and>  Q$5$3= 0         \<and>  Q$6$3=0 \<and>
             Q$1$4 = 0         \<and>  Q$2$4= 0         \<and>  Q$3$4= 0       \<and>  Q$4$4= 0.0000038 \<and>  Q$5$4= 0         \<and>  Q$6$4=0 \<and>
             Q$1$5 = 0         \<and>  Q$2$5= 0         \<and>  Q$3$5= 0       \<and>  Q$4$5= 0         \<and>  Q$5$5= 0.0000038 \<and>  Q$6$5=0 \<and>
             Q$1$6 = 0         \<and>  Q$2$6= 0         \<and>  Q$3$6= 0       \<and>  Q$4$6= 0         \<and>  Q$5$6= 0         \<and>  Q$6$6=0.00082)"
(*################################################################################################*)

(**************************************************************************************************)
section \<open>Quadcopter attitude dynamics\<close>
(**************************************************************************************************)

(* \<tau> vector equation *)
definition "torq_fun \<tau> = ((\<exists> \<omega>\<^sub>1 \<omega>\<^sub>2 \<omega>\<^sub>3 \<omega>\<^sub>4. \<bar>\<omega>\<^sub>1\<bar><\<omega>\<^sub>m\<^sub>a\<^sub>x \<and> \<bar>\<omega>\<^sub>2\<bar><\<omega>\<^sub>m\<^sub>a\<^sub>x \<and> \<bar>\<omega>\<^sub>3\<bar><\<omega>\<^sub>m\<^sub>a\<^sub>x \<and> \<bar>\<omega>\<^sub>4\<bar><\<omega>\<^sub>m\<^sub>a\<^sub>x \<and>
                         \<tau> \<in> D3_vec_set \<and>
                         \<tau>$1= ell*k*(\<omega>\<^sub>2\<^sup>2 - \<omega>\<^sub>4\<^sup>2)  \<and>
                         \<tau>$2= ell*k*(-\<omega>\<^sub>1\<^sup>2 + \<omega>\<^sub>3\<^sup>2) \<and>
                         \<tau>$3= b*(-\<omega>\<^sub>1\<^sup>2 + \<omega>\<^sub>2\<^sup>2 - \<omega>\<^sub>3\<^sup>2 + \<omega>\<^sub>4\<^sup>2) ))"

(* C matrix equation Eq. 6*)
definition "C_mat (C :: ((real, 3) vec,3) vec) \<phi> \<theta> \<psi>  = (\<forall>t.\<exists> \<phi>' \<theta>' \<psi>'. t\<in>T \<and> Euler_ang \<phi> \<theta> \<psi> \<and>
             (((\<lambda>t. \<phi>(t)) has_derivative (\<lambda>t. \<phi>'(t))) (at t within T)) \<and>
             (((\<lambda>t. \<theta>(t)) has_derivative (\<lambda>t. \<theta>'(t))) (at t within T)) \<and>
             (((\<lambda>t. \<psi>(t)) has_derivative (\<lambda>t. \<psi>'(t))) (at t within T)) \<and>
             C$1$1 = 0 \<and>
             C$2$1= ((I\<^sub>y - I\<^sub>z)*((\<theta>'(t)*cos(\<phi>(t))* sin(\<phi>(t))) + (\<psi>'(t)*(sin(\<phi>(t)))^2 * cos(\<theta>(t))) )) + (((I\<^sub>z-I\<^sub>y)* (\<psi>'(t)*(cos(\<phi>(t)))^2 *cos(\<theta>(t))))- ( I\<^sub>x*\<psi>'(t)*cos(\<theta>(t)) ))  \<and>
             C$3$1= (I\<^sub>z-I\<^sub>y)* (\<psi>'(t)* cos(\<phi>(t))* sin(\<phi>(t))* (cos(\<theta>(t)))^2)  \<and>
             C$1$2 = ((I\<^sub>z - I\<^sub>y)*((\<theta>'(t)*cos(\<phi>(t))* sin(\<phi>(t))) + (\<psi>'(t)* sin(\<phi>(t)) * cos(\<theta>(t))) ))+ ((I\<^sub>y-I\<^sub>z)* (\<psi>'(t)*(cos(\<phi>(t)))^2 *cos(\<theta>(t)))) +  ( I\<^sub>x*\<psi>'(t)*cos(\<theta>(t))  )  \<and>
             C$2$2=((I\<^sub>z - I\<^sub>y)* (\<phi>'(t)*cos(\<phi>(t))* sin(\<phi>(t)))) \<and>
             C$3$2= (-I\<^sub>x*\<psi>'(t)* sin(\<theta>(t))*cos(\<theta>(t)))  +  (I\<^sub>y*\<psi>'(t)*(sin(\<phi>(t)))^2* sin(\<theta>(t))*cos(\<theta>(t))) + (I\<^sub>z*\<psi>'(t)*(cos(\<phi>(t)))^2* sin(\<theta>(t))*cos(\<theta>(t)))   \<and>
             C$1$3 = ((I\<^sub>y - I\<^sub>z)*  (\<psi>'(t)*(cos(\<theta>(t)))^2* sin(\<phi>(t))*cos(\<phi>(t))) )   -  (I\<^sub>x*\<theta>'(t)*cos(\<theta>(t))) \<and>
             C$2$3= ((I\<^sub>z - I\<^sub>y)*  ((\<theta>'(t)*cos(\<phi>(t))* sin(\<phi>(t))* sin(\<theta>(t)))  +  (\<phi>'(t)*(sin(\<phi>(t)))^2*cos(\<theta>(t))) ) )+((I\<^sub>y - I\<^sub>z)*  (\<phi>'(t)*(cos(\<phi>(t)))^2*cos(\<theta>(t))) ) + ( I\<^sub>x* \<psi>'(t)* sin(\<theta>(t))*cos(\<theta>(t)) ) - (I\<^sub>y*\<psi>'(t)*(sin(\<phi>(t)))^2* sin(\<theta>(t))*cos(\<theta>(t))) \<and>
             C$3$3= ( ((I\<^sub>y - I\<^sub>z)*  (\<phi>'(t)*cos(\<phi>(t))* sin(\<phi>(t))*(cos(\<theta>(t)))^2)) ) - (I\<^sub>y*\<theta>'(t)*(sin(\<phi>(t)))^2*cos(\<theta>(t))* sin(\<theta>(t))) - (I\<^sub>z*\<theta>'(t)*(cos(\<phi>(t)))^2*cos(\<theta>(t))* sin(\<theta>(t))) + (I\<^sub>x*\<theta>'(t)*cos(\<theta>(t))* sin(\<theta>(t))) )"

definition "C\<^sub>h\<^sub>a\<^sub>t_mat (C\<^sub>h\<^sub>a\<^sub>t :: ((real, 3) vec,3) vec) \<phi> \<theta> \<psi>  = (\<forall>t.\<exists> \<phi>' \<theta>' \<psi>'. t\<in>T \<and> Euler_ang \<phi> \<theta> \<psi> \<and>
             (((\<lambda>t. \<phi>(t)) has_derivative (\<lambda>t. \<phi>'(t))) (at t within T)) \<and>
             (((\<lambda>t. \<theta>(t)) has_derivative (\<lambda>t. \<theta>'(t))) (at t within T)) \<and>
             (((\<lambda>t. \<psi>(t)) has_derivative (\<lambda>t. \<psi>'(t))) (at t within T)) \<and>
             C\<^sub>h\<^sub>a\<^sub>t$1$1 = 0 \<and>
             C\<^sub>h\<^sub>a\<^sub>t$2$1= ((I\<^sub>y - I\<^sub>z)*((\<theta>'(t)*cos(\<phi>(t))* sin(\<phi>(t))) + (\<psi>'(t)*(sin(\<phi>(t)))^2 * cos(\<theta>(t))) )) + (((I\<^sub>z-I\<^sub>y)* (\<psi>'(t)*(cos(\<phi>(t)))^2 *cos(\<theta>(t))))- ( I\<^sub>x*\<psi>'(t)*cos(\<theta>(t)) ))  \<and>
             C\<^sub>h\<^sub>a\<^sub>t$3$1= (I\<^sub>z-I\<^sub>y)* (\<psi>'(t)* cos(\<phi>(t))* sin(\<phi>(t))* (cos(\<theta>(t)))^2)  \<and>
             C\<^sub>h\<^sub>a\<^sub>t$1$2 = ((I\<^sub>z - I\<^sub>y)*((\<theta>'(t)*cos(\<phi>(t))* sin(\<phi>(t))) + (\<psi>'(t)* sin(\<phi>(t)) * cos(\<theta>(t))) ))+ ((I\<^sub>y-I\<^sub>z)* (\<psi>'(t)*(cos(\<phi>(t)))^2 *cos(\<theta>(t)))) +  ( I\<^sub>x*\<psi>'(t)*cos(\<theta>(t))  )  \<and>
             C\<^sub>h\<^sub>a\<^sub>t$2$2=((I\<^sub>z - I\<^sub>y)* (\<phi>'(t)*cos(\<phi>(t))* sin(\<phi>(t)))) \<and>
             C\<^sub>h\<^sub>a\<^sub>t$3$2= (-I\<^sub>x*\<psi>'(t)* sin(\<theta>(t))*cos(\<theta>(t)))  +  (I\<^sub>y*\<psi>'(t)*(sin(\<phi>(t)))^2* sin(\<theta>(t))*cos(\<theta>(t))) + (I\<^sub>z*\<psi>'(t)*(cos(\<phi>(t)))^2* sin(\<theta>(t))*cos(\<theta>(t)))   \<and>
             C\<^sub>h\<^sub>a\<^sub>t$1$3 = ((I\<^sub>y - I\<^sub>z)*  (\<psi>'(t)*(cos(\<theta>(t)))^2* sin(\<phi>(t))*cos(\<phi>(t))) )   -  (I\<^sub>x*\<theta>'(t)*cos(\<theta>(t))) \<and>
             C\<^sub>h\<^sub>a\<^sub>t$2$3= ((I\<^sub>z - I\<^sub>y)*  ((\<theta>'(t)*cos(\<phi>(t))* sin(\<phi>(t))* sin(\<theta>(t)))  +  (\<phi>'(t)*(sin(\<phi>(t)))^2*cos(\<theta>(t))) ) )+((I\<^sub>y - I\<^sub>z)*  (\<phi>'(t)*(cos(\<phi>(t)))^2*cos(\<theta>(t))) ) + ( I\<^sub>x* \<psi>'(t)* sin(\<theta>(t))*cos(\<theta>(t)) ) - (I\<^sub>y*\<psi>'(t)*(sin(\<phi>(t)))^2* sin(\<theta>(t))*cos(\<theta>(t))) \<and>
             C\<^sub>h\<^sub>a\<^sub>t$3$3= ( ((I\<^sub>y - I\<^sub>z)*  (\<phi>'(t)*cos(\<phi>(t))* sin(\<phi>(t))*(cos(\<theta>(t)))^2)) ) - (I\<^sub>y*\<theta>'(t)*(sin(\<phi>(t)))^2*cos(\<theta>(t))* sin(\<theta>(t))) - (I\<^sub>z*\<theta>'(t)*(cos(\<phi>(t)))^2*cos(\<theta>(t))* sin(\<theta>(t))) + (I\<^sub>x*\<theta>'(t)*cos(\<theta>(t))* sin(\<theta>(t))) )"

(* attitude dynamics equation *)
definition "att_dyms \<tau> J C \<eta> \<phi> \<theta> \<psi> d = (\<forall>t\<in>T.\<forall> \<eta>' \<eta>''. (\<forall>\<eta>. \<eta>\<in>D3_vec_set) \<and> Euler_vec \<eta> \<phi> \<theta> \<psi> \<and>
                     (\<forall>i.((\<lambda>t. \<eta>$i) has_derivative (\<lambda>t. \<eta>'$i)) (at t within T)) \<and>
                     (\<forall>i.((\<lambda>t. \<eta>'$i) has_derivative (\<lambda>t. \<eta>''$i)) (at t within T)) \<and>
                     J_mat J \<phi> \<theta> \<psi> \<and> C_mat C \<phi> \<theta> \<psi> \<and> \<tau> = J *v \<eta>'' + C *v \<eta>' + d)"

(*################################################################################################*)

(**************************************************************************************************)
section \<open>Control System Design\<close>
(**************************************************************************************************)

(* 1st and 2nd  derivative of \<eta> and \<eta>\<^sub>d Euler vector *)
definition "ddot_\<eta>_vec \<eta>\<^sub>d \<eta>\<^sub>d' \<eta>\<^sub>d'' \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d = (\<forall>t\<in>T. \<exists> \<eta>\<^sub>d' \<eta>\<^sub>d''. Euler_vec \<eta>\<^sub>d \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d \<and>
                                    ( \<forall>i.((\<lambda>t. \<eta>\<^sub>d$i) has_derivative (\<lambda>t. \<eta>\<^sub>d'$i)) (at t within T)) \<and>
                                    ( \<forall>i.((\<lambda>t. \<eta>\<^sub>d'$i) has_derivative (\<lambda>t. \<eta>\<^sub>d''$i)) (at t within T)))"

(*error e, e' and e'' definition Eq. 16 and 17*)
definition "error_vec e \<eta> \<eta>\<^sub>d \<phi> \<theta> \<psi> = (Euler_vec \<eta> \<phi> \<theta> \<psi> \<and>  e = \<eta>\<^sub>d - \<eta>)"

definition "dot_error_vec e e' \<eta> \<eta>\<^sub>d \<eta>' \<eta>\<^sub>d' \<phi> \<theta> \<psi> = (\<forall>t. error_vec e \<eta> \<eta>\<^sub>d \<phi> \<theta> \<psi> \<and>
                   (\<forall>i.((\<lambda>t. \<eta>$i) has_derivative (\<lambda>t. \<eta>'$i)) (at t within T)) \<and>
                   (\<forall>i.((\<lambda>t. \<eta>\<^sub>d$i) has_derivative (\<lambda>t. \<eta>\<^sub>d'$i)) (at t within T)) \<and>
                    e' = \<eta>\<^sub>d' - \<eta>')"

definition "ddot_error_vec e e' e'' \<eta> \<eta>' \<eta>'' \<eta>\<^sub>d \<eta>\<^sub>d' \<eta>\<^sub>d'' \<phi> \<theta> \<psi> \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d = (\<forall>t. error_vec e \<eta> \<eta>\<^sub>d \<phi> \<theta> \<psi> \<and>
                   ddot_\<eta>_vec \<eta>\<^sub>d \<eta>\<^sub>d' \<eta>\<^sub>d'' \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d \<and> ddot_\<eta>_vec \<eta> \<eta>' \<eta>'' \<phi> \<theta> \<psi> \<and>
                   (\<forall>i.((\<lambda>t. e$i) has_derivative (\<lambda>t. e'$i)) (at t within T)) \<and>
                   (\<forall>i.((\<lambda>t. e'$i) has_derivative (\<lambda>t. e''$i)) (at t within T)) \<and>
                    e'' = \<eta>\<^sub>d'' - \<eta>'')"

(*N and N\<^sub>h\<^sub>a\<^sub>t vectors definitions*)
definition "N_vec N C \<eta> \<eta>' \<phi> \<theta> \<psi> =(\<forall>t. Euler_vec \<eta> \<phi> \<theta> \<psi> \<and> C_mat C \<phi> \<theta> \<psi> \<and>
                             (\<forall>i.((\<lambda>t. \<eta>$i) has_derivative (\<lambda>t. \<eta>'$i)) (at t within T)) \<and>
                              N = C *v \<eta>')"

definition "N\<^sub>h\<^sub>a\<^sub>t_vec N\<^sub>h\<^sub>a\<^sub>t C\<^sub>h\<^sub>a\<^sub>t \<eta> \<phi> \<theta> \<psi> =(\<forall>t. \<exists> \<eta>'. Euler_vec \<eta> \<phi> \<theta> \<psi> \<and> C\<^sub>h\<^sub>a\<^sub>t_mat C\<^sub>h\<^sub>a\<^sub>t \<phi> \<theta> \<psi> \<and>
                             (\<forall>i.((\<lambda>t. \<eta>$i) has_derivative (\<lambda>t. \<eta>'$i)) (at t within T)) \<and>
                              N\<^sub>h\<^sub>a\<^sub>t = C\<^sub>h\<^sub>a\<^sub>t *v \<eta>')"

(* E vector definition*)
definition "E_vec (E:: (real,6)vec) \<eta> \<eta>' = (E$1 = \<eta>$1  \<and> E$2 = \<eta>$2  \<and> E$3 = \<eta>$3  \<and>
                                            E$4 = \<eta>'$1 \<and> E$5 = \<eta>'$2 \<and> E$6 = \<eta>'$3 )"

(*################################################################################################*)

(**************************************************************************************************)
subsection \<open>assumptions\<close>
(**************************************************************************************************)

(* assumption 1- Eq. 14 *)
definition "assump1 (d ::(real,3)vec) d\<^sub>h\<^sub>a\<^sub>t \<Delta>d = (\<Delta>d = d\<^sub>h\<^sub>a\<^sub>t - d \<and> norm(\<Delta>d) \<le> D \<and> norm(d)+D < D\<^sub>b\<^sub>a\<^sub>r)"

(* assumption 2 - Eq.15 *)
definition "assump2 (N ::(real,3)vec) N\<^sub>h\<^sub>a\<^sub>t \<Delta>N =  (\<Delta>N = N\<^sub>h\<^sub>a\<^sub>t - N \<and> norm(\<Delta>N) \<le> S)"

(* assumption 3 - Eqs.24 *)
definition "assump3_a \<eta>\<^sub>d'' = ((SUP t:T. norm(\<eta>\<^sub>d'')) < H)"

(* assumption 3 - Eqs.25-26 *)
definition "assump3_b J J\<^sub>h\<^sub>a\<^sub>t \<phi> \<theta> \<psi> = (J_mat J \<phi> \<theta> \<psi> \<and> J\<^sub>h\<^sub>a\<^sub>t_mat J\<^sub>h\<^sub>a\<^sub>t \<phi> \<theta> \<psi> \<and>
                                     norm(mat 1 - J\<^sub>h\<^sub>a\<^sub>t ** matrix_inv(J)) \<le> \<xi> \<and>
                                     \<beta>\<^sub>m\<^sub>i\<^sub>n \<le> norm(matrix_inv(J)) \<and> norm(matrix_inv(J)) \<le> \<beta>\<^sub>m\<^sub>a\<^sub>x)"

(*################################################################################################*)

(**************************************************************************************************)
subsection \<open>Controller definitions\<close>
(**************************************************************************************************)

(* u control input definition *)
definition "cont_u (u :: (real, 3) vec) \<eta>\<^sub>d'' K\<^sub>r K\<^sub>\<eta> e e'  = (u= \<eta>\<^sub>d'' + K\<^sub>r *v e' + K\<^sub>\<eta> *v e)"

(*v equation Eq. 19*)
definition "v_eq v u J J\<^sub>h\<^sub>a\<^sub>t \<Delta>N \<Delta>d = (v = (mat 1-(matrix_inv(J)**J\<^sub>h\<^sub>a\<^sub>t))*v u - matrix_inv(J)*v (\<Delta>N+\<Delta>d))"

(* \<delta> term definition Eq. 33*) (*assuming norm(v)\<le>\<epsilon>*)
definition "delta_def \<delta> (v::(real,3)vec) = (\<forall>t\<in>T.\<exists>\<epsilon>. \<epsilon>>0 \<and> norm(v)\<le>\<epsilon> \<longrightarrow> \<delta> \<ge> \<epsilon>/\<beta>\<^sub>m\<^sub>i\<^sub>n)"

(* \<gamma> term definition Eq. 31*)
definition "gamma_def \<gamma> B Q \<delta> E = (\<forall>t\<in>T.
    if (norm (transpose (B) *v (Q*v E)) \<ge> \<sigma>)
    then (\<gamma> = (\<delta>/norm(transpose (B) *v (Q*v E))) *s (transpose (B) *v (Q*v E)))
    else (\<gamma> = (\<delta>/\<sigma>) *s (transpose (B) *v (Q*v E))))"

(* Attitude control law Eq. 12*)
definition "cont_law (\<tau> :: (real, 3) vec) u \<gamma> J\<^sub>h\<^sub>a\<^sub>t N\<^sub>h\<^sub>a\<^sub>t d\<^sub>h\<^sub>a\<^sub>t = (\<tau> = J\<^sub>h\<^sub>a\<^sub>t *v u + N\<^sub>h\<^sub>a\<^sub>t + d\<^sub>h\<^sub>a\<^sub>t + \<gamma>)"

(*################################################################################################*)

(* Call all the definitions that predefined with their constants and variables*)
definition "set_of_definitions \<phi> \<theta> \<psi> \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d \<eta> \<eta>\<^sub>d \<eta>' \<eta>\<^sub>d' \<eta>'' \<eta>\<^sub>d'' u \<gamma> e e' e'' \<tau> d
                               d\<^sub>h\<^sub>a\<^sub>t E v \<delta> C C\<^sub>h\<^sub>a\<^sub>t N N\<^sub>h\<^sub>a\<^sub>t \<Delta>N \<Delta>d A B W Q P K\<^sub>\<eta> K\<^sub>r J J\<^sub>h\<^sub>a\<^sub>t
= (J_mat J \<phi> \<theta> \<psi> \<and> J\<^sub>h\<^sub>a\<^sub>t_mat J\<^sub>h\<^sub>a\<^sub>t \<phi> \<theta> \<psi>  \<and> K\<^sub>\<eta>_mat K\<^sub>\<eta> \<and> K\<^sub>r_mat K\<^sub>r \<and> W_mat W \<phi> \<theta> \<psi> \<and> A_mat A \<and>
B_mat B \<and> P_mat P \<and> Q_mat Q \<and> torq_fun \<tau> \<and> C_mat C  \<phi> \<theta> \<psi> \<and> C\<^sub>h\<^sub>a\<^sub>t_mat C\<^sub>h\<^sub>a\<^sub>t \<phi> \<theta> \<psi>  \<and> Euler_vec \<eta> \<phi> \<theta> \<psi>
\<and> att_dyms \<tau> J C \<eta> \<phi> \<theta> \<psi> d \<and> error_vec e \<eta> \<eta>\<^sub>d \<phi> \<theta> \<psi> \<and> dot_error_vec e e' \<eta> \<eta>\<^sub>d \<eta>' \<eta>\<^sub>d' \<phi> \<theta> \<psi> \<and>
N_vec N C \<eta> \<eta>' \<phi> \<theta> \<psi> \<and> N\<^sub>h\<^sub>a\<^sub>t_vec N\<^sub>h\<^sub>a\<^sub>t C\<^sub>h\<^sub>a\<^sub>t \<eta> \<phi> \<theta> \<psi> \<and> E_vec (E::(real,6)vec)\<eta> \<eta>' \<and> ddot_\<eta>_vec \<eta>\<^sub>d \<eta>\<^sub>d' \<eta>\<^sub>d'' \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d
 \<and> ddot_error_vec e e' e'' \<eta> \<eta>' \<eta>'' \<eta>\<^sub>d \<eta>\<^sub>d' \<eta>\<^sub>d'' \<phi> \<theta> \<psi> \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d \<and> v_eq v u J J\<^sub>h\<^sub>a\<^sub>t \<Delta>N \<Delta>d \<and>
 cont_u u \<eta>\<^sub>d'' K\<^sub>r K\<^sub>\<eta> e e' \<and> delta_def \<delta> v \<and> gamma_def \<gamma> B Q \<delta> E \<and> cont_law \<tau> u \<gamma> J\<^sub>h\<^sub>a\<^sub>t N\<^sub>h\<^sub>a\<^sub>t d\<^sub>h\<^sub>a\<^sub>t)"

lemma matrix_unity:
  fixes J :: "real^3^3"
    and x :: "real^3"
assumes "invertible J"
  shows "matrix_inv(J) *v (J *v x) = x"
proof-
    have x1: "matrix_inv(J) *v (J *v x) = (matrix_inv(J) ** J) *v x "
      by (simp add: matrix_vector_mul_assoc)
    have "J ** matrix_inv(J) = mat 1"
      by (smt assms matrix_inv_def invertible_def matrix_matrix_mult_def someI2)
    from this x1 have "(matrix_inv(J) ** J) *v x =  x"
      using matrix_left_right_inverse matrix_vector_mul_lid by force
    thus ?thesis
      using x1 by auto
qed

lemma matrix_diff_vect_distrib: "(A - B) *v x = A *v x - B *v (x :: 'a :: ring_1 ^ 'n)"
  unfolding matrix_vector_mult_def
  by vector (simp add: sum_subtractf left_diff_distrib)

lemma matrix_add_vect_distrib: "(A + B) *v x = A *v x + B *v x"
  unfolding matrix_vector_mult_def
  by vector (simp add: sum.distrib distrib_right)

lemma matrix_vector_right_distrib: "M *v (x + w) = M *v x + M *v w"
  unfolding matrix_vector_mult_def
  by vector (simp add: sum.distrib distrib_left)

lemma matrix_vector_right_distrib_diff: "(M :: 'a :: ring_1 ^ 'nr ^ 'nc) *v (y - w) = M *v y - M *v w"
  unfolding matrix_vector_mult_def
  by vector (simp add: sum_subtractf right_diff_distrib)

theorem Eq_19:
  assumes "assump1 (d ::(real,3)vec) d\<^sub>h\<^sub>a\<^sub>t \<Delta>d" and "assump2 \<Delta>N N  N\<^sub>h\<^sub>a\<^sub>t" and "\<forall>t. t\<in>T"
      and "att_dyms \<tau> J C \<eta> \<phi> \<theta> \<psi> d" and "cont_law \<tau> u \<gamma> J\<^sub>h\<^sub>a\<^sub>t N\<^sub>h\<^sub>a\<^sub>t d\<^sub>h\<^sub>a\<^sub>t"
      and "J_mat J \<phi> \<theta> \<psi>" and "J\<^sub>h\<^sub>a\<^sub>t_mat J\<^sub>h\<^sub>a\<^sub>t \<phi> \<theta> \<psi>" and "v_eq v u J J\<^sub>h\<^sub>a\<^sub>t \<Delta>N \<Delta>d"
      and "set_of_definitions \<phi> \<theta> \<psi> \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d \<eta> \<eta>\<^sub>d \<eta>' \<eta>\<^sub>d' \<eta>'' \<eta>\<^sub>d'' u \<gamma> e e' e'' \<tau> d
                               d\<^sub>h\<^sub>a\<^sub>t E v \<delta> C C\<^sub>h\<^sub>a\<^sub>t N N\<^sub>h\<^sub>a\<^sub>t \<Delta>N \<Delta>d A B W Q P K\<^sub>\<eta> K\<^sub>r J J\<^sub>h\<^sub>a\<^sub>t"
    shows "\<eta>'' = u - v + matrix_inv(J)*v \<gamma>"
proof-
  have "\<tau> = J *v \<eta>'' + C *v \<eta>' + d"
    using assms att_dyms_def by simp
  then have " J *v \<eta>'' + C *v \<eta>' + d = J\<^sub>h\<^sub>a\<^sub>t *v u + N\<^sub>h\<^sub>a\<^sub>t + d\<^sub>h\<^sub>a\<^sub>t + \<gamma>"
    unfolding cont_law_def using assms cont_law_def by blast
  then have " J *v \<eta>'' + N + d = J\<^sub>h\<^sub>a\<^sub>t *v u + N\<^sub>h\<^sub>a\<^sub>t + d\<^sub>h\<^sub>a\<^sub>t + \<gamma>"
    using N_vec_def assms(9) set_of_definitions_def by auto
  then have x1:" J *v \<eta>'' = J\<^sub>h\<^sub>a\<^sub>t *v u + N\<^sub>h\<^sub>a\<^sub>t - N + d\<^sub>h\<^sub>a\<^sub>t - d + \<gamma>"
    by (simp add: add_implies_diff diff_add_eq semiring_normalization_rules(23))
  have "\<Delta>N = N\<^sub>h\<^sub>a\<^sub>t-N"
    by (smt B_mat_def assms(9) exhaust_3 set_of_definitions_def)
    from this x1  have "J *v \<eta>'' = J\<^sub>h\<^sub>a\<^sub>t *v u + \<gamma> + \<Delta>N +  \<Delta>d"
    using assms(1) assump1_def by auto
  then have "\<eta>'' = matrix_inv(J) *v (J\<^sub>h\<^sub>a\<^sub>t *v u + \<gamma> + \<Delta>N + \<Delta>d)"
    using assms matrix_unity J_mat_def by (metis (no_types, lifting))
  then have "\<eta>'' = (matrix_inv(J) ** J\<^sub>h\<^sub>a\<^sub>t) *v u + matrix_inv(J) *v \<gamma> +  matrix_inv(J) *v (\<Delta>N + \<Delta>d)"
    by (metis (no_types, lifting) diff_diff_eq2 diff_minus_eq_add matrix_vector_mul_assoc
        matrix_vector_right_distrib_diff minus_diff_eq)
  then have "\<eta>'' = u + ((matrix_inv(J) ** J\<^sub>h\<^sub>a\<^sub>t)- mat 1)*v u + matrix_inv(J) *v \<gamma> + matrix_inv(J) *v (\<Delta>N + \<Delta>d)"
    by (simp add: matrix_diff_vect_distrib add_diff_eq)
  then have x1:"\<eta>'' = u - ((mat 1-(matrix_inv(J)**J\<^sub>h\<^sub>a\<^sub>t))*v u - matrix_inv(J)*v (\<Delta>N+\<Delta>d)) + matrix_inv(J) *v \<gamma>"
    by (simp add: diff_add_eq matrix_diff_vect_distrib)
   have x2:"v = (mat 1-(matrix_inv(J)**J\<^sub>h\<^sub>a\<^sub>t))*v u - matrix_inv(J)*v (\<Delta>N+\<Delta>d)"
    using assms v_eq_def by fast
  from x1 x2 show ?thesis
    by simp
qed

lemma Eq_22:
  assumes "set_of_definitions \<phi> \<theta> \<psi> \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d \<eta> \<eta>\<^sub>d \<eta>' \<eta>\<^sub>d' \<eta>'' \<eta>\<^sub>d'' u \<gamma> e e' e'' \<tau> d
                               d\<^sub>h\<^sub>a\<^sub>t E v \<delta> C C\<^sub>h\<^sub>a\<^sub>t N N\<^sub>h\<^sub>a\<^sub>t \<Delta>N \<Delta>d A B W Q P K\<^sub>\<eta> K\<^sub>r J J\<^sub>h\<^sub>a\<^sub>t"
    shows "E' = A *v E + B *v (v - (matrix_inv(J) *v \<gamma>))"
proof -
  have "e'' = \<eta>\<^sub>d''- \<eta>''"
    using assms ddot_error_vec_def set_of_definitions_def by metis
  thus ?thesis
    by (smt B_mat_def assms exhaust_3 set_of_definitions_def)
qed

(**************************************************************************************************)
section \<open>STABILITY ANALYSIS\<close>
(**************************************************************************************************)
(**************************************************************************************************)
text \<open>Lyapunov function\<close>
(**************************************************************************************************)
(* Lyapunov function definition *)
definition "Lyapunov V E = (\<forall>t\<in>T.  if (E :: (real,6) vec) \<noteq>0
                     then (\<exists>a. V(E)= (a:: real) \<and> continuous_on D6_vec_set V  \<and> V(E)>0) else V(E) = 0)"

lemma test_lyp0:
  assumes "\<forall>t. t\<in>T" "E\<in>D6_vec_set"  "E=0" "Lyapunov V E"
    shows "V(E) = 0" using assms Lyapunov_def  by force

lemma test_lyp1:
  assumes "\<forall>t. t\<in>T" "E\<in>D6_vec_set"  "E\<noteq>0" "Lyapunov V E"
    shows "V(E) >0" using assms Lyapunov_def    by metis
(* Eq. 27 *)
lemma Lyp_fun:
  assumes "pos_def_symmetric_matrix Q" "\<forall>E. E\<noteq>0"
  shows "\<exists>Q. (E \<bullet> (Q *v E))>0"
    using assms pos_def_symmetric_matrix_def pos_def_6x6_matrix_def by blast

lemma vec_op:
  fixes A Q :: "real^6^6"
    and E:: "real^6"
  shows "(A *v E) \<bullet> (Q *v E) = E \<bullet> ((transpose(A) ** Q) *v E)"
    by (metis dot_matrix_product dot_matrix_vector_mul dot_rowvector_columnvector)

(* Lyapunov matrix A\<^sup>T*Q + Q*A = -P *)
lemma Lya_mat:
  fixes A :: "((real, 6) vec, 6) vec"
  assumes "pos_def_symmetric_matrix Q" and "pos_def_symmetric_matrix P"
      and "A_mat A" and "P_mat P" and "Q_mat Q"
      and "det(A - (mat egn)) =0" and "egn<0" "\<forall>r. r \<noteq> 0"
    shows "\<exists>!Q. transpose (A) ** Q +  Q ** A = -P"
      using assms pos_def_symmetric_matrix_def pos_def_6x6_matrix_def by blast

(**************************************************************************************************)
text \<open>Stability proof\<close>
(**************************************************************************************************)
(* Eqs. 28-30 *)
theorem Stb_Eqs_28_30:
 assumes "\<forall>E. E\<noteq>0"and"Lyapunov V E"and"V(E) = E \<bullet> (Q *v E)"
     and "A_mat A"and"E' = A *v E + B *v (v - (matrix_inv(J) *v \<gamma>))"
     and "(\<forall>t\<in>T. ((\<lambda>t. V(E)) has_derivative (\<lambda>t. V'(E))) (at t within T))"
   shows "V'(E) = - (E \<bullet> (P *v E)) + 2 * (((E v* Q) v* B) \<bullet> (v - matrix_inv(J) *v \<gamma>))"
proof -
   have "V'(E) = E' \<bullet> (Q *v E) + E \<bullet> (Q *v E')"
     using assms add_cancel_left_left rel_simps(93) by blast
   then have "V'(E) = E \<bullet> ((transpose (A) ** Q + Q ** A)*v E) + 2*(((E v* Q) v* B) \<bullet> (v - matrix_inv(J) *v \<gamma>))"
     using assms Eq_22 vec_op  rel_simps(93) by simp
   then have "V'(E) = - (E \<bullet> (P *v E)) + 2 * (((E v* Q) v* B) \<bullet> (v - matrix_inv(J) *v \<gamma>))"
     using assms by blast
   then show ?thesis
     by blast
qed
(* Eq. 32 *)
theorem Eq_32:
  assumes "\<forall>t. t\<in>T" and "assump3_b J J\<^sub>h\<^sub>a\<^sub>t \<phi> \<theta> \<psi>" and"norm(transpose(B)*v(Q*v E)) \<ge> \<sigma>"and"delta_def \<delta> v"
      and "\<exists>E. E\<noteq>0" and "set_of_definitions \<phi> \<theta> \<psi> \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d \<eta> \<eta>\<^sub>d \<eta>' \<eta>\<^sub>d' \<eta>'' \<eta>\<^sub>d'' u \<gamma> e e' e'' \<tau> d
                               d\<^sub>h\<^sub>a\<^sub>t E v \<delta> C C\<^sub>h\<^sub>a\<^sub>t N N\<^sub>h\<^sub>a\<^sub>t \<Delta>N \<Delta>d A B W Q P K\<^sub>\<eta> K\<^sub>r J J\<^sub>h\<^sub>a\<^sub>t"
    shows "(((E v* Q) v* B) \<bullet> (v - matrix_inv(J) *v \<gamma>)) \<le> norm (transpose (B) *v (Q*v E))* (norm(v) - (\<beta>\<^sub>m\<^sub>i\<^sub>n * \<delta>)) "
proof -
  have x1:"((E v* Q) v* B) \<bullet>  (v - matrix_inv(J) *v \<gamma>) = (((E v* Q) v* B) \<bullet>  v) - (((E v* Q) v* B) \<bullet> (matrix_inv(J) *v \<gamma>)) "
    by (simp add: inner_diff_right)
  then have x2:" norm((((E v* Q) v* B) \<bullet> v) - (((E v* Q) v* B) \<bullet> (matrix_inv(J) *v \<gamma>))) \<le>
              norm (((E v* Q) v* B) \<bullet> v) + norm(((E v* Q) v* B) \<bullet> (matrix_inv(J) *v \<gamma>)) "
    using norm_triangle_ineq4 by blast
  have x3:"norm (((E v* Q) v* B) \<bullet> v) \<le> norm ((E v* Q) v* B) * norm(v) "
     by (simp add: Cauchy_Schwarz_ineq2)
   have x4:"norm(((E v* Q) v* B) \<bullet> (matrix_inv(J) *v \<gamma>)) \<le> norm((E v* Q) v* B) * norm(matrix_inv(J) *v \<gamma>)"
     by (simp add: Cauchy_Schwarz_ineq2)
   from x1 x2 x3 x4 have x5:"((E v* Q) v* B) \<bullet>  (v - matrix_inv(J) *v \<gamma>) \<le>
      norm((E v* Q) v* B) * norm(v) - ((E v* Q) v* B) \<bullet> (matrix_inv(J) *v \<gamma>)"
     by fastforce
   have x6:"norm((E v* Q) v* B) = norm(transpose(B) *v (Q*v E)) "
    by (smt B_mat_def assms exhaust_3 set_of_definitions_def)
  from x5 x6 have "((E v* Q) v* B) \<bullet>  (v - matrix_inv(J) *v \<gamma>) \<le>
      norm(transpose(B) *v (Q*v E)) * norm(v) - (transpose(B) *v (Q*v E)) \<bullet> ((matrix_inv(J)) *v \<gamma>)"
    by (meson Eq_22 add_cancel_left_left assms rel_simps(93))
  then have "((E v* Q) v* B) \<bullet>  (v - matrix_inv(J) *v \<gamma>) \<le>
      norm(transpose(B) *v (Q *v E)) * norm(v) - (transpose(B) *v (Q*v E)) \<bullet> ( norm(matrix_inv(J)) *s \<gamma>)"
    by (meson Eq_22 add_cancel_left_left assms(5) assms(6) rel_simps(93))
  then have "((E v* Q) v* B) \<bullet>  (v - matrix_inv(J) *v \<gamma>) \<le>
      norm(transpose(B) *v (Q*v E)) * norm(v) - norm(matrix_inv(J)) *((transpose(B) *v (Q*v E)) \<bullet> \<gamma>)"
    by(simp add:  scalar_mult_eq_scaleR)
  then have "((E v* Q) v* B) \<bullet>  (v - matrix_inv(J) *v \<gamma>) \<le>
      norm(transpose(B) *v (Q *v E)) * norm(v) - \<beta>\<^sub>m\<^sub>i\<^sub>n *((transpose(B) *v (Q*v E)) \<bullet> \<gamma>)"
    using  set_of_definitions_def assump2_def by (smt B_mat_def assms(6) exhaust_3)
  then have "((E v* Q) v* B) \<bullet>  (v - matrix_inv(J) *v \<gamma>) \<le>
      norm(transpose(B) *v (Q*v E)) * norm(v) - \<beta>\<^sub>m\<^sub>i\<^sub>n * norm(transpose(B) *v (Q*v E)) * norm(\<gamma>)"
    using  set_of_definitions_def assump2_def by (smt B_mat_def assms(6) exhaust_3)
  then have "((E v* Q) v* B) \<bullet>  (v - matrix_inv(J) *v \<gamma>) \<le>
      norm(transpose(B) *v (Q*v E)) *(norm(v) - \<beta>\<^sub>m\<^sub>i\<^sub>n *  norm(\<gamma>))"
    by (smt inner_diff_right inner_real_def mult.assoc mult.left_commute)
  then have "((E v* Q) v* B) \<bullet>  (v - matrix_inv(J) *v \<gamma>) \<le>
      norm(transpose(B) *v (Q*v E)) *(norm(v) - \<beta>\<^sub>m\<^sub>i\<^sub>n * \<delta>)"
    by (smt B_mat_def assms(6) exhaust_3 rel_simps(93) set_of_definitions_def)
  thus ?thesis
    by blast
qed

(* Eq. 34 *)
theorem Eq_34:
  assumes "set_of_definitions \<phi> \<theta> \<psi> \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d \<eta> \<eta>\<^sub>d \<eta>' \<eta>\<^sub>d' \<eta>'' \<eta>\<^sub>d'' u \<gamma> e e' e'' \<tau> d
                               d\<^sub>h\<^sub>a\<^sub>t E v \<delta> C C\<^sub>h\<^sub>a\<^sub>t N N\<^sub>h\<^sub>a\<^sub>t \<Delta>N \<Delta>d A B W Q P K\<^sub>\<eta> K\<^sub>r J J\<^sub>h\<^sub>a\<^sub>t"
      and "assump1 d d\<^sub>h\<^sub>a\<^sub>t \<Delta>d" and "assump2 \<Delta>N N  N\<^sub>h\<^sub>a\<^sub>t" and "assump3_a \<eta>\<^sub>d''" and "assump3_b J J\<^sub>h\<^sub>a\<^sub>t \<phi> \<theta> \<psi>"
    shows "norm (v) \<le> (\<xi> * (H + (norm(K\<^sub>r)*norm(e'))+ (norm(K\<^sub>\<eta>)*norm(e))) + (\<beta>\<^sub>m\<^sub>a\<^sub>x*(S + D)))"
proof-
  have "v = (mat 1-(matrix_inv(J)**J\<^sub>h\<^sub>a\<^sub>t))*v u - matrix_inv(J)*v (\<Delta>N+\<Delta>d)"
    using assms v_eq_def set_of_definitions_def by fast
  then have "norm(v) \<le> norm((mat 1-(matrix_inv(J)**J\<^sub>h\<^sub>a\<^sub>t))*v u - matrix_inv(J)*v (\<Delta>N+\<Delta>d))"
    by fastforce
  then have "norm(v) \<le>norm((mat 1-(matrix_inv(J)**J\<^sub>h\<^sub>a\<^sub>t))*v u) + norm((matrix_inv(J)) *v (\<Delta>N+\<Delta>d))"
    using norm_triangle_ineq4 order_trans by blast
  then have "norm(v) \<le> (norm(mat 1-(matrix_inv(J)**J\<^sub>h\<^sub>a\<^sub>t)) * norm(u)) + (norm(matrix_inv(J)) * (norm(\<Delta>N) + norm(\<Delta>d)))"
     by (smt B_mat_def assms(1) exhaust_3 set_of_definitions_def)
  then have "norm(v) \<le> norm(mat 1-(matrix_inv(J)**J\<^sub>h\<^sub>a\<^sub>t)) * norm(\<eta>\<^sub>d'' + K\<^sub>r *v e' + K\<^sub>\<eta> *v e)
                     + norm (matrix_inv(J))* (norm(\<Delta>N)+ norm(\<Delta>d))"
    using assms cont_u_def set_of_definitions_def by metis
  then have "norm(v) \<le> norm(mat 1-(matrix_inv(J)**J\<^sub>h\<^sub>a\<^sub>t)) * (norm(\<eta>\<^sub>d'') + (norm(K\<^sub>r) * norm(e')) + (norm(K\<^sub>\<eta>) * norm(e)))
                     + norm (matrix_inv(J))* (norm(\<Delta>N)+ norm(\<Delta>d))"
    using assms norm_add_rule_thm B_mat_def exhaust_3 set_of_definitions_def by smt
  then have "norm(v) \<le> \<xi> * (H + (norm(K\<^sub>r) * norm(e')) + (norm(K\<^sub>\<eta>) * norm(e)))
                     + \<beta>\<^sub>m\<^sub>a\<^sub>x * (S+D)"
    by (meson assms assump1_def assump2_def assump3_a_def mult_nonneg_nonneg norm_ge_zero mult_right_mono mult_mono
          mult_nonneg_nonneg mult_right_mono norm_ge_zero less_irrefl Eq_22 add_cancel_left_right rel_simps(93))
  thus ?thesis
    by blast
qed

(* Eq. 35 *)
theorem Eq_35:
  assumes "\<forall>t. t\<in>T""delta_def \<delta> v"
      and "norm (v) \<le> (\<xi> * (H + (norm(K\<^sub>r)*norm(e'))+ (norm(K\<^sub>\<eta>)*norm(e))) + (\<beta>\<^sub>m\<^sub>a\<^sub>x*(S + D)))" (*from Eq_34*)
    shows "\<exists>\<delta>. \<delta> \<ge> (\<xi>/\<beta>\<^sub>m\<^sub>i\<^sub>n) * (H + (norm(K\<^sub>r)*norm(e'))+ (norm(K\<^sub>\<eta>)*norm(e))) + (\<beta>\<^sub>m\<^sub>a\<^sub>x/\<beta>\<^sub>m\<^sub>i\<^sub>n)*(S + D)"
proof-
  fix x y:: "real^3"
  have x1:"\<beta>\<^sub>m\<^sub>a\<^sub>x>0 \<and> \<beta>\<^sub>m\<^sub>i\<^sub>n>0 \<and> S>0 \<and> D>0 \<and> \<xi>>0 \<and> H>0 \<and> norm x\<ge>0"
    using \<beta>\<^sub>m\<^sub>a\<^sub>x_def \<beta>\<^sub>m\<^sub>i\<^sub>n_def S_def D_def \<xi>_def H_def by force
  have x2:"y>0 \<Longrightarrow> 0+y>0"  by simp
  from x1 x2 have x3:"(\<xi> * (H + (norm(K\<^sub>r)*norm(e'))+ (norm(K\<^sub>\<eta>)*norm(e))) + (\<beta>\<^sub>m\<^sub>a\<^sub>x*(S + D))) > 0"
    by (smt distrib_left mult.commute mult_nonneg_nonneg norm_ge_zero real_mult_le_cancel_iff1)
  then have "\<exists>\<delta>. \<delta> \<ge> (\<xi> * (H + (norm(K\<^sub>r)*norm(e'))+ (norm(K\<^sub>\<eta>)*norm(e))) + (\<beta>\<^sub>m\<^sub>a\<^sub>x*(S + D)))/\<beta>\<^sub>m\<^sub>i\<^sub>n"
    using assms \<beta>\<^sub>m\<^sub>i\<^sub>n_def delta_def_def  divide_pos_pos divide_strict_right_mono by blast
  then have "\<exists>\<delta>. \<delta> \<ge> (\<xi>/\<beta>\<^sub>m\<^sub>i\<^sub>n) * (H + (norm(K\<^sub>r)*norm(e'))+ (norm(K\<^sub>\<eta>)*norm(e))) + (\<beta>\<^sub>m\<^sub>a\<^sub>x*(S + D))/\<beta>\<^sub>m\<^sub>i\<^sub>n"
    by argo
  thus ?thesis
    by auto
qed

(* Eqs 36 and 37 *)
theorem Stb_Eq_36_37:
assumes "set_of_definitions \<phi> \<theta> \<psi> \<phi>\<^sub>d \<theta>\<^sub>d \<psi>\<^sub>d \<eta> \<eta>\<^sub>d \<eta>' \<eta>\<^sub>d' \<eta>'' \<eta>\<^sub>d'' u \<gamma> e e' e'' \<tau> d
                            d\<^sub>h\<^sub>a\<^sub>t E v \<delta> C C\<^sub>h\<^sub>a\<^sub>t N N\<^sub>h\<^sub>a\<^sub>t \<Delta>N \<Delta>d A B W Q P K\<^sub>\<eta> K\<^sub>r J J\<^sub>h\<^sub>a\<^sub>t"
    and "assump1 d d\<^sub>h\<^sub>a\<^sub>t \<Delta>d" and "assump3_a \<eta>\<^sub>d''" and "assump3_b J J\<^sub>h\<^sub>a\<^sub>t \<phi> \<theta> \<psi>"
    and "\<forall>E. E\<noteq>0" and "Lyapunov V E" and "V(E) = E \<bullet> (Q *v E)"
    and "(\<forall>t\<in>T. ((\<lambda>t. V(E)) has_derivative (\<lambda>t. V'(E))) (at t within T))"
    and "\<eta>'' = u - v + matrix_inv(J)*v \<gamma>" (* from Eq_19 *)
    and "E' = A *v E + B *v (v - (matrix_inv(J) *v \<gamma>))" (* from Eq_22 *)
    and "V'(E) = - (E \<bullet> (P *v E)) + 2 * (E \<bullet> (Q *v (B *v (v - matrix_inv (J) *v \<gamma>))))" (* from Eq_30 *)
  shows "norm (transpose (B) *v (Q*v E)) \<ge> \<sigma> \<Longrightarrow> V'(E) < 0"
    and "norm (transpose (B) *v (Q*v E)) < \<sigma> \<Longrightarrow> V'(E) < 0"
    and "((\<lambda>t. norm(E)) \<longlongrightarrow> 0) (at t within T)"
proof-
   show "norm (transpose (B) *v (Q*v E)) \<ge> \<sigma> \<Longrightarrow> V'(E) < 0"
    using assms Eq_22 rel_simps(93) by metis
  then show "norm (transpose (B) *v (Q*v E)) < \<sigma> \<Longrightarrow> V'(E) < 0"
    using assms Eq_22 rel_simps(93) by metis
  show "((\<lambda>t. norm(E)) \<longlongrightarrow> 0) (at t within T)"
    using assms by auto
qed

end


theory prop_23
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun length :: "'a list => Nat" where
  "length (Nil2) = Z"
  | "length (Cons2 y xs) = S (length xs)"
  fun half :: "Nat => Nat" where
  "half (Z) = Z"
  | "half (S (Z)) = Z"
  | "half (S (S z)) = S (half z)"
  fun append :: "'a list => 'a list => 'a list" where
  "append (Nil2) y = y"
  | "append (Cons2 z xs) y = Cons2 z (append xs y)"
  (*hipster length half append *)

lemma lemma_a [thy_expl]: "append x2 Nil2 = x2"
by (hipster_induct_schemes length.simps append.simps)

lemma lemma_aa [thy_expl]: "append (append x1 y1) z1 = append x1 (append y1 z1)"
by (hipster_induct_schemes length.simps append.simps)

lemma unknown []: "length (append x y) = length (append y x)"
oops

(*hipster length half append*)

lemma ax2[thy_expl]: "length (append y (Cons2 ya xs)) = S (length (append y xs))"
by(hipster_induct_schemes)

  theorem x0 :
    "(half (length (append x y))) = (half (length (append y x)))"
    by (hipster_induct_schemes length.simps append.simps half.simps list.exhaust Nat.exhaust)
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


(*  Title:
    Author:
    Maintainer:
https://behemoth.cl.cam.ac.uk/search/
https://arxiv.org/pdf/2102.03003.pdf
https://math.stackexchange.com/
https://mathoverflow.net/
https://stackoverflow.com/
*)

section \<open> Examples \<close>

text \<open> We prove partial correctness specifications of some hybrid systems with our
verification components.\<close>

theory Real_Arith_Problems
  imports "HOL-Analysis.Analysis"
  "HOL-Eisbach.Eisbach"

begin

method move_left for x::"'a::{ab_semigroup_mult,power}" = (
    (simp only: mult.assoc[symmetric])?, (* prepare for main loop *)
    (
      (simp only: mult.commute[where b="x^_"] mult.commute[where b="x"])?,
      (simp only: mult.assoc)
      )+
    ), (simp only: mult.assoc[symmetric])? (* clean after main loop *)

method move_right for x::"'a::{ab_semigroup_mult,power}" = (
    (simp only: mult.assoc)?,
    (
      (simp only: mult.commute[where a="x^_"] mult.commute[where a="x"])?,
      (simp only: mult.assoc[symmetric])+
      )+
    ), (simp only: mult.assoc[symmetric])?

lemma sign_distrib_laws:
  shows "- (a + b) = - a - (b::'a::ab_group_add)"
  and "- (a - b) = - a + b"
  and "- (- a + b) = a - b"
  and "- (- a - b) = a + b"
  and "a - (b + c) = a - b - c"
  and "a - (b - c) = a - b + c"
  and "a - (- b + c) = a + b - c"
  and "a - (- b - c) = a + b + c"
  by simp_all

method distribute = (
    ((subst sign_distrib_laws)+)?,
    ((subst (asm) sign_distrib_laws)+)?,
    ((subst minus_mult_left)+)?, (* - (a * b) = - a * b *)
    ((subst (asm) minus_mult_left)+)?,
    ((subst ring_distribs)+)?,
    ((subst (asm) ring_distribs)+)?,
    simp
    )

named_theorems mon_pow_simps "simplification rules for powers in monomials "

declare semiring_normalization_rules(27) [mon_pow_simps] (* x * x ^ q = x ^ Suc q *)
    and semiring_normalization_rules(28) [mon_pow_simps] (* x ^ q * x = x ^ Suc q *)
    and semiring_normalization_rules(29) [mon_pow_simps] (* x * x = ?x\<^sup>2 *)

method mon_pow_simp = (
    (simp add: mon_pow_simps del: power_Suc)?,
    (simp only: mult.assoc)?,
    (simp add: mon_pow_simps del: power_Suc)?
    ) \<comment> \<open> simplifies powers in monomials \<close>

lemma "x * x * x * (y ^ Suc n * x * z * (y * x * z) * z * z) * z * z
  = x ^ 5 * y ^ Suc (Suc n) * z ^ 6" for x::real
  apply (move_left z)
  apply (move_left y)
  apply (move_left x)
  apply mon_pow_simp
  done

lemma "x * x * x * (y\<^sup>2 * x * z * (y * x * z) * z * z) * z * z
  = x ^ 5 * y ^ 3 * z ^ 6" for x::real
  apply (move_right x)
  apply (move_right y)
  apply (move_right z)
  apply mon_pow_simp
  done

lemma "(36::real) * (x1\<^sup>2 * (x1 * x2 ^ 3)) - (- (24 * (x1\<^sup>2 * x2) * x1 ^ 3 * x2\<^sup>2)
  - 12 * (x1\<^sup>2 * x2) * x1 * x2 ^ 4) - 36 * (x1\<^sup>2 * (x2 * x1)) * x2\<^sup>2 - 12 * (x1\<^sup>2 * (x1 * x2 ^ 5))
  = 24 * (x1 ^ 5 * x2 ^ 3)" (is "?t1 - (- ?t2 - ?t3) - ?t4 - ?t5 = ?t6")
  apply distribute
  apply (move_right x1)
  apply (move_right x2)
  apply mon_pow_simp
  done

method mon_simp_vars for x y::"'a::{ab_semigroup_mult,power}" = (
    (move_right x)?, (move_right y)?, mon_pow_simp?
    (* second argument should not be the right-most argument in a monomial *)
    )

lemma "x * x * (x:: real) * (y^2 * x * z * (y * x * z) * z * z) * z * z
  = x^5 * y^3 * z^6"
  by (mon_simp_vars x y)

lemma "y  * x * x * (x:: real) * (w * y^2 * x * z * (y * x * z) * z * w^4 * z) * z * z
  = x^5 * y^4 * z^6 * w^5"
  by (mon_simp_vars x y) (mon_simp_vars z w)

lemma "x * x * (x:: real) * (y^(Suc n) * x * z * (y * x * z) * z * z) * z * z
  = x^5 * y^(Suc (Suc n)) * z^6"
  by (mon_simp_vars x y)

method bin_unfold = (simp add: power2_diff power2_sum power_mult_distrib)

lemma "0 \<le> A \<Longrightarrow> 0 < b \<Longrightarrow> x2\<^sup>2 \<le> 2 * b * (m - x1) \<Longrightarrow> 0 \<le> (t::real)
  \<Longrightarrow> \<forall>\<tau>. 0 \<le> \<tau> \<and> \<tau> \<le> t \<longrightarrow> b * \<tau> \<le> x2 \<and> \<tau> \<le> \<epsilon>
  \<Longrightarrow> (x2 - b * t)\<^sup>2 \<le> 2 * b * (m - (x2 * t - b * t\<^sup>2 / 2 + x1))"
  apply bin_unfold
  apply distribute
  apply (mon_simp_vars b t)
  done

lemma factorR:
  fixes a::real
  shows "a * b + a * c = (b + c) * a"
    and "b * a + a * c = (b + c) * a"
    and "a * b + c * a = (b + c) * a"
    and "b * a + c * a = (b + c) * a"
  by distribute+

lemma factorL:
  fixes a::real
  shows "a * b + a * c = a * (b + c)"
    and "b * a + a * c = a * (b + c)"
    and "a * b + c * a = a * (b + c)"
    and "b * a + c * a = a * (b + c)"
  by distribute+

lemma factor_fracR:
  fixes a::real
  assumes "c > 0"
  shows "a / c + b = (a + c * b) * (1 / c)"
    and "a + b / c = (c * a + b) * (1 / c)"
    and "a / c - b = (a - c * b) * (1 / c)"
    and "a - b / c = (c * a - b) * (1 / c)"
    and "- a / c + b = (- a + c * b) * (1 / c)"
    and "- a + b / c = (- c * a + b) * (1 / c)"
    and "- a / c - b = (a + c * b) * (- (1 / c))"
    and "- a - b / c = (c * a + b) * (- (1 / c))"
  using assms by distribute+

lemma "a * (b / c) = (a * b) / c" for a::real
  oops

lemma STTexample6_arith:
  assumes "0 < A" "0 < B" "0 < \<epsilon>" "0 \<le> x2" "0 \<le> (t::real)" "- B \<le> k" "k \<le> A"
    and key: "x1 + x2\<^sup>2 / (2 * B) + (A * (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * x2) / B + (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * x2)) \<le> S" (is "?k3 \<le> S")
    and ghyp: "\<forall>\<tau>. 0 \<le> \<tau> \<and> \<tau> \<le> t \<longrightarrow> 0 \<le> k * \<tau> + x2 \<and> \<tau> \<le> \<epsilon>"
  shows "k * t\<^sup>2 / 2 + x2 * t + x1 + (k * t + x2)\<^sup>2 / (2 * B) \<le> S" (is "?k0 \<le> S")
  using assms
  apply -
  apply distribute
  apply (subst factor_fracR[where c="2 * B"], simp?)
  apply (subst (asm) factor_fracR[where c="2 * B"], simp?)
  apply (mon_simp_vars A B)
  apply (subst (asm) factor_fracR[where c="2"], simp?)
  apply mon_pow_simp
  apply (subst (asm) factor_fracR[where c="2"], simp?)
  apply mon_pow_simp
  apply (subst (asm) factor_fracR[where c="2 * B"], simp?)
  apply mon_pow_simp
  apply (subst (asm) factor_fracR[where c="2 * B"], simp?)
  apply mon_pow_simp
  apply (subst (asm) factor_fracR[where c="2"], simp?)
  apply mon_pow_simp
  apply (move_right A)
  apply mon_pow_simp
  apply distribute
  apply bin_unfold
  apply mon_pow_simp

  apply (subst factorL[where a=4])

  apply (mon_simp_vars )
  oops

(* still unsure if the methods below will be needed *)

method frac_ad = (simp add: add_frac_eq  diff_frac_eq)

method move_left_term for x::"'a::{ab_semigroup_add,power}" =
 (((subst add.commute[where b="x"])+)?;
    ((subst add.commute[where b="_* x"])+)?; ((subst add.commute[where b="x *_"])+)?;
 (subst add.assoc)+)+, (rule refl)?

method move_right_term for x::"'a::{ab_semigroup_add,power}" =
 (((subst add.commute[where a="x"])+)?;
    ((subst add.commute[where a="_* x"])+)?; ((subst add.commute[where a="x *_"])+)?;
 (subst add.assoc)+)+, (rule refl)?

thm semiring_normalization_rules(17,27,28,29)

lemma "x * y + z + z * 2 * y * x\<^sup>2 + z + y\<^sup>2 = y\<^sup>2 + x\<^sup>2 * 2 * z * y + 2 * z + x * y" for x:: real
  apply simp
  done

subsection \<open> Basic \<close>

lemma abs_le_eq:
  shows "(r::real) > 0 \<Longrightarrow> (\<bar>x\<bar> < r) = (-r < x \<and> x < r)"
    and "(r::real) > 0 \<Longrightarrow> (\<bar>x\<bar> \<le> r) = (-r \<le> x \<and> x \<le> r)"
   apply linarith
  apply linarith
  done

lemma "(Collect ((\<le>) (0::real))) = {x:: real. x\<ge>0}"
  by simp

lemma is_interval_real_nonneg[simp]: "is_interval {x:: real. x\<ge>0}"
  using is_interval_1 by force

lemma "((a::real)-b)^2 = a^2 - 2 * a * b + b^2"
  by bin_unfold

lemma "(cos t)\<^sup>2 + (sin (t::real))\<^sup>2 = 1"
  by simp

lemma norm_rotate_eq:
  fixes x :: "'a:: {banach,real_normed_field}"
  shows "(x * cos t - y * sin t)\<^sup>2 + (x * sin t + y * cos t)\<^sup>2 = x\<^sup>2 + y\<^sup>2" (is "?a^2+?b^2 =_")
    and "(x * cos t + y * sin t)\<^sup>2 + (y * cos t - x * sin t)\<^sup>2 = x\<^sup>2 + y\<^sup>2" (is "?e^2+?f^2 =_")
proof-
  have exp1: "?a^2 = x\<^sup>2 * (cos t)\<^sup>2 - 2 * x * y * cos t * sin t + y\<^sup>2 * (sin t)\<^sup>2" (is "_ = ?c")
    by bin_unfold
  have exp2: "?b^2 = x\<^sup>2 * (sin t)\<^sup>2 + 2 * x * y * sin t * cos t + y\<^sup>2 * (cos t)\<^sup>2" (is "_=?d")
    by bin_unfold
  have "?a\<^sup>2 + ?b\<^sup>2 = ?c+?d "
    using exp1 exp2
    by fastforce
  also have "... = x\<^sup>2 * ((cos t)\<^sup>2 + (sin t)\<^sup>2) + y\<^sup>2 * ((cos t)\<^sup>2 + (sin t)\<^sup>2)"
    by distribute
  also have "... = x^2 + y^2"
    by simp
  finally show  "?a\<^sup>2+?b\<^sup>2 = x\<^sup>2 + y\<^sup>2" .
next
  have exp3: "?e^2 = x\<^sup>2 * (cos t)\<^sup>2 + 2 * x * y * cos t * sin t + y\<^sup>2 * (sin t)\<^sup>2" (is "_ = ?g")
    by bin_unfold
  have exp4: "?f^2 = y\<^sup>2 * (cos t)\<^sup>2 - 2 * x * y * sin t * cos t + x\<^sup>2 * (sin t)\<^sup>2"(is "_= ?h")
    by bin_unfold
  have "?e\<^sup>2 + ?f\<^sup>2 = ?g + ?h "
    using exp3 exp4
    by presburger
  also have "... = x\<^sup>2 * ((cos t)\<^sup>2 + (sin t)\<^sup>2) + y\<^sup>2 * ((cos t)\<^sup>2 + (sin t)\<^sup>2)"
    by distribute
  also have "... = x\<^sup>2 + y\<^sup>2"
    by simp
  finally show  "?e\<^sup>2 + ?f\<^sup>2 = x\<^sup>2 + y\<^sup>2" .
qed

lemma mult_abs_right_mono: "a < b \<Longrightarrow> a * \<bar>c\<bar> \<le> b * \<bar>c\<bar>" for c::real
  by (simp add: mult_right_mono)

lemma local_lipschitz_first_order_linear:
  fixes c::"real \<Rightarrow> real"
  assumes "continuous_on T c"
  shows "local_lipschitz T UNIV (\<lambda>t x.  (c t) * x)"
proof(unfold local_lipschitz_def lipschitz_on_def, clarsimp simp: dist_norm)
  fix x t::real assume "t \<in> T"
  thus "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> T. 0 \<le> L \<and>
    (\<forall>xa\<in>cball x u. \<forall>y\<in>cball x u. \<bar>c t * xa - c t * y\<bar> \<le> L * \<bar>xa - y\<bar>)"
    sorry
qed

lemma darboux_ineq_arith:
  assumes "0 \<le> s\<^sub>1 + s\<^sub>2" and "0 \<le> (t::real)" and "t * s\<^sub>1 < 1"
  shows "0 \<le> s\<^sub>1 / (1 - t * s\<^sub>1) + (s\<^sub>2 - s\<^sub>1 * ln (1 - t * s\<^sub>1)) / (1 - t * s\<^sub>1)"

  oops

lemma picard_lindeloef_dyn_bif: "continuous_on T g \<Longrightarrow> t\<^sub>0 \<in> T \<Longrightarrow> is_interval T \<Longrightarrow>
  open T \<Longrightarrow> (t::real) \<in> T \<Longrightarrow> \<exists>u>0. (\<exists>ta. \<bar>t - ta\<bar> \<le> u \<and> ta \<in> T) \<longrightarrow>
  (\<exists>L\<ge>0. \<forall>xa\<in>cball (x::real) u. \<forall>y\<in>cball x u. \<bar>xa\<^sup>2 - y\<^sup>2\<bar> \<le> L * \<bar>xa - y\<bar>)"
proof-
  fix x t::real
  show "\<exists>u>0. (\<exists>\<tau>. \<bar>t - \<tau>\<bar> \<le> u \<and> \<tau> \<in> T) \<longrightarrow>
  (\<exists>L\<ge>0. \<forall>xa\<in>cball x u. \<forall>y\<in>cball x u. \<bar>xa\<^sup>2 - y\<^sup>2\<bar> \<le> L * \<bar>xa - y\<bar>)"
  proof (rule_tac x = 1 in  exI, clarsimp)
    fix w
    assume "\<bar>t - w\<bar> \<le> 1" and "w \<in> T"
    show " \<exists>L\<ge>0. \<forall>z\<in>cball x 1. \<forall>y\<in>cball x 1. \<bar>z\<^sup>2 - y\<^sup>2\<bar> \<le> L * \<bar>z - y\<bar>"
      apply (rule_tac x = 22 in exI)
      thm allE ballE  allI ballI
      thm exE exI bexE bexI
      thm conjI conjE
      thm disjI1 disjI2 disjE
      thm iffI iffE
     (* apply (rule allE)*)
      sorry
    oops

lemma sumfrac: "((a:: real) + b) / c = a / c + b / c" "(a-b)/c= a/c - b/c"
   apply (clarsimp simp: add_divide_distrib)
  apply (clarsimp simp:  diff_divide_distrib)
  done

lemma frac: "(1:: real)/ a * 1 / b = 1 / (a * b) "
  by simp

lemma "((x::real)-y)^2  / (2 * B)   = x^2 / (2 * B)  -2 * x * y /(2 * B)  + y^2  / (2 * B)"
  apply bin_unfold
  by (simp add: power2_diff diff_divide_distrib add_divide_distrib)

lemma STTexample3a_arith:
  assumes "0 < (B::real)" "0 \<le> t" "0 \<le> x2" and key: "x1 + x2\<^sup>2 / (2 * B) \<le> S"
  shows "x2 * t - B * t\<^sup>2 / 2 + x1 + (x2 - B * t)\<^sup>2 / (2 * B) \<le> S" (is "?lhs \<le> S")
proof-
  have "(x2 - B * t)\<^sup>2 =  x2\<^sup>2 -2 * B * x2 * t + B^2 * t\<^sup>2 "
     by bin_unfold
  hence "(x2 - B * t)\<^sup>2 / (2 * B) =(x2\<^sup>2 -2 * B * x2 * t + B^2 * t\<^sup>2) / (2 * B) " (is "_ = ?f")
    by simp
   also have "... = x2^2 /(2 * B)- 2 * B * x2* t/(2 * B) + B^2* t^2 /(2 * B) "
    by (simp add: add_divide_distrib  diff_divide_distrib)
  also have "... =x2^2 /(2 * B) - x2 * t + B* t^2/ 2 " using assms
    by (simp add: power2_eq_square)
  finally have "(x2 - B * t)\<^sup>2 / (2 * B) = x2^2 /(2 * B) - x2 * t + B* t^2/ 2 ".
  hence "?lhs = x1 + x2\<^sup>2 / (2 * B) "
    by simp
  thus  "?lhs \<le> S"
    using assms(4) by simp
qed

lemma "(a:: real)*(b+c) = a* b + a* c"
  by (simp add: Groups.algebra_simps(18))

lemma STTexample5_arith:
  assumes "0 < A" "0 < B" "0 < \<epsilon>" "0 \<le> x2" "0 \<le> (t::real)"
    and key: "x1 + x2\<^sup>2 / (2 * B) + (A * (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * x2) / B + (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * x2)) \<le> S" (is "?k3 \<le> S")
    and ghyp: "\<forall>\<tau>. 0 \<le> \<tau> \<and> \<tau> \<le> t \<longrightarrow> \<tau> \<le> \<epsilon>"
  shows "A * t\<^sup>2 / 2 + x2 * t + x1 + (A * t + x2)\<^sup>2 / (2 * B) \<le> S" (is "?k0 \<le> S")
proof-
  have "(A * t + x2)\<^sup>2 = A^2 * t^2 +2* A * t * x2  + x2^2 "
 by (simp add: power2_sum power_mult_distrib)
  hence "(A * t + x2)\<^sup>2 / (2 * B) = (A^2 * t^2 +2* A * t * x2  + x2^2) / (2 * B)"
    by simp
  also have "... = A^2 * t^2 /(2 * B) + 2 * A * t * x2 /(2 * B) + x2^2 /(2 * B) "
    by (simp add: add_divide_distrib)
  also have "... = A^2 * t^2 /(2 * B) + A * t * x2 / B + x2^2 /(2 * B) "
    by  clarsimp
  finally have coso1: "(A * t + x2)\<^sup>2 / (2 * B) = A^2 * t^2 /(2 * B) + A * t * x2 / B + x2^2 /(2 * B) ".
  have r1: "t \<le>  \<epsilon> "
    using ghyp assms(5) by force
  have des1: "x2 * t \<le>  \<epsilon> * x2"
    by (simp add: \<open>t \<le> \<epsilon>\<close> assms(4) mult.commute mult_right_mono)
  have des2: "A * t\<^sup>2 / 2 \<le> A * \<epsilon>\<^sup>2 / 2 "
    by (simp add: \<open>t \<le> \<epsilon>\<close> assms(1) assms(5) power_mono)
  hence des3: "A^2 * t^2 /(2 * B) \<le> A^2 * \<epsilon>\<^sup>2 /(2 * B)  " using assms(2)
    apply clarsimp
    by (simp add: assms(1) frac_le mult_left_mono)
  have des4: "A* t* x2 / B \<le> A * \<epsilon> * x2 / B " using r1 assms
    by (metis div_0 divide_right_mono le_divide_eq_1_neg less_eq_real_def
mult_le_cancel_left_pos mult_le_cancel_right not_one_le_zero)
  have "?k0 = A * t\<^sup>2 / 2 + x2 * t + x1 + A^2 * t^2 /(2 * B) + A * t * x2 / B + x2^2 /(2 * B)" (is "_=?k1")
    by (simp add: coso1)
  have "?k3 = x1 + x2\<^sup>2 / (2 * B) + (A^2 * \<epsilon>\<^sup>2 / 2 +A *  \<epsilon> * x2) / B + (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * x2)"
    using assms(2)
    by (clarsimp simp: Groups.algebra_simps(18) power2_eq_square)
  also have "... = x1 + x2\<^sup>2 / (2 * B) + A^2 * \<epsilon>\<^sup>2 / (2 * B) +A *  \<epsilon> * x2 / B + (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * x2)" (is "_=?k2")
    by (clarsimp simp: frac add_divide_distrib)
  oops

  subsubsection \<open> STTT Tutorial: Example 7 \<close>

lemma consprod: assumes  "(0::real) < b" "s \<le> t"
  shows " s / b \<le>  t / b"
  using assms(1) assms(2) divide_right_mono by fastforce

lemma consprod2: assumes  "(0::real) < b" "s \<le> t"
  shows " b* s \<le> b * t"
  by (simp add: assms(1) assms(2))

lemma STTexample7_arith1:
  assumes "(0::real) < A" "0 < b" "0 < \<epsilon>" "0 \<le> v" "0 \<le> t" "k \<le> A"
    and "x + v\<^sup>2 / (2 * b) + (A * (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * v) / b + (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * v)) \<le> S" (is "?expr1 \<le> S")
    and guard: "\<forall>\<tau>. 0 \<le> \<tau> \<and> \<tau> \<le> t \<longrightarrow> 0 \<le> k * \<tau> + v \<and> \<tau> \<le> \<epsilon>"
  shows "k * t\<^sup>2 / 2 + v * t + x + (k * t + v)\<^sup>2 / (2 * b) \<le> S" (is "?lhs \<le> S")
proof-
  have "k * t\<^sup>2 / 2 + v * t + x + (k * t + v)\<^sup>2 / (2 * b) \<le> S"
  oops

lemma "(a:: real)*c+ a * b = a * (c + b)"
  by (simp add: ring_class.ring_distribs(1))

lemma "(v:: real) * t + k * t\<^sup>2 / 2 = (v + k * t / 2) * t"
  by (simp add: power2_eq_square ring_class.ring_distribs(2))

method divide_simplify = (clarsimp simp: add_divide_distrib)

lemma STTexample7_arith2:
  assumes "(0::real) < b" "0 \<le> v" "0 \<le> t" "k \<le> - b"
    and key: "x + v\<^sup>2 / (2 * b) \<le> S"
    and guard: "\<forall>\<tau>. 0 \<le> \<tau> \<and> \<tau> \<le> t \<longrightarrow> 0 \<le> k * \<tau> + v \<and> \<tau> \<le> \<epsilon>"
  shows "k * t\<^sup>2 / 2 + v * t + x + (k * t + v)\<^sup>2 / (2 * b) \<le> S" (is "?lhs \<le> S")
proof-
  have des1: " 0 \<le> k * t / 2 + v"
    using assms(6) assms(2) assms(3) by force
  have " k / b \<le> -1" using assms(1) assms(4) consprod
    by fastforce
  hence des2: "1 + k / b \<le> 0"
    by simp
  have "(k * t + v)\<^sup>2  = (k^2 * t^2 + 2 * k * t * v + v^2)"
    by bin_unfold
  have "(k * t + v)\<^sup>2/ (2 * b) = (k^2 * t^2 + 2 * k * t * v + v^2) / (2 * b)"
    by (simp add: \<open>(k * t + v)\<^sup>2 = k\<^sup>2 * t\<^sup>2 + 2 * k * t * v + v\<^sup>2\<close>)
  also have "... = k^2 * t^2 / (2 * b)+ k * t * v/ b + v^2/ (2 * b)"
    by divide_simplify
  finally have "?lhs = k * t\<^sup>2 / 2 + v * t + x + k^2 * t^2 / (2 * b)+ k * t * v/ b + v^2/ (2 * b) "
    by simp
  also have "... = (v * t + k * t * v/ b) + (k * t\<^sup>2 / 2 + k^2 * t^2 / (2 * b)) + x + v^2/ (2 * b)"
    by auto
  also have "... = v * t * (1 + k / b) + k * t^2 / 2 * (1 + k / b) + x + v^2 / (2 * b)"
    apply (clarsimp simp: ring_distribs(1))
    by (metis (no_types, hide_lams) divide_divide_eq_right mult_numeral_1
power2_eq_square times_divide_eq_left)
  also have "... = (v * t + k * t^2 /2) * (1 + k / b) + x + v^2 / (2 * b) "
    apply clarsimp
    by (simp add: ring_class.ring_distribs(2))
  also have "... =  (v + k * t / 2) * t  * (1 + k / b) + x + v^2 / (2 * b) "
    apply clarsimp
    by (simp add: power2_eq_square ring_class.ring_distribs(2))
  finally have "?lhs = (v + k * t / 2) * t  * (1 + k / b) + x + v^2 / (2 * b)" (is "_ = ?d")
    by simp
  have "(v + k * t / 2) * t \<ge> 0" using assms(3) des1
    by fastforce
  hence "(v + k * t / 2) * t  * (1 + k / b) \<le> 0 "
    using des2 divide_self_if neg_divide_le_eq by force
  hence "?d \<le>  x + v^2 / (2 * b)"
    by simp
  hence "?lhs \<le> x + v^2 / (2 * b)"
    by (simp add: \<open>?d \<le> x + v\<^sup>2 / (2 * b)\<close> \<open>k * t\<^sup>2 / 2 + v * t + x + (k * t + v)\<^sup>2 / (2 * b) = ?d\<close>)
  thus "?lhs \<le> S"
    using assms(5)
    by auto
qed

lemma STTexample9a_arith:
  "(10*x-10*r) * v/4 + v\<^sup>2/2 + (x-r)*(2*r-2*x-3 * v)/2 + v * (2*r-2*x-3 * v)/2 \<le> (0::real)"
  (is "?t1 + ?t2 + ?t3 + ?t4 \<le> 0")
  oops

lemma LICSexample4a_arith:
  assumes "(0::real) \<le> A" "0 < b" "v\<^sup>2 \<le> 2 * b * (m - x)" "0 \<le> t"
      and guard: "\<forall>\<tau>. 0 \<le> \<tau> \<and> \<tau> \<le> t \<longrightarrow> 0 \<le> A * \<tau> + v \<and> \<tau> \<le> \<epsilon>"
      and key: "v\<^sup>2 + (A * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v) + b * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v)) \<le> 2 * b * (m - x)" (is "?expr1 \<le> _")
    shows "(A * t + v)\<^sup>2 \<le> 2 * b * (m - (A * t\<^sup>2 / 2 + v * t + x))"
  oops

lemma "(a:: real) * a = a^2"
  oops

lemma LICSexample4c_arith1:
  assumes "v\<^sup>2 \<le> 2 * b * (m - x)" "0 \<le> t" "A \<ge> 0" "b > 0"
    and key: "v\<^sup>2 + (A * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v) + b * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v)) \<le> 2 * b * (m - x)"
    and guard: "\<forall>\<tau>. 0 \<le> \<tau> \<and> \<tau> \<le> t \<longrightarrow> (0::real) \<le> A * \<tau> + v \<and> \<tau> \<le> \<epsilon>"
  shows "(A * t + v)\<^sup>2 \<le> 2 * b * (m - (A * t\<^sup>2 / 2 + v * t + x))" (is "_ \<le> ?rhs")
proof-
  have " ?rhs = 2 * b *(m - A * t\<^sup>2 / 2 - v * t - x)"
    by simp
  also have "... = 2 * b * m - 2 * b * (A * t^2 / 2) - 2 * b * v * t - 2 * b * x"
    by (simp add: cross3_simps(25))
  also have "... = 2 * b * (m- x) - 2 * b * (A * t^2 / 2) - 2 * b * v * t"
    by (simp add: cross3_simps(25))
  also have "... =  2 * b * (m- x) - b * A * t^2  - 2 * b * v * t "
    by simp
  also have "... = 2 * b * (m- x) - b * (A * t^2  + 2 * v * t)"
    by (simp add: vector_space_over_itself.scale_right_distrib)
  finally have exp1: "?rhs =  2 * b * (m- x) - b * (A * t^2  + 2 * v * t)"
    by simp
  have exp2: "t \<le> \<epsilon>"
    using guard by (simp add: assms(2))
  have "v \<ge> 0"
    using assms(6) assms(2) mult_not_zero by auto
  hence " 2 * t * v \<le> 2 * \<epsilon> * v" and "A * t^2 \<le> A * \<epsilon>^2"
    using assms(3) exp2 assms(2) mult_right_mono apply auto[1]
    by (simp add: assms(2) assms(3) guard mult_mono)
  hence exp3: "A * t^2 + 2 * t * v \<le> A * \<epsilon>^2 + 2 * \<epsilon> * v"
    by simp
  hence exp4: "A *(A * t^2 + 2 * t * v) \<le> A* (A * \<epsilon>^2 + 2 * \<epsilon> * v)"
    by (simp add: assms(3) ordered_comm_semiring_class.comm_mult_left_mono)
  have "b *(A * t^2 + 2 * t * v) \<le> b* (A * \<epsilon>^2 + 2 * \<epsilon> * v)"
    using exp3 assms(4) by auto
  hence "v\<^sup>2 + (A * (A * t\<^sup>2 + 2 * t * v) + b * (A * t\<^sup>2 + 2 * t * v)) \<le> v\<^sup>2 + (A * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v) + b * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v))"
    using exp4 by auto
  hence exp5: "v\<^sup>2 + (A * (A * t\<^sup>2 + 2 * t * v) + b * (A * t\<^sup>2 + 2 * t * v)) \<le> 2 * b * (m - x)" (is "?f \<le> _")
    using assms(5) by simp
  have "?f = v^2 + A * A * t\<^sup>2 + 2 * A * t * v + b * A * t\<^sup>2 + 2 * b * t * v" (is "_ = ?g")
    by (clarsimp simp: algebra_simps(18))
  hence "?g \<le> 2 * b * (m - x) "
    using exp5 by simp
  hence "v^2 + A * A * t\<^sup>2 + 2 * A * t * v \<le> 2 * b * (m - x) - b * A * t\<^sup>2 - 2 * b * t * v"
    by simp
  hence exp6: "A * A * t\<^sup>2 + 2 * A * t * v + v^2 \<le> 2 * b * (m - x) -2* b * A * t\<^sup>2 / 2- 2 * b * t * v"
    by simp
  have "(A * t + v)^2  = A * A * t\<^sup>2 + 2 * A * t * v + v^2"
    by (simp add: power2_diff power2_sum power_mult_distrib semiring_normalization_rules(29))
  have "2 * b * (m - x) -2* b * A * t\<^sup>2 / 2- 2 * b * t * v = 2 * b * (m- x) - b * A * t^2 -b* 2 * v * t"
    by simp
  also have "... = 2 * b * (m- x) - b * (A * t^2  + 2 * v * t)"
    using \<open>2 * b * (m - x) - b * A * t\<^sup>2 - 2 * b * v * t = 2 * b * (m - x) - b * (A * t\<^sup>2 + 2 * v * t)\<close>
    by auto
  also have "... = ?rhs"
    using exp1 by simp
  finally have "2 * b * (m - x) -2* b * A * t\<^sup>2 / 2- 2 * b * t * v = ?rhs".
  thus "(A * t + v)^2 \<le> ?rhs"
    using exp6 \<open>(A * t + v)\<^sup>2 = A * A * t\<^sup>2 + 2 * A * t * v + v\<^sup>2\<close> by presburger
qed

lemma LICSexample5_arith1:
  assumes "(0::real) < b" "0 \<le> t"
    and key: "v\<^sup>2 \<le> 2 * b * (m - x)"
  shows "v * t - b * t\<^sup>2 / 2 + x \<le> m"
proof-
  have "(v - b* t)^2 \<ge>0 "
    by simp
  have "v^2 - 2*b*(m-x)\<le>0 " using assms(3)
    by simp
  hence "(v - b* t)^2 \<ge> v^2 - 2*b*(m-x) "
    using \<open>0 \<le> (v - b * t)\<^sup>2\<close> by linarith
  have cuad: "(v - b* t)^2 = v^2 -2 * v * b* t + b^2 * t^2 "
     by bin_unfold
  have "v^2 -2 * v * b* t + b^2 * t^2 \<ge>  v^2 - 2*b*(m-x)"
    using cuad \<open>v\<^sup>2 - 2 * b * (m - x) \<le> (v - b * t)\<^sup>2\<close> by auto
  hence " 2 * b * (m-x) - v^2 \<ge> - v\<^sup>2 + 2 * v * b* t - b^2 * t^2 "
    by auto
  hence " 2 * b * (m-x) \<ge>  2 * v * b* t - b^2 * t^2 "
    by simp
  hence "2 * b * (m-x) / (2 * b) \<ge> (2 * v * b* t - b^2 * t^2) / (2 * b) " using assms(1) consprod
    by (metis eq_divide_eq_numeral1(1) half_gt_zero_iff mult_2 mult_2_right)
  hence "m - x \<ge> (2 * v * b* t - b^2 * t^2) / (2 * b) "
    using assms(1) by auto
  have " (2 * v * b* t - b^2 * t^2) / (2 * b) = 2 * v * b * t / (2 * b) - b^2 * t^2 / (2 * b)  "
    by (simp add: diff_divide_distrib)
  also have "... = v * t - b^2 * t^2 / (2 * b)"
    using assms(1) by auto
  also have "... = v * t - b * t^2 / 2  "
    apply clarsimp
    by (simp add: power2_eq_square)
  finally have r1: "(2 * v * b* t - b^2 * t^2) / (2 * b) =   v * t - b * t^2 / 2"
    by simp
  have "m - x \<ge>  v * t - b * t^2 / 2 "
    using r1 \<open>(2 * v * b * t - b\<^sup>2 * t\<^sup>2) / (2 * b) \<le> m - x\<close> by auto
  thus  "v * t - b * t\<^sup>2 / 2 + x \<le> m"
    using \<open>v * t - b * t\<^sup>2 / 2 \<le> m - x\<close> by fastforce
qed

lemma LICSexample5_arith2:
  assumes "(0::real) < b" "0 \<le> v" "\<forall>t\<in>{0..}. v * t - b * t\<^sup>2 / 2 + x \<le> m"
  shows "v\<^sup>2 \<le> 2 * b * (m - x)"
proof-
  have h1: "v / b \<ge> 0 "
    using assms(1) assms(2) by auto
have h2: "2 *b > 0 "
    using assms(1) by simp
  have "v * (v/b) - b * (v/b)\<^sup>2 / 2 + x \<le> m "
    using assms(3) apply (erule_tac x = "v/b" in ballE)
     apply simp
    using h1 by simp
  have "v * (v/b) - b * (v/b)\<^sup>2 / 2 + x = v^2 / b - 1/2 * v^2 / b + x"
    by (clarsimp simp: power2_eq_square)
  also have "... = 1/2 * v^2 /b + x "
    by simp
  also have "... = v^2 / (2*b)+x"
    by simp
  finally have "v * (v/b) - b * (v/b)\<^sup>2 / 2 + x = v^2 / (2*b)+x ".
  hence "v^2 / (2*b)+x \<le> m"
    using \<open>v * (v / b) - b * (v / b)\<^sup>2 / 2 + x \<le> m\<close> by auto
  hence "v^2 / (2*b) \<le> m - x"
    by auto
  hence "(2*b) * v^2 / (2*b) \<le> (2 * b)* (m - x) " using h2 consprod2
    by (metis times_divide_eq_right)
  thus "v^2 \<le> 2 * b* (m - x) "
    using h2 by auto
qed

(*lemma "(p  \<Longrightarrow> False) \<Longrightarrow> \<not> p  "
  by (rule notI)*)

lemma LICSexample6_arith1:
  assumes "0 \<le> v" "0 < b" "0 \<le> A" "0 \<le> \<epsilon>"
    and guard: "\<forall>t\<in>{0..}. (\<forall>\<tau>. 0 \<le> \<tau> \<and> \<tau> \<le> t \<longrightarrow> \<tau> \<le> \<epsilon>) \<longrightarrow> (\<forall>\<tau>\<in>{0..}.
  A * t * \<tau> + v * \<tau> - b * \<tau>\<^sup>2 / 2 + (A * t\<^sup>2 / 2 + v * t + x) \<le> (m::real))"
  shows "v\<^sup>2 + (A * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v) + b * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v)) \<le> 2 * b * (m - x)"
  oops

lemma ETCS_arith1:
  assumes "0 < b" "0 \<le> A" "0 \<le> v" "0 \<le> t"
    and "v\<^sup>2 / (2 * b) + (A * (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * v)/ b + (A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * v)) \<le> m - x" (is "?expr1 \<le> m - x")
    and guard: "\<forall>\<tau>. 0 \<le> \<tau> \<and> \<tau> \<le> t \<longrightarrow> \<tau> \<le> \<epsilon>"
  shows "(A * t + v)\<^sup>2/(2 * b) \<le> (m::real) - (A * t\<^sup>2/2 + v * t + x)" (is "?lhs \<le> ?rhs")
proof-
 have "(A * t + v)\<^sup>2  = (A^2 * t^2 + 2 * A * t * v + v^2)"
    by bin_unfold
  hence "(A * t + v)\<^sup>2/ (2 * b) = (A^2 * t^2 + 2 * A * t * v + v^2) / (2 * b)"
    by (simp add: \<open>(A * t + v)\<^sup>2 = A^2 * t\<^sup>2 + 2 * A * t * v + v\<^sup>2\<close>)
  also have "... = A^2 * t^2 / (2 * b)+ A * t * v/ b + v^2/ (2 * b)"
    by divide_simplify
  also have "... = (A^2 * t\<^sup>2 / 2)/ b + (A * t * v) / b + v^2/ (2 * b)"
    by simp
  also have "... = (A^2 * t\<^sup>2 / 2 + A * t * v)/ b + v^2/ (2 * b)"
    apply clarsimp
    by (simp add: sumfrac(1))
  also have "... = A * (A * t^2 / 2 + t * v) / b + v^2 /(2 * b)"
    apply clarsimp using assms(1) assms(4)
    by (simp add: Groups.algebra_simps(18) power2_eq_square)
  have "t \<le> \<epsilon>"
    using assms(6) assms(4) by simp
  hence "v *t \<le> v * \<epsilon>"
    using assms(3) by (simp add: mult_left_mono)
  have "A * t^2 / 2 \<le> A * \<epsilon>^2 / 2"
    by (simp add: \<open>t \<le> \<epsilon>\<close> assms(2) assms(4) mult_mono power_mono)
  have "?expr1 = v\<^sup>2 / (2 * b) + (A^2 * \<epsilon>\<^sup>2 / 2 + A * \<epsilon> * v)/ b + A * \<epsilon>\<^sup>2 / 2 + \<epsilon> * v"
    apply clarsimp
    sorry
  oops

lemma ETCS_Prop1_arith2:
  assumes "0 \<le> v" "0 \<le> \<delta>" "0 < b" "x \<le> m" "0 \<le> (t::real)"
      and key: "v\<^sup>2 - \<delta>\<^sup>2 \<le> 2 * b * (m - x)" "m \<le> v * t - b * t\<^sup>2 / 2 + x"
      and guard: "\<forall>\<tau>\<in> closed_segment 0 t. b * \<tau> \<le> v"
    shows "v - b * t \<le> \<delta>"
proof-
  have d0: "2 * b > 0"
    using assms(3) by simp
  have "m - x \<le> v * t - b * t\<^sup>2 / 2"
    using assms(7) by simp
  hence d1: "m - x - v^2 /(2* b) \<le> v * t - b * t\<^sup>2 / 2 - v^2 /(2* b)"
    by simp
  have " - (v - b * t)\<^sup>2 = - (v^2 - 2 * v * b * t + b^2 * t^2)"
    by bin_unfold
  hence "- (v - b * t)\<^sup>2/(2* b) = - (v^2 - 2 * v * b * t + b^2 * t^2) /(2* b)"
    by simp
  also have "... = - (v^2 /(2* b) - 2 * v * b * t /(2* b) + b^2 * t^2 /(2* b))"
    by (metis (no_types, hide_lams) add_diff_cancel_right' sumfrac(1) uminus_add_conv_diff)
  also have "... = - (v^2 /(2* b) - v * t + b * t^2 / 2) "
    using assms(3) apply clarsimp
    by (simp add: power2_eq_square)
  also have "... = - v\<^sup>2 /(2* b) + v * t - b * t^2 / 2"
    by auto
  finally have "- (v - b * t)\<^sup>2/(2* b) =  - v\<^sup>2 /(2* b) + v * t - b * t^2 / 2 "
    by simp
  hence "m - x - v^2 /(2* b) \<le> - (v - b * t)\<^sup>2/(2* b)"
    using d1 by simp
  hence d2: "(2* b) *(m - x - v^2 /(2* b)) \<le> (2 * b) * (-(v - b * t)\<^sup>2 / (2* b))"
    using d0 consprod2
    by blast
  have eq1: "(2* b) *(m - x - v^2 /(2* b)) = (2* b) *(m - x) - v^2"
    using assms(3) by (simp add: Groups.algebra_simps(19))
  have eq2: "(2 * b) * (-(v - b * t)\<^sup>2 / (2* b)) = -(v - b * t)\<^sup>2"
    using d0 by auto
  have d3: " (2* b) *(m - x) - v^2 \<le> -(v - b * t)\<^sup>2 "
    using eq1 eq2 d2 by simp
  have "- \<delta>\<^sup>2 \<le> (2* b) *(m - x) - v^2 "
    using assms(6) by simp
  hence "- \<delta>\<^sup>2 \<le> -(v - b * t)\<^sup>2"
    using d3 by auto
  hence d4: "(v - b * t)\<^sup>2 \<le> \<delta>\<^sup>2"
    by simp
  have " b * t \<le> v" using assms(8)
    by simp
  hence "v - b * t \<ge> 0"
    by simp
  thus "v - b * t \<le> \<delta>"
    using d4 assms(2) pos2 power_mono_iff by blast
qed

(*
Aquí iré haciendo pruebas de algunas herramientas de Eisbach
*)
method elimconj = (rule impI, erule conjE)

lemma "P \<and> Q \<longrightarrow> P"
  by elimconj

named_theorems eliminacion

declare conjE[eliminacion]

method elimconj2 = ((rule impI, (erule eliminacion)?) | assumption)+

lemma "P \<and> Q \<longrightarrow> P"
  by elimconj2

named_theorems introduccion

declare conjI [introduccion] and impI [introduccion]

method elimconj3 = ((rule introduccion, (erule eliminacion)?) | assumption)+

lemma "P \<and> Q \<longrightarrow> P"
  by elimconj3

method rule_twice uses my_rule =
(rule my_rule, rule my_rule)

lemma "P \<and> P \<and> P \<Longrightarrow> P"
  by (rule_twice my_rule: conjE)

lemma "P \<Longrightarrow> P \<Longrightarrow> P \<Longrightarrow> P"
  by blast

method conjuncion uses rule =
(intro conjI ; intro rule)

lemma
assumes hip: "P"
shows "P \<and> P \<and> P"
  by (conjuncion rule: hip)

method divide_distrib uses rule =
(simp add: add_divide_distrib  diff_divide_distrib; simp add: power2_eq_square)

lemma STTejemplo3a_arith:
  assumes "0 < (B::real)" "0 \<le> t" "0 \<le> x2" and key: "x1 + x2\<^sup>2 / (2 * B) \<le> S"
  shows "x2 * t - B * t\<^sup>2 / 2 + x1 + (x2 - B * t)\<^sup>2 / (2 * B) \<le> S" (is "?lhs \<le> S")
  apply (bin_unfold, divide_distrib) using assms by (auto simp: power2_eq_square)
(* esta sería la prueba formal del lema:
  have "(x2 - B * t)\<^sup>2 =  x2\<^sup>2 -2 * B * x2 * t + B^2 * t\<^sup>2 "
     by bin_unfold
  hence "(x2 - B * t)\<^sup>2 / (2 * B) =(x2\<^sup>2 -2 * B * x2 * t + B^2 * t\<^sup>2) / (2 * B) " (is "_ = ?f")
    by simp
   also have "... = x2^2 /(2 * B)- 2 * B * x2* t/(2 * B) + B^2* t^2 /(2 * B) "
    by (simp add: add_divide_distrib  diff_divide_distrib)
  also have "... =x2^2 /(2 * B) - x2 * t + B* t^2/ 2 " using assms
    by (simp add: power2_eq_square)
  finally have "(x2 - B * t)\<^sup>2 / (2 * B) = x2^2 /(2 * B) - x2 * t + B* t^2/ 2 ".
  hence "?lhs = x1 + x2\<^sup>2 / (2 * B) "
    by simp
  thus  "?lhs \<le> S"
    using assms(4) by simp
qed

pero intentaré aplicar concatenación para escribir la prueba en menos líneas

proof-
have "(x2 - B * t)\<^sup>2 =  x2\<^sup>2 -2 * B * x2 * t + B^2 * t\<^sup>2 "
     by bin_unfold
  hence "(x2 - B * t)\<^sup>2 / (2 * B) = x2^2 /(2 * B) - x2 * t + B* t^2/ 2 " using assms
    by divide_distrib
  hence "?lhs = x1 + x2\<^sup>2 / (2 * B) "
    by simp
  thus  "?lhs \<le> S"
    using assms(4) by simp
qed
*)

(* (auto 0 3 intro!: teorema1 simp: teorema2 elim: teorema 3 dest: teorema 4) *)

lemma assumes "(x:: real) \<noteq>  y"
  shows "(x^2 - y^2)/ (x - y) = x + y" (is "?l =_")
proof-
  have "x^2 - y^2 = (x + y)*(x - y)"
    by (simp add: power2_eq_square square_diff_square_factored)
  hence "?l = (x + y)*(x - y)/(x-y)"
    by simp
  also have "... = x+y"
    by (simp add: assms)
  thus "?l= x+ y"
    by (simp add: calculation)
qed

lemma "(x :: real) * y = ((x + y)^2 - (x - y)^2) / 4"
  by bin_unfold

lemma assumes "(x:: real)^2 - 10 * x + 25 = 0"
  shows "x = 5"
proof-
  have "(x:: real)^2 - 10 * x + 25 = (x - 5)^2"
    by bin_unfold
 thus "x = 5" using assms by simp
qed

lemma domain: assumes "(x:: real) * y = 0"
  shows "x = 0 | y = 0"
  apply (rule divisors_zero) using assms.

(*lemma domain1: assumes "(x::real) * (x - 2) = 0"
  shows "x = 0 | x = 2"
proof-
  show "x = 0 | x = 2" using assms domain by simp
qed
*)

lemma assumes "(x:: real)^2 - 2 * x = 0"
  shows "x = 0 | x = 2"
proof-
  have "x^2 - 2 * x = x * (x - 2)"
    by (simp add: Groups.algebra_simps(19) power2_eq_square)
  thus  "x = 0 | x = 2"
    using assms domain by simp
qed

(*
Intentare encontrar una tactica para simplificar cualquier monomio
*)
lemma "(a:: real) * (b* c) = (a * b) *c"
  by mon_pow_simp

lemma "(a:: real)* a^n = a^(Suc n)"
  oops

lemma "(a:: real) * b = b * a"
  by mon_pow_simp

lemma "(x:: real) * y * z = x * z * y"
  by mon_pow_simp

lemma "(a:: real) * a * b = a^2 * b"
  by mon_pow_simp

lemma "(x:: real)^3 * y * x^2 * x = y * x^6"
  by mon_pow_simp

lemma "(a:: real) * a^5 = a^6"
  by mon_pow_simp

lemma "(x:: real)^2 * z^2 * y * z * x = x^3 * y * z^3"
  by (mon_simp_vars x y)

lemma "a * b = b * a" for a :: real
  by mon_pow_simp

lemma "a * b * c = c * a * b" for a::real
  by mon_pow_simp

lemma "(x:: real) * y * x * y * x = x^3 * y^2"
  by (mon_simp_vars x y)

lemma "(x:: real) * y^2 * x^2 * y * x = x^4 * y^3"
  by (mon_simp_vars x y)

lemma "(x:: real) * y * x * y^2 * x^3 * x = x^6 * y^3"
  by (mon_simp_vars x y)

lemma "(((((x:: real) * y) * z) * x^2) * y) * z^2 = x^3 * y^2 * z^3"
  by (mon_simp_vars x y)

lemma "a * b * z * w = b * z * w * a" for a::real
  by (mon_simp_vars a b)

lemma "z^2 * x * z = x * z^3" for x:: real
  by (mon_simp_vars x z)

(*
Aqui desarrollare una tactica para encontrar el comun denominador entre dos fracciones
*)
lemma  assumes "b \<noteq> 0" and "d \<noteq> 0"
  shows "(a:: real) / b + c / d = (a * d + b * c) / (b * d)"
  by (simp add: add_frac_eq assms(1) assms(2))

lemma  assumes "b \<noteq> 0" and "d \<noteq> 0"
  shows "(a:: real) / b - c / d = (a * d - b * c) / (b * d)"
 by (simp add: diff_frac_eq assms(1) assms(2))

lemma "(1:: real) / 2 + 1 / 3 = 5 / 6"
  by frac_ad

lemma "(x:: real) / 2 + y / 6 = (3 * x + y) / 6"
  by frac_ad

lemma assumes "(k:: real) > 1"
  shows "1 / k + 1 / (1 - k) = 1 / (k * (1 - k))"
  using assms by frac_ad

lemma assumes "(k:: real) > 0" and "1 / (k * (k + 1)) \<le> S"
  shows "1 / k - 1 / (k+1) \<le> S"
 using assms by frac_ad

thm algebra_simps(5)

subsection \<open> Advanced \<close>

thm has_derivative_def
thm tendsto_def

lemma has_vderiv_mono_test:
  assumes T_hyp: "is_interval T"
    and d_hyp: "(f has_vderiv_on f') T"
    and xy_hyp: "x\<in>T" "y\<in>T" "x \<le> y"
  shows "\<forall>x\<in>T. (0::real) \<le> f' x \<Longrightarrow> f x \<le> f y"
    and "\<forall>x\<in>T. f' x \<le> 0 \<Longrightarrow> f x \<ge> f y"
  oops

lemma continuous_on_ge_ball_ge:
  "continuous_on T f \<Longrightarrow> x \<in> T \<Longrightarrow> f x > (k::real) \<Longrightarrow> \<exists>\<epsilon>>0. \<forall>y\<in>ball x \<epsilon> \<inter> T. f y > k"
  oops

lemma current_vderiv_ge_always_ge:
  fixes c::real
  assumes init: "c < x t\<^sub>0" and ode: "D x = x' on {t\<^sub>0..}"
    and dhyp: "x' = (\<lambda>t. g (x t))" "\<forall>x\<ge>c. g x \<ge> 0"
  shows "\<forall>t\<ge>t\<^sub>0. x t > c"
  oops

lemma LICSexample6_arith2:
  assumes "0 \<le> v" "0 < b" "0 \<le> A" "0 \<le> t" "0 \<le> \<tau>" "t \<le> \<epsilon>"
    and "v\<^sup>2 + (A * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v) + b * (A * \<epsilon>\<^sup>2 + 2 * \<epsilon> * v)) \<le> 2 * b * (m - x)"
  shows "A * \<epsilon> * \<tau> + s $ 2 * \<tau> - b * \<tau>\<^sup>2 / 2 + (A * \<epsilon>\<^sup>2 / 2 + s $ 2 * \<epsilon> + s $ 1) \<le> m"
  (* Need to show that function (\<lambda>\<tau>. A * \<epsilon> * \<tau> + s $ 2 * \<tau> - b * \<tau>\<^sup>2 / 2) attains maximum at \<tau> = (A*\<epsilon> + v)/b *)
  oops

lemma ETCS_Prop1_arith1:
  assumes "0 \<le> v" "0 \<le> \<delta>" "0 < b" "x \<le> m"
    and "\<forall>t\<in>{0..}. (\<forall>\<tau>\<in>{0--t}. b * \<tau> \<le> v) \<longrightarrow>
       m \<le> v * t - b * t\<^sup>2 / 2 + x \<longrightarrow> v - b * t \<le> \<delta>"
  shows "v\<^sup>2 - \<delta>\<^sup>2 \<le> 2 * b * (m - x)"
    (* solve arithmetic *)
  sorry

end


section \<open>Marking Using a Set\<close>

theory SetMark
imports Graph DataRefinementIBP.DataRefinement
begin

text\<open>
We construct in this theory a diagram which computes all reachable nodes
from a given root node in a graph. The graph is defined in the theory
Graph and is given by a relation $next$ on the nodes of the graph.

The diagram has only three ordered situation
($\mathit{init} > \mathit{loop} > \mathit{final}$). The termination
variant is a pair of a situation and a natural number with the lexicographic
ordering. The idea of this ordering is that we can go from a bigger situation
to a smaller one, however if we stay in the same situation the second
component of the variant must decrease.

The idea of the algorithm is that it starts with a set $X$ containing the
root element and the root is marked. As long as $X$ is not empty, if $x\in X$
and $y$ is an unmarked sucessor of $x$ we add $y$ to $X$. If $x\in X$ has
no unmarked sucessors it is removed from $X$.
The algorithm terminates when $X$ is empty.
\<close>

datatype I = init | loop | final

declare I.split [split]

instantiation I :: well_founded_transitive
begin

definition
  less_I_def: "i < j \<equiv>  (j = init \<and> (i = loop \<or> i = final)) \<or> (j = loop \<and> i = final)"

definition
  less_eq_I_def:  "(i::I) \<le> (j::I) \<equiv> i = j \<or> i < j"

instance
proof
  fix x y z :: I
  assume "x < y" and "y < z" then  show  "x < z"
    apply (simp add: less_I_def)
    by auto
next
  fix x y :: I
  show  "x \<le> y \<longleftrightarrow> x = y \<or> x < y"
    by (simp add: less_eq_I_def)
next
  fix P fix a::I
  show "P a" when "\<forall>x. (\<forall> y. y < x \<longrightarrow> P y) \<longrightarrow> P x"
    apply (insert that)
    apply (case_tac "P final")
    apply (case_tac "P loop")
    apply (simp_all add: less_I_def)
    by blast
qed (simp)

end

text\<open>
The set $\mathit{path}\ S \ \mathit{mrk}$ contains all reachable nodes from S along paths with
unmarked nodes.
\<close>

lemma trascl_less: "x \<noteq> y \<Longrightarrow> (a, x) \<in> R\<^sup>* \<Longrightarrow>
    ((a,x) \<in> (R \<inter> (-{y})\<times>(-{y}))\<^sup>* \<or>  (y,x) \<in> R O (R \<inter> (-{y})\<times>(-{y}))\<^sup>* )"
  apply (drule_tac
    b = x and a = a and r = R and
    P = "\<lambda> x. (x \<noteq> y \<longrightarrow>((a,x) \<in> (R \<inter> (-{y})\<times>(-{y}))\<^sup>* \<or> (y,x) \<in> R O (R \<inter> (-{y})\<times>(-{y}))\<^sup>* ))"
    in rtrancl_induct)
  apply (auto simp: Compl_insert)
  apply (case_tac "ya = y")
  apply auto
  apply (rule_tac x = a and y = ya and z = z and r = "R \<inter> ((UNIV - {y}) \<times> (UNIV - {y}))" in rtrancl_trans)
  apply auto
  apply (case_tac "za = y")
  apply auto
  apply (drule_tac x = ya and y = za and z = z and r = "(R \<inter> (UNIV - {y}) \<times> (UNIV - {y}))" in rtrancl_trans)
  by auto

lemma (in graph) add_set [simp]: "x \<noteq> y \<Longrightarrow> x \<in> path S mrk \<Longrightarrow> x \<in> path (insert y S) (insert y mrk)"
  apply (simp add: path_def)
  apply clarify
  apply (drule_tac x = x and y = y and a = ya and R = "next \<inter> (- mrk) \<times> (- mrk)" in trascl_less)
  apply simp_all
  apply (case_tac "(ya, x) \<in> (next \<inter> (- mrk) \<times> - mrk \<inter> (- {y}) \<times> - {y})\<^sup>*")
  apply (rule_tac x = xa in exI)
  apply simp_all
  apply (simp add: relcomp_unfold)
  apply (rule_tac x = ya in exI)
  apply simp
  apply (case_tac "(next \<inter> (- mrk) \<times> - mrk \<inter> (- {y}) \<times> - {y}) = (next \<inter> (- insert y mrk) \<times> - insert y mrk)")
  apply simp_all
  apply safe
  apply simp_all
  apply (rule_tac x = y in exI)
  apply simp
  apply (simp add: relcomp_unfold)
  apply (rule_tac x = yaa in exI)
  apply simp
  apply (case_tac "(next \<inter> (- mrk) \<times> - mrk \<inter> (- {y}) \<times> - {y}) = (next \<inter> (- insert y mrk) \<times> - insert y mrk)")
  apply simp_all
  by auto

lemma (in graph) add_set2: "x \<in> path S mrk \<Longrightarrow> x \<notin> path (insert y S) (insert y mrk) \<Longrightarrow> x = y"
  apply (case_tac "x \<noteq> y")
  apply (frule add_set)
  by simp_all

lemma (in graph) del_stack [simp]: "(\<forall> y . (t, y) \<in> next \<longrightarrow> y \<in> mrk) \<Longrightarrow> x \<notin>  mrk \<Longrightarrow> x \<in> path S mrk \<Longrightarrow> x \<in> path (S - {t}) mrk"
  apply (simp add: path_def)
  apply clarify
  apply (rule_tac x = xa in exI)
  apply (case_tac "x = y")
  apply auto
  apply (drule_tac a = y and b = x and R = "(next \<inter> (- mrk) \<times> - mrk)" in rtranclD)
  apply safe
  apply (drule_tac x = y and y = x in tranclD)
  by auto

lemma (in graph) init_set [simp]: "x \<in> reach root \<Longrightarrow> x \<noteq> root \<Longrightarrow> x \<in> path {root} {root}"
  apply (simp add: reach_def path_def)
  apply (case_tac "root \<noteq> x")
  apply (drule_tac a = root and x = x and y = root and R = "next" in trascl_less)
  apply (simp_all add: Compl_insert)
  apply safe
  apply (drule_tac a = root and b = x and R = "(next \<inter> (UNIV - {root}) \<times> (UNIV - {root}))" in rtranclD)
  apply safe
  apply (drule_tac x = root and y = x in tranclD)
  by auto

lemma (in graph)  init_set2: "x \<in> reach root \<Longrightarrow> x \<notin> path {root} {root} \<Longrightarrow> x = root"
  apply (case_tac "root \<noteq> x")
  apply (drule init_set)
  by simp_all

subsection \<open>Transitions\<close>

definition (in graph)
  "Q1_a \<equiv> [: X, mrk \<leadsto> X', mrk'. (root::'node) = nil \<and> X' = {} \<and> mrk' = mrk :]"

definition (in graph)
  "Q2_a \<equiv> [: X, mrk \<leadsto> X', mrk' .
       (root::'node) \<noteq> nil \<and> X' = {root::'node} \<and> mrk' = {root::'node} :]"

definition (in graph)
  "Q3_a \<equiv> [: X, mrk \<leadsto> X', mrk' .
        (\<exists> x \<in> X . \<exists> y . (x, y) \<in> next \<and> y \<notin> mrk \<and> X' = X \<union> {y} \<and> mrk' = mrk \<union> {y}):]"

definition (in graph)
  "Q4_a \<equiv> [: X, mrk \<leadsto> X', mrk' .
        (\<exists> x \<in> X . (\<forall> y . (x, y) \<in> next \<longrightarrow> y \<in> mrk) \<and> X' = X - {x} \<and> mrk' = mrk):]"

definition (in graph)
  "Q5_a \<equiv> [: X, mrk \<leadsto> X', mrk' . X = {} \<and> mrk = mrk' :]"

subsection \<open>Invariants\<close>

definition (in graph)
  "Loop \<equiv> { (X, mrk) .
      finite (-mrk) \<and> finite X \<and> X \<subseteq> mrk \<and>
      mrk \<subseteq> reach root \<and> reach root \<inter> -mrk \<subseteq> path X mrk}"

definition
  "trm \<equiv> \<lambda> (X, mrk) . 2 * card (-mrk) + card X"

definition
  "term_eq t w = {s . t s = w}"

definition
  "term_less t w = {s . t s < w}"

lemma union_term_eq [simp]:  "(\<Union> w . term_eq t w) = UNIV"
  apply (simp add: term_eq_def)
  by auto

lemma union_less_term_eq [simp]: "(\<Union>v\<in>{v. v < w}. term_eq t v) = term_less t w"
  apply (simp add: term_eq_def term_less_def)
  by auto

definition (in graph)
  "Init \<equiv> { (X::('node set), mrk::('node set)) . finite (-mrk) \<and> mrk = {}}"

definition (in graph)
  "Final \<equiv> { (X::('node set), mrk::('node set)) . mrk = reach root}"

definition (in graph)
  "SetMarkInv i = (case i of
      I.init  \<Rightarrow> Init |
      I.loop  \<Rightarrow> Loop |
      I.final \<Rightarrow> Final)"

definition (in graph)
  "SetMarkInvFinal i = (case i of
      I.final  \<Rightarrow> Final |
      _  \<Rightarrow> {})"

definition  (in graph) [simp]:
  "SetMarkInvTerm w i = (case i of
      I.init  \<Rightarrow> Init |
      I.loop  \<Rightarrow> Loop \<inter> {s . trm s = w} |
      I.final \<Rightarrow> Final)"

subsection \<open>Diagram\<close>

definition (in graph)
  "SetMark \<equiv> \<lambda> (i, j) . (case (i, j) of
      (I.init, I.loop)  \<Rightarrow> Q1_a \<sqinter> Q2_a |
      (I.loop, I.loop)  \<Rightarrow> Q3_a \<sqinter> Q4_a |
      (I.loop, I.final) \<Rightarrow> Q5_a |
       _ \<Rightarrow> top)"

lemma (in graph)  SetMark_dmono [simp]:
  "dmono SetMark"
  apply (unfold dmono_def SetMark_def Q1_a_def Q2_a_def Q3_a_def Q4_a_def Q5_a_def)
  by simp

subsection \<open>Correctness of the transitions\<close>

lemma  (in graph) init_loop_1_a[simp]: "\<Turnstile> Init {| Q1_a |} Loop"
  apply (unfold hoare_demonic Init_def Q1_a_def Loop_def)
  by auto

lemma  (in graph) init_loop_2_a[simp]: "\<Turnstile> Init {| Q2_a |} Loop"
  apply (simp add: hoare_demonic Init_def Q2_a_def Loop_def)
  apply auto
  apply (simp_all add: reach_def)
  apply (rule init_set2)
  by (simp_all add: reach_def)

lemma  (in graph) loop_loop_1_a [simp]: "\<Turnstile> (Loop \<inter>  {s . trm s = w}) {| Q3_a |} (Loop \<inter> {s. trm s < w})"
  apply (simp add: hoare_demonic Q3_a_def Loop_def trm_def)
  apply safe
  apply (simp_all)
  apply (simp_all add: reach_def subset_eq)
  apply safe
  apply (simp_all add: Compl_insert)
  apply (rule rtrancl_into_rtrancl)
  apply (simp_all add: Int_def)
  apply (rule add_set2)
  apply simp_all
  apply (case_tac "card (-b) > 0")
  by auto

 lemma  (in graph) loop_loop_2_a[simp]: "\<Turnstile> (Loop \<inter>  {s . trm s = w}) {| Q4_a |} (Loop \<inter> {s. trm s < w})"
  apply (simp add: hoare_demonic Q4_a_def Loop_def trm_def)
  apply auto
  apply (case_tac "card a > 0")
  by auto

 lemma  (in graph) loop_final_a [simp]: "\<Turnstile> (Loop \<inter> {s . trm s = w}) {| Q5_a |} Final"
  apply (simp add: hoare_demonic Q5_a_def Loop_def Final_def subset_eq Int_def path_def)
  by auto

lemma union_term_w[simp]:  "(\<Union>w. {s. t s = w}) = UNIV"
  by auto

lemma union_less_term_w[simp]: "(\<Union>v\<in>{v. v < w}. {s. t s = v}) = {s . t s < w}"
  by auto

lemma sup_union[simp]: "Sup (range A) i =  (\<Union> w . A w i)"
  by (simp_all add: Sup_fun_def)

lemma forall_simp [simp]: "(\<forall>a b. \<forall>x\<in>A. (a = (t x)) \<longrightarrow> (h x) \<or> b \<noteq> u x) = (\<forall>x\<in> A . h x)"
  by auto

lemma forall_simp2 [simp]: "(\<forall>a b. \<forall>x\<in>A. \<forall>y. (a  = t x y) \<longrightarrow> (h x y) \<longrightarrow> (g x y) \<or> b \<noteq> u x y) = (\<forall>x\<in>A. \<forall>y. h x y \<longrightarrow> g x y)"
  by auto

subsection \<open>Diagram correctness\<close>

text\<open>
The termination ordering for the $\mathit{SetMark}$ diagram is the lexicographic
ordering on pairs $(i,\, n)$ where $i\in I$ and $n\in \mathit{nat}$.
\<close>

interpretation  DiagramTermination "\<lambda> (n::nat) (i :: I) . (i, n)"
  done

theorem (in graph) SetMark_correct:
  "\<Turnstile> SetMarkInv {|pt SetMark|} SetMarkInvFinal"
proof (rule_tac X = "SetMarkInvTerm" in hoare_diagram3)
  show "dmono SetMark" by simp
  show "\<forall>u i j. \<Turnstile> SetMarkInvTerm u i{| SetMark (i, j) |}
    DiagramTermination.SUP_L_P (\<lambda>n i. (i, n)) SetMarkInvTerm (i, u) j"
    by (auto simp add: SUP_L_P_def  less_pair_def less_I_def hoare_choice SetMark_def)
  show "SetMarkInv \<le> Sup (range SetMarkInvTerm)"
    apply (simp add: le_fun_def, safe)
    apply (simp_all add: SetMarkInv_def)
    apply (case_tac x)
    apply auto
    done
  show "Sup (range SetMarkInvTerm) \<sqinter> - grd (step SetMark) \<le> SetMarkInvFinal"
    apply (simp add: le_fun_def inf_fun_def SetMarkInvFinal_def)
    apply safe
    apply simp_all
    apply (drule_tac x="I.loop" in spec)
    apply (simp add: SetMark_def)
    apply (simp add: Q1_a_def Q2_a_def)
    apply (frule_tac x="I.loop" in spec)
    apply (drule_tac x="I.final" in spec)
    apply (simp add: SetMark_def)
    apply (simp add: Q3_a_def Q4_a_def Q5_a_def)
    apply (auto)
    done
qed

theorem (in graph) SetMark_correct1 [simp]:
  "Hoare_dgr SetMarkInv SetMark (SetMarkInv \<sqinter> (- grd (step SetMark)))"
  apply (simp add: Hoare_dgr_def)
  apply (rule_tac x = SetMarkInvTerm in exI)
  apply (subgoal_tac "SetMarkInv = \<Squnion>range SetMarkInvTerm")
  apply simp
  apply safe
  apply (simp_all add: SetMark_def SUP_L_P_def
       less_pair_def less_I_def hoare_choice)
  apply (simp_all add: fun_eq_iff)
  apply safe
  apply (unfold SetMarkInv_def)
  by auto

theorem (in graph) stack_not_nil [simp]:
  "(mrk, S) \<in> Loop \<Longrightarrow> x \<in> S \<Longrightarrow> x \<noteq> nil"
  apply (simp add: Loop_def reach_def)
  by auto

end