(*<*)
(*
   Title:  Gateway_proof_aux.thy  (Gateway: Verification, aux. lemmas)
   Author: Maria Spichkova <maria.spichkova at rmit.edu.au>, 2013
*)
(*>*)
header {*Gateway: Verification*}

theory Gateway_proof_aux
imports Gateway BitBoolTS
begin

subsection {* Properties of the defined data types *}

lemma aType_empty:
  assumes h1:"msg (Suc 0) a"
         and h2: "a t \<noteq> [sc_ack]"
  shows       "a t = []"
proof (cases "a t")
  assume a1:"a t = []"
  from this show ?thesis by simp
next
  fix aa l
  assume a2:"a t = aa # l"
  show ?thesis
    proof (cases "aa")
      assume a3:"aa = sc_ack"
      from h1 have sg1:"length (a t) \<le> Suc 0" by (simp add: msg_def)
      from this and assms and a2 and a3 show ?thesis by auto
    qed
qed

lemma aType_nonempty:
  assumes h1:"msg (Suc 0) a"
      and h2: "a t \<noteq> []"
  shows       "a t = [sc_ack]"
proof (cases "a t")
  assume a1:"a t = []"
  from this and h2 show ?thesis by simp
next
  fix aa l
  assume a2:"a t = aa # l"
  from a2 and h1 have sg1: "l = []" by (simp add: msg_nonempty1)
  from a2 and h1 and sg1 show ?thesis
    proof (cases "aa")
      assume a3:"aa = sc_ack"
      from this and sg1 and h2 and a2 show ?thesis  by simp
    qed
qed

lemma aType_lemma:
  assumes "msg (Suc 0) a"
  shows    "a t = [] \<or> a t = [sc_ack]"
using assms
by (metis aType_nonempty)

lemma stopType_empty:
  assumes "msg (Suc 0) a"
         and "a t \<noteq> [stop_vc]"
  shows "a t = []"
using assms
by (metis (full_types) list_length_hint2 msg_nonempty2 stopType.exhaust)

lemma stopType_nonempty:
  assumes "msg (Suc 0) a"
         and "a t \<noteq> []"
  shows "a t = [stop_vc]"
using assms
by (metis stopType_empty)

lemma stopType_lemma:
  assumes "msg (Suc 0) a"
  shows    "a t = [] \<or> a t = [stop_vc]"
using assms
by (metis stopType_nonempty)

lemma vcType_empty:
  assumes "msg (Suc 0) a"
         and "a t \<noteq> [vc_com]"
  shows"a t = []"
using assms
by (metis (full_types) list_length_hint2 msg_nonempty2 vcType.exhaust)

lemma vcType_lemma:
  assumes "msg (Suc 0) a"
  shows    "a t = [] \<or> a t = [vc_com]"
using assms
by (metis vcType_empty)

subsection {* Properties of the Delay component *}

lemma Delay_L1:
 assumes h1:"\<forall>t1 < t. i1 t1 = []"
         and h2:"Delay y i1 d x i2"
         and h3:"t2 < t + d"
   shows "i2 t2 = []"
proof (cases "t2 < d")
  assume a1:"t2 < d"
  from h2 have sg1:"t2 < d \<longrightarrow> i2 t2 = []"
    by (simp add: Delay_def)
  from sg1 and a1 show ?thesis by simp
next
  assume a2:"\<not> t2 < d"
  from h2 have sg2:"d \<le> t2 \<longrightarrow> i2 t2 = i1 (t2 - d)"
    by (simp add: Delay_def)
  from a2 and sg2 have "i2 t2 = i1 (t2 - d)" by simp
  from h1 and a2 and h3 and this show ?thesis by auto
qed

lemma Delay_L2:
 assumes "\<forall>t1 < t. i1 t1 = []"
        and "Delay y i1 d x i2"
   shows "\<forall>t2 < t + d. i2 t2 = []"
using assms by (clarify, rule Delay_L1, auto)

lemma Delay_L3:
 assumes h1:"\<forall>t1 \<le> t. y t1 = []"
        and h2:"Delay y i1 d x i2"
        and h3:"t2 \<le> t + d"
   shows "x t2 = []"
proof (cases "t2 < d")
  assume a1:"t2 < d"
  from h2 have sg1:"t2 < d \<longrightarrow> x t2 = []"
    by (simp add: Delay_def)
  from sg1 and a1 show ?thesis by simp
next
  assume a2:"\<not> t2 < d"
  from h2 have sg2:"d \<le> t2 \<longrightarrow> x t2 = y (t2 - d)"
    by (simp add: Delay_def)
  from a2 and sg2 have sg3:"x t2 = y (t2 - d)" by simp
  from h1 and a2 and h3 and sg3 show ?thesis by auto
qed

lemma Delay_L4:
 assumes "\<forall>t1 \<le> t. y t1 = []"
     and "Delay y i1 d x i2"
   shows "\<forall>t2 \<le> t + d. x t2 = []"
using assms by (clarify, rule Delay_L3, auto)

lemma Delay_lengthOut1:
  assumes h1:"\<forall>t. length (x t) \<le> Suc 0"
         and h2:"Delay x i1 d y i2"
  shows "length (y t) \<le> Suc 0"
proof (cases "t < d")
  assume a1:"t < d"
  from h2 have sg1:"t < d \<longrightarrow> y t = []"
    by (simp add: Delay_def)
  from a1 and sg1 show ?thesis by auto
next
  assume a2:"\<not> t < d"
  from h2 have sg2:"t \<ge> d \<longrightarrow> (y t = x (t-d))"
    by (simp add: Delay_def)
  from a2 and sg2 and h1 show ?thesis by auto
qed

lemma Delay_msg1:
  assumes "msg (Suc 0) x"
         and "Delay x i1 d y i2"
  shows      "msg (Suc 0) y"
using assms
by (simp add: msg_def Delay_lengthOut1)

subsection {* Properties of the Loss component *}

lemma Loss_L1:
 assumes "\<forall>t2<t. i2 t2 = []"
        and "Loss lose a i2 y i"
        and "t2 < t"
        and "ts lose"
 shows "i t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L2:
 assumes "\<forall>t2<t. i2 t2 = []"
        and "Loss lose a i2 y i"
        and "ts lose"
 shows  "\<forall>t2<t. i t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L3:
 assumes "\<forall>t2<t. a t2 = []"
        and "Loss lose a i2 y i"
        and "t2 < t"
        and "ts lose"
 shows "y t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L4:
 assumes "\<forall>t2<t. a t2 = []"
        and "Loss lose a i2 y i"
        and "ts lose"
 shows  "\<forall>t2<t. y t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L5:
 assumes "\<forall>t1 \<le> t. a t1 = []"
        and "Loss lose a i2 y i"
        and "t2 \<le> t"
        and "ts lose"
 shows "y t2 = []"
using assms
by (metis Loss_def)

lemma Loss_L5Suc:
 assumes "\<forall>j \<le> d. a (t + Suc j) = []"
        and "Loss lose a i2 y i"
        and "Suc j \<le> d"
        and tsLose:"ts lose"
 shows "y (t + Suc j) = []"
using assms
proof (cases "lose (t + Suc j) = [False]")
  assume "lose (t + Suc j) = [False]"
  from assms and this show ?thesis by (simp add: Loss_def)
next
  assume "lose (t + Suc j) \<noteq> [False]"
  from this and tsLose have "lose (t + Suc j) = [True]"
    by (simp add: ts_bool_True)
  from assms and this show ?thesis by (simp add: Loss_def)
qed

lemma Loss_L6:
 assumes "\<forall>t2 \<le> t. a t2 = []"
        and "Loss lose a i2 y i"
        and "ts lose"
 shows  "\<forall>t2 \<le> t. y t2 = []"
using assms
by (metis Loss_L5)

lemma Loss_lengthOut1:
  assumes h1:"\<forall>t. length (a t) \<le> Suc 0"
         and h2:"Loss lose a i2 x i"
  shows "length (x t) \<le> Suc 0"
proof (cases "lose t =  [False]")
  assume "lose t =  [False]"
  from this and h2 have sg1:"x t = a t" by (simp add: Loss_def)
  from h1 have sg2:"length (a t) \<le> Suc 0" by auto
  from sg1 and sg2 show ?thesis by simp
next
  assume "lose t \<noteq> [False]"
  from this and h2 have "x t = []" by (simp add: Loss_def)
  from this show ?thesis by simp
qed

lemma Loss_lengthOut2:
  assumes "\<forall>t. length (a t) \<le> Suc 0"
         and "Loss lose a i2 x i"
  shows "\<forall>t. length (x t) \<le> Suc 0"
using assms
by (simp add: Loss_lengthOut1)

lemma Loss_msg1:
  assumes "msg (Suc 0) a"
         and "Loss lose a i2 x i"
  shows      "msg (Suc 0) x"
using assms
by (simp add: msg_def Loss_def Loss_lengthOut1)

subsection {* Properties of the composition of Delay and Loss components *}

lemma Loss_Delay_length_y:
  assumes "\<forall>t. length (a t) \<le> Suc 0"
         and "Delay x i1 d y i2"
         and "Loss lose a i2 x i"
  shows "length (y t) \<le> Suc 0"
using assms
by (metis Delay_msg1 Loss_msg1 msg_def)

lemma Loss_Delay_msg_a:
  assumes "msg (Suc 0) a"
         and "Delay x i1 d y i2"
         and "Loss lose a i2 x i"
  shows  "msg (Suc 0) y"
using assms
by (simp add: msg_def Loss_Delay_length_y)

subsection {* Auxiliary Lemmas*}

lemma inf_last_ti2:
  assumes "inf_last_ti dt (Suc (Suc t)) \<noteq> []"
  shows    "inf_last_ti dt (Suc (Suc (t + k))) \<noteq> []"
using assms
by (metis add_Suc inf_last_ti_nonempty_k)

lemma aux_ack_t2:
  assumes h1:"\<forall>m\<le>k. ack (Suc (Suc (t + m))) = [connection_ok]"
         and h2:"Suc (Suc t) < t2"
         and h3:"t2 < t + 3 + k"
  shows "ack t2 = [connection_ok]"
proof -
  from h3 have sg1:"t2 - Suc (Suc t) \<le> k" by arith
  from h1 and sg1
    obtain m where a1:"m = t2 - Suc (Suc t)"
                  and a2:"ack (Suc (Suc (t + m))) = [connection_ok]"
    by auto
  from h2 have sg2:"(Suc (Suc (t2 - 2))) =  t2" by arith
  from h2 have sg3:"Suc (Suc (t + (t2 - Suc (Suc t)))) =  t2" by arith
  from sg1 and a1 and a2 and sg2 and sg3 show ?thesis by simp
qed

lemma aux_lemma_lose_1:
  assumes h1:"\<forall>j\<le>((2::nat) * d + ((4::nat) + k)). (lose (t + j) = x)"
         and h2:"ka\<le>Suc d"
  shows "lose (Suc (Suc (t + k + ka))) = x"
proof -
  from h2 have sg1:"k + (2::nat) + ka \<le> (2::nat) * d + ((4::nat) + k)" by auto
  from h2 and sg1 have sg2:"Suc (Suc (k + ka)) \<le>2 * d + (4 + k)" by auto
  from sg1 and sg2 and h1 and h2  obtain j where a1:"j = k + (2::nat) + ka"
                                     and a2:"lose (t + j) = x"
    by blast
  have sg3:"Suc (Suc (t + (k + ka))) = Suc (Suc (t + k + ka))" by arith
  from a1 and a2 and sg3 show ?thesis  by simp
qed

lemma aux_lemma_lose_2:
  assumes "\<forall>j\<le>(2::nat) * d + ((4::nat) + k). lose (t + j) = [False]"
  shows    "\<forall>x\<le>d + (1::nat). lose (t + x) = [False]"
using assms by auto

lemma aux_lemma_lose_3a:
  assumes h1:"\<forall>j\<le>2 * d + (4 + k). lose (t + j) = [False]"
         and h2:"ka \<le> Suc d"
  shows "lose (d + (t + (3 + k)) + ka) = [False]"
proof -
  from h2 have sg1:"(d + 3 + k + ka) \<le>2 * d + (4 + k)"
    by arith
  from h1 and h2 and sg1  obtain j where a1:"j = (d + 3 + k + ka)" and
                                         a2:"lose (t + j) = [False]"
    by simp
  from h2 and sg1 have sg2:"(t + (d + 3 + k + ka)) = (d + (t + (3 + k)) + ka)"
    by arith
  from h1 and h2 and a1 and a2 and sg2 show ?thesis
    by simp
qed

lemma aux_lemma_lose_3:
  assumes "\<forall>j\<le>2 * d + (4 + k). lose (t + j) = [False]"
  shows    "\<forall>ka\<le>Suc d. lose (d + (t + (3 + k)) + ka) = [False]"
