subsection "Splay Tree Analysis"

theory Splay_Tree_Analysis
imports
  Splay_Tree_Analysis_Base
  Amortized_Framework
begin

subsubsection "Analysis of splay"

definition A_splay :: "'a::linorder \<Rightarrow> 'a tree \<Rightarrow> real" where
"A_splay a t = T_splay a t + \<Phi>(splay a t) - \<Phi> t"

text\<open>The following lemma is an attempt to prove a generic lemma that covers
both zig-zig cases. However, the lemma is not as nice as one would like.
Hence it is used only once, as a demo. Ideally the lemma would involve
function @{const A_splay}, but that is impossible because this involves @{const splay}
and thus depends on the ordering. We would need a truly symmetric version of @{const splay}
that takes the ordering as an explicit argument. Then we could define
all the symmetric cases by one final equation
@{term"splay2 less t = splay2 (not o less) (mirror t)"}.
This would simplify the code and the proofs.\<close>

lemma zig_zig: fixes lx x rx lb b rb a ra u lb1 lb2
defines [simp]: "X == Node lx (x) rx" defines[simp]: "B == Node lb b rb"
defines [simp]: "t == Node B a ra" defines [simp]: "A' == Node rb a ra"
defines [simp]: "t' == Node lb1 u (Node lb2 b A')"
assumes hyps: "lb \<noteq> \<langle>\<rangle>" and IH: "T_splay x lb + \<Phi> lb1 + \<Phi> lb2 - \<Phi> lb \<le> 2 * \<phi> lb - 3 * \<phi> X + 1" and
 prems: "size lb = size lb1 + size lb2 + 1" "X \<in> subtrees lb"
shows "T_splay x lb + \<Phi> t' - \<Phi> t \<le> 3 * (\<phi> t - \<phi> X)"
proof -
  define B' where [simp]: "B' = Node lb2 b A'"
  have "T_splay x lb + \<Phi> t' - \<Phi> t = T_splay x lb + \<Phi> lb1 + \<Phi> lb2 - \<Phi> lb + \<phi> B' + \<phi> A' - \<phi> B"
    using prems
    by(auto simp: A_splay_def size_if_splay algebra_simps in_set_tree_if split: tree.split)
  also have "\<dots> \<le> 2 * \<phi> lb + \<phi> B' + \<phi> A' - \<phi> B - 3 * \<phi> X + 1"
    using IH prems(2) by(auto simp: algebra_simps)
  also have "\<dots> \<le> \<phi> lb + \<phi> B' + \<phi> A' - 3 * \<phi> X + 1" by(simp)
  also have "\<dots> \<le> \<phi> B' + 2 * \<phi> t - 3 * \<phi> X "
    using prems ld_ld_1_less[of "size1 lb" "size1 A'"]
    by(simp add: size_if_splay)
  also have "\<dots> \<le> 3 * \<phi> t - 3 * \<phi> X"
    using prems by(simp add: size_if_splay)
  finally show ?thesis by simp
qed

lemma A_splay_ub: "\<lbrakk> bst t; Node l x r : subtrees t \<rbrakk>
  \<Longrightarrow> A_splay x t \<le> 3 * (\<phi> t - \<phi>(Node l x r)) + 1"
proof(induction x t rule: splay.induct)
  case 1 thus ?case by simp
next
  case 2 thus ?case by (auto simp: A_splay_def)
next
  case 4 hence False by(fastforce dest: in_set_tree_if) thus ?case ..
next
  case 5 hence False by(fastforce dest: in_set_tree_if) thus ?case ..
next
  case 7 hence False by(fastforce dest: in_set_tree_if) thus ?case ..
next
  case 10 hence False by(fastforce dest: in_set_tree_if) thus ?case ..
next
  case 12 hence False by(fastforce dest: in_set_tree_if) thus ?case ..
next
  case 13 hence False by(fastforce dest: in_set_tree_if) thus ?case ..
next
  case (3 x b A B CD)
  (* A readable proof *)
  let ?t = "\<langle>\<langle>A, x, B\<rangle>, b, CD\<rangle>"
  let ?t' = "\<langle>A, x, \<langle>B, b, CD\<rangle>\<rangle>"
  have *: "l = A \<and> r = B" using "3.prems" by(fastforce dest: in_set_tree_if)
  have "A_splay x ?t = 1 + \<Phi> ?t' - \<Phi> ?t" using "3.hyps" by (simp add: A_splay_def)
  also have "\<dots> = 1 + \<phi> ?t' + \<phi> \<langle>B, b, CD\<rangle>  - \<phi> ?t - \<phi> \<langle>A, x, B\<rangle>" by(simp)
  also have "\<dots> = 1 + \<phi> \<langle>B, b, CD\<rangle> - \<phi> \<langle>A, x, B\<rangle>" by(simp)
  also have "\<dots> \<le>  1 + \<phi> ?t - \<phi>(Node A x B)"
    using log_le_cancel_iff[of 2 "size1(Node B b CD)" "size1 ?t"] by (simp)
  also have "\<dots> \<le> 1 + 3 * (\<phi> ?t - \<phi>(Node A x B))"
    using log_le_cancel_iff[of 2 "size1(Node A x B)" "size1 ?t"] by (simp)
  finally show ?case using * by simp
next
  case (9 b x AB C D)
  (* An automatic proof *)
  let ?A = "\<langle>AB, b, \<langle>C, x, D\<rangle>\<rangle>"
  have "x \<notin> set_tree AB" using "9.prems"(1) by auto
  with 9 show ?case using
    log_le_cancel_iff[of 2 "size1(Node AB b C)" "size1 ?A"]
    log_le_cancel_iff[of 2 "size1(Node C x D)" "size1 ?A"]
    by (auto simp: A_splay_def algebra_simps simp del:log_le_cancel_iff)
