theory Uniswap
  imports Phi_Semantics.PhiSem_Machine_Integer
          Phi_Semantics.PhiSem_CF_Basic
          Phi_Semantics.PhiSem_Variable HOL.Transcendental
begin

consts Tick  :: \<open>(VAL, int) \<phi>\<close>
       Price :: \<open>(VAL, real) \<phi>\<close>

definition \<open>FACTOR = (1.0001::real)\<close>

lemma FACTOR_LG_1: \<open>1 < FACTOR\<close> unfolding FACTOR_def by simp

definition price_of :: \<open>int \<Rightarrow> real\<close>
  where price_of_def': \<open>price_of tick = sqrt (FACTOR powr (of_int tick))\<close>

lemma price_of_def: \<open>price_of t = FACTOR powr (of_int t / 2)\<close>
  unfolding price_of_def'
  by (simp add: powr_half_sqrt[symmetric] powr_powr)

hide_fact price_of_def'

lemma price_of_mono': \<open>mono price_of\<close>
  unfolding price_of_def mono_on_def
  by (simp add: FACTOR_LG_1)

lemma price_of_smono': \<open>strict_mono price_of\<close>
  unfolding price_of_def strict_mono_on_def
  by (simp add: FACTOR_LG_1)

lemma price_of_mono:
  \<open>price_of x \<le> price_of y \<longleftrightarrow> x \<le> y\<close>
  using price_of_mono'
  by (simp add: price_of_smono' strict_mono_less_eq)

lemma price_of_smono:
  \<open>price_of x < price_of y \<longleftrightarrow> x < y\<close>
  using price_of_smono' using strict_mono_less by blast

definition \<open>tick_of_price p = (@t. price_of t \<le> p \<and> p < price_of (t+1)) \<close>

lemma tick_of_price: \<open>tick_of_price (price_of t) = t\<close>
  unfolding tick_of_price_def
  by (smt (z3) price_of_smono some_eq_imp)

lemma price_of_tick:
  assumes \<open>0 < p\<close>
  shows \<open>price_of (tick_of_price p) \<le> p \<and> p < price_of (tick_of_price p + 1)\<close>
proof -
  have \<open>\<exists>t. p < FACTOR powr t\<close>
    by (metis FACTOR_LG_1 dual_order.strict_trans floor_log_eq_powr_iff linorder_neqE_linordered_idom zero_less_one)
  then have \<open>\<exists>t. p < price_of t\<close>
    unfolding price_of_def
    by (meson FACTOR_LG_1 dual_order.strict_trans ex_less_of_int less_divide_eq_numeral1(1) powr_less_cancel_iff)
  moreover have \<open>\<exists>t. FACTOR powr t \<le> p\<close>
    using \<open>0 < p\<close> FACTOR_LG_1 floor_log_eq_powr_iff by blast
  then have \<open>\<exists>t. price_of t \<le> p\<close>
    proof -
      have \<open>\<And>x. \<exists>t. real_of_int t / 2 < x\<close> by (simp add: ex_of_int_less)
      then show ?thesis
      unfolding price_of_def
      by (meson FACTOR_LG_1 \<open>\<exists>t. FACTOR powr t \<le> p\<close> dual_order.trans less_le_not_le powr_le_cancel_iff)
    qed
  ultimately have X: \<open>(\<exists>t. price_of t \<le> p \<and> p < price_of (t+1))\<close>
    proof -
    obtain t1 where t1: \<open>price_of t1 \<le> p\<close> using \<open>\<exists>t. price_of t \<le> p\<close> by blast
    obtain t2 where t2: \<open>p < price_of t2\<close> using \<open>\<exists>t. p < price_of t\<close> by blast
    have le: \<open>t1 < t2\<close> using t1 t2 price_of_smono by fastforce
    thm int_gr_induct[OF le]
    have \<open>p < price_of t2 \<longrightarrow> ?thesis\<close>
    proof (induct rule: int_gr_induct[OF le])
      case 1
      then show ?case
        using t1 by blast
    next
      case (2 i)
      then show ?case
        by force
    qed
    then show ?thesis
      using t2 by blast
  qed
  then show ?thesis
    unfolding tick_of_price_def
    by (metis (no_types, lifting) someI_ex)
qed

debt_axiomatization getSqrtRatioAtTick :: \<open>(VAL,VAL) proc'\<close>
  where getSqrtRatioAtTick_\<phi>app:
            \<open>\<p>\<r>\<o>\<c> getSqrtRatioAtTick v \<lbrace> t \<Ztypecolon> \<v>\<a>\<l>[v] Tick \<longmapsto> price_of t \<Ztypecolon> \<v>\<a>\<l> Price \<rbrace>\<close>
    and getTickAtSqrtRatio_\<phi>app:
            \<open>\<p>\<r>\<e>\<m>\<i>\<s>\<e> 0 < p
         \<Longrightarrow> \<p>\<r>\<o>\<c> getTickAtSqrtRatio v \<lbrace> p \<Ztypecolon> \<v>\<a>\<l>[v] Price \<longmapsto> tick_of_price p \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>

record tick_info =
  liquidityGross :: nat
  liquidityNet   :: int
  feeGrowthOutside0X128 :: nat
  feeGrowthOutside1X128 :: nat
  tickCumulativeOutside :: int
  secondsPerLiquidityOutsideX128 :: nat
  secondsOutside :: nat
  initialized :: bool

definition \<open>growth_Inv f f' delta current =
  (\<forall>(i::int). f i = (if i \<le> current then (sum f' {j. j \<le> i}) + delta i
                             else (sum f' {j. i < j}) - delta i))\<close>

term sum

debt_axiomatization TickInfos :: \<open>(assn, int \<Rightarrow> tick_info nonsepable option) \<phi>\<close>
  where TickInfos_mult: \<open>(f1 \<Ztypecolon> TickInfos) * (f2 \<Ztypecolon> TickInfos) = (f1 * f2 \<Ztypecolon> TickInfos)\<close>
          \<comment> \<open>Separation of Abstraction ?! cool! \<close>

thm TickInfos_mult

definition TickInfo

debt_axiomatization get_TickInfo :: \<open>(VAL,VAL) proc'\<close>
  where getSqrtRatioAtTick_\<phi>app:
            \<open>\<p>\<r>\<o>\<c> getSqrtRatioAtTick v \<lbrace> t \<Ztypecolon> \<v>\<a>\<l>[v] Tick \<longmapsto> price_of t \<Ztypecolon> \<v>\<a>\<l> Price \<rbrace>\<close>
    and getTickAtSqrtRatio_\<phi>app:
            \<open>\<p>\<r>\<e>\<m>\<i>\<s>\<e> 0 < p
         \<Longrightarrow> \<p>\<r>\<o>\<c> getTickAtSqrtRatio v \<lbrace> p \<Ztypecolon> \<v>\<a>\<l>[v] Price \<longmapsto> tick_of_price p \<Ztypecolon> \<v>\<a>\<l> Tick \<rbrace>\<close>

definition \<open>Ticks = (\<lambda>info. into \<Ztypecolon> TickInfo' \<s>\<u>\<b>\<j>  )\<close>

end


\<^marker>\<open>creator Florian Keßler\<close>

section "IMP- Max Constant"

theory Max_Constant
  imports "Small_StepT"
begin

text \<open>We define functions to derive the constant with the highest value and enumerate all variables
  in IMP- programs. \<close>

fun atomExp_to_constant:: "atomExp \<Rightarrow> nat" where
"atomExp_to_constant (V var) = 0" |
"atomExp_to_constant (N val) = val"

fun aexp_max_constant:: "AExp.aexp \<Rightarrow> nat" where
"aexp_max_constant (A a) = atomExp_to_constant a" |
"aexp_max_constant (Plus a b) = max (atomExp_to_constant a) (atomExp_to_constant b)" |
"aexp_max_constant (Sub a b) = max (atomExp_to_constant a) (atomExp_to_constant b)" |
"aexp_max_constant (Parity a) = atomExp_to_constant a" |
"aexp_max_constant (RightShift a) = atomExp_to_constant a"

fun max_constant :: "com \<Rightarrow> nat" where
"max_constant (SKIP) = 0" |
"max_constant (Assign vname aexp) = aexp_max_constant aexp" |
"max_constant (Seq c1  c2) = max (max_constant c1) (max_constant c2)" |
"max_constant (If  _ c1 c2) = max (max_constant c1) (max_constant c2)"  |
"max_constant (While _ c) = max_constant c"

lemma max_constant_not_increasing_step:
  "(c1, s1) \<rightarrow> (c2, s2) \<Longrightarrow> max_constant c2 \<le> max_constant c1"
  by (induction c1 s1 c2 s2 rule: small_step_induct) auto

lemma Max_range_le_then_element_le: "finite (range s) \<Longrightarrow> 2 * Max (range s) < (x :: nat) \<Longrightarrow> 2 * (s y) < x"
proof -
  assume "2 * Max (range s) < (x :: nat)"
  moreover have "s y \<in> range s" by simp
  moreover assume "finite (range s)"
  moreover hence "s y \<le> Max (range s)" by simp
  ultimately show ?thesis by linarith
qed

lemma aval_le_when:
  assumes "finite (range s)" "2 * max (Max (range s)) (aexp_max_constant a) < x"
  shows "AExp.aval a s < x"
using assms proof(cases a)
  case (A x1)
  thus ?thesis using assms
  proof(cases x1)
    case (V x2)
    thus ?thesis using assms A Max_range_le_then_element_le[where ?s=s and ?x = x and ?y=x2] by simp
  qed simp
next
  case (Plus x21 x22)
  hence "2 * max (AExp.atomVal x21 s) (AExp.atomVal x22 s) < x"
    apply(cases x21; cases x22)
    using assms
    by (auto simp add: Max_range_le_then_element_le nat_mult_max_right)
  thus ?thesis using Plus by auto
next
  case (Sub x31 x32)
  then show ?thesis
    apply(cases x31 ; cases x32)
    using assms apply(auto simp add: Max_range_le_then_element_le nat_mult_max_right)
    using Max_range_le_then_element_le
    by (metis gr_implies_not0 lessI less_imp_diff_less less_imp_le_nat less_le_trans
        linorder_neqE_nat n_less_m_mult_n numeral_2_eq_2)+
next
  case (Parity x4)
  then show ?thesis apply(cases x4)
    using assms Max_range_le_then_element_le[OF \<open>finite (range s)\<close>, where ?x=x]
    apply(auto simp: algebra_simps)
    by (metis One_nat_def Suc_lessI less_Suc_eq less_one mod_mult_self1_is_0 mult_eq_0_iff
        neq0_conv not_mod_2_eq_0_eq_1 numeral_2_eq_2)
next
  case (RightShift x5)
  then show ?thesis
    apply(cases x5)
    using assms Max_range_le_then_element_le[OF \<open>finite (range s)\<close>, where ?x=x]
    apply(auto simp: algebra_simps)
    by (metis less_mult_imp_div_less max.strict_coboundedI1 max_0_1 max_less_iff_conj
        mult_numeral_1_right nat_mult_max_right one_eq_numeral_iff)
qed

fun atomExp_var:: "atomExp \<Rightarrow> vname list" where
"atomExp_var (V var) = [ var ]" |
"atomExp_var (N val) = []"

fun aexp_vars:: "AExp.aexp \<Rightarrow> vname list" where
"aexp_vars (A a) = atomExp_var a" |
"aexp_vars (Plus a b) = (atomExp_var a) @ (atomExp_var b)" |
"aexp_vars (Sub a b) = (atomExp_var a) @ (atomExp_var b)" |
"aexp_vars (Parity a) = atomExp_var a" |
"aexp_vars (RightShift a) = atomExp_var a"

fun all_variables :: "com \<Rightarrow> vname list" where
"all_variables (SKIP) = []" |
"all_variables (Assign v aexp) = v # aexp_vars aexp" |
"all_variables (Seq c1 c2) = all_variables c1 @ all_variables c2" |
"all_variables (If v c1 c2) = [ v ] @ all_variables c1 @ all_variables c2" |
"all_variables (While v c) = [ v ] @ all_variables c"

definition num_variables:: "com \<Rightarrow> nat" where
"num_variables c = length (remdups (all_variables c))"

lemma all_variables_subset_step: "(c1, s1) \<rightarrow> (c2, s2)
  \<Longrightarrow> set (all_variables c2) \<subseteq> set (all_variables c1)"
  apply(induction c1 s1 c2 s2 rule: small_step_induct)
  by auto

lemma subset_then_length_remdups_le: "set as \<subseteq> set bs
  \<Longrightarrow> length (remdups (as @ cs)) \<le> length (remdups (bs @ cs))"
  apply(induction cs)
   apply (auto simp: card_mono length_remdups_card_conv)
  by (metis (no_types, lifting) List.finite_set Un_insert_right card_mono dual_order.trans
      finite.insertI finite_Un sup.boundedI sup.cobounded1 sup.cobounded2)

lemma num_variables_not_increasing_step: "(c1, s1) \<rightarrow> (c2, s2)
  \<Longrightarrow> num_variables c2 \<le> num_variables c1"
  apply(induction c1 s1 c2 s2 rule: small_step_induct)
  using subset_then_length_remdups_le[OF all_variables_subset_step]
        apply(auto simp: num_variables_def length_remdups_card_conv)
        apply (meson List.finite_set card_mono finite_Un sup.cobounded1 sup.cobounded2 le_SucI)+
  by (simp add: insert_absorb)

lemma num_variables_not_increasing: "(c1, s1) \<rightarrow>\<^bsup> t \<^esup> (c2, s2)
  \<Longrightarrow> num_variables c2 \<le> num_variables c1"
proof (induction t arbitrary: c1 s1)
  case (Suc t)
  then obtain c3 s3 where "(c1, s1) \<rightarrow> (c3, s3)" "(c3, s3) \<rightarrow>\<^bsup> t \<^esup> (c2, s2)"
    by auto
  then show ?case
    using num_variables_not_increasing_step[OF \<open>(c1, s1) \<rightarrow> (c3, s3)\<close>]
      Suc.IH[OF \<open>(c3, s3) \<rightarrow>\<^bsup> t \<^esup> (c2, s2)\<close>]
    by simp
qed auto

end


theory Boolean_Expression_Example
imports Boolean_Expression_Checkers
begin

section{* Example *}

text {* Example usage of checkers. We have our own type of boolean expressions
with its own evaluation function: *}

datatype 'a bexp =
  Const bool |
  Atom 'a |
  Neg "'a bexp" |
  And "'a bexp" "'a bexp"

fun bval where
"bval (Const b) s = b" |
"bval (Atom a) s = s a" |
"bval (Neg b) s = (\<not> bval b s)" |
"bval (And b1 b2) s = (bval b1 s \<and> bval b2 s)"

text{* Now we translate into the datatype provided by the checkers interface
and show that the semantics remains the same: *}

fun bool_expr_of_bexp :: "'a bexp \<Rightarrow> 'a bool_expr" where
"bool_expr_of_bexp (Const b) = Const_bool_expr b" |
"bool_expr_of_bexp (Atom a) = Atom_bool_expr a" |
"bool_expr_of_bexp (Neg b) = Neg_bool_expr(bool_expr_of_bexp b)" |
"bool_expr_of_bexp (And b1 b2) = And_bool_expr (bool_expr_of_bexp b1) (bool_expr_of_bexp b2)"

lemma val_preservation: "val_bool_expr(bool_expr_of_bexp b) s = bval b s"
by(induction b) auto

text{* Trivial tautology checker and its correctness: *}

definition "my_taut_test = taut_test o bool_expr_of_bexp"

corollary my_taut_test: "my_taut_test b = (\<forall>s. bval b s)"
by(simp add: my_taut_test_def val_preservation taut_test)

text{* Test: pigeonhole formulas *}

definition "Or b1 b2 == Neg (And (Neg b1) (Neg b2))"
definition "ors = foldl Or (Const False)"
definition "ands = foldl And (Const True)"

definition "pc n = ands[ors[Atom(i,j). j <- [1..<n+1]]. i <- [1..<n+2]]"

definition "nc n = ands[Or (Neg(Atom(i,k))) (Neg(Atom(j,k))).
  k <- [1..<n+1], i <- [1..<n+1], j <- [i+1..<n+2]]"

definition "php n = Neg(And (pc n) (nc n))"

text{* Takes about 5 secs; with 7 instead of 6 it takes about 4 mins (2014). *}
lemma "my_taut_test (php 6)"
by eval

end


theory triangleInequality
  imports Complex_Main
begin

theorem triangle_inequality:
  fixes x y :: real
  shows "abs x + abs y ≥ abs(x + y)"
proof cases
  {
    assume xGreater: "x ≥ 0"
    show ?thesis proof cases
      {
        assume yGreater: "y ≥ 0"
        show ?thesis by simp
      next
        assume yLess: "¬(y ≥ 0)"
        show ?thesis by simp
      }
    qed

  next
    assume xLess: "¬(x ≥ 0)"
    show ?thesis proof cases
      {
        assume yGreater: "y ≥ 0"
        show ?thesis by simp
      next
        assume yLess: "¬(y ≥ 0)"
        show ?thesis by simp
      }
    qed
  }
qed

end


header "A Typed Language"

theory hw08_tmpl imports "~~/src/HOL/IMP/Star" begin

subsection "Expressions"

datatype val = Iv int | Bv bool

type_synonym vname = string
type_synonym state = "vname \<Rightarrow> val"

datatype exp =  N int | V vname | Plus exp exp |
  Bc bool | Not exp | And exp exp | Less exp exp

inductive eval :: "exp \<Rightarrow> state \<Rightarrow> val \<Rightarrow> bool" where
"eval (N i) s (Iv i)" |
"eval (V x) s (s x)" |
"eval a1 s (Iv i1) \<Longrightarrow> eval a2 s (Iv i2)
 \<Longrightarrow> eval (Plus a1 a2) s (Iv(i1+i2))" |
"eval (Bc v) s (Bv v)" |
"eval b s (Bv bv) \<Longrightarrow> eval (Not b) s (Bv(\<not> bv))" |
"eval b1 s (Bv bv1) \<Longrightarrow> eval b2 s (Bv bv2) \<Longrightarrow> eval (And b1 b2) s (Bv(bv1 & bv2))" |
"eval a1 s (Iv i1) \<Longrightarrow> eval a2 s (Iv i2) \<Longrightarrow> eval (Less a1 a2) s (Bv(i1 < i2))"

inductive_cases [elim!]:
  "eval (N i) s v"
  "eval (V x) s v"
  "eval (Plus a1 a2) s v"
  "eval (Bc b) s v"
  "eval (Not b) s v"
  "eval (And b1 b2) s v"
  "eval (Less a1 a2) s v"

subsection "Syntax of Commands"
(* a copy of Com.thy - keep in sync! *)

datatype
  com = SKIP
      | Assign vname exp       ("_ ::= _" [1000, 61] 61)
      | Seq    com  com         ("_;; _"  [60, 61] 60)
      | If     exp com com     ("IF _ THEN _ ELSE _"  [0, 0, 61] 61)
      | While  exp com         ("WHILE _ DO _"  [0, 61] 61)

subsection "Small-Step Semantics of Commands"

inductive
  small_step :: "(com \<times> state) \<Rightarrow> (com \<times> state) \<Rightarrow> bool" (infix "\<rightarrow>" 55)
where
Assign:  "eval a s v \<Longrightarrow> (x ::= a, s) \<rightarrow> (SKIP, s(x := v))" |

Seq1:   "(SKIP;;c,s) \<rightarrow> (c,s)" |
Seq2:   "(c1,s) \<rightarrow> (c1',s') \<Longrightarrow> (c1;;c2,s) \<rightarrow> (c1';;c2,s')" |

IfTrue:  "eval b s (Bv True) \<Longrightarrow> (IF b THEN c1 ELSE c2,s) \<rightarrow> (c1,s)" |
IfFalse: "eval b s (Bv False) \<Longrightarrow> (IF b THEN c1 ELSE c2,s) \<rightarrow> (c2,s)" |

While:   "(WHILE b DO c,s) \<rightarrow> (IF b THEN c;; WHILE b DO c ELSE SKIP,s)"

lemmas small_step_induct = small_step.induct[split_format(complete)]

subsection "The Type System"

datatype ty = Ity | Bty

type_synonym tyenv = "vname \<Rightarrow> ty"

inductive etyping :: "tyenv \<Rightarrow> exp \<Rightarrow> ty \<Rightarrow> bool"
  ("(1_/ \<turnstile>/ (_ :/ _))" [50,0,50] 50)
where
Ic_ty: "\<Gamma> \<turnstile> N i : Ity" |
V_ty: "\<Gamma> \<turnstile> V x : \<Gamma> x" |
Plus_ty: "\<Gamma> \<turnstile> a1 : Ity \<Longrightarrow> \<Gamma> \<turnstile> a2 : Ity \<Longrightarrow> \<Gamma> \<turnstile> Plus a1 a2 : Ity" |
B_ty: "\<Gamma> \<turnstile> Bc v : Bty" |
Not_ty: "\<Gamma> \<turnstile> b : Bty \<Longrightarrow> \<Gamma> \<turnstile> Not b : Bty" |
And_ty: "\<Gamma> \<turnstile> b1 : Bty \<Longrightarrow> \<Gamma> \<turnstile> b2 : Bty \<Longrightarrow> \<Gamma> \<turnstile> And b1 b2 : Bty" |
Less_ty: "\<Gamma> \<turnstile> a1 : Ity \<Longrightarrow> \<Gamma> \<turnstile> a2 : Ity \<Longrightarrow> \<Gamma> \<turnstile> Less a1 a2 : Bty"

inductive ctyping :: "tyenv \<Rightarrow> com \<Rightarrow> bool" (infix "\<turnstile>" 50) where
Skip_ty: "\<Gamma> \<turnstile> SKIP" |
Assign_ty: "\<Gamma> \<turnstile> a : \<Gamma>(x) \<Longrightarrow> \<Gamma> \<turnstile> x ::= a" |
Seq_ty: "\<Gamma> \<turnstile> c1 \<Longrightarrow> \<Gamma> \<turnstile> c2 \<Longrightarrow> \<Gamma> \<turnstile> c1;;c2" |
If_ty: "\<Gamma> \<turnstile> b : Bty \<Longrightarrow> \<Gamma> \<turnstile> c1 \<Longrightarrow> \<Gamma> \<turnstile> c2 \<Longrightarrow> \<Gamma> \<turnstile> IF b THEN c1 ELSE c2" |
While_ty: "\<Gamma> \<turnstile> b : Bty \<Longrightarrow> \<Gamma> \<turnstile> c \<Longrightarrow> \<Gamma> \<turnstile> WHILE b DO c"

inductive_cases [elim!]:
  "\<Gamma> \<turnstile> x ::= a"  "\<Gamma> \<turnstile> c1;;c2"
  "\<Gamma> \<turnstile> IF b THEN c1 ELSE c2"
  "\<Gamma> \<turnstile> WHILE b DO c"

subsection "Well-typed Programs Do Not Get Stuck"

fun type :: "val \<Rightarrow> ty" where
"type (Iv i) = Ity" |
"type (Bv r) = Bty"

lemma type_eq_Ity[simp]: "type v = Ity \<longleftrightarrow> (\<exists>i. v = Iv i)"
by (cases v) simp_all

lemma type_eq_Bty[simp]: "type v = Bty \<longleftrightarrow> (\<exists>r. v = Bv r)"
by (cases v) simp_all

definition styping :: "tyenv \<Rightarrow> state \<Rightarrow> bool" (infix "\<turnstile>" 50)
where "\<Gamma> \<turnstile> s  \<longleftrightarrow>  (\<forall>x. type (s x) = \<Gamma> x)"

lemma epreservation:
  "\<Gamma> \<turnstile> a : \<tau> \<Longrightarrow> eval a s v \<Longrightarrow> \<Gamma> \<turnstile> s \<Longrightarrow> type v = \<tau>"
oops

lemma eprogress: "\<Gamma> \<turnstile> a : \<tau> \<Longrightarrow> \<Gamma> \<turnstile> s \<Longrightarrow> \<exists>v. eval a s v"
oops

theorem progress:
  "\<Gamma> \<turnstile> c \<Longrightarrow> \<Gamma> \<turnstile> s \<Longrightarrow> c \<noteq> SKIP \<Longrightarrow> \<exists>cs'. (c,s) \<rightarrow> cs'"
oops

theorem styping_preservation:
  "(c,s) \<rightarrow> (c',s') \<Longrightarrow> \<Gamma> \<turnstile> c \<Longrightarrow> \<Gamma> \<turnstile> s \<Longrightarrow> \<Gamma> \<turnstile> s'"
oops

theorem ctyping_preservation:
  "(c,s) \<rightarrow> (c',s') \<Longrightarrow> \<Gamma> \<turnstile> c \<Longrightarrow> \<Gamma> \<turnstile> c'"
oops

abbreviation small_steps :: "com * state \<Rightarrow> com * state \<Rightarrow> bool" (infix "\<rightarrow>*" 55)
where "x \<rightarrow>* y == star small_step x y"

theorem type_sound:
  "(c,s) \<rightarrow>* (c',s') \<Longrightarrow> \<Gamma> \<turnstile> c \<Longrightarrow> \<Gamma> \<turnstile> s \<Longrightarrow> c' \<noteq> SKIP
   \<Longrightarrow> \<exists>cs''. (c',s') \<rightarrow> cs''"
oops

end


header {* Polynomials\label{sec.poly.ext} *}

theory Polynomial_extension
imports
  Main
  "~~/src/HOL/Library/Permutations"
  "~~/src/HOL/Library/Polynomial"
begin

text{* This theory contains auxiliary lemmas on polynomials. *}

lemma degree_setprod_le: "degree (\<Prod>i\<in>S. f i) \<le> (\<Sum>i\<in>S. degree (f i))"
  apply(cases "finite S")
  apply(simp_all)
  apply(induct rule: finite_induct)
  apply(simp_all)
  apply(metis (lifting) degree_mult_le dual_order.trans nat_add_left_cancel_le)
  done

lemma coeff_mult_sum: "degree p \<le> m \<Longrightarrow>
                       degree q \<le> n \<Longrightarrow> coeff (p * q) (m + n) = coeff p m * coeff q n"
  apply(insert coeff_mult_degree_sum[of p q] coeff_eq_0[of q n] coeff_eq_0[of p m]
               degree_mult_le[of p q] coeff_eq_0[of "p*q" "m + n"])
  apply(cases "degree p = m \<and> degree q = n")
  apply(simp)
  apply(cases "degree p < m")
  apply(simp_all)
  done

lemma coeff_mult_setprod_setsum:
  "coeff (\<Prod>i\<in>S. f i) (\<Sum>i\<in>S. degree (f i)) = (\<Prod>i\<in>S. coeff (f i) (degree (f i)))"
  apply(cases "finite S")
  apply(induct rule: finite_induct)
  apply(simp_all add: coeff_mult_sum degree_setprod_le)
  done

lemma degree_setsum_smaller:
  assumes "n > 0" "finite A"
  shows " \<forall>x\<in>A. degree (f x) < n \<Longrightarrow> degree (\<Sum>x\<in>A. f x) < n"
  using `finite A`
  by(induct rule: finite_induct)
    (simp_all add: degree_add_less assms)

lemma degree_setsum_le:
  assumes "finite A"
  shows " \<forall>x\<in>A. degree (f x) \<le> n \<Longrightarrow> degree (\<Sum>x\<in>A. f x) \<le> n"
  using `finite A`
  by(induct rule: finite_induct)
    (auto intro!: degree_add_le)

lemma degree_setsum_le_max:
  fixes F :: "('n::finite \<Rightarrow> 'n) set" and f :: "_ \<Rightarrow> 'a::comm_ring_1 poly"
  shows "degree (setsum f F) \<le> Max { degree (f p) | p. p\<in>F}"
  by(intro degree_setsum_le)
    (auto intro!: Max.coboundedI)

lemma degree_smaller:
  assumes "n > 0"
  shows "degree (\<Sum>x::nat | x < n . monom (coeff (f x) x) x) < n"
  using assms degree_monom_le
  apply(auto intro!: degree_setsum_smaller)
  apply(subst le_less_trans[where z=n])
  apply(auto)
  done

lemma poly_as_sum_of_monoms: "(\<Sum>x\<le>degree a . monom (coeff a x) x) = a"
proof-
  have eq: "\<And>n. {.. degree a} \<inter> {n} = (if n \<le> degree a then {n} else {})"
    by auto
  show ?thesis
    by(simp add: poly_eq_iff coeff_setsum setsum.If_cases eq coeff_eq_0)
qed

lemma poly_euclidean_division:
  assumes "degree a > 0"
  shows "\<exists> b :: 'a. \<exists> a'\<in>{ x::('a::comm_ring_1 poly) . degree x < degree a}.
         a = monom b (degree a) + a'"
proof-
  have "a = (\<Sum>x\<le>degree a . monom (coeff a x) x)"
    using poly_as_sum_of_monoms[of a] by auto
  also have "\<dots> = (\<Sum>x\<in>{degree a}\<union>{..< degree a} . monom (coeff a x) x)"
    unfolding sup.commute using ivl_disj_un_singleton(2) by (metis calculation)
  finally have "a = (\<Sum>x\<in>{degree a} . monom (coeff a x) x)
                  + (\<Sum>x<degree a . monom (coeff a x) x)"
    by simp
  also have "degree (\<Sum>x<degree a . monom (coeff a x) x) < degree a"
    using assms degree_monom_le le_less_trans
    by(auto intro!: degree_setsum_smaller) (blast)
  ultimately show ?thesis
    by auto
qed

lemma sign_permut: "\<And>p q. degree (of_int (sign p) * q) = degree q"
  by(simp add: sign_def)

lemma monom_poly_degree_one: "degree(monom 1 (Suc 0) - [: a::'a::comm_ring_1 :]) = (Suc 0)"
  by(simp add: monom_0 monom_Suc)

end


section \<open> Fixed-points and Recursion \<close>

theory utp_recursion
  imports
    utp_pred_laws
    utp_rel
begin

subsection \<open> Fixed-point Laws \<close>

lemma mu_id: "(\<mu> X \<bullet> X) = true"
  by (simp add: antisym gfp_upperbound)

lemma mu_const: "(\<mu> X \<bullet> P) = P"
  by (simp add: gfp_const)

lemma nu_id: "(\<nu> X \<bullet> X) = false"
  by (meson lfp_lowerbound utp_pred_laws.bot.extremum_unique)

lemma nu_const: "(\<nu> X \<bullet> P) = P"
  by (simp add: lfp_const)

lemma mu_refine_intro:
  assumes "(C \<Rightarrow> S) \<sqsubseteq> F(C \<Rightarrow> S)" "(C \<and> \<mu> F) = (C \<and> \<nu> F)"
  shows "(C \<Rightarrow> S) \<sqsubseteq> \<mu> F"
proof -
  from assms have "(C \<Rightarrow> S) \<sqsubseteq> \<nu> F"
    by (simp add: lfp_lowerbound)
  with assms show ?thesis
    by (pred_auto)
qed

subsection \<open> Obtaining Unique Fixed-points \<close>

text \<open> Obtaining termination proofs via approximation chains. Theorems and proofs adapted
  from Chapter 2, page 63 of the UTP book~\<^cite>\<open>"Hoare&98"\<close>.  \<close>

type_synonym 'a chain = "nat \<Rightarrow> 'a upred"

definition chain :: "'a chain \<Rightarrow> bool" where
  "chain Y = ((Y 0 = false) \<and> (\<forall> i. Y (Suc i) \<sqsubseteq> Y i))"

lemma chain0 [simp]: "chain Y \<Longrightarrow> Y 0 = false"
  by (simp add:chain_def)

lemma chainI:
  assumes "Y 0 = false" "\<And> i. Y (Suc i) \<sqsubseteq> Y i"
  shows "chain Y"
  using assms by (auto simp add: chain_def)

lemma chainE:
  assumes "chain Y" "\<And> i. \<lbrakk> Y 0 = false; Y (Suc i) \<sqsubseteq> Y i \<rbrakk> \<Longrightarrow> P"
  shows "P"
  using assms by (simp add: chain_def)

lemma L274:
  assumes "\<forall> n. ((E n \<and>\<^sub>p X) = (E n \<and> Y))"
  shows "(\<Sqinter> (range E) \<and> X) = (\<Sqinter> (range E) \<and> Y)"
  using assms by (pred_auto)

text \<open> Constructive chains \<close>

definition constr ::
  "('a upred \<Rightarrow> 'a upred) \<Rightarrow> 'a chain \<Rightarrow> bool" where
"constr F E \<longleftrightarrow> chain E \<and> (\<forall> X n. ((F(X) \<and> E(n + 1)) = (F(X \<and> E(n)) \<and> E (n + 1))))"

lemma constrI:
  assumes "chain E" "\<And> X n. ((F(X) \<and> E(n + 1)) = (F(X \<and> E(n)) \<and> E (n + 1)))"
  shows "constr F E"
  using assms by (auto simp add: constr_def)

text \<open> This lemma gives a way of showing that there is a unique fixed-point when
        the predicate function can be built using a constructive function F
        over an approximation chain E \<close>

lemma chain_pred_terminates:
  assumes "constr F E" "mono F"
  shows "(\<Sqinter> (range E) \<and> \<mu> F) = (\<Sqinter> (range E) \<and> \<nu> F)"
proof -
  from assms have "\<forall> n. (E n \<and> \<mu> F) = (E n \<and> \<nu> F)"
  proof (rule_tac allI)
    fix n
    from assms show "(E n \<and> \<mu> F) = (E n \<and> \<nu> F)"
    proof (induct n)
      case 0 thus ?case by (simp add: constr_def)
    next
      case (Suc n)
      note hyp = this
      thus ?case
      proof -
        have "(E (n + 1) \<and> \<mu> F) = (E (n + 1) \<and> F (\<mu> F))"
          using gfp_unfold[OF hyp(3), THEN sym] by (simp add: constr_def)
        also from hyp have "... = (E (n + 1) \<and> F (E n \<and> \<mu> F))"
          by (metis conj_comm constr_def)
        also from hyp have "... = (E (n + 1) \<and> F (E n \<and> \<nu> F))"
          by simp
        also from hyp have "... = (E (n + 1) \<and> \<nu> F)"
          by (metis (no_types, lifting) conj_comm constr_def lfp_unfold)
        ultimately show ?thesis
          by simp
      qed
    qed
  qed
  thus ?thesis
    by (auto intro: L274)
qed

theorem constr_fp_uniq:
  assumes "constr F E" "mono F" "\<Sqinter> (range E) = C"
  shows "(C \<and> \<mu> F) = (C \<and> \<nu> F)"
  using assms(1) assms(2) assms(3) chain_pred_terminates by blast

subsection \<open> Noetherian Induction Instantiation\<close>

text \<open> Contribution from Yakoub Nemouchi.The following generalization was used by Tobias Nipkow
        and Peter Lammich  in \emph{Refine\_Monadic} \<close>

lemma  wf_fixp_uinduct_pure_ueq_gen:
  assumes fixp_unfold: "fp B = B (fp B)"
  and              WF: "wf R"
  and     induct_step:
          "\<And>f st. \<lbrakk>\<And>st'. (st',st) \<in> R  \<Longrightarrow> (((Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st'\<guillemotright>) \<Rightarrow> Post) \<sqsubseteq> f)\<rbrakk>
               \<Longrightarrow> fp B = f \<Longrightarrow>((Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright>) \<Rightarrow> Post) \<sqsubseteq> (B f)"
        shows "((Pre \<Rightarrow> Post) \<sqsubseteq> fp B)"
proof -
  { fix st
    have "((Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright>) \<Rightarrow> Post) \<sqsubseteq> (fp B)"
    using WF proof (induction rule: wf_induct_rule)
      case (less x)
      hence "(Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>x\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> B (fp B)"
        by (rule induct_step, rel_blast, simp)
      then show ?case
        using fixp_unfold by auto
    qed
  }
  thus ?thesis
  by pred_simp
qed

text \<open> The next lemma shows that using substitution also work. However it is not that generic
        nor practical for proof automation ... \<close>

lemma refine_usubst_to_ueq:
  "vwb_lens E \<Longrightarrow> (Pre \<Rightarrow> Post)\<lbrakk>\<guillemotleft>st'\<guillemotright>/$E\<rbrakk> \<sqsubseteq> f\<lbrakk>\<guillemotleft>st'\<guillemotright>/$E\<rbrakk> = (((Pre \<and> $E =\<^sub>u \<guillemotleft>st'\<guillemotright>) \<Rightarrow> Post) \<sqsubseteq> f)"
  by (rel_auto, metis vwb_lens_wb wb_lens.get_put)

text \<open> By instantiation of @{thm wf_fixp_uinduct_pure_ueq_gen} with @{term \<mu>} and lifting of the
        well-founded relation we have ... \<close>

lemma mu_rec_total_pure_rule:
  assumes WF: "wf R"
  and     M: "mono B"
  and     induct_step:
          "\<And> f st.  \<lbrakk>(Pre \<and> (\<lceil>e\<rceil>\<^sub><,\<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> f\<rbrakk>
               \<Longrightarrow> \<mu> B = f \<Longrightarrow>(Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> (B f)"
        shows "(Pre \<Rightarrow> Post) \<sqsubseteq> \<mu> B"
proof (rule wf_fixp_uinduct_pure_ueq_gen[where fp=\<mu> and Pre=Pre and B=B and R=R and e=e])
  show "\<mu> B = B (\<mu> B)"
    by (simp add: M def_gfp_unfold)
  show "wf R"
    by (fact WF)
  show "\<And>f st. (\<And>st'. (st', st) \<in> R \<Longrightarrow> (Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st'\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> f) \<Longrightarrow>
                \<mu> B = f \<Longrightarrow>
                (Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> B f"
    by (rule induct_step, rel_simp, simp)
qed

lemma nu_rec_total_pure_rule:
  assumes WF: "wf R"
  and     M: "mono B"
  and     induct_step:
          "\<And> f st.  \<lbrakk>(Pre \<and> (\<lceil>e\<rceil>\<^sub><,\<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> f\<rbrakk>
               \<Longrightarrow> \<nu> B = f \<Longrightarrow>(Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> (B f)"
        shows "(Pre \<Rightarrow> Post) \<sqsubseteq> \<nu> B"
proof (rule wf_fixp_uinduct_pure_ueq_gen[where fp=\<nu> and Pre=Pre and B=B and R=R and e=e])
  show "\<nu> B = B (\<nu> B)"
    by (simp add: M def_lfp_unfold)
  show "wf R"
    by (fact WF)
  show "\<And>f st. (\<And>st'. (st', st) \<in> R \<Longrightarrow> (Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st'\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> f) \<Longrightarrow>
                \<nu> B = f \<Longrightarrow>
                (Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> B f"
    by (rule induct_step, rel_simp, simp)
qed

text \<open>Since @{term "B ((Pre \<and> (\<lceil>E\<rceil>\<^sub><,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> \<Rightarrow> Post)) \<sqsubseteq> B (\<mu> B)"} and
      @{term "mono B"}, thus,  @{thm mu_rec_total_pure_rule} can be expressed as follows\<close>

lemma mu_rec_total_utp_rule:
  assumes WF: "wf R"
    and     M: "mono B"
    and     induct_step:
    "\<And>st. (Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> (B ((Pre \<and> (\<lceil>e\<rceil>\<^sub><,\<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright> \<Rightarrow> Post)))"
  shows "(Pre \<Rightarrow> Post) \<sqsubseteq> \<mu> B"
proof (rule mu_rec_total_pure_rule[where R=R and e=e], simp_all add: assms)
  show "\<And>f st. (Pre \<and> (\<lceil>e\<rceil>\<^sub><, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> f \<Longrightarrow> \<mu> B = f \<Longrightarrow> (Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> B f"
    by (simp add: M induct_step monoD order_subst2)
qed

lemma nu_rec_total_utp_rule:
  assumes WF: "wf R"
    and     M: "mono B"
    and     induct_step:
    "\<And>st. (Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> (B ((Pre \<and> (\<lceil>e\<rceil>\<^sub><,\<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright> \<Rightarrow> Post)))"
  shows "(Pre \<Rightarrow> Post) \<sqsubseteq> \<nu> B"
proof (rule nu_rec_total_pure_rule[where R=R and e=e], simp_all add: assms)
  show "\<And>f st. (Pre \<and> (\<lceil>e\<rceil>\<^sub><, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> f \<Longrightarrow> \<nu> B = f \<Longrightarrow> (Pre \<and> \<lceil>e\<rceil>\<^sub>< =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> Post) \<sqsubseteq> B f"
    by (simp add: M induct_step monoD order_subst2)
qed

end


section \<open>theory_decr_forest\<close>
theory theory_decr_forest
imports Main
begin

text \<open> This theory defines a notion of graphs. A graph is a record that contains a set of nodes
\<open>V\<close> and a set of edges VxV, where the values v are the unique vertex labels.\<close>

subsection \<open>Definitions\<close>
  text \<open>A graph is represented by a record.\<close>
  record ('v) graph =
    nodes :: "'v set"
    edges :: "('v \<times> 'v) set"

  text \<open>In a valid graph, edges only go from nodes to nodes.\<close>
  locale valid_graph =
    fixes G :: "('v) graph"
    assumes E_valid: "fst`edges G \<subseteq> nodes G"
                     "snd`edges G \<subseteq> nodes G"
  begin
    abbreviation "V \<equiv> nodes G"
    abbreviation "E \<equiv> edges G"

    lemma E_validD: assumes "(v,v')\<in>E"
      shows "v\<in>V" "v'\<in>V"
      apply -
      apply (rule subsetD[OF E_valid(1)])
      using assms apply force
      apply (rule subsetD[OF E_valid(2)])
      using assms apply force
      done
  end

subsection \<open>Basic operations on Graphs\<close>
  text \<open>The empty graph.\<close>
  definition empty where
    "empty \<equiv> \<lparr> nodes = {}, edges = {} \<rparr>"
  text \<open>Adds a node to a graph.\<close>
  definition add_node where
    "add_node v g \<equiv> \<lparr> nodes = insert v (nodes g), edges=edges g\<rparr>"
  text \<open>Deletes a node from a graph. Also deletes all adjacent edges.\<close>
  definition delete_node where "delete_node v g \<equiv> \<lparr>
    nodes = nodes g - {v},
    edges = edges g \<inter> (-{v})\<times>(-{v})
    \<rparr>"
  text \<open>Adds an edge to a graph, edges only go from smaller to larger vertex labels\<close>
  definition add_edge where "add_edge v  v' g \<equiv> \<lparr>
    nodes = {v,v'} \<union> nodes g,
    edges = (if v'>v then
    insert (v,v') (edges g) else insert (v',v) (edges g))
    \<rparr>"
  text \<open>Deletes an edge from a graph.\<close>
  definition delete_edge where "delete_edge v v' g \<equiv> \<lparr>
    nodes = nodes g,
    edges = edges g - {(v,v')} \<rparr>"
  text \<open>Now follow some simplification lemmas.\<close>
  lemma empty_valid[simp]: "valid_graph empty"
    unfolding empty_def by unfold_locales auto
  lemma add_node_valid[simp]: assumes "valid_graph g"
    shows "valid_graph (add_node v g)"
  proof -
    interpret valid_graph g by fact
    show ?thesis
      unfolding add_node_def
      by unfold_locales (auto dest: E_validD)
  qed
  lemma delete_node_valid[simp]: assumes "valid_graph g"
    shows "valid_graph (delete_node v g)"
  proof -
    interpret valid_graph g by fact
    show ?thesis
      unfolding delete_node_def
      by unfold_locales (auto dest: E_validD)
  qed
  lemma add_edge_valid[simp]: assumes "valid_graph g"
    shows "valid_graph (add_edge v v' g)"
  proof -
    interpret valid_graph g by fact
    show ?thesis
      unfolding add_edge_def
      by unfold_locales (auto dest: E_validD)
  qed
  lemma delete_edge_valid[simp]: assumes "valid_graph g"
    shows "valid_graph (delete_edge v v' g)"
  proof -
    interpret valid_graph g by fact
    show ?thesis
      unfolding delete_edge_def
      by unfold_locales (auto dest: E_validD)
  qed

  lemma nodes_empty[simp]: "nodes empty = {}" unfolding empty_def by simp
  lemma edges_empty[simp]: "edges empty = {}" unfolding empty_def by simp
  lemma nodes_add_node[simp]: "nodes (add_node v g) = insert v (nodes g)"
    by (simp add: add_node_def)
  lemma nodes_add_edge[simp]:
    "nodes (add_edge v v' g) = insert v (insert v' (nodes g))"
    by (simp add: add_edge_def)

subsection \<open>Preliminary definitions\<close>
  text \<open>This function finds the connected component corresponding to the given vertex.\<close>
  definition "nodes_above g v \<equiv>{v} \<union> snd ` Set.filter (\<lambda>e. fst e = v) ((edges g)\<^sup>+)"

  text \<open>The function puts a component into a tree and preserves the decreasing property.\<close>
  fun nodes_order :: " nat graph \<Rightarrow> nat \<Rightarrow> nat graph " where
     "nodes_order g x\<^sub>1 =  (let nodes\<^sub>1= nodes_above g 1 in
                           let nodes\<^sub>2= nodes_above g (x\<^sub>1+2) in
                            let max_comp\<^sub>1= Max(nodes\<^sub>1) in
                            let max_comp\<^sub>2= Max(nodes\<^sub>2) in
                              (if max_comp\<^sub>1=max_comp\<^sub>2 then g else
                                (if max_comp\<^sub>1 > max_comp\<^sub>2 then
                                    let st_p=Max(Set.filter (\<lambda>v. v<max_comp\<^sub>2) nodes\<^sub>1) in
                                    let end_p=Min(Set.filter (\<lambda>v. v>max_comp\<^sub>2) nodes\<^sub>1) in
                                    let g1= delete_edge st_p end_p g in
                                    let g2= add_edge st_p max_comp\<^sub>2 g1 in
                                    let g3=add_edge max_comp\<^sub>2 end_p g2 in g3
                                 else
                                   add_edge max_comp\<^sub>1 max_comp\<^sub>2 g
                                 )
                               )
                            )"

  text \<open>This is an additional function. Input:
    1. Order number of the current node that can be added to the graph
    2. Order number of the previous node from branch1 (above 1) added to the graph
    3. Order number of the previous node from branch2 (above x1+2) added to the graph
    4. The current graph
    5. Number sequence to encode the graph

    How does the function work:
    I. If the sequence (input 5.) is empty, return current graph (input 4.)
    II. If the sequence is not empty and starts with a zero, add one to the order number of the
    current node, delete the first number (0) from the sequence and call the function again
    III. If the sequence isn't empty and doesn't start with a 0, add the current node to the graph
    IIIa. If the sequence starts with a 1, add an edge to branch1 using input (2)
    IIIb.  If the sequence starts with a 2, add an edge to branch2 using input (3)\<close>
  fun enc_to_graph :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat graph \<Rightarrow> nat list \<Rightarrow> nat graph" where
     "enc_to_graph curr_v prev_v1 prev_v2 g Nil = g"
|    "enc_to_graph curr_v prev_v1 prev_v2 g (0#ns)  =
      enc_to_graph (Suc curr_v) prev_v1 prev_v2 g ns "
|    "enc_to_graph curr_v prev_v1 prev_v2 g (x#ns) = (if x=1 then
      enc_to_graph (Suc curr_v) curr_v prev_v2 (add_edge prev_v1 curr_v g) ns
      else (if curr_v=prev_v2 then enc_to_graph (Suc curr_v) prev_v1 curr_v g ns
      else enc_to_graph (Suc curr_v) prev_v1 curr_v (add_edge prev_v2 curr_v g) ns
           )                                         )"

  text \<open>Define f1 to be the start graph.\<close>
  definition "f1 \<equiv> \<lparr>nodes = {1::nat}, edges = {}\<rparr>"

 text \<open>This is the inverse encoding function. Input:
    1.x1
    2. number sequence to encode into a graph
    How does the function work:
    I.delete the last number since it only gives information about the number of trees in the graph
    but distinguish between cases in dependence of this last value
    II. take first x1 numbers and build the first graph part with enc_to_graph
    III. add the node x1+2 to the graph
    IV. delete x1 first numbers and build the second part with the rest
    V(0). if the last encoding value was 0, output tree2
    V(1)(2).if the last encoding value was 1 and there are 2's in the encoding,
            connect two branches into one component using the function nodes_order
    V(1)(1). if the encoding only has 0 and 1 in it, build further on tree1 \<close>
  fun encoding_to_graph :: "nat \<Rightarrow> nat list \<Rightarrow> nat graph" where
     "encoding_to_graph x1 l = (let code_l=butlast l in
                            let tree\<^sub>1 = enc_to_graph 2 1 (x1+2) f1 (take x1 (code_l)) in
                            let max\<^sub>1 = Max (nodes tree\<^sub>1) in
                            let tree\<^sub>2 = enc_to_graph (x1+3) max\<^sub>1 (x1+2) (add_node (x1+2) tree\<^sub>1)
                                        (drop x1 code_l) in
                            if (last l=0) then tree\<^sub>2 else
                            if 2\<in>set(code_l) then (nodes_order tree\<^sub>2 x1 )
                             else  enc_to_graph (x1+3) (x1+2) (x1+2) (add_edge max\<^sub>1 (x1+2) tree\<^sub>1)
                                   (drop (x1) code_l)

                                )"

 text \<open>This is the main encoding function. Input:
      1. Graph g to be encoded
      2. x1
      3. 2 as the starting node
      4. x1+x2+2
      5. False as the starting value for branching
      How does the function work:
      I. For each x from 2 (input (3)) to x1+x2+2 (input (4)), check whether
         the vertex is in the graph, and if so, above which leaf does it exist
      II. For the nodes above the vertex with label 1, add 1 to the encoding,For the nodes
          above the vertex with label x1+2, add 2 to the encoding, change input (5) if
          we found a vertex with 2 incoming edges. If the value is not on a vertex,
          add 0 to the encoding
      III.using the value (5), decide to put 1 or 0 for 1 or 2 connected components\<close>
 fun graph_to_encoding_impl :: "nat graph \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> nat list" where
    "graph_to_encoding_impl f x1 x 0 c = [if c then 1 else 0]"
|   "graph_to_encoding_impl f x1 x (Suc n) c = (let above_one = (1, x) \<in> (edges f)\<^sup>+ in
                                                let above_x1_2 = (x1+2, x) \<in> (edges f)\<^sup>* in
                                                (if x = x1 + 2 then
                                                  graph_to_encoding_impl f x1 (Suc x) n
                                                  (above_one \<and> above_x1_2)
                                                 else (if x \<in> nodes f then
                                                  (if above_one \<and> (c \<or> \<not> above_x1_2) then 1 else 2)
                                                       else 0)
                                                # graph_to_encoding_impl f x1 (Suc x) n
                                                  (c \<or> above_one \<and> above_x1_2))
                                               )"
  text \<open>Add some computation simplifications.\<close>
  lemma in_rtrancl_code [code_unfold]:  "x \<in> rtrancl R \<longleftrightarrow> fst x = snd x \<or> x \<in> trancl R"
  by (metis prod.exhaust_sel rtrancl_eq_or_trancl)

  print_theorems
  definition "graph_to_encoding f x1 x2 \<equiv> graph_to_encoding_impl f x1 2 (x1+x2+1) False"

(* Examples Part 1
definition "graph_ex1 \<equiv>
  \<lparr>nodes = {1::nat,2,5,7},
   edges = {(1,2),(2,5),(5,7)}\<rparr>"

definition "graph_ex2 \<equiv>
  \<lparr>nodes = {1::nat,2,3,5,7},
   edges = {(1,2),(2,3),(3,7),(5,7)}\<rparr>"

definition "graph_ex3 \<equiv>
  \<lparr>nodes = {1::nat,4,5,6,7},
   edges = {(1,4),(4,6),(5,7)}\<rparr>"

definition x1:: nat where "x1=3"
definition x2:: nat where "x2=2"
value "graph_to_encoding graph_ex1 x1 x2"
value "graph_to_encoding graph_ex2 x1 x2"
value "graph_to_encoding graph_ex3 x1 x2"

Part 2:
definition "f2 \<equiv>
  \<lparr>nodes = {1::nat,2,5,6,7,8,10},
   edges = {(1,2),(2,7),(7,8),
            (5,6),(6,8),(8,10)}\<rparr>"

lemma "graph_to_encoding f2 3 5 = [1,0,0,2,1,2,0,1,1]" by eval

definition "f3 \<equiv>
  \<lparr>nodes = {1::nat,2,5,6,7,8,10},
   edges = {(1,2),(2,8),
            (5,6),(6,7),(7,8),(8,10)}\<rparr>"

definition "f4 \<equiv>
  \<lparr>nodes = {1::nat,2,5,6,7,8,10},
   edges = {(1,2),(2,7),
            (5,6),(6,8),(8,10)}\<rparr>"

definition "f6 \<equiv>
  \<lparr>nodes = {1::nat,4,5,7,8},
   edges = {(1,4),(4,5),(5,7),(7,8)}\<rparr>"

definition "f7 \<equiv>
  \<lparr>nodes = {1::nat,5,7,10},
   edges = {(1,10),(5,7),(7,10)}\<rparr>"

definition "f8 \<equiv>
  \<lparr>nodes = {1::nat,5,7,10},
   edges = {(1,5),(5,7),(7,10)}\<rparr>"

definition "f5 \<equiv>
  \<lparr>nodes = {1::nat,3,5,6,7,8,10},
   edges = {(1,3),(3,6),
            (5,6),(6,7),(7,8),(8,10)}\<rparr>"

definition "f9 \<equiv>
  \<lparr>nodes = {1::nat,5},
   edges = {}\<rparr>"

value "(encoding_to_graph 3 (graph_to_encoding f3 3 5)) =f3"
value "(encoding_to_graph 3 (graph_to_encoding f4 3 5)) =f4"
value "(encoding_to_graph 3 (graph_to_encoding f5 3 5)) =f5"
value "(encoding_to_graph 3 (graph_to_encoding f6 3 5)) =f6"
value "(encoding_to_graph 3 (graph_to_encoding f7 3 5)) =f7"
value "(encoding_to_graph 3 (graph_to_encoding f8 3 5)) =f8"
value "(encoding_to_graph 3 (graph_to_encoding f9 3 5)) =f9"*)

 text \<open>Define locales for the encoding and the forest to represent them canonically.\<close>
 locale encoding =
   fixes L  :: "nat list"
   and   x1 :: "nat"
   and   x2 :: "nat"
 assumes L_valid: "length L = x1+x2+1"
                  "set (take x1 L) \<subseteq> {0,1} "
                  "set (drop x1 L) \<subseteq> {0,1,2}"
                  "set (drop (x1+x2) L) \<subseteq> {0,1}"

 text \<open>This is a function that finds the edges that are incident to the given vertex.\<close>
 definition edges_v :: "nat graph \<Rightarrow> nat \<Rightarrow> (nat \<times> nat) set" where
          " edges_v g v \<equiv> {e. e \<in> edges g \<and> (fst e = v \<or> snd e = v)}"

 locale forest =
   fixes T  :: "nat graph"
   and   x1 :: "nat"
   and   x2 :: "nat"
 assumes Ed_valid: "x1+2 \<in> nodes T"
                   "\<forall> (v)\<in> fst`edges T. card(snd`(edges_v T v)-{v})<2"
                   "\<forall> (v)\<in> snd`edges T. card(fst`(edges_v T v)-{v})<3"
                   "\<forall> (v,v')\<in> edges T. ( v<v')"
                   "nodes T \<noteq> {}"
                   "edges T \<noteq> {}"
                   "Max (nodes T) < x1+x2+3"

 text \<open>This is a test section with a simplified theory. Its purpose is to define the direction of
the future research. A single tree with one leaf can be encoded as a set of its nodes. The encoding
for such a tree is just a list of Bool values, True for "node in the graph" and False for "not". \<close>
definition "valid_tree S n \<equiv> (\<forall>x. x \<in> S \<longrightarrow> 0 < x \<and> x \<le> n)"
definition "valid_encoding B n \<equiv> length B = n \<and> set B \<subseteq> {True, False}"

 text \<open>Non-recursive definitions allow to use induction and prove some simple theorems.\<close>
fun tree_to_encoding :: "nat \<Rightarrow> nat \<Rightarrow> nat set \<Rightarrow> bool list" where
"tree_to_encoding x n S = map (\<lambda>i. i \<in> S) [x..<x+n]"

fun encoding_to_tree :: " nat \<Rightarrow> bool list \<Rightarrow> nat set" where
"encoding_to_tree n B = (\<lambda>i. i + n) ` {i. i < length B \<and> B ! i}"

text \<open>To show that two functions form a bijection, one should first check that the
outputs are well-defined.\<close>
lemma length_tree_to_encoding:
  "length (tree_to_encoding x n S) = n"
  by (induct x n S rule: tree_to_encoding.induct) auto

lemma encoding_members:
  "set (tree_to_encoding x n S) \<subseteq> {True, False}"
  by (induct x n S rule: tree_to_encoding.induct) auto

lemma valid_tree_to_valid_encoding:
  "valid_encoding (tree_to_encoding x n S) n"
  unfolding valid_encoding_def
  using encoding_members length_tree_to_encoding by auto

lemma valid_encoding_to_valid_tree_aux:
  "encoding_to_tree n B \<subseteq> {n..<n + length B}"
  by (induction n B rule: encoding_to_tree.induct)
     (auto simp: valid_encoding_def valid_tree_def)

lemma valid_encoding_to_valid_tree:
  "valid_encoding B n \<Longrightarrow> valid_tree (encoding_to_tree 1 B ) n"
  using valid_encoding_to_valid_tree_aux unfolding valid_encoding_def valid_tree_def
  by force

end


section \<open>Convex Hulls\<close>

text \<open>We define the notion of convex hull of a set or list of vectors and derive basic
  properties thereof.\<close>

theory Convex_Hull
  imports Cone
begin

context gram_schmidt
begin

definition "convex_lincomb c Vs b = (nonneg_lincomb c Vs b \<and> sum c Vs = 1)"

definition "convex_lincomb_list c Vs b = (nonneg_lincomb_list c Vs b \<and> sum c {0..<length Vs} = 1)"

definition "convex_hull Vs = {x. \<exists> Ws c. finite Ws \<and> Ws \<subseteq> Vs \<and> convex_lincomb c Ws x}"

lemma convex_hull_carrier[intro]: "Vs \<subseteq> carrier_vec n \<Longrightarrow> convex_hull Vs \<subseteq> carrier_vec n"
  unfolding convex_hull_def convex_lincomb_def nonneg_lincomb_def by auto

lemma convex_hull_mono: "Vs \<subseteq> Ws \<Longrightarrow> convex_hull Vs \<subseteq> convex_hull Ws"
  unfolding convex_hull_def by auto

lemma convex_lincomb_empty[simp]: "\<not> (convex_lincomb c {} x)"
  unfolding convex_lincomb_def by simp

lemma set_in_convex_hull:
  assumes "A \<subseteq> carrier_vec n"
  shows "A \<subseteq> convex_hull A"
proof
  fix a
  assume "a \<in> A"
  hence acarr: "a \<in> carrier_vec n" using assms by auto
  hence "convex_lincomb (\<lambda> x. 1) {a} a " unfolding convex_lincomb_def
    by (auto simp: nonneg_lincomb_def lincomb_def)
  then show "a \<in> convex_hull A" using \<open>a \<in> A\<close> unfolding convex_hull_def by auto
qed

lemma convex_hull_empty[simp]:
  "convex_hull {} = {}"
  "A \<subseteq> carrier_vec n \<Longrightarrow> convex_hull A = {} \<longleftrightarrow> A = {}"
proof -
  show "convex_hull {} = {}" unfolding convex_hull_def by auto
  then show "A \<subseteq> carrier_vec n \<Longrightarrow> convex_hull A = {} \<longleftrightarrow> A = {}"
    using set_in_convex_hull[of A] by auto
qed

lemma convex_hull_bound: assumes XBnd: "X \<subseteq> Bounded_vec Bnd"
  and X: "X \<subseteq> carrier_vec n"
shows "convex_hull X \<subseteq> Bounded_vec Bnd"
proof
  fix x
  assume "x \<in> convex_hull X"
  from this[unfolded convex_hull_def]
  obtain Y c where fin: "finite Y" and YX: "Y \<subseteq> X" and cx: "convex_lincomb c Y x" by auto
  from cx[unfolded convex_lincomb_def nonneg_lincomb_def]
  have x: "x = lincomb c Y" and sum: "sum c Y = 1" and c0: "\<And> y. y \<in> Y \<Longrightarrow> c y \<ge> 0" by auto
  from YX X XBnd have Y: "Y \<subseteq> carrier_vec n" and YBnd: "Y \<subseteq> Bounded_vec Bnd" by auto
  from x Y have dim: "dim_vec x = n" by auto
  show "x \<in> Bounded_vec Bnd" unfolding Bounded_vec_def mem_Collect_eq dim
  proof (intro allI impI)
    fix i
    assume i: "i < n"
    have "abs (x $ i) = abs (\<Sum>x\<in>Y. c x * x $ i)" unfolding x
      by (subst lincomb_index[OF i Y], auto)
    also have "\<dots> \<le> (\<Sum>x\<in>Y. abs (c x * x $ i))" by auto
    also have "\<dots> = (\<Sum>x\<in>Y. abs (c x) * abs (x $ i))" by (simp add: abs_mult)
    also have "\<dots> \<le> (\<Sum>x\<in>Y. abs (c x) * Bnd)"
      by (intro sum_mono mult_left_mono, insert YBnd[unfolded Bounded_vec_def] i Y, force+)
    also have "\<dots> = (\<Sum>x\<in>Y. abs (c x)) * Bnd"
      by (simp add: sum_distrib_right)
    also have "(\<Sum>x\<in>Y. abs (c x)) = (\<Sum>x\<in>Y. c x)"
      by (rule sum.cong, insert c0, auto)
    also have "\<dots> = 1" by fact
    finally show "\<bar>x $ i\<bar> \<le> Bnd" by auto
  qed
qed

definition "convex_hull_list Vs = {x. \<exists> c. convex_lincomb_list c Vs x}"

lemma lincomb_list_elem:
  "set Vs \<subseteq> carrier_vec n \<Longrightarrow>
   lincomb_list (\<lambda> j. if i=j then 1 else 0) Vs = (if i < length Vs then Vs ! i else 0\<^sub>v n)"
proof (induction Vs rule: rev_induct)
  case (snoc x Vs)
  have x: "x \<in> carrier_vec n" and Vs: "set Vs \<subseteq> carrier_vec n" using snoc.prems by auto
  let ?f = "\<lambda> j. if i = j then 1 else 0"
  have "lincomb_list ?f (Vs @ [x]) = lincomb_list ?f Vs + ?f (length Vs) \<cdot>\<^sub>v x"
    using x Vs by simp
  also have "\<dots> = (if i < length (Vs @ [x]) then (Vs @ [x]) ! i else 0\<^sub>v n)" (is ?goal)
    using less_linear[of i "length Vs"]
  proof (elim disjE)
    assume i: "i < length Vs"
    have "lincomb_list (\<lambda>j. if i = j then 1 else 0) Vs = Vs ! i"
      using snoc.IH[OF Vs] i by auto
    moreover have "(if i = length Vs then 1 else 0) \<cdot>\<^sub>v x = 0\<^sub>v n" using i x by auto
    moreover have "(if i < length (Vs @ [x]) then (Vs @ [x]) ! i else 0\<^sub>v n) = Vs ! i"
      using i append_Cons_nth_left by fastforce
    ultimately show ?goal using Vs i lincomb_list_carrier M.r_zero by metis
  next
    assume i: "i = length Vs"
    have "lincomb_list (\<lambda>j. if i = j then 1 else 0) Vs = 0\<^sub>v n"
      using snoc.IH[OF Vs] i by auto
    moreover have "(if i = length Vs then 1 else 0) \<cdot>\<^sub>v x = x" using i x by auto
    moreover have "(if i < length (Vs @ [x]) then (Vs @ [x]) ! i else 0\<^sub>v n) = x"
      using i append_Cons_nth_left by simp
    ultimately show ?goal using x by simp
  next
    assume i: "i > length Vs"
    have "lincomb_list (\<lambda>j. if i = j then 1 else 0) Vs = 0\<^sub>v n"
      using snoc.IH[OF Vs] i by auto
    moreover have "(if i = length Vs then 1 else 0) \<cdot>\<^sub>v x = 0\<^sub>v n" using i x by auto
    moreover have "(if i < length (Vs @ [x]) then (Vs @ [x]) ! i else 0\<^sub>v n) = 0\<^sub>v n"
      using i by simp
    ultimately show ?goal by simp
  qed
  finally show ?case by auto
qed simp

lemma set_in_convex_hull_list: fixes Vs :: "'a vec list"
  assumes "set Vs \<subseteq> carrier_vec n"
  shows "set Vs \<subseteq> convex_hull_list Vs"
proof
  fix x assume "x \<in> set Vs"
  then obtain i where i: "i < length Vs"
    and x: "x = Vs ! i" using set_conv_nth[of Vs] by auto
  let ?f = "\<lambda> j. if i = j then 1 else 0 :: 'a"
  have "lincomb_list ?f Vs = x" using i x lincomb_list_elem[OF assms] by auto
  moreover have "\<forall> j < length Vs. ?f j \<ge> 0" by auto
  moreover have "sum ?f {0..<length Vs} = 1" using i by simp
  ultimately show "x \<in> convex_hull_list Vs"
    unfolding convex_hull_list_def convex_lincomb_list_def nonneg_lincomb_list_def
    by auto
qed

lemma convex_hull_list_combination:
  assumes Vs: "set Vs \<subseteq> carrier_vec n"
    and x: "x \<in> convex_hull_list Vs"
    and y: "y \<in> convex_hull_list Vs"
    and l0: "0 \<le> l" and l1: "l \<le> 1"
  shows "l \<cdot>\<^sub>v x + (1 - l) \<cdot>\<^sub>v y \<in> convex_hull_list Vs"
proof -
  from x obtain cx where x: "lincomb_list cx Vs = x" and cx0: "\<forall> i < length Vs. cx i \<ge> 0"
    and cx1: "sum cx {0..<length Vs} = 1"
    unfolding convex_hull_list_def convex_lincomb_list_def nonneg_lincomb_list_def
    by auto
  from y obtain cy where y: "lincomb_list cy Vs = y" and cy0: "\<forall> i < length Vs. cy i \<ge> 0"
    and cy1: "sum cy {0..<length Vs} = 1"
    unfolding convex_hull_list_def convex_lincomb_list_def nonneg_lincomb_list_def
    by auto
  let ?c = "\<lambda> i. l * cx i + (1 - l) * cy i"
  have "set Vs \<subseteq> carrier_vec n \<Longrightarrow>
        lincomb_list ?c Vs = l \<cdot>\<^sub>v lincomb_list cx Vs + (1 - l) \<cdot>\<^sub>v lincomb_list cy Vs"
  proof (induction Vs rule: rev_induct)
    case (snoc v Vs)
    have v: "v \<in> carrier_vec n" and Vs: "set Vs \<subseteq> carrier_vec n"
      using snoc.prems by auto
    have "lincomb_list ?c (Vs @ [v]) = lincomb_list ?c Vs + ?c (length Vs) \<cdot>\<^sub>v v"
      using snoc.prems by auto
    also have "lincomb_list ?c Vs =
               l \<cdot>\<^sub>v lincomb_list cx Vs + (1 - l) \<cdot>\<^sub>v lincomb_list cy Vs"
      by (rule snoc.IH[OF Vs])
    also have "?c (length Vs) \<cdot>\<^sub>v v =
               l \<cdot>\<^sub>v (cx (length Vs) \<cdot>\<^sub>v v) + (1 - l) \<cdot>\<^sub>v (cy (length Vs) \<cdot>\<^sub>v v)"
      using add_smult_distrib_vec smult_smult_assoc by metis
    also have "l \<cdot>\<^sub>v lincomb_list cx Vs + (1 - l) \<cdot>\<^sub>v lincomb_list cy Vs + \<dots> =
                  l \<cdot>\<^sub>v (lincomb_list cx Vs + cx (length Vs) \<cdot>\<^sub>v v) +
                  (1 - l) \<cdot>\<^sub>v (lincomb_list cy Vs + cy (length Vs) \<cdot>\<^sub>v v)"
      using lincomb_list_carrier[OF Vs] v
      by (simp add: M.add.m_assoc M.add.m_lcomm smult_r_distr)
    finally show ?case using Vs v by simp
  qed simp
  hence "lincomb_list ?c Vs = l \<cdot>\<^sub>v x + (1 - l) \<cdot>\<^sub>v y" using Vs x y by simp
  moreover have "\<forall> i < length Vs. ?c i \<ge> 0" using cx0 cy0 l0 l1 by simp
  moreover have "sum ?c {0..<length Vs} = 1"
  proof(simp add: sum.distrib)
    have "(\<Sum>i = 0..<length Vs. (1 - l) * cy i) = (1 - l) * sum cy {0..<length Vs}"
      using sum_distrib_left by metis
    moreover have "(\<Sum>i = 0..<length Vs. l * cx i) = l * sum cx {0..<length Vs}"
      using sum_distrib_left by metis
    ultimately show "(\<Sum>i = 0..<length Vs. l * cx i) + (\<Sum>i = 0..<length Vs. (1 - l) * cy i) = 1"
      using cx1 cy1 by simp
  qed
  ultimately show ?thesis
    unfolding convex_hull_list_def convex_lincomb_list_def nonneg_lincomb_list_def
    by auto
qed

lemma convex_hull_list_mono:
  assumes "set Ws \<subseteq> carrier_vec n"
  shows "set Vs \<subseteq> set Ws \<Longrightarrow> convex_hull_list Vs \<subseteq> convex_hull_list Ws"
proof (standard, induction Vs)
  case Nil
  from Nil(2) show ?case unfolding convex_hull_list_def convex_lincomb_list_def by auto
next
  case (Cons v Vs)
  have v: "v \<in> set Ws" and Vs: "set Vs \<subseteq> set Ws" using Cons.prems(1) by auto
  hence v1: "v \<in> convex_hull_list Ws" using set_in_convex_hull_list[OF assms] by auto
  from Cons.prems(2) obtain c
    where x: "lincomb_list c (v # Vs) = x" and c0: "\<forall> i < length Vs + 1. c i \<ge> 0"
      and c1: "sum c {0..<length Vs + 1} = 1"
    unfolding convex_hull_list_def convex_lincomb_list_def nonneg_lincomb_list_def
    by auto
  have x: "x = c 0 \<cdot>\<^sub>v v + lincomb_list (c \<circ> Suc) Vs" using Vs v assms x by auto

  show ?case proof (cases)
    assume P: "c 0 = 1"
    hence "sum (c \<circ> Suc) {0..<length Vs} = 0"
      using sum.atLeast0_lessThan_Suc_shift c1
      by (metis One_nat_def R.show_r_zero add.right_neutral add_Suc_right)
    moreover have "\<And> i. i \<in> {0..<length Vs} \<Longrightarrow> (c \<circ> Suc) i \<ge> 0"
      using c0 by simp
    ultimately have "\<forall> i \<in> {0..<length Vs}. (c \<circ> Suc) i = 0"
      using sum_nonneg_eq_0_iff by blast
    hence "\<And> i. i < length Vs \<Longrightarrow> (c \<circ> Suc) i \<cdot>\<^sub>v Vs ! i = 0\<^sub>v n"
      using Vs assms by (simp add: subset_code(1))
    hence "lincomb_list (c \<circ> Suc) Vs = 0\<^sub>v n"
      using lincomb_list_eq_0 by simp
    hence "x = v" using P x v assms by auto
    thus ?case using v1 by auto

  next

    assume P: "c 0 \<noteq> 1"
    have c1: "c 0 + sum (c \<circ> Suc) {0..<length Vs} = 1"
      using sum.atLeast0_lessThan_Suc_shift[of c] c1 by simp
    have "sum (c \<circ> Suc) {0..<length Vs} \<ge> 0" by (rule sum_nonneg, insert c0, simp)
    hence "c 0 < 1" using P c1 by auto
    let ?c' = "\<lambda> i. 1 / (1 - c 0) * (c \<circ> Suc) i"
    have "sum ?c' {0..<length Vs} = 1 / (1 - c 0) * sum (c \<circ> Suc) {0..<length Vs}"
      using c1 P sum_distrib_left by metis
    hence "sum ?c' {0..<length Vs} = 1" using P c1 by simp
    moreover have "\<forall> i < length Vs. ?c' i \<ge> 0" using c0 `c 0 < 1` by simp
    ultimately have c': "lincomb_list ?c' Vs \<in> convex_hull_list Ws"
      using Cons.IH[OF Vs]
        convex_hull_list_def convex_lincomb_list_def nonneg_lincomb_list_def
      by blast
    have "lincomb_list ?c' Vs = 1 / (1 - c 0) \<cdot>\<^sub>v lincomb_list (c \<circ> Suc) Vs"
      by(rule lincomb_list_smult, insert Vs assms, auto)
    hence "(1 - c 0) \<cdot>\<^sub>v lincomb_list ?c' Vs = lincomb_list (c \<circ> Suc) Vs"
      using P by auto
    hence "x = c 0 \<cdot>\<^sub>v v + (1 - c 0) \<cdot>\<^sub>v lincomb_list ?c' Vs" using x by auto
    thus "x \<in> convex_hull_list Ws"
      using convex_hull_list_combination[OF assms v1 c'] c0 `c 0 < 1`
      by simp
  qed
qed

lemma convex_hull_list_eq_set:
  "set Vs \<subseteq> carrier_vec n \<Longrightarrow> set Vs = set Ws \<Longrightarrow> convex_hull_list Vs = convex_hull_list Ws"
  using convex_hull_list_mono by blast

lemma find_indices_empty: "(find_indices x Vs = []) = (x \<notin> set Vs)"
proof (induction Vs rule: rev_induct)
  case (snoc v Vs)
  show ?case
  proof
    assume "find_indices x (Vs @ [v]) = []"
    hence "x \<noteq> v \<and> find_indices x Vs = []" by auto
    thus "x \<notin> set (Vs @ [v])" using snoc by simp
  next
    assume "x \<notin> set (Vs @ [v])"
    hence "x \<noteq> v \<and> find_indices x Vs = []" using snoc by auto
    thus "find_indices x (Vs @ [v]) = []" by simp
  qed
qed simp

lemma distinct_list_find_indices:
  shows "\<lbrakk> i < length Vs; Vs ! i = x; distinct Vs \<rbrakk> \<Longrightarrow> find_indices x Vs = [i]"
proof (induction Vs rule: rev_induct)
  case (snoc v Vs)
  have dist: "distinct Vs" and xVs: "v \<notin> set Vs" using snoc.prems(3) by(simp_all)
  show ?case
  proof (cases)
    assume i: "i = length Vs"
    hence "x = v" using snoc.prems(2) by auto
    thus ?case using xVs find_indices_empty i
      by fastforce
  next
    assume "i \<noteq> length Vs"
    hence i: "i < length Vs" using snoc.prems(1) by simp
    hence Vsi: "Vs ! i = x" using snoc.prems(2) append_Cons_nth_left by fastforce
    hence "x \<noteq> v" using snoc.prems(3) i by auto
    thus ?case using snoc.IH[OF i Vsi dist] by simp
  qed
qed auto

lemma finite_convex_hull_iff_convex_hull_list: assumes Vs: "Vs \<subseteq> carrier_vec n"
  and id': "Vs = set Vsl'"
shows "convex_hull Vs = convex_hull_list Vsl'"
proof -
  have fin: "finite Vs" unfolding id' by auto
  from finite_distinct_list fin obtain Vsl
    where id: "Vs = set Vsl" and dist: "distinct Vsl" by auto
  from Vs id have Vsl: "set Vsl \<subseteq> carrier_vec n" by auto
  {
    fix c :: "nat \<Rightarrow> 'a"
    have "distinct Vsl \<Longrightarrow>(\<Sum>x\<in>set Vsl. sum_list (map c (find_indices x Vsl))) =
                          sum c {0..<length Vsl}"
    proof (induction Vsl rule: rev_induct)
      case (snoc v Vsl)
      let ?coef = "\<lambda> x. sum_list (map c (find_indices x (Vsl @ [v])))"
      let ?coef' = "\<lambda> x. sum_list (map c (find_indices x Vsl))"
      have dist: "distinct Vsl" using snoc.prems by simp
      have "sum ?coef (set (Vsl @ [v])) = sum_list (map ?coef (Vsl @ [v]))"
        by (rule sum.distinct_set_conv_list[OF snoc.prems, of ?coef])
      also have "\<dots> = sum_list (map ?coef Vsl) + ?coef v" by simp
      also have "sum_list (map ?coef Vsl) = sum ?coef (set Vsl)"
        using sum.distinct_set_conv_list[OF dist, of ?coef] by auto
      also have "\<dots> = sum ?coef' (set Vsl)"
      proof (intro R.finsum_restrict[of ?coef] restrict_ext, standard)
        fix x
        assume "x \<in> set Vsl"
        then obtain i where i: "i < length Vsl" and x: "x = Vsl ! i"
          using in_set_conv_nth[of x Vsl] by blast
        hence "(Vsl @ [v]) ! i = x" by (simp add: append_Cons_nth_left)
        hence "?coef x = c i"
          using distinct_list_find_indices[OF _ _ snoc.prems] i by fastforce
        also have  "c i = ?coef' x"
          using distinct_list_find_indices[OF i _ dist] x by simp
        finally show "?coef x = ?coef' x" by auto
      qed
      also have "\<dots> = sum c {0..<length Vsl}" by (rule snoc.IH[OF dist])
      also have "?coef v = c (length Vsl)"
        using distinct_list_find_indices[OF _ _ snoc.prems, of "length Vsl" v]
          nth_append_length by simp
      finally show ?case using sum.atLeast0_lessThan_Suc by simp
    qed simp
  } note sum_sumlist = this
  {
    fix b
    assume "b \<in> convex_hull_list Vsl"
    then obtain c where b: "lincomb_list c Vsl = b" and c: "(\<forall> i < length Vsl. c i \<ge> 0)"
      and c1: "sum c {0..<length Vsl} = 1"
      unfolding convex_hull_list_def convex_lincomb_list_def nonneg_lincomb_list_def
      by auto
    have "convex_lincomb (mk_coeff Vsl c) Vs b"
      unfolding b[symmetric] convex_lincomb_def nonneg_lincomb_def
      apply (subst lincomb_list_as_lincomb[OF Vsl])
      by (insert c c1, auto simp: id mk_coeff_def dist sum_sumlist intro!: sum_list_nonneg)
    hence "b \<in> convex_hull Vs"
      unfolding convex_hull_def convex_lincomb_def using fin by blast
  }
  moreover
  {
    fix b
    assume "b \<in> convex_hull Vs"
    then obtain c Ws where Ws: "Ws \<subseteq> Vs" and b: "lincomb c Ws = b"
      and c: "c ` Ws \<subseteq> {x. x \<ge> 0}" and c1: "sum c Ws = 1"
      unfolding convex_hull_def convex_lincomb_def nonneg_lincomb_def by auto
    let ?d = "\<lambda> x. if x \<in> Ws then c x else 0"
    have "lincomb ?d Vs = lincomb c Ws + lincomb (\<lambda> x. 0) (Vs - Ws)"
      using lincomb_union2[OF _ _ Diff_disjoint[of Ws Vs], of c "\<lambda> x. 0"]
        fin Vs Diff_partition[OF Ws] by metis
    also have "lincomb (\<lambda> x. 0) (Vs - Ws) = 0\<^sub>v n"
      using lincomb_zero[of "Vs - Ws" "\<lambda> x. 0"] Vs by auto
    finally have "lincomb ?d Vs = b" using b lincomb_closed Vs Ws by auto
    moreover have "?d ` Vs \<subseteq> {t. t \<ge> 0}" using c by auto
    moreover have "sum ?d Vs = 1" using  c1 R.extend_sum[OF fin Ws] by auto
    ultimately have "\<exists> c. convex_lincomb c Vs b"
      unfolding convex_lincomb_def nonneg_lincomb_def by blast
  }
  moreover
  {
    fix b
    assume "\<exists> c. convex_lincomb c Vs b"
    then obtain c where b: "lincomb c Vs = b" and c: "c ` Vs \<subseteq> {x. x \<ge> 0}"
      and c1: "sum c Vs = 1"
      unfolding convex_lincomb_def nonneg_lincomb_def by auto
    from lincomb_as_lincomb_list_distinct[OF Vsl dist, of c]
    have b: "lincomb_list (\<lambda>i. c (Vsl ! i)) Vsl = b"
      unfolding b[symmetric] id by simp
    have "1 = sum c (set Vsl)" using c1 id by auto
    also have "\<dots> = sum_list (map c Vsl)" by(rule sum.distinct_set_conv_list[OF dist])
    also have "\<dots> = sum ((!) (map c Vsl)) {0..<length Vsl}"
      using sum_list_sum_nth length_map by metis
    also have "\<dots> = sum (\<lambda> i. c (Vsl ! i)) {0..<length Vsl}" by simp
    finally have sum_1: "(\<Sum>i = 0..<length Vsl. c (Vsl ! i)) = 1" by simp

    have "\<exists> c. convex_lincomb_list c Vsl b"
      unfolding convex_lincomb_list_def nonneg_lincomb_list_def
      by (intro exI[of _ "\<lambda>i. c (Vsl ! i)"] conjI b sum_1)
        (insert c, force simp: set_conv_nth id)
    hence "b \<in> convex_hull_list Vsl" unfolding convex_hull_list_def by auto
  }
  ultimately have "convex_hull Vs = convex_hull_list Vsl" by auto
  also have "convex_hull_list Vsl = convex_hull_list Vsl'"
    using convex_hull_list_eq_set[OF Vsl, of Vsl'] id id' by simp
  finally show ?thesis by simp
qed

definition "convex S = (convex_hull S = S)"

lemma convex_convex_hull: "convex S \<Longrightarrow> convex_hull S = S"
  unfolding convex_def by auto

lemma convex_hull_convex_hull_listD: assumes A: "A \<subseteq> carrier_vec n"
  and x: "x \<in> convex_hull A"
shows "\<exists> as. set as \<subseteq> A \<and> x \<in> convex_hull_list as"
proof -
  from x[unfolded convex_hull_def]
  obtain X c where finX: "finite X" and XA: "X \<subseteq> A" and "convex_lincomb c X x" by auto
  hence x: "x \<in> convex_hull X" unfolding convex_hull_def by auto
  from finite_list[OF finX] obtain xs where X: "X = set xs" by auto
  from finite_convex_hull_iff_convex_hull_list[OF _ this] x XA A have x: "x \<in> convex_hull_list xs" by auto
  thus ?thesis using XA unfolding X by auto
qed

lemma convex_hull_convex_sum: assumes A: "A \<subseteq> carrier_vec n"
  and x: "x \<in> convex_hull A"
  and y: "y \<in> convex_hull A"
  and a: "0 \<le> a" "a \<le> 1"
shows "a \<cdot>\<^sub>v x + (1 - a) \<cdot>\<^sub>v y \<in> convex_hull A"
proof -
  from convex_hull_convex_hull_listD[OF A x] obtain xs where xs: "set xs \<subseteq> A"
    and x: "x \<in> convex_hull_list xs" by auto
  from convex_hull_convex_hull_listD[OF A y] obtain ys where ys: "set ys \<subseteq> A"
    and y: "y \<in> convex_hull_list ys" by auto
  have fin: "finite (set (xs @ ys))" by auto
  have sub: "set (xs @ ys) \<subseteq> A" using xs ys by auto
  from convex_hull_list_mono[of "xs @ ys" xs] x sub A have x: "x \<in> convex_hull_list (xs @ ys)" by auto
  from convex_hull_list_mono[of "xs @ ys" ys] y sub A have y: "y \<in> convex_hull_list (xs @ ys)" by auto
  from convex_hull_list_combination[OF _ x y a]
  have "a \<cdot>\<^sub>v x + (1 - a) \<cdot>\<^sub>v y \<in> convex_hull_list (xs @ ys)" using sub A by auto
  from finite_convex_hull_iff_convex_hull_list[of _ "xs @ ys"] this sub A
  have "a \<cdot>\<^sub>v x + (1 - a) \<cdot>\<^sub>v y \<in> convex_hull (set (xs @ ys))" by auto
  with convex_hull_mono[OF sub]
  show "a \<cdot>\<^sub>v x + (1 - a) \<cdot>\<^sub>v y \<in> convex_hull A" by auto
qed

lemma convexI: assumes S: "S \<subseteq> carrier_vec n"
  and step: "\<And> a x y. x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> 0 \<le> a \<Longrightarrow> a \<le> 1 \<Longrightarrow> a \<cdot>\<^sub>v x + (1 - a) \<cdot>\<^sub>v y \<in> S"
shows "convex S"
  unfolding convex_def
proof (standard, standard)
  fix z
  assume "z \<in> convex_hull S"
  from this[unfolded convex_hull_def] obtain W c where "finite W" and WS: "W \<subseteq> S"
    and "convex_lincomb c W z" by auto
  then show "z \<in> S"
  proof (induct W arbitrary: c z)
    case empty
    thus ?case unfolding convex_lincomb_def by auto
  next
    case (insert w W c z)
    have "convex_lincomb c (insert w W) z" by fact
    hence zl: "z = lincomb c (insert w W)" and nonneg: "\<And> w. w \<in> W \<Longrightarrow> 0 \<le> c w"
      and cw: "c w \<ge> 0"
      and sum: "sum c (insert w W) = 1"
      unfolding convex_lincomb_def nonneg_lincomb_def by auto
    have zl: "z = c w \<cdot>\<^sub>v w + lincomb c W" unfolding zl
      by (rule lincomb_insert2, insert insert S, auto)
    have sum: "c w + sum c W = 1" unfolding sum[symmetric]
      by (subst sum.insert, insert insert, auto)
    have W: "W \<subseteq> carrier_vec n" and w: "w \<in> carrier_vec n" using S insert by auto
    show ?case
    proof (cases "sum c W = 0")
      case True
      with nonneg have c0: "\<And> w. w \<in> W \<Longrightarrow> c w = 0"
        using insert(1) sum_nonneg_eq_0_iff by auto
      with sum have cw: "c w = 1" by auto
      have lin0: "lincomb c W = 0\<^sub>v n"
        by (intro lincomb_zero W, insert c0, auto)
      have "z = w" unfolding zl cw lin0 using w by simp
      with insert(4) show ?thesis by simp
    next
      case False
      have "sum c W \<ge> 0" using nonneg by (metis sum_nonneg)
      with False have pos: "sum c W > 0" by auto
      define b where "b = (\<lambda> w. inverse (sum c W) * c w)"
      have "convex_lincomb b W (lincomb b W)"
        unfolding convex_lincomb_def nonneg_lincomb_def b_def
      proof (intro conjI refl)
        show "(\<lambda>w. inverse (sum c W) * c w) ` W \<subseteq> Collect ((\<le>) 0)" using nonneg pos by auto
        show "(\<Sum>w\<in>W. inverse (sum c W) * c w) = 1" unfolding sum_distrib_left[symmetric] using False by auto
      qed
      from insert(3)[OF _ this] insert
      have IH: "lincomb b W \<in> S" by auto
      have lin: "lincomb c W = sum c W \<cdot>\<^sub>v lincomb b W"
        unfolding b_def
        by (subst lincomb_smult[symmetric, OF W], rule lincomb_cong[OF _ W], insert False, auto)
      from sum cw pos have sum: "sum c W = 1 - c w" and cw1: "c w \<le> 1" by auto
      show ?thesis unfolding zl lin unfolding sum
        by (rule step[OF _ IH cw cw1], insert insert, auto)
    qed
  qed
next
  show "S \<subseteq> convex_hull S" using S by (rule set_in_convex_hull)
qed

lemma convex_hulls_are_convex: assumes "A \<subseteq> carrier_vec n"
  shows "convex (convex_hull A)"
  by (intro convexI convex_hull_convex_sum convex_hull_carrier assms)

lemma convex_hull_sum: assumes A: "A \<subseteq> carrier_vec n" and B: "B \<subseteq> carrier_vec n"
  shows "convex_hull (A + B) = convex_hull A + convex_hull B"
proof
  note cA = convex_hull_carrier[OF A]
  note cB = convex_hull_carrier[OF B]
  have "convex (convex_hull A + convex_hull B)"
  proof (intro convexI sum_carrier_vec convex_hull_carrier A B)
    fix a :: 'a and x1 x2
    assume "x1 \<in> convex_hull A + convex_hull B" "x2 \<in> convex_hull A + convex_hull B"
    then obtain y1 y2 z1 z2 where
      x12: "x1 = y1 + z1" "x2 = y2 + z2" and
      y12: "y1 \<in> convex_hull A" "y2 \<in> convex_hull A" and
      z12: "z1 \<in> convex_hull B" "z2 \<in> convex_hull B"
      unfolding set_plus_def by auto
    from y12 z12 cA cB have carr:
      "y1 \<in> carrier_vec n" "y2 \<in> carrier_vec n"
      "z1 \<in> carrier_vec n" "z2 \<in> carrier_vec n"
      by auto
    assume a: "0 \<le> a" "a \<le> 1"
    have A: "a \<cdot>\<^sub>v y1 + (1 - a) \<cdot>\<^sub>v y2 \<in> convex_hull A" using y12 a A by (metis convex_hull_convex_sum)
    have B: "a \<cdot>\<^sub>v z1 + (1 - a) \<cdot>\<^sub>v z2 \<in> convex_hull B" using z12 a B by (metis convex_hull_convex_sum)
    have "a \<cdot>\<^sub>v x1 + (1 - a) \<cdot>\<^sub>v x2 = (a \<cdot>\<^sub>v y1 + a \<cdot>\<^sub>v z1) + ((1 - a) \<cdot>\<^sub>v y2 + (1 - a) \<cdot>\<^sub>v z2)" unfolding x12
      using carr by (auto simp: smult_add_distrib_vec)
    also have "\<dots> = (a \<cdot>\<^sub>v y1 + (1 - a) \<cdot>\<^sub>v y2) + (a \<cdot>\<^sub>v z1 + (1 - a) \<cdot>\<^sub>v z2)" using carr
      by (intro eq_vecI, auto)
    finally show "a \<cdot>\<^sub>v x1 + (1 - a) \<cdot>\<^sub>v x2 \<in> convex_hull A + convex_hull B"
      using A B by auto
  qed
  from convex_convex_hull[OF this]
  have id: "convex_hull (convex_hull A + convex_hull B) = convex_hull A + convex_hull B" .
  show "convex_hull (A + B) \<subseteq> convex_hull A + convex_hull B"
    by (subst id[symmetric], rule convex_hull_mono[OF set_plus_mono2]; intro set_in_convex_hull A B)
  show "convex_hull A + convex_hull B \<subseteq> convex_hull (A + B)"
  proof
    fix x
    assume "x \<in> convex_hull A + convex_hull B"
    then obtain y z where x: "x = y + z" and y: "y \<in> convex_hull A" and z: "z \<in> convex_hull B"
      by (auto simp: set_plus_def)
    from convex_hull_convex_hull_listD[OF A y] obtain ys where ysA: "set ys \<subseteq> A" and
      y: "y \<in> convex_hull_list ys" by auto
    from convex_hull_convex_hull_listD[OF B z] obtain zs where zsB: "set zs \<subseteq> B" and
      z: "z \<in> convex_hull_list zs" by auto
    from y[unfolded convex_hull_list_def convex_lincomb_list_def nonneg_lincomb_list_def]
    obtain c where yid: "y = lincomb_list c ys"
      and conv_c: "(\<forall>i<length ys. 0 \<le> c i) \<and> sum c {0..<length ys} = 1"
      by auto
    from z[unfolded convex_hull_list_def convex_lincomb_list_def nonneg_lincomb_list_def]
    obtain d where zid: "z = lincomb_list d zs"
      and conv_d: "(\<forall>i<length zs. 0 \<le> d i) \<and> sum d {0..<length zs} = 1"
      by auto
    from ysA A have ys: "set ys \<subseteq> carrier_vec n" by auto
    from zsB B have zs: "set zs \<subseteq> carrier_vec n" by auto
    have [intro, simp]: "lincomb_list x ys \<in> carrier_vec n" for x using lincomb_list_carrier[OF ys] .
    have [intro, simp]: "lincomb_list x zs \<in> carrier_vec n" for x using lincomb_list_carrier[OF zs] .
    have dim[simp]: "dim_vec (lincomb_list d zs) = n" by auto
    from yid have y: "y \<in> carrier_vec n" by auto
    from zid have z: "z \<in> carrier_vec n" by auto
    {
      fix x
      assume "x \<in> set (map ((+) y) zs)"
      then obtain z where "x = y + z" and "z \<in> set zs" by auto
      then obtain j where j: "j < length zs" and x: "x = y + zs ! j" unfolding set_conv_nth by auto
      hence mem: "zs ! j \<in> set zs" by auto
      hence zsj: "zs ! j \<in> carrier_vec n" using zs by auto
      let ?list = "(map (\<lambda> y. y + zs ! j) ys)"
      let ?set = "set ?list"
      have set: "?set \<subseteq> carrier_vec n" using ys A zsj by auto
      have lin_map: "lincomb_list c ?list \<in> carrier_vec n"
        by (intro lincomb_list_carrier[OF set])
      have "y + (zs ! j) = lincomb_list c ?list"
        unfolding yid using zsj lin_map lincomb_list_index[OF _ set] lincomb_list_index[OF _ ys]
        by (intro eq_vecI, auto simp: field_simps sum_distrib_right[symmetric] conv_c)
      hence "convex_lincomb_list c ?list (y + (zs ! j))"
        unfolding convex_lincomb_list_def nonneg_lincomb_list_def using conv_c by auto
      hence "y + (zs ! j) \<in> convex_hull_list ?list" unfolding convex_hull_list_def by auto
      with finite_convex_hull_iff_convex_hull_list[OF set refl]
      have "(y + zs ! j) \<in> convex_hull ?set" by auto
      also have "\<dots> \<subseteq> convex_hull (A + B)"
        by (rule convex_hull_mono, insert mem ys ysA zsB, force simp: set_plus_def)
      finally have "x \<in> convex_hull (A + B)" unfolding x .
    } note step1 = this
    {
      let ?list = "map ((+) y) zs"
      let ?set = "set ?list"
      have set: "?set \<subseteq> carrier_vec n" using zs B y by auto
      have lin_map: "lincomb_list d ?list \<in> carrier_vec n"
        by (intro lincomb_list_carrier[OF set])
      have [simp]: "i < n \<Longrightarrow> (\<Sum>j = 0..<length zs. d j * (y + zs ! j) $ i) =
        (\<Sum>j = 0..<length zs. d j * (y $ i + zs ! j $ i))" for i
        by (rule sum.cong, insert zs[unfolded set_conv_nth] y, auto)
      have "y + z = lincomb_list d ?list"
        unfolding zid using y zs lin_map lincomb_list_index[OF _ set] lincomb_list_index[OF _ zs]
          set lincomb_list_carrier[OF zs, of d] zs[unfolded set_conv_nth]
        by (intro eq_vecI, auto simp: field_simps sum_distrib_right[symmetric] conv_d)
      hence "convex_lincomb_list d ?list x" unfolding x
        unfolding convex_lincomb_list_def nonneg_lincomb_list_def using conv_d by auto
      hence "x \<in> convex_hull_list ?list" unfolding convex_hull_list_def by auto
      with finite_convex_hull_iff_convex_hull_list[OF set refl]
      have "x \<in> convex_hull ?set" by auto
      also have "\<dots> \<subseteq> convex_hull (convex_hull (A + B))"
        by (rule convex_hull_mono, insert step1, auto)
      also have "\<dots> = convex_hull (A + B)"
        by (rule convex_convex_hull[OF convex_hulls_are_convex], intro sum_carrier_vec A B)
      finally show "x \<in> convex_hull (A + B)" .
    }
  qed
qed

lemma convex_hull_in_cone:
  "convex_hull C \<subseteq> cone C"
  unfolding convex_hull_def cone_def convex_lincomb_def finite_cone_def by auto

lemma convex_cone:
  assumes C: "C \<subseteq> carrier_vec n"
  shows "convex (cone C)"
  unfolding convex_def
  using convex_hull_in_cone set_in_convex_hull[OF cone_carrier[OF C]] cone_cone[OF C]
  by blast

end
end