using assms
by (auto, simp add: aux_lemma_lose_3a)

lemma aux_arith1_Gateway7:
  assumes "t2 - t \<le> (2::nat) * d + (t + ((4::nat) + k))"
         and "t2 < t + (3::nat) + k + d"
         and "\<not> t2 - d < (0::nat)"
  shows "t2 - d < t + (3::nat) + k"
using assms  by arith

lemma ts_lose_ack_st1ts:
  assumes "ts lose"
         and "lose t = [True]  \<longrightarrow>  ack t = [x]  \<and> st_out t = x"
         and "lose t = [False] \<longrightarrow>  ack t = [y]  \<and> st_out t = y"
  shows "ack t = [st_out t]"
using assms
by (metis ts_bool_False)

lemma ts_lose_ack_st1:
  assumes h1:"lose t = [True] \<or> lose t = [False]"
  and h2:"lose t = [True]  \<longrightarrow>  ack t = [x]  \<and> st_out t = x"
  and h3:"lose t = [False] \<longrightarrow>  ack t = [y]  \<and> st_out t = y"
  shows "ack t = [st_out t]"
proof (cases "lose t = [False]")
  assume "lose t = [False]"
  from this and h3 show ?thesis by simp
next
  assume a2:"lose t \<noteq> [False]"
  from this and h1 have "lose t = [True]" by (simp add: ts_bool_True)
  from this and a2 and h2 show ?thesis by simp
qed

lemma ts_lose_ack_st2ts:
  assumes "ts lose"
         and "lose t = [True] \<longrightarrow>
                 ack t = [x]  \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = x"
        and "lose t = [False] \<longrightarrow>
               ack t = [y] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = y"
  shows "ack t = [st_out t]"
using assms
by (metis ts_bool_True_False)

lemma ts_lose_ack_st2:
  assumes h1:"lose t = [True] \<or> lose t = [False]"
         and h2:"lose t = [True] \<longrightarrow>
                ack t = [x]  \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = x"
         and h3:"lose t = [False] \<longrightarrow>
                ack t = [y] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = y"
  shows "ack t = [st_out t]"
proof (cases "lose t = [False]")
  assume "lose t = [False]"
  from this and h3 show ?thesis by simp
next
  assume a2:"lose t \<noteq> [False]"
  from this and h1 have "lose t = [True]" by (simp add: ts_bool_True)
  from this and a2 and h2 show ?thesis by simp
qed

lemma ts_lose_ack_st2vc_com:
assumes h1:"lose t = [True] \<or> lose t = [False]"
       and h2:"lose t = [True] \<longrightarrow>
             ack t = [x]  \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = x"
       and h3:"lose t = [False] \<longrightarrow>
             ack t = [y] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = y"
shows "ack t = [st_out t]"
proof (cases "lose t = [False]")
  assume "lose t = [False]"
  from this and h3 show ?thesis by simp
next
  assume a2:"lose t \<noteq> [False]"
  from this and h1 have ag1:"lose t = [True]" by (simp add: ts_bool_True)
  from this and a2 and h2 show ?thesis by simp
qed

lemma ts_lose_ack_st2send:
  assumes h1:"lose t = [True] \<or> lose t = [False]"
  and h2:"lose t = [True] \<longrightarrow>
      ack t = [x]  \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = x"
  and h3:"lose t = [False] \<longrightarrow>
      ack t = [y] \<and> i1 t = b t \<and> vc t = [] \<and> st_out t = y"
  shows "ack t = [st_out t]"
proof (cases "lose t = [False]")
  assume "lose t = [False]"
  from this and h3 show ?thesis by simp
next
  assume a2:"lose t \<noteq> [False]"
  from this and h1 have "lose t = [True]" by (simp add: ts_bool_True)
  from this and a2 and h2 show ?thesis by simp
qed

lemma tiTable_ack_st_splitten:
  assumes h1:"ts lose"
      and h2:"msg (Suc 0) a1"
      and h3:"msg (Suc 0) stop"
      and h4:"st_in t = init_state \<and> req t = [init] \<longrightarrow>
          ack t = [call] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = call"
      and h5:"st_in t = init_state \<and> req t \<noteq> [init] \<longrightarrow>
          ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
      and h6:"(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and> lose t = [False] \<longrightarrow>
          ack t = [connection_ok] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = connection_ok"
      and h7:"(st_in t = call \<or> st_in t = connection_ok \<or> st_in t = sending_data) \<and> lose t = [True] \<longrightarrow>
          ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
      and h8:"st_in t = connection_ok \<and> req t = [send] \<and> lose t = [False] \<longrightarrow>
          ack t = [sending_data] \<and> i1 t = b t \<and> vc t = [] \<and> st_out t = sending_data"
      and h9:"st_in t = sending_data \<and> a1 t = [] \<and> lose t = [False] \<longrightarrow>
          ack t = [sending_data] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = sending_data"
      and h10:"st_in t = sending_data \<and> a1 t = [sc_ack] \<and> lose t = [False] \<longrightarrow>
          ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = voice_com"
      and h11:"st_in t = voice_com \<and> stop t = [] \<and> lose t = [False] \<longrightarrow>
          ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = voice_com"
      and h12:"st_in t = voice_com \<and> stop t = [] \<and> lose t = [True] \<longrightarrow>
          ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = voice_com"
      and h13:"st_in t = voice_com \<and> stop t = [stop_vc] \<longrightarrow>
          ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
  shows "ack t = [st_out t]"
proof -
  from h1 and h6 and h7 have sg1:"lose t = [True] \<or> lose t = [False]"
    by (simp add: ts_bool_True_False)
show ?thesis
proof (cases "st_in t")
  assume a1:"st_in t = init_state"
  from a1 and h4 and h5 show ?thesis
  proof (cases "req t = [init]")
    assume a11:"req t = [init]"
    from a11 and a1 and h4 and h5 show ?thesis by simp
  next
    assume a12:"req t \<noteq> [init]"
    from a12 and a1 and h4 and h5 show ?thesis by simp
  qed
next
  assume a2:"st_in t = call"
  from a2 and sg1 and h6 and h7 show ?thesis
     apply simp
     by (rule ts_lose_ack_st2, assumption+)
next
  assume a3:"st_in t = connection_ok"
  from a3 and h6 and h7 and h8 show ?thesis apply simp
  proof (cases "req t = [send]")
    assume a31:"req t = [send]"
    from this and a3 and h6 and h7 and h8 and sg1 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2send, assumption+)
  next
    assume a32:"req t \<noteq> [send]"
    from this and a3 and h6 and h7 and h8 and sg1 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2, assumption+)
  qed
next
  assume a4:"st_in t = sending_data"
  from sg1 and a4 and h7 and h9 and h10  show ?thesis apply simp
  proof (cases "a1 t = []")
    assume a41:"a1 t = []"
    from this and a4 and sg1 and h7 and h9 and h10 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2, assumption+)
  next
    assume a42:"a1 t \<noteq> []"
    from this and h2  have "a1 t = [sc_ack]"  by (simp add: aType_nonempty)
    from this and a4 and a42 and sg1 and h7 and h9 and h10 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2vc_com, assumption+)
  qed
next
  assume a5:"st_in t = voice_com"
  from a5 and h11 and h12 and h13 show ?thesis
  apply simp
  proof (cases "stop t = []")
    assume a51:"stop t = []"
    from this and a5 and h11 and h12 and h13 and sg1 show ?thesis
      apply simp
      by (rule ts_lose_ack_st2vc_com, assumption+)
  next
    assume a52:"stop t \<noteq> []"
    from this and h3 have sg7:"stop t = [stop_vc]"
      by (simp add: stopType_nonempty)
    from this and a5 and a52 and h13 show ?thesis by simp
  qed
qed
qed

lemma tiTable_ack_st:
assumes "tiTable_SampleT req a1 stop lose st_in b ack i1 vc st_out"
       and tsLose:"ts lose"
       and a1Msg1:"msg (Suc 0) a1"
       and stopMsg1:"msg (Suc 0) stop"
  shows      "ack t = [st_out t] "
proof -
  from assms have sg1:
   "st_in t = init_state \<and> req t = [init] \<longrightarrow>
    ack t = [call] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = call"
     by (simp add: tiTable_SampleT_def)
  from assms have sg2:
   "st_in t = init_state \<and> req t \<noteq> [init] \<longrightarrow>
    ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
     by (simp add: tiTable_SampleT_def)
  from assms have sg3:
   "(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and>
     lose t = [False] \<longrightarrow>
     ack t = [connection_ok] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = connection_ok"
     by (simp add: tiTable_SampleT_def)
  from assms have sg4:
   "(st_in t = call \<or> st_in t = connection_ok \<or> st_in t = sending_data) \<and>
     lose t = [True] \<longrightarrow>
     ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
     by (simp add: tiTable_SampleT_def)
  from assms have sg5:
   "st_in t = connection_ok \<and> req t = [send] \<and> lose t = [False] \<longrightarrow>
    ack t = [sending_data] \<and> i1 t = b t \<and> vc t = [] \<and> st_out t = sending_data"
    by (simp add: tiTable_SampleT_def)
  from assms have sg6:
   "st_in t = sending_data \<and> a1 t = [] \<and> lose t = [False] \<longrightarrow>
    ack t = [sending_data] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = sending_data"
     by (simp add: tiTable_SampleT_def)
  from assms have sg7:
   "st_in t = sending_data \<and> a1 t = [sc_ack] \<and> lose t = [False] \<longrightarrow>
    ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = voice_com"
    by (simp add: tiTable_SampleT_def)
  from assms have sg8:
   "st_in t = voice_com \<and> stop t = [] \<and> lose t = [False] \<longrightarrow>
    ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [vc_com] \<and> st_out t = voice_com"
    by (simp add: tiTable_SampleT_def)
  from assms have sg9:
   "st_in t = voice_com \<and> stop t = [] \<and> lose t = [True] \<longrightarrow>
    ack t = [voice_com] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = voice_com"
    by (simp add: tiTable_SampleT_def)
  from assms have sg10:
   "st_in t = voice_com \<and> stop t = [stop_vc] \<longrightarrow>
    ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
    by (simp add: tiTable_SampleT_def)
  from tsLose and a1Msg1 and stopMsg1 and sg1 and sg2 and sg3 and sg4 and sg5 and
  sg6 and sg7 and sg8 and sg9 and sg10 show ?thesis
    by (rule tiTable_ack_st_splitten)
qed

lemma tiTable_ack_st_hd:
assumes "tiTable_SampleT req a1 stop lose st_in b ack i1 vc st_out"
       and "ts lose"
       and "msg (Suc 0) a1"
       and "msg (Suc 0) stop"
shows "st_out t =  hd (ack t)"
using assms by (simp add:  tiTable_ack_st)

lemma tiTable_ack_connection_ok:
  assumes tbl:"tiTable_SampleT req x stop lose st_in b ack i1 vc st_out"
      and ackCon:"ack t = [connection_ok]"
      and xMsg1:"msg (Suc 0) x"
      and tsLose:"ts lose"
      and stopMsg1:"msg (Suc 0) stop"
  shows "(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and>
         lose t = [False]"