next
  case (6 x a b A B C)
  hence *: "\<langle>l, x, r\<rangle> \<in> subtrees A" by(fastforce dest: in_set_tree_if)
  obtain A1 a' A2 where sp: "splay x A = Node A1 a' A2"
    using splay_not_Leaf[OF \<open>A \<noteq> Leaf\<close>] by blast
  let ?X = "Node l x r" let ?AB = "Node A a B"  let ?ABC = "Node ?AB b C"
  let ?A' = "Node A1 a' A2"
  let ?BC = "Node B b C"  let ?A2BC = "Node A2 a ?BC" let ?A1A2BC = "Node A1 a' ?A2BC"
  have 0: "\<phi> ?A1A2BC = \<phi> ?ABC" using sp by(simp add: size_if_splay)
  have 1: "\<Phi> ?A1A2BC - \<Phi> ?ABC = \<Phi> A1 + \<Phi> A2 + \<phi> ?A2BC + \<phi> ?BC - \<Phi> A - \<phi> ?AB"
    using 0 by (simp)
  have "A_splay x ?ABC = T_splay x A + 1 + \<Phi> ?A1A2BC - \<Phi> ?ABC"
    using "6.hyps" sp by(simp add: A_splay_def)
  also have "\<dots> = T_splay x A + 1 + \<Phi> A1 + \<Phi> A2 + \<phi> ?A2BC + \<phi> ?BC - \<Phi> A - \<phi> ?AB"
    using 1 by simp
  also have "\<dots> = T_splay x A + \<Phi> ?A' - \<phi> ?A' - \<Phi> A + \<phi> ?A2BC + \<phi> ?BC - \<phi> ?AB + 1"
    by(simp)
  also have "\<dots> = A_splay x A + \<phi> ?A2BC + \<phi> ?BC - \<phi> ?AB - \<phi> ?A' + 1"
    using sp by(simp add: A_splay_def)
  also have "\<dots> \<le> 3 * \<phi> A + \<phi> ?A2BC + \<phi> ?BC - \<phi> ?AB - \<phi> ?A' - 3 * \<phi> ?X + 2"
    using "6.IH" "6.prems"(1) * by(simp)
  also have "\<dots> = 2 * \<phi> A + \<phi> ?A2BC + \<phi> ?BC - \<phi> ?AB - 3 * \<phi> ?X + 2"
    using sp by(simp add: size_if_splay)
  also have "\<dots> < \<phi> A + \<phi> ?A2BC + \<phi> ?BC - 3 * \<phi> ?X + 2" by(simp)
  also have "\<dots> < \<phi> ?A2BC + 2 * \<phi> ?ABC - 3 * \<phi> ?X + 1"
    using sp ld_ld_1_less[of "size1 A" "size1 ?BC"]
    by(simp add: size_if_splay)
  also have "\<dots> < 3 * \<phi> ?ABC - 3 * \<phi> ?X + 1"
    using sp by(simp add: size_if_splay)
  finally show ?case by simp
next
  case (8 a x b B A C)
  hence *: "\<langle>l, x, r\<rangle> \<in> subtrees B" by(fastforce dest: in_set_tree_if)
  obtain B1 b' B2 where sp: "splay x B = Node B1 b' B2"
     using splay_not_Leaf[OF \<open>B \<noteq> Leaf\<close>] by blast
  let ?X = "Node l x r" let ?AB = "Node A a B"  let ?ABC = "Node ?AB b C"
  let ?B' = "Node B1 b' B2"
  let ?AB1 = "Node A a B1"  let ?B2C = "Node B2 b C" let ?AB1B2C = "Node ?AB1 b' ?B2C"
  have 0: "\<phi> ?AB1B2C = \<phi> ?ABC" using sp by(simp add: size_if_splay)
  have 1: "\<Phi> ?AB1B2C - \<Phi> ?ABC = \<Phi> B1 + \<Phi> B2 + \<phi> ?AB1 + \<phi> ?B2C - \<Phi> B - \<phi> ?AB"
    using 0 by (simp)
  have "A_splay x ?ABC = T_splay x B + 1 + \<Phi> ?AB1B2C - \<Phi> ?ABC"
    using "8.hyps" sp by(simp add: A_splay_def)
  also have "\<dots> = T_splay x B + 1 + \<Phi> B1 + \<Phi> B2 + \<phi> ?AB1 + \<phi> ?B2C - \<Phi> B - \<phi> ?AB"
    using 1 by simp
  also have "\<dots> = T_splay x B + \<Phi> ?B' - \<phi> ?B' - \<Phi> B + \<phi> ?AB1 + \<phi> ?B2C - \<phi> ?AB + 1"
    by simp
  also have "\<dots> = A_splay x B + \<phi> ?AB1 + \<phi> ?B2C - \<phi> ?AB - \<phi> ?B' + 1"
    using sp by (simp add: A_splay_def)
  also have "\<dots> \<le> 3 * \<phi> B + \<phi> ?AB1 + \<phi> ?B2C - \<phi> ?AB - \<phi> ?B' - 3 * \<phi> ?X + 2"
    using "8.IH" "8.prems"(1) * by(simp)
  also have "\<dots> = 2 * \<phi> B + \<phi> ?AB1 + \<phi> ?B2C - \<phi> ?AB - 3 * \<phi> ?X + 2"
    using sp by(simp add: size_if_splay)
  also have "\<dots> < \<phi> B + \<phi> ?AB1 + \<phi> ?B2C - 3 * \<phi> ?X + 2" by(simp)
  also have "\<dots> < \<phi> B + 2 * \<phi> ?ABC - 3 * \<phi> ?X + 1"
    using sp ld_ld_1_less[of "size1 ?AB1" "size1 ?B2C"]
    by(simp add: size_if_splay)
  also have "\<dots> < 3 * \<phi> ?ABC - 3 * \<phi> ?X + 1" by(simp)
  finally show ?case by simp
next
  case (11 b x c C A D)
  hence *: "\<langle>l, x, r\<rangle> \<in> subtrees C" by(fastforce dest: in_set_tree_if)
  obtain C1 c' C2 where sp: "splay x C = Node C1 c' C2"
    using splay_not_Leaf[OF \<open>C \<noteq> Leaf\<close>] by blast
  let ?X = "Node l x r" let ?CD = "Node C c D"  let ?ACD = "Node A b ?CD"
  let ?C' = "Node C1 c' C2"
  let ?C2D = "Node C2 c D"  let ?AC1 = "Node A b C1"
  have "A_splay x ?ACD = A_splay x C + \<phi> ?C2D + \<phi> ?AC1 - \<phi> ?CD - \<phi> ?C' + 1"
    using "11.hyps" sp
    by(auto simp: A_splay_def size_if_splay algebra_simps split: tree.split)
  also have "\<dots> \<le> 3 * \<phi> C + \<phi> ?C2D + \<phi> ?AC1 - \<phi> ?CD - \<phi> ?C' - 3 * \<phi> ?X + 2"
    using "11.IH" "11.prems"(1) * by(auto simp: algebra_simps)
  also have "\<dots> = 2 * \<phi> C + \<phi> ?C2D + \<phi> ?AC1 - \<phi> ?CD - 3 * \<phi> ?X + 2"
    using sp by(simp add: size_if_splay)
  also have "\<dots> \<le> \<phi> C + \<phi> ?C2D + \<phi> ?AC1 - 3 * \<phi> ?X + 2" by(simp)
  also have "\<dots> \<le> \<phi> C + 2 * \<phi> ?ACD - 3 * \<phi> ?X + 1"
    using sp ld_ld_1_less[of "size1 ?C2D" "size1 ?AC1"]
    by(simp add: size_if_splay algebra_simps)
  also have "\<dots> \<le> 3 * \<phi> ?ACD - 3 * \<phi> ?X + 1" by(simp)
  finally show ?case by simp
