(*  Title:      HOL/ex/SAT_Examples.thy
    Author:     Alwen Tiu, Tjark Weber
    Copyright   2005-2009
*)

section \<open>Examples for proof methods "sat" and "satx"\<close>

theory SAT_Examples
imports Main
begin

(*
declare [[sat_solver = zchaff_with_proofs]]
declare [[sat_solver = minisat_with_proofs]]
declare [[sat_trace]]
*)

lemma "True"
by sat

lemma "a | ~a"
by sat

lemma "(a | b) & ~a \<Longrightarrow> b"
by sat

lemma "(a & b) | (c & d) \<Longrightarrow> (a & b) | (c & d)"
(*
apply (tactic {* CNF.cnf_rewrite_tac @{context} 1 *})
*)
by sat

lemma "(a & b) | (c & d) \<Longrightarrow> (a & b) | (c & d)"
(*
apply (tactic {* CNF.cnfx_rewrite_tac @{context} 1 *})
apply (erule exE | erule conjE)+
*)
by satx

lemma "(a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)
  \<Longrightarrow> (a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)"
(*
apply (tactic {* CNF.cnf_rewrite_tac @{context} 1 *})
*)
by sat

lemma "(a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)
  \<Longrightarrow> (a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)"
(*
apply (tactic {* CNF.cnfx_rewrite_tac @{context} 1 *})
apply (erule exE | erule conjE)+
*)
by satx

lemma "P=P=P=P=P=P=P=P=P=P"
by sat

lemma "P=P=P=P=P=P=P=P=P=P"
by satx

lemma  "!! a b c. [| a | b | c | d ;
e | f | (a & d) ;
~(a | (c & ~c)) | b ;
~(b & (x | ~x)) | c ;
~(d | False) | c ;
~(c | (~p & (p | (q & ~q)))) |] ==> False"
by sat

lemma  "!! a b c. [| a | b | c | d ;
e | f | (a & d) ;
~(a | (c & ~c)) | b ;
~(b & (x | ~x)) | c ;
~(d | False) | c ;
~(c | (~p & (p | (q & ~q)))) |] ==> False"
by satx

text \<open>eta-Equivalence\<close>

lemma "(\<forall>x. P x) \<or> \<not> All P"
by sat

declare [[sat_trace = false]]
declare [[quick_and_dirty = false]]

