theory Formula_prices
imports HML_def Main
begin

function expr_1 :: "('a, 'x) HML_formula \<Rightarrow>  nat"
and expr_neg_1 :: "('a, 'x)HML_neg_formula \<Rightarrow> nat"
  where
expr_pos: \<open>expr_1 (HML_poss_2 \<alpha> \<phi>) = 1 + (expr_1 \<phi>)\<close>
| expr_1_conj: \<open>expr_1 (HML_conj_2 I F) = (Max ({(expr_neg_1 (F i)) |i. i\<in>I} \<union> {0}))\<close>
| expr_1_neg: \<open>expr_neg_1 (HML_neg_2 \<phi>) = expr_1 \<phi>\<close>
| expr_1_no_neg: \<open>expr_neg_1 (HML_no_neg \<phi>) = expr_1 \<phi>\<close>
| expr_1_true: \<open>expr_1 HML_true = 0\<close>
  apply (metis HML_formula.exhaust HML_neg_formula.exhaust old.sum.exhaust)
                apply simp+
  done
termination sorry

value "expr_1 (HML_conj_2 {} F)" (* 0 *)

function (sequential) expr_2 :: "('a, 'x) HML_formula \<Rightarrow> nat"
and expr_neg_2 :: "('a, 'x)HML_neg_formula \<Rightarrow> nat"
where
expr_2_true: \<open>expr_2 HML_true = 1\<close>
| expr_2_pos: \<open>expr_2 (HML_poss_2 \<alpha> \<phi>) = expr_2 \<phi>\<close>
| expr_2_conj: \<open>expr_2 (HML_conj_2 I F) = (if I = {} then 1 else
  (Max ({(expr_neg_2 (F i)) |i. i\<in>I} \<union> {1+(Max {(expr_neg_2 (F i)) |i. i\<in>I})})))\<close>
| expr_2_neg: \<open>expr_neg_2 (HML_neg_2 \<phi>) = expr_2 \<phi>\<close>
| expr_2_no_neg: \<open>expr_neg_2 (HML_no_neg \<phi>) = expr_2 \<phi>\<close>
  apply (metis HML_neg_formula.exhaust expr_1.cases old.sum.exhaust)
                apply simp+
  done
termination sorry

value "expr_2 (HML_poss_2 a HML_true)"
value "expr_2 (HML_conj_2 {} F)"

(* value "Max ({}::nat set)" *)

(*abbreviation neg_set :: "('a, 'x)HML_formula  \<Rightarrow> ('a, 'x) HML_neg_formula set"
  where
\<open>neg_set (HML_conj_2 I F) \<equiv> ({(F i) |i. i\<in>I \<and> (\<exists>f. (F i) = HML_neg_2 f)})\<close>*)

function (sequential) neg_set :: "('a, 'x)HML_formula \<Rightarrow> ('a, 'x) HML_neg_formula set"
  where
    "neg_set (HML_conj_2 I F) = (if I = {} then {} else {(F i) | i. i \<in> I \<and> (\<exists>f. (F i) = HML_neg_2 f)})"
  | "neg_set _ = {}"
  using expr_1.cases by blast+
termination sorry

value "card ({}::(nat set))"

lemma "neg_set (HML_poss_2 a HML_true) = {}"
  by simp

function (sequential) pos_set :: "('a, 'x)HML_formula \<Rightarrow> ('a, 'x) HML_neg_formula set"
  where
\<open>pos_set (HML_conj_2 I F) = {(F i) |i. i\<in>I} - (neg_set (HML_conj_2 I F))\<close>
| \<open>pos_set _ = {}\<close>
  using neg_set.cases apply blast
       apply fastforce+
  done
termination sorry

value "pos_set (HML_conj_2 {} F)"

function (sequential) r_set :: "('a, 'x)HML_formula \<Rightarrow>  ('a, 'x) HML_neg_formula set"
  where
\<open>r_set (HML_conj_2 I F) =
(if (pos_set (HML_conj_2 I F)) = {} then {}
else {(F i)
    |i. (F i) \<in> (pos_set (HML_conj_2 I F))
      \<and> (expr_neg_1 (F i)) = (Max {(expr_neg_1 (F j)) |j. (F j)\<in>(pos_set (HML_conj_2 I F))})})\<close>
| \<open>r_set _ = {}\<close>
  using expr_1.cases apply blast
       apply simp+
  done
termination sorry