next
  case (14 a x b CD A B)
  hence 0: "x \<notin> set_tree B \<and> x \<notin> set_tree A"
    using "14.prems"(1) \<open>b<x\<close> by(auto)
  hence 1: "x \<in> set_tree CD" using "14.prems" \<open>b<x\<close> \<open>a<x\<close> by (auto)
  obtain C c D where sp: "splay x CD = Node C c D"
    using splay_not_Leaf[OF \<open>CD \<noteq> Leaf\<close>] by blast
  from zig_zig[of CD x D C l r _ b B a A] 14 sp 0
  show ?case by(auto simp: A_splay_def size_if_splay algebra_simps)
(* The explicit version:
  have "A_splay x ?A = A_splay x ?R + \<phi> ?B' + \<phi> ?A' - \<phi> ?B - \<phi> ?R' + 1"
    using "14.prems" 1 sp
    by(auto simp: A_splay_def size_if_splay algebra_simps split: tree.split)
  also have "\<dots> \<le> 3 * \<phi> ?R + \<phi> ?B' + \<phi> ?A' - \<phi> ?B - \<phi> ?R' - 3 * \<phi> ?X + 2"
    using 14 0 by(auto simp: algebra_simps)
  also have "\<dots> = 2 * \<phi> rb + \<phi> ?B' + \<phi> ?A' - \<phi> ?B - 3 * \<phi> ?X + 2"
    using sp by(simp add: size_if_splay)
  also have "\<dots> \<le> \<phi> ?R + \<phi> ?B' + \<phi> ?A' - 3 * \<phi> ?X + 2" by(simp)
  also have "\<dots> \<le> \<phi> ?B' + 2 * \<phi> ?A - 3 * \<phi> ?X + 1"
    using sp ld_ld_1_less[of "size1 ?R" "size1 ?A'"]
    by(simp add: size_if_splay algebra_simps)
  also have "\<dots> \<le> 3 * \<phi> ?A - 3 * \<phi> ?X + 1"
    using sp by(simp add: size_if_splay)
  finally show ?case by simp
*)
qed

lemma A_splay_ub2: assumes "bst t" "x : set_tree t"
shows "A_splay x t \<le> 3 * (\<phi> t - 1) + 1"
proof -
  from assms(2) obtain l r where N: "Node l x r : subtrees t"
    by (metis set_treeE)
  have "A_splay x t \<le> 3 * (\<phi> t - \<phi>(Node l x r)) + 1" by(rule A_splay_ub[OF assms(1) N])
  also have "\<dots> \<le> 3 * (\<phi> t - 1) + 1" by(simp add: field_simps)
  finally show ?thesis .
qed

lemma A_splay_ub3: assumes "bst t" shows "A_splay x t \<le> 3 * \<phi> t + 1"
proof cases
  assume "t = Leaf" thus ?thesis by(simp add: A_splay_def)
next
  assume "t \<noteq> Leaf"
  from ex_in_set_tree[OF this assms] obtain x' where
    a': "x' \<in> set_tree t"  "splay x' t = splay x t"  "T_splay x' t = T_splay x t"
    by blast
  show ?thesis using A_splay_ub2[OF assms a'(1)] by(simp add: A_splay_def a')
qed

subsubsection "Analysis of insert"

lemma amor_insert: assumes "bst t"
shows "T_insert x t + \<Phi>(Splay_Tree.insert x t) - \<Phi> t \<le> 4 * log 2 (size1 t) + 3" (is "?l \<le> ?r")
proof cases
  assume "t = Leaf" thus ?thesis by(simp add: T_insert_def)
next
  assume "t \<noteq> Leaf"
  then obtain l e r where [simp]: "splay x t = Node l e r"
    by (metis tree.exhaust splay_Leaf_iff)
  let ?t = "real(T_splay x t)"
  let ?Plr = "\<Phi> l + \<Phi> r"  let ?Ps = "\<Phi> t"
  let ?slr = "real(size1 l) + real(size1 r)" let ?LR = "log 2 (1 + ?slr)"
  have opt: "?t + \<Phi> (splay x t) - ?Ps  \<le> 3 * log 2 (real (size1 t)) + 1"
    using A_splay_ub3[OF \<open>bst t\<close>, simplified A_splay_def, of x] by (simp)
  from less_linear[of e x]
  show ?thesis
  proof (elim disjE)
    assume "e=x"
    have nneg: "log 2 (1 + real (size t)) \<ge> 0" by simp
    thus ?thesis using \<open>t \<noteq> Leaf\<close> opt \<open>e=x\<close>
      apply(simp add: T_insert_def algebra_simps) using nneg by arith
  next
    let ?L = "log 2 (real(size1 l) + 1)"
    assume "e < x" hence "e \<noteq> x" by simp
    hence "?l = (?t + ?Plr - ?Ps) + ?L + ?LR + 1"
      using  \<open>t \<noteq> Leaf\<close> \<open>e<x\<close> by(simp add: T_insert_def)
    also have "?t + ?Plr - ?Ps \<le> 2 * log 2 ?slr + 1"
      using opt size_splay[of x t,symmetric] by(simp)
    also have "?L \<le> log 2 ?slr" by(simp)
    also have "?LR \<le> log 2 ?slr + 1"
    proof -
      have "?LR \<le> log 2 (2 * ?slr)" by (simp add:)
      also have "\<dots> \<le> log 2 ?slr + 1"
        by (simp add: log_mult del:distrib_left_numeral)
      finally show ?thesis .
    qed
    finally show ?thesis using size_splay[of x t,symmetric] by (simp)
  next
    let ?R = "log 2 (2 + real(size r))"
    assume "x < e" hence "e \<noteq> x" by simp
    hence "?l = (?t + ?Plr - ?Ps) + ?R + ?LR + 1"
      using \<open>t \<noteq> Leaf\<close> \<open>x < e\<close> by(simp add: T_insert_def)
    also have "?t + ?Plr - ?Ps \<le> 2 * log 2 ?slr + 1"
      using opt size_splay[of x t,symmetric] by(simp)
    also have "?R \<le> log 2 ?slr" by(simp)
    also have "?LR \<le> log 2 ?slr + 1"
    proof -
      have "?LR \<le> log 2 (2 * ?slr)" by (simp add:)
      also have "\<dots> \<le> log 2 ?slr + 1"
        by (simp add: log_mult del:distrib_left_numeral)
      finally show ?thesis .
    qed
    finally show ?thesis using size_splay[of x t, symmetric] by simp
  qed
