section "Amortized Complexity (Unary Operations)"

theory Amortized_Framework0
imports Complex_Main
begin

text\<open>
This theory provides a simple amortized analysis framework where all operations
act on a single data type, i.e. no union-like operations. This is the basis of
the ITP 2015 paper by Nipkow. Although it is superseded by the model in
\<open>Amortized_Framework\<close> that allows arbitrarily many parameters, it is still
of interest because of its simplicity.\<close>

locale Amortized =
fixes init :: "'s"
fixes nxt :: "'o \<Rightarrow> 's \<Rightarrow> 's"
fixes inv :: "'s \<Rightarrow> bool"
fixes t :: "'o \<Rightarrow> 's \<Rightarrow> real"
fixes \<Phi> :: "'s \<Rightarrow> real"
fixes U :: "'o \<Rightarrow> 's \<Rightarrow> real"
assumes inv_init: "inv init"
assumes inv_nxt: "inv s \<Longrightarrow> inv(nxt f s)"
assumes ppos: "inv s \<Longrightarrow> \<Phi> s \<ge> 0"
assumes p0: "\<Phi> init = 0"
assumes U: "inv s \<Longrightarrow> t f s + \<Phi>(nxt f s) - \<Phi> s \<le> U f s"
begin

fun state :: "(nat \<Rightarrow> 'o) \<Rightarrow> nat \<Rightarrow> 's" where
"state f 0 = init" |
"state f (Suc n) = nxt (f n) (state f n)"

lemma inv_state: "inv(state f n)"
by(induction n)(simp_all add: inv_init inv_nxt)

definition a :: "(nat \<Rightarrow> 'o) \<Rightarrow> nat \<Rightarrow> real" where
"a f i = t (f i) (state f i) + \<Phi>(state f (i+1)) - \<Phi>(state f i)"

lemma aeq: "(\<Sum>i<n. t (f i) (state f i)) = (\<Sum>i<n. a f i) - \<Phi>(state f n)"
apply(induction n)
apply (simp add: p0)
apply (simp add: a_def)
done

corollary ta: "(\<Sum>i<n. t (f i) (state f i)) \<le> (\<Sum>i<n. a f i)"
by (metis add.commute aeq diff_add_cancel le_add_same_cancel2 ppos[OF inv_state])

lemma aa1: "a f i \<le> U (f i) (state f i)"
by(simp add: a_def U inv_state)

lemma ub: "(\<Sum>i<n. t (f i) (state f i)) \<le> (\<Sum>i<n. U (f i) (state f i))"
by (metis (mono_tags) aa1 order.trans sum_mono ta)

end

subsection "Binary Counter"

fun incr where
"incr [] = [True]" |
"incr (False#bs) = True # bs" |
"incr (True#bs) = False # incr bs"

fun t\<^sub>i\<^sub>n\<^sub>c\<^sub>r :: "bool list \<Rightarrow> real" where
"t\<^sub>i\<^sub>n\<^sub>c\<^sub>r [] = 1" |
"t\<^sub>i\<^sub>n\<^sub>c\<^sub>r (False#bs) = 1" |
"t\<^sub>i\<^sub>n\<^sub>c\<^sub>r (True#bs) = t\<^sub>i\<^sub>n\<^sub>c\<^sub>r bs + 1"

definition p_incr :: "bool list \<Rightarrow> real" ("\<Phi>\<^sub>i\<^sub>n\<^sub>c\<^sub>r") where
"\<Phi>\<^sub>i\<^sub>n\<^sub>c\<^sub>r bs = length(filter id bs)"

lemma a_incr: "t\<^sub>i\<^sub>n\<^sub>c\<^sub>r bs + \<Phi>\<^sub>i\<^sub>n\<^sub>c\<^sub>r(incr bs) - \<Phi>\<^sub>i\<^sub>n\<^sub>c\<^sub>r bs = 2"
apply(induction bs rule: incr.induct)
apply (simp_all add: p_incr_def)
done

interpretation incr: Amortized
where init = "[]" and nxt = "%_. incr" and inv = "\<lambda>_. True"
and t = "\<lambda>_. t\<^sub>i\<^sub>n\<^sub>c\<^sub>r" and \<Phi> = \<Phi>\<^sub>i\<^sub>n\<^sub>c\<^sub>r and U = "\<lambda>_ _. 2"
proof (standard, goal_cases)
  case 1 show ?case by simp
next
  case 2 show ?case by simp
next
  case 3 show ?case by(simp add: p_incr_def)
next
  case 4 show ?case by(simp add: p_incr_def)
next
  case 5 show ?case by(simp add: a_incr)
qed

thm incr.ub

subsection "Dynamic tables: insert only"

fun t\<^sub>i\<^sub>n\<^sub>s :: "nat \<times> nat \<Rightarrow> real" where
"t\<^sub>i\<^sub>n\<^sub>s (n,l) = (if n<l then 1 else n+1)"

interpretation ins: Amortized
where init = "(0::nat,0::nat)"
and nxt = "\<lambda>_ (n,l). (n+1, if n<l then l else if l=0 then 1 else 2*l)"
and inv = "\<lambda>(n,l). if l=0 then n=0 else n \<le> l \<and> l < 2*n"
and t = "\<lambda>_. t\<^sub>i\<^sub>n\<^sub>s" and \<Phi> = "\<lambda>(n,l). 2*n - l" and U = "\<lambda>_ _. 3"
proof (standard, goal_cases)
  case 1 show ?case by auto
next
  case (2 s) thus ?case by(cases s) auto
next
  case (3 s) thus ?case by(cases s)(simp split: if_splits)
next
  case 4 show ?case by(simp)
next
  case (5 s) thus ?case by(cases s) auto
qed

locale table_insert =
fixes a :: real
fixes c :: real
assumes c1[arith]: "c > 1"
assumes ac2: "a \<ge> c/(c - 1)"
begin

lemma ac: "a \<ge> 1/(c - 1)"
using ac2 by(simp add: field_simps)

lemma a0[arith]: "a>0"
proof-
  have "1/(c - 1) > 0" using ac by simp
  thus ?thesis by (metis ac dual_order.strict_trans1)
qed

definition "b = 1/(c - 1)"

lemma b0[arith]: "b > 0"
using ac by (simp add: b_def)

fun "ins" :: "nat * nat \<Rightarrow> nat * nat" where
"ins(n,l) = (n+1, if n<l then l else if l=0 then 1 else nat(ceiling(c*l)))"

fun pins :: "nat * nat => real" where
"pins(n,l) = a*n - b*l"