function expr_3 :: "('a, 'x) HML_formula \<Rightarrow> nat"
and expr_neg_3 :: "('a, 'x)HML_neg_formula \<Rightarrow> nat"
where
expr_3_true: \<open>expr_3 HML_true = 0\<close>
| expr_3_pos: \<open>expr_3 (HML_poss_2 \<alpha> \<phi>) = expr_3 \<phi>\<close>
| expr_3_conj: \<open>expr_3 (HML_conj_2 I F) = (if I = {} then 0 else
(Max ({(expr_neg_3 (F i)) |i. i\<in>I} \<union> {Max {(expr_neg_1 (F i))|i. (F i) \<in> (pos_set (HML_conj_2 I F))}})))\<close> (*TODO*)
| expr_3_neg: \<open>expr_neg_3 (HML_neg_2 \<phi>) = expr_3 \<phi>\<close>
| expr_3_no_neg: \<open>expr_neg_3 (HML_no_neg \<phi>) = expr_3 \<phi>\<close>
apply (metis expr_1.cases expr_neg_2.cases obj_sumE)
                apply simp+
  done
termination sorry

value "expr_3 (HML_poss_2 a HML_true)"
value "expr_3 (HML_conj_2 {} F)"

(* Neg := {i \<in> I| \<exists>\<phi>\<^sub>i. \<psi>\<^sub>i = \<not>\<phi>\<^sub>i}*)

function expr_4 :: "('a, 'x) HML_formula \<Rightarrow> nat"
and expr_neg_4 :: "('a, 'x)HML_neg_formula \<Rightarrow> nat"
where
expr_4_true: \<open>expr_4 HML_true = 1\<close>
| expr_4_pos: \<open>expr_4 (HML_poss_2 \<alpha> \<phi>) = expr_4 \<phi>\<close>
| expr_4_conj: \<open>expr_4 (HML_conj_2 I F) = (if I = {} then 0 else
 (Max ({(expr_neg_4 (F i)) |i. i\<in>I} \<union> {Max {(expr_neg_1 (F i))|i. (F i) \<in> ((pos_set (HML_conj_2 I F)) - (r_set (HML_conj_2 I F)))}})))\<close> (*TODO*)
| expr_4_neg: \<open>expr_neg_4 (HML_neg_2 \<phi>) = expr_4 \<phi>\<close>
| expr_4_no_neg: \<open>expr_neg_4 (HML_no_neg \<phi>) = expr_4 \<phi>\<close>
apply (metis expr_1.cases expr_neg_3.cases obj_sumE)
apply simp+
  done
termination sorry

function expr_5 :: "('a, 'x) HML_formula \<Rightarrow> nat"
and expr_neg_5 :: "('a, 'x)HML_neg_formula \<Rightarrow> nat"
where
expr_5_true: \<open>expr_5 HML_true = 0\<close>
| expr_5_pos: \<open>expr_5 (HML_poss_2 \<alpha> \<phi>) = expr_5 \<phi>\<close>
| expr_5_conj: \<open>expr_5 (HML_conj_2 I F) = (if I = {} then 0 else
(Max ({(expr_neg_5 (F i)) |i. i\<in>I} \<union> {Max {(expr_neg_1 (F i))|i. (F i) \<in> (neg_set (HML_conj_2 I F))}})))\<close> (*TODO*)
| expr_5_neg: \<open>expr_neg_5 (HML_neg_2 \<phi>) = expr_5 \<phi>\<close>
| expr_5_no_neg: \<open>expr_neg_5 (HML_no_neg \<phi>) = expr_5 \<phi>\<close>
                 apply (metis HML_neg_formula.exhaust expr_4.cases sumE)
                apply simp+
  done
termination sorry

function expr_6 :: "('a, 'x) HML_formula \<Rightarrow> nat"
and expr_neg_6 :: "('a, 'x)HML_neg_formula \<Rightarrow> nat"
where
expr_6_true: \<open>expr_6 HML_true = 0\<close>
| expr_6_pos: \<open>expr_6 (HML_poss_2 \<alpha> \<phi>) = expr_6 \<phi>\<close>
| expr_6_conj: \<open>expr_6 (HML_conj_2 I F) = (Max ({0} \<union> {(expr_neg_6 (F i)) |i. i\<in>I}))\<close> (*TODO*)
| expr_6_neg: \<open>expr_neg_6 (HML_neg_2 \<phi>) = 1 + expr_6 \<phi>\<close>
| expr_6_no_neg: \<open>expr_neg_6 (HML_no_neg \<phi>) = expr_6 \<phi>\<close>
                 apply (metis HML_neg_formula.exhaust expr_5.cases obj_sumE)
                apply simp+
  done