qed

subsubsection "Analysis of delete"

definition A_splay_max :: "'a::linorder tree \<Rightarrow> real" where
"A_splay_max t = T_splay_max t + \<Phi>(splay_max t) - \<Phi> t"

lemma A_splay_max_ub: "t \<noteq> Leaf \<Longrightarrow> A_splay_max t \<le> 3 * (\<phi> t - 1) + 1"
proof(induction t rule: splay_max.induct)
  case 1 thus ?case by (simp)
next
  case (2 A)
  thus ?case using one_le_log_cancel_iff[of 2 "size1 A + 1"]
    by (simp add: A_splay_max_def del: one_le_log_cancel_iff)
next
  case (3 l b rl c rr)
  show ?case
  proof cases
    assume "rr = Leaf"
    thus ?thesis
      using one_le_log_cancel_iff[of 2 "1 + size1 rl"]
        one_le_log_cancel_iff[of 2 "1 + size1 l + size1 rl"]
        log_le_cancel_iff[of 2 "size1 l + size1 rl" "1 + size1 l + size1 rl"]
     by (auto simp: A_splay_max_def field_simps
           simp del: log_le_cancel_iff one_le_log_cancel_iff)
  next
    assume "rr \<noteq> Leaf"
    then obtain l' u r' where sp: "splay_max rr = Node l' u r'"
      using splay_max_Leaf_iff tree.exhaust by blast
    hence 1: "size rr = size l' + size r' + 1"
      using size_splay_max[of rr,symmetric] by(simp)
    let ?C = "Node rl c rr"  let ?B = "Node l b ?C"
    let ?B' = "Node l b rl"  let ?C' = "Node ?B' c l'"
    have "A_splay_max ?B = A_splay_max rr + \<phi> ?B' + \<phi> ?C' - \<phi> rr - \<phi> ?C + 1" using "3.prems" sp 1
      by(auto simp add: A_splay_max_def)
    also have "\<dots> \<le> 3 * (\<phi> rr - 1) + \<phi> ?B' + \<phi> ?C' - \<phi> rr - \<phi> ?C + 2"
      using 3 \<open>rr \<noteq> Leaf\<close> by auto
    also have "\<dots> = 2 * \<phi> rr + \<phi> ?B' + \<phi> ?C' - \<phi> ?C - 1" by simp
    also have "\<dots> \<le> \<phi> rr + \<phi> ?B' + \<phi> ?C' - 1" by simp
    also have "\<dots> \<le> 2 * \<phi> ?B + \<phi> ?C' - 2"
      using ld_ld_1_less[of "size1 ?B'" "size1 rr"] by(simp add:)
    also have "\<dots> \<le> 3 * \<phi> ?B - 2" using 1 by simp
    finally show ?case by simp
  qed
qed

lemma A_splay_max_ub3: "A_splay_max t \<le> 3 * \<phi> t + 1"
proof cases
  assume "t = Leaf" thus ?thesis by(simp add: A_splay_max_def)
next
  assume "t \<noteq> Leaf"
  show ?thesis using A_splay_max_ub[OF \<open>t \<noteq> Leaf\<close>] by(simp)
qed

lemma amor_delete: assumes "bst t"
shows "T_delete a t + \<Phi>(Splay_Tree.delete a t) - \<Phi> t \<le> 6 * log 2 (size1 t) + 3"
proof (cases t)
  case Leaf thus ?thesis by(simp add: Splay_Tree.delete_def T_delete_def)