interpretation ins: Amortized
where init = "(0,0)" and nxt = "%_. ins"
and inv = "\<lambda>(n,l). if l=0 then n=0 else n \<le> l \<and> (b/a)*l \<le> n"
and t = "\<lambda>_. t\<^sub>i\<^sub>n\<^sub>s" and \<Phi> = pins and U = "\<lambda>_ _. a + 1"
proof (standard, goal_cases)
  case 1 show ?case by auto
next
  case (2 s)
  show ?case
  proof (cases s)
    case [simp]: (Pair n l)
    show ?thesis
    proof cases
      assume "l=0" thus ?thesis using 2 ac
        by (simp add: b_def field_simps)
    next
      assume "l\<noteq>0"
      show ?thesis
      proof cases
        assume "n<l"
        thus ?thesis using 2 by(simp add: algebra_simps)
      next
        assume "\<not> n<l"
        hence [simp]: "n=l" using 2 \<open>l\<noteq>0\<close> by simp
        have 1: "(b/a) * ceiling(c * l) \<le> real l + 1"
        proof-
          have "(b/a) * ceiling(c * l) = ceiling(c * l)/(a*(c - 1))"
            by(simp add: b_def)
          also have "ceiling(c * l) \<le> c*l + 1" by simp
          also have "\<dots> \<le> c*(real l+1)" by (simp add: algebra_simps)
          also have "\<dots> / (a*(c - 1)) = (c/(a*(c - 1))) * (real l + 1)" by simp
          also have "c/(a*(c - 1)) \<le> 1" using ac2 by (simp add: field_simps)
          finally show ?thesis by (simp add: divide_right_mono)
        qed
        have 2: "real l + 1 \<le> ceiling(c * real l)"
        proof-
          have "real l + 1 = of_int(int(l)) + 1" by simp
          also have "... \<le> ceiling(c * real l)" using \<open>l \<noteq> 0\<close>
            by(simp only: int_less_real_le[symmetric] less_ceiling_iff)
              (simp add: mult_less_cancel_right1)
          finally show ?thesis .
        qed
        from \<open>l\<noteq>0\<close> 1 2 show ?thesis by simp (simp add: not_le zero_less_mult_iff)
      qed
    qed
  qed
next
  case (3 s) thus ?case by(cases s)(simp add: field_simps split: if_splits)
next
  case 4 show ?case by(simp)
next
  case (5 s)
  show ?case
  proof (cases s)
    case [simp]: (Pair n l)
    show ?thesis
    proof cases
      assume "l=0" thus ?thesis using 5 by (simp)
    next
      assume [arith]: "l\<noteq>0"
      show ?thesis
      proof cases
        assume "n<l"
        thus ?thesis using 5 ac by(simp add: algebra_simps b_def)
      next
        assume "\<not> n<l"
        hence [simp]: "n=l" using 5 by simp
        have "t\<^sub>i\<^sub>n\<^sub>s s + pins (ins s) - pins s = l + a + 1 + (- b*ceiling(c*l)) + b*l"
          using \<open>l\<noteq>0\<close>
          by(simp add: algebra_simps less_trans[of "-1::real" 0])
        also have "- b * ceiling(c*l) \<le> - b * (c*l)" by (simp add: ceiling_correct)
        also have "l + a + 1 + - b*(c*l) + b*l = a + 1 + l*(1 - b*(c - 1))"
          by (simp add: algebra_simps)
        also have "b*(c - 1) = 1" by(simp add: b_def)
        also have "a + 1 + (real l)*(1 - 1) = a+1" by simp
        finally show ?thesis by simp
      qed
    qed
  qed
qed

thm ins.ub

end

subsection "Stack with multipop"

datatype 'a op\<^sub>s\<^sub>t\<^sub>k = Push 'a | Pop nat

fun nxt\<^sub>s\<^sub>t\<^sub>k :: "'a op\<^sub>s\<^sub>t\<^sub>k \<Rightarrow> 'a list \<Rightarrow> 'a list" where
"nxt\<^sub>s\<^sub>t\<^sub>k (Push x) xs = x # xs" |
"nxt\<^sub>s\<^sub>t\<^sub>k (Pop n) xs = drop n xs"

fun t\<^sub>s\<^sub>t\<^sub>k:: "'a op\<^sub>s\<^sub>t\<^sub>k \<Rightarrow> 'a list \<Rightarrow> real" where
"t\<^sub>s\<^sub>t\<^sub>k (Push x) xs = 1" |
"t\<^sub>s\<^sub>t\<^sub>k (Pop n) xs = min n (length xs)"

interpretation stack: Amortized
where init = "[]" and nxt = nxt\<^sub>s\<^sub>t\<^sub>k and inv = "\<lambda>_. True"
and t = t\<^sub>s\<^sub>t\<^sub>k and \<Phi> = "length" and U = "\<lambda>f _. case f of Push _ \<Rightarrow> 2 | Pop _ \<Rightarrow> 0"
proof (standard, goal_cases)
  case 1 show ?case by auto
next
  case (2 s) thus ?case by(cases s) auto
next
  case 3 thus ?case by simp
next
  case 4 show ?case by(simp)
next
  case (5 _ f) thus ?case by (cases f) auto
qed

subsection "Queue"

text\<open>See, for example, the book by Okasaki~\cite{Okasaki}.\<close>

datatype 'a op\<^sub>q = Enq 'a | Deq

type_synonym 'a queue = "'a list * 'a list"

fun nxt\<^sub>q :: "'a op\<^sub>q \<Rightarrow> 'a queue \<Rightarrow> 'a queue" where
"nxt\<^sub>q (Enq x) (xs,ys) = (x#xs,ys)" |
"nxt\<^sub>q Deq (xs,ys) = (if ys = [] then ([], tl(rev xs)) else (xs,tl ys))"

fun t\<^sub>q :: "'a op\<^sub>q \<Rightarrow> 'a queue \<Rightarrow> real" where
"t\<^sub>q (Enq x) (xs,ys) = 1" |
"t\<^sub>q Deq (xs,ys) = (if ys = [] then length xs else 0)"

interpretation queue: Amortized
where init = "([],[])" and nxt = nxt\<^sub>q and inv = "\<lambda>_. True"
and t = t\<^sub>q and \<Phi> = "\<lambda>(xs,ys). length xs" and U = "\<lambda>f _. case f of Enq _ \<Rightarrow> 2 | Deq \<Rightarrow> 0"
proof (standard, goal_cases)
  case 1 show ?case by auto
next
  case (2 s) thus ?case by(cases s) auto
next
  case (3 s) thus ?case by(cases s) auto
next
  case 4 show ?case by(simp)
