header {* Auxiliary Lemmas *}
theory ODE_Auxiliarities
imports
  "~~/src/HOL/Multivariate_Analysis/Multivariate_Analysis"
  "~~/src/HOL/Library/Float"
begin

subsection {* Reals *}

lemma image_mult_atLeastAtMost:
  "(\<lambda>x. x * c::real) ` {x..y} = (if x \<le> y then if c > 0 then {x * c .. y * c} else {y * c .. x * c} else {})"
  apply (cases "c = 0")
   apply force
  apply (auto simp: field_simps not_less intro!: image_eqI[where x="inverse c * xa" for xa])
  done

lemma image_add_atLeastAtMost:
  "op + c ` {x..y::real} = {c + x .. c + y}"
  by (auto intro: image_eqI[where x="xa - c" for xa])

lemma linear_compose: "(\<lambda>xa. a + xa * b) = (\<lambda>x. a + x) o (\<lambda>x. x * b)"
  by auto

lemma image_linear_atLeastAtMost: "(\<lambda>xa. a + xa * b) ` {c..d::real} =
  (if c \<le> d then if b > 0 then {a + c * b .. a + d * b} else {a + d * b .. a + c * b} else {})"
  by (simp add: linear_compose image_comp [symmetric] image_mult_atLeastAtMost image_add_atLeastAtMost)

lemma min_zero_mult_nonneg_le: "0 \<le> h' \<Longrightarrow> h' \<le> h \<Longrightarrow> min 0 (h * k::real) \<le> h' * k"
  by (metis dual_order.antisym le_cases min_le_iff_disj mult_eq_0_iff mult_le_0_iff mult_right_mono_neg)

lemma max_zero_mult_nonneg_le: "0 \<le> h' \<Longrightarrow> h' \<le> h \<Longrightarrow> h' * k \<le> max 0 (h * k::real)"
  by (metis dual_order.antisym le_cases le_max_iff_disj mult_eq_0_iff mult_right_mono zero_le_mult_iff)

subsection {* Vector Spaces *}

lemma scaleR_dist_distrib_left:
  fixes b c::"'a::real_normed_vector"
  shows "abs a * dist b c = dist (scaleR a b) (scaleR a c)"
  unfolding dist_norm scaleR_diff_right[symmetric] norm_scaleR ..

lemma ex_norm_eq_1: "\<exists>x. norm (x::'a::euclidean_space) = 1"
  by (metis vector_choose_size zero_le_one)

subsection {* Euclidean Components *}

lemma sqrt_le_rsquare:
  assumes "\<bar>x\<bar> \<le> sqrt y"
  shows "x\<^sup>2 \<le> y"
  using assms real_sqrt_le_iff[of "x\<^sup>2"] by simp

lemma setsum_ge_element:
  fixes f::"'a \<Rightarrow> ('b::ordered_comm_monoid_add)"
  assumes "finite s"
  assumes "i \<in> s"
  assumes "\<And>i. i \<in> s \<Longrightarrow> f i \<ge> 0"
  assumes "el = f i"
  shows "el \<le> setsum f s"
proof -
  have "el = setsum f {i}" by (simp add: assms)
  also have "... \<le> setsum f s" using assms by (intro setsum_mono2) auto
  finally show ?thesis .
qed

lemma norm_nth_le:
  fixes x::"'a::euclidean_space"
  assumes "i \<in> Basis"
  shows "norm (x \<bullet> i) \<le> norm x"
  unfolding norm_conv_dist euclidean_dist_l2[of x] setL2_def
  by (auto intro!: real_le_rsqrt setsum_ge_element assms)

lemma norm_Pair_le:
  shows "norm (x, y) \<le> norm x + norm y"
  unfolding norm_Pair
  by (metis norm_ge_zero sqrt_sum_squares_le_sum)

subsection {* Continuity *}

lemma continuous_on_fst[continuous_intros]: "continuous_on X fst"
  unfolding continuous_on_def
  by (intro ballI tendsto_intros)

lemma continuous_on_snd[continuous_intros]: "continuous_on X snd"
  unfolding continuous_on_def
  by (intro ballI tendsto_intros)

lemma continuous_at_fst[continuous_intros]:
  fixes x::"'a::euclidean_space \<times> 'b::euclidean_space"
  shows "continuous (at x) fst"
  unfolding continuous_def netlimit_at
  by (intro tendsto_intros)

lemma continuous_at_snd[continuous_intros]:
  fixes x::"'a::euclidean_space \<times> 'b::euclidean_space"
  shows "continuous (at x) snd"
  unfolding continuous_def netlimit_at
  by (intro tendsto_intros)

lemma continuous_at_Pair[continuous_intros]:
  fixes x::"'a::euclidean_space \<times> 'b::euclidean_space"
  assumes "continuous (at x) f"
  assumes "continuous (at x) g"
  shows "continuous (at x) (\<lambda>x. (f x, g x))"
  using assms unfolding continuous_def
  by (intro tendsto_intros)

lemma continuous_on_Pair[continuous_intros]:
  assumes "continuous_on S f"
  assumes "continuous_on S g"
  shows "continuous_on S (\<lambda>x. (f x, g x))"
  using assms unfolding continuous_on_def
  by (auto intro: tendsto_intros)

lemma continuous_Sigma:
  assumes defined: "y \<in> Pi T X"
  assumes f_cont: "continuous_on (Sigma T X) f"
  assumes y_cont: "continuous_on T y"
  shows "continuous_on T (\<lambda>x. f (x, y x))"
  using continuous_on_compose2[OF continuous_on_subset[where t="(\<lambda>x. (x, y x)) ` T", OF f_cont]
                                  continuous_on_Pair[OF continuous_on_id y_cont]] defined
  by auto

subsection {* Differentiability *}

lemma differentiable_Pair [simp]:
  "f differentiable at x within s \<Longrightarrow> g differentiable at x within s \<Longrightarrow> (\<lambda>x. (f x, g x)) differentiable at x within s"
  unfolding differentiable_def by (blast intro: has_derivative_Pair)

lemma (in bounded_linear)
  differentiable:
  assumes "g differentiable (at x within s)"
  shows " (\<lambda>x. f (g x)) differentiable (at x within s)"
  using assms[simplified frechet_derivative_works]
  by (intro differentiableI) (rule has_derivative)

lemmas
  differentiable_mult_right[intro] = bounded_linear.differentiable[OF bounded_linear_mult_right] and
  differentiable_mult_left[intro] = bounded_linear.differentiable[OF bounded_linear_mult_left] and
  differentiable_inner_right[intro] = bounded_linear.differentiable[OF bounded_linear_inner_right] and
  differentiable_inner_left[intro] = bounded_linear.differentiable[OF bounded_linear_inner_left]

lemma (in bounded_bilinear)
  differentiable:
  assumes f: "f differentiable at x within s" and g: "g differentiable at x within s"
  shows "(\<lambda>x. prod (f x) (g x)) differentiable at x within s"
  using assms[simplified frechet_derivative_works]
  by (intro differentiableI) (rule FDERIV)

lemmas
  differentiable_mult[intro] = bounded_bilinear.differentiable[OF bounded_bilinear_mult] and
  differentiable_scaleR[intro] = bounded_bilinear.differentiable[OF bounded_bilinear_scaleR]

lemma differentiable_transform_within_weak:
  assumes "x \<in> s" "\<And>x'. x'\<in>s \<Longrightarrow> g x' = f x'" "f differentiable at x within s"
  shows "g differentiable at x within s"
  using assms by (intro differentiable_transform_within[OF zero_less_one, where g=g]) auto

lemma differentiable_compose_at:
  "f differentiable (at x) \<Longrightarrow> g differentiable (at (f x)) \<Longrightarrow> (\<lambda>x. g (f x)) differentiable (at x)"
  unfolding o_def[symmetric]
  by (rule differentiable_chain_at)

lemma differentiable_compose_within:
  "f differentiable (at x within s) \<Longrightarrow> g differentiable (at(f x) within (f ` s)) \<Longrightarrow>
  (\<lambda>x. g (f x)) differentiable (at x within s)"
  unfolding o_def[symmetric]
  by (rule differentiable_chain_within)

lemma differentiable_setsum[intro, simp]:
  assumes "finite s" "\<forall>a\<in>s. (f a) differentiable net"
  shows "(\<lambda>x. setsum (\<lambda>a. f a x) s) differentiable net"
proof-
 guess f' using bchoice[OF assms(2)[unfolded differentiable_def]] ..
 thus ?thesis unfolding differentiable_def apply-
   apply(rule,rule has_derivative_setsum[where f'=f'])
   by auto
qed

subsection {* Derivatives *}