fun expr :: "('a, 'x)HML_formula \<Rightarrow> nat \<times> nat \<times> nat \<times>  nat \<times> nat \<times> nat"
  where
\<open>expr \<phi> = (expr_1 \<phi>, expr_2 \<phi>, expr_3 \<phi>, expr_4 \<phi>, expr_5 \<phi>, expr_6 \<phi>)\<close>

(*<a>\<And>{\<not><a>}*)
value "expr (HML_conj_2 {} F)"
value "expr ((HML_poss_2 a) HML_true)"

thm Sup
thm Max_def

value "Max {}"
value "(Max \<emptyset>)"

end


theory isar
imports Main

begin
(* Propositional Logic *)
lemma "A \<longrightarrow> A"
proof
  assume a : "A"
  show "A" by (rule a) (*remove naming, replace by .*)
qed

lemma "A \<longrightarrow> (A \<and> A)"
proof
  assume A
  show "A \<and> A" by (rule conjI) (* implicit proofs by assumption *)
qed

lemma "A \<longrightarrow> (A \<and> A)"
proof
  assume A
  show "A \<and> A" ..
qed

end


section\<open>Examples on Proving Inequalities\<close>
theory Ex_Ineqs
imports
  Affine_Code
  Float_Real
begin
text\<open>\label{sec:examples}\<close>

text \<open>The examples below are taken from
  @{url "http://link.springer.com/chapter/10.1007/978-3-642-38088-4_26"},
  ``Formal Verification of Nonlinear Inequalities with Taylor Interval Approximations'',
  Alexey Solovyev, Thomas C. Hales,
  NASA Formal Methods 2013, LNCS 7871
\<close>

primrec prove_pos::"nat \<Rightarrow> nat \<Rightarrow> real \<Rightarrow> real \<Rightarrow>
    (nat \<Rightarrow> real \<Rightarrow> 'a::executable_euclidean_space aform \<Rightarrow> _ \<Rightarrow> real aform option) \<Rightarrow>
    'a::executable_euclidean_space aform \<Rightarrow> bool" where
  "prove_pos 0 p t st F X = False"
| "prove_pos (Suc i) p t st F X = (if 0 < Inf_aform' p (the (F p t X [])) then True else
    let (a, b) = split_aform_largest p st X in prove_pos i p t st F a \<and> prove_pos i p t st F b
    )"

approximate_affine schwefel "\<lambda>(x1, x2, x3).
  (FloatR 58806 0 * inverse (FloatR 6103515625 14) +
    (x1 + - (x2*x2))*(x1 + - (x2*x2)) +
    (x2 + - 1)*(x2 + - 1) +
    (x1 + - (x3*x3))*(x1 + - (x3*x3)) +
    (x3 + - 1)*(x3 + - 1))*\<^sub>R1::real"

lemma
  "prove_pos 80 20 (FloatR  1 (-1)) (FloatR 1 1) schwefel (aform_of_ivl (-10,-10,-10) (10,10,10))"
  by eval \<comment>"slow: 100s"

approximate_affine delta6 "\<lambda>(x1, x2, x3, x4, x5, x6).
  (x1 * x4 * (-x1 + x2 + x3 + -x4 + x5 + x6) +
   x2 * x5 * (x1 + -x2 + x3 + x4 + - x5 + x6) +
   x3 * x6 * (x1 + x2 + - x3 + x4 + x5 + -x6) +
   - x2 * x3 * x4 +
   - x1 * x3 * x5 +
   - x1 * x2 * x6 +
   - x4 * x5 * x6)*\<^sub>R1::real"

definition "mk_tuple6 x = (x, x, x, x, x, x)"

lemma "prove_pos 20 10 (FloatR 1 (-1)) (FloatR 1 1) delta6
    (aform_of_ivl (mk_tuple6 4) (mk_tuple6 (FloatR 104045 (-14))))"
  by eval

definition "mk_tuple7 x = (x, x, x, x, x, x, x)"

approximate_affine magnetism "\<lambda>(x1, x2, x3, x4, x5, x6, x7).
  (FloatR 409616384 (-14) + x1 * x1 + 2 * x2*x2 + 2 * x3 * x3 + 2 * x4 * x4 + 2 * x5 * x5 +
  2 * x6 * x6 + 2 * x7 * x7 + - x1) *\<^sub>R 1::real"