next
  case (5 s f) thus ?case
    apply(cases s)
    apply(cases f)
    by auto
qed

fun balance :: "'a queue \<Rightarrow> 'a queue" where
"balance(xs,ys) = (if size xs \<le> size ys then (xs,ys) else ([], ys @ rev xs))"

fun nxt_q2 :: "'a op\<^sub>q \<Rightarrow> 'a queue \<Rightarrow> 'a queue" where
"nxt_q2 (Enq a) (xs,ys) = balance (a#xs,ys)" |
"nxt_q2 Deq (xs,ys) = balance (xs, tl ys)"

fun t_q2 :: "'a op\<^sub>q \<Rightarrow> 'a queue \<Rightarrow> real" where
"t_q2 (Enq _) (xs,ys) = 1 + (if size xs + 1 \<le> size ys then 0 else size xs + 1 + size ys)" |
"t_q2 Deq (xs,ys) = (if size xs \<le> size ys - 1 then 0 else size xs + (size ys - 1))"

interpretation queue2: Amortized
where init = "([],[])" and nxt = nxt_q2
and inv = "\<lambda>(xs,ys). size xs \<le> size ys"
and t = t_q2 and \<Phi> = "\<lambda>(xs,ys). 2 * size xs"
and U = "\<lambda>f _. case f of Enq _ \<Rightarrow> 3 | Deq \<Rightarrow> 0"
proof (standard, goal_cases)
  case 1 show ?case by auto
next
  case (2 s f) thus ?case by(cases s) (cases f, auto)
next
  case (3 s) thus ?case by(cases s) auto
next
  case 4 show ?case by(simp)
next
  case (5 s f) thus ?case
    apply(cases s)
    apply(cases f)
    by (auto simp: split: prod.splits)
qed

subsection "Dynamic tables: insert and delete"

datatype op\<^sub>t\<^sub>b = Ins | Del

fun nxt\<^sub>t\<^sub>b :: "op\<^sub>t\<^sub>b \<Rightarrow> nat*nat \<Rightarrow> nat*nat" where
"nxt\<^sub>t\<^sub>b Ins (n,l) = (n+1, if n<l then l else if l=0 then 1 else 2*l)" |
"nxt\<^sub>t\<^sub>b Del (n,l) = (n - 1, if n=1 then 0 else if 4*(n - 1)<l then l div 2 else l)"

fun t\<^sub>t\<^sub>b :: "op\<^sub>t\<^sub>b \<Rightarrow> nat*nat \<Rightarrow> real" where
"t\<^sub>t\<^sub>b Ins (n,l) = (if n<l then 1 else n+1)" |
"t\<^sub>t\<^sub>b Del (n,l) = (if n=1 then 1 else if 4*(n - 1)<l then n else 1)"

interpretation tb: Amortized
where init = "(0,0)" and nxt = nxt\<^sub>t\<^sub>b
and inv = "\<lambda>(n,l). if l=0 then n=0 else n \<le> l \<and> l \<le> 4*n"
and t = t\<^sub>t\<^sub>b and \<Phi> = "(\<lambda>(n,l). if 2*n < l then l/2 - n else 2*n - l)"
and U = "\<lambda>f _. case f of Ins \<Rightarrow> 3 | Del \<Rightarrow> 2"
proof (standard, goal_cases)
  case 1 show ?case by auto
next
  case (2 s f) thus ?case by(cases s, cases f) (auto split: if_splits)
next
  case (3 s) thus ?case by(cases s)(simp split: if_splits)
next
  case 4 show ?case by(simp)
next
  case (5 s f) thus ?case apply(cases s) apply(cases f)
    by (auto simp: field_simps)
qed

end


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

datatype Nat = Z | S "Nat"

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

fun altmul :: "Nat => Nat => Nat" where
"altmul (Z) y = Z"
| "altmul (S z) (Z) = Z"
| "altmul (S z) (S x2) =
     plus (plus (plus (S Z) (altmul z x2)) z) x2"

theorem property0 :
  "((altmul x y) = (altmul y x))"
  oops

end


(*  Title:      HOL/Library/Option_ord.thy
    Author:     Florian Haftmann, TU Muenchen
*)

section {* Canonical order on option type *}

theory Option_ord
imports Option Main
begin

notation
  bot ("\<bottom>") and
  top ("\<top>") and
  inf  (infixl "\<sqinter>" 70) and
  sup  (infixl "\<squnion>" 65) and
  Inf  ("\<Sqinter>_" [900] 900) and
  Sup  ("\<Squnion>_" [900] 900)

syntax (xsymbols)
  "_INF1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3\<Sqinter>_./ _)" [0, 10] 10)
  "_INF"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sqinter>_\<in>_./ _)" [0, 0, 10] 10)
  "_SUP1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3\<Squnion>_./ _)" [0, 10] 10)
  "_SUP"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Squnion>_\<in>_./ _)" [0, 0, 10] 10)

instantiation option :: (preorder) preorder
begin

definition less_eq_option where
  "x \<le> y \<longleftrightarrow> (case x of None \<Rightarrow> True | Some x \<Rightarrow> (case y of None \<Rightarrow> False | Some y \<Rightarrow> x \<le> y))"

definition less_option where
  "x < y \<longleftrightarrow> (case y of None \<Rightarrow> False | Some y \<Rightarrow> (case x of None \<Rightarrow> True | Some x \<Rightarrow> x < y))"

lemma less_eq_option_None [simp]: "None \<le> x"
  by (simp add: less_eq_option_def)

lemma less_eq_option_None_code [code]: "None \<le> x \<longleftrightarrow> True"
  by simp

lemma less_eq_option_None_is_None: "x \<le> None \<Longrightarrow> x = None"
  by (cases x) (simp_all add: less_eq_option_def)

lemma less_eq_option_Some_None [simp, code]: "Some x \<le> None \<longleftrightarrow> False"
  by (simp add: less_eq_option_def)

lemma less_eq_option_Some [simp, code]: "Some x \<le> Some y \<longleftrightarrow> x \<le> y"
  by (simp add: less_eq_option_def)

lemma less_option_None [simp, code]: "x < None \<longleftrightarrow> False"
  by (simp add: less_option_def)

lemma less_option_None_is_Some: "None < x \<Longrightarrow> \<exists>z. x = Some z"
  by (cases x) (simp_all add: less_option_def)

lemma less_option_None_Some [simp]: "None < Some x"
  by (simp add: less_option_def)

lemma less_option_None_Some_code [code]: "None < Some x \<longleftrightarrow> True"
  by simp