next
  case [simp]: (Node ls x rs)
  then obtain l e r where sp[simp]: "splay a (Node ls x rs) = Node l e r"
    by (metis tree.exhaust splay_Leaf_iff)
  let ?t = "real(T_splay a t)"
  let ?Plr = "\<Phi> l + \<Phi> r"  let ?Ps = "\<Phi> t"
  let ?slr = "real(size1 l) + real(size1 r)" let ?LR = "log 2 (1 + ?slr)"
  let ?lslr = "log 2 (real (size ls) + (real (size rs) + 2))"
  have "?lslr \<ge> 0" by simp
  have opt: "?t + \<Phi> (splay a t) - ?Ps  \<le> 3 * log 2 (real (size1 t)) + 1"
    using A_splay_ub3[OF \<open>bst t\<close>, simplified A_splay_def, of a]
    by (simp add: field_simps)
  show ?thesis
  proof (cases "e=a")
    case False thus ?thesis
      using opt apply(simp add: Splay_Tree.delete_def T_delete_def field_simps)
      using \<open>?lslr \<ge> 0\<close> by arith
  next
    case [simp]: True
    show ?thesis
    proof (cases l)
      case Leaf
      have 1: "log 2 (real (size r) + 2) \<ge> 0" by(simp)
      show ?thesis
        using Leaf opt apply(simp add: Splay_Tree.delete_def T_delete_def field_simps)
        using 1 \<open>?lslr \<ge> 0\<close> by arith
    next
      case (Node ll y lr)
      then obtain l' y' r' where [simp]: "splay_max (Node ll y lr) = Node l' y' r'"
      using splay_max_Leaf_iff tree.exhaust by blast
      have "bst l" using bst_splay[OF \<open>bst t\<close>, of a] by simp
      have "\<Phi> r' \<ge> 0" apply (induction r') by (auto)
      have optm: "real(T_splay_max l) + \<Phi> (splay_max l) - \<Phi> l  \<le> 3 * \<phi> l + 1"
        using A_splay_max_ub3[of l, simplified A_splay_max_def] by (simp add: field_simps Node)
      have 1: "log 2 (2+(real(size l')+real(size r))) \<le> log 2 (2+(real(size l)+real(size r)))"
        using size_splay_max[of l] Node by simp
      have 2: "log 2 (2 + (real (size l') + real (size r'))) \<ge> 0" by simp
      have 3: "log 2 (size1 l' + size1 r) \<le> log 2 (size1 l' + size1 r') + log 2 ?slr"
        apply simp using 1 2 by arith
      have 4: "log 2 (real(size ll) + (real(size lr) + 2)) \<le> ?lslr"
        using size_if_splay[OF sp] Node by simp
      show ?thesis using add_mono[OF opt optm] Node 3
        apply(simp add: Splay_Tree.delete_def T_delete_def field_simps)
        using 4 \<open>\<Phi> r' \<ge> 0\<close> by arith
    qed
  qed
qed

subsubsection "Overall analysis"

fun U where
"U Empty [] = 1" |
"U (Splay _) [t] = 3 * log 2 (size1 t) + 1" |
"U (Insert _) [t] = 4 * log 2 (size1 t) + 3" |
"U (Delete _) [t] = 6 * log 2 (size1 t) + 3"

interpretation Amortized
where arity = arity and exec = exec and inv = bst
and cost = cost and \<Phi> = \<Phi> and U = U
proof (standard, goal_cases)
  case (1 ss f) show ?case
  proof (cases f)
    case Empty thus ?thesis using 1 by auto
  next
    case (Splay a)
    then obtain t where "ss = [t]" "bst t" using 1 by auto
    with Splay bst_splay[OF \<open>bst t\<close>, of a] show ?thesis
      by (auto split: tree.split)
  next
    case (Insert a)
    then obtain t where "ss = [t]" "bst t" using 1 by auto
    with bst_splay[OF \<open>bst t\<close>, of a] Insert show ?thesis
      by (auto simp: splay_bstL[OF \<open>bst t\<close>] splay_bstR[OF \<open>bst t\<close>] split: tree.split)
  next
    case (Delete a)
    then obtain t where "ss = [t]" "bst t" using 1 by auto
    with 1 Delete show ?thesis by(simp add: bst_delete)
  qed
next
  case (2 t) thus ?case by (induction t) auto
next
  case (3 ss f)
  show ?case (is "?l \<le> ?r")
  proof(cases f)
    case Empty thus ?thesis using 3(2) by(simp add: A_splay_def)
  next
    case (Splay a)
    then obtain t where "ss = [t]" "bst t" using 3 by auto
    thus ?thesis using Splay A_splay_ub3[OF \<open>bst t\<close>] by(simp add: A_splay_def)
  next
    case [simp]: (Insert a)
    then obtain t where [simp]: "ss = [t]" and "bst t" using 3 by auto
    thus ?thesis using amor_insert[of t a] by auto
  next
    case [simp]: (Delete a)
    then obtain t where [simp]: "ss = [t]" and "bst t" using 3 by auto
    thus ?thesis using amor_delete[of t a] by auto
  qed
qed

end


section\<open>\<open>\<Sigma>\<close>-Protocols\<close>

text\<open>\<open>\<Sigma>\<close>-protocols were first introduced as an abstract notion by Cramer \<^cite>\<open>"Cramerthesis"\<close>.
We point the reader to \<^cite>\<open>"sigma_protocols"\<close> for a good introduction to the primitive as well as informal proofs
of many of the constructions we formalise in this work. In particular the construction of commitment schemes from
\<open>\<Sigma>\<close>-protocols and the construction of compound AND and OR statements.

In this section we define \<open>\<Sigma>\<close>-protocols then provide a general proof that they can be used to construct commitment schemes.
Defining security for \<open>\<Sigma>\<close>-protocols uses a mixture of the game-based and simulation-based paradigms. The honest verifier
zero knowledge property is considered using simulation-based proof, thus we follow the follow the simulation-based formalisation
of \<^cite>\<open>"DBLP:journals/afp/AspinallB19"\<close> and \<^cite>\<open>"DBLP:conf/itp/Butler0G17"\<close>.\<close>

subsection\<open>Defining \<open>\<Sigma>\<close>-protocols\<close>

theory Sigma_Protocols imports
  CryptHOL.CryptHOL
  Commitment_Schemes
begin

type_synonym ('msg', 'challenge', 'response') conv_tuple = "('msg' \<times> 'challenge' \<times> 'response')"

type_synonym ('msg','response') sim_out = "('msg' \<times> 'response')"

type_synonym ('pub_input', 'msg', 'challenge', 'response', 'witness') prover_adversary
                  = "'pub_input' \<Rightarrow> ('msg', 'challenge', 'response') conv_tuple
                        \<Rightarrow> ('msg', 'challenge', 'response') conv_tuple \<Rightarrow> 'witness' spmf"

locale \<Sigma>_protocols_base =
  fixes init :: "'pub_input \<Rightarrow> 'witness \<Rightarrow> ('rand \<times> 'msg) spmf" \<comment> \<open>initial message in \<open>\<Sigma>\<close>-protocol\<close>
    and response :: "'rand \<Rightarrow> 'witness \<Rightarrow> 'challenge  \<Rightarrow> 'response spmf"
    and check :: "'pub_input \<Rightarrow> 'msg \<Rightarrow> 'challenge \<Rightarrow> 'response \<Rightarrow> bool"
    and Rel :: "('pub_input \<times> 'witness) set" \<comment> \<open>The relation the \<open>\<Sigma>\<close> protocol is considered over\<close>
    and S_raw :: "'pub_input \<Rightarrow> 'challenge \<Rightarrow> ('msg, 'response) sim_out spmf" \<comment> \<open>Simulator for the HVZK property\<close>
    and \ss :: "('pub_input, 'msg, 'challenge, 'response, 'witness) prover_adversary" \<comment> \<open>Special soundness adversary\<close>
    and challenge_space :: "'challenge set" \<comment> \<open>The set of valid challenges\<close>
    and valid_pub :: "'pub_input set"
  assumes domain_subset_valid_pub: "Domain Rel \<subseteq> valid_pub"
begin

lemma assumes "x \<in> Domain Rel" shows "\<exists> w. (x,w) \<in> Rel"
  using assms by auto

text\<open>The language defined by the relation is the set of all public inputs such that there exists a witness that satisfies the relation.\<close>

definition "L \<equiv> {x. \<exists> w. (x, w) \<in> Rel}"

text\<open>The first property of \<open>\<Sigma>\<close>-protocols we consider is completeness, we define a probabilistic programme
that runs the components of the protocol and outputs the boolean defined by the check algorithm.\<close>

definition completeness_game :: "'pub_input \<Rightarrow> 'witness \<Rightarrow> 'challenge \<Rightarrow> bool spmf"
  where "completeness_game h w e = do {
    (r, a) \<leftarrow> init h w;
    z \<leftarrow> response r w e;
    return_spmf (check h a e z)}"