lemma
  "prove_pos 20 10 (FloatR 1 (-1)) (FloatR 1 1) magnetism
    (aform_of_ivl (mk_tuple7 (-1)) (mk_tuple7 1))"
  by eval

definition "mk_tuple4 x = (x, x, x, x)"
approximate_affine caprasse "\<lambda>(x1, x2, x3, x4).
  (FloatR 7160948587500457 (-51) + - x1 * x3 * x3 * x3 + 4 * x2 * x3 * x3 * x4 +
    4 * x1 * x3 * x4 * x4 + 2 * x2 * x4 * x4 * x4 + 4 * x1 * x3 + 4 * x3 * x3 + - 10 * x2 * x4 +
    -10 * x4 * x4 + 2)*\<^sub>R1::real"

lemma
  "prove_pos 50 40 (FloatR 1 (-3)) (FloatR 1 (-1)) caprasse
    (aform_of_ivl (mk_tuple4 (- FloatR 1 (-1))) (mk_tuple4 (FloatR 1 (-1))))"
  by eval

end


section \<open>A simple example demonstrating parallelism for code generated towards Isabelle/ML\<close>

theory Parallel_Example
imports Complex_Main "HOL-Library.Parallel" "HOL-Library.Debug"
begin

subsection \<open>Compute-intensive examples.\<close>

subsubsection \<open>Fragments of the harmonic series\<close>

definition harmonic :: "nat \<Rightarrow> rat" where
  "harmonic n = sum_list (map (\<lambda>n. 1 / of_nat n) [1..<n])"

subsubsection \<open>The sieve of Erathostenes\<close>

text \<open>
  The attentive reader may relate this ad-hoc implementation to the
  arithmetic notion of prime numbers as a little exercise.
\<close>

primrec mark :: "nat \<Rightarrow> nat \<Rightarrow> bool list \<Rightarrow> bool list" where
  "mark _ _ [] = []"
| "mark m n (p # ps) = (case n of 0 \<Rightarrow> False # mark m m ps
    | Suc n \<Rightarrow> p # mark m n ps)"

lemma length_mark [simp]:
  "length (mark m n ps) = length ps"
  by (induct ps arbitrary: n) (simp_all split: nat.split)

function sieve :: "nat \<Rightarrow> bool list \<Rightarrow> bool list" where
  "sieve m ps = (case dropWhile Not ps
   of [] \<Rightarrow> ps
    | p#ps' \<Rightarrow> let n = m - length ps' in takeWhile Not ps @ p # sieve m (mark n n ps'))"
by pat_completeness auto

termination \<comment> \<open>tuning of this proof is left as an exercise to the reader\<close>
  apply (relation "measure (length \<circ> snd)")
  apply rule
  apply (auto simp add: length_dropWhile_le)
proof -
  fix ps qs q
  assume "dropWhile Not ps = q # qs"
  then have "length (q # qs) = length (dropWhile Not ps)" by simp
  then have "length qs < length (dropWhile Not ps)" by simp
  moreover have "length (dropWhile Not ps) \<le> length ps"
    by (simp add: length_dropWhile_le)
  ultimately show "length qs < length ps" by auto
qed

primrec natify :: "nat \<Rightarrow> bool list \<Rightarrow> nat list" where
  "natify _ [] = []"
| "natify n (p#ps) = (if p then n # natify (Suc n) ps else natify (Suc n) ps)"

primrec list_primes where
  "list_primes (Suc n) = natify 1 (sieve n (False # replicate n True))"

subsubsection \<open>Naive factorisation\<close>

function factorise_from :: "nat \<Rightarrow> nat \<Rightarrow> nat list" where
  "factorise_from k n = (if 1 < k \<and> k \<le> n
    then
      let (q, r) = Divides.divmod_nat n k
      in if r = 0 then k # factorise_from k q
        else factorise_from (Suc k) n
    else [])"
by pat_completeness auto

termination factorise_from \<comment> \<open>tuning of this proof is left as an exercise to the reader\<close>
  apply (relation "measure (\<lambda>(k, n). 2 * n - k)")
    apply (auto simp add: prod_eq_iff algebra_simps elim!: dvdE)
  apply (case_tac "k \<le> ka * 2")
   apply (auto intro: diff_less_mono)
  done

definition factorise :: "nat \<Rightarrow> nat list" where
  "factorise n = factorise_from 2 n"

subsection \<open>Concurrent computation via futures\<close>