lemma less_option_Some [simp, code]: "Some x < Some y \<longleftrightarrow> x < y"
  by (simp add: less_option_def)

instance proof
qed (auto simp add: less_eq_option_def less_option_def less_le_not_le elim: order_trans split: option.splits)

end

instance option :: (order) order proof
qed (auto simp add: less_eq_option_def less_option_def split: option.splits)

instance option :: (linorder) linorder proof
qed (auto simp add: less_eq_option_def less_option_def split: option.splits)

instantiation option :: (order) order_bot
begin

definition bot_option where
  "\<bottom> = None"

instance proof
qed (simp add: bot_option_def)

end

instantiation option :: (order_top) order_top
begin

definition top_option where
  "\<top> = Some \<top>"

instance proof
qed (simp add: top_option_def less_eq_option_def split: option.split)

end

instance option :: (wellorder) wellorder proof
  fix P :: "'a option \<Rightarrow> bool" and z :: "'a option"
  assume H: "\<And>x. (\<And>y. y < x \<Longrightarrow> P y) \<Longrightarrow> P x"
  have "P None" by (rule H) simp
  then have P_Some [case_names Some]:
    "\<And>z. (\<And>x. z = Some x \<Longrightarrow> (P o Some) x) \<Longrightarrow> P z"
  proof -
    fix z
    assume "\<And>x. z = Some x \<Longrightarrow> (P o Some) x"
    with `P None` show "P z" by (cases z) simp_all
  qed
  show "P z" proof (cases z rule: P_Some)
    case (Some w)
    show "(P o Some) w" proof (induct rule: less_induct)
      case (less x)
      have "P (Some x)" proof (rule H)
        fix y :: "'a option"
        assume "y < Some x"
        show "P y" proof (cases y rule: P_Some)
          case (Some v) with `y < Some x` have "v < x" by simp
          with less show "(P o Some) v" .
        qed
      qed
      then show ?case by simp
    qed
  qed
qed

instantiation option :: (inf) inf
begin

definition inf_option where
  "x \<sqinter> y = (case x of None \<Rightarrow> None | Some x \<Rightarrow> (case y of None \<Rightarrow> None | Some y \<Rightarrow> Some (x \<sqinter> y)))"

lemma inf_None_1 [simp, code]:
  "None \<sqinter> y = None"
  by (simp add: inf_option_def)

lemma inf_None_2 [simp, code]:
  "x \<sqinter> None = None"
  by (cases x) (simp_all add: inf_option_def)

lemma inf_Some [simp, code]:
  "Some x \<sqinter> Some y = Some (x \<sqinter> y)"
  by (simp add: inf_option_def)

instance ..

end

instantiation option :: (sup) sup
begin

definition sup_option where
  "x \<squnion> y = (case x of None \<Rightarrow> y | Some x' \<Rightarrow> (case y of None \<Rightarrow> x | Some y \<Rightarrow> Some (x' \<squnion> y)))"

lemma sup_None_1 [simp, code]:
  "None \<squnion> y = y"
  by (simp add: sup_option_def)

lemma sup_None_2 [simp, code]:
  "x \<squnion> None = x"
  by (cases x) (simp_all add: sup_option_def)

lemma sup_Some [simp, code]:
  "Some x \<squnion> Some y = Some (x \<squnion> y)"
  by (simp add: sup_option_def)

instance ..

end

instantiation option :: (semilattice_inf) semilattice_inf
begin

instance proof
  fix x y z :: "'a option"
  show "x \<sqinter> y \<le> x"
    by - (cases x, simp_all, cases y, simp_all)
  show "x \<sqinter> y \<le> y"
    by - (cases x, simp_all, cases y, simp_all)
  show "x \<le> y \<Longrightarrow> x \<le> z \<Longrightarrow> x \<le> y \<sqinter> z"
    by - (cases x, simp_all, cases y, simp_all, cases z, simp_all)
qed

end

instantiation option :: (semilattice_sup) semilattice_sup
begin

instance proof
  fix x y z :: "'a option"
  show "x \<le> x \<squnion> y"
    by - (cases x, simp_all, cases y, simp_all)
  show "y \<le> x \<squnion> y"
    by - (cases x, simp_all, cases y, simp_all)
  fix x y z :: "'a option"
  show "y \<le> x \<Longrightarrow> z \<le> x \<Longrightarrow> y \<squnion> z \<le> x"
    by - (cases y, simp_all, cases z, simp_all, cases x, simp_all)
qed

end

instance option :: (lattice) lattice ..

instance option :: (lattice) bounded_lattice_bot ..

instance option :: (bounded_lattice_top) bounded_lattice_top ..

instance option :: (bounded_lattice_top) bounded_lattice ..

instance option :: (distrib_lattice) distrib_lattice
proof
  fix x y z :: "'a option"
  show "x \<squnion> y \<sqinter> z = (x \<squnion> y) \<sqinter> (x \<squnion> z)"
    by - (cases x, simp_all, cases y, simp_all, cases z, simp_all add: sup_inf_distrib1 inf_commute)
qed

instantiation option :: (complete_lattice) complete_lattice
begin

definition Inf_option :: "'a option set \<Rightarrow> 'a option" where
  "\<Sqinter>A = (if None \<in> A then None else Some (\<Sqinter>Option.these A))"

lemma None_in_Inf [simp]:
  "None \<in> A \<Longrightarrow> \<Sqinter>A = None"
  by (simp add: Inf_option_def)

definition Sup_option :: "'a option set \<Rightarrow> 'a option" where
  "\<Squnion>A = (if A = {} \<or> A = {None} then None else Some (\<Squnion>Option.these A))"

lemma empty_Sup [simp]:
  "\<Squnion>{} = None"
  by (simp add: Sup_option_def)

lemma singleton_None_Sup [simp]:
  "\<Squnion>{None} = None"
  by (simp add: Sup_option_def)

instance proof
  fix x :: "'a option" and A
  assume "x \<in> A"
  then show "\<Sqinter>A \<le> x"
    by (cases x) (auto simp add: Inf_option_def in_these_eq intro: Inf_lower)
next
  fix z :: "'a option" and A
  assume *: "\<And>x. x \<in> A \<Longrightarrow> z \<le> x"
  show "z \<le> \<Sqinter>A"
  proof (cases z)
    case None then show ?thesis by simp
  next
    case (Some y)
    show ?thesis
      by (auto simp add: Inf_option_def in_these_eq Some intro!: Inf_greatest dest!: *)
  qed
next
  fix x :: "'a option" and A
  assume "x \<in> A"
  then show "x \<le> \<Squnion>A"
    by (cases x) (auto simp add: Sup_option_def in_these_eq intro: Sup_upper)