proof -
  from tbl and tsLose have sg1:"lose t = [True] \<or> lose t = [False]"
    by (simp add: ts_bool_True_False)
  from tbl and xMsg1 have sg2:"x t = [] \<or> x t = [sc_ack]"
    by (simp add: aType_lemma)
  from tbl and stopMsg1 have sg3:"stop t = [] \<or> stop t = [stop_vc]"
    by (simp add: stopType_lemma)
  show ?thesis
  proof (cases "st_in t")
    assume a1:"st_in t = init_state"
    show ?thesis
    proof (cases "req t = [init]")
      assume a11:"req t = [init]"
      from tbl and a1 and a11 and ackCon show ?thesis by (simp add: tiTable_SampleT_def)
    next
      assume a12:"req t \<noteq> [init]"
      from tbl and a1 and a12 and ackCon show ?thesis by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a2:"st_in t = call"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a21:"lose t = [True]"
      from tbl and a2 and a21 and ackCon show ?thesis by (simp add: tiTable_SampleT_def)
    next
      assume a22:"lose t \<noteq> [True]"
      from this and tsLose have a22a:"lose t = [False]" by (simp add: ts_bool_False)
      from tbl have
       "(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and>
         lose t = [False] \<longrightarrow>
         ack t = [connection_ok] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = connection_ok"
         by (simp add: tiTable_SampleT_def)
      from this and a2 and a22a and ackCon show ?thesis by simp
    qed
  next
    assume a3:"st_in t = connection_ok"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a31:"lose t = [True]"
      from tbl have
       "(st_in t = call \<or> st_in t = connection_ok \<or> st_in t = sending_data) \<and>
         lose t = [True] \<longrightarrow>
         ack t = [init_state] \<and> i1 t = [] \<and> vc t = [] \<and> st_out t = init_state"
        by (simp add: tiTable_SampleT_def)
      from this and a3 and a31 and ackCon show ?thesis by simp
    next
      assume a32:"lose t \<noteq> [True]"
      from this and tsLose have a32a:"lose t = [False]" by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "req t = [send]")
        assume a321:"req t = [send]"
        from tbl and a3 and a32a and a321 and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a322:"req t \<noteq> [send]"
        from tbl and a3 and a32a and a322 and ackCon show ?thesis
           by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a4:"st_in t = sending_data"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a41:"lose t = [True]"
      from tbl and a4 and a41 and ackCon show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a42:"lose t \<noteq> [True]"
      from this and tsLose have a42a:"lose t = [False]" by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "x t = [sc_ack]")
        assume a421:"x t = [sc_ack]"
        from tbl and a4 and a42a and a421 and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a422:" x t \<noteq> [sc_ack]"
        from this and xMsg1 have a422a:"x t = []" by (simp add: aType_empty)
        from tbl and a4 and a42a and a422a and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a5:"st_in t = voice_com"
    show ?thesis
    proof (cases "stop t = [stop_vc]")
      assume a51:"stop t = [stop_vc]"
      from tbl and a5 and a51 and ackCon show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a52:"stop t \<noteq> [stop_vc]"
      from this and stopMsg1 have a52a:"stop t = []" by (simp add: stopType_empty)
      show ?thesis
      proof (cases "lose t = [True]")
        assume a521:"lose t = [True]"
        from tbl and a5 and a52a and a521 and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a522:"lose t \<noteq> [True]"
        from this and tsLose have a522a:"lose t = [False]" by (simp add: ts_bool_False)
        from tbl and a5 and a52a and a522a and ackCon show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  qed
qed

lemma tiTable_i1_1:
assumes tbl:"tiTable_SampleT req x stop lose st_in b ack i1 vc st_out"
       and "ts lose"
       and "msg (Suc 0) x"
       and "msg (Suc 0) stop"
       and "ack t = [connection_ok]"
shows "i1 t = []"
proof -
  from assms have
   "(st_in t = call \<or> st_in t = connection_ok \<and> req t \<noteq> [send]) \<and>
    lose t = [False]"
    by (simp add: tiTable_ack_connection_ok)
  from this and tbl show ?thesis by (simp add: tiTable_SampleT_def)
qed

lemma tiTable_ack_call:
assumes tbl:"tiTable_SampleT req x stop lose st_in b ack i1 vc st_out"
      and ackCall:"ack t = [call]"
      and xMsg1:"msg (Suc 0) x"
      and tsLose:"ts lose"
      and stopMsg1:"msg (Suc 0) stop"
shows "st_in t = init_state \<and> req t = [init]"
proof -
  from tbl and tsLose have sg1:"lose t = [True] \<or> lose t = [False]"
    by (simp add: ts_bool_True_False)
  from tbl and xMsg1 have sg2:"x t = [] \<or> x t = [sc_ack]"
    by (simp add: aType_lemma)
  from tbl and stopMsg1 have sg3:"stop t = [] \<or> stop t = [stop_vc]"
    by (simp add: stopType_lemma)
  show ?thesis
  proof (cases "st_in t")
    assume a1:"st_in t = init_state"
    show ?thesis
    proof (cases "req t = [init]")
      assume a11:"req t = [init]"
      from tbl and a1 and a11 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a12:"req t \<noteq> [init]"
      from tbl and a1 and a12 and ackCall show ?thesis
         by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a2:"st_in t = call"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a21:"lose t = [True]"
      from tbl and a2 and a21 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a22:"lose t \<noteq> [True]"
      from this and tsLose have a22a:"lose t = [False]"
         by (simp add: ts_bool_False)
      from tbl and a2 and a22a and ackCall show ?thesis
         by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a3:"st_in t = connection_ok"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a31:"lose t = [True]"
      from tbl and a3 and a31 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a32:"lose t \<noteq> [True]"
      from this and tsLose have a32a:"lose t = [False]"
        by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "req t = [send]")
        assume a321:"req t = [send]"
        from tbl and a3 and a32a and a321 and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a322:"req t \<noteq> [send]"
        from tbl and a3 and a32a and a322 and ackCall show ?thesis
           by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a4:"st_in t = sending_data"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a41:"lose t = [True]"
      from tbl and a4 and a41 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a42:"lose t \<noteq> [True]"
      from this and tsLose have a42a:"lose t = [False]"
        by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "x t = [sc_ack]")
        assume a421:"x t = [sc_ack]"
        from tbl and a4 and a42a and a421 and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a422:" x t \<noteq> [sc_ack]"
        from this and xMsg1  have a422a:"x t = []"
          by (simp add: aType_empty)
        from tbl and a4 and a42a and a422a and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a5:"st_in t = voice_com"
    show ?thesis
    proof (cases "stop t = [stop_vc]")
      assume a51:"stop t = [stop_vc]"
      from tbl and a5 and a51 and ackCall show ?thesis
        by (simp add: tiTable_SampleT_def)
    next
      assume a52:"stop t \<noteq> [stop_vc]"
      from this and stopMsg1 have a52a:"stop t = []" by (simp add: stopType_empty)
      show ?thesis
      proof (cases "lose t = [True]")
        assume a521:"lose t = [True]"
        from tbl and a5 and a52a and a521 and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a522:"lose t \<noteq> [True]"
        from this and tsLose have a522a:"lose t = [False]" by (simp add: ts_bool_False)
        from tbl and a5 and a52a and a522a and ackCall show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  qed
qed

lemma tiTable_i1_2:
assumes tbl:"tiTable_SampleT req a1 stop lose st_in b ack i1 vc st_out"
       and "ts lose"
       and "msg (Suc 0) a1"
       and "msg (Suc 0) stop"
       and "ack t = [call]"
shows "i1 t = []"
proof -
  from assms have "st_in t = init_state \<and> req t = [init]"
    by (simp add: tiTable_ack_call)
  from this and tbl show ?thesis
    by (simp add: tiTable_SampleT_def)
qed

lemma tiTable_ack_init0:
assumes tbl:"tiTable_SampleT req a1 stop lose
                  (fin_inf_append [init_state] st)
                   b ack i1 vc st"
      and req0:"req 0 = []"
shows "ack 0 = [init_state]"
proof -
  have "(fin_inf_append [init_state] st) (0::nat) = init_state"
    by (simp add: fin_inf_append_def)
  from tbl and this and req0 show ?thesis by (simp add: tiTable_SampleT_def)
qed

lemma tiTable_ack_init:
assumes "tiTable_SampleT req a1 stop lose
                  (fin_inf_append [init_state] st)
                   b ack i1 vc st"
      and "ts lose"
      and "msg (Suc 0) a1"
      and "msg (Suc 0) stop"
      and "\<forall> t1 \<le> t. req t1 = []"
shows "ack t = [init_state]"
using assms
proof (induction t)
  case 0
  from this show ?case
    by (simp add: tiTable_ack_init0)
next
  case (Suc t)
  from Suc have sg1: "st t =  hd (ack t)"
    by (simp add: tiTable_ack_st_hd)
  from Suc and sg1 have sg2:
   "(fin_inf_append [init_state] st) (Suc t) = init_state"
    by (simp add: correct_fin_inf_append2)
  from Suc and sg1 and sg2 show ?case
    by (simp add: tiTable_SampleT_def)
qed

lemma tiTable_i1_3:
assumes tbl:"tiTable_SampleT req x stop lose
                  (fin_inf_append [init_state] st)  b ack i1 vc st"
      and tsLose:"ts lose"
      and xMsg1:"msg (Suc 0) x"
      and stopMsg1:"msg (Suc 0) stop"
      and h5:"\<forall> t1 \<le> t. req t1 = []"
shows "i1 t = []"
proof -
  from assms have sg1:"ack t = [init_state]"
    by (simp add: tiTable_ack_init)
  from assms have sg2:"st t =  hd (ack t)"
    by (simp add: tiTable_ack_st_hd)
  from sg1 and sg2 have sg3:
   "(fin_inf_append [init_state] st) (Suc t) = init_state"
    by (simp add: correct_fin_inf_append2)
  from tbl and tsLose have sg4:"lose t = [True] \<or> lose t = [False]"
    by (simp add: ts_bool_True_False)
  from tbl and xMsg1 have sg5:"x t = [] \<or> x t = [sc_ack]"
    by (simp add: aType_lemma)
  from tbl and stopMsg1 have sg6:"stop t = [] \<or> stop t = [stop_vc]"
    by (simp add: stopType_lemma)
  show ?thesis
  proof (cases "fin_inf_append [init_state] st t")
    assume a1:"fin_inf_append [init_state] st t = init_state"
    from assms and sg1 and sg2 and sg3 and a1 show ?thesis
      by (simp add:  tiTable_SampleT_def)
  next
    assume a2:"fin_inf_append [init_state] st t = call"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a21:"lose t = [True]"
      from tbl and a2 and a21 show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a22:"lose t \<noteq> [True]"
      from this and tsLose have a22a:"lose t = [False]"
        by (simp add: ts_bool_False)
      from tbl and a2 and a22a show ?thesis
        by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a3:"fin_inf_append [init_state] st t = connection_ok"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a31:"lose t = [True]"
      from tbl and a3 and a31 show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a32:"lose t \<noteq> [True]"
      from this and tsLose have a32a:"lose t = [False]"
         by (simp add: ts_bool_False)
      from h5 have a322:"req t \<noteq> [send]" by auto
      from tbl and a3 and a32a and a322 show ?thesis
        by (simp add: tiTable_SampleT_def)
    qed
  next
    assume a4:"fin_inf_append [init_state] st t = sending_data"
    show ?thesis
    proof (cases "lose t = [True]")
      assume a41:"lose t = [True]"
      from tbl and a4 and a41 show ?thesis by (simp add: tiTable_SampleT_def)
    next
      assume a42:"lose t \<noteq> [True]"
      from this and tsLose have a42a:"lose t = [False]" by (simp add: ts_bool_False)
      show ?thesis
      proof (cases "x t = [sc_ack]")
        assume a421:"x t = [sc_ack]"
        from tbl and a4 and a42a and a421 and tsLose show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a422:" x t \<noteq> [sc_ack]"
        from this and xMsg1 have a422a:"x t = []" by (simp add: aType_empty)
        from tbl and a4 and a42a and a422a and tsLose show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  next
    assume a5:"fin_inf_append [init_state] st t = voice_com"
    show ?thesis
    proof (cases "stop t = [stop_vc]")
      assume a51:"stop t = [stop_vc]"
      from tbl and a5 and a51 and tsLose show ?thesis
         by (simp add: tiTable_SampleT_def)
    next
      assume a52:"stop t \<noteq> [stop_vc]"
      from this and stopMsg1 have a52a:"stop t = []" by (simp add: stopType_empty)
      show ?thesis
      proof (cases "lose t = [True]")
        assume a521:"lose t = [True]"
        from tbl and a5 and a52a and a521 and tsLose show ?thesis
          by (simp add: tiTable_SampleT_def)
      next
        assume a522:"lose t \<noteq> [True]"
        from this and tsLose have a522a:"lose t = [False]" by (simp add: ts_bool_False)
        from tbl and a5 and a52a and a522a and tsLose show ?thesis
          by (simp add: tiTable_SampleT_def)
      qed
    qed
  qed
qed

lemma tiTable_st_call_ok:
assumes tbl:"tiTable_SampleT req x stop lose
                  (fin_inf_append [init_state] st)
                   b ack i1 vc st"
      and tsLose:"ts lose"
      and h3:"\<forall>m \<le> k. ack (Suc (Suc (t + m))) = [connection_ok]"
      and h4:"st (Suc t) = call"
shows "st (Suc (Suc t)) = connection_ok"
proof -
    from h4 have sg1:
     "(fin_inf_append [init_state] st) (Suc (Suc t)) = call"
      by (simp add: correct_fin_inf_append2)
   from tbl and tsLose have sg2:"lose (Suc (Suc t)) = [True] \<or> lose (Suc (Suc t)) = [False]"
    by (simp add: ts_bool_True_False)
   show ?thesis
   proof (cases "lose (Suc (Suc t)) = [False]")
     assume a1:"lose (Suc (Suc t)) = [False]"
     from tbl and a1 and sg1 show ?thesis
       by (simp add: tiTable_SampleT_def)
   next
     assume a2:"lose (Suc (Suc t)) \<noteq> [False]"
     from h3 have sg3:"ack (Suc (Suc t)) = [connection_ok]" by auto
     from tbl and a2 and sg1 and sg2 and sg3 show ?thesis
       by (simp add: tiTable_SampleT_def)
   qed