definition computation_harmonic :: "unit \<Rightarrow> rat" where
  "computation_harmonic _ = Debug.timing (STR ''harmonic example'') harmonic 300"

definition computation_primes :: "unit \<Rightarrow> nat list" where
  "computation_primes _ = Debug.timing (STR ''primes example'') list_primes 4000"

definition computation_future :: "unit \<Rightarrow> nat list \<times> rat" where
  "computation_future = Debug.timing (STR ''overall computation'')
   (\<lambda>() \<Rightarrow> let c = Parallel.fork computation_harmonic
     in (computation_primes (), Parallel.join c))"

value "computation_future ()"

definition computation_factorise :: "nat \<Rightarrow> nat list" where
  "computation_factorise = Debug.timing (STR ''factorise'') factorise"

definition computation_parallel :: "unit \<Rightarrow> nat list list" where
  "computation_parallel _ = Debug.timing (STR ''overall computation'')
     (Parallel.map computation_factorise) [20000..<20100]"

value "computation_parallel ()"

end


(*<*)
theory hw10_2_tmpl
imports Trie1 "HOL-Library.List_lexord"
begin
(*>*)
(* Incomplete *)

fun path_trav :: "trie \<Rightarrow> bool list \<Rightarrow> bool list list" where
  "path_trav Leaf bs = []"
| "path_trav (Node b (x,y)) bs = (if b then ([bs] @ (path_trav x (bs@[True])) @ (path_trav y (bs@[False])))
                                    else ( (path_trav x (bs@[True])) @ (path_trav y (bs@[False]))))"

fun enum :: "trie \<Rightarrow> bool list list"
  where
    "enum Leaf = []"
  | "enum t = path_trav t []"

value "enum (Node False ((Node True (Leaf, Leaf)),Leaf))"
value "path_trav (Node False ((Node True (Leaf, Leaf)),Leaf)) []"

lemma enum_correct1: "set (enum t) = { xs. isin t xs }"
proof(induction rule: isin.induct)
  case (1 ks)
then show ?case by auto
next
case (2 b l r ks)
  then show ?case
qed

  oops

lemma enum_correct2: "sorted_wrt op< (enum t)"

    oops

lemma enum_correct:
    "set (enum t) = { xs. isin t xs }" and "sorted_wrt op< (enum t)"
    oops

text \<open>
  Note that Booleans are ordered by \<open>False < True\<close>, and
  that we imported @{theory "List_lexord"}, which defines
  a lexicographic ordering on lists, if the elements are ordered.
\<close>

value "[True,True,False] < [True,True,True,True]"

(*<*)
end
(*>*)


theory prop_12
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  fun qrev :: "'a list => 'a list => 'a list" where
  "qrev (Nil2) y = y"
  | "qrev (Cons2 z xs) y = qrev xs (Cons2 z y)"
  fun append :: "'a list => 'a list => 'a list" where
  "append (Nil2) y = y"
  | "append (Cons2 z xs) y = Cons2 z (append xs y)"
  fun rev :: "'a list => 'a list" where
  "rev (Nil2) = Nil2"
  | "rev (Cons2 y xs) = append (rev xs) (Cons2 y (Nil2))"
  (*hipster qrev append rev *)

(*hipster qrev append rev*)
lemma lemma_a [thy_expl]: "append x2 Nil2 = x2"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

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

lemma lemma_ab [thy_expl]: "append (qrev x1 y1) z1 = qrev x1 (append y1 z1)"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

lemma lemma_ac [thy_expl]: "qrev (append x1 y1) z1 = qrev y1 (qrev x1 z1)"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

lemma lemma_ad [thy_expl]: "qrev (qrev x1 y1) z1 = qrev y1 (append x1 z1)"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

lemma lemma_ae [thy_expl]: "append (rev x3) y3 = qrev x3 y3"
by (hipster_induct_schemes qrev.simps append.simps rev.simps)

  theorem x0 :
    "(qrev x y) = (append (rev x) y)"
    by (hipster_induct_schemes append.simps qrev.simps)

end


subsection \<open>Diophantine description of alpha function\<close>

theory Alpha_Sequence
  imports Modulo_Divisibility "Exponentiation"
begin

text \<open>The alpha function is diophantine\<close>
definition alpha ("[_ = \<alpha> _ _]" 1000)
  where "[X = \<alpha> B N] \<equiv> (TERNARY (\<lambda>b n x. b > 3 \<and> x = Exp_Matrices.\<alpha> b n) B N X)"