text\<open>We define completeness as the probability that the completeness-game returns true for all challenges assuming the relation holds on \<open>h\<close> and \<open>w\<close>.\<close>

definition "completeness \<equiv> (\<forall> h w e . (h,w) \<in> Rel \<longrightarrow> e \<in> challenge_space \<longrightarrow> spmf (completeness_game h w e) True = 1)"

text\<open>Second we consider the honest verifier zero knowledge property (HVZK). To reason about this we construct the real view of the
\<open>\<Sigma>\<close>-protocol given a challenge \<open>e\<close> as input.\<close>

definition R :: "'pub_input \<Rightarrow> 'witness \<Rightarrow> 'challenge \<Rightarrow> ('msg, 'challenge, 'response) conv_tuple spmf"
  where "R h w e = do {
    (r,a) \<leftarrow> init h w;
    z \<leftarrow> response r w e;
    return_spmf (a,e,z)}"

definition S where "S h e = map_spmf (\<lambda> (a, z). (a, e, z)) (S_raw h e)"

lemma lossless_S_raw_imp_lossless_S: "lossless_spmf (S_raw h e) \<longrightarrow> lossless_spmf (S h e)"
  by(simp add: S_def)

text\<open>The HVZK property requires that the simulator's output distribution is equal to the real views output distribution.\<close>

definition "HVZK \<equiv> (\<forall>e \<in> challenge_space.
                      (\<forall>(h, w)\<in>Rel. R h w e = S h e)
                        \<and> (\<forall>h \<in> valid_pub. \<forall>(a, z) \<in> set_spmf (S_raw h e). check h a e z))"

text\<open>The final property to consider is that of special soundness. This says that given two valid transcripts such that the challenges
are not equal there exists an adversary \<open>\ss\<close> that can output the witness.\<close>

definition "special_soundness \<equiv> (\<forall> h e e' a z z'. h \<in> valid_pub \<longrightarrow> e \<in> challenge_space \<longrightarrow> e' \<in> challenge_space \<longrightarrow>  e \<noteq> e'
              \<longrightarrow> check h a e z \<longrightarrow> check h a e' z' \<longrightarrow> (lossless_spmf (\ss h (a,e,z) (a, e', z')) \<and>
                  (\<forall>w'\<in>set_spmf (\ss h (a,e,z) (a,e',z')). (h,w') \<in> Rel)))"

lemma special_soundness_alt:
  "special_soundness \<longleftrightarrow>
      (\<forall> h a e z e' z'. e \<in> challenge_space \<longrightarrow> e' \<in> challenge_space \<longrightarrow> h \<in> valid_pub
          \<longrightarrow> e \<noteq> e' \<longrightarrow> check h a e z \<and> check h a e' z'
              \<longrightarrow> bind_spmf (\ss h (a,e,z) (a,e',z')) (\<lambda> w'. return_spmf ((h,w') \<in> Rel)) = return_spmf True)"
  apply(auto simp add: special_soundness_def map_spmf_conv_bind_spmf[symmetric] map_pmf_eq_return_pmf_iff in_set_spmf lossless_iff_set_pmf_None)
  apply(metis Domain.DomainI in_set_spmf not_Some_eq)
  using Domain.intros by blast +

definition "\<Sigma>_protocol \<equiv> completeness \<and> special_soundness \<and> HVZK"

text\<open>General lemmas\<close>

lemma lossless_complete_game:
  assumes lossless_init: "\<forall> h w. lossless_spmf (init h w)"
    and lossless_response: "\<forall> r w e. lossless_spmf (response r w e)"
  shows "lossless_spmf (completeness_game h w e)"
  by(simp add: completeness_game_def lossless_init lossless_response split_def)

lemma complete_game_return_true:
  assumes "(h,w) \<in> Rel"
    and "completeness"
    and lossless_init: "\<forall> h w. lossless_spmf (init h w)"
    and lossless_response: "\<forall> r w e. lossless_spmf (response r w e)"
    and "e \<in> challenge_space"
  shows "completeness_game h w e = return_spmf True"
proof -
  have "spmf (completeness_game h w e) True = spmf (return_spmf True) True"
    using assms \<Sigma>_protocol_def completeness_def by fastforce
  then have "completeness_game h w e = return_spmf True"
    by (metis (full_types) lossless_complete_game lossless_init lossless_response lossless_return_spmf spmf_False_conv_True spmf_eqI)
  then show ?thesis
    by (simp add: completeness_game_def)
qed

lemma HVZK_unfold1:
  assumes "\<Sigma>_protocol"
  shows "\<forall> h w e. (h,w) \<in> Rel \<longrightarrow> e \<in> challenge_space \<longrightarrow> R h w e = S h e"
  using assms by(auto simp add: \<Sigma>_protocol_def HVZK_def)

lemma HVZK_unfold2:
  assumes "\<Sigma>_protocol"
  shows "\<forall> h e out. e \<in> challenge_space \<longrightarrow> h \<in> valid_pub \<longrightarrow> out \<in> set_spmf (S_raw h e) \<longrightarrow> check h (fst out) e (snd out)"
  using assms by(auto simp add: \<Sigma>_protocol_def HVZK_def split_def)

lemma HVZK_unfold2_alt:
  assumes "\<Sigma>_protocol"
  shows "\<forall> h a e z. e \<in> challenge_space \<longrightarrow> h \<in> valid_pub \<longrightarrow> (a,z) \<in> set_spmf (S_raw h e) \<longrightarrow> check h a e z"
  using assms by(fastforce simp add: \<Sigma>_protocol_def HVZK_def)

end

subsection\<open>Commitments from \<open>\<Sigma>\<close>-protocols\<close>