qed

lemma tiTable_i1_4b:
assumes "tiTable_SampleT req x stop lose
                  (fin_inf_append [init_state] st) b ack i1 vc st"
      and "ts lose"
      and "msg (Suc 0) x"
      and "msg (Suc 0) stop"
      and "\<forall> t1 \<le> t. req t1 = []"
      and "req (Suc t) = [init]"
      and "\<forall>m < k + 3. req (t + m) \<noteq> [send]"
      and h7:"\<forall>m \<le> k. ack (Suc (Suc (t + m))) = [connection_ok]"
      and "\<forall>j \<le> k + 3. lose (t + j) = [False]"
      and h9:"t2 < (t + 3 + k)"
shows "i1 t2 = []"
proof (cases "t2 \<le> t")
  assume "t2 \<le> t"
  from assms and this show ?thesis by (simp add: tiTable_i1_3)
next
  assume a2:"\<not> t2 \<le> t"
  from assms have sg1:"ack t = [init_state]" by (simp add: tiTable_ack_init)
  from assms have sg2:"st t =  hd (ack t)" by (simp add: tiTable_ack_st_hd)
  from sg1 and sg2 have sg3:
   "(fin_inf_append [init_state] st) (Suc t) = init_state"
    by (simp add: correct_fin_inf_append2)
  from assms and sg3 have sg4:"st (Suc t) = call"
    by (simp add: tiTable_SampleT_def)
  show ?thesis
  proof (cases "t2 = Suc t")
    assume a3:"t2 = Suc t"
    from assms and sg3 and a3 show ?thesis
      by (simp add: tiTable_SampleT_def)
  next
    assume a4:"t2 \<noteq> Suc t"
    from assms and sg4 and a4 and a2 have sg7:"st (Suc (Suc t)) = connection_ok"
      by (simp add: tiTable_st_call_ok)
    from assms have sg8:"ack (Suc (Suc t)) = [st (Suc (Suc t))]"
      by (simp add: tiTable_ack_st)
    show ?thesis
    proof (cases "t2 =  Suc (Suc t)")
      assume a5:"t2 =  Suc (Suc t)"
      from h7 and h9 and a5 have sg9:"ack t2 = [connection_ok]" by auto
      from assms and sg9 show ?thesis by (simp add:  tiTable_i1_1)
    next
      assume a6:"t2 \<noteq> Suc (Suc t)"
      from a6 and a4 and a2 have sg10:"Suc (Suc t) < t2" by arith
      from h7 and h9 and sg10 have sg11:"ack t2 = [connection_ok]"
        by (simp add: aux_ack_t2)
      from assms and a6 and sg7 and sg8 and sg11 show ?thesis
        by (simp add:  tiTable_i1_1)
    qed
  qed
qed

lemma tiTable_i1_4:
assumes "tiTable_SampleT req a1 stop lose
                  (fin_inf_append [init_state] st) b ack i1 vc st"
      and "ts lose"
      and "msg (Suc 0) a1"
      and "msg (Suc 0) stop"
      and "\<forall> t1 \<le> t. req t1 = []"
      and "req (Suc t) = [init]"
      and "\<forall>m < k + 3. req (t + m) \<noteq> [send]"
      and "\<forall>m \<le> k. ack (Suc (Suc (t + m))) = [connection_ok]"
      and "\<forall>j \<le> k + 3. lose (t + j) = [False]"
shows "\<forall> t2 < (t + 3 + k). i1 t2 = []"
using assms by (simp add: tiTable_i1_4b)

lemma tiTable_ack_ok:
  assumes h1:"\<forall>j\<le> d + 2. lose (t + j) = [False]"
      and tsLose:"ts lose"
      and stopMsg1:"msg (Suc 0) stop"
      and a1Msg1:"msg (Suc 0) a1"
      and reqNsend:"req (Suc t) \<noteq> [send]"
      and ackCon:"ack t = [connection_ok]"
      and tbl:"tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st) b ack i1 vc st"
  shows "ack (Suc t) = [connection_ok]"
proof -
  from tbl and tsLose and a1Msg1 and stopMsg1 have "st t =  hd (ack t)"
    by (simp add: tiTable_ack_st_hd)
  from this and ackCon have sg2:
   "(fin_inf_append [init_state] st) (Suc t) =  connection_ok"
    by (simp add: correct_fin_inf_append2)
  have sg3a:"Suc 0 \<le> d + 2" by arith
  from h1 and sg3a have sg3:"lose (t + Suc 0) = [False]" by auto
  from sg2 and sg3 and reqNsend and tbl show ?thesis
    by (simp add: tiTable_SampleT_def)
qed

lemma Gateway_L7a:
  assumes gw:"Gateway req dt a stop lose d ack i vc"
      and aMsg1:"msg (Suc 0) a"
      and stopMsg1:"msg (Suc 0) stop"
      and reqMsg1:"msg (Suc 0) req"
      and tsLose:"ts lose"
      and loseFalse:"\<forall>j\<le> d + 2. lose (t + j) = [False]"
      and nsend:"req (Suc t) \<noteq> [send]"
      and ackNCon:"ack (t) = [connection_ok]"
  shows "ack (Suc t) = [connection_ok]"
proof -
  from gw and stopMsg1 and reqMsg1 and nsend obtain i1 i2 a1 a2 where
    ah1:"Sample req dt a1 stop lose ack i1 vc" and
    ah2:"Delay a2 i1 d a1 i2" and
    ah3:"Loss lose a i2 a2 i"
    by (simp add: Gateway_def, auto)
  from ah2 and ah3 and aMsg1 have sg1:"msg (Suc 0) a1"
    by (simp add: Loss_Delay_msg_a)
  from ah1 and sg1 and stopMsg1 and reqMsg1 obtain st buffer where
    ah4:"Sample_L req dt a1 stop lose (fin_inf_append [init_state] st)
             (fin_inf_append [[]] buffer)
             ack i1 vc st buffer"
    by (simp add: Sample_def, auto)
  from ah4 have sg2:
    "tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
         (fin_inf_append [[]] buffer)
         ack i1 vc st"
    by (simp add: Sample_L_def)
  from loseFalse and tsLose and stopMsg1 and sg1 and
           nsend and ackNCon and sg2 show ?thesis
    by (simp add: tiTable_ack_ok)
qed

lemma Sample_L_buffer:
  assumes
    "Sample_L req dt a1 stop lose (fin_inf_append [init_state] st)
          (fin_inf_append [[]] buffer)
           ack i1 vc st buffer"
  shows "buffer t = inf_last_ti dt t"
proof -
  from assms have
   "\<forall>t. buffer t =
    (if dt t = [] then fin_inf_append [[]] buffer t else dt t)"
    by (simp add: Sample_L_def)
  from this show ?thesis
  proof (induct t)
    case 0
    from this show ?case
      by (simp add: fin_inf_append_def)
  next
    fix t
    case (Suc t)
    from this show ?case
    proof (cases "dt t = []")
      assume "dt t = []"
      from this and Suc show ?thesis
        by (simp add: correct_fin_inf_append1)
    next
      assume "dt t \<noteq> []"
      from this and Suc show ?thesis
        by (simp add: correct_fin_inf_append1)
    qed
  qed
qed

lemma  tiTable_SampleT_i1_buffer:
 assumes "ack t = [connection_ok]"
        and reqSend:"req (Suc t) = [send]"
        and loseFalse:"\<forall>k\<le>Suc d. lose (t + k) = [False]"
        and buf: "buffer t = inf_last_ti dt t"
        and tbl:"tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
      (fin_inf_append [[]] buffer) ack
      i1 vc st"
     and conOk:"fin_inf_append [init_state] st (Suc t) = connection_ok"
shows "i1 (Suc t) = inf_last_ti dt t"
proof -
  have sg1:"Suc 0 \<le>Suc d" by arith
  from loseFalse and sg1 have sg2:"lose (Suc t) = [False]" by auto
  from tbl have
   "fin_inf_append [init_state] st (Suc t) = connection_ok \<and>
    req (Suc t) = [send] \<and>
    lose (Suc t) = [False] \<longrightarrow>
    ack (Suc t) = [sending_data] \<and>
    i1 (Suc t) = (fin_inf_append [[]] buffer) (Suc t) \<and>
    vc (Suc t) = [] \<and> st (Suc t) = sending_data"
    by (simp add: tiTable_SampleT_def)
  from this and conOk and reqSend and sg2 have
   "i1 (Suc t) = (fin_inf_append [[]] buffer) (Suc t)" by simp
  from this and buf show ?thesis by (simp add: correct_fin_inf_append1)
qed

lemma Sample_L_i1_buffer:
  assumes "msg (Suc 0) req"
      and "msg (Suc 0) a"
      and stopMsg1:"msg (Suc 0) stop"
      and a1Msg1:"msg (Suc 0) a1"
      and tsLose:"ts lose"
      and ackCon:"ack t = [connection_ok]"
      and reqSend:"req (Suc t) = [send]"
      and loseFalse:"\<forall>k\<le>Suc d. lose (t + k) = [False]"
      and smpl:"Sample_L req dt a1 stop lose
                (fin_inf_append [init_state] st)
                (fin_inf_append [[]] buffer) ack i1 vc st buffer"
  shows "i1 (Suc t) =  buffer t"
proof -
  from smpl have sg1:"buffer t = inf_last_ti dt t"
    by (simp add: Sample_L_buffer)
  from smpl have sg2:
    "\<forall>t. buffer t = (if dt t = [] then fin_inf_append [[]] buffer t else dt t)"
    by (simp add: Sample_L_def)
  from smpl have sg3:
    "tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
      (fin_inf_append [[]] buffer) ack
      i1 vc st"
    by (simp add: Sample_L_def)
  from sg3 and tsLose and a1Msg1 and stopMsg1 have sg4:"st t =  hd (ack t)"
    by (simp add: tiTable_ack_st_hd)
  from ackCon and sg4 have sg5:
    "(fin_inf_append [init_state] st) (Suc t) = connection_ok"
    by (simp add: correct_fin_inf_append1)
  from ackCon and reqSend and loseFalse and sg1 and
           sg3 and sg4 and sg5 have sg6:
    "i1 (Suc t) = inf_last_ti dt t"
     by (simp add: tiTable_SampleT_i1_buffer)
  from this and sg1 show ?thesis by simp
qed

lemma tiTable_SampleT_sending_data:
  assumes tbl: "tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
         (fin_inf_append [[]] buffer)
         ack i1 vc st"
      and loseFalse:"\<forall>j\<le>2 * d. lose (t + j) = [False]"
      and a1e:"\<forall>t4\<le>t + d + d. a1 t4 = []"
      and snd:"fin_inf_append [init_state] st (Suc (t + x)) = sending_data"
      and h6:"Suc (t + x) \<le> 2 * d + t"
  shows "ack (Suc (t + x)) = [sending_data]"
proof -
  from h6 have "Suc x \<le> 2 * d" by arith
  from this and loseFalse have sg1:"lose (t + Suc x) = [False]" by auto
  from h6 have "Suc (t + x) \<le>t + d + d" by arith
  from this and a1e have sg2:"a1 (Suc (t + x)) = []" by auto
  from tbl and sg1 and sg2 and snd show ?thesis
    by (simp add: tiTable_SampleT_def)
qed

lemma Sample_sending_data:
  assumes stopMsg1:"msg (Suc 0) stop"
      and tsLose:"ts lose"
      and reqMsg1:"msg (Suc 0) req"
      and a1Msg1:"msg (Suc 0) a1"
      and loseFalse:"\<forall>j\<le>2 * d. lose (t + j) = [False]"
      and ackSnd:"ack t = [sending_data]"
      and smpl:"Sample req dt a1 stop lose ack i1 vc"
      and xdd:"x \<le> d + d"
      and h9:"\<forall>t4 \<le> t + d + d. a1 t4 = []"
 shows "ack (t + x) = [sending_data]"