method_setup rawsat = \<open>
  Scan.succeed (SIMPLE_METHOD' o SAT.rawsat_tac)
\<close> "SAT solver (no preprocessing)"

(* Translated from TPTP problem library: PUZ015-2.006.dimacs *)

lemma assumes 1: "~x0"
and 2: "~x30"
and 3: "~x29"
and 4: "~x59"
and 5: "x1 | x31 | x0"
and 6: "x2 | x32 | x1"
and 7: "x3 | x33 | x2"
and 8: "x4 | x34 | x3"
and 9: "x35 | x4"
and 10: "x5 | x36 | x30"
and 11: "x6 | x37 | x5 | x31"
and 12: "x7 | x38 | x6 | x32"
and 13: "x8 | x39 | x7 | x33"
and 14: "x9 | x40 | x8 | x34"
and 15: "x41 | x9 | x35"
and 16: "x10 | x42 | x36"
and 17: "x11 | x43 | x10 | x37"
and 18: "x12 | x44 | x11 | x38"
and 19: "x13 | x45 | x12 | x39"
and 20: "x14 | x46 | x13 | x40"
and 21: "x47 | x14 | x41"
and 22: "x15 | x48 | x42"
and 23: "x16 | x49 | x15 | x43"
and 24: "x17 | x50 | x16 | x44"
and 25: "x18 | x51 | x17 | x45"
and 26: "x19 | x52 | x18 | x46"
and 27: "x53 | x19 | x47"
and 28: "x20 | x54 | x48"
and 29: "x21 | x55 | x20 | x49"
and 30: "x22 | x56 | x21 | x50"
and 31: "x23 | x57 | x22 | x51"
and 32: "x24 | x58 | x23 | x52"
and 33: "x59 | x24 | x53"
and 34: "x25 | x54"
and 35: "x26 | x25 | x55"
and 36: "x27 | x26 | x56"
and 37: "x28 | x27 | x57"
and 38: "x29 | x28 | x58"
and 39: "~x1 | ~x31"
and 40: "~x1 | ~x0"
and 41: "~x31 | ~x0"
and 42: "~x2 | ~x32"
and 43: "~x2 | ~x1"
and 44: "~x32 | ~x1"
and 45: "~x3 | ~x33"
and 46: "~x3 | ~x2"
and 47: "~x33 | ~x2"
and 48: "~x4 | ~x34"
and 49: "~x4 | ~x3"
and 50: "~x34 | ~x3"
and 51: "~x35 | ~x4"
and 52: "~x5 | ~x36"
and 53: "~x5 | ~x30"
and 54: "~x36 | ~x30"
and 55: "~x6 | ~x37"
and 56: "~x6 | ~x5"
and 57: "~x6 | ~x31"
and 58: "~x37 | ~x5"
and 59: "~x37 | ~x31"
and 60: "~x5 | ~x31"
and 61: "~x7 | ~x38"
and 62: "~x7 | ~x6"
and 63: "~x7 | ~x32"
and 64: "~x38 | ~x6"
and 65: "~x38 | ~x32"
and 66: "~x6 | ~x32"
and 67: "~x8 | ~x39"
and 68: "~x8 | ~x7"
and 69: "~x8 | ~x33"
and 70: "~x39 | ~x7"
and 71: "~x39 | ~x33"
and 72: "~x7 | ~x33"
and 73: "~x9 | ~x40"
and 74: "~x9 | ~x8"
and 75: "~x9 | ~x34"
and 76: "~x40 | ~x8"
and 77: "~x40 | ~x34"
and 78: "~x8 | ~x34"
and 79: "~x41 | ~x9"
and 80: "~x41 | ~x35"
and 81: "~x9 | ~x35"
and 82: "~x10 | ~x42"
and 83: "~x10 | ~x36"
and 84: "~x42 | ~x36"
and 85: "~x11 | ~x43"
and 86: "~x11 | ~x10"
and 87: "~x11 | ~x37"
and 88: "~x43 | ~x10"
and 89: "~x43 | ~x37"
and 90: "~x10 | ~x37"
and 91: "~x12 | ~x44"
and 92: "~x12 | ~x11"
and 93: "~x12 | ~x38"
and 94: "~x44 | ~x11"
and 95: "~x44 | ~x38"
and 96: "~x11 | ~x38"
and 97: "~x13 | ~x45"
and 98: "~x13 | ~x12"
and 99: "~x13 | ~x39"
and 100: "~x45 | ~x12"
and 101: "~x45 | ~x39"
and 102: "~x12 | ~x39"
and 103: "~x14 | ~x46"
and 104: "~x14 | ~x13"
and 105: "~x14 | ~x40"
and 106: "~x46 | ~x13"
and 107: "~x46 | ~x40"
and 108: "~x13 | ~x40"
and 109: "~x47 | ~x14"
and 110: "~x47 | ~x41"
and 111: "~x14 | ~x41"
and 112: "~x15 | ~x48"
and 113: "~x15 | ~x42"
and 114: "~x48 | ~x42"
and 115: "~x16 | ~x49"
and 116: "~x16 | ~x15"
and 117: "~x16 | ~x43"
and 118: "~x49 | ~x15"
and 119: "~x49 | ~x43"
and 120: "~x15 | ~x43"
and 121: "~x17 | ~x50"
and 122: "~x17 | ~x16"
and 123: "~x17 | ~x44"
and 124: "~x50 | ~x16"
and 125: "~x50 | ~x44"
and 126: "~x16 | ~x44"
and 127: "~x18 | ~x51"
and 128: "~x18 | ~x17"
and 129: "~x18 | ~x45"
and 130: "~x51 | ~x17"
and 131: "~x51 | ~x45"
and 132: "~x17 | ~x45"
and 133: "~x19 | ~x52"
and 134: "~x19 | ~x18"
and 135: "~x19 | ~x46"
and 136: "~x52 | ~x18"
and 137: "~x52 | ~x46"
and 138: "~x18 | ~x46"
and 139: "~x53 | ~x19"
and 140: "~x53 | ~x47"
and 141: "~x19 | ~x47"
and 142: "~x20 | ~x54"
and 143: "~x20 | ~x48"
and 144: "~x54 | ~x48"
and 145: "~x21 | ~x55"
and 146: "~x21 | ~x20"
and 147: "~x21 | ~x49"
and 148: "~x55 | ~x20"
and 149: "~x55 | ~x49"
and 150: "~x20 | ~x49"
and 151: "~x22 | ~x56"
and 152: "~x22 | ~x21"
and 153: "~x22 | ~x50"
and 154: "~x56 | ~x21"
and 155: "~x56 | ~x50"
and 156: "~x21 | ~x50"
and 157: "~x23 | ~x57"
and 158: "~x23 | ~x22"
and 159: "~x23 | ~x51"
and 160: "~x57 | ~x22"
and 161: "~x57 | ~x51"
and 162: "~x22 | ~x51"
and 163: "~x24 | ~x58"
and 164: "~x24 | ~x23"
and 165: "~x24 | ~x52"
and 166: "~x58 | ~x23"
and 167: "~x58 | ~x52"
and 168: "~x23 | ~x52"
and 169: "~x59 | ~x24"
and 170: "~x59 | ~x53"
and 171: "~x24 | ~x53"
and 172: "~x25 | ~x54"
and 173: "~x26 | ~x25"
and 174: "~x26 | ~x55"
and 175: "~x25 | ~x55"
and 176: "~x27 | ~x26"
and 177: "~x27 | ~x56"
and 178: "~x26 | ~x56"
and 179: "~x28 | ~x27"
and 180: "~x28 | ~x57"
and 181: "~x27 | ~x57"
and 182: "~x29 | ~x28"
and 183: "~x29 | ~x58"
and 184: "~x28 | ~x58"
shows "False"
using assms
(*
by sat
*)
by rawsat  \<comment> \<open>this is without CNF conversion\<close>

(* Translated from TPTP problem library: MSC007-1.008.dimacs *)

lemma assumes 1: "x0 | x1 | x2 | x3 | x4 | x5 | x6"
and 2: "x7 | x8 | x9 | x10 | x11 | x12 | x13"
and 3: "x14 | x15 | x16 | x17 | x18 | x19 | x20"
and 4: "x21 | x22 | x23 | x24 | x25 | x26 | x27"
and 5: "x28 | x29 | x30 | x31 | x32 | x33 | x34"
and 6: "x35 | x36 | x37 | x38 | x39 | x40 | x41"
and 7: "x42 | x43 | x44 | x45 | x46 | x47 | x48"
and 8: "x49 | x50 | x51 | x52 | x53 | x54 | x55"
and 9: "~x0 | ~x7"
and 10: "~x0 | ~x14"
and 11: "~x0 | ~x21"
and 12: "~x0 | ~x28"
and 13: "~x0 | ~x35"
and 14: "~x0 | ~x42"
and 15: "~x0 | ~x49"
and 16: "~x7 | ~x14"
and 17: "~x7 | ~x21"
and 18: "~x7 | ~x28"
and 19: "~x7 | ~x35"
and 20: "~x7 | ~x42"
and 21: "~x7 | ~x49"
and 22: "~x14 | ~x21"
and 23: "~x14 | ~x28"
and 24: "~x14 | ~x35"
and 25: "~x14 | ~x42"
and 26: "~x14 | ~x49"
and 27: "~x21 | ~x28"
and 28: "~x21 | ~x35"
and 29: "~x21 | ~x42"
and 30: "~x21 | ~x49"
and 31: "~x28 | ~x35"
and 32: "~x28 | ~x42"
and 33: "~x28 | ~x49"
and 34: "~x35 | ~x42"
and 35: "~x35 | ~x49"
and 36: "~x42 | ~x49"
and 37: "~x1 | ~x8"
and 38: "~x1 | ~x15"
and 39: "~x1 | ~x22"
and 40: "~x1 | ~x29"
and 41: "~x1 | ~x36"
and 42: "~x1 | ~x43"
and 43: "~x1 | ~x50"
and 44: "~x8 | ~x15"
and 45: "~x8 | ~x22"
and 46: "~x8 | ~x29"
and 47: "~x8 | ~x36"
and 48: "~x8 | ~x43"
and 49: "~x8 | ~x50"
and 50: "~x15 | ~x22"
and 51: "~x15 | ~x29"
and 52: "~x15 | ~x36"
and 53: "~x15 | ~x43"
and 54: "~x15 | ~x50"
and 55: "~x22 | ~x29"
and 56: "~x22 | ~x36"
and 57: "~x22 | ~x43"
and 58: "~x22 | ~x50"
and 59: "~x29 | ~x36"
and 60: "~x29 | ~x43"
and 61: "~x29 | ~x50"
and 62: "~x36 | ~x43"
and 63: "~x36 | ~x50"
and 64: "~x43 | ~x50"
and 65: "~x2 | ~x9"
and 66: "~x2 | ~x16"
and 67: "~x2 | ~x23"
and 68: "~x2 | ~x30"
and 69: "~x2 | ~x37"
and 70: "~x2 | ~x44"
and 71: "~x2 | ~x51"
and 72: "~x9 | ~x16"
and 73: "~x9 | ~x23"
and 74: "~x9 | ~x30"
and 75: "~x9 | ~x37"
and 76: "~x9 | ~x44"
and 77: "~x9 | ~x51"
and 78: "~x16 | ~x23"
and 79: "~x16 | ~x30"
and 80: "~x16 | ~x37"
and 81: "~x16 | ~x44"
and 82: "~x16 | ~x51"
and 83: "~x23 | ~x30"
and 84: "~x23 | ~x37"
and 85: "~x23 | ~x44"
and 86: "~x23 | ~x51"
and 87: "~x30 | ~x37"
and 88: "~x30 | ~x44"
and 89: "~x30 | ~x51"
and 90: "~x37 | ~x44"
and 91: "~x37 | ~x51"
and 92: "~x44 | ~x51"
and 93: "~x3 | ~x10"
and 94: "~x3 | ~x17"
and 95: "~x3 | ~x24"
and 96: "~x3 | ~x31"
and 97: "~x3 | ~x38"
and 98: "~x3 | ~x45"
and 99: "~x3 | ~x52"
and 100: "~x10 | ~x17"
and 101: "~x10 | ~x24"
and 102: "~x10 | ~x31"
and 103: "~x10 | ~x38"
and 104: "~x10 | ~x45"
and 105: "~x10 | ~x52"
and 106: "~x17 | ~x24"
and 107: "~x17 | ~x31"
and 108: "~x17 | ~x38"
and 109: "~x17 | ~x45"
and 110: "~x17 | ~x52"
and 111: "~x24 | ~x31"
and 112: "~x24 | ~x38"
and 113: "~x24 | ~x45"
and 114: "~x24 | ~x52"
and 115: "~x31 | ~x38"
and 116: "~x31 | ~x45"
and 117: "~x31 | ~x52"
and 118: "~x38 | ~x45"
and 119: "~x38 | ~x52"
and 120: "~x45 | ~x52"
and 121: "~x4 | ~x11"
and 122: "~x4 | ~x18"
and 123: "~x4 | ~x25"
and 124: "~x4 | ~x32"
and 125: "~x4 | ~x39"
and 126: "~x4 | ~x46"
and 127: "~x4 | ~x53"
and 128: "~x11 | ~x18"
and 129: "~x11 | ~x25"
and 130: "~x11 | ~x32"
and 131: "~x11 | ~x39"
and 132: "~x11 | ~x46"
and 133: "~x11 | ~x53"
and 134: "~x18 | ~x25"
and 135: "~x18 | ~x32"
and 136: "~x18 | ~x39"
and 137: "~x18 | ~x46"
and 138: "~x18 | ~x53"
and 139: "~x25 | ~x32"
and 140: "~x25 | ~x39"
and 141: "~x25 | ~x46"
and 142: "~x25 | ~x53"
and 143: "~x32 | ~x39"
and 144: "~x32 | ~x46"
and 145: "~x32 | ~x53"
and 146: "~x39 | ~x46"
and 147: "~x39 | ~x53"
and 148: "~x46 | ~x53"
and 149: "~x5 | ~x12"
and 150: "~x5 | ~x19"
and 151: "~x5 | ~x26"
and 152: "~x5 | ~x33"
and 153: "~x5 | ~x40"
and 154: "~x5 | ~x47"
and 155: "~x5 | ~x54"
and 156: "~x12 | ~x19"
and 157: "~x12 | ~x26"
and 158: "~x12 | ~x33"
and 159: "~x12 | ~x40"
and 160: "~x12 | ~x47"
and 161: "~x12 | ~x54"
and 162: "~x19 | ~x26"
and 163: "~x19 | ~x33"
and 164: "~x19 | ~x40"
and 165: "~x19 | ~x47"
and 166: "~x19 | ~x54"
and 167: "~x26 | ~x33"
and 168: "~x26 | ~x40"
and 169: "~x26 | ~x47"
and 170: "~x26 | ~x54"
and 171: "~x33 | ~x40"
and 172: "~x33 | ~x47"
and 173: "~x33 | ~x54"
and 174: "~x40 | ~x47"
and 175: "~x40 | ~x54"
and 176: "~x47 | ~x54"
and 177: "~x6 | ~x13"
and 178: "~x6 | ~x20"
and 179: "~x6 | ~x27"
and 180: "~x6 | ~x34"
and 181: "~x6 | ~x41"
and 182: "~x6 | ~x48"
and 183: "~x6 | ~x55"
and 184: "~x13 | ~x20"
and 185: "~x13 | ~x27"
and 186: "~x13 | ~x34"
and 187: "~x13 | ~x41"
and 188: "~x13 | ~x48"
and 189: "~x13 | ~x55"
and 190: "~x20 | ~x27"
and 191: "~x20 | ~x34"
and 192: "~x20 | ~x41"
and 193: "~x20 | ~x48"
and 194: "~x20 | ~x55"
and 195: "~x27 | ~x34"
and 196: "~x27 | ~x41"
and 197: "~x27 | ~x48"
and 198: "~x27 | ~x55"
and 199: "~x34 | ~x41"
and 200: "~x34 | ~x48"
and 201: "~x34 | ~x55"
and 202: "~x41 | ~x48"
and 203: "~x41 | ~x55"
and 204: "~x48 | ~x55"
shows "False"
using assms
(*
by sat
*)
by rawsat  \<comment> \<open>this is without CNF conversion\<close>

(* Old sequent clause representation ("[c_i, p, ~q, \<dots>] \<turnstile> False"):
   sat, zchaff_with_proofs: 8705 resolution steps in
                            +++ User 1.154  All 1.189 secs
   sat, minisat_with_proofs: 40790 resolution steps in
                             +++ User 3.762  All 3.806 secs

   rawsat, zchaff_with_proofs: 8705 resolution steps in
                               +++ User 0.731  All 0.751 secs
   rawsat, minisat_with_proofs: 40790 resolution steps in
                                +++ User 3.514  All 3.550 secs

   CNF clause representation ("[c_1 && \<dots> && c_n, p, ~q, \<dots>] \<turnstile> False"):
   rawsat, zchaff_with_proofs: 8705 resolution steps in
                               +++ User 0.653  All 0.670 secs
   rawsat, minisat_with_proofs: 40790 resolution steps in
                                +++ User 1.860  All 1.886 secs

   (as of 2006-08-30, on a 2.5 GHz Pentium 4)
*)

text \<open>
Function {\tt benchmark} takes the name of an existing DIMACS CNF
file, parses this file, passes the problem to a SAT solver, and checks
the proof of unsatisfiability found by the solver.  The function
measures the time spent on proof reconstruction (at least real time
also includes time spent in the SAT solver), and additionally returns
the number of resolution steps in the proof.
\<close>

(*
declare [[sat_solver = zchaff_with_proofs]]
declare [[sat_trace = false]]
declare [[quick_and_dirty = false]]
*)
ML \<open>
  fun benchmark dimacsfile =
    let
      val prop_fm = SAT_Solver.read_dimacs_cnf_file (Path.explode dimacsfile)
      fun and_to_list (Prop_Logic.And (fm1, fm2)) acc = and_to_list fm2 (fm1 :: acc)
        | and_to_list fm acc = rev (fm :: acc)
      val clauses = and_to_list prop_fm []
      val terms = map (HOLogic.mk_Trueprop o Prop_Logic.term_of_prop_formula) clauses
      val cterms = map (Thm.cterm_of \<^context>) terms
      val start = Timing.start ()
      val _ = SAT.rawsat_thm \<^context> cterms
    in
      (Timing.result start, ! SAT.counter)
    end;
\<close>

end


section\<open>Examples of Pseudo-Hoops\<close>

theory Examples
imports SpecialPseudoHoops LatticeProperties.Lattice_Ordered_Group
begin

declare add_uminus_conv_diff [simp del] right_minus [simp]
lemmas diff_minus = diff_conv_add_uminus

context lgroup
begin
lemma (in lgroup) less_eq_inf_2: "(x \<le> y) = (inf y x = x)"
  by (simp add: le_iff_inf inf_commute)
end

class lgroup_with_const = lgroup +
  fixes u::'a
  assumes [simp]: "0 \<le> u"

definition "G = {a::'a::lgroup_with_const. (0 \<le> a \<and> a \<le> u)}"
typedef (overloaded) 'a G = "G::'a::lgroup_with_const set"
proof
  show "0 \<in> G" by (simp add: G_def)
qed

instantiation "G" :: (lgroup_with_const) bounded_wajsberg_pseudo_hoop_algebra
begin

definition
  times_def: "a * b \<equiv> Abs_G (sup (Rep_G a - u + Rep_G b) 0)"

definition
  impl_def: "a l\<rightarrow> b \<equiv> Abs_G ((Rep_G b - Rep_G a + u) \<sqinter> u)"

lemma [simp]: "inf (Rep_G (b::'a G) - Rep_G a + u) u \<in> G"
  apply (cut_tac x = a in Rep_G)
  apply (cut_tac x = b in Rep_G)
  apply (unfold G_def)
  apply (simp_all add: diff_minus)
  apply safe
  apply (rule right_move_to_left)
  apply (rule right_move_to_left)
  apply simp
  apply (rule_tac y = 0 in order_trans)
  apply (rule left_move_to_right)
  by simp_all

definition
  impr_def: "a r\<rightarrow> b \<equiv> Abs_G (inf (u - Rep_G a + Rep_G b) u)"

lemma [simp]: "inf (u - Rep_G a + Rep_G b) u \<in> G"
  apply (cut_tac x = a in Rep_G)
  apply (cut_tac x = b in Rep_G)
  apply (unfold G_def)
  apply (simp_all add: diff_minus)
  apply safe
  apply (rule right_move_to_left)
  apply (rule right_move_to_left)
  apply simp
  apply (rule left_move_to_right)
  apply (rule_tac y = u in order_trans)
  apply  simp_all
  apply (rule right_move_to_left)
  by simp_all

definition
  one_def: "1 \<equiv> Abs_G u"

definition
  zero_def: "0 \<equiv> Abs_G 0"

definition
  order_def: "((a::'a G) \<le> b) \<equiv> (a l\<rightarrow> b = 1)"

definition
  strict_order_def: "(a::'a G) < b \<equiv> (a \<le> b \<and> \<not> b \<le> a)"

definition
  inf_def: "(a::'a G) \<sqinter> b = ((a l\<rightarrow> b) * a)"

lemma [simp]: "(u::'a) \<in> G"
  by (simp add: G_def)

lemma [simp]: "(1::'a G) * a = a"
  apply (simp add: one_def times_def)
  apply (cut_tac y = "u::'a" in Abs_G_inverse)
  apply simp_all
  apply (subgoal_tac "sup (Rep_G a) (0::'a) = Rep_G a")
  apply (simp add: Rep_G_inverse)
  apply (cut_tac x = a in Rep_G)
  apply (rule antisym)
  apply (simp add: G_def)
  by simp

lemma [simp]: "a * (1::'a G) = a"
  apply (simp add: one_def times_def)
  apply (cut_tac y = "u::'a" in Abs_G_inverse)
  apply (simp_all add: diff_minus add.assoc)
  apply (subgoal_tac "sup (Rep_G a) (0::'a) = Rep_G a")
  apply (simp add: Rep_G_inverse)
  apply (cut_tac x = a in Rep_G)
  apply (rule antisym)
  by (simp_all add: G_def)

lemma [simp]: "a l\<rightarrow> a = (1::'a G)"
  by (simp add: one_def impl_def)

lemma [simp]: "a r\<rightarrow> a = (1::'a G)"
  by (simp add: one_def impr_def diff_minus add.assoc)

lemma [simp]: "a \<in> G \<Longrightarrow> Rep_G (Abs_G a) = a"
  apply (rule Abs_G_inverse)
  by simp

lemma inf_def_1: "((a::'a G) l\<rightarrow> b) * a = Abs_G (inf (Rep_G a) (Rep_G b))"
  apply (simp add: times_def impl_def)
  apply (subgoal_tac "sup (inf (Rep_G b) (Rep_G a)) 0 = inf (Rep_G a) (Rep_G b)")
  apply simp
  apply (rule antisym)
  apply (cut_tac x = "a" in Rep_G)
  apply (cut_tac x = "b" in Rep_G)
  apply (simp add: G_def)
  apply (subgoal_tac "inf (Rep_G a) (Rep_G b) = inf (Rep_G b) (Rep_G a)")
  apply simp
  apply (rule antisym)
  by simp_all

lemma inf_def_2: "(a::'a G) * (a r\<rightarrow> b) = Abs_G (inf (Rep_G a) (Rep_G b))"
  apply (simp add: times_def impr_def)
  apply (simp add: diff_minus add.assoc [THEN sym])
  apply (simp add: add.assoc)
  apply (subgoal_tac "sup (inf (Rep_G b) (Rep_G a)) 0 = inf (Rep_G a) (Rep_G b)")
  apply simp
  apply (rule antisym)
  apply (cut_tac x = "a" in Rep_G)
  apply (cut_tac x = "b" in Rep_G)
  apply (simp add: G_def)
  apply (subgoal_tac "inf (Rep_G a) (Rep_G b) = inf (Rep_G b) (Rep_G a)")
  apply simp
  apply (rule antisym)
  by simp_all

lemma Rep_G_order: "(a \<le> b) = (Rep_G a \<le> Rep_G b)"
  apply (simp add: order_def impl_def one_def)
  apply safe
  apply (subgoal_tac "Rep_G (Abs_G (inf (Rep_G b - Rep_G a + u) u)) = Rep_G (Abs_G u)")
  apply (drule drop_assumption)
  apply simp
  apply (subst (asm) less_eq_inf_2 [THEN sym])
  apply (simp add: diff_minus)
  apply (drule_tac a = "u" and b = " Rep_G b + - Rep_G a + u" and v = "-u" in add_order_preserving_right)
  apply (simp add: add.assoc)
  apply (drule_tac a = "0" and b = " Rep_G b + - Rep_G a" and v = "Rep_G a" in add_order_preserving_right)
  apply (simp add: add.assoc)
  apply simp
  apply (subgoal_tac "Rep_G (Abs_G (inf (Rep_G b - Rep_G a + u) u)) = Rep_G (Abs_G u)")
  apply simp
  apply simp
  apply (subst less_eq_inf_2 [THEN sym])
  apply (rule right_move_to_left)
  apply simp
  apply (simp add: diff_minus)
  apply (rule right_move_to_left)
  by simp

lemma ded_left: "((a::'a G) * b) l\<rightarrow> c = a l\<rightarrow> b l\<rightarrow> c"
  apply (simp add: times_def impl_def)
  apply (simp add: diff_minus minus_add)
  apply (simp add: add.assoc [THEN sym])
  apply (simp add: inf_assoc)
  apply (subgoal_tac "inf (Rep_G c + u) u = u")
  apply (subgoal_tac "inf (u + - Rep_G a + u) u = u")
  apply simp
  apply (rule antisym)
  apply simp
  apply simp
  apply (simp add: add.assoc)
  apply (rule add_pos)
  apply (cut_tac x = a in Rep_G)
  apply (simp add: G_def)
  apply (rule left_move_to_left)
  apply simp
  apply (rule antisym)
  apply simp
  apply simp
  apply (rule add_pos_left)
  apply (cut_tac x = c in Rep_G)
  by (simp add: G_def)

lemma ded_right: "((a::'a G) * b) r\<rightarrow> c = b r\<rightarrow> a r\<rightarrow> c"
  apply (simp add: times_def impr_def)
  apply (simp add: diff_minus minus_add)
  apply (simp add: add.assoc [THEN sym])
  apply (simp add: inf_assoc)
  apply (subgoal_tac "inf (u + Rep_G c) u = u")
  apply (subgoal_tac "inf (u + - Rep_G b + u) u = u")
  apply simp
  apply (rule antisym)
  apply simp
  apply simp
  apply (simp add: add.assoc)
  apply (rule add_pos)
  apply (cut_tac x = b in Rep_G)
  apply (simp add: G_def)
  apply (rule left_move_to_left)
  apply simp
  apply (rule antisym)
  apply simp
  apply simp
  apply (rule add_pos)
  apply (cut_tac x = c in Rep_G)
  by (simp add: G_def)

lemma [simp]: "0 \<in> G"
  by (simp add: G_def)

lemma [simp]: "0 \<le> (a::'a G)"
  apply (simp add: order_def impl_def zero_def one_def diff_minus)
  apply (subgoal_tac "inf (Rep_G a + u) u = u")
  apply simp
  apply (rule antisym)
  apply simp
  apply (cut_tac x = a in Rep_G)
  apply (unfold G_def)
  apply simp
  apply (rule add_pos_left)
  by simp

lemma lemma_W1: "((a::'a G) l\<rightarrow> b) r\<rightarrow> b = (b l\<rightarrow> a) r\<rightarrow> a"
  apply (simp add: impl_def impr_def)
  apply (simp add: diff_minus minus_add)
  apply (simp add: add.assoc)
  apply (subgoal_tac "Rep_G a \<squnion> Rep_G b = Rep_G b \<squnion> Rep_G a")
  apply simp
  apply (rule antisym)
  by simp_all
  (*by (simp add: sup_commute)*)

lemma lemma_W2: "((a::'a G) r\<rightarrow> b) l\<rightarrow> b = (b r\<rightarrow> a) l\<rightarrow> a"
  apply (simp add: impl_def impr_def)
  apply (simp add: diff_minus minus_add)
  apply (simp add: add.assoc)
  apply (subgoal_tac "Rep_G a \<squnion> Rep_G b = Rep_G b \<squnion> Rep_G a")
  apply simp
  apply (rule antisym)
  by simp_all
  (*by (simp add: sup_commute)*)

instance proof
  fix a show "(1::'a G) * a = a" by simp
  fix a show "a * (1::'a G) = a" by simp
  fix a show "a l\<rightarrow> a = (1::'a G)" by simp
  fix a show "a r\<rightarrow> a = (1::'a G)" by simp
next
  fix a b have a: "((a::'a G) l\<rightarrow> b) * a = (b l\<rightarrow> a) * b"
    by (simp add: inf_def_1 inf_commute)
  show "((a::'a G) l\<rightarrow> b) * a = (b l\<rightarrow> a) * b" by (rule a)
next
  fix a b have a: "a * ((a::'a G) r\<rightarrow> b) = b * (b r\<rightarrow> a)" by (simp add: inf_def_2 inf_commute)
  show "a * ((a::'a G) r\<rightarrow> b) = b * (b r\<rightarrow> a)" by (rule a)
next
  fix a b have "!!a b . ((a::'a G) l\<rightarrow> b) * a = a * (a r\<rightarrow> b)" by (simp add: inf_def_2 inf_def_1)
  from this show "((a::'a G) l\<rightarrow> b) * a = a * (a r\<rightarrow> b)"  by simp
next
  fix a b c show "(a::'a G) * b l\<rightarrow> c = a l\<rightarrow> b l\<rightarrow> c" by (rule ded_left)
next
  fix a b c show "(a::'a G) * b r\<rightarrow> c = b r\<rightarrow> a r\<rightarrow> c" by (rule ded_right)
next
  fix a::"'a G" have "0 \<le> a" by simp
  from this show "0 \<le> a" by simp
next
  fix a b::"'a G" show "(a \<le> b) = (a l\<rightarrow> b = 1)" by (simp add: order_def)
next
  fix a b::"'a G" show "(a < b) = (a \<le> b \<and> \<not> b \<le> a)" by (simp add: strict_order_def)
next
  fix a b::"'a G" show "(a l\<rightarrow> b) r\<rightarrow> b = (b l\<rightarrow> a) r\<rightarrow> a" by (rule lemma_W1)
next
  fix a b::"'a G" show "(a r\<rightarrow> b) l\<rightarrow> b = (b r\<rightarrow> a) l\<rightarrow> a" by (rule lemma_W2)
next
  fix a b::"'a G" show "a \<sqinter> b = (a l\<rightarrow> b) * a" by (rule inf_def)
next
  fix a b::"'a G" show "a \<sqinter> b = a * (a r\<rightarrow> b)" by (simp add: inf_def inf_def_2 inf_def_1)
qed

end

context order
begin
definition
  closed_interval::"'a\<Rightarrow>'a\<Rightarrow>'a set" ("|[ _ , _ ]|" [0, 0] 900) where
  "closed_interval a b = {c . a \<le> c \<and> c \<le> b}"

definition
  "convex = {A . \<forall> a b . a \<in> A \<and> b \<in> A \<longrightarrow> |[a, b]| \<subseteq> A}"

end

context group_add
begin
definition
  "subgroup = {A . 0 \<in> A \<and> (\<forall> a b . a \<in> A \<and> b \<in> A \<longrightarrow> a + b \<in> A \<and> -a \<in> A)}"

lemma [simp]: "A \<in> subgroup \<Longrightarrow> 0 \<in> A"
  by (simp add: subgroup_def)

lemma [simp]: "A \<in> subgroup \<Longrightarrow> a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> a + b \<in> A"
  apply (subst (asm) subgroup_def)
  by simp

lemma minus_subgroup: "A \<in> subgroup \<Longrightarrow> -a \<in> A \<Longrightarrow> a \<in> A"
  apply (subst (asm) subgroup_def)
  apply safe
  apply (drule_tac x="-a" in spec)
  by simp

definition
  add_set:: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set" (infixl "+++" 70) where
  "add_set A B = {c . \<exists> a \<in> A .\<exists> b \<in> B . c = a + b}"

definition
  "normal = {A . (\<forall> a . A +++ {a} = {a} +++ A)}"
end

context lgroup
begin
definition
  "lsubgroup = {A . A \<in> subgroup \<and> (\<forall> a b . a \<in> A \<and> b \<in> A \<longrightarrow> inf a b \<in> A \<and> sup a b \<in> A)}"

lemma inf_lsubgroup:
  "A \<in> lsubgroup \<Longrightarrow> a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> inf a b \<in> A"
  by (simp add: lsubgroup_def)

lemma sup_lsubgroup:
  "A \<in> lsubgroup \<Longrightarrow> a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> sup a b \<in> A"
  by (simp add: lsubgroup_def)
end

definition
  "F K = {a:: 'a G . (u::'a::lgroup_with_const) - Rep_G a \<in> K}"

context lgroup begin
lemma sup_assoc_lgroup: "a \<squnion> b \<squnion> c = a \<squnion> (b \<squnion> c)"
  by (rule sup_assoc)

end

lemma normal_1: "K \<in> normal \<Longrightarrow> K \<in> convex \<Longrightarrow> K \<in> lsubgroup \<Longrightarrow> x \<in> {a} ** F K \<Longrightarrow> x \<in> F K ** {a}"
  apply (subst (asm) times_set_def)
  apply simp
  apply safe
  apply (subst (asm) F_def2)
  apply simp_all
  apply (subgoal_tac "-u + Rep_G y \<in> K")
  apply (subgoal_tac "Rep_G a - u + Rep_G y \<in> K +++ {Rep_G a}")
  apply (subst (asm) add_set_def)
  apply simp
  apply safe
  apply (simp add: times_set_def)
  apply (rule_tac x = "Abs_G (inf (sup (aa + u) 0) u)" in bexI)
  apply (subgoal_tac "aa =  Rep_G a - u + Rep_G y - Rep_G a")
  apply (subgoal_tac "inf (sup (aa + u) (0::'a)) u \<in> G")
  apply safe
  apply simp
  apply (simp add: times_def)
  apply (subgoal_tac "(sup (Rep_G a - u + Rep_G y) 0) = (sup (inf (sup (Rep_G a - u + Rep_G y - Rep_G a + u - u + Rep_G a) (- u + Rep_G a)) (Rep_G a)) 0)")
  apply simp
  apply (simp add: diff_minus add.assoc)
  apply (subgoal_tac "inf (sup (Rep_G a + (- u + Rep_G y)) (- u + Rep_G a)) (Rep_G a) = (sup (Rep_G a + (- u + Rep_G y)) (- u + Rep_G a))")
  apply simp
  (*apply (subst sup_assoc) - why it does not work*)
  apply (subst sup_assoc_lgroup)
  apply (subgoal_tac "(sup (- u + Rep_G a) (0::'a)) = 0")
  apply simp
  apply (rule antisym)
  apply simp
  apply (rule left_move_to_right)
  apply simp
  apply (cut_tac x = a in Rep_G)
  apply (simp add: G_def)
  apply simp
  apply (rule antisym)
  apply simp
  apply simp
  apply safe
  apply (rule left_move_to_right)
  apply simp
  apply (rule left_move_to_right)
  apply simp
  apply (cut_tac x = y in Rep_G)
  apply (simp add: G_def)
  apply (rule left_move_to_right)
  apply simp
  apply (rule right_move_to_left)
  apply simp
  apply (simp add: G_def)
  apply (simp add: diff_minus)
  apply (simp add: add.assoc)
  apply (simp add: F_def)
  apply (subgoal_tac "inf (sup (aa + u) (0::'a)) u \<in> G")
  apply simp
  apply (simp add: diff_minus minus_add add.assoc [THEN sym])
  apply (subst (asm) convex_def)
  apply simp
  apply (drule_tac x = 0 in spec)
  apply (drule_tac x = "sup (- aa) 0" in spec)
  apply safe
  apply (subst (asm) lsubgroup_def)
  apply simp
  apply (rule sup_lsubgroup)
  apply simp
  apply (rule minus_subgroup)
  apply (subst (asm) lsubgroup_def)
  apply simp
  apply simp
  apply (subst (asm) lsubgroup_def)
  apply simp
  apply (subgoal_tac "sup (inf (- aa) u) (0::'a) \<in> |[ 0::'a , sup (- aa) (0::'a) ]|")
  apply blast
  apply (subst closed_interval_def)
  apply safe
  apply simp
  apply simp
(*
  apply (rule_tac y = "-aa" in order_trans)
  apply simp
  apply simp
*)
  apply (simp add: G_def)
  apply (subst (asm) normal_def)
  apply simp
  apply (drule drop_assumption)
  apply (simp add: add_set_def)
  apply (rule_tac x = "-u + Rep_G y" in bexI)
  apply (simp add: diff_minus add.assoc)
  apply simp
  apply (rule minus_subgroup)
  apply (simp add: lsubgroup_def)
  by (simp add: minus_add)

lemma normal_2: "K \<in> normal \<Longrightarrow> K \<in> convex \<Longrightarrow> K \<in> lsubgroup \<Longrightarrow> x \<in> F K ** {a} \<Longrightarrow> x \<in> {a} ** F K"
  apply (subst (asm) times_set_def)
  apply simp
  apply safe
  apply (subst (asm) F_def)
  apply simp_all
  apply hypsubst_thin
  apply (subgoal_tac "Rep_G x - u \<in> K")
  apply (subgoal_tac "Rep_G x - u + Rep_G a \<in> {Rep_G a} +++ K")
  apply (subst (asm) add_set_def)
  apply simp
  apply safe
  apply (simp add: times_set_def)
  apply (rule_tac x = "Abs_G (inf (sup (u + b) 0) u)" in bexI)
  apply (subgoal_tac "b =  - Rep_G a + Rep_G x - u + Rep_G a")
  apply (subgoal_tac "inf (sup (u + b) 0) u \<in> G")
  apply safe
  apply simp
  apply (simp add: times_def)
  apply (simp add: diff_minus add.assoc)
  apply (simp add: add.assoc [THEN sym])
  apply (subgoal_tac "sup (Rep_G x + - u + Rep_G a) 0 = sup (inf (sup (Rep_G x + - u + Rep_G a) (Rep_G a + - u)) (Rep_G a)) 0")
  apply simp
  apply (subgoal_tac "inf (sup (Rep_G x + - u + Rep_G a) (Rep_G a + - u)) (Rep_G a) = sup (Rep_G x + - u + Rep_G a) (Rep_G a + - u)")
  apply simp
  (*apply (subst sup_assoc) - why it does not work*)
  apply (subst sup_assoc_lgroup)
  apply (subgoal_tac "(sup (Rep_G a + - u) (0::'a)) = 0")
  apply simp
  apply (rule antisym)
  apply simp
  apply (rule right_move_to_right)
  apply simp
  apply (cut_tac x = a in Rep_G)
  apply (simp add: G_def)
  apply simp
  apply (rule antisym)
  apply simp
  apply simp
  apply safe
  apply (rule right_move_to_right)
  apply simp
  apply (rule right_move_to_right)
  apply simp
  apply (cut_tac x = x in Rep_G)
  apply (simp add: G_def)
  apply (rule right_move_to_right)
  apply simp
  apply (rule left_move_to_left)
  apply simp
  apply (simp add: G_def)
  apply (simp add: diff_minus)
  apply (simp add: add.assoc)
  apply (simp add: F_def2)
  apply (subgoal_tac "inf (sup (u + b) (0::'a)) u \<in> G")
  apply simp
  apply (simp add: diff_minus minus_add add.assoc [THEN sym])
  apply (subst (asm) convex_def)
  apply simp
  apply (drule_tac x = 0 in spec)
  apply (drule_tac x = "sup (- b) 0" in spec)
  apply safe
  apply (subst (asm) lsubgroup_def)
  apply simp
  apply (rule sup_lsubgroup)
  apply simp
  apply (rule minus_subgroup)
  apply (subst (asm) lsubgroup_def)
  apply simp
  apply simp
  apply (subst (asm) lsubgroup_def)
  apply simp
  apply (simp add: add.assoc)
  apply (subgoal_tac "sup (inf (- b) u) (0::'a) \<in> |[ 0::'a , sup (-b) 0]|")
  apply blast
  apply (subst closed_interval_def)
  apply safe
  apply simp
  apply simp
(*
  apply (rule_tac y = "-b" in order_trans)
  apply simp
  apply simp
*)
  apply (simp add: G_def)
  apply (subgoal_tac  "{Rep_G a} +++ K = K +++ {Rep_G a}")
  apply simp
  apply (simp add: add_set_def)
  apply (subst (asm) normal_def)
  apply simp
  apply (rule minus_subgroup)
  apply (simp add: lsubgroup_def)
  by (simp add: diff_minus minus_add)

lemma "K \<in> normal \<Longrightarrow> K \<in> convex \<Longrightarrow> K \<in> lsubgroup \<Longrightarrow> F K \<in> normalfilters"
  apply (rule lemma_3_10_ii_i)
  apply (subgoal_tac "K \<in> subgroup")
  apply (subst filters_def)
  apply safe
  apply (subgoal_tac "1 \<in> F K")
  apply simp
  apply (subst F_def)
  apply safe
  apply (subst one_def)
  apply simp
  apply (simp add: F_def)
  apply (simp add: convex_def)
  apply (drule_tac x = 0 in spec)
  apply (drule_tac x = "(u - Rep_G b) + (u - Rep_G a) " in spec)
  apply simp
  apply (subgoal_tac "u - Rep_G (a * b) \<in> |[ 0::'a , u - Rep_G b + (u - Rep_G a) ]|")
  apply blast
  apply (simp add: closed_interval_def)
  apply safe
  apply (cut_tac x = "a * b" in Rep_G)
  apply (simp add: G_def diff_minus)
  apply (rule right_move_to_left)
  apply simp
  apply (simp add: times_def)
  apply (subgoal_tac "(u - (Rep_G a - u + Rep_G b)) = u - Rep_G b + (u - Rep_G a)")
  apply simp
  apply (simp add: diff_minus add.assoc minus_add)
  apply (subst (asm) Rep_G_order)

  apply (simp add: F_def)
  apply (subst (asm) convex_def)
  apply simp
  apply (drule_tac x = 0 in spec)
  apply (drule_tac x = " u - Rep_G a" in spec)
  apply simp
  apply (subgoal_tac "u - Rep_G b \<in> |[ 0::'a , u - Rep_G a ]|")
  apply blast
  apply (subst closed_interval_def)
  apply simp
  apply safe
  apply (cut_tac x = "b" in Rep_G)
  apply (simp add: G_def)
  apply (safe)
  apply (simp add: diff_minus)
  apply (rule right_move_to_left)
  apply simp
  apply (simp add: diff_minus)
  apply (rule add_order_preserving_left)
  apply (rule minus_order)
  apply simp
  apply (simp add: lsubgroup_def)
  apply (rule normal_1)
  apply simp_all
  apply (rule normal_2)
  by simp_all

definition "N = {a::'a::lgroup. a \<le> 0}"
typedef (overloaded) ('a::lgroup) N = "N :: 'a::lgroup set"
proof
  show "0 \<in> N" by (simp add: N_def)
qed

class cancel_product_pseudo_hoop_algebra = cancel_pseudo_hoop_algebra + product_pseudo_hoop_algebra

context group_add
begin
subclass cancel_semigroup_add
proof qed
(*
  fix a b c :: 'a
  assume "a + b = a + c"
  then have "- a + a + b = - a + a + c"
    unfolding add.assoc by simp
  then show "b = c" by simp
next
  fix a b c :: 'a
  assume "b + a = c + a"
  then have "b + a + - a = c + a  + - a" by simp
  then show "b = c" unfolding add.assoc by simp
qed
*)
end

instantiation "N" :: (lgroup) pseudo_hoop_algebra
begin

definition
  times_N_def: "a * b \<equiv> Abs_N (Rep_N a +  Rep_N b)"

lemma [simp]: "Rep_N a + Rep_N b \<in> N"
  apply (cut_tac x = a in Rep_N)
  apply (cut_tac x = b in Rep_N)
  apply (simp add: N_def)
  apply (rule_tac left_move_to_right)
  apply (rule_tac y = 0 in order_trans)
  apply simp_all
  apply (rule_tac minus_order)
  by simp

definition
  impl_N_def: "a l\<rightarrow> b \<equiv> Abs_N (inf (Rep_N b - Rep_N a) 0)"

definition
  inf_N_def: "(a:: 'a N) \<sqinter> b = (a l\<rightarrow> b) * a"

lemma [simp]: "inf (Rep_N b - Rep_N a) 0 \<in> N"
  apply (cut_tac x = a in Rep_N)
  apply (cut_tac x = b in Rep_N)
  by (simp add: N_def)

definition
  impr_N_def: "a r\<rightarrow> b \<equiv> Abs_N (inf (- Rep_N a + Rep_N b) 0)"

lemma [simp]: "inf (- Rep_N a + Rep_N b) 0 \<in> N"
  apply (cut_tac x = a in Rep_N)
  apply (cut_tac x = b in Rep_N)
  by (simp add: N_def)

definition
  one_N_def: "1 \<equiv> Abs_N 0"

lemma [simp]: "0 \<in> N"
  by (simp add: N_def)

definition
  order_N_def: "((a::'a N) \<le> b) \<equiv> (a l\<rightarrow> b = 1)"

definition
  strict_order_N_def: "(a::'a N) < b \<equiv> (a \<le> b \<and> \<not> b \<le> a)"

lemma order_Rep_N:
  "((a::'a N) \<le> b) = (Rep_N a \<le> Rep_N b)"
  apply (subst order_N_def)
  apply (simp add: impl_N_def one_N_def)
  apply (subgoal_tac "(Abs_N (inf (Rep_N b - Rep_N a) (0::'a)) = Abs_N (0::'a)) = ((Rep_N (Abs_N (inf (Rep_N b - Rep_N a) (0::'a))) = Rep_N(Abs_N (0::'a))))")
  apply simp
  apply (drule drop_assumption)
  apply (simp add: Abs_N_inverse)
  apply safe
  apply (subgoal_tac "0 \<le> Rep_N b - Rep_N a")
  apply (drule_tac v = "Rep_N a" in add_order_preserving_right)
  apply (simp add: diff_minus add.assoc)
  apply (rule_tac y = "inf (Rep_N b - Rep_N a) (0::'a)" in order_trans)
  apply simp
  apply (drule drop_assumption)
  apply simp
  apply (rule antisym)
  apply simp
  apply simp
  apply (simp add: diff_minus)
  apply (rule right_move_to_left)
  apply simp
  apply simp
  by (simp add: Abs_N_inverse)

lemma order_Abs_N:
  "a \<in> N \<Longrightarrow> b \<in> N \<Longrightarrow> (a \<le> b) = (Abs_N a \<le> Abs_N b)"
  apply (subst order_N_def)
  apply (simp add: impl_N_def one_N_def)
  apply (simp add: Abs_N_inverse)
  apply (subgoal_tac "inf (b - a) 0 \<in> N")
  apply (subgoal_tac "(Abs_N (inf (b - a) (0::'a)) = Abs_N (0::'a)) = (Rep_N (Abs_N (inf (b - a) (0::'a))) = Rep_N (Abs_N (0::'a)))")
  apply simp
  apply (simp add: Abs_N_inverse)
  apply (drule drop_assumption)
  apply (drule drop_assumption)
  apply (drule drop_assumption)
  apply (drule drop_assumption)
  apply simp
  apply safe
  apply (rule antisym)
  apply simp_all
  apply (simp add: diff_minus)
  apply (rule right_move_to_left)
  apply simp
  apply (subgoal_tac "0 \<le> b - a")
  apply (drule_tac v = "a" in add_order_preserving_right)
  apply (simp add: diff_minus add.assoc)
  apply (rule_tac y = "inf (b - a) (0::'a)" in order_trans)
  apply simp
  apply (drule drop_assumption)
  apply simp
  apply (simp add: Abs_N_inverse)
  by (simp add: N_def)

lemma [simp]: "(1::'a N) * a = a"
  by (simp add: one_N_def times_N_def Abs_N_inverse Rep_N_inverse)

lemma [simp]: "a * (1::'a N) = a"
  by (simp add: one_N_def times_N_def Abs_N_inverse Rep_N_inverse)

lemma [simp]: "a l\<rightarrow> a = (1::'a N)"
  by (simp add: impl_N_def one_N_def Abs_N_inverse Rep_N_inverse)

lemma [simp]: "a r\<rightarrow> a = (1::'a N)"
  by (simp add: impr_N_def one_N_def Abs_N_inverse Rep_N_inverse)

lemma impl_times: "(a l\<rightarrow> b) * a = (b l\<rightarrow> a) * (b::'a N)"
  apply (simp add: impl_N_def impr_N_def times_N_def Abs_N_inverse Rep_N_inverse)
  apply (subgoal_tac "inf (Rep_N b - Rep_N a + Rep_N a) (Rep_N a) = inf (Rep_N a - Rep_N b + Rep_N b) (Rep_N b)")
  apply simp
  apply (subgoal_tac "Rep_N b - Rep_N a + Rep_N a = Rep_N b ")
  apply simp
  apply (subgoal_tac "Rep_N a - Rep_N b + Rep_N b = Rep_N a")
  apply simp
  apply (rule antisym)
  by simp_all

lemma impr_times: "a * (a r\<rightarrow> b) = (b::'a N) * (b r\<rightarrow> a)"
  apply (simp add: impr_N_def times_N_def Abs_N_inverse Rep_N_inverse)
  apply (subgoal_tac "inf (Rep_N a + (- Rep_N a + Rep_N b)) (Rep_N a) = inf (Rep_N b + (- Rep_N b + Rep_N a)) (Rep_N b)")
  apply simp
  apply (simp add: add.assoc [THEN sym])
  apply (rule antisym)
  by simp_all

lemma impr_impl_times: "(a l\<rightarrow> b) * a = (a::'a N) * (a r\<rightarrow> b)"
  by (simp add: impl_N_def impr_N_def times_N_def Abs_N_inverse Rep_N_inverse)

lemma impl_ded: "(a::'a N) * b l\<rightarrow> c = a l\<rightarrow> b l\<rightarrow> c"
  apply (simp add: impl_N_def impr_N_def times_N_def Abs_N_inverse Rep_N_inverse)
  apply (subgoal_tac "inf (Rep_N c - (Rep_N a + Rep_N b)) (0::'a) = inf (inf (Rep_N c - Rep_N b - Rep_N a) (- Rep_N a)) (0::'a)")
  apply simp
  apply (rule antisym)
  apply simp_all
  apply safe
  apply (rule_tac y = "Rep_N c - (Rep_N a + Rep_N b)" in order_trans)
  apply simp
  apply (simp add: diff_minus minus_add add.assoc)
  apply (rule_tac y = "0" in order_trans)
  apply simp
  apply (cut_tac x = a in "Rep_N")
  apply (simp add: N_def)
  apply (drule_tac u = 0 and v = "- Rep_N a" in add_order_preserving)
  apply simp
  apply (rule_tac y = "inf (Rep_N c - Rep_N b - Rep_N a) (- Rep_N a)" in order_trans)
  apply (rule inf_le1)
  apply (rule_tac y = "Rep_N c - Rep_N b - Rep_N a" in order_trans)
  apply simp
  by (simp add: diff_minus minus_add add.assoc)

lemma impr_ded: "(a::'a N) * b r\<rightarrow> c = b r\<rightarrow> a r\<rightarrow> c"
  apply (simp add: impr_N_def impr_N_def times_N_def Abs_N_inverse Rep_N_inverse)
  apply (subgoal_tac "inf (- (Rep_N a + Rep_N b) + Rep_N c) (0::'a) = inf (inf (- Rep_N b + (- Rep_N a + Rep_N c)) (- Rep_N b)) (0::'a)")
  apply simp
  apply (rule antisym)
  apply simp_all
  apply safe
  apply (rule_tac y = "- (Rep_N a + Rep_N b) + Rep_N c" in order_trans)
  apply simp
  apply (simp add: diff_minus minus_add add.assoc)
  apply (rule_tac y = "0" in order_trans)
  apply simp
  apply (cut_tac x = b in "Rep_N")
  apply (simp add: N_def)
  apply (drule_tac u = 0 and v = "- Rep_N b" in add_order_preserving)
  apply simp
  apply (rule_tac y = "inf (- Rep_N b + (- Rep_N a + Rep_N c)) (- Rep_N b)" in order_trans)
  apply (rule inf_le1)
  apply (rule_tac y = "- Rep_N b + (- Rep_N a + Rep_N c)" in order_trans)
  apply simp
  by (simp add: diff_minus minus_add add.assoc)

instance proof
  fix a show "(1::'a N) * a = a" by simp
  fix a show "a * (1::'a N) = a" by simp
  fix a show "a l\<rightarrow> a = (1::'a N)" by simp
  fix a show "a r\<rightarrow> a = (1::'a N)" by simp
next
  fix a b::"'a N" show "(a l\<rightarrow> b) * a = (b l\<rightarrow> a) * b" by (simp add: impl_times)
next
  fix a b::"'a N" show "a * (a r\<rightarrow> b) = b * (b r\<rightarrow> a)" by (simp add: impr_times)
next
  fix a b::"'a N" show "(a l\<rightarrow> b) * a = a * (a r\<rightarrow> b)" by (simp add: impr_impl_times)
next
  fix a b c::"'a N" show "a * b l\<rightarrow> c = a l\<rightarrow> b l\<rightarrow> c" by (simp add: impl_ded)
  fix a b c::"'a N" show "a * b r\<rightarrow> c = b r\<rightarrow> a r\<rightarrow> c" by (simp add: impr_ded)
next
  fix a b::"'a N" show "(a \<le> b) = (a l\<rightarrow> b = 1)" by (simp add: order_N_def)
next
  fix a b::"'a N" show "(a < b) = (a \<le> b \<and> \<not> b \<le> a)" by (simp add: strict_order_N_def)
next
  fix a b::"'a N" show "a \<sqinter> b = (a l\<rightarrow> b) * a" by (simp add: inf_N_def)
next
  fix a b::"'a N" show "a \<sqinter> b = a * (a r\<rightarrow> b)" by (simp add: inf_N_def impr_impl_times)
qed

end

lemma Rep_N_inf: "Rep_N ((a::'a::lgroup N) \<sqinter> b) = (Rep_N a) \<sqinter> (Rep_N b)"
  apply (rule antisym)
  apply simp_all
  apply safe
  apply (simp add: order_Rep_N [THEN sym])
  apply (simp add: order_Rep_N [THEN sym])
  apply (subgoal_tac "inf (Rep_N a) (Rep_N b) \<in> N")
  apply (subst order_Abs_N)
  apply simp_all
  apply (cut_tac x = "a \<sqinter> b" in Rep_N)
  apply (simp add: N_def)
  apply (simp add: Rep_N_inverse)
  apply safe
  apply (subst order_Rep_N)
  apply (simp add: Abs_N_inverse)
  apply (subst order_Rep_N)
  apply (simp add: Abs_N_inverse)
  apply (simp add: N_def)
  apply (rule_tac y = "Rep_N a" in order_trans)
  apply simp
  apply (cut_tac x = a in Rep_N)
  by (simp add: N_def)

context lgroup begin

lemma sup_inf_distrib2_lgroup: "(b \<sqinter> c) \<squnion> a = (b \<squnion> a) \<sqinter> (c \<squnion> a)"
  by (rule sup_inf_distrib2)

lemma inf_sup_distrib2_lgroup: "(b \<squnion> c) \<sqinter> a = (b \<sqinter> a) \<squnion> (c \<sqinter> a)"
  by (rule inf_sup_distrib2)
end

instantiation "N" :: (lgroup) cancel_product_pseudo_hoop_algebra
begin

lemma cancel_times_left: "(a::'a N) * b = a * c \<Longrightarrow> b = c"
  apply (simp add: times_N_def Abs_N_inverse Rep_N_inverse)
  apply (subgoal_tac "Rep_N (Abs_N (Rep_N a + Rep_N b)) = Rep_N (Abs_N (Rep_N a + Rep_N c))")
  apply (drule drop_assumption)
  apply (simp add: Abs_N_inverse)
  apply (subgoal_tac "Abs_N (Rep_N b) = Abs_N (Rep_N c)")
  apply (drule drop_assumption)
  apply (simp add: Rep_N_inverse)
  by simp_all

lemma cancel_times_right: "b * (a::'a N) = c * a \<Longrightarrow> b = c"
  apply (simp add: times_N_def Abs_N_inverse Rep_N_inverse)
  apply (subgoal_tac "Rep_N (Abs_N (Rep_N b + Rep_N a)) = Rep_N (Abs_N (Rep_N c + Rep_N a))")
  apply (drule drop_assumption)
  apply (simp add: Abs_N_inverse)
  apply (subgoal_tac "Abs_N (Rep_N b) = Abs_N (Rep_N c)")
  apply (drule drop_assumption)
  apply (simp add: Rep_N_inverse)
  by simp_all

lemma prod_1: "((a::'a N) l\<rightarrow> b) l\<rightarrow> c \<le> ((b l\<rightarrow> a) l\<rightarrow> c) l\<rightarrow> c"
  apply (unfold impl_N_def times_N_def Abs_N_inverse Rep_N_inverse order_N_def one_N_def)
  apply (subst Abs_N_inverse)
  apply simp
  apply (subst Abs_N_inverse)
  apply simp
  apply (subst Abs_N_inverse)
  apply simp
  apply (subst Abs_N_inverse)
  apply simp
  apply (subst Abs_N_inverse)
  apply simp
  apply (subgoal_tac "inf (inf (Rep_N c - inf (Rep_N c - inf (Rep_N a - Rep_N b) 0) 0) 0 - inf (Rep_N c - inf (Rep_N b - Rep_N a) 0) 0) 0 = 0")
  apply simp
  apply (rule antisym)
  apply simp
  apply (rule inf_greatest)
  apply (subst diff_minus)
  apply (subst diff_minus)
  apply (subst diff_minus)
  apply (subst diff_minus)
  apply (rule right_move_to_left)
  apply simp_all
  apply (simp add: diff_minus minus_add)
  (*apply (subst sup_inf_distrib2) - why it does not work*)
  apply (subst sup_inf_distrib2_lgroup)
  apply simp
  (*apply safe*)
  (*apply (subst inf_sup_distrib2) - why it does not work*)
  apply (subst inf_sup_distrib2_lgroup)
  apply simp
  (*apply safe*)
  apply (rule_tac y="Rep_N c + (Rep_N a + - Rep_N b + - Rep_N c)" in order_trans)
  apply simp_all
  apply (rule_tac y="Rep_N c + (Rep_N a + - Rep_N b)" in order_trans)
  apply simp_all
  apply (rule add_order_preserving_left)
  apply (simp add: add.assoc)
  apply (rule add_order_preserving_left)
  apply (rule left_move_to_left)
  apply simp
  apply (cut_tac x = c in Rep_N)
  apply (simp add: N_def)
  apply (rule minus_order)
  by simp

lemma prod_2: "((a::'a N) r\<rightarrow> b) r\<rightarrow> c \<le> ((b r\<rightarrow> a) r\<rightarrow> c) r\<rightarrow> c"
  apply (unfold impr_N_def times_N_def Abs_N_inverse Rep_N_inverse right_lesseq one_N_def)
  apply (subst Abs_N_inverse)
  apply simp
  apply (subst Abs_N_inverse)
  apply simp
  apply (subst Abs_N_inverse)
  apply simp
  apply (subst Abs_N_inverse)
  apply simp
  apply (subst Abs_N_inverse)
  apply simp
  apply (subgoal_tac "inf (- inf (- inf (- Rep_N a + Rep_N b) (0::'a) + Rep_N c) (0::'a) + inf (- inf (- inf (- Rep_N b + Rep_N a) (0::'a) + Rep_N c) (0::'a) + Rep_N c) (0::'a))
            (0::'a) = 0")
  apply simp
  apply (rule antisym)
  apply simp
  apply (rule inf_greatest)
  apply (rule minus_order)
  apply (subst minus_add)
  apply (subst minus_minus)
  apply (subst minus_zero)
  apply (rule left_move_to_right)
  apply (subst minus_minus)
  apply simp
  apply (simp add: minus_add)
  apply simp_all
  (*apply (subst sup_inf_distrib2) - why it does not work*)
  apply (subst sup_inf_distrib2_lgroup)
  apply simp
(*  apply safe*)
  (*apply (subst inf_sup_distrib2) - why it does not work*)
  apply (subst inf_sup_distrib2_lgroup)
  apply simp
(*  apply safe*)
  apply (rule_tac y = "- Rep_N c + (- Rep_N b + Rep_N a) + Rep_N c" in order_trans)
  apply simp_all
  apply (rule_tac y = "- Rep_N b + Rep_N a + Rep_N c" in order_trans)
  apply simp_all
  apply (rule add_order_preserving_right)
  apply (simp add: add.assoc [THEN sym])
  apply (rule add_order_preserving_right)
  apply (rule left_move_to_left)
  apply (rule right_move_to_right)
  apply simp
  apply (cut_tac x = c in Rep_N)
  by (simp add: N_def)

lemma prod_3: "(b::'a N) l\<rightarrow> b * b \<le> a \<sqinter> (a l\<rightarrow> b) l\<rightarrow> b"
  apply (simp add: impl_N_def times_N_def Abs_N_inverse Rep_N_inverse order_N_def one_N_def Rep_N_inf)
  apply (subst Abs_N_inverse)
  apply (simp add: add.assoc N_def)
  apply (subst Abs_N_inverse)
  apply (simp add: add.assoc N_def)
  apply (subgoal_tac "inf (inf (sup (Rep_N b - Rep_N a) (sup (Rep_N b - (Rep_N b - Rep_N a)) (Rep_N b))) (0::'a) - inf (Rep_N b + Rep_N b - Rep_N b) (0::'a)) (0::'a) = 0")
  apply simp
  apply (rule antisym)
  apply simp
  apply (subst diff_minus)
  apply (subst diff_minus)
  apply (subst diff_minus)
  apply (subst diff_minus)
  apply (subst diff_minus)
  apply (rule inf_greatest)
  apply (rule right_move_to_left)
  apply (subst minus_minus)
  apply simp_all
  apply (simp add: add.assoc)
  apply (rule_tac y = "Rep_N b" in order_trans)
  by simp_all

lemma prod_4: "(b::'a N) r\<rightarrow> b * b \<le> a \<sqinter> (a r\<rightarrow> b) r\<rightarrow> b"
  apply (simp add: impr_N_def times_N_def Abs_N_inverse Rep_N_inverse Rep_N_inf minus_add)
  apply (subst order_Abs_N [THEN sym])
  apply (simp add:  N_def)
  apply (simp add:  N_def)
  apply simp
  apply (rule_tac y = "- Rep_N a + Rep_N b" in order_trans)
  apply simp_all
  apply (rule_tac y = "Rep_N b" in order_trans)
  apply simp
  apply (rule right_move_to_left)
  apply simp
  apply (rule minus_order)
  apply simp
  apply (cut_tac x = a in Rep_N)
  by (simp add: N_def)

lemma prod_5: "(((a::'a N) l\<rightarrow> b) l\<rightarrow> b) * (c * a l\<rightarrow> f * a) * (c * b l\<rightarrow> f * b) \<le> c l\<rightarrow> f"
  apply (simp add: impl_N_def times_N_def Abs_N_inverse Rep_N_inverse Rep_N_inf minus_add)
  apply (subst Abs_N_inverse)
  apply (simp add: N_def)
  apply (subst Abs_N_inverse)
  apply (simp add: N_def)
  apply (subst Abs_N_inverse)
  apply (simp add: N_def)
  apply (subst order_Abs_N [THEN sym])
  apply (simp add: N_def inf_assoc [THEN sym])
  apply (simp add: N_def)
  apply (simp only: diff_minus minus_add minus_minus add.assoc)
  apply (subst (4) add.assoc [THEN sym])
  apply (subst (5) add.assoc [THEN sym])
  apply (simp only: right_minus add_0_left)
  apply (rule right_move_to_right)
  apply (simp only: minus_add add.assoc [THEN sym] add_0_left right_minus)
  by (simp add: minus_add)

lemma prod_6: "(((a::'a N) r\<rightarrow> b) r\<rightarrow> b) * (a * c r\<rightarrow> a * f) * (b * c r\<rightarrow> b * f) \<le> c r\<rightarrow> f"
  apply (simp add: impr_N_def times_N_def Abs_N_inverse Rep_N_inverse Rep_N_inf minus_add)
  apply (subst Abs_N_inverse)
  apply (simp add: N_def)
  apply (subst Abs_N_inverse)
  apply (simp add: N_def)
  apply (subst Abs_N_inverse)
  apply (simp add: N_def)
  apply (subst order_Abs_N [THEN sym])
  apply (simp add: N_def inf_assoc [THEN sym])
  apply (simp add: N_def)
  apply (simp only: diff_minus minus_add minus_minus add.assoc)
  apply (subst (4) add.assoc [THEN sym])
  apply (subst (5) add.assoc [THEN sym])
  apply (simp only: left_minus add_0_left)
  apply (rule right_move_to_right)
  apply (simp only: minus_add add.assoc [THEN sym] add_0_left right_minus)
  by (simp add: minus_add)

instance
apply intro_classes
by (fact cancel_times_left cancel_times_right prod_1 prod_2 prod_3 prod_4 prod_5 prod_6)+

end

definition "OrdSum =
  {x. (\<exists>a::'a::pseudo_hoop_algebra. x = (a, 1::'b::pseudo_hoop_algebra)) \<or> (\<exists>b::'b. x = (1::'a, b))}"
typedef (overloaded) ('a, 'b) OrdSum = "OrdSum :: ('a::pseudo_hoop_algebra \<times> 'b::pseudo_hoop_algebra) set"
proof
  show "(1, 1) \<in> OrdSum" by (simp add: OrdSum_def)
qed

lemma [simp]: "(1, b) \<in> OrdSum"
  by (simp add: OrdSum_def)

lemma [simp]: "(a, 1) \<in> OrdSum"
  by (simp add: OrdSum_def)

definition
  "first x = fst (Rep_OrdSum x)"

definition
  "second x = snd (Rep_OrdSum x)"

lemma if_unfold_left: "((if a then b else c) = d) = ((a\<longrightarrow> b = d) \<and> (\<not> a \<longrightarrow> c = d))"
  apply auto
  done

lemma if_unfold_right: "(d = (if a then b else c)) = ((a \<longrightarrow> d = b) \<and> (\<not> a \<longrightarrow> d = c))"
  apply auto
  done

lemma fst_snd_eq: "fst a = x \<Longrightarrow> snd a = y \<Longrightarrow> (x, y) = a"
  apply (subgoal_tac "x = fst a")
  apply (subgoal_tac "y = snd a")
  apply (drule drop_assumption)
  apply (drule drop_assumption)
  by simp_all

instantiation "OrdSum" :: (pseudo_hoop_algebra, pseudo_hoop_algebra) pseudo_hoop_algebra
begin

definition
  times_OrdSum_def: "a * b \<equiv> (
    if second a = 1 \<and> second b = 1 then
      Abs_OrdSum (first a * first b, 1)
    else if first a = 1 \<and> first b = 1 then
      Abs_OrdSum (1, second a * second b)
    else if first a = 1 \<and> second b = 1 then
      b
    else
      a)"

definition
  one_OrdSum_def: "1 \<equiv> Abs_OrdSum (1, 1)"

definition
  impl_OrdSum_def: "a l\<rightarrow> b \<equiv>
    (if second a = 1 \<and> second b = 1 then
      Abs_OrdSum (first a l\<rightarrow> first b, 1)
    else if first a = 1 \<and> first b = 1 then
      Abs_OrdSum (1, second a l\<rightarrow> second b)
    else if first a = 1 \<and> second b = 1 then
      b
    else
      1)"

definition
  impr_OrdSum_def: "a r\<rightarrow> b \<equiv>
    (if second a = 1 \<and> second b = 1 then
      Abs_OrdSum (first a r\<rightarrow> first b, 1)
    else if first a = 1 \<and> first b = 1 then
      Abs_OrdSum (1, second a r\<rightarrow> second b)
    else if first a = 1 \<and> second b = 1 then
      b
    else
      1)"

definition
  order_OrdSum_def: "((a::('a, 'b) OrdSum) \<le> b) \<equiv> (a l\<rightarrow> b = 1)"

definition
  inf_OrdSum_def: "(a::('a, 'b) OrdSum) \<sqinter> b = (a l\<rightarrow> b) * a"

definition
  strict_order_OrdSum_def: "(a::('a, 'b) OrdSum) < b \<equiv> (a \<le> b \<and> \<not> b \<le> a)"

lemma OrdSum_first [simp]: "(a, 1) \<in> OrdSum"
  by (simp add: OrdSum_def)

lemma OrdSum_second [simp]: "(1, b) \<in> OrdSum"
  by (simp add: OrdSum_def)

lemma Rep_OrdSum_eq: "Rep_OrdSum x = Rep_OrdSum y \<Longrightarrow> x = y"
  apply (subgoal_tac "Abs_OrdSum (Rep_OrdSum x) = Abs_OrdSum (Rep_OrdSum y)")
  apply (drule drop_assumption)
  apply (simp add: Rep_OrdSum_inverse)
  by simp

lemma Abs_OrdSum_eq: "x \<in> OrdSum \<Longrightarrow> y \<in> OrdSum \<Longrightarrow> Abs_OrdSum x = Abs_OrdSum y \<Longrightarrow> x = y"
  apply (subgoal_tac "Rep_OrdSum (Abs_OrdSum x) = Rep_OrdSum (Abs_OrdSum y)")
  apply (unfold Abs_OrdSum_inverse) [1]
  by simp_all

lemma [simp]: "fst (Rep_OrdSum a) \<noteq> 1 \<Longrightarrow> (snd (Rep_OrdSum a) \<noteq> 1 = False)"
  apply (cut_tac x = a in Rep_OrdSum)
  apply (simp add: OrdSum_def)
  by auto

lemma fst_not_one_snd: "fst (Rep_OrdSum a) \<noteq> 1 \<Longrightarrow> (snd (Rep_OrdSum a) = 1)"
  apply (cut_tac x = a in Rep_OrdSum)
  apply (simp add: OrdSum_def)
  by auto

lemma snd_not_one_fst: "snd (Rep_OrdSum a) \<noteq> 1 \<Longrightarrow> (fst (Rep_OrdSum a) = 1)"
  apply (cut_tac x = a in Rep_OrdSum)
  apply (simp add: OrdSum_def)
  by auto

lemma fst_not_one_simp [simp]: "fst (Rep_OrdSum c) \<noteq> 1 \<Longrightarrow> Abs_OrdSum (fst (Rep_OrdSum c), 1) = c"
  apply (rule  Rep_OrdSum_eq)
  apply (simp add: Abs_OrdSum_inverse)
  apply (rule fst_snd_eq)
  apply simp_all
  by (simp add: fst_not_one_snd)

lemma snd_not_one_simp [simp]: "snd (Rep_OrdSum c) \<noteq> 1 \<Longrightarrow> Abs_OrdSum (1, snd (Rep_OrdSum c)) = c"
  apply (rule  Rep_OrdSum_eq)
  apply (simp add: Abs_OrdSum_inverse)
  apply (rule fst_snd_eq)
  apply simp_all
  by (simp add: snd_not_one_fst)

lemma  A: fixes a b::"('a, 'b) OrdSum" shows "(a l\<rightarrow> b) * a = a * (a r\<rightarrow> b)"
  apply (simp add: one_OrdSum_def impr_OrdSum_def impl_OrdSum_def second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply safe
  apply (simp_all add: fst_snd_eq times_OrdSum_def left_right_impl_times first_def second_def Abs_OrdSum_inverse Rep_OrdSum_inverse )
  apply safe
  by simp_all

instance
proof
fix a::"('a, 'b) OrdSum" show "1 * a = a"
  by (simp add: fst_snd_eq one_OrdSum_def times_OrdSum_def first_def second_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
next
fix a::"('a, 'b) OrdSum" show "a * 1 = a"
  by (simp add: fst_snd_eq one_OrdSum_def times_OrdSum_def first_def second_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
next
fix a::"('a, 'b) OrdSum" show "a l\<rightarrow> a = 1"
  by (simp add: one_OrdSum_def impl_OrdSum_def)
next
fix a::"('a, 'b) OrdSum" show "a r\<rightarrow> a = 1"
  by (simp add: one_OrdSum_def impr_OrdSum_def)
next
fix a b::"('a, 'b) OrdSum" show "(a l\<rightarrow> b) * a = (b l\<rightarrow> a) * b"
  apply (unfold one_OrdSum_def impl_OrdSum_def second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply simp
  apply safe
  by (simp_all add: times_OrdSum_def left_impl_times first_def second_def Abs_OrdSum_inverse Rep_OrdSum_inverse )
next
fix a b::"('a, 'b) OrdSum" show "a * (a r\<rightarrow> b) = b * (b r\<rightarrow> a)"
  apply (unfold one_OrdSum_def impr_OrdSum_def second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (simp)
  apply safe
  by (simp_all add: fst_snd_eq times_OrdSum_def right_impl_times first_def second_def Abs_OrdSum_inverse Rep_OrdSum_inverse )
next
fix a b::"('a, 'b) OrdSum" show "(a l\<rightarrow> b) * a = a * (a r\<rightarrow> b)" by (rule A)
next
fix a b c::"('a, 'b) OrdSum" show "a * b l\<rightarrow> c = a l\<rightarrow> b l\<rightarrow> c"
  apply (unfold times_OrdSum_def)
  apply simp apply safe
  apply (simp_all add: impl_OrdSum_def)
  apply (simp_all add: first_def second_def)
  apply (simp_all add: Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (simp_all add: fst_snd_eq)
  apply (simp_all add: Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (simp_all add: left_impl_ded)
  apply (simp_all add: fst_snd_eq one_OrdSum_def times_OrdSum_def left_impl_ded impl_OrdSum_def second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  by auto
next
fix a b c::"('a, 'b) OrdSum" show "a * b r\<rightarrow> c = b r\<rightarrow> a r\<rightarrow> c"
  apply (simp add: right_impl_ded impr_OrdSum_def second_def first_def one_OrdSum_def  times_OrdSum_def  second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  by auto
next
  fix a b::"('a, 'b) OrdSum" show "(a \<le> b) = (a l\<rightarrow> b = 1)"
    by (simp add:  order_OrdSum_def)
next
  fix a b::"('a, 'b) OrdSum" show "(a < b) = (a \<le> b \<and> \<not> b \<le> a)"
    by (simp add:  strict_order_OrdSum_def)
next
  fix a b::"('a, 'b) OrdSum" show "a \<sqinter> b = (a l\<rightarrow> b) * a" by (simp add: inf_OrdSum_def)
next
  fix a b::"('a, 'b) OrdSum" show "a \<sqinter> b = a * (a r\<rightarrow> b)" by (simp add: inf_OrdSum_def A)

qed

definition
   "Second = {x . \<exists> b . x =  Abs_OrdSum(1::'a, b::'b)}"

end

lemma "Second \<in> normalfilters"
  apply (unfold normalfilters_def)
  apply safe
  apply (unfold filters_def)
  apply safe
  apply (unfold Second_def)
  apply auto
  apply (rule_tac x = "ba * bb" in exI)
  apply (simp add: times_OrdSum_def second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (rule_tac x = "second b" in exI)
  apply (subgoal_tac "Abs_OrdSum (1::'a, second b) = Abs_OrdSum (first b, second b)")
  apply simp
  apply (simp add: first_def second_def Rep_OrdSum_inverse)
  apply (subgoal_tac "first b = 1")
  apply simp
  apply (simp add: order_OrdSum_def one_OrdSum_def impl_OrdSum_def second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (unfold second_def first_def)
  apply (case_tac "ba = (1::'b) \<and> snd (Rep_OrdSum b) = (1::'b)")
  apply simp
  apply (simp add: Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (subgoal_tac "Rep_OrdSum (Abs_OrdSum (fst (Rep_OrdSum b), 1::'b)) = Rep_OrdSum (Abs_OrdSum (1::'a, 1::'b))")
  apply (drule drop_assumption)
  apply (simp add: Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply simp
  apply simp
  apply (simp add: Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (case_tac "fst (Rep_OrdSum b) = (1::'a)")
  apply simp
  apply simp
  apply (simp add: Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (case_tac "snd (Rep_OrdSum b) = (1::'b)")
  apply simp_all
  apply (simp add: Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (simp add: impr_OrdSum_def impl_OrdSum_def second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply safe
  apply (unfold second_def first_def)
  apply (simp_all add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (case_tac "snd (Rep_OrdSum a) = (1::'b)")
  apply simp_all
  apply auto
  apply (case_tac "snd (Rep_OrdSum a) = (1::'b)")
  apply auto
  apply (rule_tac x = 1 in exI)
  apply (rule Rep_OrdSum_eq)
  apply (simp_all add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (subgoal_tac "Rep_OrdSum (Abs_OrdSum (fst (Rep_OrdSum a) l\<rightarrow> fst (Rep_OrdSum b), 1::'b)) = Rep_OrdSum (Abs_OrdSum (1::'a, ba))")
  apply (drule drop_assumption)
  apply (simp add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (simp add: left_lesseq [THEN sym] right_lesseq [THEN sym])
  apply simp
  apply (rule_tac x = 1 in exI)
  apply (rule Rep_OrdSum_eq)
  apply (simp_all add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (subgoal_tac "Rep_OrdSum (Abs_OrdSum (fst (Rep_OrdSum a) l\<rightarrow> fst (Rep_OrdSum b), 1::'b)) = Rep_OrdSum (Abs_OrdSum (1::'a, ba))")
  apply (drule drop_assumption)
  apply (simp add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (simp add: left_lesseq [THEN sym] right_lesseq [THEN sym])
  apply simp

  apply (simp add: impr_OrdSum_def impl_OrdSum_def second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply safe
  apply (unfold second_def first_def)
  apply (simp_all add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (case_tac "snd (Rep_OrdSum a) = (1::'b)")
  apply simp_all
  apply auto
  apply (case_tac "snd (Rep_OrdSum a) = (1::'b)")
  apply auto
  apply (rule_tac x = 1 in exI)
  apply (rule Rep_OrdSum_eq)
  apply (simp_all add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (subgoal_tac "Rep_OrdSum (Abs_OrdSum (fst (Rep_OrdSum a) r\<rightarrow> fst (Rep_OrdSum b), 1::'b)) = Rep_OrdSum (Abs_OrdSum (1::'a, ba))")
  apply (drule drop_assumption)
  apply (simp add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (simp add: left_lesseq [THEN sym] right_lesseq [THEN sym])
  apply simp
  apply (rule_tac x = 1 in exI)
  apply (rule Rep_OrdSum_eq)
  apply (simp_all add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (subgoal_tac "Rep_OrdSum (Abs_OrdSum (fst (Rep_OrdSum a) r\<rightarrow> fst (Rep_OrdSum b), 1::'b)) = Rep_OrdSum (Abs_OrdSum (1::'a, ba))")
  apply (drule drop_assumption)
  apply (simp add: second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
  apply (simp add: left_lesseq [THEN sym] right_lesseq [THEN sym])
  by simp

class linear_pseudo_hoop_algebra = pseudo_hoop_algebra + linorder

instantiation "OrdSum" :: (linear_pseudo_hoop_algebra, linear_pseudo_hoop_algebra) linear_pseudo_hoop_algebra
begin
instance
proof
  fix x y::"('a, 'b) OrdSum" show "x \<le> y \<or> y \<le> x"
    apply (simp add: order_OrdSum_def impl_OrdSum_def one_OrdSum_def second_def first_def Abs_OrdSum_inverse Rep_OrdSum_inverse)
    apply (cut_tac x = "fst (Rep_OrdSum x)" and y = "fst (Rep_OrdSum y)" in linear)
    apply (cut_tac x = "snd (Rep_OrdSum x)" and y = "snd (Rep_OrdSum y)" in linear)
    apply (simp add: left_lesseq)
    by auto [1]
qed
end

instantiation bool:: pseudo_hoop_algebra
begin
definition impl_bool_def:
  "a l\<rightarrow> b = (a \<longrightarrow> b)"

definition impr_bool_def:
  "a r\<rightarrow> b = (a \<longrightarrow> b)"

definition one_bool_def:
  "1 = True"

definition times_bool_def:
  "a * b = (a \<and> b)"

lemma inf_bool_def: "(a :: bool) \<sqinter> b = (a l\<rightarrow> b) * a"
  by (auto simp add: times_bool_def impl_bool_def)

instance
  apply intro_classes
  apply (simp_all add: impl_bool_def impr_bool_def one_bool_def times_bool_def le_bool_def less_bool_def inf_bool_def)
  by auto

end

context cancel_pseudo_hoop_algebra begin end

lemma "\<not> class.cancel_pseudo_hoop_algebra (*) (\<sqinter>)  (l\<rightarrow>) (\<le>) (<) (1:: bool) (r\<rightarrow>) "
  apply (unfold  class.cancel_pseudo_hoop_algebra_def)
  apply (unfold  class.cancel_pseudo_hoop_algebra_axioms_def)
  apply safe
  apply (drule drop_assumption)
  apply (drule_tac x = "False" in spec)
  apply (drule drop_assumption)
  apply (drule_tac x = "True" in spec)
  apply (drule_tac x = "False" in spec)
  by (simp add: times_bool_def)

context pseudo_hoop_algebra begin
lemma classorder: "class.order (\<le>) (<)"
  proof qed
end

lemma impl_OrdSum_first: "Abs_OrdSum (x, 1) l\<rightarrow> Abs_OrdSum (y, 1) = Abs_OrdSum (x l\<rightarrow> y, 1)"
  by (simp add: impl_OrdSum_def first_def second_def  Abs_OrdSum_inverse Rep_OrdSum_inverse)

lemma impl_OrdSum_second: "Abs_OrdSum (1, x) l\<rightarrow> Abs_OrdSum (1, y) = Abs_OrdSum (1, x l\<rightarrow> y)"
  by (simp add: impl_OrdSum_def first_def second_def  Abs_OrdSum_inverse Rep_OrdSum_inverse)

lemma impl_OrdSum_first_second: "x \<noteq> 1 \<Longrightarrow> Abs_OrdSum (x, 1) l\<rightarrow> Abs_OrdSum (1, y) = 1"
  by (simp add: one_OrdSum_def impl_OrdSum_def first_def second_def  Abs_OrdSum_inverse Rep_OrdSum_inverse)

lemma Abs_OrdSum_bijective: "x \<in> OrdSum \<Longrightarrow> y \<in> OrdSum \<Longrightarrow> (Abs_OrdSum x = Abs_OrdSum y) = (x = y)"
  apply safe
  apply (subgoal_tac  "Rep_OrdSum (Abs_OrdSum x) = Rep_OrdSum (Abs_OrdSum y)")
  apply (unfold Abs_OrdSum_inverse) [1]
  by simp_all

context pseudo_hoop_algebra begin end

context linear_pseudo_hoop_algebra begin end
context basic_pseudo_hoop_algebra begin end

lemma "class.pseudo_hoop_algebra (*) (\<sqinter>) (l\<rightarrow>) (\<le>) (<) (1::'a::pseudo_hoop_algebra) (r\<rightarrow>)
          \<Longrightarrow> \<not> (class.linear_pseudo_hoop_algebra (\<le>) (<)  (*) (\<sqinter>) (l\<rightarrow>) (1::'a) (r\<rightarrow>))
          \<Longrightarrow> \<not> class.basic_pseudo_hoop_algebra (*) (\<sqinter>) (l\<rightarrow>) (\<le>) (<) (1::('a, bool) OrdSum) (r\<rightarrow>)"
  apply (unfold class.linear_pseudo_hoop_algebra_def)
  apply (unfold class.linorder_def)
  apply (unfold class.linorder_axioms_def)
  apply safe
  apply (rule classorder)
  apply (unfold class.basic_pseudo_hoop_algebra_def) [1]
  apply simp
  apply (unfold class.basic_pseudo_hoop_algebra_axioms_def) [1]
  apply safe
  apply (subgoal_tac "(Abs_OrdSum (x, 1) l\<rightarrow> Abs_OrdSum (y, 1)) l\<rightarrow> Abs_OrdSum (1, False) \<le>
         ((Abs_OrdSum (y, 1) l\<rightarrow> Abs_OrdSum (x, 1)) l\<rightarrow> Abs_OrdSum (1, False)) l\<rightarrow> Abs_OrdSum (1, False)")
  apply (unfold impl_OrdSum_first) [1]
  apply (case_tac "x l\<rightarrow> y \<noteq> 1 \<and> y l\<rightarrow> x \<noteq> 1")
  apply (simp add: impl_OrdSum_first_second)
  apply (unfold order_OrdSum_def one_OrdSum_def one_bool_def impl_OrdSum_second impl_bool_def ) [1]
  apply simp
  apply (cut_tac x = "(1::'a, False)" and y = "(1::'a, True)" in  Abs_OrdSum_eq)
  apply simp_all
  apply (unfold left_lesseq)
  by simp

end


theory Fibonacci
  imports "../DP_Lifting" "../DP_CRelVS" "../DP_Proof"
begin

  (*
fun fib :: "nat \<Rightarrow> int option" where
  "fib 0 = Some 0"
| "fib (Suc 0) = Some 1"
| "fib (Suc (Suc n)) = (case (fib (Suc n), fib n) of (Some f1, Some f0) \<Rightarrow> Some (f1 + f0) | _ \<Rightarrow> None)"
term 0 (**)
*)

fun fib :: "nat \<Rightarrow> int option" where
  "fib 0 = Some 0"
| "fib (Suc 0) = Some 1"
| "fib (Suc (Suc n)) = case_prod
      (\<lambda>of1 of0. case_option
        None
        (\<lambda>f1. case_option
          None
          (\<lambda>f0. Some (f1 + f0))
          of0)
        of1)
      (Pair (fib (Suc n)) (fib n))"

ML_file \<open>../scratch/Transform.ML\<close>
local_setup \<open>
lift_fun NONE;
\<close>

interpretation fib: dp_consistency fib .

lemma "fib.consistentDP fib\<^sub>T"
  by (dp_match induct: fib\<^sub>T.induct simp: fib.simps simp\<^sub>T: fib\<^sub>T.simps)
end


theory Example_van_der_Pol
imports
  "../Numerics/Euler_Affine"
  "../Numerics/Optimize_Float"
begin

subsection {* Van der Pol oscillator *}
text {*\label{sec:vanderpol}*}
approximate_affine vanderpol "\<lambda>(x::real, y::real). (y, y * (1 + - x*x) + - x)"

lemma vanderpol_fderiv:
  "((\<lambda>(x::real, y::real). (y, y * (1 + - x*x) + - x))
    has_derivative
   (case x of (x, y) \<Rightarrow> \<lambda>(dx, dy). (dy, - (y * (2 * (dx * x))) + dy * (1 + - (x * x)) + - dx)))
   (at x within X)"
  by (auto intro!: derivative_eq_intros simp:  split_beta inverse_eq_divide)

approximate_affine vanderpol_d "\<lambda>(x::real, y) (dx, dy). (dy,
        - (y * (2 * (dx * x))) +
        dy * (1 + - (x * x)) +
        - dx)"

interpretation vanderpol!: aform_approximate_ivp
  "uncurry_options vanderpol"
  "uncurry_options vanderpol_d"
  "\<lambda>(x::real, y::real). (y, y * (1 + - x*x) + - x)"
  "\<lambda>(x::real, y) (dx, dy).
    (dy,
        - (y * (2 * (dx * x))) +
        dy * (1 + - (x * x)) +
        - dx)"
  apply unfold_locales
  apply (rule vanderpol[THEN Joints2_JointsI]) apply assumption apply assumption
  apply (rule vanderpol_fderiv)
  apply (rule vanderpol_d[THEN Joints2_JointsI]) apply assumption apply assumption
  apply (auto intro!: continuous_intros simp: split_beta)
  apply intro_locales
  done

definition "vanderpoltest =
  (poincare_distance_d (uncurry_options vanderpol) (uncurry_options vanderpol_d)
    \<lparr>
    precision = 30,
    tolerance = FloatR 1 (- 5),
    stepsize  = FloatR 1 (- 6),
    min_stepsize = FloatR 1 (- 7),
    iterations = 40,
    halve_stepsizes = 10,
    widening_mod = 40,
    max_tdev_thres = FloatR 1 (- 3),
    presplit_summary_tolerance = FloatR 1 (- 1),
    collect_mod = 30,
    collect_granularity = FloatR 1 (- 4),
    override_section = (\<lambda>b y i s. if snd i > FloatR 149 (- 6) then ((0, 1), FloatR 149 (- 6)) else
      if snd i = FloatR 149 (- 6) \<and> snd s = FloatR 149 (- 6) then (0, 0) else (b, y)),
    global_section = (\<lambda>X. None),
    stop_iteration = (\<lambda>X. False),
    printing_fun = (\<lambda>_ _. print_aform),
    result_fun = ivls_result 20 40
  \<rparr>)"

text {* @{term "vanderpoltest [aform_of_ivl (FloatR 5 (- 2), FloatR 146 (- 6)) (FloatR 49 (- 5), FloatR 149 (- 6))]"}
  proves a stable limit-cycle. *}
value "vanderpoltest [aform_of_ivl (FloatR 5 (- 2), FloatR 146 (- 6)) (FloatR 49 (- 5), FloatR 149 (- 6))]"

end


theory PositiveAccounts
imports Semantics ValidState
begin

fun positiveMoneyInAccountOrNoAccount :: "AccountId \<Rightarrow> Token \<Rightarrow> Accounts \<Rightarrow> bool" where
"positiveMoneyInAccountOrNoAccount accId tok mlist =
  (case MList.lookup (accId, tok) mlist of
     None \<Rightarrow> True
   | Some x \<Rightarrow> x > 0)"

lemma addMoneyToAccountPositve_match :
 "\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok accs \<Longrightarrow>
    money > 0 \<Longrightarrow>
    newBalance > 0 \<Longrightarrow>
    positiveMoneyInAccountOrNoAccount y tok2 (MList.insert (y, tok2) newBalance accs)"
  apply simp
  by (simp add: MList.insert_lookup_Some)

lemma addMoneyToAccountPositive_noMatch :
 "\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok accs \<Longrightarrow>
    money > 0 \<Longrightarrow>
    (accId, tok) \<noteq> (y, tok2) \<Longrightarrow>
    newBalance > 0 \<Longrightarrow>
    positiveMoneyInAccountOrNoAccount y tok2 (MList.insert (accId, tok2) newBalance accs)"
  by (metis addMoneyToAccountPositve_match insert_lookup_different positiveMoneyInAccountOrNoAccount.elims(2) positiveMoneyInAccountOrNoAccount.elims(3))

lemma updateMoneyInAccount_gtZero :
 "0 < newBalance \<Longrightarrow>
  \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok accs \<Longrightarrow>
  positiveMoneyInAccountOrNoAccount y tok2 (updateMoneyInAccount accId tok2 newBalance accs)"
  by (metis addMoneyToAccountPositive_noMatch addMoneyToAccountPositve_match not_less updateMoneyInAccount.simps)

lemma addMoneyToAccountPositive :
  "(\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok accs)
  \<Longrightarrow> positiveMoneyInAccountOrNoAccount y tok2 (addMoneyToAccount accId tok3 money accs)"
  apply (simp only:"addMoneyToAccount.simps")
  apply (cases "money \<le> 0")
  apply simp
  apply (cases "lookup (accId, tok3) accs")
  apply simp
  apply (metis MList.insert_lookup_Some insert_lookup_different not_le option.simps(5) surj_pair)
  apply simp
  by (smt MList.insert_lookup_Some insert_lookup_different option.simps(5) prod_cases3)

lemma giveMoney_gtZero :
    "\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok accs \<Longrightarrow>
       (eff, newAccs) = giveMoney src payee tok2 money accs \<Longrightarrow>
       positiveMoneyInAccountOrNoAccount y tok3 newAccs"
  apply (cases payee)
  apply (simp del:positiveMoneyInAccountOrNoAccount.simps addMoneyToAccount.simps)
  apply (rule addMoneyToAccountPositive)
  apply simp
  by (simp del:positiveMoneyInAccountOrNoAccount.simps addMoneyToAccount.simps)

lemma positiveMoneyInAccountOrNoAccount_valid_zero : "valid_map (((accId, tok), money) # rest) \<Longrightarrow> positiveMoneyInAccountOrNoAccount accId tok rest"
  apply (simp only:positiveMoneyInAccountOrNoAccount.simps findWithDefault.simps)
  by (simp add: MList.delete_lookup_None_aux)

lemma positiveMoneyInAccountOrNoAccount_sublist_gtZero_different :
  "valid_map ((accIdTok, money) # rest) \<Longrightarrow>
   0 < money \<Longrightarrow> positiveMoneyInAccountOrNoAccount y tok ((accIdTok, money) # rest) \<Longrightarrow>
   accIdTok \<noteq> (y, tok) \<Longrightarrow> positiveMoneyInAccountOrNoAccount y tok rest"
  apply (simp only:positiveMoneyInAccountOrNoAccount.simps findWithDefault.simps)
  by (metis MList.delete.simps(2) MList.different_delete_lookup)

lemma positiveMoneyInAccountOrNoAccount_sublist_gtZero :
    "valid_map ((accIdTok, money) # rest) \<Longrightarrow>
     money > 0 \<Longrightarrow>
    (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok ((accIdTok, money) # rest)) \<Longrightarrow> positiveMoneyInAccountOrNoAccount y tok2 rest"
  apply (cases "accIdTok = (y, tok2)")
  using positiveMoneyInAccountOrNoAccount_valid_zero apply auto[1]
  using positiveMoneyInAccountOrNoAccount_sublist_gtZero_different by blast

lemma positiveMoneyInAccountOrNoAccount_gtZero_preservation :
  "valid_map ((accIdTok, money) # rest) \<Longrightarrow>
   (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok ((accIdTok, money) # rest)) \<Longrightarrow> positiveMoneyInAccountOrNoAccount y tok2 rest"
  apply (simp only:positiveMoneyInAccountOrNoAccount.simps findWithDefault.simps)
  by (metis (no_types, lifting) MList.delete.simps(2) MList.delete_lookup_None MList.sublist_valid delete_step lookup.simps(2) option.simps(4))

lemma reduceOne_gtZero :
  "valid_map accs \<Longrightarrow>
   \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok accs \<Longrightarrow>
   refundOne accs = Some (paym, newAccs) \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 newAccs"
  apply (induction accs rule:"refundOne.induct")
  subgoal for accId tok money rest
    apply (cases "money > 0")
    apply (simp only:refundOne.simps if_True)
    apply (metis option.inject positiveMoneyInAccountOrNoAccount_gtZero_preservation prod.inject)
    by (metis MList.sublist_valid positiveMoneyInAccountOrNoAccount_gtZero_preservation refundOne.simps(1))
  by auto

lemma reduceContractStep_gtZero_Refund :
  "valid_state state \<Longrightarrow>
   \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state) \<Longrightarrow>
   refundOne (accounts state) = Some ((party, tok2, money), newAccount) \<Longrightarrow>
   Reduced ReduceNoWarning (ReduceWithPayment (Payment party (Party party) tok2 money)) (state\<lparr>accounts := newAccount\<rparr>) Close =
      Reduced wa eff newState newCont \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok3 (accounts newState)"
  by (metis (mono_tags) ReduceStepResult.inject State.simps(1) State.surjective State.update_convs(1) reduceOne_gtZero valid_state_valid_accounts)

lemma MList_delete_preserves_gtZero : "valid_map accs \<Longrightarrow> \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok accs \<Longrightarrow>
                                       positiveMoneyInAccountOrNoAccount y tok2 (MList.delete accIdTok accs)"
  by (metis (full_types) MList.delete_lookup_None MList.different_delete_lookup option.simps(4) positiveMoneyInAccountOrNoAccount.simps)

lemma reduceContractStep_gtZero_Pay_aux :
  "valid_state state \<Longrightarrow>
   \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state) \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (updateMoneyInAccount accId tok3 amount (accounts state))"
  by (metis MList_delete_preserves_gtZero insert_lookup_different not_le positiveMoneyInAccountOrNoAccount.elims(2) positiveMoneyInAccountOrNoAccount.elims(3) updateMoneyInAccount.simps updateMoneyInAccount_gtZero valid_state_valid_accounts)

lemma reduceContractStep_gtZero_Pay :
  "valid_state state \<Longrightarrow>
   \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state) \<Longrightarrow>
   reduceContractStep env state (Pay accId payee tok2 val cont) = Reduced wa eff newState newCont \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok3 (accounts newState)"
  apply (simp only:reduceContractStep.simps)
  apply (cases "evalValue env state val \<le> 0")
  apply simp
  apply (cases "giveMoney accId payee tok2 (min (moneyInAccount accId tok2 (accounts state)) (evalValue env state val))
                (updateMoneyInAccount accId tok2
                  (moneyInAccount accId tok2 (accounts state) - min (moneyInAccount accId tok2 (accounts state)) (evalValue env state val))
                  (accounts state))")
  apply (simp del:positiveMoneyInAccountOrNoAccount.simps valid_state.simps updateMoneyInAccount.simps)
  apply (cases payee)
  apply (simp only:addMoneyToAccountPositive reduceContractStep_gtZero_Pay_aux)
  apply (metis (no_types, lifting) Payee.simps(5) ReduceStepResult.inject State.simps(1) State.surjective State.update_convs(1) addMoneyToAccountPositive reduceContractStep_gtZero_Pay_aux)
  apply (simp only:refl Payee.case Let_def updateMoneyInAccount_gtZero)
  by (smt (z3) ReduceStepResult.inject State.select_convs(1) State.simps(6) State.surjective reduceContractStep_gtZero_Pay_aux)

lemma reduceContractStep_gtZero_Let :
  "valid_state state \<Longrightarrow>
   \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state) \<Longrightarrow>
   reduceContractStep env state (Contract.Let valueId val cont) = Reduced wa eff newState newCont \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (accounts newState)"
  apply (simp only:reduceContractStep.simps)
  apply (cases "state")
  apply (cases "newState")
  apply (simp del:positiveMoneyInAccountOrNoAccount.simps valid_state.simps)
  by (metis ReduceStepResult.inject State.ext_inject)

theorem reduceContractStep_gtZero :
  "valid_state state \<Longrightarrow>
   (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state)) \<Longrightarrow>
   reduceContractStep env state cont = Reduced wa eff newState newCont \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (accounts newState)"
  apply (cases cont)
  apply (cases "refundOne (accounts state)")
  apply simp
  apply (metis (mono_tags, lifting) option.simps(5) prod.case_eq_if prod.collapse reduceContractStep.simps(1) reduceContractStep_gtZero_Refund)
  using reduceContractStep_gtZero_Pay apply blast
  apply simp
  apply (smt ReduceStepResult.distinct(1) ReduceStepResult.inject ReduceStepResult.simps(5) case_prod_unfold reduceContractStep.simps(4))
  using reduceContractStep_gtZero_Let apply blast
  by simp

lemma reduceLoop_gtZero :
  "valid_state state \<Longrightarrow>
    \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state) \<Longrightarrow>
    reductionLoop reduced env state contract warns pays = ContractQuiescent nreduced nwa npa newState ncont \<Longrightarrow>
    positiveMoneyInAccountOrNoAccount y tok2 (accounts newState)"
  apply (induction reduced env state contract warns pays rule: reductionLoop.induct)
  subgoal for reduced env state contract warns pays
    apply (cases "reduceContractStep env state contract")
    apply (simp only:reductionLoop.simps [of reduced env state contract warns pays])
      apply (metis (no_types, lifting) ReduceStepResult.simps(8) reduceContractStep_gtZero reductionStep_preserves_valid_state)
    apply fastforce
    by simp_all
  done

lemma reduceContractUntilQuiescent_gtZero :
  "valid_state state \<Longrightarrow>
   (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state)) \<Longrightarrow>
   reduceContractUntilQuiescent env state contract = ContractQuiescent nreduced nwa npa newState ncont \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (accounts newState)"
  apply (simp only:reduceContractUntilQuiescent.simps)
  using reduceLoop_gtZero by blast

lemma applyCases_positive : "valid_state state \<Longrightarrow>
       \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state) \<Longrightarrow>
       applyCases env state inp cases = Applied nwa newState ncont \<Longrightarrow>
       positiveMoneyInAccountOrNoAccount y tok2 (accounts newState)"
  (* Deposit case *)
  apply (induction env state inp cases rule: applyCases.induct)
  subgoal for env state accId1 party1 tok1 amount accId2 party2 tok2a val cont rest
    apply (simp only:applyCases.simps(1) [of env state accId1 party1 tok1 amount accId2 party2 tok2 val cont rest])
    apply (cases "accId1 = accId2 \<and> party1 = party2 \<and> tok1 = tok2a \<and> amount = evalValue env state val")
    apply (cases "evalValue env state val \<le> 0")
    apply (simp add:Let_def del:valid_state.simps positiveMoneyInAccountOrNoAccount.simps moneyInAccount.simps)
    apply (simp add:Let_def del:valid_state.simps updateMoneyInAccount.simps positiveMoneyInAccountOrNoAccount.simps moneyInAccount.simps)
    apply (metis State.simps(1) State.surjective State.update_convs(1) reduceContractStep_gtZero_Pay_aux)
    by (simp add:Let_def del:valid_state.simps updateMoneyInAccount.simps positiveMoneyInAccountOrNoAccount.simps moneyInAccount.simps)
  (* Choice case *)
  apply (metis ApplyResult.inject State.ext_inject State.simps(7) State.surjective applyCases.simps(2))
  (* Notify case *)
  apply (metis ApplyResult.inject applyCases.simps(3))
  (* Rest of cases *)
  by auto

lemma applyInput_gtZero :
  "valid_state state \<Longrightarrow>
   (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state)) \<Longrightarrow>
   applyInput env state inp cont = Applied nwa newState ncont \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (accounts newState)"
  apply (cases cont)
  apply simp
  apply simp
  apply simp
  apply (simp only:applyInput.simps)
  using applyCases_positive apply blast
  apply simp
  by simp

lemma applyAllLoop_gtZero :
  "valid_state state \<Longrightarrow>
   \<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state) \<Longrightarrow>
   applyAllLoop reduced env state cont inps warns pays = ApplyAllSuccess newReduced wa pa newState ncont \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (accounts newState)"
  apply (induction reduced env state cont inps warns pays rule: applyAllLoop.induct)
  subgoal for reduced env state contract inputs warnings payments
    apply (cases inputs)
    apply (simp only:list.case applyAllLoop.simps [of reduced env state contract "[]" warnings payments])
    apply (cases "reduceContractUntilQuiescent env state contract")
    apply (simp only:ReduceResult.case)
    using reduceContractUntilQuiescent_gtZero apply auto[1]
    apply simp
    subgoal for h t
      apply (simp only:list.case applyAllLoop.simps [of reduced env state contract "h#t" warnings payments])
      apply (cases "reduceContractUntilQuiescent env state contract")
      apply (simp only:ReduceResult.case)
      subgoal for newReduced newWarns newPays newSta newCont
        apply (cases "applyInput env newSta h newCont")
        apply (simp only:ApplyResult.case)
        apply (metis applyInput_gtZero applyInput_preserves_valid_state reduceContractUntilQuiescent.simps reduceLoop_gtZero reductionLoop_preserves_valid_state)
        by simp
      by simp
    done
  done

lemma applyAllInputs_gtZero :
  "valid_state state \<Longrightarrow>
   (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state)) \<Longrightarrow>
   applyAllInputs env state cont inps = ApplyAllSuccess newReduced wa pa newState ncont \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (accounts newState)"
  apply (simp only:applyAllInputs.simps)
  using applyAllLoop_gtZero by blast

lemma fixInterval_gtZero :
  "valid_state state \<Longrightarrow>
   (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state)) \<Longrightarrow>
   fixInterval inte state = IntervalTrimmed nenv newState \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (accounts newState)"
  apply (cases  inte)
  apply (simp only:fixInterval.simps)
  by (smt IntervalResult.distinct(1) IntervalResult.inject(1) State.select_convs(1) State.surjective State.update_convs(4))

theorem computeTransaction_gtZero :
  "valid_state state \<Longrightarrow>
   (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state)) \<Longrightarrow>
   computeTransaction tx state contract = (TransactionOutput txOut) \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (accounts (txOutState txOut))"
  apply (simp only:computeTransaction.simps)
  apply (cases "fixInterval (interval tx) state")
  apply (simp only:IntervalResult.case)
  subgoal for env state
    apply (simp only:Let_def)
    apply (cases "applyAllInputs env state contract (inputs tx)")
    apply (simp only:ApplyAllResult.case)
    apply (metis TransactionOutput.distinct(1) TransactionOutput.inject(1) TransactionOutputRecord.select_convs(3) applyAllInputs_gtZero fixInterval_gtZero fixInterval_preserves_valid_state old.prod.exhaust)
    by auto
  by auto

lemma playTraceAux_gtZero :
  "valid_state (txOutState txIn) \<Longrightarrow>
   (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts (txOutState txIn))) \<Longrightarrow>
   playTraceAux txIn transList = TransactionOutput txOut \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok2 (accounts (txOutState txOut))"
  apply (induction txIn transList rule:playTraceAux.induct)
  apply simp
  apply (cases txOut)
  subgoal for state cont h t txOutWarnings txOutPayments txOutStatea txOutContract
    apply (simp del:valid_state.simps computeTransaction.simps positiveMoneyInAccountOrNoAccount.simps add:Let_def)
    apply (cases "computeTransaction txOutWarnings h t")
    using computeTransaction_gtZero computeTransaction_preserves_valid_state apply auto[1]
    by simp
  done

lemma emptyState_gtZero : "positiveMoneyInAccountOrNoAccount y tok (accounts (emptyState sl))"
  apply simp
  by (simp add: MList.lookup_empty)

theorem playTrace_gtZero :
  "playTrace sl contract t = TransactionOutput txOut \<Longrightarrow>
   positiveMoneyInAccountOrNoAccount y tok (accounts (txOutState txOut))"
  by (metis TransactionOutputRecord.select_convs(3) emptyState_gtZero playTrace.simps playTraceAux.simps(1) playTraceAux_gtZero playTrace_preserves_valid_state)

(* Alternative formulation *)

fun allAccountsPositive :: "Accounts \<Rightarrow> bool" where
"allAccountsPositive accs = foldl (\<lambda> r ((_, _), money) . r \<and> money > 0) True accs"

fun allAccountsPositiveState :: "State \<Rightarrow> bool" where
"allAccountsPositiveState state = allAccountsPositive (accounts state)"

lemma allAccountsPositiveMeansFirstIsPositive :
 "allAccountsPositive ((a, b) # accs) \<Longrightarrow> 0 < b"
  apply (induction accs)
  apply simp
  subgoal for aa accs
    apply simp
    apply (cases "(case aa of (uu_, x) \<Rightarrow> 0 < x)")
    by auto
  done

lemma allAccountsPositiveMeansAllAccountsInTailArePositive_aux :
 "(allAccountsPositive ((a, b) # accs) \<Longrightarrow> allAccountsPositive accs) \<Longrightarrow> allAccountsPositive ((a, b) # aa # accs) \<Longrightarrow> allAccountsPositive (aa # accs)"
  apply simp
  apply (cases "(case aa of (u, x) \<Rightarrow> 0 < x)")
  apply (simp add: case_prod_beta')
  by (simp add: case_prod_beta')

lemma allAccountsPositiveMeansAllAccountsInTailArePositive :
 "allAccountsPositive ((a, b) # accs) \<Longrightarrow> allAccountsPositive accs"
  apply (induction accs)
  apply simp
  using allAccountsPositiveMeansAllAccountsInTailArePositive_aux by blast

lemma allAccountsPositiveImpliesPositiveMoneyInAccountOrNoAccount_aux :
  "(\<And>accId tok. allAccountsPositive accs \<Longrightarrow> positiveMoneyInAccountOrNoAccount accId tok accs) \<Longrightarrow>
   allAccountsPositive ((a, b) # accs) \<Longrightarrow> positiveMoneyInAccountOrNoAccount accId2 tok2 ((a, b) # accs)"
  apply (simp only:positiveMoneyInAccountOrNoAccount.simps)
  apply (cases "(accId2, tok2) = a")
  apply (simp del:valid_map.simps)
  apply (rule allAccountsPositiveMeansFirstIsPositive)
  apply simp
  apply (simp only:lookup.simps if_False)
  apply (cases "a < (accId2, tok2)")
  apply (simp only:if_True)
  using allAccountsPositiveMeansAllAccountsInTailArePositive apply blast
  by simp

lemma allAccountsPositiveImpliesPositiveMoneyInAccountOrNoAccount :
  "allAccountsPositive accs \<Longrightarrow> positiveMoneyInAccountOrNoAccount accId tok accs"
  apply (induction accs arbitrary: accId tok)
  apply simp
  using allAccountsPositiveImpliesPositiveMoneyInAccountOrNoAccount_aux by auto

lemma positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive_aux :
 "b > 0 \<Longrightarrow> allAccountsPositive accs \<Longrightarrow> allAccountsPositive ((a, b) # accs)"
  by simp

lemma positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive_aux2 :
  "(valid_map accs \<Longrightarrow> \<forall>accId tok. positiveMoneyInAccountOrNoAccount accId tok accs \<Longrightarrow> allAccountsPositive accs) \<Longrightarrow>
   valid_map ((a, b) # accs) \<Longrightarrow> \<forall>accId tok. positiveMoneyInAccountOrNoAccount accId tok ((a, b) # accs) \<Longrightarrow> allAccountsPositive ((a, b) # accs)"
  apply (cases "0 \<ge> b")
  apply (simp del:foldl_Cons valid_map.simps)
  apply (smt old.prod.exhaust option.simps(5))
  apply (simp only:positiveMoneyInAccountOrNoAccount.simps)
  apply (rule positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive_aux)
  apply linarith
  by (meson MList.sublist_valid positiveMoneyInAccountOrNoAccount.simps positiveMoneyInAccountOrNoAccount_gtZero_preservation)

lemma positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive :
  "valid_map accs \<Longrightarrow> (\<forall> accId tok. positiveMoneyInAccountOrNoAccount accId tok accs) \<Longrightarrow> allAccountsPositive accs"
  apply (induction accs)
  apply simp
  using positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive_aux2 by auto

theorem accountsArePositive :
  "valid_state state \<Longrightarrow> (\<forall>x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state)) \<Longrightarrow>
  computeTransaction txIn state cont = TransactionOutput txOut \<Longrightarrow>
  positiveMoneyInAccountOrNoAccount y tok2 (accounts (txOutState txOut))"
  using computeTransaction_gtZero by blast

theorem accountsArePositive2 :
    "valid_state state \<Longrightarrow> allAccountsPositiveState state
    \<Longrightarrow> computeTransaction txIn state cont = TransactionOutput txOut
    \<Longrightarrow> allAccountsPositiveState (txOutState txOut)"
  by (meson accountsArePositive allAccountsPositiveImpliesPositiveMoneyInAccountOrNoAccount allAccountsPositiveState.elims(2) allAccountsPositiveState.elims(3) computeTransaction_preserves_valid_state positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive valid_state.elims(2))

lemma valid_state_valid_accounts : "valid_state state \<Longrightarrow> valid_map (accounts state)"
  by simp

theorem accountsArePositive2_trace :
    "valid_state (txOutState txIn) \<Longrightarrow> allAccountsPositiveState (txOutState txIn)
    \<Longrightarrow> playTraceAux txIn transList = TransactionOutput txOut
    \<Longrightarrow> allAccountsPositiveState (txOutState txOut)"
  by (meson allAccountsPositiveImpliesPositiveMoneyInAccountOrNoAccount allAccountsPositiveState.simps playTraceAux_gtZero playTraceAux_preserves_valid_state positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive valid_state_valid_accounts)

fun validAndPositive_state :: "State \<Rightarrow> bool" where
"validAndPositive_state state = (valid_state state \<and> allAccountsPositiveState state)"

lemma validAndPositiveImpliesValid : "validAndPositive_state state \<Longrightarrow> valid_state state"
  by simp

lemma validAndPositiveImpliesPositive : "validAndPositive_state state \<Longrightarrow> (\<forall> x tok. positiveMoneyInAccountOrNoAccount x tok (accounts state))"
  using allAccountsPositiveImpliesPositiveMoneyInAccountOrNoAccount by auto

lemma reduceContractStep_preserves_validAndPositive_state :
  "validAndPositive_state state \<Longrightarrow>
   reduceContractStep env state cont = Reduced wa eff newState newCont \<Longrightarrow>
   validAndPositive_state newState"
  apply (simp only:validAndPositive_state.simps)
  by (meson allAccountsPositiveImpliesPositiveMoneyInAccountOrNoAccount allAccountsPositiveState.elims(2) allAccountsPositiveState.elims(3) positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive reduceContractStep_gtZero reductionStep_preserves_valid_state valid_state.elims(2))

lemma reduceContractUntilQuiescent_preserves_validAndPositive_state :
  "validAndPositive_state state \<Longrightarrow>
   reduceContractUntilQuiescent env state contract = ContractQuiescent nreduced nwa npa nstate ncont \<Longrightarrow>
   validAndPositive_state nstate"
  by (metis allAccountsPositiveState.elims(3) positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive reduceContractUntilQuiescent.simps reduceContractUntilQuiescent_gtZero reductionLoop_preserves_valid_state validAndPositiveImpliesPositive validAndPositiveImpliesValid validAndPositive_state.elims(3) valid_state.elims(2))

lemma applyInput_preserves_preserves_validAndPositive_state :
  "validAndPositive_state state \<Longrightarrow>
   applyInput env state inp cont = Applied nwa nstate ncont \<Longrightarrow>
   validAndPositive_state nstate"
  by (meson allAccountsPositiveState.simps applyInput_gtZero applyInput_preserves_valid_state positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive validAndPositiveImpliesPositive validAndPositive_state.simps valid_state.simps)

lemma applyAllInputs_preserves_preserves_validAndPositive_state :
  "validAndPositive_state state \<Longrightarrow>
   applyAllInputs env state cont inps = ApplyAllSuccess nreduced wa pa nstate ncont \<Longrightarrow>
   validAndPositive_state nstate"
  by (metis allAccountsPositiveState.elims(3) applyAllInputs.simps applyAllInputs_gtZero applyAllLoop_preserves_valid_state positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive validAndPositiveImpliesPositive validAndPositiveImpliesValid validAndPositive_state.elims(3) valid_state.elims(2))

lemma fixInterval_preserves_preserves_validAndPositive_state :
  "validAndPositive_state state \<Longrightarrow>
   fixInterval inte state = IntervalTrimmed nenv nstate \<Longrightarrow>
   validAndPositive_state nstate"
  by (metis allAccountsPositiveState.elims(3) fixInterval_gtZero fixInterval_preserves_valid_state old.prod.exhaust positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive validAndPositiveImpliesPositive validAndPositiveImpliesValid validAndPositive_state.elims(3) valid_state.simps)

lemma applyAllLoop_preserves_preserves_validAndPositive_state :
  "validAndPositive_state state \<Longrightarrow>
   applyAllLoop reduced env state cont inp wa pa = ApplyAllSuccess nreduced nwa npa nstate ncont \<Longrightarrow>
   validAndPositive_state nstate"
  by (meson allAccountsPositiveState.simps applyAllLoop_gtZero applyAllLoop_preserves_valid_state positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive validAndPositiveImpliesPositive validAndPositive_state.simps valid_state.simps)

lemma computeTransaction_preserves_validAndPositive_state :
    "validAndPositive_state state
    \<Longrightarrow> computeTransaction txIn state cont = TransactionOutput txOut
    \<Longrightarrow> validAndPositive_state (txOutState txOut)"
  using accountsArePositive2 computeTransaction_preserves_valid_state validAndPositive_state.simps by blast

lemma playTraceAux_preserves_validAndPositive_state :
  "validAndPositive_state (txOutState txIn) \<Longrightarrow>
   playTraceAux txIn transList = TransactionOutput txOut \<Longrightarrow>
   validAndPositive_state (txOutState txOut)"
  using accountsArePositive2_trace playTraceAux_preserves_valid_state validAndPositive_state.simps by blast

lemma validAndPositive_initial_state : "validAndPositive_state (emptyState sl)"
  using emptyState_gtZero empty_state_valid_state positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive by auto

lemma allAccountsPositive_implies_every_account_positive :
  fixes accId tok val
  assumes "((accId, tok), val) \<in> set m" (is "?entry \<in> _")
  assumes "allAccountsPositive m" and "valid_map m"
  shows "val > 0"
proof (rule ccontr)
  assume valIsNeg: "\<not> (val > 0)"
  obtain headM restM where pList: "m = headM @ [?entry] @ restM"
    by (metis append_Cons append_Nil assms(1) in_set_conv_decomp_first)
  with assms(1) allAccountsPositive.simps have "allAccountsPositive m = False"
    by (smt (z3) valIsNeg allAccountsPositiveMeansFirstIsPositive foldl_Cons foldl_append)
  with assms show False
    by blast
qed

lemma allAccountsPositive_implies_lookup_is_positive :
"\<lbrakk> valid_map m
 ; allAccountsPositive m
 ; lookup (accId, tok) m = Some v
\<rbrakk> \<Longrightarrow> v > 0"
  by (metis allAccountsPositive_implies_every_account_positive lookupAsMap map_of_SomeD)

lemma updateMoneyIsPositive :
  assumes "allAccountsPositive accs"
      and "valid_map accs"
      and "val \<ge> 0"
    shows "allAccountsPositive (updateMoneyInAccount accId token val accs)"
proof (cases "val = 0")
  note assms
  moreover assume "val = 0"
  moreover have "updateMoneyInAccount accId token val accs = MList.delete (accId, token) accs"
    using calculation(4) by force
  ultimately show ?thesis
    (* TODO: this should be easier, we should unify
       positiveMoneyInAccountOrNoAccount and allAccountsPositive to avoid unecesary conversion *)
    by (metis MList_delete_preserves_gtZero allAccountsPositiveImpliesPositiveMoneyInAccountOrNoAccount delete_valid positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive)
next
  note assms
  moreover assume "val \<noteq> 0"
  moreover have "updateMoneyInAccount accId token val accs = MList.insert (accId, token) val accs"
    using calculation(3) calculation(4) by force
  ultimately show ?thesis
    (* TODO: same note as before *)
    by (smt (verit, del_insts) PositiveAccounts.positiveMoneyInAccountOrNoAccount.simps addMoneyToAccountPositve_match allAccountsPositiveImpliesPositiveMoneyInAccountOrNoAccount insert_lookup_different positiveMoneyInAccountOrNoAccountImpliesAllAccountsPositive updateMoneyInAccount_preserves_valid_map)
qed

end