text\<open>In this section we provide a general proof that \<open>\<Sigma>\<close>-protocols can be used to construct commitment schemes.
We follow  the construction given by Damgard in \<^cite>\<open>"sigma_protocols"\<close>.\<close>

locale \<Sigma>_protocols_to_commitments = \<Sigma>_protocols_base init response check Rel S_raw \ss challenge_space valid_pub
  for init :: "'pub_input \<Rightarrow> 'witness \<Rightarrow> ('rand \<times> 'msg) spmf"
    and response :: "'rand \<Rightarrow> 'witness \<Rightarrow> 'challenge \<Rightarrow> 'response spmf"
    and check :: "'pub_input \<Rightarrow> 'msg \<Rightarrow> 'challenge \<Rightarrow> 'response \<Rightarrow> bool"
    and Rel :: "('pub_input \<times> 'witness) set"
    and S_raw :: "'pub_input \<Rightarrow> 'challenge \<Rightarrow> ('msg, 'response) sim_out spmf"
    and \ss :: "('pub_input, 'msg, 'challenge, 'response, 'witness) prover_adversary"
    and challenge_space :: "'challenge set"
    and valid_pub :: "'pub_input set"
    and G :: "('pub_input \<times> 'witness) spmf" \<comment> \<open>generates pairs that satisfy the relation\<close>
    +
  assumes \<Sigma>_prot: "\<Sigma>_protocol" \<comment> \<open>assume we have a \<open>\<Sigma>\<close>-protocol\<close>
    and set_spmf_G_rel [simp]: "(h,w) \<in> set_spmf G \<Longrightarrow> (h,w) \<in> Rel" \<comment> \<open>the generator has the desired property\<close>
    and lossless_G: "lossless_spmf G"
    and lossless_init: "lossless_spmf (init h w)"
    and lossless_response: "lossless_spmf (response r w e)"
begin

lemma set_spmf_G_domain_rel [simp]: "(h,w) \<in> set_spmf G \<Longrightarrow> h \<in> Domain Rel"
  using set_spmf_G_rel by fast

lemma set_spmf_G_L [simp]: "(h,w) \<in> set_spmf G \<Longrightarrow> h \<in> L"
  by (metis mem_Collect_eq set_spmf_G_rel L_def)

text\<open>We define the advantage associated with the hard relation, this is used in the proof of the binding property where
we reduce the binding advantage to the relation advantage.\<close>

definition rel_game :: "('pub_input \<Rightarrow> 'witness spmf) \<Rightarrow> bool spmf"
  where "rel_game \ = TRY do {
    (h,w) \<leftarrow> G;
    w' \<leftarrow> \ h;
    return_spmf ((h,w') \<in> Rel)} ELSE return_spmf False"

definition rel_advantage :: "('pub_input \<Rightarrow> 'witness spmf) \<Rightarrow> real"
  where "rel_advantage \ \<equiv> spmf (rel_game \) True"

text\<open>We now define the algorithms that define the commitment scheme constructed from a \<open>\<Sigma>\<close>-protocol.\<close>

definition key_gen :: "('pub_input \<times>  ('pub_input \<times> 'witness)) spmf"
  where
   "key_gen = do {
    (x,w) \<leftarrow> G;
    return_spmf (x, (x,w))}"

definition commit :: "'pub_input \<Rightarrow> 'challenge \<Rightarrow> ('msg \<times>  'response) spmf"
  where
    "commit x e = do {
    (a,e,z) \<leftarrow> S x e;
    return_spmf (a, z)}"

definition verify :: "('pub_input \<times> 'witness) \<Rightarrow> 'challenge \<Rightarrow> 'msg \<Rightarrow>  'response \<Rightarrow> bool"
  where "verify x e a z = (check (fst x) a e z)"

text\<open>We allow the adversary to output any message, so this means the type constraint is enough\<close>

definition "valid_msg m = (m \<in> challenge_space)"

text\<open>Showing the construction of a commitment scheme from a \<open>\<Sigma>\<close>-protocol is a  valid commitment scheme is trivial.\<close>

sublocale abstract_com: abstract_commitment key_gen commit verify valid_msg .

paragraph\<open>Correctness\<close>

lemma commit_correct:
  shows "abstract_com.correct"
  including monad_normalisation
proof-
  have "\<forall> m \<in> challenge_space. abstract_com.correct_game m = return_spmf True"
  proof
    fix m
    assume m: "m \<in> challenge_space"
    show "abstract_com.correct_game m = return_spmf True"
    proof-
    have "abstract_com.correct_game m = do {
      (ck, (vk1,vk2)) \<leftarrow> key_gen;
      (a,e,z) \<leftarrow> S ck m;
      return_spmf (check vk1 a m z)}"
      unfolding abstract_com.correct_game_def
      by(simp add: commit_def verify_def split_def)
    also have "... = do {
      (x,w) \<leftarrow> G;
      let (ck, (vk1,vk2)) = (x,(x,w));
      (a,e,z) \<leftarrow> S ck m;
      return_spmf (check vk1 a m z)}"
      by(simp add: key_gen_def split_def)
    also have "... = do {
      (x,w) \<leftarrow> G;
      (a,e,z) \<leftarrow> S x m;
      return_spmf (check x a m z)}"
      by(simp add: Let_def)
    also have "... = do {
      (x,w) \<leftarrow> G;
      (a, e,z) \<leftarrow> R x w m;
      return_spmf (check x a m z)}"
      using \<Sigma>_prot HVZK_unfold1 m
      by(intro bind_spmf_cong bind_spmf_cong[OF refl]; clarsimp?)
    also have "... = do {
      (x,w) \<leftarrow> G;
      (r, a) \<leftarrow> init x w;
      z \<leftarrow> response r w m;
      return_spmf (check x a m z)}"
      by(simp add: R_def split_def)
    also have "... = do {
      (x,w) \<leftarrow> G;
      return_spmf True}"
      apply(intro bind_spmf_cong bind_spmf_cong[OF refl]; clarsimp?)
      using complete_game_return_true lossless_init lossless_response \<Sigma>_prot \<Sigma>_protocol_def
      by(simp add: split_def completeness_game_def \<Sigma>_protocols_base.\<Sigma>_protocol_def m cong: bind_spmf_cong_simp)
    ultimately show "abstract_com.correct_game m = return_spmf True"
      by(simp add: bind_spmf_const lossless_G lossless_weight_spmfD split_def)
  qed