using assms
proof -
  from stopMsg1 and reqMsg1 and a1Msg1 and smpl obtain st buffer where a1:
   "Sample_L req dt a1 stop lose (fin_inf_append [init_state] st)
             (fin_inf_append [[]] buffer) ack
             i1 vc st buffer"
    by (simp add: Sample_def, auto)
  from a1 have sg1:
    "tiTable_SampleT req a1 stop lose (fin_inf_append [init_state] st)
        (fin_inf_append [[]] buffer)
         ack i1 vc st"
     by (simp add: Sample_L_def)
  from a1 have sg2:
    "\<forall>t. buffer t = (if dt t = [] then fin_inf_append [[]] buffer t else dt t)"
     by (simp add: Sample_L_def)
  from stopMsg1 and tsLose and a1Msg1 and ackSnd and xdd and sg1 and sg2 show ?thesis
  proof (induct "x")
    case 0
    from this show ?case by simp
  next
    fix x
    case (Suc x)
    from this have sg3:"st (t + x) = hd (ack (t + x))"
      by (simp add: tiTable_ack_st_hd)
    from Suc have sg4:"x \<le> d + d" by arith
    from Suc and sg3 and sg4 have sg5:
     "(fin_inf_append [init_state] st) (Suc (t + x)) = sending_data"
      by (simp add: fin_inf_append_def)
    from Suc have sg6:"Suc (t + x) \<le> 2 * d + t" by simp
    from Suc have sg7:"ack (t + x) = [sending_data]" by simp
    from sg1 and loseFalse and h9 and sg7 and sg5 and sg6 have sg7:
     "ack (Suc (t + x)) = [sending_data]"
      by (simp add: tiTable_SampleT_sending_data)
    from this show ?case by simp
  qed
qed

subsection {* Properties of the ServiceCenter component *}

lemma ServiceCenter_a_l:
  assumes "ServiceCenter i a"
  shows    "length (a t) \<le> (Suc 0)"
proof (cases "t")
  case 0
  from this and assms show ?thesis by (simp add: ServiceCenter_def)
next
  fix m assume "t = Suc m"
  from this and assms show ?thesis by (simp add: ServiceCenter_def)
qed

lemma ServiceCenter_a_msg:
  assumes "ServiceCenter i a"
  shows    "msg (Suc 0) a"
using assms
by (simp add: msg_def ServiceCenter_a_l)

lemma ServiceCenter_L1:
assumes "\<forall> t2 < x. i t2 = []"
       and "ServiceCenter i a"
       and "t \<le> x"
shows "a t = []"
using assms
proof (induct t)
   case 0
   from this show ?case by (simp add: ServiceCenter_def)
next
   case (Suc t)
   from this show ?case by (simp add: ServiceCenter_def)
qed

lemma ServiceCenter_L2:
assumes "\<forall> t2 < x. i t2 = []"
       and "ServiceCenter i a"
shows "\<forall> t3 \<le> x. a t3 = []"
using assms
by (clarify, simp add: ServiceCenter_L1)

subsection {* General properties of stream values *}

lemma streamValue1:
assumes h1:"\<forall>j\<le> D + (z::nat). str (t + j) = x"
       and h2: "j\<le> D"
shows      "str (t + j + z) = x"
proof -
    from h2 have sg1:" j + z \<le> D + z" by arith
    have sg2:"t + j + z = t + (j + z)" by arith
    from h1 and sg1 and sg2 show ?thesis by (simp (no_asm_simp))
qed

lemma streamValue2:
  assumes "\<forall>j\<le> D + (z::nat). str (t + j) = x"
  shows    "\<forall>j\<le> D. str (t + j + z) = x"
using assms by (clarify, simp add: streamValue1)

lemma streamValue3:
assumes "\<forall>j\<le> D. str (t + j + (Suc y)) = x"
        and "j \<le> D"
        and h3:"str (t + y) = x"
    shows    "str (t + j + y) = x"
using assms
proof (induct j)
  case 0
  from h3 show ?case by simp
next
  case (Suc j)
  from this show ?case by auto
qed

lemma streamValue4:
assumes "\<forall>j\<le> D. str (t + j + (Suc y)) = x"
       and "str (t + y) = x"
shows     "\<forall>j\<le> D. str (t + j + y) = x"
using assms
by (clarify, hypsubst_thin, simp add: streamValue3)

lemma streamValue5:
assumes "\<forall>j\<le> D. str (t + j + ((i::nat) + k)) = x"
       and "j\<le> D"
shows      "str (t + i + k + j) = x"
using assms
by (metis add.commute add.left_commute)

lemma streamValue6:
  assumes "\<forall>j\<le> D. str (t + j + ((i::nat) + k)) = x"
  shows     "\<forall>j\<le> D. str (t + (i::nat) + k + j) = x"
using assms by (clarify, simp add: streamValue5)

lemma streamValue7:
  assumes h1:"\<forall>j\<le>d. str (t + i + k + d + Suc j) = x"
      and h2:"str (t + i + k + d) = x"
      and h3:"j\<le> Suc d"
  shows      "str (t + i + k + d + j) = x"
proof -
  from h1 have sg1:"str (t + i + k + d + Suc d) = x"
     by (simp (no_asm_simp), simp)
  from assms show ?thesis
  proof (cases "j = Suc d")
    assume a1:"j = Suc d"
    from a1 and sg1 show ?thesis by simp
  next
    assume a2:"j \<noteq> Suc d"
    from a2 and h3 have sg2:"j\<le>d" by auto
    from assms and sg2 show ?thesis
    proof (cases "j > 0")
      assume a3:"0 < j"
      from a3 and h3 have sg3:"j - (1::nat) \<le> d" by simp
      from a3 have sg4:"Suc (j - (1::nat)) = j"  by arith
      from sg3 and h1 and sg4 have sg5:"str (t + i + k + d + j) = x" by auto
      from sg5 show ?thesis by simp
    next
      assume a4:"\<not> 0 < j"
      from a4 have sg6:"j = 0" by simp
      from h2 and sg6 show ?thesis by simp
    qed
  qed
qed

lemma streamValue8:
assumes "\<forall>j\<le>d. str (t + i + k + d + Suc j) = x"
       and "str (t + i + k + d) = x"
shows "\<forall> j\<le> Suc d. str (t + i + k + d + j) = x"
using assms streamValue7
  by metis

lemma arith_streamValue9aux:
"Suc (t + (j + d) + (i + k)) =  Suc (t + i + k + d + j)"
by arith

lemma streamValue9:
assumes h1:"\<forall>j\<le>2 * d. str (t + j + Suc (i + k)) = x"
       and h2:"j\<le>d"
shows      "str (t + i + k + d + Suc j) = x"
proof -
  from h2 have "(j+d) \<le>2 * d" by arith
  from h1 and this have "str (t + (j + d) + Suc (i + k)) = x" by auto
  from this show ?thesis  by (simp add: arith_streamValue9aux)
qed

lemma streamValue10:
  assumes "\<forall>j\<le>2 * d. str (t + j + Suc (i + k)) = x"
  shows    "\<forall>j\<le>d. str (t + i + k + d + Suc j) = x"
using assms
  apply clarify
  by (rule streamValue9, auto)

lemma arith_sum1:"(t::nat) + (i + k + d) =  t + i + k + d"
by arith

lemma arith_sum2:"Suc (Suc (t + k + j)) = Suc (Suc (t + (k + j)))"
by arith

lemma arith_sum4:"t + 3 + k + d = Suc (t + (2::nat) + k + d)"
by arith

lemma streamValue12:
 assumes  "\<forall>j\<le>2 * d + (4 + k). lose (t + j) = x"
 shows     "\<forall>j\<le>Suc d. lose (t + 2 + k + j) = x"
using assms
  apply clarify
  by (rule streamValue11, auto)

lemma streamValue43:
  assumes "\<forall>j\<le>2 * d + ((4::nat) + k). lose (t + j) = [False]"
  shows    "\<forall>j\<le>2 * d. lose ((t + (3::nat) + k) + j) = [False]"
proof -
  from assms have sg1:"\<forall>j\<le>2 * d. lose (t + j + (4 + k)) = [False]"
    by (simp add: streamValue2)
  have sg2:"Suc (3 + k) = (4 + k)" by arith
  from sg1 and sg2 have sg3:"\<forall>j\<le>2 * d. lose (t + j + Suc (3 + k)) = [False]"
    by (simp (no_asm_simp))
  from assms have sg4:"lose (t + (3 + k)) = [False]" by auto
  from sg3 and sg4 have sg5:"\<forall>j\<le>2 * d. lose (t + j + (3 + k)) = [False]"
    by (rule streamValue4)
  from sg5 show ?thesis by (rule streamValue6)
qed

end


(*  Title:      FOL/ex/If.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1991  University of Cambridge
*)

section \<open>First-Order Logic: the 'if' example\<close>

theory If
imports FOL
begin

definition "if" :: "[o,o,o]=>o"
  where "if(P,Q,R) \<equiv> P \<and> Q \<or> \<not> P \<and> R"

lemma ifI: "\<lbrakk>P \<Longrightarrow> Q; \<not> P \<Longrightarrow> R\<rbrakk> \<Longrightarrow> if(P,Q,R)"
  unfolding if_def by blast

lemma ifE: "\<lbrakk>if(P,Q,R); \<lbrakk>P; Q\<rbrakk> \<Longrightarrow> S; \<lbrakk>\<not> P; R\<rbrakk> \<Longrightarrow> S\<rbrakk> \<Longrightarrow> S"
  unfolding if_def by blast

lemma if_commute: "if(P, if(Q,A,B), if(Q,C,D)) \<longleftrightarrow> if(Q, if(P,A,C), if(P,B,D))"
  apply (rule iffI)
  apply (erule ifE)
  apply (erule ifE)
  apply (rule ifI)
  apply (rule ifI)
  oops

text\<open>Trying again from the beginning in order to use \<open>blast\<close>\<close>
declare ifI [intro!]
declare ifE [elim!]

lemma if_commute: "if(P, if(Q,A,B), if(Q,C,D)) \<longleftrightarrow> if(Q, if(P,A,C), if(P,B,D))"
  by blast

lemma "if(if(P,Q,R), A, B) \<longleftrightarrow> if(P, if(Q,A,B), if(R,A,B))"
  by blast

text\<open>Trying again from the beginning in order to prove from the definitions\<close>
lemma "if(if(P,Q,R), A, B) \<longleftrightarrow> if(P, if(Q,A,B), if(R,A,B))"
  unfolding if_def by blast

text \<open>An invalid formula. High-level rules permit a simpler diagnosis.\<close>
lemma "if(if(P,Q,R), A, B) \<longleftrightarrow> if(P, if(Q,A,B), if(R,B,A))"
  apply auto
    \<comment> \<open>The next step will fail unless subgoals remain\<close>
  apply (tactic all_tac)
  oops

text \<open>Trying again from the beginning in order to prove from the definitions.\<close>
lemma "if(if(P,Q,R), A, B) \<longleftrightarrow> if(P, if(Q,A,B), if(R,B,A))"
  unfolding if_def
  apply auto
    \<comment> \<open>The next step will fail unless subgoals remain\<close>
  apply (tactic all_tac)
  oops

end


(*  Title:      HOL/Import/HOL_Light_Maps.thy
    Author:     Cezary Kaliszyk, University of Innsbruck
    Author:     Alexander Krauss, QAware GmbH

Based on earlier code by Steven Obua and Sebastian Skalberg
*)

section {* Type and constant mappings of HOL Light importer *}

theory HOL_Light_Maps
imports Import_Setup
begin

lemma [import_const T]:
  "True = ((\<lambda>p :: bool. p) = (\<lambda>p. p))"
  by simp

lemma [import_const "/\\"]:
  "(op \<and>) = (\<lambda>p q. (\<lambda>f. f p q \<Colon> bool) = (\<lambda>f. f True True))"
  by metis

lemma [import_const "==>"]:
  "(op \<longrightarrow>) = (\<lambda>(p\<Colon>bool) q\<Colon>bool. (p \<and> q) = p)"
  by auto

lemma [import_const "!"]:
  "All = (\<lambda>P\<Colon>'A \<Rightarrow> bool. P = (\<lambda>x\<Colon>'A. True))"
  by auto

lemma [import_const "?"]:
  "Ex = (\<lambda>P\<Colon>'A \<Rightarrow> bool. All (\<lambda>q\<Colon>bool. (All (\<lambda>x\<Colon>'A\<Colon>type. (P x) \<longrightarrow> q)) \<longrightarrow> q))"
  by auto

lemma [import_const "\\/"]:
  "(op \<or>) = (\<lambda>p q. \<forall>r. (p \<longrightarrow> r) \<longrightarrow> (q \<longrightarrow> r) \<longrightarrow> r)"
  by auto

lemma [import_const F]:
  "False = (\<forall>p. p)"
  by auto

lemma [import_const "~"]:
  "Not = (\<lambda>p. p \<longrightarrow> False)"
  by simp

lemma [import_const "?!"]:
  "Ex1 = (\<lambda>P\<Colon>'A \<Rightarrow> bool. Ex P \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> x = y))"
  by auto

lemma [import_const "_FALSITY_"]: "False = False"
  by simp

lemma hl_ax1: "\<forall>t\<Colon>'A \<Rightarrow> 'B. (\<lambda>x. t x) = t"
  by metis

lemma hl_ax2: "\<forall>P x\<Colon>'A. P x \<longrightarrow> P (Eps P)"
  by (auto intro: someI)