next
  fix z :: "'a option" and A
  assume *: "\<And>x. x \<in> A \<Longrightarrow> x \<le> z"
  show "\<Squnion>A \<le> z "
  proof (cases z)
    case None
    with * have "\<And>x. x \<in> A \<Longrightarrow> x = None" by (auto dest: less_eq_option_None_is_None)
    then have "A = {} \<or> A = {None}" by blast
    then show ?thesis by (simp add: Sup_option_def)
  next
    case (Some y)
    from * have "\<And>w. Some w \<in> A \<Longrightarrow> Some w \<le> z" .
    with Some have "\<And>w. w \<in> Option.these A \<Longrightarrow> w \<le> y"
      by (simp add: in_these_eq)
    then have "\<Squnion>Option.these A \<le> y" by (rule Sup_least)
    with Some show ?thesis by (simp add: Sup_option_def)
  qed
next
  show "\<Squnion>{} = (\<bottom>::'a option)"
  by (auto simp: bot_option_def)
next
  show "\<Sqinter>{} = (\<top>::'a option)"
  by (auto simp: top_option_def Inf_option_def)
qed

end

lemma Some_Inf:
  "Some (\<Sqinter>A) = \<Sqinter>(Some ` A)"
  by (auto simp add: Inf_option_def)

lemma Some_Sup:
  "A \<noteq> {} \<Longrightarrow> Some (\<Squnion>A) = \<Squnion>(Some ` A)"
  by (auto simp add: Sup_option_def)

lemma Some_INF:
  "Some (\<Sqinter>x\<in>A. f x) = (\<Sqinter>x\<in>A. Some (f x))"
  using Some_Inf [of "f ` A"] by (simp add: comp_def)

lemma Some_SUP:
  "A \<noteq> {} \<Longrightarrow> Some (\<Squnion>x\<in>A. f x) = (\<Squnion>x\<in>A. Some (f x))"
  using Some_Sup [of "f ` A"] by (simp add: comp_def)

instantiation option :: (complete_distrib_lattice) complete_distrib_lattice
begin

instance proof
  fix a :: "'a option" and B
  show "a \<squnion> \<Sqinter>B = (\<Sqinter>b\<in>B. a \<squnion> b)"
  proof (cases a)
    case None
    then show ?thesis by (simp add: INF_def)
  next
    case (Some c)
    show ?thesis
    proof (cases "None \<in> B")
      case True
      then have "Some c = (\<Sqinter>b\<in>B. Some c \<squnion> b)"
        by (auto intro!: antisym INF_lower2 INF_greatest)
      with True Some show ?thesis by simp
    next
      case False then have B: "{x \<in> B. \<exists>y. x = Some y} = B" by auto (metis not_Some_eq)
      from sup_Inf have "Some c \<squnion> Some (\<Sqinter>Option.these B) = Some (\<Sqinter>b\<in>Option.these B. c \<squnion> b)" by simp
      then have "Some c \<squnion> \<Sqinter>(Some ` Option.these B) = (\<Sqinter>x\<in>Some ` Option.these B. Some c \<squnion> x)"
        by (simp add: Some_INF Some_Inf comp_def)
      with Some B show ?thesis by (simp add: Some_image_these_eq)
    qed
  qed
  show "a \<sqinter> \<Squnion>B = (\<Squnion>b\<in>B. a \<sqinter> b)"
  proof (cases a)
    case None
    then show ?thesis by (simp add: SUP_def image_constant_conv bot_option_def)
  next
    case (Some c)
    show ?thesis
    proof (cases "B = {} \<or> B = {None}")
      case True
      then show ?thesis by auto
    next
      have B: "B = {x \<in> B. \<exists>y. x = Some y} \<union> {x \<in> B. x = None}"
        by auto
      then have Sup_B: "\<Squnion>B = \<Squnion>({x \<in> B. \<exists>y. x = Some y} \<union> {x \<in> B. x = None})"
        and SUP_B: "\<And>f. (\<Squnion>x \<in> B. f x) = (\<Squnion>x \<in> {x \<in> B. \<exists>y. x = Some y} \<union> {x \<in> B. x = None}. f x)"
        by simp_all
      have Sup_None: "\<Squnion>{x. x = None \<and> x \<in> B} = None"
        by (simp add: bot_option_def [symmetric])
      have SUP_None: "(\<Squnion>x\<in>{x. x = None \<and> x \<in> B}. Some c \<sqinter> x) = None"
        by (simp add: bot_option_def [symmetric])
      case False then have "Option.these B \<noteq> {}" by (simp add: these_not_empty_eq)
      moreover from inf_Sup have "Some c \<sqinter> Some (\<Squnion>Option.these B) = Some (\<Squnion>b\<in>Option.these B. c \<sqinter> b)"
        by simp
      ultimately have "Some c \<sqinter> \<Squnion>(Some ` Option.these B) = (\<Squnion>x\<in>Some ` Option.these B. Some c \<sqinter> x)"
        by (simp add: Some_SUP Some_Sup comp_def)
      with Some show ?thesis
        by (simp add: Some_image_these_eq Sup_B SUP_B Sup_None SUP_None SUP_union Sup_union_distrib)
    qed
  qed
qed

end

instantiation option :: (complete_linorder) complete_linorder
begin

instance ..

end

no_notation
  bot ("\<bottom>") and
  top ("\<top>") and
  inf  (infixl "\<sqinter>" 70) and
  sup  (infixl "\<squnion>" 65) and
  Inf  ("\<Sqinter>_" [900] 900) and
  Sup  ("\<Squnion>_" [900] 900)

no_syntax (xsymbols)
  "_INF1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3\<Sqinter>_./ _)" [0, 10] 10)
  "_INF"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sqinter>_\<in>_./ _)" [0, 0, 10] 10)
  "_SUP1"     :: "pttrns \<Rightarrow> 'b \<Rightarrow> 'b"           ("(3\<Squnion>_./ _)" [0, 10] 10)
  "_SUP"      :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Squnion>_\<in>_./ _)" [0, 0, 10] 10)

end


theory negation_conditions
  imports "../TBA/frontier_algebra" "../conditions/conditions_complement_infinitary"
begin
nitpick_params[assms=true, user_axioms=true, show_all, expect=genuine, format=3] (*default Nitpick settings*)

section \<open>Frontier-based negation - Semantic conditions\<close>

(**We define a paracomplete and a paraconsistent negation employing the interior and closure operation resp.
We take the frontier operator as primitive and explore which semantic conditions are minimally required
to obtain some relevant properties of negation.*)

