           (*-------------------------------------------*
            |       Uniform Candy Distribution          |
            |                                           |
            |           November 2007 for Isabelle 2005 |
            |           November 2008 for Isabelle 2008 |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory UCD_data2
imports UCD_data1
begin

(*****************************************************************

         1.

 *****************************************************************)

(*********************************************************
          preliminary (functions for updates)
 *********************************************************)

datatype Att = AttL "nat*nat" | AttC nat | AttR nat

lemma inj_Att[simp]: "inj AttL" "inj AttC" "inj AttR"
by (simp_all add: inj_on_def)

lemma Att_or:
  "ALL a. (EX n x. a = AttL (n, x)) | (EX n. a = AttC n) | (EX n. a = AttR n)"
apply (rule)
apply (induct_tac a)
apply (auto)
done

lemma AttR_EX[simp]:
  "((ALL n x. a ~= AttL (n, x)) & (ALL n. a ~= AttC n)) = (EX n. a = AttR n)"
apply (induct_tac a)
apply (auto)
done

(* functions *)

primrec
  getNat   :: "Att => nat"
where
  "getNat (AttL nx) = fst(nx)"
 |"getNat (AttC n) = n"
 |"getNat (AttR n) = n"

(*
consts
  updateR  :: "(Att list * nat) => Att list"
recdef updateR "measure (%sx. length (fst(sx)))"
  "updateR ([],x) = []"
  "updateR ((AttL (n,y))#s,x) = [AttR 0, AttC 0]"
  "updateR ((AttC n)#s,x) = [AttR 0, AttC 0]"
  "updateR ([AttR n],x) = [AttR (fill(n + x) div 2)]"
  "updateR ((AttR n)#s,x) =
     (AttR (fill(n + getNat(hd(updateR(s,x)))) div 2)) # updateR(s,x)"
*)

fun
  updateR  :: "(Att list * nat) => Att list"
where
  "updateR ([],x) = []"
 |"updateR ((AttL (n,y))#s,x) = [AttR 0, AttC 0]"
 |"updateR ((AttC n)#s,x) = [AttR 0, AttC 0]"
 |"updateR ([AttR n],x) = [AttR (fill(n + x) div 2)]"
 |"updateR ((AttR n)#s,x) =
     (AttR (fill(n + getNat(hd(updateR(s,x)))) div 2)) # updateR(s,x)"

fun
  nextR    :: "(Att list * nat) => Att list"
where
  "nextR ([],x) = []"
 |"nextR ([AttL (n,y)],x) = [AttR 0, AttC 0]"
 |"nextR ((AttL (n,y))#s,x) = (AttL (n,y))# nextR(s,x)"
 |"nextR ([AttC n],x) = [AttL (n,x)]"
 |"nextR ((AttC n)#s,x) = (AttL (n, getNat(hd(updateR(s,x))) ))#updateR(s,x)"
 |"nextR ([AttR n],x) = [AttC (fill(n + x))]"
 |"nextR ((AttR n)#s,x) =
     (AttC (fill(n + getNat(hd(updateR(s,x))) ))) # updateR(s,x)"

fun
  nextLhd :: "(nat*(Att list)) => Att"
where
  "nextLhd (nz,[])        = (AttC nz)"
 |"nextLhd (nz,(AttR m)#s) = (AttC nz)"
 |"nextLhd (nz,(AttC m)#s)     = (AttL (nz,(m div 2)))"
 |"nextLhd (nz,(AttL (m,y))#s) = (AttL (nz,(m div 2)))"

fun
  nextL    :: "Att list => Att list"
where
  "nextL ([]) = []"
 |"nextL ((AttR n)#s) = [AttR 0, AttC 0]"
 |"nextL ((AttC n)#s) = (AttR (n div 2))#s"
 |"nextL ([AttL (n,z)]) = [AttC (fill(n div 2 + z))]"
 |"nextL ((AttL (n,z))#(AttL (m,y))#s) = AttL (fill(n div 2 + z), m div 2)#nextL((AttL (m,y))#s)"
 |"nextL ((AttL (n,z))#(AttC m)#s) = AttL (fill(n div 2 + z), m div 2)#(AttR (m div 2))#s"
 |"nextL ((AttL (n,z))#(AttR m)#s) = AttC (fill(n div 2 + z)) # (AttR m)#s"

primrec
  guardL   :: "Att list => bool"
where
 "guardL([]) = False"
|"guardL(a#s) = ((EX n x. a=AttL (n,x)) | (EX n. a=AttC n))"

fun
  guardR   :: "Att list => bool"
where
  "guardR([]) = False"
 |"guardR([a]) = ((EX n. a=AttC n) | (EX n. a=AttR n))"
 |"guardR(a#s) = guardR(s)"

definition
  nextLR   :: "Att list => Att list"
where
 nextLR_def: "nextLR(s) == nextL(nextR(s,getNat(hd(s)) div 2))"

fun
  toStbOne :: "Att list => Att list"

where
  "toStbOne ([]) = []"
 |"toStbOne ([a]) = [a]"
 |"toStbOne ((AttL (n,z))#s) = (AttL (n,z))#s"
 |"toStbOne ((AttC n)#(AttL (m,z))#s) = (AttL (n, m div 2)) # nextL((AttL (m,z))#s)"
 |"toStbOne ((AttC n)#(AttC m)#s)     = (AttL (n, m div 2)) # nextL((AttC m)#s)"
 |"toStbOne ((AttC n)#(AttR m)#s)     = (AttC n)#(AttR m)#s"

 |"toStbOne ([AttR n, AttL (m,z)]) =
        [AttL (fill (n + m div 2), fill (m div 2 + z) div 2),
         AttR (fill (m div 2 + z) div 2)]"

 |"toStbOne ((AttR n)#(AttL (m,z))#(AttL (na, x))#sa) =
        AttL (fill (n + m div 2), fill (m div 2 + z) div 2) #
        nextL (AttL (fill (m div 2 + z), na div 2) # nextL (AttL (na, x) # sa))"

 |"toStbOne ((AttR n)#(AttL (m,z))#(AttC na)#sa) =
        AttL (fill (n + m div 2), fill (m div 2 + z) div 2) #
        AttC (fill (fill (m div 2 + z) div 2 + na div 2)) # AttR (na div 2) # sa"

 |"toStbOne ((AttR n)#(AttL (m,z))#(AttR na)#sa) =
        AttL (fill (n + m div 2), fill (m div 2 + z) div 2) #
        AttR (fill (m div 2 + z) div 2) # AttR na # sa"

 |"toStbOne ((AttR n)#(AttC m)#s) = (AttC (fill(n + m div 2))) # nextL((AttC m)#s)"
 |"toStbOne ((AttR n)#(AttR m)#s) = (AttR n)#(AttR m)#s"

primrec
  toStb    :: "Att list => Att list"
where
  "toStb  ([]) = []"
 |"toStb (a#s) = toStbOne(a#(toStb(s)))"

(* --- test --- *)

lemma test_updateR:
 "updateR ([AttR 2, AttR 4, AttR 0],8) = [AttR 3, AttR 4, AttR 4]"
by (simp add: fill_def)

lemma test_toStbOne:
  "toStbOne ([AttR 2, AttL (4,2), AttC 0, AttR 6]) =
            [AttL (4,2), AttC 2, AttR 0, AttR 6]"
by (simp  add: fill_def)

(*   lemmas    *)

lemma guardR_last:
  "guardR s = (s~=[] & ((EX n. last s =AttC n) | (EX n. last s =AttR n)))"
apply (induct_tac s)
apply (simp)
apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma guardL_hd:
  "guardL s = (s~=[] & ((EX n x. hd s =AttL (n,x)) | (EX n. hd s =AttC n)))"
apply (induct_tac s)
apply (simp_all)
done

lemma guardR_AttL[simp]: "guardR (AttL sx # t) = guardR t"
apply (induct_tac t)
by (simp_all)

(*********************************************************
                       L C R
 *********************************************************)

primrec
 ChkL    :: "Att list => bool"
where
 "ChkL    [] = True"
|"ChkL (c#t) = ((EX x. c = AttL x) & ChkL t)"

primrec
 ChkC    :: "Att list => bool"
where
 "ChkC    [] = True"
|"ChkC (c#t) = ((EX x. c = AttC x) & ChkC t)"

primrec
 ChkR    :: "Att list => bool"
where
 "ChkR    [] = True"
|"ChkR (c#t) = ((EX x. c = AttR x) & ChkR t)"

primrec
 ChkCR   :: "Att list => bool"
where
 "ChkCR   []  = True"
|"ChkCR (c#t) = (((EX x. c = AttC x) & ChkR t) | ChkR (c#t))"

primrec
 ChkLCR  :: "Att list => bool"
where
 "ChkLCR   []  = True"
|"ChkLCR (c#t) = (((EX x. c = AttL x) & ChkLCR t) | ChkCR (c#t))"

(* ---------- sub 1 ---------- *)

lemma nextL_one_not_nil[simp]: "nextL ([a]) ~= []"
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (auto)
done

lemma nextL_not_nil[simp]: "nextL (a#s) ~= []"
apply (induct_tac s)
apply (auto)
apply (insert Att_or)
apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (auto)
done

lemma nextR_not_nil[simp]: "nextR (a#s,x) ~= []"
apply (induct_tac s)
apply (auto)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (auto)

apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (auto)
done

lemma tl_toStbOne_not_nil:
 "(tl (toStbOne s) ~= []) = (EX a1 a2 t. s=a1#a2#t)"
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert list_nil_or_unnil)
apply (drule_tac x="sa" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (insert Att_or)
apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
apply (insert list_nil_or_unnil)
apply (drule_tac x="saa" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="ab" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
done

lemma ChkLCR_nextL[simp]: "guardL s --> ChkLCR (nextL s) = ChkLCR s"
apply (induct_tac s)
apply (simp)
apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
done

lemma ChkLCR_nextR[simp]: "guardR s --> ChkLCR (nextR (s,x)) = ChkLCR s"
apply (induct_tac s)
apply (simp)
apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
apply (drule_tac x="s" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
done

lemma ChkLCR_AttL[simp]: "ChkLCR (AttL (n, x) # s) = ChkLCR s"
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma toStbOne_AttL[simp]: "toStbOne (AttL (n, x) # s) = AttL (n, x) # s"
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
done

lemma nextL_nextR_order[rule_format]:
   "(t = [] | (guardL t & guardR t & ChkLCR t)) -->
    nextL (nextR (t, x)) = nextR (nextL t, x)"
apply (induct_tac t)
apply (simp)
apply (intro allI impI)
apply (simp)

apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (auto)
done

lemma ChkR_ChkCR: "ChkR t --> ChkLCR t"
apply (induct_tac t)
apply (auto)
done

lemma guardR_hd: "guardR t --> guardR (a#t)"
apply (induct_tac t)
apply (simp_all)
done

lemma ChkR_guardR_AttR[simp]: "ALL n. ChkR s --> guardR (AttR n # s)"
apply (induct_tac s)
apply (auto)
done

lemma ChkR_guardR_AttC[simp]: "ALL n. ChkR s --> guardR (AttC n # s)"
apply (induct_tac s)
apply (auto)
done

lemma ChkLCR_guardR_next[simp]: "(ChkLCR t & t ~= []) --> guardR (nextL t)"
apply (induct_tac t)
apply (simp_all)
apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma guardR_nextR_AttL[simp]:
 "guardR t ==> nextR (AttL (n, x) # t, z) = (AttL (n,x))# nextR(t,z)"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma nextL_AttL_nextR_AttC[simp]:
   "nextL (AttL (n, x) # nextR (AttC m # t, y))
    = AttL (fill(n div 2 + x), m div 2) # nextL(nextR (AttC m # t, y))"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma nextL_AttL_nextR_AttR[simp]:
   "nextL (AttL (n, x) # nextR (AttR m # t, y)) =
       AttL (fill (n div 2 + x), getNat (hd (updateR (AttR m # t, y))) ) #
       updateR (AttR m # t, y)"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma nextL_AttL_updateR[simp]:
   "nextL (AttL (n, x) # updateR (AttR m # t, y)) =
    AttC (fill (n div 2 + x)) # updateR (AttR m # t, y)"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
done

(* --------------------lemma ------------------*)

lemma guardL_nextL_AttL[simp]: "guardL (nextL (AttL (n,x) # t))"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma nextL_AttL_nextL_AttL[simp]:
  "nextL (AttL (n,x) # nextL (AttL (m,y) # t)) =
   AttL (fill(n div 2 + x), fill(m div 2 + y) div 2) # nextL (nextL (AttL (m,y) # t))"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma ChkLCR_guardL_guardR_nextL[simp]:
  "[| ChkLCR t ; guardL t |] ==> guardR (nextL t)"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma ChkLCR_guardR_guardL_nextR[simp]:
  "[| ChkLCR t ; guardR t |] ==> guardL (nextR (t, x))"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="aa" in spec)
apply (elim disjE exE)
apply (simp_all)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (drule_tac x="aa" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma nextR_nextL_nextL_order_AttL:
   "[| ChkLCR t ; guardR t |] ==>
    nextR (nextL (nextL (AttL (n, x) # t)), y) =
    nextL (nextR (nextL (AttL (n, x) # t), y))"
apply (simp add: nextL_nextR_order[THEN sym])
done

lemma nextL_AttL_nextR_guardR[simp]:
  "[| ChkLCR t ; guardR t |] ==>
   nextL (AttL (n, x) # nextR (t, y)) =
   AttL (fill (n div 2 + x), getNat (hd (nextR (t, y))) div 2) # nextL (nextR (t, y))"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (elim disjE conjE exE)
apply (simp_all)
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp_all)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma ChkR_ChkLCR_updateR[simp]: "ChkR s --> ChkLCR (updateR (s,x)) = ChkLCR s"
apply (induct_tac s)
apply (simp)
apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
done

lemma ChkR_ChkR_updateR[simp]: "ChkR s --> ChkR (updateR (s,x)) = ChkR s"
apply (induct_tac s)
apply (simp)
apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (auto)
done

(* ---- basic ---- *)

lemma ChkLCR_toStbOne_id: "ChkLCR t --> toStbOne t = t"
apply (induct_tac t)
apply (simp_all)
apply (auto)
apply (simp_all add: ChkR_ChkCR)
apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (auto)
apply (drule_tac x="list" in spec)
apply (auto)
done

(* ---- basic ---- *)

lemma ChkLCR_toStbOne: "ChkLCR t --> ChkLCR (toStbOne (a#t))"
apply (induct_tac t)
apply (simp_all)
apply (simp add: Att_or)

apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (intro conjI impI)
apply (elim disjE conjE exE)
apply (simp_all)

apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (insert Att_or)
apply (elim disjE conjE exE)
apply (simp)
apply (drule_tac x="ab" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (drule_tac x="list" in spec)
apply (frule_tac x="a" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (drule_tac x="list" in spec)
apply (frule_tac x="a" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
done

lemma ChkLCR_tl[rule_format]: "ChkLCR (a#t) --> ChkLCR t"
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE conjE exE)
apply (simp_all add: ChkR_ChkCR)
done

lemma ChkLCR_toStb: "ChkLCR (toStb t)"
apply (induct_tac t)
apply (simp_all)
apply (simp add: ChkLCR_toStbOne)
done

lemma ChkLCR_toStb_id[rule_format]: "ChkLCR t --> toStb t = t"
apply (induct_tac t)
apply (simp_all)
apply (auto)
apply (simp_all add: ChkR_ChkCR)
apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (auto)
apply (drule_tac x="list" in spec)
apply (auto)
done

(* basic *)

lemma nextL_one_EX:
 "[| ChkLCR t ; nextL t = [a] |] ==> (EX a. t = [a])"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
apply (elim disjE conjE exE)
apply (simp_all)
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
apply (elim disjE conjE exE)
apply (simp_all)
done

lemma nextR_one_EX:
 "[| ChkLCR t ; nextR (t,x) = [a] |] ==> (EX a. t = [a])"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
apply (elim disjE conjE exE)
apply (simp_all)
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (frule_tac x="s" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
apply (elim conjE exE)
apply (simp)
apply (drule_tac x="sa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (frule_tac x="s" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
apply (elim conjE exE)
apply (simp)
apply (drule_tac x="sa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
done

(*  ----  basic ---- *)

lemma toStbOne_nil[simp]: "(toStbOne t = []) = (t = [])"
apply (induct_tac t)
apply (simp_all)

apply (insert list_nil_or_unnil)
apply (frule_tac x="list" in spec)
apply (elim disjE conjE exE)
apply (simp)
apply (drule_tac x="s" in spec)
apply (elim disjE conjE exE)
apply (simp)

apply (insert Att_or)
apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (frule_tac x="aa" in spec)
apply (drule_tac x="ab" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
done

lemma toStb_nil[simp]: "(toStb t = []) = (t = [])"
apply (induct_tac t)
apply (simp_all)
done

lemma toStbOne_one[simp]: "(toStbOne t = [a]) = (t = [a])"
apply (induct_tac t)
apply (simp_all)

apply (insert list_nil_or_unnil)
apply (frule_tac x="list" in spec)
apply (elim disjE conjE exE)
apply (simp)
apply (drule_tac x="s" in spec)
apply (elim disjE conjE exE)
apply (simp)

apply (insert Att_or)
apply (frule_tac x="aa" in spec)
apply (drule_tac x="aaa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (frule_tac x="aa" in spec)
apply (frule_tac x="aaa" in spec)
apply (drule_tac x="ab" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
done

lemma toStb_one[simp]: "(toStb t = [a]) = (t = [a])"
apply (induct_tac t)
apply (simp_all)
done

lemma length_nextL: "(guardL t & ChkLCR t) --> length (nextL t) = length t"
apply (induct_tac t)
apply (simp)

apply (simp)
apply (intro conjI impI)
apply (auto)

apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (elim disjE exE)
apply (simp_all)
apply (elim disjE exE conjE)
apply (simp_all)

apply (drule_tac x="list" in spec)
apply (elim disjE conjE exE)
apply (simp)
apply (simp)
apply (elim disjE exE conjE)
apply (simp_all)
done

lemma toStbOne_length[rule_format]:
  "ALL a. ChkLCR t --> length (toStbOne (a#t)) = Suc (length t)"
apply (induct_tac t)
apply (simp_all)

apply (rule allI)
apply (insert list_nil_or_unnil)
apply (frule_tac x="list" in spec)
apply (elim disjE conjE exE)
apply (simp)

apply (insert Att_or)
apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (frule_tac x="aa" in spec)
apply (drule_tac x="ab" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
apply (simp add: length_nextL)
apply (simp add: length_nextL)
done

lemma ChkLCR_toStbOne_if[rule_format]:
  "ALL a. ChkLCR (toStbOne (a#s)) --> ChkLCR s"
apply (induct_tac s)
apply (simp_all)

apply (intro conjI impI)
apply (elim conjE exE)
apply (insert Att_or)
apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE conjE exE)
apply (simp_all)

apply (insert list_nil_or_unnil)
apply (drule_tac x="list" in spec)
apply (elim disjE conjE exE)
apply (simp)
apply (drule mp)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="ab" in spec)
apply (elim disjE conjE exE)
apply (simp_all)
apply (rule_tac x="AttL (0, 0)" in exI)
apply (simp)
apply (rule_tac x="AttL (0, 0)" in exI)
apply (simp)
apply (rule_tac x="AttL (0, 0)" in exI)
apply (simp)
done

lemma ChkLCR_toStbOne_iff:
  "ChkLCR (toStbOne (a#s)) = ChkLCR s"
apply (rule iffI)
apply (rule ChkLCR_toStbOne_if)
apply (simp)
apply (simp add: ChkLCR_toStbOne)
done

lemma EX_toStbOne_toStb: "EX t. toStbOne t = toStb s"
apply (induct_tac s)
apply (rule_tac x="[]" in exI)
apply (auto)
done

(* -------------------------------------------------------------------- *)

lemma nextL_AttL_EX: "EX a s. nextL (AttL (n, x) # t) = a#s"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma nextR_AttC_EX: "EX a s. nextR (AttC n # t,x) = a#s"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma nextR_AttR_EX: "EX a s. nextR (AttR n # t,x) = a#s"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma hd_nextR_AttC_EX:
  "EX x s. nextR (AttC n # t, y) = AttL (n,x)#s"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma getNat_hd_nextR_AttC:
  "getNat (hd (nextR (AttC n # t, y))) = n"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma guardR_nextR_nextL_lm:
  "ALL t z. (length t = n & ChkLCR t & guardL t & guardR t)
   --> guardR (nextR ((nextL t), z))"
apply (induct_tac n)
apply (simp)
apply (intro allI impI)
apply (simp)
apply (elim disjE exE conjE)

apply (insert list_nil_or_unnil)
apply (rotate_tac -1)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (elim disjE exE)
apply (simp_all)
apply (insert list_nil_or_unnil)
apply (rotate_tac -1)
apply (frule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (elim disjE exE conjE)
apply (simp_all)
apply (frule_tac x="sa" in spec)
apply (elim disjE exE)
apply (simp_all)
apply (drule_tac x="sa" in spec)
apply (elim disjE exE)
apply (simp_all)
apply (rotate_tac -1)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma guardR_nextR_nextL:
  "[| ChkLCR t ; guardL t ; guardR t |]
   ==> guardR (nextR ((nextL t), z))"
apply (insert guardR_nextR_nextL_lm[of "length t"])
apply (simp)
done

lemma guardL_nextL_nextR_lm:
  "ALL t z. (length t = n & ChkLCR t & guardL t & guardR t)
   --> guardL (nextL (nextR (t, z)))"
apply (induct_tac n)
apply (simp)
apply (intro allI impI)
apply (simp)
apply (elim disjE exE conjE)

apply (insert list_nil_or_unnil)
apply (rotate_tac -1)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (elim disjE exE)
apply (simp_all)
apply (insert list_nil_or_unnil)
apply (rotate_tac -1)
apply (frule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
done

lemma guardL_nextL_nextR:
  "[| ChkLCR t ; guardL t ; guardR t |]
   ==> guardL (nextL (nextR (t, z)))"
apply (insert guardL_nextL_nextR_lm[of "length t"])
apply (simp)
done

lemma guardR_nextR_AttR_lm:
  "ALL t m x. (length t = n & ChkLCR t)
   --> guardR (nextR (AttR m # t, x))"
apply (induct_tac n)
apply (simp)
apply (intro allI impI)
apply (simp)
apply (elim disjE exE conjE)

apply (insert list_nil_or_unnil)
apply (rotate_tac -1)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (elim conjE disjE exE)
apply (simp_all)
done

lemma guardR_nextR_AttR:
  "ChkLCR t ==> guardR (nextR (AttR m # t, x))"
apply (insert guardR_nextR_AttR_lm[of "length t"])
apply (simp)
done

lemma not_nil_nextL_not_nil[simp]: "t ~= [] ==> nextL t ~= []"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (auto)
done

lemma not_nil_nextR_not_nil[simp]: "t ~= [] ==> nextR (t,x) ~= []"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (auto)
done

(* --------------------------------- *
               lemmas
 * --------------------------------- *)

lemma toStbOne_AttC_hd:
  "ALL n s. (EX m t. toStbOne ((AttC n)#s) = (AttC m)#t) |
            (EX m t. toStbOne ((AttC n)#s) = (AttL m)#t)"
apply (intro allI)
apply (insert list_nil_or_unnil)
apply (frule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (frule_tac x="sa" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma guardL_toStb_AttC:
   "s ~= [] ==> guardL (toStb (map AttC s))"
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (insert toStbOne_AttC_hd)
apply (drule_tac x="a" in spec)
apply (drule_tac x="toStb (map AttC sa)" in spec)
apply (auto)
done

lemma guardR_toStbOne_map_AttC_lm:
   "ALL s. (length s = n & s ~= []) --> guardR (toStbOne (map AttC s))"
apply (induct_tac n)
apply (simp)
apply (intro allI impI)
apply (elim disjE exE conjE)

apply (insert list_nil_or_unnil)
apply (rotate_tac -1)
apply (frule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (frule_tac x="sa" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (drule_tac x="sb" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (drule_tac x="sa" in spec)
apply (simp)
apply (simp add: guardR_last)
apply (auto)
done

lemma guardR_toStbOne_AttC:
   "ChkLCR t ==> guardR (toStbOne (AttC a # t))"
apply (insert list_nil_or_unnil)
apply (frule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp_all)
apply (elim disjE conjE exE)
apply (simp_all)
done

lemma guardR_toStb_AttC:
   "s ~= [] ==> guardR (toStb (map AttC s))"
apply (insert list_nil_or_unnil)
apply (drule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (simp add: guardR_toStbOne_AttC ChkLCR_toStb)
done

(*********************************************************
              preliminary (stabilization)
 *********************************************************)

lemma toStbOne_AttC_hd2:
  "ALL n s. (EX t. toStbOne ((AttC n)#s) = (AttC n)#t) |
            (EX m t. toStbOne ((AttC n)#s) = (AttL (n,m))#t)"
apply (intro allI)
apply (insert list_nil_or_unnil)
apply (frule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (frule_tac x="sa" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma getNat_hd_toStbOne_AttC[simp]:
  "getNat (hd (toStbOne ((AttC n)#s))) = n"
apply (insert toStbOne_AttC_hd2)
apply (drule_tac x="n" in spec)
apply (drule_tac x="s" in spec)
apply (auto)
done

lemma nextR_nextL_AttL_EX:
  "ALL n x a s y.
   EX z t. (nextR (nextL (AttL (n, x) # a # s), y)) =
            (AttL(fill (n div 2 + x),z)) # t"
apply (intro allI)
apply (insert list_nil_or_unnil)
apply (frule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma getNat_hd_nextR_nextL_AttL[simp]:
  "getNat(hd (nextR (nextL (AttL (n, x) # a # s), y))) = fill (n div 2 + x)"
apply (insert nextR_nextL_AttL_EX)
apply (drule_tac x="n" in spec)
apply (drule_tac x="x" in spec)
apply (drule_tac x="a" in spec)
apply (drule_tac x="s" in spec)
apply (drule_tac x="y" in spec)
apply (auto)
done

(* ---------------------------------- *
      async version <--> lineNext
 * ---------------------------------- *)

lemmas toStb_simp = guardR_toStb_AttC
                    guardL_toStb_AttC
                    ChkLCR_toStb

lemma nextL_nextR_toStb_lineNext:
  "nextL (nextR (toStb (map AttC s), x)) = toStb (map AttC (lineNext s x))"
apply (induct_tac s)
apply (simp)
apply (simp)
apply (intro impI)
apply (drule sym)
apply (simp)   (* induction hypothesis *)

apply (subgoal_tac "ChkLCR (toStb (map AttC list))")  (* by ChkLCR_toStb *)
apply (subgoal_tac "guardL (toStb (map AttC list))")  (* by guardL_toStb_AttC *)
apply (subgoal_tac "guardR (toStb (map AttC list))")  (* by guardR_toStb_AttC *)
apply (simp add: nextL_nextR_order)
apply (simp add: not_nil_EX)
apply (elim exE)
apply (simp)
apply (insert toStbOne_AttC_hd2)
apply (drule_tac x="aa" in spec)
apply (drule_tac x="toStb (map AttC t)" in spec)
apply (elim disjE conjE exE)
 (* C *)
 apply (simp)
 apply (case_tac "ta=[]")
 apply (simp)
 apply (simp add: not_nil_EX)
 apply (elim exE)
 apply (simp)

 (* L *)
 apply (simp)
 apply (case_tac "ta=[]")
 apply (simp)
 apply (simp add: not_nil_EX)
 apply (elim exE)
 apply (simp)
 apply (insert nextR_nextL_AttL_EX)
  apply (drule_tac x="aa" in spec)
  apply (drule_tac x="m" in spec)
  apply (drule_tac x="ab" in spec)
  apply (drule_tac x="tb" in spec)
  apply (drule_tac x="x" in spec)
 apply (elim exE)
 apply (simp)

 apply (simp add: guardR_toStb_AttC)
 apply (simp add: guardL_toStb_AttC)
 apply (simp add: ChkLCR_toStb)
done

lemma nextR_nextL_toStb_nextR_nextL_toStb:
  "s ~= [] ==>
   nextR (nextL (toStb (map AttC s)), x) = nextL (nextR (toStb (map AttC s), x))"
apply (simp add: nextL_nextR_order toStb_simp)
done

lemma nextR_nextL_toStb_lineNext:
  "s ~= [] ==>
   nextR (nextL (toStb (map AttC s)), x) = toStb (map AttC (lineNext s x))"
apply (simp add: nextR_nextL_toStb_nextR_nextL_toStb
                 nextL_nextR_toStb_lineNext)
done

(* ----------- guard lemma ----------- *)

lemma guardL_nextL_toStb_AttC:
   "tl s ~= [] ==> guardL (nextL (toStb (map AttC s)))"
apply (insert list_nil_or_unnil)
apply (frule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (drule_tac x="sa" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (insert toStbOne_AttC_hd)
apply (drule_tac x="aa" in spec)
apply (drule_tac x="toStb (map AttC saa)" in spec)
apply (auto)
done

lemma toStbOne_AttC_AttC:
  "toStbOne ((AttC n)#(toStbOne ((AttC m)#s))) =
   (AttL (n,m div 2))#(nextL (toStbOne((AttC m)#s)))"
apply (insert list_nil_or_unnil)
apply (frule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (frule_tac x="sa" in spec)
apply (elim disjE exE)
apply (simp)
apply (insert Att_or)
apply (drule_tac x="a" in spec)
apply (elim disjE exE)
apply (simp_all)

apply (frule_tac x="a" in spec)
apply (drule_tac x="aa" in spec)
apply (elim disjE exE)
apply (simp_all)
done

lemma guardR_nextR_toStb_AttC_lm:
   "ALL s x. (length s = n & tl s ~= [])
    --> guardR (nextR (toStb (map AttC s),x))"
apply (induct_tac n)
apply (simp)
apply (intro allI impI)
apply (insert list_nil_or_unnil)
apply (rotate_tac -1)
apply (frule_tac x="s" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)

apply (subgoal_tac "ChkLCR (toStb (map AttC sa))")  (* by ChkLCR_toStb *)
apply (subgoal_tac "guardL (toStb (map AttC sa))")  (* by guardL_toStb_AttC *)
apply (subgoal_tac "guardR (toStb (map AttC sa))")  (* by guardR_toStb_AttC *)

apply (drule_tac x="sa" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (simp add: toStbOne_AttC_AttC)

apply (insert list_nil_or_unnil)
apply (rotate_tac -1)
apply (drule_tac x="nextL (toStbOne (AttC aa # toStb (map AttC sb)))" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
apply (rotate_tac -1)
apply (drule sym)
apply (simp)
apply (subgoal_tac "nextR (nextL (toStbOne (AttC aa # toStb (map AttC sb))), x) =
                    nextL (nextR (toStbOne (AttC aa # toStb (map AttC sb)), x))")
apply (simp)
apply (simp add: nextL_nextR_order)

 apply (simp add: guardR_toStb_AttC)
 apply (simp add: guardL_toStb_AttC)
 apply (simp add: ChkLCR_toStb)
done

lemma guardR_nextR_toStb_AttC:
   "tl s ~= [] ==> guardR (nextR (toStb (map AttC s),x))"
apply (insert guardR_nextR_toStb_AttC_lm[of "length s"])
apply (simp)
done

(* ---------------------------------- *
                nextLR
 * ---------------------------------- *)

lemma nextLR_toStb_circNext:
  "nextLR (toStb (map AttC s)) = toStb (map AttC (circNext s))"
apply (simp add: nextLR_def)
apply (simp add: circNext_def)
apply (intro impI)
apply (simp add: nextL_nextR_toStb_lineNext)
apply (simp add: not_nil_EX)
apply (elim exE)
apply (simp)
done

(* ------------- lemma ------------- *)

lemma tl_lineNext:
 "tl t ~= [] ==> lineNext (tl t) x = tl (lineNext t x)"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
done

lemma hd_lineNext:
  "tl t ~= [] ==> hd (lineNext t x) =  (fill (hd t div 2 + hd (tl t) div 2))"
apply (insert list_nil_or_unnil)
apply (drule_tac x="t" in spec)
apply (elim disjE exE)
apply (simp)
apply (simp)
done

lemma hd_circNext:
  "tl t ~= [] ==> hd (circNext t) =  (fill (hd t div 2 + hd (tl t) div 2))"
apply (simp add: circNext_def)
apply (auto)
apply (simp add: hd_lineNext)
done

lemma getNat_hd_toStb_map_AttC:
  "t ~= [] ==> getNat (hd (toStb (map AttC t))) = hd t"
apply (simp add: not_nil_EX)
apply (elim exE)
apply (simp)
done

end


theory Refinement
  imports While "../Algebra/RKAT_Models" "$ISABELLE_HOME/src/HOL/Eisbach/Eisbach"
begin

no_notation comp_op ("n_" [90] 91)
  and test_operator  ("t_" [100] 101)
  and floor ("\<lfloor>_\<rfloor>")
  and ceiling ("\<lceil>_\<rceil>")
  and Set.image (infixr "`" 90)
  and rkat_class.ref_order (infix "\<sqsubseteq>" 50)

abbreviation rel_ref_order (infix "\<sqsubseteq>" 50) where
  "rel_ref_order \<equiv> rel_rkat.ref_order"

abbreviation Spec :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a rel" where
  "Spec P Q \<equiv> rel_spec (\<lfloor>P\<rfloor>) (\<lfloor>Q\<rfloor>)"

lemma seq_assoc: "x; y; z = (x; y); z"
  by (auto simp: seq_def)

(***********************************************************************************************)

text {* \emph{morgan} tactic *}

named_theorems ref_rules

method morgan_step uses simp ref =
  (assumption | rule ref ref_rules | subst seq_assoc)

method morgan uses simp ref =
  (morgan_step simp: simp ref: ref; (morgan simp: simp ref: ref)?)+

(***********************************************************************************************)

text {* Remaining Morgan Refinement Laws *}

lemma assignment_ref [intro]: "P \<subseteq> subst Q v m \<Longrightarrow> Spec P Q \<sqsubseteq> assign v m"
  apply (clarsimp simp: subst_def assign_def rel_rkat.ref_order_def graph_def rel_spec_def)
  apply (rule_tac x="{(s, v (\<lambda>_. m s) s)}" in exI, auto)
done

lemma following_assignment_ref: "Q' \<subseteq> subst Q v m \<Longrightarrow> Spec P Q \<sqsubseteq> Spec P Q'; assign v m"
proof -
  assume assms: "Q' \<subseteq> subst Q v m"
  have "Spec P Q \<sqsubseteq> Spec P Q'; Spec Q' Q"
    by (auto simp: seq_def)
  also have "... \<sqsubseteq> Spec P Q'; assign v m"
    using assms by (auto simp: seq_def)
  finally show ?thesis .
qed

lemma leading_assignment_ref: "P \<subseteq> subst P' v m \<Longrightarrow> Spec P Q \<sqsubseteq> assign v m; Spec P' Q"
proof -
  assume assms: "P \<subseteq> subst P' v m"
  have "Spec P Q \<sqsubseteq> Spec P P'; Spec P' Q"
    by (auto simp: seq_def)
  also have "... \<sqsubseteq> assign v m; Spec P' Q"
    using assms by (auto simp: seq_def)
  finally show ?thesis .
qed

(* Annotated while Specification *)

lemma while_ref_tactic: "\<lbrakk>I \<inter> B \<subseteq> P'; P \<subseteq> I; I - B \<subseteq> Q\<rbrakk> \<Longrightarrow> Spec P Q \<sqsubseteq> cwhile B (Spec P' I)"
proof -
  have a: "\<lfloor>I - B\<rfloor> = \<lfloor>I\<rfloor> O \<lfloor>-B\<rfloor>" by force
  have b: "\<lfloor>I \<inter> B\<rfloor> = \<lfloor>I\<rfloor> O \<lfloor>B\<rfloor>" by force
  assume assms: "I \<inter> B \<subseteq> P'" "P \<subseteq> I" "I - B \<subseteq> Q"
  hence "Spec P Q \<sqsubseteq> rel_spec (\<lfloor>I\<rfloor>) (\<lfloor>I - B\<rfloor>)"
    by auto
  also have "... \<sqsubseteq> (\<lfloor>B\<rfloor> O Spec (I \<inter> B) I)\<^sup>* O \<lfloor>- B\<rfloor>"
    by (auto simp: a b intro: rel_rkat.while_ref)
  also have "... \<sqsubseteq> (\<lfloor>B\<rfloor> O Spec P' I)\<^sup>* O \<lfloor>- B\<rfloor>"
    using assms by force
  finally show ?thesis
    by (simp add: cwhile_def seq_def)
qed

lemma while_iso: "c \<sqsubseteq> c' \<Longrightarrow> cwhile b c \<sqsubseteq> cwhile b c'"
  by (auto simp: cwhile_def seq_def)

lemma spec_mult_isol: "x \<sqsubseteq> y \<Longrightarrow> z; x \<sqsubseteq> z; y"
  by (simp add: seq_def rel_rkat.spec_mult_isol)

lemma spec_mult_isor: "x \<sqsubseteq> y \<Longrightarrow> x; z \<sqsubseteq> y; z"
  by (simp add: seq_def rel_rkat.spec_mult_isor)

lemma ref_skipI: "p \<le> q \<Longrightarrow> Spec p q \<sqsubseteq> skip"
  by (auto simp: skip_def)

lemma ref_skipE: "x \<sqsubseteq> skip \<Longrightarrow> x;y \<sqsubseteq> y"
  by (auto simp: skip_def seq_def rel_rkat.ref_order_def)

(***********************************************************************************************)

text {* When using morgan, rules should be applied in the following order *}

declare
  spec_mult_isol [ref_rules]
  spec_mult_isor [ref_rules]
  while_iso [ref_rules]
  leading_assignment_ref [ref_rules]
  following_assignment_ref [ref_rules]
  assignment_ref [ref_rules]
  rel_rkat.skip_ref_var2 [ref_rules]
  rel_rkat.sequence_ref [ref_rules]
  rel_rkat.weaken_pre [ref_rules]
  rel_rkat.strengthen_post [ref_rules]
  rel_rkat.weaken_and_strengthen [ref_rules]
  rel_rkat.while_ref [ref_rules]
  while_ref_tactic [ref_rules]
  ref_skipI [ref_rules]
  ref_skipE [ref_rules]

declare subst_def [simp]

end


theory Chapter4
  imports Chapter1 Chapter2 Complex_Main

begin
declare [[smt_timeout = 200]]
text \<open>
\spike
Soon to be filled in with some Hartshorne text.

Key idea for this on 3/10:

If you have a projective plane, defined by meets: points -> lines,
then you can define a NEW set of points:

type_equivalence ppoints = lines

and a new set of lines:

type_equivalence llines = points

in which you swap the role of "point" and "line". We already saw something like this in our
work on the real projective plane, where I suggested that we could use the type "point" (3-coordinate
homogeneous vector) to represent a line (the "line" defined by "points in the plane orthogonal to the
given "normal" vector).

With these two "new" types we can define a new "meets" function:

  fun dmeets :: "ppoint \<Rightarrow> lline \<Rightarrow> bool" where
    "dmeets P k = meets k P"

i.e., the "newpoint P" (which is really a line p) meets the "newline l" (which is really a point L)
exactly if L lies on p in our original projective plane. This new function, dmeets, (together with its
domain and codomain) constitutes a projective plane, called the "dual" of the original plane.

To prove this, we have to (as usual) show the three axioms are true.

\done\<close>

  locale projective_plane_plus =
    projective_plane meets
  for meets :: "'point \<Rightarrow> 'line \<Rightarrow> bool"
begin
    definition dmeets
      where "dmeets P l  \<longleftrightarrow> ( meets l P)"
(* Goal: to prove the theorem that "dmeets is a projective plane" *)

lemma dmeets_p1aa_1:
  assumes "P\<noteq>Q"
  shows "\<exists>l. dmeets P l \<and> dmeets Q l"
  unfolding dmeets_def
  using assms p2 by blast

lemma dmeets_p1aa: "P \<noteq> Q \<longrightarrow> (\<exists>l. dmeets P l \<and> dmeets Q l)"

  using dmeets_p1aa_1 by auto

(* first exercise:
1. what happens if you remove the "forall Q : at the start of that lemma?
2. rewrite that lemma as p1a, in fix-assume-show format
3. PROVE the lemma (you may need to delete the lemma I've written above, or it'll
be used as the "proof" of the rewritten lemma.
*)

lemma dunique_lines:
  fixes B
  fixes l
  fixes m
  assumes diff:"P \<noteq> B"
  assumes "dmeets P l"
  assumes "dmeets B l"
  assumes "dmeets P m"
  assumes "dmeets B m"

  shows "l = m"
  using assms dmeets_def p2 by blast

lemma "dmeets_p1b": "P \<noteq> Q \<longrightarrow> (\<exists>!l. dmeets P l \<and> dmeets Q l)"
  using dmeets_p1aa dunique_lines by blast

lemma "dmeets_p2": "\<forall>l m. l \<noteq> m \<longrightarrow> (\<exists>!P. dmeets P l \<and> dmeets P m)"

  by (simp add: dmeets_def p1)

lemma "dmeets_p3": "\<exists>P Q R. P \<noteq> Q \<and> P \<noteq> R \<and> Q \<noteq> R \<and> \<not> projective_plane_data.collinear dmeets P Q R"
proof -
  obtain l m n where lmn: "l \<noteq> m \<and> l \<noteq> n \<and> m \<noteq> n \<and> \<not> projective_plane_data.collinear meets l m n"
    using p3 by blast
  obtain P where P: "dmeets P l \<and> dmeets P m" using dmeets_p2 lmn by blast
  obtain Q where Q: "dmeets Q m \<and> dmeets Q n" using dmeets_p2 lmn by blast
  obtain R where R: "dmeets R n \<and> dmeets R l" using dmeets_p2 lmn by blast
  have PQ: "P \<noteq> Q" using P Q collinear_def dmeets_def lmn by blast
  have PR: "P \<noteq> R" using P R collinear_def dmeets_def lmn by blast
  have RQ: "R \<noteq> Q" using R Q collinear_def dmeets_def lmn by blast
  thus ?thesis by (smt P Q R dunique_lines lmn projective_plane_data.collinear_def) qed

lemma "pmeets_p4": "\<exists>P Q R. P \<noteq> Q \<and> P \<noteq> R \<and> Q \<noteq> R \<and> dmeets P l \<and> dmeets Q l \<and> dmeets R l"
proof -
  obtain A where A:"\<not> meets l A" using dmeets_def dmeets_p3
    by (smt projective_plane_data.collinear_def)
  obtain m n k where mnk:"meets m A \<and> meets n A \<and> meets k A \<and> m \<noteq> n \<and> n \<noteq> k \<and> m \<noteq>k"
    using p4 by blast
  obtain P where P: "meets l P \<and> meets m P"
    by (metis mnk p1)
 obtain Q where Q: "meets l Q \<and> meets n Q"
   by (metis mnk p1)
 obtain R where R: "meets l R \<and> meets k R"
   by (metis mnk p1)
 have "P \<noteq> Q \<and> P \<noteq> R \<and> Q \<noteq> R \<and> meets l P \<and> meets l Q \<and> meets l R"
   by (metis A P Q R mnk p2)
  thus ?thesis unfolding dmeets_def by auto
qed

lemma "extra_line":
  fixes P
  shows "\<exists> k . \<not> meets P k"
  using dmeets_def dmeets_p3 projective_plane_data.collinear_def by force

text\<open>\daniel This allows us an easy way to prove the duals of theorems
in a projective plane\<close>

interpretation dual:projective_plane dmeets
  unfolding projective_plane_def
  using dmeets_p1b dmeets_p2 dmeets_p3 local.pmeets_p4 by blast

lemma linesOffPoints: (* dual of pointOffLines *)
  fixes P::"'point" and Q::"'point"
  assumes "P \<noteq> Q"
  shows "\<exists>l::'line. (\<not> meets P l) \<and> (\<not> meets Q l)"
  using dual.pointOffLines assms dmeets_def by blast

text\<open>\done\<close>
end

end
text\<open>\seiji \caleb\<close>
locale desarguian_projective_plane_plus =
    projective_plane_plus meets +
    desarguian_proj_plane meets
    for meets :: "'point \<Rightarrow> 'line \<Rightarrow> bool"
begin
lemma perspective_implies_concurrent:
  fixes a and b and c and a' and b' and c' and p
  assumes "desarguian_plane_data.perspective_from_point local.dmeets p a b c a' b' c'"
  shows "(projective_plane_data.concurrent meets a a' p)"
proof -
  obtain P where P: "local.dmeets p P \<and> local.dmeets a P"
    by (metis (full_types) dmeets_def dmeets_p1aa p4)
  obtain A where A: "local.dmeets a A \<and> local.dmeets a' A"
    by (metis (full_types) dmeets_def dmeets_p1aa p4)
  obtain P' where P': "local.dmeets p P' \<and> local.dmeets a' P'"
    by (metis (full_types) dmeets_def dmeets_p1aa p4)

qed
lemma dual_desargues:
  fixes a and b and c and a' and b' and c' and p
  assumes "desarguian_plane_data.perspective_from_point local.dmeets p a b c a' b' c'"
  shows "desarguian_plane_data.perspective_from_line local.dmeets a b c a' b' c'"
proof -
  have conc1: "(projective_plane_data.concurrent meets a a' p)" try
    by (smt assms concurrent_def desarguian_plane_data.intro desarguian_plane_data.perspective_from_point_def dmeets_def dmeets_p1b dmeets_p2 dmeets_p3 local.pmeets_p4 projective_plane.intro projective_plane_data.collinear_def)

qed
end

text\<open>\done \done\<close>


chapter \<open>Löb  Formulas\<close>

(*<*)
theory Loeb_Formula imports Diagonalization Derivability_Conditions
begin
(*>*)

text \<open>The Löb formula, parameterized by a sentence @{term \<phi>}, is defined by diagonalizing @{term "imp P \<phi>"}.\<close>

locale Loeb_Form =
Deduct2
  var trm fmla Var FvarsT substT Fvars subst
  num
  eql cnj imp all exi
  prv bprv
+
Repr_SelfSubst
  var trm fmla Var FvarsT substT Fvars subst
  num
  eql cnj imp all exi
  prv bprv
  enc
  S
+
HBL1
  var trm fmla Var FvarsT substT Fvars subst
  num
  eql cnj imp all exi
  prv bprv
  enc
  P
for
var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set"
and Var num FvarsT substT Fvars subst
and eql cnj imp all exi
and prv bprv
and enc ("\<langle>_\<rangle>")
and S
and P
begin

text \<open>The Löb formula associated to a formula @{term \<phi>}:\<close>
definition \<phi>L :: "'fmla \<Rightarrow> 'fmla" where "\<phi>L \<phi> \<equiv> diag (imp P \<phi>)"

lemma \<phi>L[simp,intro]: "\<And>\<phi>. \<phi> \<in> fmla \<Longrightarrow> Fvars \<phi> = {} \<Longrightarrow> \<phi>L \<phi> \<in> fmla"
and
Fvars_\<phi>L[simp]: "\<phi> \<in> fmla \<Longrightarrow> Fvars \<phi> = {} \<Longrightarrow> Fvars (\<phi>L \<phi>) = {}"
  unfolding \<phi>L_def PP_def by auto

lemma bprv_\<phi>L_eqv:
"\<phi> \<in> fmla \<Longrightarrow> Fvars \<phi>  = {} \<Longrightarrow> bprv (eqv (\<phi>L \<phi>) (imp (PP \<langle>\<phi>L \<phi>\<rangle>) \<phi>))"
  unfolding \<phi>L_def PP_def using bprv_diag_eqv[of "imp P \<phi>"] by auto

lemma prv_\<phi>L_eqv:
"\<phi> \<in> fmla \<Longrightarrow> Fvars \<phi>  = {} \<Longrightarrow> prv (eqv (\<phi>L \<phi>) (imp (PP \<langle>\<phi>L \<phi>\<rangle>) \<phi>))"
  using bprv_prv[OF _ _ bprv_\<phi>L_eqv, simplified] by auto

end \<comment> \<open>context @{locale Loeb_Form}\<close>

(*<*)
end
(*>*)


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
paragraph \<open>Galois Property\<close>
theory Transport_Compositions_Agree_Galois_Property
  imports
    Transport_Compositions_Agree_Base
begin

context transport_comp_agree
begin

lemma galois_propI:
  assumes galois1: "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and galois2: "((\<le>\<^bsub>L2\<^esub>) \<unlhd> (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  and mono_l1: "([in_dom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m in_dom (\<le>\<^bsub>L2\<^esub>)) l1"
  and mono_r2: "([in_codom (\<le>\<^bsub>R2\<^esub>)] \<Rrightarrow>\<^sub>m in_codom (\<le>\<^bsub>R1\<^esub>)) r2"
  and agree: "([in_dom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow> [in_codom (\<le>\<^bsub>R2\<^esub>)] \<Rrightarrow> (\<longleftrightarrow>))
    (rel_bimap l1 r2 (\<le>\<^bsub>R1\<^esub>)) (rel_bimap l1 r2 (\<le>\<^bsub>L2\<^esub>))"
  shows "((\<le>\<^bsub>L\<^esub>) \<unlhd> (\<le>\<^bsub>R\<^esub>)) l r"
proof (rule galois_prop.galois_propI')
  fix x y assume "in_dom (\<le>\<^bsub>L\<^esub>) x" "in_codom (\<le>\<^bsub>R\<^esub>) y"
  with mono_r2 mono_l1 have "in_dom (\<le>\<^bsub>L2\<^esub>) (l1 x)" "in_codom (\<le>\<^bsub>R1\<^esub>) (r2 y)" by auto
  have "x \<le>\<^bsub>L\<^esub> r y \<longleftrightarrow> x \<le>\<^bsub>L1\<^esub> r1 (r2 y)" by simp
  also from galois1 \<open>in_dom (\<le>\<^bsub>L1\<^esub>) x\<close> \<open>in_codom (\<le>\<^bsub>R1\<^esub>) (r2 y)\<close>
    have "... \<longleftrightarrow> l1 x \<le>\<^bsub>R1\<^esub> r2 y"
    by (rule g1.galois_prop_left_rel_right_iff_left_right_rel)
  also from agree \<open>in_dom (\<le>\<^bsub>L1\<^esub>) x\<close> \<open>in_codom (\<le>\<^bsub>R2\<^esub>) y\<close>
    have "... \<longleftrightarrow> l1 x \<le>\<^bsub>L2\<^esub> r2 y" by fastforce
  also from galois2 \<open>in_dom (\<le>\<^bsub>L2\<^esub>) (l1 x)\<close> \<open>in_codom (\<le>\<^bsub>R2\<^esub>) y\<close>
    have "... \<longleftrightarrow> l x \<le>\<^bsub>R2\<^esub> y"
    unfolding l_def
    by (simp add: g2.galois_prop_left_rel_right_iff_left_right_rel)
  finally show "x \<le>\<^bsub>L\<^esub> r y \<longleftrightarrow> l x \<le>\<^bsub>R\<^esub> y" .
qed

end

context transport_comp_same
begin

corollary galois_propI:
  assumes "((\<le>\<^bsub>L1\<^esub>) \<unlhd> (\<le>\<^bsub>R1\<^esub>)) l1 r1"
  and "((\<le>\<^bsub>R1\<^esub>) \<unlhd> (\<le>\<^bsub>R2\<^esub>)) l2 r2"
  and "([in_dom (\<le>\<^bsub>L1\<^esub>)] \<Rrightarrow>\<^sub>m in_dom (\<le>\<^bsub>R1\<^esub>)) l1"
  and "([in_codom (\<le>\<^bsub>R2\<^esub>)] \<Rrightarrow>\<^sub>m in_codom (\<le>\<^bsub>R1\<^esub>)) r2"
  shows "((\<le>\<^bsub>L\<^esub>) \<unlhd> (\<le>\<^bsub>R\<^esub>)) l r"
  using assms by (rule galois_propI) auto

end

end


section \<open>Intermediate Frameworks\<close>

text \<open>This theory provides partial applications of the H, SPY, and Pair-Frameworks.\<close>

theory Intermediate_Frameworks
imports Intermediate_Implementations Test_Suite_Representations "../OFSM_Tables_Refined" Simple_Convergence_Graph Empty_Convergence_Graph
begin

subsection \<open>Partial Applications of the SPY-Framework\<close>

definition spy_framework_static_with_simple_graph :: "('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow>
                              (nat \<Rightarrow> 'a \<Rightarrow> ('b\<times>'c) prefix_tree) \<Rightarrow>
                              nat \<Rightarrow>
                              ('b\<times>'c) prefix_tree"
  where
  "spy_framework_static_with_simple_graph M1
                         dist_fun
                         m
    = spy_framework M1
                  get_state_cover_assignment
                  (handle_state_cover_static dist_fun)
                  (\<lambda> M V ts . ts)
                  (establish_convergence_static dist_fun)
                  (handle_io_pair False True)
                  simple_cg_initial
                  simple_cg_insert
                  simple_cg_lookup_with_conv
                  simple_cg_merge
                  m"

lemma spy_framework_static_with_simple_graph_completeness_and_finiteness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('d,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
  and     "\<And> q1 q2 . q1 \<in> states M1 \<Longrightarrow> q2 \<in> states M1 \<Longrightarrow> q1 \<noteq> q2 \<Longrightarrow> \<exists> io . \<forall> k1 k2 . io \<in> set (dist_fun k1 q1) \<inter> set (dist_fun k2 q2) \<and> distinguishes M1 q1 q2 io"
  and     "\<And> q k . q \<in> states M1 \<Longrightarrow> finite_tree (dist_fun k q)"
shows "(L M1 = L M2) \<longleftrightarrow> ((L M1 \<inter> set (spy_framework_static_with_simple_graph M1 dist_fun m)) = (L M2 \<inter> set (spy_framework_static_with_simple_graph M1 dist_fun m)))"
and "finite_tree (spy_framework_static_with_simple_graph M1 dist_fun m)"
  using spy_framework_completeness_and_finiteness[OF assms(1-8),
                                                   of get_state_cover_assignment, OF get_state_cover_assignment_is_state_cover_assignment,
                                                   of "(\<lambda> M V ts . ts)",
                                                   OF _ simple_cg_initial_invar_with_conv[OF assms(1,2)],
                                                   OF _ simple_cg_insert_invar_with_conv[OF assms(1,2)],
                                                   OF _ simple_cg_merge_invar_with_conv[OF assms(1,2)],
                                                   of "handle_state_cover_static dist_fun"
                                                      "establish_convergence_static dist_fun"
                                                      "handle_io_pair False True"
                                                   ]
  using handle_state_cover_static_separates_state_cover[OF assms(9,10)]
  using establish_convergence_static_verifies_transition[of M1 dist_fun M2 "get_state_cover_assignment M1" simple_cg_initial simple_cg_insert simple_cg_lookup_with_conv, OF assms(9,10)]
  using handle_io_pair_verifies_io_pair[of False True M1 M2 simple_cg_insert simple_cg_lookup_with_conv]
  unfolding spy_framework_static_with_simple_graph_def
  by blast+

definition spy_framework_static_with_empty_graph :: "('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow>
                              (nat \<Rightarrow> 'a \<Rightarrow> ('b\<times>'c) prefix_tree) \<Rightarrow>
                              nat \<Rightarrow>
                              ('b\<times>'c) prefix_tree"
  where
  "spy_framework_static_with_empty_graph M1
                 dist_fun
                 m
    = spy_framework M1
                     get_state_cover_assignment
                     (handle_state_cover_static dist_fun)
                     (\<lambda> M V ts . ts)
                     (establish_convergence_static dist_fun)
                     (handle_io_pair False True)
                     empty_cg_initial
                     empty_cg_insert
                     empty_cg_lookup
                     empty_cg_merge
                     m"

lemma spy_framework_static_with_empty_graph_completeness_and_finiteness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('d,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
  and     "\<And> q1 q2 . q1 \<in> states M1 \<Longrightarrow> q2 \<in> states M1 \<Longrightarrow> q1 \<noteq> q2 \<Longrightarrow> \<exists> io . \<forall> k1 k2 . io \<in> set (dist_fun k1 q1) \<inter> set (dist_fun k2 q2) \<and> distinguishes M1 q1 q2 io"
  and     "\<And> q k . q \<in> states M1 \<Longrightarrow> finite_tree (dist_fun k q)"
shows "(L M1 = L M2) \<longleftrightarrow> ((L M1 \<inter> set (spy_framework_static_with_empty_graph M1 dist_fun m)) = (L M2 \<inter> set (spy_framework_static_with_empty_graph M1 dist_fun m)))"
and "finite_tree (spy_framework_static_with_empty_graph M1 dist_fun m)"
  using spy_framework_completeness_and_finiteness[OF assms(1-8),
                                                   of get_state_cover_assignment, OF get_state_cover_assignment_is_state_cover_assignment,
                                                   of "(\<lambda> M V ts . ts)",
                                                   OF _ empty_graph_initial_invar,
                                                   OF _ empty_graph_insert_invar,
                                                   OF _ empty_graph_merge_invar,
                                                   of "handle_state_cover_static dist_fun"
                                                      "establish_convergence_static dist_fun"
                                                      "handle_io_pair False True"
                                                   ]
  using handle_state_cover_static_separates_state_cover[OF assms(9,10)]
  using establish_convergence_static_verifies_transition[of M1 dist_fun M2 "get_state_cover_assignment M1" empty_cg_initial empty_cg_insert empty_cg_lookup, OF assms(9,10)]
  using handle_io_pair_verifies_io_pair[of False True M1 M2 empty_cg_insert empty_cg_lookup]
  unfolding spy_framework_static_with_empty_graph_def
  by blast+

subsection \<open>Partial Applications of the H-Framework\<close>

definition h_framework_static_with_simple_graph :: "('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow>
                                        (nat \<Rightarrow> 'a \<Rightarrow> ('b\<times>'c) prefix_tree) \<Rightarrow>
                                        nat \<Rightarrow>
                                        ('b\<times>'c) prefix_tree"
  where
  "h_framework_static_with_simple_graph M1 dist_fun m =
    h_framework M1
                   get_state_cover_assignment
                   (handle_state_cover_static dist_fun)
                   (\<lambda> M V ts . ts)
                   (handleUT_static dist_fun)
                   (handle_io_pair False False)
                   simple_cg_initial
                   simple_cg_insert
                   simple_cg_lookup_with_conv
                   simple_cg_merge
                   m"

lemma h_framework_static_with_simple_graph_completeness_and_finiteness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('e,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
  and     "\<And> q1 q2 . q1 \<in> states M1 \<Longrightarrow> q2 \<in> states M1 \<Longrightarrow> q1 \<noteq> q2 \<Longrightarrow> \<exists> io . \<forall> k1 k2 . io \<in> set (dist_fun k1 q1) \<inter> set (dist_fun k2 q2) \<and> distinguishes M1 q1 q2 io"
  and     "\<And> q k . q \<in> states M1 \<Longrightarrow> finite_tree (dist_fun k q)"
shows "(L M1 = L M2) \<longleftrightarrow> ((L M1 \<inter> set (h_framework_static_with_simple_graph  M1 dist_fun m)) = (L M2 \<inter> set (h_framework_static_with_simple_graph  M1 dist_fun m)))"
and "finite_tree (h_framework_static_with_simple_graph  M1 dist_fun m)"
  using h_framework_completeness_and_finiteness[OF assms(1-8),
                                             of get_state_cover_assignment
                                                "(\<lambda> M V ts . ts)" ,
                                             OF get_state_cover_assignment_is_state_cover_assignment
                                                _
                                                simple_cg_initial_invar_with_conv[OF assms(1,2)]
                                                simple_cg_insert_invar_with_conv[OF assms(1,2)]
                                                simple_cg_merge_invar_with_conv[OF assms(1,2)]
                                                handle_state_cover_static_separates_state_cover[OF assms(9,10)]
                                                handleUT_static_handles_transition[OF assms(9,10)]
                                                verifies_io_pair_handled[OF handle_io_pair_verifies_io_pair[of False False M1 M2 simple_cg_insert simple_cg_lookup_with_conv]]
                                             ]
  unfolding h_framework_static_with_simple_graph_def[symmetric]
  by presburger+

definition h_framework_static_with_simple_graph_lists :: "('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> ('b\<times>'c) prefix_tree) \<Rightarrow> nat \<Rightarrow> (('b\<times>'c) \<times> bool) list list" where
  "h_framework_static_with_simple_graph_lists M dist_fun m = sorted_list_of_maximal_sequences_in_tree (test_suite_from_io_tree M (initial M) (h_framework_static_with_simple_graph M dist_fun m))"

lemma h_framework_static_with_simple_graph_lists_completeness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('d,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
  and     "\<And> q1 q2 . q1 \<in> states M1 \<Longrightarrow> q2 \<in> states M1 \<Longrightarrow> q1 \<noteq> q2 \<Longrightarrow> \<exists> io . \<forall> k1 k2 . io \<in> set (dist_fun k1 q1) \<inter> set (dist_fun k2 q2) \<and> distinguishes M1 q1 q2 io"
  and     "\<And> q k . q \<in> states M1 \<Longrightarrow> finite_tree (dist_fun k q)"
shows "(L M1 = L M2) \<longleftrightarrow> list_all (passes_test_case M2 (initial M2)) (h_framework_static_with_simple_graph_lists M1 dist_fun m)"
  unfolding h_framework_static_with_simple_graph_lists_def
  using h_framework_static_with_simple_graph_completeness_and_finiteness(1)[OF assms(1,2,3,4,5,6,7,8,9,10)]
  using passes_test_cases_from_io_tree[OF assms(1,2) fsm_initial fsm_initial h_framework_static_with_simple_graph_completeness_and_finiteness(2)[OF assms]]
  by blast

definition h_framework_static_with_empty_graph :: "('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow>
                                        (nat \<Rightarrow> 'a \<Rightarrow> ('b\<times>'c) prefix_tree) \<Rightarrow>
                                        nat \<Rightarrow>
                                        ('b\<times>'c) prefix_tree"
  where
  "h_framework_static_with_empty_graph M1 dist_fun m =
    h_framework M1
                   get_state_cover_assignment
                   (handle_state_cover_static dist_fun)
                   (\<lambda> M V ts . ts)
                   (handleUT_static dist_fun)
                   (handle_io_pair False False)
                   empty_cg_initial
                   empty_cg_insert
                   empty_cg_lookup
                   empty_cg_merge
                   m"

lemma h_framework_static_with_empty_graph_completeness_and_finiteness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('e,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
  and     "\<And> q1 q2 . q1 \<in> states M1 \<Longrightarrow> q2 \<in> states M1 \<Longrightarrow> q1 \<noteq> q2 \<Longrightarrow> \<exists> io . \<forall> k1 k2 . io \<in> set (dist_fun k1 q1) \<inter> set (dist_fun k2 q2) \<and> distinguishes M1 q1 q2 io"
  and     "\<And> q k . q \<in> states M1 \<Longrightarrow> finite_tree (dist_fun k q)"
shows "(L M1 = L M2) \<longleftrightarrow> ((L M1 \<inter> set (h_framework_static_with_empty_graph  M1 dist_fun m)) = (L M2 \<inter> set (h_framework_static_with_empty_graph  M1 dist_fun m)))"
and "finite_tree (h_framework_static_with_empty_graph  M1 dist_fun m)"
  using h_framework_completeness_and_finiteness[OF assms(1-8),
                                             of get_state_cover_assignment
                                                "(\<lambda> M V ts . ts)" ,
                                             OF get_state_cover_assignment_is_state_cover_assignment
                                                _
                                                empty_graph_initial_invar
                                                empty_graph_insert_invar
                                                empty_graph_merge_invar
                                                handle_state_cover_static_separates_state_cover[OF assms(9,10)]
                                                handleUT_static_handles_transition[OF assms(9,10)]
                                                verifies_io_pair_handled[OF handle_io_pair_verifies_io_pair[of False False M1 M2 empty_cg_insert empty_cg_lookup]]
                                             ]
  unfolding h_framework_static_with_empty_graph_def[symmetric]
  by presburger+

definition h_framework_static_with_empty_graph_lists :: "('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow> (nat \<Rightarrow> 'a \<Rightarrow> ('b\<times>'c) prefix_tree) \<Rightarrow> nat \<Rightarrow> (('b\<times>'c) \<times> bool) list list" where
  "h_framework_static_with_empty_graph_lists M dist_fun m = sorted_list_of_maximal_sequences_in_tree (test_suite_from_io_tree M (initial M) (h_framework_static_with_empty_graph M dist_fun m))"

lemma h_framework_static_with_empty_graph_lists_completeness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('d,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
  and     "\<And> q1 q2 . q1 \<in> states M1 \<Longrightarrow> q2 \<in> states M1 \<Longrightarrow> q1 \<noteq> q2 \<Longrightarrow> \<exists> io . \<forall> k1 k2 . io \<in> set (dist_fun k1 q1) \<inter> set (dist_fun k2 q2) \<and> distinguishes M1 q1 q2 io"
  and     "\<And> q k . q \<in> states M1 \<Longrightarrow> finite_tree (dist_fun k q)"
shows "(L M1 = L M2) \<longleftrightarrow> list_all (passes_test_case M2 (initial M2)) (h_framework_static_with_empty_graph_lists M1 dist_fun m)"
  unfolding h_framework_static_with_empty_graph_lists_def
  using h_framework_static_with_empty_graph_completeness_and_finiteness(1)[OF assms(1,2,3,4,5,6,7,8,9,10)]
  using passes_test_cases_from_io_tree[OF assms(1,2) fsm_initial fsm_initial h_framework_static_with_empty_graph_completeness_and_finiteness(2)[OF assms]]
  by blast

definition h_framework_dynamic :: "
              (('a,'b,'c) fsm \<Rightarrow> ('a,'b,'c) state_cover_assignment \<Rightarrow> ('a,'b,'c) transition \<Rightarrow> ('a,'b,'c) transition list \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow>
              ('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow>
              nat \<Rightarrow>
              bool \<Rightarrow>
              bool \<Rightarrow>
              ('b\<times>'c) prefix_tree"
  where
  "h_framework_dynamic convergence_decisision M1 m completeInputTraces useInputHeuristic =
    h_framework M1
                   get_state_cover_assignment
                   (handle_state_cover_dynamic completeInputTraces useInputHeuristic (get_distinguishing_sequence_from_ofsm_tables M1))
                   sort_unverified_transitions_by_state_cover_length
                   (handleUT_dynamic completeInputTraces useInputHeuristic (get_distinguishing_sequence_from_ofsm_tables M1) convergence_decisision)
                   (handle_io_pair completeInputTraces useInputHeuristic)
                   simple_cg_initial
                   simple_cg_insert
                   simple_cg_lookup_with_conv
                   simple_cg_merge
                   m"

lemma h_framework_dynamic_completeness_and_finiteness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('e,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
shows "(L M1 = L M2) \<longleftrightarrow> ((L M1 \<inter> set (h_framework_dynamic convergenceDecision M1 m completeInputTraces useInputHeuristic)) = (L M2 \<inter> set (h_framework_dynamic convergenceDecision M1 m completeInputTraces useInputHeuristic)))"
and "finite_tree (h_framework_dynamic convergenceDecision M1 m completeInputTraces useInputHeuristic)"
  using h_framework_completeness_and_finiteness[OF assms,
                                             of get_state_cover_assignment
                                                sort_unverified_transitions_by_state_cover_length ,
                                             OF get_state_cover_assignment_is_state_cover_assignment
                                                sort_unverified_transitions_by_state_cover_length_retains_set[of _ M1 get_state_cover_assignment]
                                                simple_cg_initial_invar_with_conv[OF assms(1,2)]
                                                simple_cg_insert_invar_with_conv[OF assms(1,2)]
                                                simple_cg_merge_invar_with_conv[OF assms(1,2)]
                                                handle_state_cover_dynamic_separates_state_cover[OF get_distinguishing_sequence_from_ofsm_tables_distinguishes[OF assms(1,3)], of completeInputTraces useInputHeuristic M2 simple_cg_initial simple_cg_insert simple_cg_lookup_with_conv]
                                                handleUT_dynamic_handles_transition[of M1 "(get_distinguishing_sequence_from_ofsm_tables M1)" completeInputTraces useInputHeuristic convergenceDecision M2 _ _ simple_cg_insert simple_cg_lookup_with_conv simple_cg_merge, OF get_distinguishing_sequence_from_ofsm_tables_distinguishes[OF assms(1,3)]]
                                                verifies_io_pair_handled[OF handle_io_pair_verifies_io_pair[of completeInputTraces useInputHeuristic M1 M2 simple_cg_insert simple_cg_lookup_with_conv]]
                                             ]
  unfolding h_framework_dynamic_def[symmetric]
  by presburger+

definition h_framework_dynamic_lists :: "(('a,'b,'c) fsm \<Rightarrow> ('a,'b,'c) state_cover_assignment \<Rightarrow> ('a,'b,'c) transition \<Rightarrow> ('a,'b,'c) transition list \<Rightarrow> nat \<Rightarrow> bool) \<Rightarrow> ('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> (('b\<times>'c) \<times> bool) list list" where
  "h_framework_dynamic_lists convergenceDecision M m completeInputTraces useInputHeuristic = sorted_list_of_maximal_sequences_in_tree (test_suite_from_io_tree M (initial M) (h_framework_dynamic convergenceDecision M m completeInputTraces useInputHeuristic))"

lemma h_framework_dynamic_lists_completeness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('d,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "minimal M2"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
shows "(L M1 = L M2) \<longleftrightarrow> list_all (passes_test_case M2 (initial M2)) (h_framework_dynamic_lists convergenceDecision M1 m completeInputTraces useInputHeuristic)"
  unfolding h_framework_dynamic_lists_def
            h_framework_dynamic_completeness_and_finiteness(1)[OF assms, of convergenceDecision completeInputTraces useInputHeuristic]
            passes_test_cases_from_io_tree[OF assms(1,2) fsm_initial fsm_initial h_framework_dynamic_completeness_and_finiteness(2)[OF assms]]
  by blast

subsection \<open>Partial Applications of the Pair-Framework\<close>

definition pair_framework_h_components :: "('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow> nat \<Rightarrow>
                                           (('a,'b,'c) fsm \<Rightarrow> (('b \<times> 'c) list \<times> 'a) \<times> ('b \<times> 'c) list \<times> 'a \<Rightarrow> ('b \<times> 'c) prefix_tree \<Rightarrow> ('b \<times> 'c) prefix_tree) \<Rightarrow>
                                           ('b\<times>'c) prefix_tree"
where
  "pair_framework_h_components M m get_separating_traces = (let
    V = get_state_cover_assignment M
  in pair_framework M m (get_initial_test_suite_H V) (get_pairs_H V) get_separating_traces)"

lemma pair_framework_h_components_completeness_and_finiteness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('e,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
  and     "\<And> \<alpha> \<beta> t . \<alpha> \<in> L M1 \<Longrightarrow> \<beta> \<in> L M1 \<Longrightarrow> after_initial M1 \<alpha> \<noteq> after_initial M1 \<beta> \<Longrightarrow> \<exists> io \<in> set (get_separating_traces M1 ((\<alpha>,after_initial M1 \<alpha>),(\<beta>,after_initial M1 \<beta>)) t) \<union> (set (after t \<alpha>) \<inter> set (after t \<beta>)) . distinguishes M1 (after_initial M1 \<alpha>) (after_initial M1 \<beta>) io"
  and     "\<And> \<alpha> \<beta> t . \<alpha> \<in> L M1 \<Longrightarrow> \<beta> \<in> L M1 \<Longrightarrow> after_initial M1 \<alpha> \<noteq> after_initial M1 \<beta> \<Longrightarrow> finite_tree (get_separating_traces M1 ((\<alpha>,after_initial M1 \<alpha>),(\<beta>,after_initial M1 \<beta>)) t)"
shows "(L M1 = L M2) \<longleftrightarrow> ((L M1 \<inter> set (pair_framework_h_components M1 m get_separating_traces)) = (L M2 \<inter> set (pair_framework_h_components M1 m get_separating_traces)))"
and "finite_tree (pair_framework_h_components M1 m get_separating_traces)"
proof -
  show "(L M1 = L M2) \<longleftrightarrow> ((L M1 \<inter> set (pair_framework_h_components M1 m get_separating_traces)) = (L M2 \<inter> set (pair_framework_h_components M1 m get_separating_traces)))"
    using pair_framework_completeness[ OF assms(1,2,3,5,4,6,7) get_state_cover_assignment_is_state_cover_assignment
                                     , of "get_initial_test_suite_H (get_state_cover_assignment M1)" "get_pairs_H (get_state_cover_assignment M1)" get_separating_traces
                                     , OF get_initial_test_suite_H_set_and_finite(1)[of "get_state_cover_assignment M1" M1 m]
                                     , OF get_pairs_H_set(1)[OF assms(1) get_state_cover_assignment_is_state_cover_assignment, where m=m] assms(8)
                                     ]
    unfolding pair_framework_h_components_def Let_def
    using get_pairs_H_set(1)[OF assms(1) get_state_cover_assignment_is_state_cover_assignment, where m=m]
    using assms(8)
    unfolding pair_framework_h_components_def Let_def
    by presburger

  show "finite_tree (pair_framework_h_components M1 m get_separating_traces)"
    using pair_framework_finiteness[of M1 get_separating_traces "get_initial_test_suite_H (get_state_cover_assignment M1)" m "get_pairs_H (get_state_cover_assignment M1)",
                                    OF assms(9) get_initial_test_suite_H_set_and_finite(2)[of "get_state_cover_assignment M1" M1 m] get_pairs_H_set(2)[OF assms(1) get_state_cover_assignment_is_state_cover_assignment] ]
    unfolding pair_framework_h_components_def Let_def
    by auto
qed

definition pair_framework_h_components_2 :: "('a::linorder,'b::linorder,'c::linorder) fsm \<Rightarrow> nat \<Rightarrow>
                                           (('a,'b,'c) fsm \<Rightarrow> (('b \<times> 'c) list \<times> 'a) \<times> ('b \<times> 'c) list \<times> 'a \<Rightarrow> ('b \<times> 'c) prefix_tree \<Rightarrow> ('b \<times> 'c) prefix_tree) \<Rightarrow>
                                            bool \<Rightarrow>
                                           ('b\<times>'c) prefix_tree"
where
  "pair_framework_h_components_2 M m get_separating_traces c = (let
    V = get_state_cover_assignment M
  in pair_framework M m (get_initial_test_suite_H_2 c V) (get_pairs_H V) get_separating_traces)"

lemma pair_framework_h_components_2_completeness_and_finiteness :
  fixes M1 :: "('a::linorder,'b::linorder,'c::linorder) fsm"
  fixes M2 :: "('e,'b,'c) fsm"
  assumes "observable M1"
  and     "observable M2"
  and     "minimal M1"
  and     "size_r M1 \<le> m"
  and     "size M2 \<le> m"
  and     "inputs M2 = inputs M1"
  and     "outputs M2 = outputs M1"
  and     "\<And> \<alpha> \<beta> t . \<alpha> \<in> L M1 \<Longrightarrow> \<beta> \<in> L M1 \<Longrightarrow> after_initial M1 \<alpha> \<noteq> after_initial M1 \<beta> \<Longrightarrow> \<exists> io \<in> set (get_separating_traces M1 ((\<alpha>,after_initial M1 \<alpha>),(\<beta>,after_initial M1 \<beta>)) t) \<union> (set (after t \<alpha>) \<inter> set (after t \<beta>)) . distinguishes M1 (after_initial M1 \<alpha>) (after_initial M1 \<beta>) io"
  and     "\<And> \<alpha> \<beta> t . \<alpha> \<in> L M1 \<Longrightarrow> \<beta> \<in> L M1 \<Longrightarrow> after_initial M1 \<alpha> \<noteq> after_initial M1 \<beta> \<Longrightarrow> finite_tree (get_separating_traces M1 ((\<alpha>,after_initial M1 \<alpha>),(\<beta>,after_initial M1 \<beta>)) t)"
shows "(L M1 = L M2) \<longleftrightarrow> ((L M1 \<inter> set (pair_framework_h_components_2 M1 m get_separating_traces c)) = (L M2 \<inter> set (pair_framework_h_components_2 M1 m get_separating_traces c)))"
and "finite_tree (pair_framework_h_components_2 M1 m get_separating_traces c)"
proof -
  show "(L M1 = L M2) \<longleftrightarrow> ((L M1 \<inter> set (pair_framework_h_components_2 M1 m get_separating_traces c)) = (L M2 \<inter> set (pair_framework_h_components_2 M1 m get_separating_traces c)))"
    using pair_framework_completeness[ OF assms(1,2,3,5,4,6,7) get_state_cover_assignment_is_state_cover_assignment
                                     , of "get_initial_test_suite_H_2 c (get_state_cover_assignment M1)" "get_pairs_H (get_state_cover_assignment M1)" get_separating_traces
                                     , OF get_initial_test_suite_H_2_set_and_finite(1)[of "get_state_cover_assignment M1" M1 m]
                                     , OF get_pairs_H_set(1)[OF assms(1) get_state_cover_assignment_is_state_cover_assignment, where m=m] assms(8)
                                     ]
    unfolding pair_framework_h_components_2_def Let_def
    using get_pairs_H_set(1)[OF assms(1) get_state_cover_assignment_is_state_cover_assignment, where m=m]
    using assms(8)
    unfolding pair_framework_h_components_def Let_def
    by presburger

  show "finite_tree (pair_framework_h_components_2 M1 m get_separating_traces c)"
    using pair_framework_finiteness[of M1 get_separating_traces "get_initial_test_suite_H_2 c (get_state_cover_assignment M1)" m "get_pairs_H (get_state_cover_assignment M1)",
                                    OF assms(9) get_initial_test_suite_H_2_set_and_finite(2)[of c "get_state_cover_assignment M1" M1 m] get_pairs_H_set(2)[OF assms(1) get_state_cover_assignment_is_state_cover_assignment] ]
    unfolding pair_framework_h_components_2_def Let_def
    by auto
qed

subsection \<open>Code Generation\<close>

(* one-time pre-computation of OFSM tables *)
lemma h_framework_dynamic_code[code] :
  "h_framework_dynamic convergence_decisision M1 m completeInputTraces useInputHeuristic = (let
      tables = (compute_ofsm_tables M1 (size M1 - 1));
      distMap = mapping_of (map (\<lambda> (q1,q2) . ((q1,q2), get_distinguishing_sequence_from_ofsm_tables_with_provided_tables tables M1 q1 q2))
                        (filter (\<lambda> qq . fst qq \<noteq> snd qq) (List.product (states_as_list M1) (states_as_list M1))));
      distHelper = (\<lambda> q1 q2 . if q1 \<in> states M1 \<and> q2 \<in> states M1 \<and> q1 \<noteq> q2 then the (Mapping.lookup distMap (q1,q2)) else get_distinguishing_sequence_from_ofsm_tables M1 q1 q2)
    in
      h_framework  M1
                   get_state_cover_assignment
                   (handle_state_cover_dynamic completeInputTraces useInputHeuristic distHelper)
                   sort_unverified_transitions_by_state_cover_length
                   (handleUT_dynamic completeInputTraces useInputHeuristic distHelper convergence_decisision)
                   (handle_io_pair completeInputTraces useInputHeuristic)
                   simple_cg_initial
                   simple_cg_insert
                   simple_cg_lookup_with_conv
                   simple_cg_merge
                   m)"
  unfolding h_framework_dynamic_def
  apply (subst (1 2) get_distinguishing_sequence_from_ofsm_tables_precomputed[of M1])
  unfolding Let_def
  by presburger

end


(* Title: IND_CPA_PK.thy
  Author: Andreas Lochbihler, ETH Zurich *)

theory IND_CPA_PK imports
  CryptHOL.Computational_Model
  CryptHOL.Negligible
begin

subsection \<open>The IND-CPA game for public-key encryption with oracle access\<close>

locale ind_cpa_pk =
  fixes key_gen :: "('pubkey \<times> 'privkey, 'call, 'ret) gpv" \<comment> \<open>probabilistic\<close>
  and aencrypt :: "'pubkey \<Rightarrow> 'plain \<Rightarrow> ('cipher, 'call, 'ret) gpv"  \<comment> \<open>probabilistic w/ access to an oracle\<close>
  and adecrypt :: "'privkey \<Rightarrow> 'cipher \<Rightarrow> ('plain, 'call, 'ret) gpv" \<comment> \<open>not used\<close>
  and valid_plains :: "'plain \<Rightarrow> 'plain \<Rightarrow> bool" \<comment> \<open>checks whether a pair of plaintexts is valid, i.e., they have the right format\<close>
begin

text \<open>
  We cannot incorporate the predicate @{term valid_plain} in the type @{typ "'plain"} of plaintexts,
  because the single @{typ "'plain"} must contain plaintexts for all values of the security parameter,
  as HOL does not have dependent types.  Consequently, the game has to ensure that the received
  plaintexts are valid.
\<close>

type_synonym ('pubkey', 'plain', 'cipher', 'call', 'ret', 'state) adversary =
  "('pubkey' \<Rightarrow> (('plain' \<times> 'plain') \<times> 'state, 'call', 'ret') gpv)
   \<times> ('cipher' \<Rightarrow> 'state \<Rightarrow> (bool, 'call', 'ret') gpv)"

fun ind_cpa :: "('pubkey, 'plain, 'cipher, 'call, 'ret, 'state) adversary \<Rightarrow> (bool, 'call, 'ret) gpv"
where
  "ind_cpa (\1, \2) = TRY do {
     (pk, sk) \<leftarrow> key_gen;
     b \<leftarrow> lift_spmf coin_spmf;
     ((m0, m1), \<sigma>) \<leftarrow> (\1 pk);
     assert_gpv (valid_plains m0 m1);
     cipher \<leftarrow> aencrypt pk (if b then m0 else m1);
     guess \<leftarrow> \2 cipher \<sigma>;
     Done (guess = b)
   } ELSE lift_spmf coin_spmf"

definition advantage :: "('\<sigma> \<Rightarrow> 'call \<Rightarrow> ('ret \<times> '\<sigma>) spmf) \<Rightarrow> '\<sigma> \<Rightarrow> ('pubkey, 'plain, 'cipher, 'call, 'ret, 'state) adversary \<Rightarrow> real"
where "advantage oracle \<sigma> \ = \<bar>spmf (run_gpv oracle (ind_cpa \) \<sigma>) True - 1/2\<bar>"

lemma advantage_nonneg: "advantage oracle \<sigma> \ \<ge> 0" by(simp add: advantage_def)

definition ibounded_by :: "('call \<Rightarrow> bool) \<Rightarrow> ('pubkey, 'plain, 'cipher, 'call, 'ret, 'state) adversary \<Rightarrow> enat \<Rightarrow> bool"
where
  "ibounded_by consider = (\<lambda>(\1, \2) q.
  (\<exists>q1 q2. (\<forall>pk. interaction_bounded_by consider (\1 pk) q1) \<and> (\<forall>cipher \<sigma>. interaction_bounded_by consider (\2 cipher \<sigma>) q2) \<and> q1 + q2 \<le> q))"

lemma ibounded_by'E [consumes 1, case_names ibounded_by', elim?]:
  assumes "ibounded_by consider (\1, \2) q"
  obtains q1 q2
  where "q1 + q2 \<le> q"
  and "\<And>pk. interaction_bounded_by consider (\1 pk) q1"
  and "\<And>cipher \<sigma>. interaction_bounded_by consider (\2 cipher \<sigma>) q2"
using assms by(auto simp add: ibounded_by_def)

lemma ibounded_byI [intro?]:
  "\<lbrakk> \<And>pk. interaction_bounded_by consider (\1 pk) q1; \<And>cipher \<sigma>. interaction_bounded_by consider (\2 cipher \<sigma>) q2; q1 + q2 \<le> q \<rbrakk>
  \<Longrightarrow> ibounded_by consider (\1, \2) q"
by(auto simp add: ibounded_by_def)

definition lossless :: "('pubkey, 'plain, 'cipher, 'call, 'ret, 'state) adversary \<Rightarrow> bool"
where "lossless = (\<lambda>(\1, \2). (\<forall>pk. lossless_gpv \_full (\1 pk)) \<and> (\<forall>cipher \<sigma>. lossless_gpv \_full (\2 cipher \<sigma>)))"

end

end


theory weird_nat_add3_assoc3
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype Nat = Z | S "Nat"

fun add3 :: "Nat => Nat => Nat => Nat" where
"add3 (Z) (Z) z = z"
| "add3 (Z) (S y2) z = S (add3 Z y2 z)"
| "add3 (S x2) y z = S (add3 x2 y z)"

(*hipster add3 *)

theorem x0 :
  "!! (x1 :: Nat) (x2 :: Nat) (x3 :: Nat) (x4 :: Nat) (x5 :: Nat) .
     (add3 x1 (add3 x2 x3 x4) x5) = (add3 x1 x2 (add3 x3 x4 x5))"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


theory ModifyStringToCharTuples
  imports Main
begin

definition isAlpha :: "char \<Rightarrow> bool" where
"isAlpha chr = (let val = nat_of_char chr  in  (65  \<le>  val \<and> val \<le> 90 ) \<or> (97 \<le> val \<and> val \<le> 122))"

declare isAlpha_def [simp]

lemma isAlphaTest1 : "isAlpha CHR ''a''" by simp

lemma isAlphaTest2 : "isAlpha CHR ''A''" by simp

lemma isAlphaTest3 : "isAlpha CHR ''z''" by simp

lemma isAlphaTest4 : "isAlpha CHR ''Z''" by simp

(*simple snaity proof*)
theorem "(\<exists>x . isAlpha x = False) \<and> (\<exists>x. isAlpha x = True)"
proof -
  have "isAlpha CHR ''}''= False" by simp
  hence tmp:"\<exists>x . isAlpha x = False" by (rule exI)

  have "isAlpha CHR ''a''= True" by simp
  hence "\<exists>x . isAlpha x = True" by (rule exI)

  with  tmp show ?thesis by (rule conjI)
qed

definition "allLetterNats = set ([ nat_of_char CHR ''a'' ..< nat_of_char CHR ''z'' + 1] @ [nat_of_char CHR ''A'' ..< nat_of_char CHR ''Z'' + 1])"

definition "allNotLetterNats = set (map (nat_of_char) (Enum.enum :: char list)) - allLetterNats"

declare allLetterNats_def [simp]

declare allNotLetterNats_def [simp]

lemma helper1:"x \<in> set [n ..< m] \<Longrightarrow> n \<le>  x  \<and>  x < m " by simp

lemma helper2:"x \<in> set ([n ..<m] @ [a ..<b]) \<Longrightarrow> (n \<le> x \<and> x < m) \<or> (a \<le> x \<and> x < b)" by simp

theorem "nat_of_char x \<in> allLetterNats \<Longrightarrow> isAlpha x" by auto

lemma "nat_of_char (x :: char) < 256" by simp

lemma helper3:"x \<in> allNotLetterNats \<Longrightarrow> x < 65 \<or> (90 < x \<and> x < 97) \<or> 122 < x"  (*takes some time to compute*) by (auto ; arith)

lemma helper3'':"x \<in> allNotLetterNats \<Longrightarrow> x < 256" by auto

lemma helper3':" noc \<in>  allNotLetterNats \<Longrightarrow> (noc < 65 \<or> (90 < noc \<and> noc < 97) \<or> 122 < noc) \<and> noc < 256" using helper3 helper3'' by simp

lemma helper4:"noc = nat_of_char x \<Longrightarrow> \<not>isAlpha x = (noc < 65 \<or> (90 < noc \<and> noc < 97) \<or> 122 < noc) " by (auto simp add : Let_def )

theorem "nat_of_char x \<in> allNotLetterNats \<Longrightarrow> isAlpha x = False"
proof -
  let ?noc="nat_of_char x"
  assume hyp:"nat_of_char x \<in> allNotLetterNats"
  hence "(?noc < 65 \<or> (90 < ?noc \<and> ?noc < 97) \<or> 122 < ?noc) " by (rule helper3)
  thus ?thesis using helper4 by simp
qed

primrec transform :: "string \<Rightarrow> string" where
"transform [] = []"|
"transform (x#xs) = ''bla''"