lemma [import_const COND]:
  "If = (\<lambda>t (t1 :: 'A) t2. SOME x. (t = True \<longrightarrow> x = t1) \<and> (t = False \<longrightarrow> x = t2))"
  unfolding fun_eq_iff by auto

lemma [import_const o]:
  "(op \<circ>) = (\<lambda>(f\<Colon>'B \<Rightarrow> 'C) g x\<Colon>'A. f (g x))"
  unfolding fun_eq_iff by simp

lemma [import_const I]: "id = (\<lambda>x\<Colon>'A. x)"
  by auto

lemma [import_type 1 one_ABS one_REP]:
  "type_definition Rep_unit Abs_unit (Collect (\<lambda>b. b))"
  by (metis (full_types) Collect_cong singleton_conv2 type_definition_unit)

lemma [import_const one]: "() = (SOME x\<Colon>unit. True)"
  by auto

lemma [import_const mk_pair]:
  "Pair_Rep = (\<lambda>(x\<Colon>'A) (y\<Colon>'B) (a\<Colon>'A) b\<Colon>'B. a = x \<and> b = y)"
  by (simp add: Pair_Rep_def fun_eq_iff)

lemma [import_type prod ABS_prod REP_prod]:
  "type_definition Rep_prod Abs_prod (Collect (\<lambda>x\<Colon>'A \<Rightarrow> 'B \<Rightarrow> bool. \<exists>a b. x = Pair_Rep a b))"
  using type_definition_prod[unfolded Product_Type.prod_def] by simp

lemma [import_const ","]: "Pair = (\<lambda>(x\<Colon>'A) y\<Colon>'B. Abs_prod (Pair_Rep x y))"
  by (metis Pair_def)

lemma [import_const FST]:
  "fst = (\<lambda>p\<Colon>'A \<times> 'B. SOME x\<Colon>'A. \<exists>y\<Colon>'B. p = (x, y))"
  by auto

lemma [import_const SND]:
  "snd = (\<lambda>p\<Colon>'A \<times> 'B. SOME y\<Colon>'B. \<exists>x\<Colon>'A. p = (x, y))"
  by auto

lemma CURRY_DEF[import_const CURRY]:
  "curry = (\<lambda>(f\<Colon>'A \<times> 'B \<Rightarrow> 'C) x y. f (x, y))"
  using curry_def .

lemma [import_const ONE_ONE : inj]:
  "inj = (\<lambda>(f\<Colon>'A \<Rightarrow> 'B). \<forall>x1 x2. f x1 = f x2 \<longrightarrow> x1 = x2)"
  by (auto simp add: fun_eq_iff inj_on_def)

lemma [import_const ONTO : surj]:
  "surj = (\<lambda>(f\<Colon>'A \<Rightarrow> 'B). \<forall>y. \<exists>x. y = f x)"
  by (auto simp add: fun_eq_iff)