definition neg_I::"\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<not>\<^sup>I")  where  "\<^bold>\<not>\<^sup>I A \<equiv> \<I>(\<^bold>\<midarrow>A)"
definition neg_C::"\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<not>\<^sup>C")  where  "\<^bold>\<not>\<^sup>C A \<equiv> \<C>(\<^bold>\<midarrow>A)"
declare neg_I_def[conn] neg_C_def[conn]

(**(We rename the meta-logical HOL negation to avoid terminological confusion)*)
abbreviation cneg::"bool\<Rightarrow>bool" ("\<sim>_" [40]40) where "\<sim>\<phi> \<equiv> \<not>\<phi>"

subsection \<open>'Explosion' (ECQ), non-contradiction (LNC) and excluded middle (TND)\<close>

(**TND*)
lemma "\<FF> \<F> \<Longrightarrow> TNDm \<^bold>\<not>\<^sup>I" nitpick oops (*still not recovering minimally weak TND*)
lemma TND_C: "TND \<^bold>\<not>\<^sup>C" by (simp add: pC2 Defs conn) (*TND valid in general*)

(**ECQ*)
lemma ECQ_I: "ECQ \<^bold>\<not>\<^sup>I" by (simp add: pI2 Defs conn) (*ECQ valid in general*)
lemma "\<FF> \<F> \<Longrightarrow> ECQm \<^bold>\<not>\<^sup>C" nitpick oops (*still not recovering minimally weak ECQ*)

(**LNC*)
lemma "LNC \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma LNC_I: "Fr_2 \<F> \<Longrightarrow> Fr_3 \<F> \<Longrightarrow>  LNC \<^bold>\<not>\<^sup>I" using ECQ_I ECQ_def IF3 LNC_def dNOR_def unfolding conn by auto
lemma "LNC \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma LNC_C: "Fr_6 \<F> \<Longrightarrow> LNC \<^bold>\<not>\<^sup>C" unfolding Defs by (smt Cl_fr_def MONO_def compl_def join_def meet_def monC neg_C_def top_def)

(**Relations between LNC and different ECQ variants (only relevant for paraconsistent negation).*)
lemma "ECQ \<^bold>\<not>\<^sup>C \<longrightarrow>  LNC \<^bold>\<not>\<^sup>C" by (simp add: pC2 Defs conn)
lemma ECQw_LNC: "ECQw \<^bold>\<not>\<^sup>C \<longrightarrow>  LNC \<^bold>\<not>\<^sup>C" by (smt ECQw_def LNC_def pC2 conn)
lemma ECQm_LNC: "Fr_1 \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> ECQm \<^bold>\<not>\<^sup>C \<longrightarrow> LNC \<^bold>\<not>\<^sup>C" using Cl_fr_def Fr_1_def pF2 unfolding Defs conn by metis
lemma "\<FF> \<F> \<Longrightarrow> LNC \<^bold>\<not>\<^sup>C \<longrightarrow>  ECQm \<^bold>\<not>\<^sup>C" nitpick oops  (*countermodel*)

(**Below we show that enforcing all conditions on the frontier operator still leaves room
for both boldly paraconsistent and paracomplete models. We use Nitpick to generate a non-trivial
model (here a set algebra with 8 elements).*)
lemma "\<FF> \<F> \<and> \<sim>ECQm \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops (*boldly paraconsistent model found*)
lemma "\<FF> \<F> \<and> \<sim>TNDm \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops (*boldly paracomplete model found*)

subsection \<open>Modus tollens (MT)\<close>

(**MT-I*)
lemma MT0_I: "Fr_1b \<F> \<Longrightarrow> MT0 \<^bold>\<not>\<^sup>I"  unfolding Defs by (smt MONO_def compl_def monI neg_I_def top_def)
lemma MT1_I: "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> Fr_3 \<F> \<Longrightarrow> MT1 \<^bold>\<not>\<^sup>I" unfolding Defs by (metis MONO_def monI IF3 Int_fr_def compl_def dNOR_def diff_def neg_I_def top_def)
lemma "\<FF> \<F> \<Longrightarrow> MT2 \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> MT2 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> Fr_1a \<F> \<and> Fr_2 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> MT2 \<^bold>\<not>\<^sup>I" nitpick[satisfy] oops
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> MT2 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> MT2 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<FF> \<F> \<Longrightarrow> MT3 \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> Fr_1a \<F> \<and> Fr_2 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> MT3 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> MT0 \<^bold>\<not>\<^sup>I \<and> MT1 \<^bold>\<not>\<^sup>I \<and> MT2 \<^bold>\<not>\<^sup>I \<and> MT3 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
(**MT-C*)
lemma "Fr_2 \<F> \<Longrightarrow> MT0 \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma MT0_C: "Fr_6 \<F> \<Longrightarrow> MT0 \<^bold>\<not>\<^sup>C" unfolding Defs by (smt ICdual MONO_def compl_def monC neg_C_def top_def)
lemma MT1_C: "Fr_6 \<F> \<Longrightarrow> MT1 \<^bold>\<not>\<^sup>C" unfolding Defs by (smt Cl_fr_def Fr_6_def conn)
lemma "\<FF> \<F> \<Longrightarrow> MT2 \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> \<FF> \<F> \<and> MT2 \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops (*model found*)
lemma MT3_C: "Fr_1b \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> Fr_3 \<F> \<Longrightarrow> MT3 \<^bold>\<not>\<^sup>C" unfolding Defs using MONO_def monI by (metis ClOpdual IF3 compl_def dNOR_def diff_def neg_C_def pA2 top_def)
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> MT0 \<^bold>\<not>\<^sup>C \<and> MT1 \<^bold>\<not>\<^sup>C \<and> MT2 \<^bold>\<not>\<^sup>C \<and> MT3 \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops

subsection \<open>Contraposition rules (CoP)\<close>

(**CoPw-I*)
lemma "CoPw \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma CoPw_I: "Fr_1b \<F> \<Longrightarrow> CoPw \<^bold>\<not>\<^sup>I" unfolding Defs conn by (metis (no_types, lifting) MONO_def monI)
(**CoPw-C*)
lemma "CoPw \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma CoPw_C: "Fr_6 \<F> \<Longrightarrow> CoPw \<^bold>\<not>\<^sup>C" by (smt CoPw_def MONO_def monC conn)