lemma alpha_dioph[dioph]:
  fixes B N X
  defines "D \<equiv> [X = \<alpha> B N]"
  shows "is_dioph_rel D"
proof -
  define r s t u v w x y where param_defs:
    "r == (Param 0)" "s == (Param 1)" "t == (Param 2)" "u == (Param 3)"  "v == (Param 4)"
    "w == (Param 5)" "x == (Param 6)" "y == (Param 7)"
  define B' X' N' where pushed_defs: "B' ==  (push_param B 8)" "X' ==  (push_param X 8)"
                                      "N' ==  (push_param N 8)"

  (* eqns. (3.41) – (3.55) from YuMat lecture notes (p. 36) where "a" = X and "c" = N here *)
  (* don't confuse capital X with x == (param 6) here, this is unhappy notation *)
  define DR1 where "DR1 \<equiv> B' [>] (Const 3) [\<and>] (Const 1 [+] B' [*] u [*] t [=] u[^2] [+] t[^2])"
  define DR2 where "DR2 \<equiv> (Const 1 [+] B' [*] s [*] r [=] s[^2] [+] r[^2]) [\<and>] r [<] s"
  define DR3 where "DR3 \<equiv> (DVD (u[^2]) s) [\<and>] (v [+] (Const 2) [*] r [=] B' [*] s)"
  define DR4 where "DR4 \<equiv> (MOD B' v w) [\<and>] (MOD (Const 2) u w) [\<and>] (Const 2) [<] w"
  define DR5 where "DR5 \<equiv> (Const 1 [+] w [*] x [*] y [=] x[^2] [+] y[^2])"
  define DR6 where "DR6 \<equiv> (Const 2) [*] X' [<] u [\<and>] (Const 2) [*] X' [<] v
                           [\<and>] (MOD x v X') [\<and>] (Const 2) [*] N' [<] u [\<and>] MOD x u N'"

  define DR where "DR \<equiv> [\<exists>8] DR1 [\<and>] DR2 [\<and>] DR3 [\<and>] DR4 [\<and>] DR5 [\<and>] DR6"
  (* definition would otherwise be too long to handle for Isabelle *)

  note DR_defs = DR1_def DR2_def DR3_def DR4_def DR5_def DR6_def

  have "is_dioph_rel DR"
    unfolding DR_def DR_defs
    by (auto simp: dioph)

  moreover have "eval D a = eval DR a" for a
  proof -
    define x_ev b n where evaled_defs: "x_ev \<equiv> peval X a" "b \<equiv> peval B a" "n \<equiv> peval N a"
    have h: "eval D a = (\<exists>r s t u v w x y::nat. Exp_Matrices.alpha_equations x_ev b n r s t u v w x y)"
      unfolding D_def alpha_def evaled_defs defs using alpha_equivalence by simp

    show ?thesis
    proof (rule)
      assume "eval D a"
      then obtain r s t u v w x y :: nat where "Exp_Matrices.alpha_equations x_ev b n r s t u v w x y"
        using h by auto
      then show "eval DR a"
        unfolding evaled_defs Exp_Matrices.alpha_equations_def
        unfolding DR_def DR_defs defs param_defs apply (auto simp: sq_p_eval)
        apply (rule exI[of _ "[r, s, t, u, v, w, x, y]"])
        unfolding pushed_defs by (auto simp add: push_push[where ?n = 8] push_list_eval)
    next
      assume "eval DR a"
      then show "eval D a"
        (* simplify "eval DR a" and undo all the pushes *)
        unfolding DR_def DR_defs defs param_defs apply (auto simp: sq_p_eval)
        unfolding pushed_defs apply (auto simp add: push_push[where ?n = 8] push_list_eval)
        (* simplify "eval D a" using the above fact h *)
        unfolding h Exp_Matrices.alpha_equations_def evaled_defs
        subgoal for ks
          apply (rule exI[of _ "ks!0"]) apply (rule exI[of _ "ks!1"]) apply (rule exI[of _ "ks!2"])
          apply (rule exI[of _ "ks!3"]) apply (rule exI[of _ "ks!4"]) apply (rule exI[of _ "ks!5"])
          apply (rule exI[of _ "ks!6"]) apply (rule exI[of _ "ks!7"])
          by simp_all
        done
    qed
  qed

  ultimately show ?thesis
    by (auto simp: is_dioph_rel_def)
qed

declare alpha_def[defs]

end