lemma has_derivative_singletonI: "bounded_linear g \<Longrightarrow> (f has_derivative g) (at x within {x})"
  by (rule has_derivativeI_sandwich[where e=1]) (auto intro!: bounded_linear_scaleR_left)

lemma vector_derivative_eq_rhs: "(f has_vector_derivative f') F \<Longrightarrow> f' = g' \<Longrightarrow> (f has_vector_derivative g') F"
  by simp

lemma has_derivative_transform:
  assumes "x \<in> s" "\<And>x. x \<in> s \<Longrightarrow> g x = f x"
  assumes "(f has_derivative f') (at x within s)"
  shows "(g has_derivative f') (at x within s)"
  using assms by (intro has_derivative_transform_within[OF zero_less_one, where g=g]) auto

lemma has_derivative_If_in_closed:
  assumes f':"\<And>x. x \<in> s \<Longrightarrow> (f has_derivative f' x) (at x within s)"
  assumes g':"\<And>x. x \<in> t \<Longrightarrow> (g has_derivative g' x) (at x within t)"
  assumes connect: "\<And>x. x \<in> s \<inter> t \<Longrightarrow> f x = g x" "\<And>x. x \<in> s \<inter> t \<Longrightarrow> f' x = g' x"
  assumes "closed t" "closed s" "x \<in> s \<union> t"
  shows "((\<lambda>x. if x \<in> s then f x else g x) has_derivative (if x \<in> s then f' x else g' x)) (at x within (s \<union> t))"
  (is "(?if has_derivative ?if') _")
  unfolding has_derivative_within
proof (safe intro!: tendstoI)
  fix e::real assume "0 < e"
  let ?D = "\<lambda>x f f' y. (1 / norm (y - x)) *\<^sub>R (f y - (f x + f' (y - x)))"
  have f': "x \<in> s \<Longrightarrow> ((?D x f (f' x)) ---> 0) (at x within s)"
    and g': "x \<in> t \<Longrightarrow> ((?D x g (g' x)) ---> 0) (at x within t)"
    using f' g' by (auto simp: has_vector_derivative_def has_derivative_within)
  let ?thesis = "eventually (\<lambda>y. dist (?D x ?if ?if' y) 0 < e) (at x within s \<union> t)"
  {
    assume "x \<in> s" "x \<in> t"
    from tendstoD[OF f'[OF `x \<in> s`] `0 < e`] tendstoD[OF g'[OF `x \<in> t`] `0 < e`]
    have ?thesis unfolding eventually_at_filter
      by eventually_elim (insert `x \<in> s` `x \<in> t`, auto simp: connect)
  } moreover {
    assume "x \<in> s" "x \<notin> t"
    hence "eventually (\<lambda>x. x \<in> - t) (at x within s \<union> t)" using `closed t`
      by (intro topological_tendstoD) (auto intro: tendsto_ident_at)
    with tendstoD[OF f'[OF `x \<in> s`] `0 < e`] have ?thesis unfolding eventually_at_filter
      by eventually_elim (insert `x \<in> s` `x \<notin> t`, auto simp: connect)
  } moreover {
    assume "x \<notin> s" hence "x \<in> t" using assms by auto
    have "eventually (\<lambda>x. x \<in> - s) (at x within s \<union> t)" using `closed s` `x \<notin> s`
      by (intro topological_tendstoD) (auto intro: tendsto_ident_at)
    with tendstoD[OF g'[OF `x \<in> t`] `0 < e`] have ?thesis unfolding eventually_at_filter
      by eventually_elim (insert `x \<in> t` `x \<notin> s`, auto simp: connect)
  } ultimately show ?thesis by blast
qed (insert assms, auto intro!: has_derivative_bounded_linear f' g')

lemma linear_continuation:
  assumes f':"\<And>x. x \<in> {a .. b} \<Longrightarrow> (f has_vector_derivative f' x) (at x within {a .. b})"
  assumes g':"\<And>x. x \<in> {b .. c} \<Longrightarrow> (g has_vector_derivative g' x) (at x within {b .. c})"
  assumes connect: "f b = g b" "f' b = g' b"
  assumes x: "x \<in> {a .. c}"
  assumes abc:"a \<le> b" "b \<le> c"
  shows "((\<lambda>x. if x \<le> b then f x else g x) has_vector_derivative
  (\<lambda>x. if x \<le> b then f' x else g' x) x) (at x within {a .. c})"
  (is "(?h has_vector_derivative ?h' x) _")
proof -
  have un: "{a .. b} \<union> {b .. c} = {a .. c}" using assms by auto
  note has_derivative_If_in_closed[derivative_intros]
  note f'[simplified has_vector_derivative_def, derivative_intros]
  note g'[simplified has_vector_derivative_def, derivative_intros]
  have if': "((\<lambda>x. if x \<in> {a .. b} then f x else g x) has_vector_derivative
    (\<lambda>x. if x \<le> b then f' x else g' x) x) (at x within {a .. b}\<union>{b .. c})"
    unfolding has_vector_derivative_def
    using assms
    apply -
    apply (rule derivative_eq_intros refl | assumption)+
    apply auto
    done
  show ?thesis
    unfolding has_vector_derivative_def
    by (rule has_derivative_transform[OF x _ if'[simplified un has_vector_derivative_def]]) simp
qed

lemma exists_linear_continuation:
  assumes f':"\<And>x. x \<in> {a .. b} \<Longrightarrow> (f has_vector_derivative f' x) (at x within {a .. b})"
  shows "\<exists>fc. (\<forall>x. x \<in> {a .. b} \<longrightarrow> (fc has_vector_derivative f' x) (at x)) \<and>
    (\<forall>x. x \<in> {a .. b} \<longrightarrow> fc x = f x)"
proof (rule, safe)
  fix x assume "x \<in> {a .. b}" hence "a \<le> b" by simp
  let ?line = "\<lambda>a x. f a + (x - a) *\<^sub>R f' a"
  let ?fc = "(\<lambda>x. if x \<in> {a .. b} then f x else if x \<in> {..a} then ?line a x else ?line b x)"
  have [simp]:
    "\<And>x. x \<in> {a .. b} \<Longrightarrow> (b \<le> x \<longleftrightarrow> x = b)" "\<And>x. x \<in> {a .. b} \<Longrightarrow> (x \<le> a \<longleftrightarrow> x = a)"
    "\<And>x. x \<le> a \<Longrightarrow> (b \<le> x \<longleftrightarrow> x = b)" using `a \<le> b` by auto
  note has_derivative_If_in_closed[derivative_intros] f'[simplified has_vector_derivative_def, derivative_intros]
  have "(?fc has_vector_derivative f' x) (at x within {a .. b} \<union> ({..a} \<union> {b..}))"
    using `x \<in> {a .. b}` `a \<le> b`
    by (auto intro!: derivative_eq_intros simp: has_vector_derivative_def
      simp del: atMost_iff atLeastAtMost_iff)
  moreover have "{a .. b} \<union> ({..a} \<union> {b..}) = UNIV" by auto
  ultimately show "(?fc has_vector_derivative f' x) (at x)" by simp
  show "?fc x = f x" using `x \<in> {a .. b}` by simp
qed

lemma Pair_has_vector_derivative:
  assumes f: "(f has_vector_derivative f') (at x within s)"
      and g: "(g has_vector_derivative g') (at x within s)"
  shows "((\<lambda>x. (f x, g x)) has_vector_derivative (f', g')) (at x within s)"
  using assms by (auto simp: has_vector_derivative_def intro!: derivative_eq_intros)

lemma has_vector_derivative_imp:
  assumes "x \<in> s"
  assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
  assumes f'g':"f' = g'"
  assumes "x = y" "s = t"
  assumes f': "(f has_vector_derivative f') (at x within s)"
  shows "(g has_vector_derivative g') (at y within t)"
  unfolding has_vector_derivative_def has_derivative_within'
proof (safe)
  fix e::real
  assume "0 < e"
  with assms f' have "\<exists>d>0. \<forall>x'\<in>s.
    0 < norm (x' - x) \<and> norm (x' - x) < d \<longrightarrow>
    norm (g x' - g y - (x' - y) *\<^sub>R g') / norm (x' - x) < e"
    by (auto simp add: has_vector_derivative_def has_derivative_within')
  then guess d ..
  with assms show "\<exists>d>0. \<forall>x'\<in>t. 0 < norm (x' - y) \<and> norm (x' - y) < d \<longrightarrow>
    norm (g x' - g y - (x' - y) *\<^sub>R g') / norm (x' - y) < e"
    by auto