(**We can indeed prove that XCoP is entailed by CoP1 (CoP2) in the particular case of a closure- (interior-)based negation.*)
lemma CoP1_XCoP: "CoP1 \<^bold>\<not>\<^sup>C \<longrightarrow>  XCoP \<^bold>\<not>\<^sup>C" by (metis XCoP_def2 CoP1_def CoP1_def2 DM2_CoPw DM2_def ECQw_def TND_C TND_def TNDw_def top_def)
lemma CoP2_XCoP: "CoP2 \<^bold>\<not>\<^sup>I \<longrightarrow>  XCoP \<^bold>\<not>\<^sup>I" by (smt XCoP_def2 CoP2_DM3 CoP2_def2 CoPw_def DM3_def DNE_def ECQ_I ECQ_def ECQw_def TNDw_def bottom_def join_def)

(**CoP1-I*)
lemma "\<FF> \<F> \<Longrightarrow> CoP1 \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> \<FF> \<F> \<and> CoP1 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
(**CoP1-C*)
lemma "\<FF> \<F> \<Longrightarrow> CoP1 \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQ \<^bold>\<not>\<^sup>C \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> CoP1 \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops
lemma "CoP1 \<^bold>\<not>\<^sup>C \<longrightarrow> ECQm \<^bold>\<not>\<^sup>C" using XCoP_def2 CoP1_XCoP ECQm_def ECQw_def by blast

(**CoP2-I*)
lemma "\<FF> \<F> \<Longrightarrow> CoP2 \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> CoP2 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> CoP2 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "CoP2 \<^bold>\<not>\<^sup>I \<longrightarrow> TNDm \<^bold>\<not>\<^sup>I" using XCoP_def2 CoP2_XCoP TNDm_def TNDw_def by auto
(**CoP2-C*)
lemma "\<FF> \<F> \<Longrightarrow> CoP2 \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> \<FF> \<F> \<and> CoP2 \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops

(**CoP3-I*)
lemma "\<FF> \<F> \<Longrightarrow> CoP3 \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> CoP3 \<^bold>\<not>\<^sup>I" (*nitpick[satisfy]*) oops (*cannot find (finite) models*)
(**CoP3-C*)
lemma "\<FF> \<F> \<Longrightarrow> CoP3 \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQ \<^bold>\<not>\<^sup>C \<and> CoP3 \<^bold>\<not>\<^sup>C" (*nitpick[satisfy]*) oops (*cannot find (finite) models*)

(**XCoP-I*)
lemma "\<FF> \<F> \<Longrightarrow> XCoP \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> XCoP \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> XCoP \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "XCoP \<^bold>\<not>\<^sup>I \<longrightarrow> TNDm \<^bold>\<not>\<^sup>I" by (simp add: XCoP_def2 TNDm_def TNDw_def)
(**XCoP-C*)
lemma "\<FF> \<F> \<Longrightarrow> XCoP \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQ \<^bold>\<not>\<^sup>C \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> XCoP \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops
lemma "XCoP \<^bold>\<not>\<^sup>C \<longrightarrow> ECQm \<^bold>\<not>\<^sup>C" by (simp add: XCoP_def2 ECQm_def ECQw_def)

subsection \<open>Normality (negative) and its dual (nNor/nDNor)\<close>

(**nNor-I*)
lemma "nNor \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma nNor_I: "Fr_2 \<F> \<Longrightarrow> Fr_3 \<F> \<Longrightarrow> nNor \<^bold>\<not>\<^sup>I"  using IF3 dNOR_def unfolding Defs conn by auto
(**nNor-C*)
lemma nNor_C: "nNor \<^bold>\<not>\<^sup>C" unfolding Cl_fr_def Defs conn by simp

(**nDNor-I*)
lemma nDNor_I: "nDNor \<^bold>\<not>\<^sup>I" unfolding Int_fr_def Defs conn by simp
(**nDNor-C*)
lemma "nDNor \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma nDNor_C: "Fr_3 \<F> \<Longrightarrow> nDNor \<^bold>\<not>\<^sup>C" using pC2 NOR_def unfolding Defs conn by simp

subsection \<open>Double negation introduction/elimination (DNI/DNE)\<close>

(**DNI-I*)
lemma "\<FF> \<F> \<Longrightarrow> DNI \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> \<FF> \<F> \<and> DNI \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
(**DNI-C*)
lemma "\<FF> \<F> \<Longrightarrow> DNI \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQ \<^bold>\<not>\<^sup>C \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> DNI \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> DNI \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> Fr_2 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> DNI \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops

(**DNE-I*)
lemma "\<FF> \<F> \<Longrightarrow> DNE \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> DNE \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> DNE \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> Fr_2 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> DNE \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TND \<^bold>\<not>\<^sup>I  \<and> DNE \<^bold>\<not>\<^sup>I \<and> DNI \<^bold>\<not>\<^sup>I" (*nitpick[satisfy]*) oops (*cannot find (finite) models*)
(**DNE-C*)
lemma "\<FF> \<F> \<Longrightarrow> DNE \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> \<FF> \<F> \<and> DNE \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops

lemma "\<sim>ECQ \<^bold>\<not>\<^sup>C  \<and> DNE \<^bold>\<not>\<^sup>C \<and> DNI \<^bold>\<not>\<^sup>C" (*nitpick[satisfy]*) oops (*cannot find (finite) models*)

(**rDNI-I*)
lemma "Fr_2 \<F> \<Longrightarrow> Fr_3 \<F> \<Longrightarrow> rDNI \<^bold>\<not>\<^sup>I" using nNor_I nDNor_I nDNor_rDNI by simp
(**rDNI-C*)
lemma "Fr_3 \<F> \<Longrightarrow> rDNI \<^bold>\<not>\<^sup>C" using nNor_C nDNor_C nDNor_rDNI by simp

(**rDNE-I*)
lemma "\<FF> \<F> \<Longrightarrow> rDNE \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> rDNE \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> rDNE \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> Fr_2 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> rDNE \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
(**rDNE-C*)
lemma "\<FF> \<F> \<Longrightarrow> rDNE \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> \<FF> \<F> \<and> rDNE \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops

lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C  \<and> rDNE \<^bold>\<not>\<^sup>C \<and> rDNI \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops

subsection \<open>De Morgan laws\<close>

(**DM1/2 (see CoPw)*)

(**DM3-I*)
lemma "\<FF> \<F> \<Longrightarrow> DM3 \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> DM3 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> DM3 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> DM3 \<^bold>\<not>\<^sup>I" (*nitpick[satisfy]*) oops (*cannot find (finite) models*)
(**DM3-C*)
lemma "DM3 \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma DM3_C: "Fr_1a \<F> \<Longrightarrow> Fr_2 \<F> \<Longrightarrow> DM3 \<^bold>\<not>\<^sup>C" using  DM3_def Fr_1a_def pA2 pF2 unfolding conn by smt
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> \<FF> \<F> \<and> DM3 \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops

(**DM4-I*)
lemma "DM4 \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma DM4_I: "Fr_1a \<F> \<Longrightarrow> DM4 \<^bold>\<not>\<^sup>I" using ADDI_a_def Cl_fr_def DM4_def IC1b IF1b dual_def unfolding conn by smt
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> \<FF> \<F> \<and> DM4 \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
(**DM4-C*)
lemma "\<FF> \<F> \<Longrightarrow> DM4 \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQ \<^bold>\<not>\<^sup>C \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> DM4 \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> DM4 \<^bold>\<not>\<^sup>C" (*nitpick[satisfy]*) oops (*cannot find (finite) models*)

(**iDM1/2 (see CoPw)*)

(**iDM3-I*)
lemma "\<FF> \<F> \<Longrightarrow> Fr_inf \<F> \<Longrightarrow> iDM3 \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> iDM3 \<^bold>\<not>\<^sup>I" nitpick[satisfy] oops
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> iDM3 \<^bold>\<not>\<^sup>I" nitpick[satisfy] oops
lemma "\<sim>TNDm \<^bold>\<not>\<^sup>I \<and> iDM3 \<^bold>\<not>\<^sup>I" (*nitpick[satisfy]*) oops (*cannot find (finite) models*)
(**iDM3-C*)
lemma "iDM3 \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma iDM3_C: "Fr_2 \<F> \<Longrightarrow> Fr_inf \<F> \<Longrightarrow> iDM3 \<^bold>\<not>\<^sup>C" unfolding Defs by (metis (full_types) CF_inf Ra_restr_ex dom_compl_def iADDI_a_def iDM_a neg_C_def)
(**iDM4-I*)
lemma "iDM4 \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma iDM4_I: "Fr_inf \<F> \<Longrightarrow> iDM4 \<^bold>\<not>\<^sup>I" unfolding Defs by (metis IF_inf Ra_restr_all dom_compl_def iDM_b iMULT_b_def neg_I_def)
(**iDM4-C*)
lemma "\<FF> \<F> \<Longrightarrow> Fr_inf \<F> \<Longrightarrow> iDM4 \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQ \<^bold>\<not>\<^sup>C \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> iDM4 \<^bold>\<not>\<^sup>C" nitpick[satisfy] oops
lemma "\<sim>ECQm \<^bold>\<not>\<^sup>C \<and> iDM4 \<^bold>\<not>\<^sup>C" (*nitpick[satisfy]*) oops (*cannot find (finite) models*)

subsection \<open>Local contraposition axioms (lCoP)\<close>

(**lCoPw-I*)
lemma "\<FF> \<F> \<Longrightarrow> lCoPw(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> lCoPw(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> lCoPw(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "lCoPw(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I \<longrightarrow> TNDm \<^bold>\<not>\<^sup>I" by (simp add: XCoP_def2 TNDm_def TNDw_def lCoPw_XCoP)
(**lCoPw-C*)
lemma "\<FF> \<F> \<Longrightarrow> lCoPw(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQ \<^bold>\<not>\<^sup>C \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> lCoPw(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops
lemma "lCoPw(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C \<longrightarrow> ECQm \<^bold>\<not>\<^sup>C" by (simp add: XCoP_def2 ECQm_def ECQw_def lCoPw_XCoP)

(**lCoP1-I*)
lemma "\<FF> \<F> \<Longrightarrow> lCoP1(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "lCoP1(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I \<longrightarrow> TND \<^bold>\<not>\<^sup>I" by (simp add: lCoP1_TND)
(**lCoP1-C*)
lemma "\<FF> \<F> \<Longrightarrow> lCoP1(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "\<sim>ECQ \<^bold>\<not>\<^sup>C \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> lCoP1(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C" nitpick[satisfy,card w=3] oops
lemma "lCoP1(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C \<longrightarrow> ECQm \<^bold>\<not>\<^sup>C" by (simp add: XCoP_def2 ECQm_def ECQw_def lCoP1_def2 lCoPw_XCoP)

(**lCoP2-I*)
lemma "\<FF> \<F> \<Longrightarrow> lCoP2(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_2 \<F> \<and> Fr_4 \<F> \<and> lCoP2(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "\<sim>TND \<^bold>\<not>\<^sup>I \<and> Fr_1 \<F> \<and> Fr_3 \<F> \<and> Fr_4 \<F> \<and> lCoP2(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" nitpick[satisfy,card w=3] oops
lemma "lCoP2(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I \<longrightarrow> TNDm \<^bold>\<not>\<^sup>I" by (simp add: XCoP_def2 TNDm_def TNDw_def lCoP2_def2 lCoPw_XCoP)
(**lCoP2-C*)
lemma "\<FF> \<F> \<Longrightarrow> lCoP2(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "lCoP2(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C \<longrightarrow> ECQ \<^bold>\<not>\<^sup>C" by (simp add: lCoP2_ECQ)

(**lCoP3-I*)
lemma "\<FF> \<F> \<Longrightarrow> lCoP3(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "lCoP3(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I \<longrightarrow> TND \<^bold>\<not>\<^sup>I" unfolding Defs conn by metis
(**lCoP3-C*)
lemma "\<FF> \<F> \<Longrightarrow> lCoP3(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "lCoP3(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C \<longrightarrow> ECQ \<^bold>\<not>\<^sup>C" unfolding Defs conn by metis

subsection \<open>Disjunctive syllogism\<close>

(**DS1-I*)
lemma "DS1(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" using DS1_def ECQ_I ECQ_def unfolding conn by auto
(**DS1-C*)
lemma "\<FF> \<F> \<Longrightarrow> DS1(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C" nitpick oops (*countermodel*)
lemma "DS1(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C \<longrightarrow> ECQ \<^bold>\<not>\<^sup>C" unfolding Defs conn by metis

(**DS2-I*)
lemma "\<FF> \<F> \<Longrightarrow> DS2(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I" nitpick oops (*countermodel*)
lemma "DS2(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>I \<longrightarrow> TND \<^bold>\<not>\<^sup>I" by (simp add: Defs conn)
(**DS2-C*)
lemma "DS2(\<^bold>\<rightarrow>) \<^bold>\<not>\<^sup>C" using TND_C unfolding Defs conn by auto

end

github-repos/isabelle/davfuenmayor-topological-semantics/topological-semantics-770a84ffa2cf8498bd5f60853d11be4d77fc8cd3/old-stuff (to migrate from old version)/Example/negation_conditions.thy