(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_sort_nat_StoogeSort2Count
  imports "../../Test_Base"
begin

datatype ('a, 'b) pair = pair2 "'a" "'b"

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun plus :: "Nat => Nat => Nat" where
  "plus (Z) z = z"
| "plus (S z2) z = S (plus z2 z)"

fun times :: "Nat => Nat => Nat" where
  "times (Z) z = Z"
| "times (S z2) z = plus z (times z2 z)"

fun minus :: "Nat => Nat => Nat" where
  "minus (Z) z = Z"
| "minus (S z2) (S y2) = minus z2 y2"

fun lt :: "Nat => Nat => bool" where
  "lt y (Z) = False"
| "lt (Z) (S z2) = True"
| "lt (S n) (S z2) = lt n z2"

fun length :: "'a list => Nat" where
  "length (nil2) = Z"
| "length (cons2 z l) = plus (S Z) (length l)"

fun le :: "Nat => Nat => bool" where
  "le (Z) z = True"
| "le (S z2) (Z) = False"
| "le (S z2) (S x2) = le z2 x2"

fun sort2 :: "Nat => Nat => Nat list" where
  "sort2 y z =
   (if le y z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun take :: "Nat => 'a list => 'a list" where
  "take y z =
   (if le y Z then nil2 else
      (case z of
         nil2 => nil2
         | cons2 z2 xs => (case y of S x2 => cons2 z2 (take x2 xs))))"

(*fun did not finish the proof*)
function idiv :: "Nat => Nat => Nat" where
  "idiv y z = (if lt y z then Z else S (idiv (minus y z) z))"
  by pat_completeness auto

fun drop :: "Nat => 'a list => 'a list" where
  "drop y z =
   (if le y Z then z else
      (case z of
         nil2 => nil2
         | cons2 z2 xs1 => (case y of S x2 => drop x2 xs1)))"

fun splitAt :: "Nat => 'a list =>
              (('a list), ('a list)) pair" where
  "splitAt y z = pair2 (take y z) (drop y z)"

function stooge2sort2 :: "Nat list => Nat list"
  and stoogesort2 :: "Nat list => Nat list"
  and stooge2sort1 :: "Nat list => Nat list" where
  "stooge2sort2 y =
   (case
      splitAt (idiv (S (times (S (S Z)) (length y))) (S (S (S Z)))) y
      of
      pair2 ys2 zs1 => x (stoogesort2 ys2) zs1)"
| "stoogesort2 (nil2) = nil2"
| "stoogesort2 (cons2 z (nil2)) = cons2 z (nil2)"
| "stoogesort2 (cons2 z (cons2 y2 (nil2))) = sort2 z y2"
| "stoogesort2 (cons2 z (cons2 y2 (cons2 x3 x4))) =
     stooge2sort2
       (stooge2sort1 (stooge2sort2 (cons2 z (cons2 y2 (cons2 x3 x4)))))"
| "stooge2sort1 y =
     (case splitAt (idiv (length y) (S (S (S Z)))) y of
        pair2 ys2 zs1 => x ys2 (stoogesort2 zs1))"
  by pat_completeness auto

fun count :: "'a => 'a list => Nat" where
  "count y (nil2) = Z"
| "count y (cons2 z2 ys) =
     (if (y = z2) then plus (S Z) (count y ys) else count y ys)"

theorem property0 :
  "((count y (stoogesort2 xs)) = (count y xs))"
  oops

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_sort_StoogeSort2IsSort
imports "../../Test_Base"
begin

datatype ('a, 'b) pair = pair2 "'a" "'b"

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun x :: "'a list => 'a list => 'a list" where
"x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

fun take :: "int => 'a list => 'a list" where
"take y z =
   (if y <= 0 then nil2 else
      (case z of
         nil2 => nil2
         | cons2 z2 xs => cons2 z2 (take (y - 1) xs)))"

fun sort2 :: "int => int => int list" where
"sort2 y z =
   (if y <= z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun length :: "'a list => int" where
"length (nil2) = 0"
| "length (cons2 z l) = 1 + (length l)"

fun insert :: "int => int list => int list" where
"insert y (nil2) = cons2 y (nil2)"
| "insert y (cons2 z2 xs) =
     (if y <= z2 then cons2 y (cons2 z2 xs) else
        cons2 z2 (insert y xs))"

fun isort :: "int list => int list" where
"isort (nil2) = nil2"
| "isort (cons2 z xs) = insert z (isort xs)"

fun drop :: "int => 'a list => 'a list" where
"drop y z =
   (if y <= 0 then z else
      (case z of
         nil2 => nil2
         | cons2 z2 xs1 => drop (y - 1) xs1))"

fun splitAt :: "int => 'a list =>
                (('a list), ('a list)) pair" where
"splitAt y z = pair2 (take y z) (drop y z)"

function stooge2sort2 :: "int list => int list"
         and stoogesort2 :: "int list => int list"
         and stooge2sort1 :: "int list => int list" where
"stooge2sort2 y =
   (case splitAt ((op div) ((2 * (length y)) + 1) 3) y of
      pair2 ys2 zs1 => x (stoogesort2 ys2) zs1)"
| "stoogesort2 (nil2) = nil2"
| "stoogesort2 (cons2 z (nil2)) = cons2 z (nil2)"
| "stoogesort2 (cons2 z (cons2 y2 (nil2))) = sort2 z y2"
| "stoogesort2 (cons2 z (cons2 y2 (cons2 x3 x4))) =
     stooge2sort2
       (stooge2sort1 (stooge2sort2 (cons2 z (cons2 y2 (cons2 x3 x4)))))"
| "stooge2sort1 y =
     (case splitAt ((op div) (length y) 3) y of
        pair2 ys2 zs1 => x ys2 (stoogesort2 zs1))"
by pat_completeness auto

theorem property0 :
  "((stoogesort2 xs) = (isort xs))"
  oops

end


(* Title:      Lattice-Ordered Semirings
   Author:     Walter Guttmann
   Maintainer: Walter Guttmann <walter.guttmann at canterbury.ac.nz>
*)

section \<open>Lattice-Ordered Semirings\<close>

theory Lattice_Ordered_Semirings

imports Stone_Relation_Algebras.Semirings

begin

nitpick_params [timeout = 600]

text \<open>Many results in this theory are taken from a joint paper with Rudolf Berghammer.\<close>

text \<open>M0-algebra\<close>

class lattice_ordered_pre_left_semiring = pre_left_semiring + bounded_distrib_lattice
begin

subclass bounded_pre_left_semiring
  apply unfold_locales
  by simp

lemma top_mult_right_one:
  "x * top = x * top * 1"
  by (metis order.antisym mult_sub_right_one mult_sup_associative_one surjective_one_closed)

lemma mult_left_sub_dist_inf_left:
  "x * (y \<sqinter> z) \<le> x * y"
  by (simp add: mult_right_isotone)

lemma mult_left_sub_dist_inf_right:
  "x * (y \<sqinter> z) \<le> x * z"
  by (simp add: mult_right_isotone)

lemma mult_right_sub_dist_inf_left:
  "(x \<sqinter> y) * z \<le> x * z"
  by (simp add: mult_left_isotone)

lemma mult_right_sub_dist_inf_right:
  "(x \<sqinter> y) * z \<le> y * z"
  by (simp add: mult_left_isotone)

lemma mult_right_sub_dist_inf:
  "(x \<sqinter> y) * z \<le> x * z \<sqinter> y * z"
  by (simp add: mult_right_sub_dist_inf_left mult_right_sub_dist_inf_right)

text \<open>Figure 1: fundamental properties\<close>

definition co_total          :: "'a \<Rightarrow> bool" where "co_total x \<equiv> x * bot = bot"
definition up_closed         :: "'a \<Rightarrow> bool" where "up_closed x \<equiv> x * 1 = x"
definition sup_distributive  :: "'a \<Rightarrow> bool" where "sup_distributive x \<equiv> (\<forall>y z . x * (y \<squnion> z) = x * y \<squnion> x * z)"
definition inf_distributive  :: "'a \<Rightarrow> bool" where "inf_distributive x \<equiv> (\<forall>y z . x * (y \<sqinter> z) = x * y \<sqinter> x * z)"
definition contact           :: "'a \<Rightarrow> bool" where "contact x \<equiv> x * x \<squnion> 1 = x"
definition kernel            :: "'a \<Rightarrow> bool" where "kernel x \<equiv> x * x \<sqinter> 1 = x * 1"
definition sup_dist_contact  :: "'a \<Rightarrow> bool" where "sup_dist_contact x \<equiv> sup_distributive x \<and> contact x"
definition inf_dist_kernel   :: "'a \<Rightarrow> bool" where "inf_dist_kernel x \<equiv> inf_distributive x \<and> kernel x"
definition test              :: "'a \<Rightarrow> bool" where "test x \<equiv> x * top \<sqinter> 1 = x"
definition co_test           :: "'a \<Rightarrow> bool" where "co_test x \<equiv> x * bot \<squnion> 1 = x"
definition co_vector         :: "'a \<Rightarrow> bool" where "co_vector x \<equiv> x * bot = x"

text \<open>AAMP Theorem 6 / Figure 2: relations between properties\<close>

lemma reflexive_total:
  "reflexive x \<Longrightarrow> total x"
  using sup_left_divisibility total_sup_closed by force

lemma reflexive_dense:
  "reflexive x \<Longrightarrow> dense_rel x"
  using mult_left_isotone by fastforce

lemma reflexive_transitive_up_closed:
  "reflexive x \<Longrightarrow> transitive x \<Longrightarrow> up_closed x"
  by (metis antisym_conv mult_isotone mult_sub_right_one reflexive_dense up_closed_def)

lemma coreflexive_co_total:
  "coreflexive x \<Longrightarrow> co_total x"
  by (metis co_total_def order.eq_iff mult_left_isotone mult_left_one bot_least)

lemma coreflexive_transitive:
  "coreflexive x \<Longrightarrow> transitive x"
  by (simp add: coreflexive_transitive)

lemma idempotent_transitive_dense:
  "idempotent x \<longleftrightarrow> transitive x \<and> dense_rel x"
  by (simp add: order.eq_iff)

lemma contact_reflexive:
  "contact x \<Longrightarrow> reflexive x"
  using contact_def sup_right_divisibility by auto

lemma contact_transitive:
  "contact x \<Longrightarrow> transitive x"
  using contact_def sup_left_divisibility by blast

lemma contact_dense:
  "contact x \<Longrightarrow> dense_rel x"
  by (simp add: contact_reflexive reflexive_dense)

lemma contact_idempotent:
  "contact x \<Longrightarrow> idempotent x"
  by (simp add: contact_dense contact_transitive idempotent_transitive_dense)

lemma contact_up_closed:
  "contact x \<Longrightarrow> up_closed x"
  by (simp add: contact_reflexive contact_transitive reflexive_transitive_up_closed)

lemma contact_reflexive_idempotent_up_closed:
  "contact x \<longleftrightarrow> reflexive x \<and> idempotent x \<and> up_closed x"
  by (metis contact_def contact_idempotent contact_reflexive contact_up_closed sup_absorb2 sup_monoid.add_commute)

lemma kernel_coreflexive:
  "kernel x \<Longrightarrow> coreflexive x"
  by (metis kernel_def inf.boundedE mult_sub_right_one)

lemma kernel_transitive:
  "kernel x \<Longrightarrow> transitive x"
  by (simp add: coreflexive_transitive kernel_coreflexive)

lemma kernel_dense:
  "kernel x \<Longrightarrow> dense_rel x"
  by (metis kernel_def inf.boundedE mult_sub_right_one)

lemma kernel_idempotent:
  "kernel x \<Longrightarrow> idempotent x"
  by (simp add: idempotent_transitive_dense kernel_dense kernel_transitive)

lemma kernel_up_closed:
  "kernel x \<Longrightarrow> up_closed x"
  by (metis kernel_coreflexive kernel_def kernel_idempotent inf.absorb1 up_closed_def)

lemma kernel_coreflexive_idempotent_up_closed:
  "kernel x \<longleftrightarrow> coreflexive x \<and> idempotent x \<and> up_closed x"
  by (metis kernel_coreflexive kernel_def kernel_idempotent inf.absorb1 up_closed_def)

lemma test_coreflexive:
  "test x \<Longrightarrow> coreflexive x"
  using inf.sup_right_divisibility test_def by blast

lemma test_up_closed:
  "test x \<Longrightarrow> up_closed x"
  by (metis order.eq_iff mult_left_one mult_sub_right_one mult_right_sub_dist_inf test_def top_mult_right_one up_closed_def)

lemma co_test_reflexive:
  "co_test x \<Longrightarrow> reflexive x"
  using co_test_def sup_right_divisibility by blast

lemma co_test_transitive:
  "co_test x \<Longrightarrow> transitive x"
  by (smt co_test_def sup_assoc le_iff_sup mult_left_one mult_left_zero mult_right_dist_sup mult_semi_associative)

lemma co_test_idempotent:
  "co_test x \<Longrightarrow> idempotent x"
  by (simp add: co_test_reflexive co_test_transitive idempotent_transitive_dense reflexive_dense)

lemma co_test_up_closed:
  "co_test x \<Longrightarrow> up_closed x"
  by (simp add: co_test_reflexive co_test_transitive reflexive_transitive_up_closed)

lemma co_test_contact:
  "co_test x \<Longrightarrow> contact x"
  by (simp add: co_test_idempotent co_test_reflexive co_test_up_closed contact_reflexive_idempotent_up_closed)

lemma vector_transitive:
  "vector x \<Longrightarrow> transitive x"
  by (metis mult_right_isotone top.extremum)

lemma vector_up_closed:
  "vector x \<Longrightarrow> up_closed x"
  by (metis top_mult_right_one up_closed_def)

text \<open>AAMP Theorem 10 / Figure 3: closure properties\<close>

text \<open>total\<close>

lemma one_total:
  "total 1"
  by simp

lemma top_total:
  "total top"
  by simp

lemma sup_total:
  "total x \<Longrightarrow> total y \<Longrightarrow> total (x \<squnion> y)"
  by (simp add: total_sup_closed)

text \<open>co-total\<close>

lemma zero_co_total:
  "co_total bot"
  by (simp add: co_total_def)

lemma one_co_total:
  "co_total 1"
  by (simp add: co_total_def)

lemma sup_co_total:
  "co_total x \<Longrightarrow> co_total y \<Longrightarrow> co_total (x \<squnion> y)"
  by (simp add: co_total_def mult_right_dist_sup)

lemma inf_co_total:
  "co_total x \<Longrightarrow> co_total y \<Longrightarrow> co_total (x \<sqinter> y)"
  by (metis co_total_def order.antisym bot_least mult_right_sub_dist_inf_right)

lemma comp_co_total:
  "co_total x \<Longrightarrow> co_total y \<Longrightarrow> co_total (x * y)"
  by (metis co_total_def order.eq_iff mult_semi_associative bot_least)

text \<open>sub-transitive\<close>

lemma zero_transitive:
  "transitive bot"
  by (simp add: vector_transitive)

lemma one_transitive:
  "transitive 1"
  by simp

lemma top_transitive:
  "transitive top"
  by simp

lemma inf_transitive:
  "transitive x \<Longrightarrow> transitive y \<Longrightarrow> transitive (x \<sqinter> y)"
  by (meson inf_mono order_trans mult_left_sub_dist_inf_left mult_left_sub_dist_inf_right mult_right_sub_dist_inf)

text \<open>dense\<close>

lemma zero_dense:
  "dense_rel bot"
  by simp

lemma one_dense:
  "dense_rel 1"
  by simp

lemma top_dense:
  "dense_rel top"
  by simp

lemma sup_dense:
  assumes "dense_rel x"
      and "dense_rel y"
    shows "dense_rel (x \<squnion> y)"
proof -
  have "x \<le> x * x \<and> y \<le> y * y"
    using assms by auto
  hence "x \<le> (x \<squnion> y) * (x \<squnion> y) \<and> y \<le> (x \<squnion> y) * (x \<squnion> y)"
    by (meson dense_sup_closed order_trans sup.cobounded1 sup.cobounded2)
  hence "x \<squnion> y \<le> (x \<squnion> y) * (x \<squnion> y)"
    by simp
  thus "dense_rel (x \<squnion> y)"
    by simp
qed

text \<open>reflexive\<close>

lemma one_reflexive:
  "reflexive 1"
  by simp

lemma top_reflexive:
  "reflexive top"
  by simp

lemma sup_reflexive:
  "reflexive x \<Longrightarrow> reflexive y \<Longrightarrow> reflexive (x \<squnion> y)"
  by (simp add: reflexive_sup_closed)

lemma inf_reflexive:
  "reflexive x \<Longrightarrow> reflexive y \<Longrightarrow> reflexive (x \<sqinter> y)"
  by simp

lemma comp_reflexive:
  "reflexive x \<Longrightarrow> reflexive y \<Longrightarrow> reflexive (x * y)"
  using reflexive_mult_closed by auto

text \<open>co-reflexive\<close>

lemma zero_coreflexive:
  "coreflexive bot"
  by simp

lemma one_coreflexive:
  "coreflexive 1"
  by simp

lemma sup_coreflexive:
  "coreflexive x \<Longrightarrow> coreflexive y \<Longrightarrow> coreflexive (x \<squnion> y)"
  by simp

lemma inf_coreflexive:
  "coreflexive x \<Longrightarrow> coreflexive y \<Longrightarrow> coreflexive (x \<sqinter> y)"
  by (simp add: le_infI1)

lemma comp_coreflexive:
  "coreflexive x \<Longrightarrow> coreflexive y \<Longrightarrow> coreflexive (x * y)"
  by (simp add: coreflexive_mult_closed)

text \<open>idempotent\<close>

lemma zero_idempotent:
  "idempotent bot"
  by simp

lemma one_idempotent:
  "idempotent 1"
  by simp

lemma top_idempotent:
  "idempotent top"
  by simp

text \<open>up-closed\<close>

lemma zero_up_closed:
  "up_closed bot"
  by (simp add: up_closed_def)

lemma one_up_closed:
  "up_closed 1"
  by (simp add: up_closed_def)

lemma top_up_closed:
  "up_closed top"
  by (simp add: vector_up_closed)

lemma sup_up_closed:
  "up_closed x \<Longrightarrow> up_closed y \<Longrightarrow> up_closed (x \<squnion> y)"
  by (simp add: mult_right_dist_sup up_closed_def)

lemma inf_up_closed:
  "up_closed x \<Longrightarrow> up_closed y \<Longrightarrow> up_closed (x \<sqinter> y)"
  by (metis order.antisym mult_sub_right_one mult_right_sub_dist_inf up_closed_def)

lemma comp_up_closed:
  "up_closed x \<Longrightarrow> up_closed y \<Longrightarrow> up_closed (x * y)"
  by (metis order.antisym mult_semi_associative mult_sub_right_one up_closed_def)

text \<open>add-distributive\<close>

lemma zero_sup_distributive:
  "sup_distributive bot"
  by (simp add: sup_distributive_def)

lemma one_sup_distributive:
  "sup_distributive 1"
  by (simp add: sup_distributive_def)

lemma sup_sup_distributive:
  "sup_distributive x \<Longrightarrow> sup_distributive y \<Longrightarrow> sup_distributive (x \<squnion> y)"
  using sup_distributive_def mult_right_dist_sup sup_monoid.add_assoc sup_monoid.add_commute by auto

text \<open>inf-distributive\<close>

lemma zero_inf_distributive:
  "inf_distributive bot"
  by (simp add: inf_distributive_def)

lemma one_inf_distributive:
  "inf_distributive 1"
  by (simp add: inf_distributive_def)

text \<open>contact\<close>

lemma one_contact:
  "contact 1"
  by (simp add: contact_def)

lemma top_contact:
  "contact top"
  by (simp add: contact_def)

lemma inf_contact:
  "contact x \<Longrightarrow> contact y \<Longrightarrow> contact (x \<sqinter> y)"
  by (meson contact_reflexive_idempotent_up_closed contact_transitive inf_reflexive inf_transitive inf_up_closed preorder_idempotent)

text \<open>kernel\<close>

lemma zero_kernel:
  "kernel bot"
  by (simp add: kernel_def)

lemma one_kernel:
  "kernel 1"
  by (simp add: kernel_def)

lemma sup_kernel:
  "kernel x \<Longrightarrow> kernel y \<Longrightarrow> kernel (x \<squnion> y)"
  using kernel_coreflexive_idempotent_up_closed order.antisym coreflexive_transitive sup_dense sup_up_closed by force

text \<open>add-distributive contact\<close>

lemma one_sup_dist_contact:
  "sup_dist_contact 1"
  by (simp add: sup_dist_contact_def one_sup_distributive one_contact)

text \<open>inf-distributive kernel\<close>

lemma zero_inf_dist_kernel:
  "inf_dist_kernel bot"
  by (simp add: inf_dist_kernel_def zero_kernel zero_inf_distributive)

lemma one_inf_dist_kernel:
  "inf_dist_kernel 1"
  by (simp add: inf_dist_kernel_def one_kernel one_inf_distributive)

text \<open>test\<close>

lemma zero_test:
  "test bot"
  by (simp add: test_def)

lemma one_test:
  "test 1"
  by (simp add: test_def)

lemma sup_test:
  "test x \<Longrightarrow> test y \<Longrightarrow> test (x \<squnion> y)"
  by (simp add: inf_sup_distrib2 mult_right_dist_sup test_def)

lemma inf_test:
  "test x \<Longrightarrow> test y \<Longrightarrow> test (x \<sqinter> y)"
  by (smt (z3) inf.left_commute idempotent_one_closed inf.le_iff_sup inf_top.right_neutral mult_right_isotone mult_sub_right_one mult_right_sub_dist_inf test_def top_mult_right_one)

text \<open>co-test\<close>

lemma one_co_test:
  "co_test 1"
  by (simp add: co_test_def)

lemma sup_co_test:
  "co_test x \<Longrightarrow> co_test y \<Longrightarrow> co_test (x \<squnion> y)"
  by (smt (z3) co_test_def mult_right_dist_sup sup.left_idem sup_assoc sup_commute)

text \<open>vector\<close>

lemma zero_vector:
  "vector bot"
  by simp

lemma top_vector:
  "vector top"
  by simp

lemma sup_vector:
  "vector x \<Longrightarrow> vector y \<Longrightarrow> vector (x \<squnion> y)"
  by (simp add: vector_sup_closed)

lemma inf_vector:
  "vector x \<Longrightarrow> vector y \<Longrightarrow> vector (x \<sqinter> y)"
  by (metis order.antisym top_right_mult_increasing mult_right_sub_dist_inf)

lemma comp_vector:
  "vector y \<Longrightarrow> vector (x * y)"
  by (simp add: vector_mult_closed)

end

class lattice_ordered_pre_left_semiring_1 = non_associative_left_semiring + bounded_distrib_lattice +
  assumes mult_associative_one: "x * (y * z) = (x * (y * 1)) * z"
  assumes mult_right_dist_inf_one: "(x * 1 \<sqinter> y * 1) * z = x * z \<sqinter> y * z"
begin

subclass pre_left_semiring
  apply unfold_locales
  by (metis mult_associative_one mult_left_isotone mult_right_isotone mult_sub_right_one)

subclass lattice_ordered_pre_left_semiring ..

lemma mult_zero_associative:
  "x * bot * y = x * bot"
  by (metis mult_associative_one mult_left_zero)

lemma mult_zero_sup_one_dist:
  "(x * bot \<squnion> 1) * z = x * bot \<squnion> z"
  by (simp add: mult_right_dist_sup mult_zero_associative)

lemma mult_zero_sup_dist:
  "(x * bot \<squnion> y) * z = x * bot \<squnion> y * z"
  by (simp add: mult_right_dist_sup mult_zero_associative)

lemma vector_zero_inf_one_comp:
  "(x * bot \<sqinter> 1) * y = x * bot \<sqinter> y"
  by (metis mult_left_one mult_right_dist_inf_one mult_zero_associative)

text \<open>AAMP Theorem 6 / Figure 2: relations between properties\<close>

lemma co_test_inf_distributive:
  "co_test x \<Longrightarrow> inf_distributive x"
  by (metis co_test_def distrib_imp1 inf_sup_distrib1 inf_distributive_def mult_zero_sup_one_dist)

lemma co_test_sup_distributive:
  "co_test x \<Longrightarrow> sup_distributive x"
  by (metis sup_sup_distributive sup_distributive_def co_test_def one_sup_distributive sup.idem mult_zero_associative)

lemma co_test_sup_dist_contact:
  "co_test x \<Longrightarrow> sup_dist_contact x"
  by (simp add: co_test_sup_distributive sup_dist_contact_def co_test_contact)

text \<open>AAMP Theorem 10 / Figure 3: closure properties\<close>

text \<open>co-test\<close>

lemma inf_co_test:
  "co_test x \<Longrightarrow> co_test y \<Longrightarrow> co_test (x \<sqinter> y)"
  by (smt (z3) co_test_def co_test_up_closed mult_right_dist_inf_one sup_commute sup_inf_distrib1 up_closed_def)

lemma comp_co_test:
  "co_test x \<Longrightarrow> co_test y \<Longrightarrow> co_test (x * y)"
  by (metis co_test_def mult_associative_one sup_assoc mult_zero_sup_one_dist)

end

class lattice_ordered_pre_left_semiring_2 = lattice_ordered_pre_left_semiring +
  assumes mult_sub_associative_one: "x * (y * z) \<le> (x * (y * 1)) * z"
  assumes mult_right_dist_inf_one_sub: "x * z \<sqinter> y * z \<le> (x * 1 \<sqinter> y * 1) * z"
begin

subclass lattice_ordered_pre_left_semiring_1
  apply unfold_locales
  apply (simp add: order.antisym mult_sub_associative_one mult_sup_associative_one)
  by (metis order.eq_iff mult_one_associative mult_right_dist_inf_one_sub mult_right_sub_dist_inf)

end

class multirelation_algebra_1 = lattice_ordered_pre_left_semiring +
  assumes mult_left_top: "top * x = top"
begin

text \<open>AAMP Theorem 10 / Figure 3: closure properties\<close>

lemma top_sup_distributive:
  "sup_distributive top"
  by (simp add: sup_distributive_def mult_left_top)

lemma top_inf_distributive:
  "inf_distributive top"
  by (simp add: inf_distributive_def mult_left_top)

lemma top_sup_dist_contact:
  "sup_dist_contact top"
  by (simp add: sup_dist_contact_def top_contact top_sup_distributive)

lemma top_co_test:
  "co_test top"
  by (simp add: co_test_def mult_left_top)

end

text \<open>M1-algebra\<close>

class multirelation_algebra_2 = multirelation_algebra_1 + lattice_ordered_pre_left_semiring_2
begin

lemma mult_top_associative:
  "x * top * y = x * top"
  by (metis mult_left_top mult_associative_one)

lemma vector_inf_one_comp:
  "(x * top \<sqinter> 1) * y = x * top \<sqinter> y"
  by (metis vector_zero_inf_one_comp mult_top_associative)

lemma vector_left_annihilator:
  "vector x \<Longrightarrow> x * y = x"
  by (metis mult_top_associative)

text \<open>properties\<close>

lemma test_comp_inf:
  "test x \<Longrightarrow> test y \<Longrightarrow> x * y = x \<sqinter> y"
  by (metis inf.absorb1 inf.left_commute test_coreflexive test_def vector_inf_one_comp)

text \<open>AAMP Theorem 6 / Figure 2: relations between properties\<close>

lemma test_sup_distributive:
  "test x \<Longrightarrow> sup_distributive x"
  by (metis sup_distributive_def inf_sup_distrib1 test_def vector_inf_one_comp)

lemma test_inf_distributive:
  "test x \<Longrightarrow> inf_distributive x"
  by (smt (verit, ccfv_SIG) inf.commute inf.sup_monoid.add_assoc inf_distributive_def test_def inf.idem vector_inf_one_comp)

lemma test_inf_dist_kernel:
  "test x \<Longrightarrow> inf_dist_kernel x"
  by (simp add: kernel_def inf_dist_kernel_def one_test test_comp_inf test_inf_distributive)

lemma vector_idempotent:
  "vector x \<Longrightarrow> idempotent x"
  using vector_left_annihilator by blast

lemma vector_sup_distributive:
  "vector x \<Longrightarrow> sup_distributive x"
  by (simp add: sup_distributive_def vector_left_annihilator)

lemma vector_inf_distributive:
  "vector x \<Longrightarrow> inf_distributive x"
  by (simp add: inf_distributive_def vector_left_annihilator)

lemma vector_co_vector:
  "vector x \<longleftrightarrow> co_vector x"
  by (metis co_vector_def mult_zero_associative mult_top_associative)

text \<open>AAMP Theorem 10 / Figure 3: closure properties\<close>

text \<open>test\<close>

lemma comp_test:
  "test x \<Longrightarrow> test y \<Longrightarrow> test (x * y)"
  by (simp add: inf_test test_comp_inf)

end

class dual =
  fixes dual :: "'a \<Rightarrow> 'a" ("_\<^sup>d" [100] 100)

class multirelation_algebra_3 = lattice_ordered_pre_left_semiring + dual +
  assumes dual_involutive: "x\<^sup>d\<^sup>d = x"
  assumes dual_dist_sup: "(x \<squnion> y)\<^sup>d = x\<^sup>d \<sqinter> y\<^sup>d"
  assumes dual_one: "1\<^sup>d = 1"
begin

lemma dual_dist_inf:
  "(x \<sqinter> y)\<^sup>d = x\<^sup>d \<squnion> y\<^sup>d"
  by (metis dual_dist_sup dual_involutive)

lemma dual_antitone:
  "x \<le> y \<Longrightarrow> y\<^sup>d \<le> x\<^sup>d"
  using dual_dist_sup sup_right_divisibility by fastforce

lemma dual_zero:
  "bot\<^sup>d = top"
  by (metis dual_antitone bot_least dual_involutive top_le)

lemma dual_top:
  "top\<^sup>d = bot"
  using dual_zero dual_involutive by auto

text \<open>AAMP Theorem 10 / Figure 3: closure properties\<close>

lemma reflexive_coreflexive_dual:
  "reflexive x \<longleftrightarrow> coreflexive (x\<^sup>d)"
  using dual_antitone dual_involutive dual_one by fastforce

end

class multirelation_algebra_4 = multirelation_algebra_3 +
  assumes dual_sub_dist_comp: "(x * y)\<^sup>d \<le> x\<^sup>d * y\<^sup>d"
begin

subclass multirelation_algebra_1
  apply unfold_locales
  by (metis order.antisym top.extremum dual_zero dual_sub_dist_comp dual_involutive mult_left_zero)

lemma dual_sub_dist_comp_one:
  "(x * y)\<^sup>d \<le> (x * 1)\<^sup>d * y\<^sup>d"
  by (metis dual_sub_dist_comp mult_one_associative)

text \<open>AAMP Theorem 10 / Figure 3: closure properties\<close>

lemma co_total_total_dual:
  "co_total x \<Longrightarrow> total (x\<^sup>d)"
  by (metis co_total_def dual_sub_dist_comp dual_zero top_le)

lemma transitive_dense_dual:
  "transitive x \<Longrightarrow> dense_rel (x\<^sup>d)"
  using dual_antitone dual_sub_dist_comp inf.order_lesseq_imp by blast

end

text \<open>M2-algebra\<close>

class multirelation_algebra_5 = multirelation_algebra_3 +
  assumes dual_dist_comp_one: "(x * y)\<^sup>d = (x * 1)\<^sup>d * y\<^sup>d"
begin

subclass multirelation_algebra_4
  apply unfold_locales
  by (metis dual_antitone mult_sub_right_one mult_left_isotone dual_dist_comp_one)

lemma strong_up_closed:
  "x * 1 \<le> x \<Longrightarrow> x\<^sup>d * y\<^sup>d \<le> (x * y)\<^sup>d"
  by (simp add: dual_dist_comp_one antisym_conv mult_sub_right_one)

lemma strong_up_closed_2:
  "up_closed x \<Longrightarrow> (x * y)\<^sup>d = x\<^sup>d * y\<^sup>d"
  by (simp add: dual_dist_comp_one up_closed_def)

subclass lattice_ordered_pre_left_semiring_2
  apply unfold_locales
  apply (smt comp_up_closed dual_antitone dual_dist_comp_one dual_involutive dual_one mult_left_one mult_one_associative mult_semi_associative up_closed_def strong_up_closed_2)
  by (smt dual_dist_comp_one dual_dist_inf dual_involutive eq_refl mult_one_associative mult_right_dist_sup)

text \<open>AAMP Theorem 8\<close>

subclass multirelation_algebra_2 ..

text \<open>AAMP Theorem 10 / Figure 3: closure properties\<close>

text \<open>up-closed\<close>

lemma dual_up_closed:
  "up_closed x \<longleftrightarrow> up_closed (x\<^sup>d)"
  by (metis dual_involutive dual_one up_closed_def strong_up_closed_2)

text \<open>contact\<close>

lemma contact_kernel_dual:
  "contact x \<longleftrightarrow> kernel (x\<^sup>d)"
  by (metis contact_def contact_up_closed dual_dist_sup dual_involutive dual_one kernel_def kernel_up_closed up_closed_def strong_up_closed_2)

text \<open>add-distributive contact\<close>

lemma sup_dist_contact_inf_dist_kernel_dual:
  "sup_dist_contact x \<longleftrightarrow> inf_dist_kernel (x\<^sup>d)"
proof
  assume 1: "sup_dist_contact x"
  hence 2: "up_closed x"
    using sup_dist_contact_def contact_up_closed by auto
  have "sup_distributive x"
    using 1 sup_dist_contact_def by auto
  hence "inf_distributive (x\<^sup>d)"
    using 2 by (smt sup_distributive_def dual_dist_comp_one dual_dist_inf dual_involutive inf_distributive_def up_closed_def)
  thus "inf_dist_kernel (x\<^sup>d)"
    using 1 contact_kernel_dual sup_dist_contact_def inf_dist_kernel_def by blast
next
  assume 3: "inf_dist_kernel (x\<^sup>d)"
  hence 4: "up_closed (x\<^sup>d)"
    using kernel_up_closed inf_dist_kernel_def by auto
  have "inf_distributive (x\<^sup>d)"
    using 3 inf_dist_kernel_def by auto
  hence "sup_distributive (x\<^sup>d\<^sup>d)"
    using 4 by (smt inf_distributive_def sup_distributive_def dual_dist_sup dual_involutive strong_up_closed_2)
  thus "sup_dist_contact x"
    using 3 contact_kernel_dual sup_dist_contact_def dual_involutive inf_dist_kernel_def by auto
qed

text \<open>test\<close>

lemma test_co_test_dual:
  "test x \<longleftrightarrow> co_test (x\<^sup>d)"
  by (smt (z3) co_test_def co_test_up_closed dual_dist_comp_one dual_dist_inf dual_involutive dual_one dual_top test_def test_up_closed up_closed_def)

text \<open>vector\<close>

lemma vector_dual:
  "vector x \<longleftrightarrow> vector (x\<^sup>d)"
  by (metis dual_dist_comp_one dual_involutive mult_top_associative)

end

class multirelation_algebra_6 = multirelation_algebra_4 +
  assumes dual_sub_dist_comp_one: "(x * 1)\<^sup>d * y\<^sup>d \<le> (x * y)\<^sup>d"
begin

subclass multirelation_algebra_5
  apply unfold_locales
  by (metis dual_sub_dist_comp dual_sub_dist_comp_one order.eq_iff mult_one_associative)

proposition "dense_rel x \<and> coreflexive x \<longrightarrow> up_closed x" nitpick [expect=genuine,card=5] oops
proposition "x * top \<sqinter> y * z \<le> (x * top \<sqinter> y) * z" nitpick [expect=genuine,card=8] oops

end

text \<open>M3-algebra\<close>

class up_closed_multirelation_algebra = multirelation_algebra_3 +
  assumes dual_dist_comp: "(x * y)\<^sup>d = x\<^sup>d * y\<^sup>d"
begin

lemma mult_right_dist_inf:
  "(x \<sqinter> y) * z = x * z \<sqinter> y * z"
  by (metis dual_dist_sup dual_dist_comp dual_involutive mult_right_dist_sup)

text \<open>AAMP Theorem 9\<close>

subclass idempotent_left_semiring
  apply unfold_locales
  apply (metis order.antisym dual_antitone dual_dist_comp dual_involutive mult_semi_associative)
  apply simp
  by (metis order.antisym dual_antitone dual_dist_comp dual_involutive dual_one mult_sub_right_one)

subclass multirelation_algebra_6
  apply unfold_locales
  by (simp_all add: dual_dist_comp)

lemma vector_inf_comp:
  "(x * top \<sqinter> y) * z = x * top \<sqinter> y * z"
  by (simp add: vector_left_annihilator mult_right_dist_inf mult.assoc)

lemma vector_zero_inf_comp:
  "(x * bot \<sqinter> y) * z = x * bot \<sqinter> y * z"
  by (simp add: mult_right_dist_inf mult.assoc)

text \<open>AAMP Theorem 10 / Figure 3: closure properties\<close>

text \<open>total\<close>

lemma inf_total:
  "total x \<Longrightarrow> total y \<Longrightarrow> total (x \<sqinter> y)"
  by (simp add: mult_right_dist_inf)

lemma comp_total:
  "total x \<Longrightarrow> total y \<Longrightarrow> total (x * y)"
  by (simp add: mult_assoc)

lemma total_co_total_dual:
  "total x \<longleftrightarrow> co_total (x\<^sup>d)"
  by (metis co_total_def dual_dist_comp dual_involutive dual_top)

text \<open>dense\<close>

lemma transitive_iff_dense_dual:
  "transitive x \<longleftrightarrow> dense_rel (x\<^sup>d)"
  by (metis dual_antitone dual_dist_comp dual_involutive)

text \<open>idempotent\<close>

lemma idempotent_dual:
  "idempotent x \<longleftrightarrow> idempotent (x\<^sup>d)"
  using dual_involutive idempotent_transitive_dense transitive_iff_dense_dual by auto

text \<open>add-distributive\<close>

lemma comp_sup_distributive:
  "sup_distributive x \<Longrightarrow> sup_distributive y \<Longrightarrow> sup_distributive (x * y)"
  by (simp add: sup_distributive_def mult.assoc)

lemma sup_inf_distributive_dual:
  "sup_distributive x \<longleftrightarrow> inf_distributive (x\<^sup>d)"
  by (smt (verit, ccfv_threshold) sup_distributive_def dual_dist_sup dual_dist_comp dual_dist_inf dual_involutive inf_distributive_def)

text \<open>inf-distributive\<close>

lemma inf_inf_distributive:
  "inf_distributive x \<Longrightarrow> inf_distributive y \<Longrightarrow> inf_distributive (x \<sqinter> y)"
  by (metis sup_inf_distributive_dual sup_sup_distributive dual_dist_inf dual_involutive)

lemma comp_inf_distributive:
  "inf_distributive x \<Longrightarrow> inf_distributive y \<Longrightarrow> inf_distributive (x * y)"
  by (simp add: inf_distributive_def mult.assoc)

proposition "co_total x \<and> transitive x \<and> up_closed x \<longrightarrow> coreflexive x" nitpick [expect=genuine,card=5] oops
proposition "total x \<and> dense_rel x \<and> up_closed x \<longrightarrow> reflexive x" nitpick [expect=genuine,card=5] oops
proposition "x * top \<sqinter> x\<^sup>d * bot = bot" nitpick [expect=genuine,card=6] oops

end

class multirelation_algebra_7 = multirelation_algebra_4 +
  assumes vector_inf_comp: "(x * top \<sqinter> y) * z = x * top \<sqinter> y * z"
begin

lemma vector_zero_inf_comp:
  "(x * bot \<sqinter> y) * z = x * bot \<sqinter> y * z"
  by (metis vector_inf_comp vector_mult_closed zero_vector)

lemma test_sup_distributive:
  "test x \<Longrightarrow> sup_distributive x"
  by (metis sup_distributive_def inf_sup_distrib1 mult_left_one test_def vector_inf_comp)

lemma test_inf_distributive:
  "test x \<Longrightarrow> inf_distributive x"
  by (smt (z3) inf.right_idem inf.sup_monoid.add_assoc inf.sup_monoid.add_commute inf_distributive_def mult_left_one test_def vector_inf_comp)

lemma test_inf_dist_kernel:
  "test x \<Longrightarrow> inf_dist_kernel x"
  by (metis inf.idem inf.sup_monoid.add_assoc kernel_def inf_dist_kernel_def mult_left_one test_def test_inf_distributive vector_inf_comp)

lemma co_test_inf_distributive:
  assumes "co_test x"
    shows "inf_distributive x"
proof -
  have "x = x * bot \<squnion> 1"
    using assms co_test_def by auto
  hence "\<forall>y z . x * y \<sqinter> x * z = x * (y \<sqinter> z)"
    by (metis distrib_imp1 inf_sup_absorb inf_sup_distrib1 mult_left_one mult_left_top mult_right_dist_sup sup_top_right vector_zero_inf_comp)
  thus "inf_distributive x"
    by (simp add: inf_distributive_def)
qed

lemma co_test_sup_distributive:
  assumes "co_test x"
    shows "sup_distributive x"
proof -
  have "x = x * bot \<squnion> 1"
    using assms co_test_def by auto
  hence "\<forall>y z . x * (y \<squnion> z) = x * y \<squnion> x * z"
    by (metis sup_sup_distributive sup_distributive_def inf_sup_absorb mult_left_top one_sup_distributive sup.idem sup_top_right vector_zero_inf_comp)
  thus "sup_distributive x"
    by (simp add: sup_distributive_def)
qed

lemma co_test_sup_dist_contact:
  "co_test x \<Longrightarrow> sup_dist_contact x"
  by (simp add: sup_dist_contact_def co_test_sup_distributive co_test_contact)

end

end


theory Projekat
  imports Main
begin

(*Nova tema rada: Mala biblioteka definicija deljivosti prirodnih brojeva n odredjenim brojevima k*)
(*k \<in> {3,4,12,2,5,6,8,11,9,10,15,18,20,25} *)

(*potrebna nam je funkcija koja pravi listu cifara*)
fun izdvoj_cifre :: "nat \<Rightarrow> nat list" where
  "izdvoj_cifre x =  (if x \<le> 9 then [x]
      else x mod 10 # izdvoj_cifre (x div 10))"

value "izdvoj_cifre 123"

(*racunamo sumu cifara*)
abbreviation suma_cifara :: "nat \<Rightarrow> nat" where
  "suma_cifara x \<equiv> sum_list (izdvoj_cifre x)"

value "suma_cifara 245"

(*******************************************DELJIV SA 3*******************************************)
(*Broj je deljiv sa 3 ako mu je suma cifara deljiva sa 3.*)
definition deljiv_3 ::"nat\<Rightarrow>bool" where
"deljiv_3 x = ( if (suma_cifara x mod 3 = 0) then True else False ) "

(*provera*)
value "deljiv_3 12"
value "deljiv_3 5"
value "deljiv_3 531840"

(*lema vezana za ovu deljivost je na kraju fajla*)

(*************************************************************************************************)
(*potrebna nam je funkcija koja racuna dvocifren zavrsetak broja iz liste*)
(*ova funkcija nam ne treba za nepraznu listu jer nam ona nista ne govori-ne postoji br bez cifara*)
fun dvocifren_broj:: "nat list \<Rightarrow> nat" where
"dvocifren_broj [x] = x" | (*slucaj jednocifrenih brojeva*)
"dvocifren_broj (x # y # xs) = x + 10*y"

(*spajamo sve da ne bismo pisali kompoziciju funkcija*)
definition dvocifren_zavrsetak:: "nat \<Rightarrow> nat" where
"dvocifren_zavrsetak x = dvocifren_broj(izdvoj_cifre x)"

(*drugi nacin definisanja dvocifrenog zavrsetka bez koriscenja liste cifara*)
lemma dvocifre_zavrsetak_bez_liste:
  assumes "x \<ge> 9"
  shows "dvocifren_zavrsetak x = (x mod 10) + 10 * ((x div 10) mod 10)"
  using assms
  unfolding dvocifren_zavrsetak_def
  by simp

(*********************************************DELJIV SA 4******************************************)
(*Broj je deljiv sa 4 ako mu je dvocifreni zavrsetak deljiv sa 4.*)
definition deljiv_4 :: "nat \<Rightarrow> bool" where
"deljiv_4 x \<equiv> dvocifren_zavrsetak x mod 4 = 0"

value "deljiv_4 4"
value "deljiv_4 5450328"
value "deljiv_4 15"

(*dvocifren zavrsetak definisan preko liste jednak je sa mod 100*)
lemma dvocifren_zavrsetak_mod_100: "dvocifren_zavrsetak x = x mod 100"
proof (cases "x < 9")
  case True
  thus ?thesis
    unfolding dvocifren_zavrsetak_def
    by (simp add: izdvoj_cifre.simps)
next
  case False
  thus ?thesis
    using dvocifre_zavrsetak_bez_liste[of x]
    unfolding dvocifren_zavrsetak_def
    sorry
   (*by (metis add.commute comm_semiring_class.distrib mod_mult2_eq not_less
      numeral_Bit0 numeral_eq_iff numeral_plus_numeral numeral_times_numeral semiring_norm(12)
      semiring_norm(3) semiring_norm(4) semiring_norm(6) semiring_norm(9))*)
qed

(*lema koja spaja matematicku definiciju sa definicijom preko cifara*)
lemma deljiv_4_k: "deljiv_4 x \<longleftrightarrow> (\<exists> k. x = 4 * k)"
proof
  assume "deljiv_4 x"
  show "\<exists> k. x = 4 * k"
  proof-
    from `deljiv_4 x`
    have "(x mod 100) mod 4 = 0"
      unfolding deljiv_4_def
      using dvocifren_zavrsetak_mod_100[of x]
      by auto
    have "x = 100 * (x div 100) + x mod 100"
      by auto
    hence "x mod 4 = 0"
      using `(x mod 100) mod 4 = 0`
      by (metis Euclidean_Division.div_eq_0_iff add_diff_cancel_left'
          add_self_mod_2 mod_0_imp_dvd mod_mod_cancel mult_2 mult_mod_right numeral.simps(2)
          numeral_code(1) numerals(2) odd_one odd_two_times_div_two_nat plus_1_eq_Suc rel_simps(51)
          zero_less_diff)
    thus ?thesis
      by (simp add: mod_eq_0D)
  qed
next
  assume "\<exists> k. x = 4 * k"
  show "deljiv_4 x"
  proof-
    from `\<exists> k. x = 4 * k`
    have " x mod 4 = 0"
      by auto
    hence "x = 100 * (x div 100) + x mod 100 "
      unfolding deljiv_4_def
      by simp
    hence"(x mod 100) mod 4 = 0"
      by (metis \<open>x mod 4 = 0\<close> cong_exp_iff_simps(1) cong_exp_iff_simps(2)
           dvd_eq_mod_eq_0 mod_mod_cancel)
    thus ?thesis
      by (simp add: deljiv_4_def dvocifren_zavrsetak_mod_100)
qed
qed
(**************************************************************************************************)

(********************************************DELJIV SA 12******************************************)
(*Broj je deljiv brojem 12 ako je deljiv brojem 3 i brojem 4*)
definition deljiv_12 ::"nat\<Rightarrow>bool" where
"deljiv_12 x \<equiv> deljiv_3 x \<and> deljiv_4 x"

(*provera*)
value "deljiv_12 144"
value "deljiv_12 8030472"

(*************************************************************************************************)
(*JEDNOCIFRENI ZAVRSETAK*)
fun jednocifren_broj:: "nat list \<Rightarrow> nat" where
"jednocifren_broj [x] = x" | (*slucaj jednocifrenih brojeva*)
"jednocifren_broj (x # xs) = x "

value "jednocifren_broj [1,2,3] "

(*spajamo sve da ne bismo pisali kompoziciju funkcija*)
definition jednocifren_zavrsetak:: "nat \<Rightarrow> nat" where
"jednocifren_zavrsetak x = jednocifren_broj(izdvoj_cifre x)"

value "jednocifren_zavrsetak 53"

lemma jednocifren_zavrsetak_bez_liste:
  assumes "x \<ge> 9"
  shows "jednocifren_zavrsetak x = (x mod 10) "
  using assms
  unfolding jednocifren_zavrsetak_def
  by simp

(*****************************************DELJIV SA 2*********************************************)
(*Broj je deljiv sa 2 ako mu je poslednja cifra deljiva sa 2.*)
definition deljiv_2 :: "nat \<Rightarrow> bool" where
"deljiv_2 x \<equiv> jednocifren_zavrsetak x mod 2 = 0"

lemma jednocifren_zavrsetak_mod_10: "jednocifren_zavrsetak x = x mod 10"
proof (cases "x < 9")
  case True
  thus ?thesis
    unfolding jednocifren_zavrsetak_def
    by (simp add: izdvoj_cifre.simps)
next
  case False
  thus ?thesis
    using jednocifren_zavrsetak_bez_liste[of x]
    unfolding dvocifren_zavrsetak_def
    using not_less
    by blast
qed

(*lema koja spaja matematicku definiciju sa definicijom preko cifara*)
lemma deljiv_2_k: "deljiv_2 x \<longleftrightarrow> (\<exists> k. x = 2* k)"
proof
  assume "deljiv_2 x"
  show "\<exists> k. x = 2 * k"
  proof-
    from `deljiv_2 x`
    have "(x mod 10) mod 2 = 0"
      unfolding deljiv_4_def
      using jednocifren_zavrsetak_mod_10[of x]
      by (simp add: deljiv_2_def)
    have "x = 10 * (x div 10) + x mod 10"
      by auto
    hence "x mod 2 = 0"
      using `(x mod 10) mod 2 = 0`
      by (metis add_self_mod_2 dvd_eq_mod_eq_0 mod_mod_cancel numeral_Bit0)
    thus ?thesis
      by blast
  qed
next
  assume "\<exists> k. x = 2 * k"
  show "deljiv_2 x"
  proof-
    from `\<exists> k. x = 2 * k`
    have " x mod 2 = 0"
      by auto
    hence"x = 10 * (x div 10) + x mod 10"
      unfolding deljiv_2_def
      by simp
    hence"(x mod 10) mod 2 = 0"
      by (metis \<open>x mod 2 = 0\<close> add_self_mod_2 dvd_eq_mod_eq_0 mod_mod_cancel numeral_Bit0)
    thus ?thesis
      by (simp add: deljiv_2_def jednocifren_zavrsetak_mod_10)
qed
qed

(***********************************************DELJIV SA 5****************************************)
(*Broj je deljiv sa 5 ako mu je poslednja cifra deljiva sa 5*)
definition deljiv_5 :: "nat \<Rightarrow> bool" where
"deljiv_5 x \<equiv> jednocifren_zavrsetak x mod 5 = 0"

(*lema koja spaja matematicku definiciju i definiciju preko cifara*)
lemma deljiv_5_k: "deljiv_5 x \<longleftrightarrow> (\<exists> k. x = 5* k)"
proof
  assume "deljiv_5 x"
  show "\<exists> k. x = 5 * k"
  proof-
    from `deljiv_5 x`
    have "(x mod 10) mod 5 = 0"
      unfolding deljiv_5_def
      using jednocifren_zavrsetak_mod_10[of x]
      by (simp add: deljiv_5_def)
    have "x = 10 * (x div 10) + x mod 10"
      by auto
    hence "x mod 5 = 0"
      using `(x mod 10) mod 5 = 0`
      by (metis add.right_neutral dvd_eq_mod_eq_0 mod_add_self1 mod_mod_cancel
          mod_mult_self4 mult_div_mod_eq numeral_Bit0)
      thus ?thesis
      by blast
  qed
next
  assume "\<exists> k. x = 5 * k"
  show "deljiv_5 x"
  proof-
    from `\<exists> k. x = 5 * k`
    have " x mod 5 = 0"
      by auto
    hence"x = 10 * (x div 10) + x mod 10"
      unfolding deljiv_5_def
      by simp
    hence"(x mod 10) mod 5 = 0"
      by (metis \<open>x mod 5 = 0\<close> dvd_eq_mod_eq_0 mod_mod_cancel mod_mult_self1_is_0 mult_2_right
          numeral_Bit0)
    thus ?thesis
      by (simp add: deljiv_5_def jednocifren_zavrsetak_mod_10)
qed
qed

(********************************************DELJIV SA 6*******************************************)
(*Broj je deljiv sa 6 ako je deljiv sa 2 i sa 3*)
definition deljiv_6 ::"nat\<Rightarrow>bool" where
"deljiv_6 x \<equiv> deljiv_3 x \<and> deljiv_2 x"

(*provera*)
value "deljiv_6 342"
value "deljiv_12 8030472"

(**************************************************************************************************)
(*TROCIFRENI ZAVRSETAK*)
fun trocifren_broj:: "nat list \<Rightarrow> nat" where
"trocifren_broj [x] = x" |
"trocifren_broj [x,y] = x + 10*y" | (*slucaj dvocifrenog broja*)
"trocifren_broj (x # y #z # xs) = x + 10*y+ 100*z"
value "trocifren_broj [1,2,3,4]"

definition trocifren_zavrsetak:: "nat \<Rightarrow> nat" where
"trocifren_zavrsetak x = trocifren_broj(izdvoj_cifre x)"

value "trocifren_zavrsetak 1234"
value "trocifren_zavrsetak 52"
value "trocifren_zavrsetak 5"

lemma trocifren_zavrsetak_bez_liste:
  assumes "x \<ge> 9"
  shows "trocifren_zavrsetak x = (x mod 10) + 10 * ((x div 10) mod 10 )+ 100*((x div 100) mod 10)"
  using assms
  unfolding trocifren_zavrsetak_def
  sorry

(*******************************************DELJIV SA 8********************************************)
(*Broj je deljiv sa 8 ako mu je trocifreni zavrsetak deljiv sa 8.*)
definition deljiv_8 :: "nat \<Rightarrow> bool" where
"deljiv_8 x \<equiv> trocifren_zavrsetak x mod 8 = 0"

(*potrebno za lemu ispod*)
lemma trocifren_zavrsetak_mod_1000: "trocifren_zavrsetak x = x mod 1000"
proof (cases "x < 9")
  case True
  thus ?thesis
    unfolding trocifren_zavrsetak_def
    by (simp add: izdvoj_cifre.simps)
next
  case False
  thus ?thesis
    using trocifren_zavrsetak_bez_liste[of x]
    unfolding trocifren_zavrsetak_def
    sorry
   (* by (metis add.commute comm_semiring_class.distrib mod_mult2_eq
        not_less numeral_Bit0 numeral_eq_iff numeral_plus_numeral numeral_times_numeral
        semiring_norm(12) semiring_norm(3) semiring_norm(4) semiring_norm(6) semiring_norm(9))*)
qed

(*lema koja spaja matematicku definiciju i definiciju preko cifara*)
lemma deljiv_8_k: "deljiv_8 x \<longleftrightarrow> (\<exists> k. x = 8* k)"
proof
  assume "deljiv_8 x"
  show "\<exists> k. x = 8 * k"
  proof-
    from `deljiv_8 x`
    have "(x mod 1000) mod 8 = 0"
      unfolding deljiv_8_def
      using trocifren_zavrsetak_mod_1000[of x]
      by (simp add: deljiv_8_def)
    have "x = 1000 * (x div 1000) + x mod 1000" (*ovde je bila greska*)
      by auto
    hence "x mod 8 = 0"
      using `(x mod 1000) mod 8 = 0`
      by (metis Euclidean_Division.div_eq_0_iff add_diff_cancel_left'
          add_self_mod_2 mod_0_imp_dvd mod_mod_cancel mult_2 mult_mod_right numeral.simps(2)
          numeral_code(1) numerals(2) odd_one odd_two_times_div_two_nat plus_1_eq_Suc rel_simps(51)
          zero_less_diff)
      thus ?thesis
        by(simp add: mod_eq_0D)
  qed
next
  assume "\<exists> k. x = 8 * k"
  show "deljiv_8 x"
  proof-
    from `\<exists> k. x = 8 * k`
    have " x mod 8 = 0"
      by auto
    hence "x =  1000*(x div 1000) + x mod 1000"
      unfolding deljiv_8_def
      by simp
    hence"(x mod 10) mod 8 = 0"
      by (metis \<open>x mod 8 = 0\<close> dvd_eq_mod_eq_0 mod_mod_cancel mod_mult_self1_is_0
          mult_2_right numeral_Bit0 )
    thus ?thesis
      by (simp add: deljiv_8_def trocifren_zavrsetak_mod_1000)
qed
qed

(*******************************************DELJIV SA 11*****************************************)
(*Broj je deljiv sa 11 ako mu je razlika zbira cifara na neparnim i parnim mestima deljiva sa 11*)
fun izdvoj_neparne :: "nat list \<Rightarrow> nat list" where
  "izdvoj_neparne [x] =[x]"|
  "izdvoj_neparne (x#y#xs) = x # izdvoj_neparne xs"

fun izdvoj_parne :: "nat list \<Rightarrow> nat list" where
  "izdvoj_parne [x] =[]"|
  "izdvoj_parne (x#y#xs) = y # izdvoj_parne xs"

definition deljiv_11 ::"nat \<Rightarrow> bool" where
"deljiv_11 x \<equiv> (sum_list(izdvoj_neparne(izdvoj_cifre x)) - sum_list(izdvoj_neparne(izdvoj_cifre x))) mod 11 = 0 "

(*lema koja spaja matematicku definiciju i definiciju preko cifara*)
lemma deljiv_11_k: "deljiv_11 x \<longleftrightarrow> (\<exists> k. x = 11* k)"
proof
  assume "deljiv_11 x"
  show "\<exists> k. x = 11 * k"
    sorry
next
  assume "\<exists> k. x = 11* k"
  show "deljiv_11 x"
    sorry
qed
(*******************************************DELJIV SA 9*******************************************)
(*Broj je deljiv sa 9 ako mu je suma cifara deljiva sa 9.*)
definition deljiv_9::"nat \<Rightarrow> bool" where
"deljiv_9 x \<longleftrightarrow> suma_cifara x mod 9 = 0"

(*provera*)
value "deljiv_9 27"
value "deljiv_9 9"
value "deljiv_9 13"

(******************************************DELJIV SA 10*******************************************)
(*Broj je deljiv sa 10 ako mu je poslednja cifra 0*)
definition deljiv_10 :: "nat \<Rightarrow> bool" where
"deljiv_10 x \<equiv> jednocifren_zavrsetak x  = 0"

(*lema koja spaja matematicku definiciju sa definicijom preko cifara*)
lemma deljiv_10_k: "deljiv_10 x \<longleftrightarrow> (\<exists> k. x = 10*k)"
proof
  assume "deljiv_10 x"
  show "\<exists> k. x = 10 * k"
  proof-
    from `deljiv_10 x`
    have "(x mod 10) mod 10 = 0"
      unfolding deljiv_10_def
      using jednocifren_zavrsetak_mod_10[of x]
      by (simp add: deljiv_10_def)
    have "x = 10 * (x div 10) + x mod 10"
      by auto
    hence "x mod 10 = 0"
      using `(x mod 10) mod 10 = 0`
      by simp
    thus ?thesis
      by blast
  qed
next
  assume "\<exists> k. x = 10 * k"
  show "deljiv_10 x"
  proof-
    from `\<exists> k. x = 10 * k`
    have " x mod 10 = 0"
      by auto
    hence "x = 10 * (x div 10) + x mod 10"
      unfolding deljiv_10_def
      by auto
    hence"(x mod 10) mod 10 = 0"
      by (simp add: \<open>x mod 10 = 0\<close>)
    thus ?thesis
      by (simp add: deljiv_10_def jednocifren_zavrsetak_mod_10)
qed
qed

(********************************************DELJIV SA 15*******************************************)
(*Broj je deljiv sa 15 ako je deljiv sa 3 i sa 5*)
definition deljiv_15 ::"nat\<Rightarrow>bool" where
"deljiv_15 x \<equiv> deljiv_3 x \<and> deljiv_5 x"

(*provera*)
value "deljiv_15 255"
value "deljiv_15 25"

(********************************************DELJIV SA 18*******************************************)
(*Broj je deljiv sa 18 ako je deljiv sa 2 i sa 9*)
definition deljiv_18 ::"nat\<Rightarrow>bool" where
"deljiv_18 x \<equiv> deljiv_2 x \<and> deljiv_9 x"

(*provera*)
value "deljiv_18 255"
value "deljiv_18 4428"

(*********************************************DELJIV SA 20******************************************)
(*Broj je deljiv sa 20 ako mu je dvocifreni zavrsetak deljiv sa 20.*)
definition deljiv_20 :: "nat \<Rightarrow> bool" where
"deljiv_20 x \<equiv> dvocifren_zavrsetak x mod 20 = 0"

value "deljiv_20 20"
value "deljiv_20 253100"
value "deljiv_20 3"

(*lema koja spaja matematicku definiciju sa definicijom preko cifara*)
lemma deljiv_20_k: "deljiv_20 x \<longleftrightarrow> (\<exists> k. x = 20 * k)"
proof
  assume "deljiv_20 x"
  show "\<exists> k. x = 20 * k"
  proof-
    from `deljiv_20 x`
    have "(x mod 100) mod 20 = 0"
      unfolding deljiv_20_def
      using dvocifren_zavrsetak_mod_100[of x]
      by auto
    have "x = 100 * (x div 100) + x mod 100"
      by auto
    hence "x mod 20 = 0"
      using `(x mod 100) mod 20 = 0`
      sorry
    thus ?thesis
      by (simp add: mod_eq_0D)
  qed
next
  assume "\<exists> k. x = 20 * k"
  show "deljiv_20 x"
  proof-
    from `\<exists> k. x = 20 * k`
    have " x mod 20 = 0"
      by auto
    hence "x = 100 * (x div 100) + x mod 100 "
      unfolding deljiv_20_def
      by simp
    hence"(x mod 100) mod 20 = 0"
      sorry
    thus ?thesis
      by (simp add: deljiv_20_def dvocifren_zavrsetak_mod_100)
qed
qed

(*********************************************DELJIV SA 25******************************************)
(*Broj je deljiv sa 25 ako mu je dvocifreni zavrsetak deljiv sa 25.*)
definition deljiv_25 :: "nat \<Rightarrow> bool" where
"deljiv_25 x \<equiv> dvocifren_zavrsetak x mod 25 = 0"

value "deljiv_25 50"
value "deljiv_25 15"

(*lema koja spaja matematicku definiciju sa definicijom preko cifara*)
lemma deljiv_25_k: "deljiv_25 x \<longleftrightarrow> (\<exists> k. x = 25 * k)"
proof
  assume "deljiv_25 x"
  show "\<exists> k. x = 25 * k"
  proof-
    from `deljiv_25 x`
    have "(x mod 100) mod 25 = 0"
      unfolding deljiv_25_def
      using dvocifren_zavrsetak_mod_100[of x]
      by auto
    have "x = 100 * (x div 100) + x mod 100"
      by auto
    hence "x mod 25 = 0"
      using `(x mod 100) mod 25 = 0`
      sorry
    thus ?thesis
      by (simp add: mod_eq_0D)
  qed
next
  assume "\<exists> k. x = 25 * k"
  show "deljiv_25 x"
  proof-
    from `\<exists> k. x = 25 * k`
    have " x mod 25 = 0"
      by auto
    hence "x = 100 * (x div 100) + x mod 100 "
      unfolding deljiv_25_def
      by simp
    hence"(x mod 100) mod 25 = 0"
      by (metis \<open>x mod 25 = 0\<close> mod_0_imp_dvd mod_mod_cancel mod_mult_self1_is_0
          mod_mult_self4 mult_2_right numeral.simps(2))
    thus ?thesis
      by (simp add: deljiv_25_def dvocifren_zavrsetak_mod_100)
qed
qed

(**************************************************************************************)
(*DOKAZ TEOEREME ZA DELJIVOST SA 3 - x deljiv sa 3 akko suma cifara od x deljiva sa 3*)

declare izdvoj_cifre.simps [simp del] (*ovo pravi problem ostalim dokazima pa je zato na kraju!*)

lemma suma_cifara_manja:
  shows "suma_cifara x \<le> x"
proof (induction x rule:izdvoj_cifre.induct)
  case (1 x)
  show ?case
  proof (cases "x \<le> 9")
    case True
    thus ?thesis
      by (simp add:izdvoj_cifre.simps)
  next
    case False
    thus ?thesis
      using 1
      by (simp add: izdvoj_cifre.simps[of x])
  qed
qed

lemma dvd_3_suma_cifara:
 shows "3 dvd x \<longleftrightarrow> 3 dvd suma_cifara x"
 proof-
  have "suma_cifara x \<le> x"
    by (rule suma_cifara_manja)
  moreover
  have "3 dvd (x - suma_cifara x)"
  proof (induct x rule:izdvoj_cifre.induct)
    case (1 x)
    show ?case
    proof (cases "x \<le> 9")
      case True
      thus ?thesis
        by (simp add:izdvoj_cifre.simps)
    next
      case False
      have "x = 10 * (x div 10) + x mod 10"
        by simp
      hence "x - suma_cifara x = 10*(x div 10) - suma_cifara(x div 10)"
        using izdvoj_cifre.simps[of x] `\<not> x \<le> 9`
        by (metis add_diff_cancel_right' diff_diff_left sum_list.Cons)
      hence "x - suma_cifara x = 9*(x div 10) + (x div 10 - suma_cifara (x div 10))"
        using suma_cifara_manja[of "x div 10"]
        by auto
      thus ?thesis
        using 1 `\<not> x \<le> 9`
        by simp
    qed
  qed
  ultimately
  show ?thesis
    using dvd_diffD dvd_diffD1
    by blast
qed

(**************************************************************************************************)
(****************************************prethodna tema rada***************************************)
(*definicija PROSTOG BROJA*)

definition prost :: "nat \<Rightarrow> bool"  where
 "prost x \<longleftrightarrow> 1 < x \<and> (\<forall>a \<in> {1..x}. a dvd x \<longrightarrow>  a = 1 \<or> a = x)"

(*provera definicije prostog broja*)
value "prost 5"
value "prost 12"
value "prost 113"

(*GLAVNA TEOREMA KOJU DOKAZUJEMO - otprilike pomocne leme koje ce nam trebati*)
(*Ako su a i b prosti brojevi veci od 3 i a>b dokazati da je proizvod (a+b)(a-b) deljiv sa 12*)
(*1:  Prosti brojevi veci od 3 su neparni pa su a i b neparni.
  2:  Njihov zbir a+b i njihova razlika a-b su parni pa je i proizvod paran deljiv sa 4.
  3:  Pri deljenju sa brojem 3 brojevi a i b mogu imati ostatak 1 ili 2.
  4: Ako je ostatak isti onda je razlika deljiva sa 3,
  5: a ako imaju razlicit ostatak onda je zbir deljiv sa 3.
  6: U oba slucaja proizvod je deljiv sa 3. Kako je deljiv i sa 3  i sa 4 onda je deliv i sa 12 *)
theorem
  assumes "prost a" "prost b" "a>b" "a>3" "b>3"
  shows "deljiv_12 ((a+b)*(a-b))"
  sorry

(*1. Prosti brojevi veci od tri su neparni*)
lemma prosti_brojevi_veci_od_tri_neparni:
  assumes "prost x" "x > 3"
  shows "x mod 2 = 1"
  using assms
  unfolding prost_def
  by (metis One_nat_def Suc_leI atLeastAtMost_iff gcd_nat.order_iff_strict linorder_not_less not_numeral_less_one numerals(2) odd_iff_mod_2_eq_one odd_one one_less_numeral_iff semiring_norm(77))

(*2.1.Zbir i razlika dva neparna broja su paran broj*)
lemma razlika_neparnih_paran:
  assumes"prost x" "x > 3" "prost y" "y > 3"
  shows "(x - y) mod 2 = 0"
  using assms
  by (metis prosti_brojevi_veci_od_tri_neparni One_nat_def  diff_is_0_eq dvd_imp_mod_0 linorder_not_less mod_0 mod_eq_dvd_iff_nat numerals(2) order_le_less )

lemma zbir_nepanih_paran:
  assumes "prost x" "x > 3" "prost y" "y > 3"
  shows "(x + y) mod 2 = 0"
  using assms
  by (metis add_self_mod_2 mod_add_eq prosti_brojevi_veci_od_tri_neparni)

(*2.2.1. Proizvod parnih brojeva je paran*)
lemma proizvod_parnih_paran:
  assumes  "x mod 2 = 0" "y mod 2 = 0" "prost x" "prost y"
  shows "(x*y) mod 2 = 0"
  using assms
  unfolding prost_def
  by fastforce

(*2.2.2 Proizvod parnih je paran broj deljiv sa cetiri*)
lemma proizvod_parnih_deljiv_sa_cetiri: (*dokazana na konsultacijama*)
  assumes "x mod 2 = 0" "y mod 2 = 0" "prost x" "prost y"
  shows "deljiv_4 (x*y)"
proof-
  from `x mod 2 = 0` obtain k where "x = 2 * k"
    by blast
  moreover
  from `y mod 2 = 0` obtain k' where "y = 2 * k'"
    by blast
  ultimately
  have "x * y = 4 * k * k'"
    by auto
  thus ?thesis
    using deljiv_4_k[of "x*y"]
    by auto
qed

(*3. Ako je broj veci od 3 i prost - onda pri deljenju sa brojem 3 ostatak moze biti 1 ili 2*)
lemma ostatak_pri_deljenju_sa_3:
  assumes "x > 3" "prost x"
  shows "(x mod 3 = 1) \<or> (x mod 3 = 2)"
  using assms
  unfolding prost_def
  sorry

(*4. Ako dva broja koja su veca od tri i prosti su daju isti ostatak pri deljenju sa 3
- razlika im je deljiva sa 3*)
lemma razlika_sa_tri:
  assumes "x > 3" "y > 3" "prost x" "prost y"
  assumes "x mod 3 = y mod 3"
  shows "deljiv_3 (x - y) "
  using assms
  unfolding deljiv_3_def prost_def
  sorry
  (*by (smt Suc3_eq_add_3 Suc_le_mono add.right_neutral add_le_cancel_left
      diff_Suc_Suc diff_is_0_eq dvd_3_suma_cifara dvd_eq_mod_eq_0 le0 le_0_eq
      linorder_not_less mod_0 mod_eq_dvd_iff_nat numerals(2) order_le_less suma_cifara_manja zero_less_diff)*)

(*5. Ako dva broja daju razlicit ostatak pri deljenju sa 3 i prosti su i veci su od 3
- njihov zbir je deljiv sa tri*)
lemma zbir_sa_tri:
  assumes "x > 3" "y > 3" "prost x" "prost y"
  assumes "(x mod 3) \<noteq> (y mod 3)"
  shows "deljiv_3 (x + y)"
  using assms
  unfolding deljiv_3_def prost_def
  sorry

(*6. Nezavinso kakav je ostatak (pri deljejnju sa 3) proizvod brojeva x i y za koje vazi da su: prosti i veci od 3
njihov proizvod je deljiv sa tri*)
lemma proizvod_sa_tri:
  assumes "x > 3" "y > 3" "prost x" "prost y"
  shows "deljiv_3 (x*y)"
  using assms
  unfolding prost_def deljiv_3_def
  sorry

(*Kad dokazemo da je proizvod deljiv sa 3 i proizvod deljiv sa cetiri, upotrebimo te dve leme
i imamo dokaz da je proizvod deljiv sa 12.

Koristili smo u lemama opsti slucaj za neka dva broja, a u glavnoj teoremi cemo to primeniti na
brojeve (a-b) i (a+b)*)

end


theory PFHOL_nonpol imports Main
begin

(* A nonpolymorphic Embedding of Positive Free Higher-Order Logic (PFHOL) in HOL *)

text \<open> Positive Free Higher-Order Logic \<close>

  typedecl i (* — Type for individuals *)

  consts fExistenceI :: "i \<Rightarrow> bool" ("E\<^sup>i") (* — Existence/definedness predicate for individuals *)
  consts fExistenceP :: "(i \<Rightarrow> bool) \<Rightarrow> bool" ("E\<^sup>p") (* — Existence/definedness predicate for predicates *)

  consts fUndefI :: "i" ("\<^bold>e\<^sup>i") (* Distinguished symbol for undefinedness among the individuals *)
  axiomatization where fUndefIAxiom: "\<not>E\<^sup>i \<^bold>e\<^sup>i"

  consts fFalsehoodB :: "bool" ("\<^bold>e\<^sup>b") (* Distinguished error value among the booleans *)
  axiomatization where fFalsehoodBAxiom: "\<^bold>e\<^sup>b = False"

  (*
  axiomatization where fNonemptyDomainI: "\<exists>x. E\<^sup>i x"
  axiomatization where fNonemptyDomainP: "\<exists>x. E\<^sup>p x"
  *)

  definition fIdentityI :: "i \<Rightarrow> i \<Rightarrow> bool" (infixr "\<^bold>=" 56) (* — Free identity *)
    where "\<phi> \<^bold>= \<psi> \<equiv> \<phi> = \<psi>"

  definition fNot :: "bool \<Rightarrow> bool" ("\<^bold>\<not>_" [52]53) (* — Free negation *)
    where "\<^bold>\<not>\<phi> \<equiv> \<not>\<phi>"
  definition fOr (infixr "\<^bold>\<or>" 51) (* — Free disjunction *)
    where "\<phi> \<^bold>\<or> \<psi> \<equiv> \<phi> \<or> \<psi>"

  definition fForallI :: "(i \<Rightarrow> bool) \<Rightarrow> bool" ("\<^bold>\<forall>\<^sup>i") (* — Free universal quantification over individuals guarded by predicate E *)
    where "\<^bold>\<forall>\<^sup>i\<Phi> \<equiv> \<forall>x. E\<^sup>i x \<longrightarrow> \<Phi> x"
  definition fForallIBinder:: "(i \<Rightarrow> bool) \<Rightarrow> bool" (binder "\<^bold>\<forall>\<^sup>i" [8]9) (* — Binder notation *)
    where "\<^bold>\<forall>\<^sup>ix. \<phi> x \<equiv> \<^bold>\<forall>\<^sup>i\<phi>"
  definition fForallP :: "((i \<Rightarrow> bool) \<Rightarrow> bool) \<Rightarrow> bool" ("\<^bold>\<forall>\<^sup>p") (* — Free universal quantification over predicates guarded by predicate E *)
    where "\<^bold>\<forall>\<^sup>p\<Phi> \<equiv> \<forall>x. E\<^sup>p x \<longrightarrow> \<Phi> x"
  definition fForallPBinder:: "((i \<Rightarrow> bool) \<Rightarrow> bool) \<Rightarrow> bool" (binder "\<^bold>\<forall>\<^sup>p" [8]9) (* — Binder notation *)
    where "\<^bold>\<forall>\<^sup>px. \<phi> x \<equiv> \<^bold>\<forall>\<^sup>p\<phi>"

  definition fThatI :: "(i \<Rightarrow> bool) \<Rightarrow> i" ("\<^bold>I") (* — Free definite description for individuals guarded by predicate E *)
    where "\<^bold>I\<Phi> \<equiv> if \<exists>x. E\<^sup>i x \<and> \<Phi> x \<and> (\<forall>y. (E\<^sup>i y \<and> \<Phi> y) \<longrightarrow> (y = x))
                 then THE x. E\<^sup>i x \<and> \<Phi> x
                 else \<^bold>e\<^sup>i"
  definition fThatIBinder:: "(i \<Rightarrow> bool) \<Rightarrow> i" (binder "\<^bold>I" [8]9) (* — Binder notation *)
    where "\<^bold>Ix. \<phi> x \<equiv> \<^bold>I\<phi>"

  text \<open> Further logical constants can be defined as usual \<close>

  definition fAnd :: "bool \<Rightarrow> bool \<Rightarrow> bool" (infixr "\<^bold>\<and>" 52) (* — Free conjunction *)
    where "\<phi> \<^bold>\<and> \<psi> \<equiv> \<^bold>\<not>(\<^bold>\<not>\<phi> \<^bold>\<or> \<^bold>\<not>\<psi>)"
  definition fImp :: "bool \<Rightarrow> bool \<Rightarrow> bool" (infixr "\<^bold>\<rightarrow>" 49) (* — Free implication *)
    where "\<phi> \<^bold>\<rightarrow> \<psi> \<equiv> \<^bold>\<not>\<phi> \<^bold>\<or> \<psi>"
  definition fEquiv :: "bool \<Rightarrow> bool \<Rightarrow> bool" (infixr "\<^bold>\<leftrightarrow>" 50) (* — Free equivalence *)
    where "\<phi> \<^bold>\<leftrightarrow> \<psi> \<equiv> \<phi> \<^bold>\<rightarrow> \<psi> \<^bold>\<and> \<psi> \<^bold>\<rightarrow> \<phi>"

  definition fExistsI :: "(i \<Rightarrow> bool) \<Rightarrow> bool" ("\<^bold>\<exists>\<^sup>i") (* — Free existential quantification over individuals *)
    where "\<^bold>\<exists>\<^sup>i\<Phi> \<equiv> \<^bold>\<not>(\<^bold>\<forall>\<^sup>i(\<lambda>y. \<^bold>\<not>(\<Phi> y)))"
  definition fExistsIBinder :: "(i \<Rightarrow> bool) \<Rightarrow> bool" (binder "\<^bold>\<exists>\<^sup>i" [8]9) (* — Binder notation *)
    where "\<^bold>\<exists>\<^sup>ix. \<phi> x \<equiv> \<^bold>\<exists>\<^sup>i\<phi>"
  definition fExistsP :: "((i \<Rightarrow> bool) \<Rightarrow> bool) \<Rightarrow> bool" ("\<^bold>\<exists>\<^sup>p") (* — Free existential quantification over predicates *)
    where "\<^bold>\<exists>\<^sup>p\<Phi> \<equiv> \<^bold>\<not>(\<^bold>\<forall>\<^sup>p(\<lambda>y. \<^bold>\<not>(\<Phi> y)))"
  definition fExistsPBinder :: "((i \<Rightarrow> bool) \<Rightarrow> bool) \<Rightarrow> bool" (binder "\<^bold>\<exists>\<^sup>p" [8]9) (* — Binder notation *)
    where "\<^bold>\<exists>\<^sup>px. \<phi> x \<equiv> \<^bold>\<exists>\<^sup>p\<phi>"

  (* Introducing "Defs" as the set of the above definitions; useful for convenient unfolding *)
  named_theorems Defs declare fIdentityI_def[Defs] fNot_def[Defs] fOr_def[Defs] fForallI_def[Defs]
    fForallIBinder_def[Defs] fForallP_def[Defs] fForallPBinder_def[Defs] fThatI_def[Defs]
    fThatIBinder_def[Defs] fAnd_def[Defs] fImp_def[Defs] fEquiv_def[Defs] fExistsI_def[Defs]
    fExistsIBinder_def[Defs] fExistsP_def[Defs] fExistsPBinder_def[Defs]

text \<open> Some Tests \<close>

  lemma "(\<^bold>\<forall>\<^sup>ix. P x) \<^bold>\<rightarrow>  P x" nitpick [user_axioms=true, show_all, format=2] oops (* properly invalid *)
  lemma "((\<^bold>\<forall>\<^sup>ix. (P x)) \<^bold>\<and> (E\<^sup>i x)) \<^bold>\<rightarrow> (P x)" unfolding Defs by auto (* properly valid *)

  lemma "P x \<^bold>\<rightarrow> (\<^bold>\<exists>\<^sup>ix. P x)" nitpick [user_axioms=true, show_all, format=2] oops (* properly invalid *)
  lemma "((P x) \<^bold>\<and> (E\<^sup>i x)) \<^bold>\<rightarrow> (\<^bold>\<exists>\<^sup>ix. P x)" unfolding Defs by auto (* properly valid *)

  lemma "(P x) \<^bold>\<and> (\<^bold>\<exists>\<^sup>ix. P x)" nitpick [user_axioms=true, show_all, format=2] oops (* properly invalid *)
  lemma "(P x) \<^bold>\<rightarrow> (E\<^sup>i x)" nitpick [user_axioms=true, show_all, format=2] oops (* properly invalid *)

  lemma "(P x) \<^bold>\<or> (\<^bold>\<not>(P x))" unfolding Defs by auto (* properly valid *)
  lemma "(P x) \<^bold>\<and> (\<^bold>\<not>(P x))" nitpick [user_axioms=true, show_all, format=2] oops (* properly invalid *)
  lemma "\<^bold>\<not>((P x) \<^bold>\<and> (\<^bold>\<not>(P x)))" unfolding Defs by auto (* properly valid *)

  consts fIndividual1 :: "i" ("i\<^sub>1")
  axiomatization where fUndefIndividual1Axiom: "\<^bold>\<not>(E\<^sup>i i\<^sub>1)"

  consts fIndividual2 :: "i" ("i\<^sub>2")
  axiomatization where fUndefIndividual2Axiom: "\<^bold>\<not>(E\<^sup>i i\<^sub>2)"

  lemma "x \<^bold>= x" unfolding Defs by auto (* properly valid *)
  lemma "i\<^sub>1 \<^bold>= i\<^sub>1" unfolding Defs by auto (* properly valid *)

  lemma "(P i\<^sub>1)" nitpick [user_axioms=true, show_all, format=2] oops (* properly invalid *)
  lemma "\<^bold>\<not>(P i\<^sub>1)" nitpick [user_axioms=true, show_all, format=2] oops (* properly invalid *)

  lemma test_True: "True" by simp
  lemma test_False: "False" nitpick [satisfy, user_axioms=true] oops

text \<open> Prior's Theorem \<close>

  lemma "(P (\<forall>p. (P p \<longrightarrow> (\<not>p)))) \<longrightarrow> ((\<exists>p. P p \<and> p) \<and> (\<exists>p. P p \<and> (\<not>p)))" by blast

  consts fExistenceB :: "bool \<Rightarrow> bool" ("E\<^sup>b") (* — Existence/definedness predicate for booleans *)

  definition fForallB :: "(bool \<Rightarrow> bool) \<Rightarrow> bool" ("\<^bold>\<forall>\<^sup>b") (* — Free universal quantification over booleans guarded by predicate E *)
    where "\<^bold>\<forall>\<^sup>b\<Phi> \<equiv> \<forall>x. E\<^sup>b x \<longrightarrow> \<Phi> x"
  definition fForallBBinder:: "(bool \<Rightarrow> bool) \<Rightarrow> bool" (binder "\<^bold>\<forall>\<^sup>b" [8]9) (* — Binder notation *)
    where "\<^bold>\<forall>\<^sup>bx. \<phi> x \<equiv> \<^bold>\<forall>\<^sup>b\<phi>"

  definition fExistsB :: "(bool \<Rightarrow> bool) \<Rightarrow> bool" ("\<^bold>\<exists>\<^sup>b") (* — Free existential quantification over booleans *)
    where "\<^bold>\<exists>\<^sup>b\<Phi> \<equiv> \<^bold>\<not>(\<^bold>\<forall>\<^sup>b(\<lambda>y. \<^bold>\<not>(\<Phi> y)))"
  definition fExistsBBinder :: "(bool \<Rightarrow> bool) \<Rightarrow> bool" (binder "\<^bold>\<exists>\<^sup>b" [8]9) (* — Binder notation *)
    where "\<^bold>\<exists>\<^sup>bx. \<phi> x \<equiv> \<^bold>\<exists>\<^sup>b\<phi>"

  lemma "(Q (\<^bold>\<forall>\<^sup>bp. (Q p \<^bold>\<rightarrow> (\<^bold>\<not>p)))) \<^bold>\<rightarrow> ((\<^bold>\<exists>\<^sup>bp. Q p \<^bold>\<and> p) \<^bold>\<and> (\<^bold>\<exists>\<^sup>bp. Q p \<^bold>\<and> (\<^bold>\<not>p)))"
    nitpick [user_axioms=true, show_all, format=2] oops

  axiomatization where fTrueAxiom: "E\<^sup>b True"
  axiomatization where fFalseAxiom: "E\<^sup>b False"

  lemma "(Q (\<^bold>\<forall>\<^sup>bp. (Q p \<^bold>\<rightarrow> (\<^bold>\<not>p)))) \<^bold>\<rightarrow> ((\<^bold>\<exists>\<^sup>bp. Q p \<^bold>\<and> p) \<^bold>\<and> (\<^bold>\<exists>\<^sup>bp. Q p \<^bold>\<and> (\<^bold>\<not>p)))"
    unfolding Defs
    by (smt fExistsBBinder_def fExistsB_def fFalseAxiom fForallBBinder_def fForallB_def fNot_def fTrueAxiom)


(*  Title:       Verification Examples
    Author:      Jonathan Julián Huerta y Munive, 2020
    Maintainer:  Jonathan Julián Huerta y Munive <jonjulian23@gmail.com>
*)

section \<open> Verification examples \<close>

theory MTX_Examples
  imports
    "Matrix_ODE_Verify.MTX_Flows"
    HS_VC_Spartan

begin

subsection \<open> Examples \<close>

abbreviation hoareT :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a set) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool"
  ("PRE_ HP _ POST _" [85,85]85) where "PRE P HP X POST Q \<equiv> (P \<le> |X]Q)"

subsubsection \<open> Verification by uniqueness. \<close>

abbreviation mtx_circ :: "2 sq_mtx" ("A")
  where "A \<equiv> mtx
   ([0,  1] #
    [-1, 0] # [])"

abbreviation mtx_circ_flow :: "real \<Rightarrow> real^2 \<Rightarrow> real^2" ("\<phi>")
  where "\<phi> t s \<equiv> (\<chi> i. if i = 1 then s$1 * cos t + s$2 * sin t else - s$1 * sin t + s$2 * cos t)"

lemma mtx_circ_flow_eq: "exp (t *\<^sub>R A) *\<^sub>V s = \<phi> t s"
  apply(rule local_flow.eq_solution[OF local_flow_sq_mtx_linear, symmetric, of _ "\<lambda>s. UNIV"], simp_all)
    apply(rule ivp_solsI, simp_all add: sq_mtx_vec_mult_eq vec_eq_iff)
  unfolding UNIV_2 using exhaust_2
  by (force intro!: vderiv_intros simp: matrix_vector_mult_def)+

lemma mtx_circ:
  "PRE(\<lambda>s. r\<^sup>2 = (s $ 1)\<^sup>2 + (s $ 2)\<^sup>2)
  HP x\<acute>=(*\<^sub>V) A & G
  POST (\<lambda>s. r\<^sup>2 = (s $ 1)\<^sup>2 + (s $ 2)\<^sup>2)"
  apply(subst local_flow.fbox_g_ode_subset[OF local_flow_sq_mtx_linear])
  unfolding mtx_circ_flow_eq by auto

no_notation mtx_circ ("A")
        and mtx_circ_flow ("\<phi>")

subsubsection \<open> Flow of diagonalisable matrix. \<close>

abbreviation mtx_hOsc :: "real \<Rightarrow> real \<Rightarrow> 2 sq_mtx" ("A")
  where "A a b \<equiv> mtx
   ([0, 1] #
    [a, b] # [])"

abbreviation mtx_chB_hOsc :: "real \<Rightarrow> real \<Rightarrow> 2 sq_mtx" ("P")
  where "P a b \<equiv> mtx
   ([a, b] #
    [1, 1] # [])"

lemma inv_mtx_chB_hOsc:
  "a \<noteq> b \<Longrightarrow> (P a b)\<^sup>-\<^sup>1 = (1/(a - b)) *\<^sub>R mtx
   ([ 1, -b] #
    [-1,  a] # [])"
  apply(rule sq_mtx_inv_unique, unfold scaleR_mtx2 times_mtx2)
  by (simp add: diff_divide_distrib[symmetric] one_mtx2)+

lemma invertible_mtx_chB_hOsc: "a \<noteq> b \<Longrightarrow> mtx_invertible (P a b)"
  apply(rule mtx_invertibleI[of _ "(P a b)\<^sup>-\<^sup>1"])
   apply(unfold inv_mtx_chB_hOsc scaleR_mtx2 times_mtx2 one_mtx2)
  by (subst sq_mtx_eq_iff, simp add: vector_def frac_diff_eq1)+

lemma mtx_hOsc_diagonalizable:
  fixes a b :: real
  defines "\<iota>\<^sub>1 \<equiv> (b - sqrt (b^2+4*a))/2" and "\<iota>\<^sub>2 \<equiv> (b + sqrt (b^2+4*a))/2"
  assumes "b\<^sup>2 + a * 4 > 0" and "a \<noteq> 0"
  shows "A a b = P (-\<iota>\<^sub>2/a) (-\<iota>\<^sub>1/a) * (\<d>\<i>\<a>\<g> i. if i = 1 then \<iota>\<^sub>1 else \<iota>\<^sub>2) * (P (-\<iota>\<^sub>2/a) (-\<iota>\<^sub>1/a))\<^sup>-\<^sup>1"
  unfolding assms apply(subst inv_mtx_chB_hOsc)
  using assms(3,4) apply(simp_all add: diag2_eq[symmetric])
  unfolding sq_mtx_times_eq sq_mtx_scaleR_eq UNIV_2 apply(subst sq_mtx_eq_iff)
  using exhaust_2 assms by (auto simp: field_simps)

lemma mtx_hOsc_solution_eq:
  fixes a b :: real
  defines "\<iota>\<^sub>1 \<equiv> (b - sqrt (b\<^sup>2+4*a))/2" and "\<iota>\<^sub>2 \<equiv> (b + sqrt (b\<^sup>2+4*a))/2"
  defines "\<Phi> t \<equiv> mtx (
   [\<iota>\<^sub>2*exp(t*\<iota>\<^sub>1) - \<iota>\<^sub>1*exp(t*\<iota>\<^sub>2),     exp(t*\<iota>\<^sub>2)-exp(t*\<iota>\<^sub>1)]#
   [a*exp(t*\<iota>\<^sub>2) - a*exp(t*\<iota>\<^sub>1), \<iota>\<^sub>2*exp(t*\<iota>\<^sub>2)-\<iota>\<^sub>1*exp(t*\<iota>\<^sub>1)]#[])"
  assumes "b\<^sup>2 + a * 4 > 0" and "a \<noteq> 0"
  shows "P (-\<iota>\<^sub>2/a) (-\<iota>\<^sub>1/a) * (\<d>\<i>\<a>\<g> i. exp (t * (if i=1 then \<iota>\<^sub>1 else \<iota>\<^sub>2))) * (P (-\<iota>\<^sub>2/a) (-\<iota>\<^sub>1/a))\<^sup>-\<^sup>1
  = (1/sqrt (b\<^sup>2 + a * 4)) *\<^sub>R (\<Phi> t)"
  unfolding assms apply(subst inv_mtx_chB_hOsc)
  using assms apply(simp_all add: mtx_times_scaleR_commute, subst sq_mtx_eq_iff)
  unfolding UNIV_2 sq_mtx_times_eq sq_mtx_scaleR_eq sq_mtx_uminus_eq apply(simp_all add: axis_def)
  by (auto simp: field_simps)+

lemma local_flow_mtx_hOsc:
  fixes a b
  defines "\<iota>\<^sub>1 \<equiv> (b - sqrt (b^2+4*a))/2" and "\<iota>\<^sub>2 \<equiv> (b + sqrt (b^2+4*a))/2"
  defines "\<Phi> t \<equiv> mtx (
   [\<iota>\<^sub>2*exp(t*\<iota>\<^sub>1) - \<iota>\<^sub>1*exp(t*\<iota>\<^sub>2),     exp(t*\<iota>\<^sub>2)-exp(t*\<iota>\<^sub>1)]#
   [a*exp(t*\<iota>\<^sub>2) - a*exp(t*\<iota>\<^sub>1), \<iota>\<^sub>2*exp(t*\<iota>\<^sub>2)-\<iota>\<^sub>1*exp(t*\<iota>\<^sub>1)]#[])"
  assumes "b\<^sup>2 + a * 4 > 0" and "a \<noteq> 0"
  shows "local_flow ((*\<^sub>V) (A a b)) UNIV UNIV (\<lambda>t. (*\<^sub>V) ((1/sqrt (b\<^sup>2 + a * 4)) *\<^sub>R \<Phi> t))"
  unfolding assms using local_flow_sq_mtx_linear[of "A a b"] assms
  apply(subst (asm) exp_scaleR_diagonal2[OF invertible_mtx_chB_hOsc mtx_hOsc_diagonalizable])
     apply(simp, simp, simp)
  by (subst (asm) mtx_hOsc_solution_eq) simp_all

lemma overdamped_door_arith:
  assumes "b\<^sup>2 + a * 4 > 0" and "a < 0" and "b \<le> 0" and "t \<ge> 0" and "s1 > 0"
  shows "0 \<le> ((b + sqrt (b\<^sup>2 + 4 * a)) * exp (t * (b - sqrt (b\<^sup>2 + 4 * a)) / 2) / 2 -
(b - sqrt (b\<^sup>2 + 4 * a)) * exp (t * (b + sqrt (b\<^sup>2 + 4 * a)) / 2) / 2) * s1 / sqrt (b\<^sup>2 + a * 4)"
proof(subst diff_divide_distrib[symmetric], simp)
  have f0: "s1 / (2 * sqrt (b\<^sup>2 + a * 4)) > 0"  (is "s1/?c3 > 0")
    using assms(1,5) by simp
  have f1: "(b - sqrt (b\<^sup>2 + 4 * a)) < (b + sqrt (b\<^sup>2 + 4 * a))" (is "?c2 < ?c1")
    and f2: "(b + sqrt (b\<^sup>2 + 4 * a)) < 0"
    using sqrt_ge_absD[of b "b\<^sup>2 + 4 * a"] assms by (force, linarith)
  hence f3: "exp (t * ?c2 / 2) \<le> exp (t * ?c1 / 2)" (is "exp ?t1 \<le> exp ?t2")
    unfolding exp_le_cancel_iff
    using assms(4) by (case_tac "t=0", simp_all)
  hence "?c2 * exp ?t2 \<le> ?c2 * exp ?t1"
    using f1 f2 mult_le_cancel_iff2[of "-?c2" "exp ?t1" "exp ?t2"] by linarith
  also have "... < ?c1 * exp ?t1"
    using f1 by auto
  also have"... \<le> ?c1 * exp ?t1"
    using f1 f2 by auto
  ultimately show "0 \<le> (?c1 * exp ?t1 - ?c2 * exp ?t2) * s1 / ?c3"
    using f0 f1 assms(5) by auto
qed

abbreviation "open_door s \<equiv> {s. s$1 > 0 \<and> s$2 = 0}"

lemma overdamped_door:
  assumes "b\<^sup>2 + a * 4 > 0" and "a < 0" and "b \<le> 0"
  shows "PRE (\<lambda>s. s$1 = 0)
  HP (LOOP open_door; (x\<acute>=((*\<^sub>V) (A a b)) & G) INV (\<lambda>s. 0 \<le> s$1))
  POST (\<lambda>s. 0 \<le> s $ 1)"
  apply(rule fbox_loopI, simp_all add: le_fun_def)
  apply(subst local_flow.fbox_g_ode_subset[OF local_flow_mtx_hOsc[OF assms(1)]])
  using assms apply(simp_all add: le_fun_def fbox_def)
  unfolding sq_mtx_scaleR_eq UNIV_2 sq_mtx_vec_mult_eq
  by (clarsimp simp: overdamped_door_arith)

no_notation mtx_hOsc ("A")
        and mtx_chB_hOsc ("P")

subsubsection \<open> Flow of non-diagonalisable matrix. \<close>

abbreviation mtx_cnst_acc :: "3 sq_mtx" ("K")
  where "K \<equiv> mtx (
  [0,1,0] #
  [0,0,1] #
  [0,0,0] # [])"

lemma pow2_scaleR_mtx_cnst_acc: "(t *\<^sub>R K)\<^sup>2 = mtx (
  [0,0,t\<^sup>2] #
  [0,0,0] #
  [0,0,0] # [])"
  unfolding power2_eq_square apply(subst sq_mtx_eq_iff)
  unfolding sq_mtx_times_eq UNIV_3 by auto

lemma powN_scaleR_mtx_cnst_acc: "n > 2 \<Longrightarrow> (t *\<^sub>R K)^n = 0"
  apply(induct n, simp, case_tac "n \<le> 2")
   apply(subgoal_tac "n = 2", erule ssubst)
  unfolding power_Suc2 pow2_scaleR_mtx_cnst_acc sq_mtx_times_eq UNIV_3
  by (auto simp: sq_mtx_eq_iff)

lemma exp_mtx_cnst_acc_vec_mult_eq: "exp (t *\<^sub>R K) *\<^sub>V s =
  vector [s$3 * t^2/2 + s$2 * t + s$1, s$3 * t + s$2, s$3]"
  apply(subst exp_mtx_cnst_acc, subst pow2_scaleR_mtx_cnst_acc)
  apply(simp add: sq_mtx_vec_mult_eq vector_def)
  unfolding UNIV_3 by (simp add: fun_eq_iff)

lemma local_flow_mtx_cnst_acc:
  "local_flow ((*\<^sub>V) K) UNIV UNIV (\<lambda>t s. ((t *\<^sub>R K)\<^sup>2/\<^sub>R 2 + (t *\<^sub>R K) + 1) *\<^sub>V s)"
  using local_flow_sq_mtx_linear[of K] unfolding exp_mtx_cnst_acc .

lemma docking_station_arith:
  assumes "(d::real) > x" and "v > 0"
  shows "(v = v\<^sup>2 * t / (2 * d - 2 * x)) \<longleftrightarrow> (v * t - v\<^sup>2 * t\<^sup>2 / (4 * d - 4 * x) + x = d)"
proof
  assume "v = v\<^sup>2 * t / (2 * d - 2 * x)"
  hence "v * t = 2 * (d - x)"
    using assms by (simp add: eq_divide_eq power2_eq_square)
  hence "v * t - v\<^sup>2 * t\<^sup>2 / (4 * d - 4 * x) + x = 2 * (d - x) - 4 * (d - x)\<^sup>2 / (4 * (d - x)) + x"
    apply(subst power_mult_distrib[symmetric])
    by (erule ssubst, subst power_mult_distrib, simp)
  also have "... = d"
    apply(simp only: mult_divide_mult_cancel_left_if)
    using assms by (auto simp: power2_eq_square)
  finally show "v * t - v\<^sup>2 * t\<^sup>2 / (4 * d - 4 * x) + x = d" .
next
  assume "v * t - v\<^sup>2 * t\<^sup>2 / (4 * d - 4 * x) + x = d"
  hence "0 = v\<^sup>2 * t\<^sup>2 / (4 * (d - x)) + (d - x) - v * t"
    by auto
  hence "0 = (4 * (d - x)) * (v\<^sup>2 * t\<^sup>2 / (4 * (d - x)) + (d - x) - v * t)"
    by auto
  also have "... = v\<^sup>2 * t\<^sup>2 + 4 * (d - x)\<^sup>2  - (4 * (d - x)) * (v * t)"
    using assms apply(simp add: distrib_left right_diff_distrib)
    apply(subst right_diff_distrib[symmetric])+
    by (simp add: power2_eq_square)
  also have "... = (v * t - 2 * (d - x))\<^sup>2"
    by (simp only: power2_diff, auto simp: field_simps power2_diff)
  finally have "0 = (v * t - 2 * (d - x))\<^sup>2" .
  hence "v * t = 2 * (d - x)"
    by auto
  thus "v = v\<^sup>2 * t / (2 * d - 2 * x)"
    apply(subst power2_eq_square, subst mult.assoc)
    apply(erule ssubst, subst right_diff_distrib[symmetric])
    using assms by auto
qed

lemma docking_station:
  assumes "d > x\<^sub>0" and "v\<^sub>0 > 0"
  shows "PRE (\<lambda>s. s$1 = x\<^sub>0 \<and> s$2 = v\<^sub>0)
  HP ((3 ::= (\<lambda>s. -(v\<^sub>0^2/(2*(d-x\<^sub>0))))); x\<acute>=(*\<^sub>V) K & G)
  POST (\<lambda>s. s$2 = 0 \<longleftrightarrow> s$1 = d)"
  apply(clarsimp simp: le_fun_def local_flow.fbox_g_ode_subset[OF local_flow_sq_mtx_linear[of K]])
  unfolding exp_mtx_cnst_acc_vec_mult_eq using assms by (simp add: docking_station_arith)

no_notation mtx_cnst_acc ("K")

end


theory T75
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. over(join(x, y), z) = join(over(x, z), over(y, 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. undr(x, join(y, z)) = join(undr(x, y), undr(x, z)))
"
nitpick[card nat=7,timeout=86400]
oops
end