next
  show "bounded_linear (\<lambda>x. x *\<^sub>R g')"
    using has_derivative_bounded_linear[OF f'[simplified has_vector_derivative_def], simplified f'g'] assms
    by simp
qed

lemma has_vector_derivative_cong:
  assumes "x \<in> s"
  assumes "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
  assumes f'g':"f' = g'"
  assumes "x = y" "s = t"
  shows "(g has_vector_derivative g') (at y within t) =
  (f has_vector_derivative f') (at x within s)"
proof
  assume "(f has_vector_derivative f') (at x within s)"
  from has_vector_derivative_imp this assms
  show "(g has_vector_derivative g') (at y within t)"
    by blast
next
  assume g': "(g has_vector_derivative g') (at y within t)"
  show "(f has_vector_derivative f') (at x within s)"
    using assms g'
    by (intro has_vector_derivative_imp[where f=g and g=f and f'=g' and g'=f'])
      auto
qed

lemma has_derivative_within_union:
  assumes "(f has_derivative g) (at x within s)"
  assumes "(f has_derivative g) (at x within t)"
  shows  "(f has_derivative g) (at x within (s \<union> t))"
proof cases
  assume "at x within (s \<union> t) = bot"
  thus ?thesis using assms by (simp_all add: has_derivative_def)
next
  assume st: "at x within (s \<union> t) \<noteq> bot"
  thus ?thesis
    using assms
    apply (auto simp: Lim_within_union has_derivative_def)
    apply (cases "at x within s = bot", simp_all add: netlimit_within)
    apply (cases "at x within t = bot", simp_all add: netlimit_within)
    done
qed

lemma has_vector_derivative_within_union:
  assumes "(f has_vector_derivative g) (at x within s)"
  assumes "(f has_vector_derivative g) (at x within t)"
  shows  "(f has_vector_derivative g) (at x within (s \<union> t))"
using assms
by (auto simp: has_vector_derivative_def intro: has_derivative_within_union)

lemma vector_derivative_within_closed_interval:
  fixes f::"real \<Rightarrow> 'a::euclidean_space"
  assumes "a < b" and "x \<in> {a .. b}"
  assumes "(f has_vector_derivative f') (at x within {a .. b})"
  shows "vector_derivative f (at x within {a .. b}) = f'"
  apply(rule vector_derivative_unique_within_closed_interval)
  using vector_derivative_works[unfolded differentiable_def]
  using assms by (auto simp add: has_vector_derivative_def)

text {* TODO: include this into the attribute DERIV-intros?! *}

lemma DERIV_compose_FDERIV:
  fixes f::"real\<Rightarrow>real"
  assumes "DERIV f (g x) :> f'"
  assumes "(g has_derivative g') (at x within s)"
  shows "((\<lambda>x. f (g x)) has_derivative (\<lambda>x. g' x * f')) (at x within s)"
  using assms has_derivative_compose[of g g' x s f "op * f'"]
  by (auto simp: has_field_derivative_def ac_simps)

lemmas has_derivative_sin[derivative_intros] = DERIV_sin[THEN DERIV_compose_FDERIV]
  and  has_derivative_cos[derivative_intros] = DERIV_cos[THEN DERIV_compose_FDERIV]
  and  has_derivative_exp[derivative_intros] = DERIV_exp[THEN DERIV_compose_FDERIV]
  and  has_derivative_ln[derivative_intros] = DERIV_ln[THEN DERIV_compose_FDERIV]

lemma has_derivative_continuous_on:
  "(\<And>x. x \<in> s \<Longrightarrow> (f has_derivative f' x) (at x within s)) \<Longrightarrow> continuous_on s f"
  by (auto intro!: differentiable_imp_continuous_on differentiableI simp: differentiable_on_def)

lemma taylor_up_within:
  assumes INIT: "n>0" "\<And>t. t \<in> {a .. b} \<Longrightarrow> diff 0 t = f t"
  and DERIV: "\<And>m t. m < n \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
    ((diff m) has_vector_derivative (diff (Suc m) t)) (at t within {a .. b})"
  and INTERV: "a \<le> c" "c < b"
  shows "\<exists>t. c < t & t < b &
    f b = (\<Sum>m<n. (diff m c / real (fact m)) * (b - c)^m)+
      (diff n t / real (fact n)) * (b - c)^n" (is "?taylor f diff")
proof -
  from exists_linear_continuation[of a b, OF DERIV]
  have "\<forall>m. \<exists>d'. m < n \<longrightarrow>
    (\<forall>x \<in> {a .. b}. (d' has_vector_derivative diff (Suc m) x) (at x) \<and> d' x = diff m x)"
    by (metis atLeastAtMost_iff)
  then guess d' unfolding choice_iff .. note d' = this
  let ?diff = "\<lambda>m. if m = n then diff m else d' m"
  have "?taylor (?diff 0) ?diff" using d'
    by (intro taylor_up[OF _ _ _ `a \<le> c`])
       (auto simp: has_field_derivative_def has_vector_derivative_def INIT INTERV mult_commute_abs)
  thus "?taylor f diff" using d' INTERV INIT by auto
qed

lemma taylor_up_within_vector:
  fixes f::"real \<Rightarrow> 'a::euclidean_space"
  assumes INIT: "n>0" "\<And>t. t \<in> {a .. b} \<Longrightarrow> diff 0 t = f t"
  and DERIV: "\<And>m t. m < n \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
    ((diff m) has_vector_derivative (diff (Suc m) t)) (at t within {a .. b})"
  and INTERV: "a \<le> c" "c < b"
  shows "\<exists>t. (\<forall>i\<in>Basis::'a set. c < t i & t i < b) \<and>
    f b = setsum (%m. (b - c)^m *\<^sub>R (diff m c /\<^sub>R real (fact m))) {..<n} +
      setsum (\<lambda>x. (((b - c) ^ n *\<^sub>R diff n (t x) /\<^sub>R real (fact n)) \<bullet> x) *\<^sub>R x) Basis"
proof -
  obtain t where t: "\<forall>i\<in>Basis::'a set. t i > c \<and> t i < b \<and>
    f b \<bullet> i =
      (\<Sum>m<n. diff m c \<bullet> i / real (fact m) * (b - c) ^ m) +
      diff n (t i) \<bullet> i / real (fact n) * (b - c) ^ n"
  proof (atomize_elim, rule bchoice, safe)
    fix i::'a
    assume "i \<in> Basis"
    have DERIV_0: "\<And>t. t \<in> {a .. b} \<Longrightarrow> (diff 0) t \<bullet> i = f t \<bullet> i" using INIT by simp
    have DERIV_Suc: "\<And>m t. m < n \<Longrightarrow> a \<le> t \<Longrightarrow> t \<le> b \<Longrightarrow>
      ((\<lambda>t. (diff m) t \<bullet> i) has_vector_derivative (diff (Suc m) t \<bullet> i)) (at t within {a .. b})"
      using DERIV by (auto intro!: derivative_eq_intros simp: has_vector_derivative_def)
    from taylor_up_within[OF INIT(1) DERIV_0 DERIV_Suc INTERV]
    show "\<exists>t>c. t < b \<and> f b \<bullet> i =
      (\<Sum>m<n. diff m c \<bullet> i / real (fact m) * (b - c) ^ m) +
      diff n t \<bullet> i / real (fact n) * (b - c) ^ n" by simp
  qed
  have "f b = (\<Sum>i\<in>Basis. (f b \<bullet> i) *\<^sub>R i)" by (rule euclidean_representation[symmetric])
  also have "\<dots> =
      (\<Sum>i\<in>Basis. ((\<Sum>m<n. (b - c) ^ m *\<^sub>R (diff m c /\<^sub>R real (fact m))) \<bullet> i) *\<^sub>R i) +
      (\<Sum>x\<in>Basis. (((b - c) ^ n *\<^sub>R diff n (t x) /\<^sub>R real (fact n)) \<bullet> x) *\<^sub>R x)"
    using t by (simp add: setsum.distrib inner_setsum_left inverse_eq_divide algebra_simps)
  finally show ?thesis using t by (auto simp: euclidean_representation)
qed

subsection {* Integration *}

lemmas content_real[simp]

lemma integral_real_singleton[simp]:
  "integral {a::real} f = 0"
  using integral_refl[of a f] by simp
lemmas integrable_continuous[intro, simp]
  and integrable_continuous_real[intro, simp]

lemma mvt_integral:
  fixes f::"'a::euclidean_space\<Rightarrow>'b::euclidean_space"
  assumes f'[derivative_intros]: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
  assumes f'_cont: "\<And>i. i \<in> Basis \<Longrightarrow> continuous_on S (\<lambda>t. f' t i)"
  assumes line_in: "\<And>t. t \<in> {0..1} \<Longrightarrow> x + t *\<^sub>R y \<in> S"
  shows "f (x + y) - f x = integral {0..1} (\<lambda>t. f' (x + t *\<^sub>R y) y)" (is ?th1)
   and  "f (x + y) - f x = (\<Sum>a\<in>Basis. (y \<bullet> a) *\<^sub>R integral {0..1} (\<lambda>t. f' (x + t *\<^sub>R y) a))" (is ?th2)
proof -
  from assms have subset: "(\<lambda>xa. x + xa *\<^sub>R y) ` {0..1} \<subseteq> S" by auto
  note has_derivative_subset[OF _ subset, derivative_intros]
  note has_derivative_in_compose[where f="(\<lambda>xa. x + xa *\<^sub>R y)" and g = f, derivative_intros]
  note continuous_on_compose2[where f="(\<lambda>xa. x + xa *\<^sub>R y)", continuous_intros]
  note continuous_on_subset[OF _ subset, continuous_intros]
  have "\<And>t. t \<in> {0..1} \<Longrightarrow>
    ((\<lambda>t. f (x + t *\<^sub>R y)) has_vector_derivative f' (x + t *\<^sub>R y) y) (at t within {0..1})"
    using assms
    by (auto simp: has_vector_derivative_def linear_cmul[OF has_derivative_linear[OF f'], symmetric]
      intro!: derivative_eq_intros)
  from fundamental_theorem_of_calculus[rule_format, OF _ this]
  show ?th1
    by (auto intro!: integral_unique[symmetric])

  also have "integral {0..1} (\<lambda>t. f' (x + t *\<^sub>R y) y) =
    integral {0..1} (\<lambda>t. (\<Sum>i\<in>Basis. (f' (x + t *\<^sub>R y) y \<bullet> i) *\<^sub>R i))"
    by (simp add: euclidean_representation)
  also have "\<dots> = integral {0..1}
     (\<lambda>t. \<Sum>i\<in>Basis. (y \<bullet> i) *\<^sub>R (f' (x + t *\<^sub>R y) i))"
  proof (rule integral_spike[OF negligible_empty], safe)
    fix t::real assume t: "t \<in> {0 .. 1}"
    have "(\<Sum>i\<in>Basis. (y \<bullet> i) *\<^sub>R f' (x + t *\<^sub>R y) i) =
      (\<Sum>i\<in>Basis. \<Sum>a\<in>Basis. (y \<bullet> a) *\<^sub>R (f' (x + t *\<^sub>R y) a \<bullet> i) *\<^sub>R i)"
      by (subst setsum.commute[symmetric])
        (simp only: scaleR_setsum_right[symmetric] euclidean_representation)
    also have "\<dots> = (\<Sum>i\<in>Basis. (f' (x + t *\<^sub>R y) y \<bullet> i) *\<^sub>R i)"
      by (subst Derivative.linear_componentwise[OF has_derivative_linear[OF f'], OF line_in[OF t]])
        (simp add: scaleR_setsum_left)
    finally
    show "(\<Sum>i\<in>Basis. (y \<bullet> i) *\<^sub>R f' (x + t *\<^sub>R y) i) = (\<Sum>i\<in>Basis. (f' (x + t *\<^sub>R y) y \<bullet> i) *\<^sub>R i)" .
  qed
  also have "\<dots> = (\<Sum>a\<in>Basis. integral {0..1} (\<lambda>t. (y \<bullet> a) *\<^sub>R f' (x + t *\<^sub>R y) a))"
    by (subst integral_setsum) (auto intro!: continuous_intros f'_cont)
  also have "\<dots> = (\<Sum>a\<in>Basis. (y \<bullet> a) *\<^sub>R integral {0..1} (\<lambda>t. f' (x + t *\<^sub>R y) a))"
    using assms
    by (intro setsum.cong[OF refl], subst integral_cmul)
      (auto intro!: continuous_intros f'_cont simp: integral_cmul)
  finally show ?th2 .
qed

subsection {* conditionally complete lattice *}

lemma bounded_imp_bdd_above: "bounded S \<Longrightarrow> bdd_above (S :: 'a::ordered_euclidean_space set)"
  by (auto intro: bdd_above_mono dest!: bounded_subset_cbox)

lemma bounded_imp_bdd_below: "bounded S \<Longrightarrow> bdd_below (S :: 'a::ordered_euclidean_space set)"
  by (auto intro: bdd_below_mono dest!: bounded_subset_cbox)

lemma bdd_above_cmult:
  "0 \<le> (a :: 'a :: ordered_semiring) \<Longrightarrow> bdd_above S \<Longrightarrow> bdd_above ((\<lambda>x. a * x) ` S)"
  by (metis bdd_above_def bdd_aboveI2 mult_left_mono)

lemma Sup_real_mult:
  fixes a::real
  assumes "0 \<le> a"
  assumes "S \<noteq> {}" "bdd_above S"
  shows "a * Sup S = Sup ((\<lambda>x. a * x) ` S)"
  using assms
proof cases
  assume "a = 0" with `S \<noteq> {}` show ?thesis
    by (simp add: cSUP_const)
next
  assume "a \<noteq> 0"
  with `0 \<le> a` have "0 < a"
    by simp
  show ?thesis
  proof (intro antisym)
    have "Sup S \<le> Sup (op * a ` S) / a" using assms
      by (intro cSup_least mult_imp_le_div_pos cSup_upper)
         (auto simp: bdd_above_cmult assms `0 < a` less_imp_le)
    thus "a * Sup S \<le> Sup (op * a ` S)"
      by (simp add: ac_simps pos_le_divide_eq[OF `0<a`])
  qed (insert assms `0 < a`, auto intro!: cSUP_least cSup_upper)
qed

subsection {* Linorder *}

context linordered_idom
begin

lemma mult_right_le_one_le:
  "0 \<le> x \<Longrightarrow> y \<le> 1 \<Longrightarrow> x * y \<le> x"
  by (auto simp add: mult_le_cancel_left2)

lemma mult_left_le_one_le:
  "0 \<le> x \<Longrightarrow> y \<le> 1 \<Longrightarrow> y * x \<le> x"
  by (auto simp add: mult_le_cancel_right2)

end

subsection {* Banach on type class *}

lemma banach_fix_type:
  fixes f::"'a::complete_space\<Rightarrow>'a"
  assumes c:"0 \<le> c" "c < 1"
      and lipschitz:"\<forall>x. \<forall>y. dist (f x) (f y) \<le> c * dist x y"
  shows "\<exists>!x. (f x = x)"
  using assms banach_fix[OF complete_UNIV UNIV_not_empty assms(1,2) subset_UNIV, of f]
  by auto

subsection {* Float *}

definition "trunc p s =
  (let d = truncate_down p s in
  let u = truncate_up p s in
  let ed = abs (s - d) in
  let eu = abs (u - s) in
  if abs (s - d) < abs (u - s) then (d, truncate_up p ed) else (u, truncate_up p eu))"

lemma trunc_nonneg: "0 \<le> s \<Longrightarrow> 0 \<le> trunc p s"
  by (auto simp: trunc_def Let_def zero_prod_def truncate_down_def round_down_nonneg
    intro!: truncate_up_le)

definition "trunc_err p f = f - (fst (trunc p f))"

lemma trunc_err_eq:
  "fst (trunc p f) + (trunc_err p f) = f"
  by (auto simp: trunc_err_def)

lemma trunc_err_le:
  "abs (trunc_err p f) \<le> snd (trunc p f)"
  apply (auto simp: trunc_err_def trunc_def Let_def)
  apply (metis truncate_up)
  by (metis abs_minus_commute truncate_up)

lemma trunc_err_eq_zero_iff:
  "trunc_err p f = 0 \<longleftrightarrow> snd (trunc p f) = 0"
  apply (auto simp: trunc_err_def trunc_def Let_def)
  apply (metis abs_le_zero_iff eq_iff_diff_eq_0 truncate_up)
  apply (metis abs_le_zero_iff eq_iff_diff_eq_0 truncate_up)
  done

lemma mantissa_Float_0[simp]: "mantissa (Float 0 e) = 0"
  by (metis float_of_real float_zero mantissa_eq_zero_iff zero_float_def)

subsection {* Lists *}

lemma listsum_nonneg:
  assumes nn: "(\<And>x. x \<in> set xs \<Longrightarrow> f x \<ge> (0::'a::{monoid_add, ordered_ab_semigroup_add}))"
  shows "0 \<le> listsum (map f xs)"
proof -
  have "0 = listsum (map (\<lambda>_. 0) xs)"
    by (induct xs) auto
  also have "\<dots> \<le> listsum (map f xs)"
    by (rule listsum_mono) (rule assms)
  finally show ?thesis .
qed

subsection {* Set(sum) *}

lemma setsum_eq_nonzero: "finite A \<Longrightarrow> (\<Sum>a\<in>A. f a) = (\<Sum>a\<in>{a\<in>A. f a \<noteq> 0}. f a)"
  by (subst setsum.mono_neutral_cong_right) auto

lemma singleton_subsetI:"i \<in> B \<Longrightarrow> {i} \<subseteq> B"
  by auto

subsection {* Max *}

lemma max_transfer[transfer_rule]:
  assumes [transfer_rule]: "(rel_fun A (rel_fun A (op =))) (op \<le>) (op \<le>)"
  shows "(rel_fun A (rel_fun A A)) max max"
  unfolding max_def[abs_def]
  by transfer_prover

lemma max_power2: fixes a b::real shows "(max (abs a) (abs b))\<^sup>2 = max (a\<^sup>2) (b\<^sup>2)"
  by (auto simp: max_def real_abs_le_square_iff)

end


theory Exercises
imports Main
begin

text \<open> Exercise 5.1 \<close>

lemma
  assumes T: "\<forall> x y. T x y \<or> T y x"
  and A: "\<forall> x y. A x y \<and> A y x \<longrightarrow> x = y"
  and TA: "\<forall> x y. T x y \<longrightarrow> A x y"
  and AA: "A x y"
shows "T x y"
proof(rule ccontr)
  assume a1:"\<not> T x y"
  from this and T have a2:"T y x" by blast
  from this and TA have "A y x" by blast
  from this and A and AA have "x = y" by blast
  from this and a1 and a2 show "False" by blast
qed

text \<open> A more direct solution...
proof(cases)
  assume a1:"T y x"
  from this and TA have "A y x" by auto
  from this and AA and A have a2:"x = y" by auto
  from this and a1 show "T x y" by simp
next
  assume a1:"\<not> T y x"
  from this and T show "T x y" by auto
qed
\<close>

text \<open> End of exercise 5.1 \<close>

text \<open> Exercise 5.2 \<close>

lemma "(\<exists> ys zs. xs = ys @ zs \<and> length ys = length zs)
\<or> (\<exists> ys zs. xs = ys @ zs \<and> length ys = length zs + 1)"
proof(cases)
  assume "2 dvd (length xs)"
  from this obtain k where l_xs:"length xs = 2*k" by(auto simp add: dvd_def)
  from this obtain ys where tys:"ys = take k xs" by(auto)
  from this obtain zs where dzs:"zs = drop k xs" by(auto)
  from this have l1:"length ys = k" using l_xs and tys by(auto)
  from this have f1:"xs = ys @ zs" using tys and dzs by(metis append_eq_conv_conj)
  from this have f2:"length ys = length zs" using l_xs and l1 by(auto)
  then show ?thesis using f1 and f2 by(auto)
next
  assume " \<not> 2 dvd (length xs)"
  from this have "\<exists> k. (length xs) = 2*k + 1" by(arith)
  from this obtain k where l_xs:"(length xs) = 2*k + 1" by(auto)
  from this obtain ys where tys:"ys = take (Suc k) xs" by(auto)
  from this obtain zs where dzs:"zs = drop (Suc k) xs" by(auto)
  from this have "length ys = Suc k" using l_xs and tys by(auto)
  from this have f1:"xs = ys @ zs" using tys and dzs by(metis append_eq_conv_conj)
  from this have f2:"length ys = length zs + 1" using l_xs and tys and dzs by(auto)
  then show ?thesis using f1 and f2 by(auto)
qed

text \<open> End of Exercise 5.2 \<close>

text \<open> Exercise 5.3 \<close>

inductive ev :: "nat \<Rightarrow> bool" where
ev0: "ev 0" |
evSS: "ev n \<Longrightarrow> ev(Suc(Suc n))"

lemma assumes a: "ev (Suc(Suc n))" shows "ev n"
proof -
  show "ev n" using a
  proof cases
    case evSS thus "ev n"  by (simp add: ev.evSS)
  qed
qed

text \<open> End of Exercise 5.3 \<close>

text \<open> End of Exercise 5.4 \<close>

lemma "\<not> ev (Suc (Suc (Suc 0)))" (is "\<not> ?P")
proof
 assume "?P"
 from this have "ev (Suc 0)" by (cases)
 from this show  False by (cases)
qed

text \<open> End of Exercise 5.4 \<close>


theory Najveci_zajednicki_delilac
  imports Main begin

fun gcd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "gcd m n = (if n = 0 then m else gcd n (m mod n))"

(*
   U daljim dokazima, gde je bilo potrebno nesto dokazati preko indukcije,
   lakse mi je bilo da to dokazem koristeci funkciju gcd_prim,
   zbog toga imam dve funkcije koje rade istu stvar.
*)

fun gcd_prim :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "gcd_prim m 0 = m" |
  "gcd_prim m n = gcd_prim n (m mod n)"

(* Euklidov algoritam *)

(* gcd za n = 0 i n > 0*)
lemma gcd_0 [simp]: "gcd m 0 = m"
  using gcd.simps(1)
  by simp

lemma gcd_ne_0 [simp]: "0 < n \<Longrightarrow> gcd m n = gcd n (m mod n)"
  using gcd.simps
  by simp

declare gcd.simps [simp del]

(* Dokaz da broj koji deli m i deli n, deli i njihov nzd  *)
lemma deli_oba_deli_gcd: "\<forall> d. d dvd m \<and> d dvd n \<longrightarrow> d dvd (gcd_prim m n)"
proof (induction m n rule: gcd_prim.induct)
  case (1 m) (* \<forall>d. d dvd m \<and> d dvd 0 \<longrightarrow> d dvd gcd_prim m 0 *)
  then show ?case
  proof (cases "n = 0")
    case True
    then show ?thesis
      using gcd_prim.simps(1)
      by simp
  next
    case False
    then show ?thesis
      using gcd_prim.simps(2)
      by simp
  qed
next
  case (2 m v)
 then show ?case (*d dvd Suc v \<and> d dvd m mod Suc v \<longrightarrow> d dvd gcd_prim (Suc v) (m mod Suc v) *)
   by (simp add: dvd_mod)
qed

thm dvd_mod (* ako neki broj deli m i n, deli i njihov ostatak *)
thm dvd_mod_imp_dvd (* ako neki broj deli ostatak od a i b i deli b, deli i a*)

(* Dokaz da gcd m n deli i m i n *)
lemma gcd_deli_oba [simp]: "(gcd m n) dvd m \<and> (gcd m n) dvd n"
proof(induction m n rule: gcd_prim.induct)
    case (1 m)  (* (nzd m 0) dvd m \<and> (nzd m 0) dvd 0, a imamo "nzd m 0 = m" iz fun nzd \<Rightarrow> m dvd m \<and> m dvd 0 *)
    then show ?case by simp
  next
    case (2 m v)
    then show ?case using dvd_mod_imp_dvd by auto
  qed

  thm gcd_dvd1 (* gcd a b deli a*)

lemmas gcd_dvd1 [iff] = gcd_deli_oba [THEN conjunct1] (* gcd m n deli m *)
lemmas gcd_dvd2 [iff] = gcd_deli_oba [THEN conjunct2] (* gcd m n deli n *)

(* Maksimalnost: "Za sve m, n, d, ako d deli m i ako d deli n onda d deli njihov nzd." *)
lemma gcd_najveci_zajednicki_prim [rule_format]:  "d dvd m \<longrightarrow> d dvd n \<longrightarrow> d dvd (gcd_prim m n)"
proof (induction m n rule: gcd_prim.induct)
  case (1 m)
  then show ?case
  proof (cases "n = 0")
    case True
    then show ?thesis
      using gcd_prim.simps(1)
      by simp
  next
    case False
    then show ?thesis
      using gcd_prim.simps(2)
      by simp
  qed
next
  case (2 m v)
 then show ?case (* \<forall>d. d dvd Suc v \<and> d dvd m mod Suc v \<longrightarrow> d dvd gcd_prim (Suc v) (m mod Suc v) *)
   by (simp_all add: dvd_mod)
qed

(*
Termovi se formiraju primenom funkcija na argumente.
Kada na dva terma t1-->t2 primenimo funkciju f, dobijamo f(t1) --> f(t2).

Isabelle moze da razlikuje slucajeve zasnovane na termovima pomocu: apply (case_tac <term>).

Tako i u dokazu naredne leme, kada kazemo apply (case_tac "n=0"), Isabelle deli na dva slucaja
u zavisnosti od toga da li je n = 0 ili n \<noteq> 0:
1. n = 0 \<Longrightarrow> d dvd m \<longrightarrow> d dvd n \<longrightarrow> d dvd gcd m n
2. n \<noteq> 0 \<Longrightarrow> d dvd m \<longrightarrow> d dvd n \<longrightarrow> d dvd gcd m n

dvd_mod - ako k deli m i k deli n, onda k deli i njihov ostatak (tj. m mod n)
*)

(*
Sledeca lema je kao prethodna, ali dokazana na drugi nacin, da bi mogla gcd_najveci_zajednicki_iff da se dok.
Iz predhodne se jasnije vidi dokaz, pa sam je zato ostavila.
*)

(* Maksimalnost: "Za sve m, n, d, ako d deli m i ako d deli n onda d deli njihov nzd." *)
lemma gcd_najveci_zajednicki [rule_format]: "d dvd m \<longrightarrow> d dvd n \<longrightarrow> d dvd gcd m n"
apply (induct_tac m n rule: gcd.induct)
apply (case_tac "n=0")
apply (simp_all add: dvd_mod)
  done

(* Broj koji deli gcd m n, deli m i deli n *)
theorem gcd_najveci_zajednicki_iff [iff]: "(k dvd gcd m n) = (k dvd m \<and> k dvd n)"
  sledgehammer
  by (meson Najveci_zajednicki_delilac.gcd_dvd1 Najveci_zajednicki_delilac.gcd_dvd2 Najveci_zajednicki_delilac.gcd_najveci_zajednicki gcd_nat.trans)

definition is_gcd :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
    "is_gcd p m n == (p dvd m)  \<and>  (p dvd n)  \<and>  (\<forall> d. d dvd m \<and> d dvd n \<longrightarrow> d dvd p)"

(* Funkcija gcd daje najveci zajednicki delilac *)
lemma euklid_nzd_is_gcd:
  shows "is_gcd (gcd m n) m n"
(* Znaci ovo treba pokazati:
"((gcd m n) dvd m) \<and> ((gcd m n) dvd n) \<and> (\<forall>d. d dvd m \<and> d dvd n \<longrightarrow> d dvd (gcd m n))" *)
proof -
  have "(gcd m n) dvd m \<and> (gcd m n) dvd n"
    using gcd_deli_oba by simp
  also have "\<forall>d. d dvd m \<and> d dvd n \<longrightarrow> d dvd (gcd m n)"
    using gcd_deli_oba by simp
 ultimately show "is_gcd (gcd m n) m n"
    by (simp add: is_gcd_def)
qed

value "euklid_nzd_is_gcd 3 3 27"

(* Drugi nacin *)
lemma is_gcd: "is_gcd (gcd m n) m n"
apply (simp add: is_gcd_def gcd_najveci_zajednicki)
  done

(* Jedinstvenost nzd *)
lemma gcd_jedinstven: "is_gcd m a b \<Longrightarrow> is_gcd n a b \<Longrightarrow> m = n" (* za a i b postoji jedinstven nzd m = n *)
apply (simp add: is_gcd_def)
apply (blast intro: dvd_antisym)
  done

(* Asocijativnost nzd *)
lemma gcd_asocijativnost: "gcd (gcd k m) n = gcd k (gcd m n)"
  apply (rule gcd_jedinstven)
  apply (rule is_gcd)
  apply (simp add: is_gcd_def)
  apply (blast intro: dvd_trans)
  done

thm dvd_trans

lemma bezuov_stav [simp]:
  assumes ex: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x = b * y + d \<or> b * x = a * y + d)"
  shows "\<exists>d x y. d dvd a \<and> d dvd a + b \<and> (a * x = (a + b) * y + d \<or> (a + b) * x = a * y + d)"
  using ex
 (*
 sledgehammer
  by (metis add.left_neutral bezout_add_strong_nat gcd_nat.extremum gcd_nat.refl mult.right_neutral mult_0)
*)
  apply clarsimp
  apply (rule_tac x="d" in exI, simp)
  apply (case_tac "a * x = b * y + d", simp_all)
  apply (rule_tac x="x + y" in exI)
  apply (rule_tac x="y" in exI)
  apply algebra
  apply (rule_tac x="x" in exI)
  apply (rule_tac x="x + y" in exI)
  apply algebra
  done

lemma pomocna:
  assumes "is_gcd d a b"
  shows "\<exists>m n. m*a + n*b = d"
  sorry

lemma pomocna_obrnuto:
  assumes "\<exists>m n. m*a + n*b = d"
  shows "is_gcd d a b"
  sorry

(* Dokaz da je nzd (a/d, b/d) = 1, ako su a, b > 0 i d = nzd(a, b). *)
lemma
  fixes d::nat
  assumes "0 < a \<and> 0 < b \<and> is_gcd d a b"
  shows "is_gcd 1 (a div d) (b div d)"
proof-
  have "(gcd a b) dvd a \<and> (gcd a b) dvd b"
          unfolding gcd_deli_oba
          by simp
        hence "\<exists>m n. m*a + n*b = d"
          unfolding pomocna
          using assms pomocna by auto
        hence "\<exists>m n. m*(a div d) + n*(b div d) = 1" sorry
(*          unfolding pomocna
          sledgehammer
          by (metis Euclidean_Division.div_eq_0_iff Nat.add_0_right One_nat_def add.commute add.left_neutral add_Suc_right add_cancel_left_right add_less_cancel_left add_mult_distrib2 assms div_mult_self1_is_m div_mult_self_is_m dividend_less_div_times dividend_less_times_div dvd_add_times_triv_left_iff dvd_add_triv_right_iff dvd_mult_div_cancel dvd_refl gcd_nat.trans is_gcd_def less_add_same_cancel1 mult.assoc mult.commute mult.left_commute mult_0_right mult_cancel1 mult_is_0 mult_zero_right nat.simps(3) nat_0_less_mult_iff nat_add_right_cancel nat_dvd_not_less nat_mult_1 nat_mult_1_right nat_mult_eq_1_iff nat_neq_iff neq0_conv not_less0 plus_nat.add_0 plus_nat.simps(2))
  *)
        hence "is_gcd 1 (a div d) (b div d)"
          unfolding pomocna_obrnuto
          using pomocna_obrnuto by simp
  thus ?thesis
          by simp
qed

(* definicija *)

abbreviation uzajamno_prosti where
  "uzajamno_prosti x y \<equiv> is_gcd 1 x y"

lemma
  fixes n a b :: nat
  assumes "is_gcd 1 a b"
  shows "is_gcd 1 (a*a) (b*b)"
proof-
  have "\<exists>m n. m*a + n*b = 1"
    unfolding pomocna
    using assms pomocna by simp
  hence "\<exists>m n. m*a = 1 - n*b"
    sledgehammer
    by (metis add_diff_cancel_right')
  hence "\<exists>m n. (m*a)^2  = (1 - n*b)^2"
    by simp
  hence "\<exists>m n. m^2 * a^2  = 1 - 2*n*b + n^2*b^2"
    by (metis (no_types, lifting) Suc_1 even_add even_plus_one_iff gcd_jedinstven mult_2 numeral_One one_add_one one_power2 pomocna_obrnuto power_add_numeral power_one_right semiring_norm(2))
  hence "\<exists>m n. 2*n*b - n^2*b^2 = 1 - m^2 * a^2"
       by (metis Suc_eq_plus1 add_cancel_left_left add_cancel_right_left assms id_apply gcd_jedinstven mult_eq_0_iff nat_1_eq_mult_iff of_nat_eq_id pomocna_obrnuto semiring_1_class.of_nat_simps(2) semiring_normalization_rules(4) zero_neq_one)
     hence "\<exists>m n. b^2 * (2*n - n^2*b)^2 = (1 - m^2 * a^2)^2"
       by (metis Suc_eq_plus1 add_cancel_left_left add_cancel_right_left assms id_apply gcd_jedinstven mult_eq_0_iff nat_1_eq_mult_iff of_nat_eq_id pomocna_obrnuto semiring_1_class.of_nat_simps(2) semiring_normalization_rules(4) zero_neq_one)
     hence "\<exists>m n. b^2 * (2*n - n^2*b)^2 = 1 - a * m^2 * a^2 + m^4 * a^4"
       by (metis Suc_eq_plus1 add_cancel_left_left add_cancel_right_left assms id_apply gcd_jedinstven mult_eq_0_iff nat_1_eq_mult_iff of_nat_eq_id pomocna_obrnuto semiring_1_class.of_nat_simps(2) semiring_normalization_rules(4) zero_neq_one)
     hence "\<exists>m n. b^2 * (2*n - n^2*b)^2 + a * m^2 * a^2 - m^4 * a^4 = 1"
       by (metis Suc_eq_plus1 add_cancel_left_left add_cancel_right_left assms id_apply gcd_jedinstven mult_eq_0_iff nat_1_eq_mult_iff of_nat_eq_id pomocna_obrnuto semiring_1_class.of_nat_simps(2) semiring_normalization_rules(4) zero_neq_one)
     hence "\<exists>m n. b^2 * (2*n - n^2*b)^2 + a^2 * (a * m^2 - m^4 * a^2) = 1"
       by (metis Suc_eq_plus1 add_cancel_left_left add_cancel_right_left assms id_apply gcd_jedinstven mult_eq_0_iff nat_1_eq_mult_iff of_nat_eq_id pomocna_obrnuto semiring_1_class.of_nat_simps(2) semiring_normalization_rules(4) zero_neq_one)
     hence "is_gcd 1 (a^2) (b^2)"
       by (metis Suc_eq_plus1 add_cancel_left_left add_cancel_right_left assms id_apply gcd_jedinstven mult_eq_0_iff nat_1_eq_mult_iff of_nat_eq_id pomocna_obrnuto semiring_1_class.of_nat_simps(2) semiring_normalization_rules(4) zero_neq_one)
     thus ?thesis
       by (simp add: semiring_normalization_rules(29))
   qed

(* Ako je gcd(a,n) = 1 \<and> gcd(b,n) = 1, onda je gcd(ab,n) = 1. *)
lemma
  assumes "is_gcd 1 a n \<and> is_gcd 1 b n"
  shows "is_gcd 1 (a*b) n"
proof-
  have *: "\<exists> x y. a*x + n*y = 1"
    unfolding pomocna
    by (metis assms mult.commute pomocna)
  have **: "\<exists> z w. b*z + n*w = 1"
    by (metis assms mult.commute pomocna)
  hence "\<exists> x y z w. (a*x + n*y) * (b*z + n*w) = 1 * 1"
  using "*" "**" by auto
  hence "\<exists> x y z w. a*b*x*z + a*x*n*w + b*z*n*y + (n^2)*y*w = 1 * 1"
  by (metis One_nat_def even_plus_one_iff is_gcd_def mult_eq_1_iff one_add_one pomocna_obrnuto)
  hence "\<exists> x y z w. a*b*(x*z) + n*(a*x*w + b*z*y + n*y*w) = 1"
    by (metis even_plus_one_iff is_gcd_def nat_1_eq_mult_iff one_add_one pomocna_obrnuto)
  hence "is_gcd 1 (a*b) n"
    by (metis mult.commute pomocna_obrnuto)
     thus ?thesis
       by simp
   qed

lemma
  fixes n a b :: nat
  assumes "a dvd (b*c) \<and> is_gcd 1 a b"
  shows "a dvd c"
proof-
  have "\<exists> x y. a*x + b*y = 1"
    by (metis assms mult.commute pomocna)
  have *: "\<exists> x y. a*x*c + b*y*c = 1*c"
    by (metis \<open>\<exists>x y. a * x + b * y = 1\<close> add_mult_distrib nat_mult_1)
  hence "\<exists> x. a dvd a*c*x \<and> a dvd b*c"
    by (simp add: assms)
  hence "\<exists> x y. a dvd b*c*y"
    by simp
  hence "\<exists> x y. a dvd (a*c*x + b*c*y)"
    by (metis add.commute add_cancel_right_left dvdI mult.assoc mult.commute mult_0 mult_0_right)
  hence "a dvd c"
    by (metis (no_types, hide_lams) add_cancel_right_left dvd_mult2 is_gcd_def gcd_jedinstven mult.right_neutral mult_0_right nat_mult_1 pomocna_obrnuto)
  thus ?thesis
    by simp
qed

(* 11|6^(2n)+3^(n+2)+3^n *)

lemma deljivost_sa_11:
  fixes n :: nat
shows "(11::nat) dvd (6^(2*n::nat) + 3^(n+2) + 3^n)"
proof (induction n)
  case 0
  then show ?case by simp
next
  case (Suc n)
  show ?case
  proof -
  (* [[show_types]] *)
  (* mora da bude oblika nesto = nesto *)
    have "(6::nat)^(2*(Suc n)) + 3^((Suc n) + 2) + 3^ (Suc n) = 6^(2*(n + 1)) + 3^((n + 1) + 2) + 3^ (n + 1)"
  (*using [[show_types]] --- pokazuje da mora da se doda nat na pocetku *)
      by simp
    also have "... = 6^(2*n+2) + 3^(n+2)*3 + 3^n*3"
      by (simp add: algebra_simps power_add)
    also have "... = 6^(2*n) * 6^2 + 3^(n + 2) * 3 + 3^n * 3"
      by (simp add: algebra_simps)
    also have "... = 6^(2*n) * 36 + 3 * 3^(n + 2) + 3 * 3^n"
      by (simp add: algebra_simps)
    also have "... = 36 * 6^(2*n) + 3 * 3^(n + 2) + 3 * 3^n"
      by (simp add: algebra_simps)
    also have "... = 36 * 6^(2*n) + (36-33) * 3^(n + 2) + (36-33) * 3^n"
      by (simp add: algebra_simps)
    also have "... = 36 * 6^(2*n) + 36 * 3^(n + 2) - 33 * 3^(n + 2) + 36 * 3^n - 33 * 3^n"
      by (simp add: algebra_simps)
    also have "... = 36 * (6^(2*n) + 3^(n + 2) + 3^n) - 33 * (3^(n + 2) + 3^n)"
      by (simp add: algebra_simps)
    also have "... = 36 * (6^(2*n) + 3^(n + 2) + 3^n) - 11 * 3 * (3^(n + 2) + 3^n)"
      by (simp add: algebra_simps)
    also have "... = (36::nat) * (6^(2*n) + 3^(n + 2) + 3^n) - 11 * (3^(n + 3) + 3^(n+1))"
      by (simp add: algebra_simps power_add)
    finally show ?case

  (* sledgehammer *)
      by (smt Suc.IH dvd_diff_nat dvd_trans dvd_triv_left dvd_triv_right)
  qed
qed

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
subsection \<open>Transitive\<close>
theory SBinary_Relations_Transitive
  imports
    Pairs
begin

definition "transitive D R \<equiv> \<forall>x y z \<in> D. \<langle>x, y\<rangle> \<in> R \<and> \<langle>y, z\<rangle> \<in> R \<longrightarrow> \<langle>x, z\<rangle> \<in> R"

lemma transitiveI [intro]:
  assumes
    "\<And>x y z. x \<in> D \<Longrightarrow> y \<in> D \<Longrightarrow> z \<in> D \<Longrightarrow> \<langle>x, y\<rangle> \<in> R \<Longrightarrow> \<langle>y, z\<rangle> \<in> R \<Longrightarrow> \<langle>x, z\<rangle> \<in> R"
  shows "transitive D R"
  using assms unfolding transitive_def by blast

lemma transitiveD:
  assumes "transitive D R"
  and "x \<in> D" "y \<in> D" "z \<in> D"
  and "\<langle>x, y\<rangle> \<in> R" "\<langle>y, z\<rangle> \<in> R"
  shows "\<langle>x, z\<rangle> \<in> R"
  using assms unfolding transitive_def by blast

end


theory Exercise3p12
imports AExp
begin

(* Exercise 3.12.

This is a variation on the previous exercise. Let the instruc-
tion set be

datatype instr0 = LDI0 val | LD0 vname | MV0 reg | ADD0 reg

All instructions refer implicitly to register 0 as the source (MV0) or target (all others).
 Define a compiler pretty much as explained above except that the compiled code leaves the
value of the expression in register 0. Prove that

exec (comp a r) s rs 0 = aval a s.

*)

type_synonym reg = nat

datatype instr = LDI0 val | LD0 vname | MV0 reg | ADD0 reg

fun exec1 :: "instr \<Rightarrow> state \<Rightarrow> (reg \<Rightarrow> int) \<Rightarrow> reg \<Rightarrow> int" where
  "exec1 (LDI0 i) s rs = rs (0 := i)"  |
  "exec1 (LD0 x)  s rs = rs (0 := s x)" |
  "exec1 (MV0 r)  s rs = rs (r := rs 0)" |
  "exec1 (ADD0 r) s rs = rs (0 := rs 0 + rs r)"

fun exec :: "instr list \<Rightarrow> state \<Rightarrow> (reg \<Rightarrow> int) \<Rightarrow> reg \<Rightarrow> int" where
  "exec [] s rs = rs" |
  "exec (i#is) s rs = exec is s (exec1 i s rs)"

lemma exec_append[simp]: "exec (is1 @ is2) s rs = exec is2 s (exec is1 s rs)"
  apply (induction is1 arbitrary: rs)
   apply auto
  done

value "exec1 (ADD0 1) <> <0 := 1, 1 := 2> 0"

(* r is the top of the stack. Leave registers < r alone *)
fun comp :: "aexp \<Rightarrow> reg \<Rightarrow> instr list" where
  "comp (N n) r = [LDI0 n]" |
  "comp (V x) r = [LD0  x]" |
(* We put intermediate computations in r+1, r+2 so that comp (Plus a1 a2) 0 is valid
   If we didn't then "comp2 a2" overwrites the intermediate result that is sitting in 0
   Alternatively we could just prove a result where we have r > 0 as a precondition.
 *)
  "comp (Plus a1 a2) r = comp a1 (r+1) @ [MV0 (r+1)] @ comp a2 (r+2) @ [ADD0 (r+1)]"

value "comp (Plus (N 1) (V ''x'')) 0"
value "exec [LDI0 1, MV0 0, LD0 ''x''] <''x'' := 10> <> 0"
value "exec (comp (Plus (N 1) (V ''x'')) 0) <''x'' := 10> <> 0"

lemma "exec (comp a r) s rs 0 = aval a s"
  apply (induction a arbitrary: r rs)
    apply (auto)
    done

end


theory PracticeIsar
  imports Main
begin

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume 0: "surj f"
  from 0 have 1: "\<forall>A. \<exists>a. A = f a" by (simp add: surj_def)
  from 1 have 2: "\<exists>a. {x. x \<notin> f x} = f a" by blast
  from 2 show "False" by blast
qed

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  from this have "\<exists>a. {x. x \<notin> f x} = f a" by (auto simp: surj_def)
  from this show "False" by blast
qed

lemma "\<not> surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  hence "\<exists>a. {x. x \<notin> f x} = f a" by (auto simp: surj_def)
  thus "False" by blast
qed

lemma
  fixes f :: "'a \<Rightarrow> 'a set"
  assumes s: "surj f"
  shows "False"
proof -
  have "\<exists> a. {x. x \<notin> f x} = f a" using s
    by (auto simp: surj_def)
  thus "False" by blast
qed

lemma "\<not>surj(f :: 'a \<Rightarrow> 'a set)"
proof
  assume "surj f"
  hence "\<exists>a. {x. x \<notin> f x} = f a" by (auto simp: surj_def)
  then obtain a where "{x. x \<notin> f x} = f a" by blast
  hence "a \<notin> f a \<longleftrightarrow> a \<in> f a" by blast
  thus "False" by blast
qed

lemma "length (tl xs) = length xs - 1"
proof (cases xs)
  case Nil
  then show ?thesis by simp
next
  case (Cons a list)
  then show ?thesis by simp
qed

lemma "\<Sum>{0..n::nat} = n*(n+1) div 2" (is "?P n")
proof (induction n)
  case 0
  then show ?case by simp
next
  fix n assume "?P n"
  thus "?P (Suc n)" by simp
qed

inductive ev :: "nat \<Rightarrow> bool" where
ev0: "ev 0" |
evSS : "ev n \<Longrightarrow> ev (Suc(Suc n))"

fun evn :: "nat \<Rightarrow> bool" where
"evn 0 = True" |
"evn (Suc 0) = False" |
"evn (Suc(Suc n)) = evn n"

lemma "ev (Suc m) \<Longrightarrow> \<not> ev m"
proof (induction "Suc m" arbitrary: m rule: ev.induct)
  fix n assume IH: "\<And>m. n = Suc m \<Longrightarrow> \<not>ev m"
  show "\<not>ev (Suc n)"
  proof
    assume "ev(Suc n)"
    thus False
    proof cases
      fix k assume "n = Suc k" "ev k"
      thus False using IH by auto
    qed
  qed
qed

lemma assumes a: "ev(Suc(Suc n))" shows "ev n"
proof -
  have "ev(Suc(Suc n)) \<Longrightarrow> ev n"
  proof (induction "Suc(Suc n)" arbitrary: n rule: ev.induct)
    case ev0
    fix n assume "ev n"
    thus "ev n" by simp
  qed
  thus ?thesis using a by simp
qed


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
subsection \<open>Preorders\<close>
theory Preorders
  imports
    Binary_Relations_Reflexive
    Binary_Relations_Transitive
begin

definition "preorder_on P R \<equiv> reflexive_on P R \<and> transitive_on P R"

lemma preorder_onI [intro]:
  assumes "reflexive_on P R"
  and "transitive_on P R"
  shows "preorder_on P R"
  unfolding preorder_on_def using assms by blast

lemma preorder_onE [elim]:
  assumes "preorder_on P R"
  obtains "reflexive_on P R" "transitive_on P R"
  using assms unfolding preorder_on_def by blast

lemma reflexive_on_if_preorder_on:
  assumes "preorder_on P R"
  shows "reflexive_on P R"
  using assms by (elim preorder_onE)

lemma transitive_on_if_preorder_on:
  assumes "preorder_on P R"
  shows "transitive_on P R"
  using assms by (elim preorder_onE)

lemma transitive_if_preorder_on_in_field:
  assumes "preorder_on (in_field R) R"
  shows "transitive R"
  using assms by (elim preorder_onE) (rule transitive_if_transitive_on_in_field)

corollary preorder_on_in_fieldE [elim]:
  assumes "preorder_on (in_field R) R"
  obtains "reflexive_on (in_field R) R" "transitive R"
  using assms
  by (blast dest: reflexive_on_if_preorder_on transitive_if_preorder_on_in_field)

lemma preorder_on_rel_inv_if_preorder_on [iff]:
  "preorder_on P R\<inverse> \<longleftrightarrow> preorder_on (P :: 'a \<Rightarrow> bool) (R :: 'a \<Rightarrow> _)"
  by auto

lemma rel_if_all_rel_if_rel_if_reflexive_on:
  assumes "reflexive_on P R"
  and "\<And>z. P z \<Longrightarrow> R x z \<Longrightarrow> R y z"
  and "P x"
  shows "R y x"
  using assms by blast

lemma rel_if_all_rel_if_rel_if_reflexive_on':
  assumes "reflexive_on P R"
  and "\<And>z. P z \<Longrightarrow> R z x \<Longrightarrow> R z y"
  and "P x"
  shows "R x y"
  using assms by blast

definition "preorder (R :: 'a \<Rightarrow> _) \<equiv> preorder_on (\<top> :: 'a \<Rightarrow> bool) R"

lemma preorder_eq_preorder_on:
  "preorder (R :: 'a \<Rightarrow> _) = preorder_on (\<top> :: 'a \<Rightarrow> bool) R"
  unfolding preorder_def ..

lemma preorderI [intro]:
  assumes "reflexive R"
  and "transitive R"
  shows "preorder R"
  unfolding preorder_eq_preorder_on using assms
  by (intro preorder_onI reflexive_on_if_reflexive transitive_on_if_transitive)

lemma preorderE [elim]:
  assumes "preorder R"
  obtains "reflexive R" "transitive R"
  using assms unfolding preorder_eq_preorder_on by (elim preorder_onE)
  (simp only: reflexive_eq_reflexive_on transitive_eq_transitive_on)

lemma preorder_on_if_preorder:
  fixes P :: "'a \<Rightarrow> bool" and R :: "'a \<Rightarrow> _"
  assumes "preorder R"
  shows "preorder_on P R"
  using assms by (elim preorderE)
  (intro preorder_onI reflexive_on_if_reflexive transitive_on_if_transitive)

subsubsection \<open>Instantiations\<close>

lemma preorder_eq: "preorder (=)"
  using reflexive_eq transitive_eq by (rule preorderI)

end


theory identity1 imports Complex_Main begin

theorem identity1: fixes f :: "nat \<Rightarrow> nat"
assumes fff: "\<And>n. f(f(n)) < f(Suc(n))"
shows "f(n) = n"
proof -
  { fix m n have key: "m \<ge> n \<Longrightarrow> f(m) \<ge> n"
  (*This key lemma is such a stroke of genius. How could anyone make this generalisation?*)
  proof (induct n arbitrary: m)
  case 0
    then show ?case by simp
  next
    case (Suc n)
    print_facts
    hence "m - 1 \<ge> n" by auto
    hence "f (m-1) \<ge> n" using Suc.hyps by auto
    hence 1: "f (f (m-1)) \<ge> n" using Suc.hyps by auto
    have "f m > f (f (m-1))" using assms
      by (metis One_nat_def Suc.prems Suc_diff_Suc Suc_le_D diff_zero less_Suc_eq_0_disj)
    hence "f m > n" using 1 by auto
    then show ?case by auto
  qed }
  hence "\<And>n. f n \<ge> n" by simp
  hence "\<And>n. f (n+1) > f n"
    by (metis Suc_eq_plus1 \<open>\<And>na m. na \<le> m \<Longrightarrow> na \<le> f m\<close> discrete fff not_less_eq_eq)
  hence "f n < n + 1"
    by (metis Suc_eq_plus1 fff lift_Suc_mono_less_iff)
  then show ?thesis
    by (metis Suc_eq_plus1 \<open>\<And>n. n \<le> f n\<close> less_antisym not_le)
qed

end