lemma hl_ax3: "\<exists>f\<Colon>ind \<Rightarrow> ind. inj f \<and> \<not> surj f"
  by (rule_tac x="Suc_Rep" in exI)
     (metis Suc_Rep_inject' injI Suc_Rep_not_Zero_Rep surjD)

import_type_map num : nat
import_const_map "_0" : zero_class.zero
import_const_map SUC : Suc

lemma NOT_SUC: "\<forall>n. Suc n \<noteq> 0"
  by simp

lemma SUC_INJ: "\<forall>m n. (Suc m = Suc n) = (m = n)"
  by simp

lemma num_INDUCTION:
  "\<forall>P. P 0 \<and> (\<forall>n. P n \<longrightarrow> P (Suc n)) \<longrightarrow> (\<forall>n. P n)"
  by (auto intro: nat.induct)

lemma [import_const NUMERAL]: "id = (\<lambda>x :: nat. x)"
  by auto

definition [simp]: "bit0 n = 2 * n"

lemma [import_const BIT0]:
  "bit0 = (SOME fn. fn (id 0) = id 0 \<and> (\<forall>n. fn (Suc n) = Suc (Suc (fn n))))"
  apply (auto intro!: some_equality[symmetric])
  apply (auto simp add: fun_eq_iff)
  apply (induct_tac x)
  apply auto
  done

definition [import_const BIT1, simp]:
  "bit1 = (\<lambda>x. Suc (bit0 x))"

definition [simp]: "pred n = n - 1"

lemma PRE[import_const PRE : pred]:
  "pred (id (0\<Colon>nat)) = id (0\<Colon>nat) \<and> (\<forall>n\<Colon>nat. pred (Suc n) = n)"
  by simp

lemma ADD[import_const "+" : plus]:
  "(\<forall>n :: nat. (id 0) + n = n) \<and> (\<forall>m n. (Suc m) + n = Suc (m + n))"
  by simp

lemma MULT[import_const "*" : times]:
  "(\<forall>n :: nat. (id 0) * n = id 0) \<and> (\<forall>m n. (Suc m) * n = (m * n) + n)"
  by simp

lemma EXP[import_const EXP : power]:
  "(\<forall>m. m ^ (id 0) = id (bit1 0)) \<and> (\<forall>(m :: nat) n. m ^ (Suc n) = m * (m ^ n))"
  by simp

lemma LE[import_const "<=" : less_eq]:
  "(\<forall>m :: nat. m \<le> (id 0) = (m = id 0)) \<and> (\<forall>m n. m \<le> (Suc n) = (m = Suc n \<or> m \<le> n))"
  by auto

lemma LT[import_const "<" : less]:
  "(\<forall>m :: nat. m < (id 0) = False) \<and> (\<forall>m n. m < (Suc n) = (m = n \<or> m < n))"
  by auto

lemma DEF_GE[import_const ">=" : greater_eq]:
  "(op \<ge>) = (\<lambda>x y :: nat. y \<le> x)"
  by simp

lemma DEF_GT[import_const ">" : greater]:
  "(op >) = (\<lambda>x y :: nat. y < x)"
  by simp

lemma DEF_MAX[import_const "MAX"]:
  "max = (\<lambda>x y :: nat. if x \<le> y then y else x)"
  by (auto simp add: max.absorb_iff2 fun_eq_iff)

lemma DEF_MIN[import_const "MIN"]:
  "min = (\<lambda>x y :: nat. if x \<le> y then x else y)"
  by (auto simp add: min.absorb_iff1 fun_eq_iff)

definition even
where
  "even = Parity.even"

lemma EVEN[import_const "EVEN" : even]:
  "even (id 0\<Colon>nat) = True \<and> (\<forall>n. even (Suc n) = (\<not> even n))"
  by (simp add: even_def)

lemma SUB[import_const "-" : minus]:
  "(\<forall>m\<Colon>nat. m - (id 0) = m) \<and> (\<forall>m n. m - (Suc n) = pred (m - n))"
  by simp

lemma FACT[import_const "FACT" : fact]:
  "fact (id 0) = id (bit1 0) \<and> (\<forall>n. fact (Suc n) = Suc n * fact n)"
  by simp

import_const_map MOD : mod
import_const_map DIV : div

lemma DIVISION_0:
  "\<forall>m n\<Colon>nat. if n = id 0 then m div n = id 0 \<and> m mod n = m else m = m div n * n + m mod n \<and> m mod n < n"
  by simp

lemmas [import_type sum "_dest_sum" "_mk_sum"] = type_definition_sum[where 'a="'A" and 'b="'B"]
import_const_map INL : Inl
import_const_map INR : Inr

lemma sum_INDUCT:
  "\<forall>P. (\<forall>a :: 'A. P (Inl a)) \<and> (\<forall>a :: 'B. P (Inr a)) \<longrightarrow> (\<forall>x. P x)"
  by (auto intro: sum.induct)

lemma sum_RECURSION:
  "\<forall>Inl' Inr'. \<exists>fn. (\<forall>a :: 'A. fn (Inl a) = (Inl' a :: 'Z)) \<and> (\<forall>a :: 'B. fn (Inr a) = Inr' a)"
  by (intro allI, rule_tac x="case_sum Inl' Inr'" in exI) auto

lemma OUTL[import_const "OUTL" : projl]:
  "Sum_Type.projl (Inl x) = x"
  by simp

lemma OUTR[import_const "OUTR" : projr]:
  "Sum_Type.projr (Inr y) = y"
  by simp

import_type_map list : list
import_const_map NIL : Nil
import_const_map CONS : Cons

lemma list_INDUCT:
  "\<forall>P\<Colon>'A list \<Rightarrow> bool. P [] \<and> (\<forall>a0 a1. P a1 \<longrightarrow> P (a0 # a1)) \<longrightarrow> (\<forall>x. P x)"
  using list.induct by auto

lemma list_RECURSION:
 "\<forall>nil' cons'. \<exists>fn\<Colon>'A list \<Rightarrow> 'Z. fn [] = nil' \<and> (\<forall>(a0\<Colon>'A) a1\<Colon>'A list. fn (a0 # a1) = cons' a0 a1 (fn a1))"
  by (intro allI, rule_tac x="rec_list nil' cons'" in exI) auto

lemma HD[import_const HD : hd]:
  "hd ((h\<Colon>'A) # t) = h"
  by simp

lemma TL[import_const TL : tl]:
  "tl ((h\<Colon>'A) # t) = t"
  by simp

lemma APPEND[import_const APPEND : append]:
  "(\<forall>l\<Colon>'A list. [] @ l = l) \<and> (\<forall>(h\<Colon>'A) t l. (h # t) @ l = h # t @ l)"
  by simp

lemma REVERSE[import_const REVERSE : rev]:
  "rev [] = ([] :: 'A list) \<and> rev ((x\<Colon>'A) # l) = rev l @ [x]"
  by simp

lemma LENGTH[import_const LENGTH : length]:
  "length ([] :: 'A list) = id 0 \<and> (\<forall>(h\<Colon>'A) t. length (h # t) = Suc (length t))"
  by simp

lemma MAP[import_const MAP : map]:
  "(\<forall>f\<Colon>'A \<Rightarrow> 'B. map f [] = []) \<and>
       (\<forall>(f\<Colon>'A \<Rightarrow> 'B) h t. map f (h # t) = f h # map f t)"
  by simp

lemma LAST[import_const LAST : last]:
  "last ((h\<Colon>'A) # t) = (if t = [] then h else last t)"
  by simp

lemma BUTLAST[import_const BUTLAST : butlast]:
    "butlast [] = ([] :: 't18337 list) \<and>
     butlast ((h :: 't18337) # t) = (if t = [] then [] else h # butlast t)"
  by simp

lemma REPLICATE[import_const REPLICATE : replicate]:
  "replicate (id (0\<Colon>nat)) (x\<Colon>'t18358) = [] \<and>
   replicate (Suc n) x = x # replicate n x"
  by simp

lemma NULL[import_const NULL : List.null]:
  "List.null ([]\<Colon>'t18373 list) = True \<and> List.null ((h\<Colon>'t18373) # t) = False"
  unfolding null_def by simp

lemma ALL[import_const ALL : list_all]:
  "list_all (P\<Colon>'t18393 \<Rightarrow> bool) [] = True \<and>
  list_all P (h # t) = (P h \<and> list_all P t)"
  by simp

lemma EX[import_const EX : list_ex]:
  "list_ex (P\<Colon>'t18414 \<Rightarrow> bool) [] = False \<and>
  list_ex P (h # t) = (P h \<or> list_ex P t)"
  by simp

lemma ITLIST[import_const ITLIST : foldr]:
  "foldr (f\<Colon>'t18437 \<Rightarrow> 't18436 \<Rightarrow> 't18436) [] b = b \<and>
  foldr f (h # t) b = f h (foldr f t b)"
  by simp

lemma ALL2_DEF[import_const ALL2 : list_all2]:
  "list_all2 (P\<Colon>'t18495 \<Rightarrow> 't18502 \<Rightarrow> bool) [] (l2\<Colon>'t18502 list) = (l2 = []) \<and>
  list_all2 P ((h1\<Colon>'t18495) # (t1\<Colon>'t18495 list)) l2 =
  (if l2 = [] then False else P h1 (hd l2) \<and> list_all2 P t1 (tl l2))"
  by simp (induct_tac l2, simp_all)

lemma FILTER[import_const FILTER : filter]:
  "filter (P\<Colon>'t18680 \<Rightarrow> bool) [] = [] \<and>
  filter P ((h\<Colon>'t18680) # t) = (if P h then h # filter P t else filter P t)"
  by simp

lemma ZIP[import_const ZIP : zip]:
 "zip [] [] = ([] :: ('t18824 \<times> 't18825) list) \<and>
  zip ((h1\<Colon>'t18849) # t1) ((h2\<Colon>'t18850) # t2) = (h1, h2) # zip t1 t2"
  by simp

lemma WF[import_const WF : wfP]:
  "\<forall>u. wfP u \<longleftrightarrow> (\<forall>P. (\<exists>x :: 'A. P x) \<longrightarrow> (\<exists>x. P x \<and> (\<forall>y. u y x \<longrightarrow> \<not> P y)))"
proof (intro allI iffI impI wfI_min[to_pred], elim exE wfE_min[to_pred])
  fix x :: "'a \<Rightarrow> 'a \<Rightarrow> bool" and xa :: "'a" and Q
  assume a: "xa \<in> Q"
  assume "\<forall>P. Ex P \<longrightarrow> (\<exists>xa. P xa \<and> (\<forall>y. x y xa \<longrightarrow> \<not> P y))"
  then have "Ex (\<lambda>x. x \<in> Q) \<longrightarrow> (\<exists>xa. (\<lambda>x. x \<in> Q) xa \<and> (\<forall>y. x y xa \<longrightarrow> \<not> (\<lambda>x. x \<in> Q) y))" by auto
  then show "\<exists>z\<in>Q. \<forall>y. x y z \<longrightarrow> y \<notin> Q" using a by auto
next
  fix x P and xa :: 'A and z
  assume "P xa" "z \<in> {a. P a}" "\<And>y. x y z \<Longrightarrow> y \<notin> {a. P a}"
  then show "\<exists>xa. P xa \<and> (\<forall>y. x y xa \<longrightarrow> \<not> P y)" by auto
qed auto

end


(*  Title:       Implementing field extensions of the form Q[sqrt(b)]
    Author:      René Thiemann       <rene.thiemann@uibk.ac.at>
    Maintainer:  René Thiemann
    License:     LGPL
*)

(*
Copyright 2009-2014 René Thiemann

This file is part of IsaFoR/CeTA.

IsaFoR/CeTA is free software: you can redistribute it and/or modify it under the
terms of the GNU Lesser General Public License as published by the Free Software
Foundation, either version 3 of the License, or (at your option) any later
version.

IsaFoR/CeTA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License along
with IsaFoR/CeTA. If not, see <http://www.gnu.org/licenses/>.
*)
section \<open>A unique representation of real numbers via triples\<close>
theory Real_Unique_Impl
imports
  Prime_Product
  Real_Impl
  Show.Show_Instances
  Show.Show_Real
begin

text \<open>We implement the real numbers again using triples, but now we require an additional
 invariant on the triples, namely that the base has to be a prime product. This has the consequence
 that the mapping of triples into $\reals$ is injective. Hence, equality on reals is now equality
 on triples, which can even be executed in case of different bases. Similarly, we now also allow
 different basis in comparisons. Ultimately, injectivity allows us to define a show-function for
 real numbers, which pretty prints real numbers into strings.\<close>

typedef mini_alg_unique =
  "{ r :: mini_alg . ma_coeff r = 0 \<and> ma_base r = 0 \<or> ma_coeff r \<noteq> 0 \<and> prime_product (ma_base r)}"
  by (transfer, auto)

setup_lifting type_definition_mini_alg_unique

lift_definition real_of_u :: "mini_alg_unique \<Rightarrow> real" is real_of .
lift_definition mau_floor :: "mini_alg_unique \<Rightarrow> int" is ma_floor .
lift_definition mau_of_rat :: "rat \<Rightarrow> mini_alg_unique" is ma_of_rat by (transfer, auto)
lift_definition mau_rat :: "mini_alg_unique \<Rightarrow> rat" is ma_rat .
lift_definition mau_base :: "mini_alg_unique \<Rightarrow> nat" is ma_base .
lift_definition mau_coeff :: "mini_alg_unique \<Rightarrow> rat" is ma_coeff .
lift_definition mau_uminus :: "mini_alg_unique \<Rightarrow> mini_alg_unique" is ma_uminus by (transfer, auto)
lift_definition mau_compatible :: "mini_alg_unique \<Rightarrow> mini_alg_unique \<Rightarrow> bool" is ma_compatible .
lift_definition mau_ge_0 :: "mini_alg_unique \<Rightarrow> bool" is ma_ge_0 .
lift_definition mau_inverse :: "mini_alg_unique \<Rightarrow> mini_alg_unique" is ma_inverse
  by (transfer, auto simp: ma_normalize_def Let_def split: if_splits)
lift_definition mau_plus :: "mini_alg_unique \<Rightarrow> mini_alg_unique \<Rightarrow> mini_alg_unique" is ma_plus
  by (transfer, auto simp: ma_normalize_def split: if_splits)
lift_definition mau_times :: "mini_alg_unique \<Rightarrow> mini_alg_unique \<Rightarrow> mini_alg_unique" is ma_times
  by (transfer, auto simp: ma_normalize_def split: if_splits)
lift_definition ma_identity :: "mini_alg \<Rightarrow> mini_alg \<Rightarrow> bool" is "(=)" .
lift_definition mau_equal :: "mini_alg_unique \<Rightarrow> mini_alg_unique \<Rightarrow> bool" is ma_identity .
lift_definition mau_is_rat :: "mini_alg_unique \<Rightarrow> bool" is ma_is_rat .

lemma Ratreal_code[code]:
  "Ratreal = real_of_u \<circ> mau_of_rat"
  by (simp add: fun_eq_iff) (transfer, transfer, simp)

lemma mau_floor: "floor (real_of_u r) = mau_floor r"
  using ma_floor by (transfer, auto)
lemma mau_inverse: "inverse (real_of_u r) = real_of_u (mau_inverse r)"
  using ma_inverse by (transfer, auto)
lemma mau_uminus: "- (real_of_u r) = real_of_u (mau_uminus r)"
  using ma_uminus by (transfer, auto)
lemma mau_times:
  "(real_of_u r1 * real_of_u r2) = (if mau_compatible r1 r2
    then real_of_u (mau_times r1 r2) else
    Code.abort (STR ''different base'') (\<lambda> _. real_of_u r1 * real_of_u r2))"
  using ma_times by (transfer, auto)
lemma mau_plus:
  "(real_of_u r1 + real_of_u r2) = (if mau_compatible r1 r2
    then real_of_u (mau_plus r1 r2) else
    Code.abort (STR ''different base'') (\<lambda> _. real_of_u r1 + real_of_u r2))"
  using ma_plus by (transfer, auto)

lemma real_of_u_inj[simp]: "real_of_u x = real_of_u y \<longleftrightarrow> x = y"
proof
  note field_simps[simp] of_rat_diff[simp]
  assume "real_of_u x = real_of_u y"
  thus "x = y"
  proof (transfer)
    fix x y
    assume "ma_coeff x = 0 \<and> ma_base x = 0 \<or> ma_coeff x \<noteq> 0 \<and> prime_product (ma_base x)"
      and  "ma_coeff y = 0 \<and> ma_base y = 0 \<or> ma_coeff y \<noteq> 0 \<and> prime_product (ma_base y)"
      and  "real_of x = real_of y"
    thus "x = y"
    proof (transfer, clarsimp)
      fix p1 q1 p2 q2 :: rat and b1 b2
      let ?p1 = "real_of_rat p1"
      let ?p2 = "real_of_rat p2"
      let ?q1 = "real_of_rat q1"
      let ?q2 = "real_of_rat q2"
      let ?b1 = "real_of_nat b1"
      let ?b2 = "real_of_nat b2"
      assume q1: "q1 = 0 \<and> b1 = 0 \<or> q1 \<noteq> 0 \<and> prime_product b1"
      and q2: "q2 = 0 \<and> b2 = 0 \<or> q2 \<noteq> 0 \<and> prime_product b2"
      and i1: "q1 = 0 \<or> b1 \<in> sqrt_irrat"
      and i2: "q2 = 0 \<or> b2 \<in> sqrt_irrat"
      and eq: "?p1 + ?q1 * sqrt ?b1 = ?p2 + ?q2 * sqrt ?b2"
      show "p1 = p2 \<and> q1 = q2 \<and> b1 = b2"
      proof (cases "q1 = 0")
        case True
        have "q2 = 0"
          by (rule sqrt_irrat[OF i2, of "p2 - p1"], insert eq True q1, auto)
        with True q1 q2 eq show ?thesis by auto
      next
        case False
        hence 1: "q1 \<noteq> 0" "prime_product b1" using q1 by auto
        {
          assume *: "q2 = 0"
          have "q1 = 0"
            by (rule sqrt_irrat[OF i1, of "p1 - p2"], insert eq * q2, auto)
          with False have False by auto
        }
        hence 2: "q2 \<noteq> 0" "prime_product b2" using q2 by auto
        from 1 i1 have b1: "b1 \<noteq> 0" unfolding sqrt_irrat_def by (cases b1, auto)
        from 2 i2 have b2: "b2 \<noteq> 0" unfolding sqrt_irrat_def by (cases b2, auto)
        let ?sq = "\<lambda> x. x * x"
        define q3 where "q3 = p2 - p1"
        let ?q3 = "real_of_rat q3"
        let ?e = "of_rat (q2 * q2 * of_nat b2 + ?sq q3  - ?sq q1 * of_nat b1) + of_rat (2 * q2 * q3) * sqrt ?b2"
        from eq have *: "?q1 * sqrt ?b1 = ?q2 * sqrt ?b2 + ?q3"
          by (simp add: q3_def)
        from arg_cong[OF this, of ?sq] have "0 = (real_of_rat 2 * ?q2 * ?q3) * sqrt ?b2 +
          (?sq ?q2 * ?b2 +  ?sq ?q3 - ?sq ?q1 * ?b1)"
          by auto
        also have "\<dots> = ?e"
          by (simp add: of_rat_mult of_rat_add of_rat_minus)
        finally have eq: "?e = 0" by simp
        from sqrt_irrat[OF _ this] 2 i2 have q3: "q3 = 0" by auto
        hence p: "p1 = p2" unfolding q3_def by simp
        let ?b1 = "rat_of_nat b1"
        let ?b2 = "rat_of_nat b2"
        from eq[unfolded q3] have eq: "?sq q2 * ?b2 = ?sq q1 * ?b1" by auto
        obtain z1 n1 where d1: "quotient_of q1 = (z1,n1)" by force
        obtain z2 n2 where d2: "quotient_of q2 = (z2,n2)" by force
        note id = quotient_of_div[OF d1] quotient_of_div[OF d2]
        note pos = quotient_of_denom_pos[OF d1] quotient_of_denom_pos[OF d2]
        from id(1) 1(1) pos(1) have z1: "z1 \<noteq> 0" by auto
        from id(2) 2(1) pos(2) have z2: "z2 \<noteq> 0" by auto
        let ?n1 = "rat_of_int n1"
        let ?n2 = "rat_of_int n2"
        let ?z1 = "rat_of_int z1"
        let ?z2 = "rat_of_int z2"
        from arg_cong[OF eq[simplified id], of "\<lambda> x. x * ?sq ?n1 * ?sq ?n2",
          simplified field_simps]
        have "?sq (?n1 * ?z2) * ?b2 = ?sq (?n2 * ?z1) * ?b1"
          using pos by auto
        moreover have "?n1 * ?z2 \<noteq> 0" "?n2 * ?z1 \<noteq> 0" using z1 z2 pos by auto
        ultimately obtain i1 i2 where 0: "rat_of_int i1 \<noteq> 0" "rat_of_int i2 \<noteq> 0"
          and eq: "?sq (rat_of_int i2) * ?b2 = ?sq (rat_of_int i1) * ?b1"
          unfolding of_int_mult[symmetric] by blast+
        let ?b1 = "int b1"
        let ?b2 = "int b2"
        from eq have eq: "?sq i1 * ?b1 = ?sq i2 * ?b2"
          by (metis (hide_lams, no_types) of_int_eq_iff of_int_mult of_int_of_nat_eq)
        from 0 have 0: "i1 \<noteq> 0" "i2 \<noteq> 0" by auto
        from arg_cong[OF eq, of nat] have "?sq (nat (abs i1)) * b1 = ?sq (nat (abs i2)) * b2"
          by (metis abs_of_nat eq nat_abs_mult_distrib nat_int)
        moreover have "nat (abs i1) > 0" "nat (abs i2) > 0" using 0 by auto
        ultimately obtain n1 n2 where 0: "n1 > 0" "n2 > 0" and eq: "?sq n1 * b1 = ?sq n2 * b2" by blast
        from b1 0 have b1: "b1 > 0" "n1 > 0" "n1 * n1 > 0" by auto
        from b2 0 have b2: "b2 > 0" "n2 > 0" "n2 * n2 > 0" by auto
        {
          fix p :: nat assume p: "prime p"
          have "multiplicity p (?sq n1 * b1) = multiplicity p b1 + 2 * multiplicity p n1"
            using b1 p by (auto simp: prime_elem_multiplicity_mult_distrib)
          also have "\<dots> mod 2 = multiplicity p b1 mod 2" by presburger
          finally have id1: "multiplicity p (?sq n1 * b1) mod 2 = multiplicity p b1 mod 2" .
          have "multiplicity p (?sq n2 * b2) = multiplicity p b2 + 2 * multiplicity p n2"
            using b2 p by (auto simp: prime_elem_multiplicity_mult_distrib)
          also have "\<dots> mod 2 = multiplicity p b2 mod 2" by presburger
          finally have id2: "multiplicity p (?sq n2 * b2) mod 2 = multiplicity p b2 mod 2" .
          from id1 id2 eq have eq: "multiplicity p b1 mod 2 = multiplicity p b2 mod 2" by simp
          from 1(2) 2(2) p have "multiplicity p b1 \<le> 1" "multiplicity p b2 \<le> 1"
            unfolding prime_product_def by auto
          with eq have "multiplicity p b1 = multiplicity p b2" by simp
        }
        with b1(1) b2(1) have b: "b1 = b2" by (rule multiplicity_eq_nat)
        from *[unfolded b q3] b1(1) b2(1) have q: "q1 = q2" by simp
        from p q b show ?thesis by blast
      qed
    qed
  qed
qed simp

lift_definition mau_sqrt :: "mini_alg_unique \<Rightarrow> mini_alg_unique" is
   "\<lambda> ma. let (a,b) = quotient_of (ma_rat ma); (sq,fact) = prime_product_factor (nat (abs a * b));
      ma' = ma_of_rat (of_int (sgn(a)) * of_nat sq / of_int b)
      in ma_times ma' (ma_sqrt (ma_of_rat (of_nat fact)))"
proof -
  fix ma :: mini_alg
  let ?num =
    "let (a, b) = quotient_of (ma_rat ma); (sq, fact) = prime_product_factor (nat (\<bar>a\<bar> * b));
       ma' = ma_of_rat (rat_of_int (sgn a) * rat_of_nat sq / of_int b)
     in ma_times ma' (ma_sqrt (ma_of_rat (rat_of_nat fact)))"
  obtain a b where q: "quotient_of (ma_rat ma) = (a,b)" by force
  obtain sq fact where ppf: "prime_product_factor (nat (abs a * b)) = (sq,fact)" by force
  define asq where "asq = rat_of_int (sgn a) * of_nat sq / of_int b"
  define ma' where "ma' = ma_of_rat asq"
  define sqrt where "sqrt = ma_sqrt (ma_of_rat (rat_of_nat fact))"
  have num: "?num = ma_times ma' sqrt" unfolding q ppf asq_def Let_def split ma'_def sqrt_def ..
  let ?inv = "\<lambda> ma. ma_coeff ma = 0 \<and> ma_base ma = 0 \<or> ma_coeff ma \<noteq> 0 \<and> prime_product (ma_base ma)"
  have ma': "?inv ma'" unfolding ma'_def
    by (transfer, auto)
  have id: "\<And> i. int i * 1 = i" "\<And> i :: rat. i / 1 = i" "rat_of_int 1 = 1" "inverse (1 :: rat) = 1"
    "\<And> n. nat \<bar>int n\<bar> = n" by auto
  from prime_product_factor[OF ppf] have "prime_product fact" by auto
  hence sqrt: "?inv sqrt" unfolding sqrt_def
    by (transfer, unfold split quotient_of_nat Let_def id, case_tac "sqrt_int \<bar>int facta\<bar>", auto)
  show "?inv ?num" unfolding num using ma' sqrt
    by (transfer, auto simp: ma_normalize_def split: if_splits)  (* slow *)
qed

lemma sqrt_sgn[simp]: "sqrt (of_int (sgn a)) = of_int (sgn a)"
  by (cases "a \<ge> 0", cases "a = 0", auto simp: real_sqrt_minus)

lemma mau_sqrt_main: "mau_coeff r = 0 \<Longrightarrow> sqrt (real_of_u r) = real_of_u (mau_sqrt r)"
proof (transfer)
  fix r
  assume "ma_coeff r = 0"
  hence rr: "real_of r = of_rat (ma_rat r)" by (transfer, auto)
  obtain a b where q: "quotient_of (ma_rat r) = (a,b)" by force
  from quotient_of_div[OF q] have r: "ma_rat r = of_int a / of_int b" by auto
  from quotient_of_denom_pos[OF q] have b: "b > 0" by auto
  obtain sq fact where ppf: "prime_product_factor (nat (\<bar>a\<bar> * b)) = (sq, fact)" by force
  from prime_product_factor[OF ppf] have ab: "nat (\<bar>a\<bar> * b) = sq * sq * fact" ..
  have "sqrt (real_of r) = sqrt(of_int a / of_int b)" unfolding rr r
    by (metis of_rat_divide of_rat_of_int_eq)
  also have "real_of_int a / of_int b = of_int a * of_int b / (of_int b * of_int b)" using b by auto
  also have "sqrt (\<dots>) = sqrt (of_int a * of_int b) / of_int b" using sqrt_sqrt[of "real_of_int b"] b
    by (metis less_eq_real_def of_int_0_less_iff real_sqrt_divide real_sqrt_mult)
  also have "real_of_int a * of_int b = real_of_int (a * b)" by auto
  also have "a * b = sgn a * (abs a * b)" by (simp, metis mult_sgn_abs)
  also have "real_of_int (\<dots>) = of_int (sgn a) * real_of_int (\<bar>a\<bar> * b)"
    unfolding of_int_mult[of "sgn a"] ..
  also have "real_of_int (\<bar>a\<bar> * b) = of_nat (nat (abs a * b))" using b
    by (metis abs_sgn mult_pos_pos mult_zero_left nat_int of_int_of_nat_eq of_nat_0 zero_less_abs_iff zero_less_imp_eq_int)
  also have "\<dots> = of_nat fact * (of_nat sq * of_nat sq)" unfolding ab of_nat_mult by simp
  also have "sqrt (of_int (sgn a) * (of_nat fact * (of_nat sq * of_nat sq))) =
    of_int (sgn a) * sqrt (of_nat fact) * of_nat sq"
    unfolding real_sqrt_mult by simp
  finally have r: "sqrt (real_of r) = real_of_int (sgn a) * real_of_nat sq / real_of_int b * sqrt (real_of_nat fact)" by simp
  let ?asqb = "ma_of_rat (rat_of_int (sgn a) * rat_of_nat sq / rat_of_int b)"
  let ?f = "ma_of_rat (rat_of_nat fact)"
  let ?sq = "ma_sqrt ?f"
  have sq: "0 \<le> ma_rat ?f" "ma_coeff ?f = 0" by ((transfer, simp)+)
  have compat: "\<And> m. (ma_compatible ?asqb m) = True"
    by (transfer, auto)
  show "sqrt (real_of r) =
         real_of
          (let (a, b) = quotient_of (ma_rat r); (sq, fact) = prime_product_factor (nat (\<bar>a\<bar> * b));
               ma' = ma_of_rat (rat_of_int (sgn a) * rat_of_nat sq / rat_of_int b)
           in ma_times ma' (ma_sqrt (ma_of_rat (rat_of_nat fact))))"
    unfolding q ppf Let_def split
    unfolding r
    unfolding ma_times[symmetric, of ?asqb, unfolded compat if_True]
    unfolding ma_sqrt_main[OF sq, symmetric]
    unfolding ma_of_rat[symmetric]
    by (simp add: of_rat_divide of_rat_mult)
qed

lemma mau_sqrt: "sqrt (real_of_u r) = (if mau_coeff r = 0 then
  real_of_u (mau_sqrt r)
  else Code.abort (STR ''cannot represent sqrt of irrational number'') (\<lambda> _. sqrt (real_of_u r)))"
  using mau_sqrt_main[of r] by (cases "mau_coeff r = 0", auto)

lemma mau_0: "0 = real_of_u (mau_of_rat 0)" using ma_0 by (transfer, auto)

lemma mau_1: "1 = real_of_u (mau_of_rat 1)" using ma_1 by (transfer, auto)

lemma mau_equal:
  "HOL.equal (real_of_u r1) (real_of_u r2) = mau_equal r1 r2" unfolding equal_real_def
  using real_of_u_inj[of r1 r2]
  by (transfer, transfer, auto)

lemma mau_ge_0: "ge_0 (real_of_u x) = mau_ge_0 x" using ma_ge_0
  by (transfer, auto)

definition real_lt :: "real \<Rightarrow> real \<Rightarrow> bool" where "real_lt = (<)"

text\<open>The following code equation terminates if it is started on two
  different inputs.\<close>
lemma real_lt [code equation]: "real_lt x y = (let fx = floor x; fy = floor y in
  (if fx < fy then True else if fx > fy then False else real_lt (x * 1024) (y * 1024)))"
proof (cases "floor x < floor y")
  case True
  thus ?thesis by (auto simp: real_lt_def floor_less_cancel)
next
  case False note nless = this
  show ?thesis
  proof (cases "floor x > floor y")
    case True
    from floor_less_cancel[OF this] True nless show ?thesis
      by (simp add: real_lt_def)
  next
    case False
    with nless show ?thesis unfolding real_lt_def by auto
  qed
qed

text \<open>For comparisons we first check for equality. Then, if the bases are
  compatible we can just compare the differences with 0. Otherwise, we start
  the recursive algorithm @{const real_lt} which works on arbitrary bases.
  In this way, we have an implementation of comparisons which can compare
  all representable numbers.

  Note that in @{theory Real_Impl.Real_Impl} we did not use @{const real_lt} as there
  the code-equations for equality already require identical bases.
\<close>
lemma comparison_impl:
  "real_of_u x \<le> real_of_u y \<longleftrightarrow> real_of_u x = real_of_u y \<or>
    (if mau_compatible x y then ge_0 (real_of_u y - real_of_u x) else real_lt (real_of_u x) (real_of_u y))"
  "real_of_u x < real_of_u y \<longleftrightarrow> real_of_u x \<noteq> real_of_u y \<and>
    (if mau_compatible x y then ge_0 (real_of_u y - real_of_u x) else real_lt (real_of_u x) (real_of_u y))"
  unfolding ge_0_def real_lt_def by (auto simp del: real_of_u_inj)

lemma mau_is_rat: "is_rat (real_of_u x) = mau_is_rat x" using ma_is_rat
  by (transfer, auto)

lift_definition ma_show_real :: "mini_alg \<Rightarrow> string" is
  "\<lambda> (p,q,b). let sb = shows ''sqrt('' \<circ> shows b \<circ> shows '')'';
      qb = (if q = 1 then sb else if q = -1 then shows ''-'' \<circ> sb else shows q \<circ> shows ''*'' \<circ> sb) in
      if q = 0 then shows p [] else
      if p = 0 then qb [] else
      if q < 0 then ((shows p \<circ> qb) [])
      else ((shows p \<circ> shows ''+'' \<circ> qb) [])" .

lift_definition mau_show_real :: "mini_alg_unique \<Rightarrow> string" is ma_show_real .

overloading show_real \<equiv> show_real
begin
  definition show_real
    where "show_real x \<equiv>
      (if (\<exists> y. x = real_of_u y) then mau_show_real (THE y. x = real_of_u y) else [])"
end

lemma mau_show_real: "show_real (real_of_u x) = mau_show_real x"
  unfolding show_real_def by simp

code_datatype real_of_u

declare [[code drop:
  "plus :: real \<Rightarrow> real \<Rightarrow> real"
  "uminus :: real \<Rightarrow> real"
  "times :: real \<Rightarrow> real \<Rightarrow> real"
  "inverse :: real \<Rightarrow> real"
  "floor :: real \<Rightarrow> int"
  sqrt
  "HOL.equal :: real \<Rightarrow> real \<Rightarrow> bool"
  ge_0
  is_rat
  "less :: real \<Rightarrow> real \<Rightarrow> bool"
  "less_eq :: real \<Rightarrow> real \<Rightarrow> bool"
]]

lemmas mau_code_eqns [code] = mau_floor mau_0 mau_1 mau_uminus mau_inverse mau_sqrt mau_plus mau_times mau_equal mau_ge_0 mau_is_rat
  mau_show_real comparison_impl

text \<open>Some tests with small numbers. To work on larger number, one should
  additionally import the theories for efficient calculation on numbers\<close>

value "\<lfloor>101.1 * (sqrt 18 + 6 * sqrt 0.5)\<rfloor>"
value "\<lfloor>324 * sqrt 7 + 0.001\<rfloor>"
value "101.1 * (sqrt 18 + 6 * sqrt 0.5) = 324 * sqrt 7 + 0.001"
value "101.1 * (sqrt 18 + 6 * sqrt 0.5) > 324 * sqrt 7 + 0.001"
value "show (101.1 * (sqrt 18 + 6 * sqrt 0.5))"
value "(sqrt 0.1 \<in> \<rat>, sqrt (- 0.09) \<in> \<rat>)"

end