qed
  thus ?thesis
    using abstract_com.correct_def abstract_com.valid_msg_set_def valid_msg_def by simp
qed

paragraph\<open>The hiding property\<close>

text\<open>We first show we have perfect hiding with respect to the hiding game that allows the adversary to choose
the messages that are committed to, this is akin to the ind-cpa game for encryption schemes.\<close>

lemma perfect_hiding:
  shows "abstract_com.perfect_hiding_ind_cpa \"
  including monad_normalisation
proof-
  obtain \1 \2 where [simp]: "\ = (\1, \2)" by(cases \)
  have "abstract_com.hiding_game_ind_cpa (\1, \2) = TRY do {
    (x,w) \<leftarrow> G;
    ((m0, m1), \<sigma>) \<leftarrow> \1 (x,w);
    _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
    b \<leftarrow> coin_spmf;
    (a,e,z) \<leftarrow> S x (if b then m0 else m1);
    b' \<leftarrow> \2 a \<sigma>;
    return_spmf (b' = b)} ELSE coin_spmf"
    by(simp add: abstract_com.hiding_game_ind_cpa_def commit_def; simp add: key_gen_def split_def)
  also have "... = TRY do {
    (x,w) \<leftarrow> G;
    ((m0, m1), \<sigma>) \<leftarrow> \1 (x,w);
    _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
    b :: bool \<leftarrow> coin_spmf;
    (a,e,z) \<leftarrow> R x w (if b then m0 else m1);
    b' :: bool \<leftarrow> \2 a \<sigma>;
    return_spmf (b' = b)} ELSE coin_spmf"
    apply(intro try_spmf_cong bind_spmf_cong[OF refl]; clarsimp?)+
    by(simp add: \<Sigma>_prot  HVZK_unfold1 valid_msg_def)
  also have "... = TRY do {
    (x,w) \<leftarrow> G;
    ((m0, m1), \<sigma>) \<leftarrow> \1 (x,w);
    _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
    b \<leftarrow> coin_spmf;
    (r,a) \<leftarrow> init x w;
    z :: 'response \<leftarrow> response r w (if b then m0 else m1);
    guess :: bool \<leftarrow> \2 a \<sigma>;
    return_spmf(guess = b)} ELSE coin_spmf"
    using \<Sigma>_protocols_base.R_def
    by(simp add: bind_map_spmf o_def R_def split_def)
  also have  "... = TRY do {
    (x,w) \<leftarrow> G;
    ((m0, m1), \<sigma>) \<leftarrow> \1 (x,w);
    _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
    b \<leftarrow> coin_spmf;
    (r,a) \<leftarrow> init x w;
    guess :: bool \<leftarrow> \2 a \<sigma>;
    return_spmf(guess = b)} ELSE coin_spmf"
    by(simp add: bind_spmf_const lossless_response lossless_weight_spmfD)
  also have  "... = TRY do {
    (x,w) \<leftarrow> G;
    ((m0, m1), \<sigma>) \<leftarrow> \1 (x,w);
    _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
    (r,a) \<leftarrow> init x w;
    guess :: bool \<leftarrow> \2 a \<sigma>;
    map_spmf( (=) guess) coin_spmf} ELSE coin_spmf"
    apply(simp add: map_spmf_conv_bind_spmf)
    by(simp add: split_def)
  also have "... = coin_spmf"
    by(auto simp add: map_eq_const_coin_spmf try_bind_spmf_lossless2' Let_def split_def bind_spmf_const scale_bind_spmf weight_spmf_le_1 scale_scale_spmf)
  ultimately have "spmf (abstract_com.hiding_game_ind_cpa \) True = 1/2"
    by(simp add: spmf_of_set)
  thus ?thesis
    by (simp add: abstract_com.perfect_hiding_ind_cpa_def abstract_com.hiding_advantage_ind_cpa_def)
qed

text\<open>We reduce the security of the binding property to the relation advantage. To do this we first construct
an adversary that interacts with the relation game. This adversary succeeds if the binding adversary succeeds.\<close>

definition adversary :: "('pub_input \<Rightarrow> ('msg \<times> 'challenge \<times> 'response \<times> 'challenge \<times> 'response) spmf) \<Rightarrow> 'pub_input \<Rightarrow> 'witness spmf"
  where "adversary \ x = do {
    (c, e, ez, e', ez') \<leftarrow> \ x;
    \ss x (c,e,ez) (c,e',ez')}"

lemma bind_advantage:
  shows "abstract_com.bind_advantage \ \<le> rel_advantage (adversary \)"
proof-
  have "abstract_com.bind_game \ = TRY do {
  (x,w) \<leftarrow> G;
  (c, m, d, m', d') \<leftarrow> \ x;
  _ :: unit \<leftarrow> assert_spmf (m \<noteq> m' \<and> m \<in> challenge_space \<and> m' \<in> challenge_space);
  let b = check x c m d;
  let b' = check x c m' d';
  _ :: unit \<leftarrow> assert_spmf (b \<and> b');
  w' \<leftarrow> \ss x (c,m, d) (c,m', d');
  return_spmf ((x,w') \<in> Rel)} ELSE return_spmf False"
    unfolding abstract_com.bind_game_alt_def
    apply(simp add:  key_gen_def verify_def Let_def split_def valid_msg_def)
    apply(intro try_spmf_cong bind_spmf_cong[OF refl]; clarsimp?)+
    using special_soundness_def \<Sigma>_prot \<Sigma>_protocol_def special_soundness_alt special_soundness_def set_spmf_G_rel set_spmf_G_domain_rel
    by (smt basic_trans_rules(31) bind_spmf_cong domain_subset_valid_pub)
  hence "abstract_com.bind_advantage \ \<le> spmf (TRY do {
  (x,w) \<leftarrow> G;
  (c, m, d, m', d') \<leftarrow> \ x;
  w' \<leftarrow> \ss x (c,m, d) (c,m', d');
  return_spmf ((x,w') \<in> Rel)} ELSE return_spmf False) True"
    unfolding abstract_com.bind_advantage_def
    apply(simp add: spmf_try_spmf)
    apply(rule ord_spmf_eq_leD)
    apply(rule ord_spmf_bind_reflI;clarsimp)+
    by(simp add: assert_spmf_def)
  thus ?thesis
    by(simp add: rel_game_def adversary_def split_def rel_advantage_def)
qed

end

end