Theory Derivations

theory Derivations
imports CFG ListTools InductRules
begin

(* leftderives and leftderives1 *)
context CFG begin

lemma [simp]: "is_terminal t  is_symbol t"
  by (auto simp add: is_terminal_def is_symbol_def)

lemma [simp]: "is_sentence []" by (auto simp add: is_sentence_def)

lemma [simp]: "is_word []" by (auto simp add: is_word_def)

lemma [simp]: "is_word u  is_sentence u"
  by (induct u, auto simp add: is_word_def is_sentence_def)

definition leftderives1 :: "sentence  sentence  bool"
where
  "leftderives1 u v = 
     ( x y N α. 
          u = x @ [N] @ y
         v = x @ α @ y
         is_word x
         is_sentence y
         (N, α)  )"  

lemma leftderives1_implies_derives1[simp]: "leftderives1 u v  derives1 u v"
  apply (auto simp add: leftderives1_def derives1_def)
  apply (rule_tac x="x" in exI)
  apply (rule_tac x="y" in exI)
  apply (rule_tac x="N" in exI)
  by auto

definition leftderivations1 :: "(sentence × sentence) set"
where
  "leftderivations1 = { (u,v) | u v. leftderives1 u v }"

lemma [simp]: "leftderivations1  derivations1"
  by (auto simp add: leftderivations1_def derivations1_def)

definition leftderivations :: "(sentence × sentence) set"
where 
  "leftderivations = leftderivations1^*"

lemma rtrancl_subset_implies: "a  b  a  b^*" by blast

lemma leftderivations_subset_derivations[simp]: "leftderivations  derivations"
  apply (simp add: leftderivations_def derivations_def)
  apply (rule rtrancl_subset_rtrancl)
  apply (rule rtrancl_subset_implies)
  by simp

definition leftderives :: "sentence  sentence  bool"
where
  "leftderives u v = ((u, v)  leftderivations)"

lemma leftderives_implies_derives[simp]: "leftderives u v  derives u v"
  apply (auto simp add: leftderives_def derives_def)
  by (rule subsetD[OF leftderivations_subset_derivations])

definition is_leftderivation :: "sentence  bool"
where
  "is_leftderivation u = leftderives [𝔖] u"

lemma leftderivation_implies_derivation[simp]: 
  "is_leftderivation u  is_derivation u"
  by (simp add: is_leftderivation_def is_derivation_def)

lemma leftderives_refl[simp]: "leftderives u u"
  by (auto simp add: leftderives_def leftderivations_def)

lemma leftderives1_implies_leftderives[simp]:"leftderives1 a b  leftderives a b"
  by (auto simp add: leftderives_def leftderivations_def leftderivations1_def)

lemma leftderives_trans: "leftderives a b  leftderives b c  leftderives a c"
  by (auto simp add: leftderives_def leftderivations_def)

lemma leftderives1_eq_leftderivations1: "leftderives1 x y = ((x, y)  leftderivations1)"
  by (simp add: leftderivations1_def)

lemma leftderives_induct[consumes 1, case_names Base Step]:
  assumes derives: "leftderives a b"
  assumes Pa: "P a"
  assumes induct: "y z. leftderives a y  leftderives1 y z  P y  P z"
  shows "P b"
proof -
  note rtrancl_lemma = rtrancl_induct[where a = a and b = b and r = leftderivations1 and P=P]
  from derives Pa induct rtrancl_lemma show "P b"
    by (metis leftderives_def leftderivations_def leftderives1_eq_leftderivations1)
qed

end

(* Basic lemmas about derives1 and derives *)
context CFG begin

lemma derives1_implies_derives[simp]:"derives1 a b  derives a b"
  by (auto simp add: derives_def derivations_def derivations1_def)

lemma derives_trans: "derives a b  derives b c  derives a c"
  by (auto simp add: derives_def derivations_def)

lemma derives1_eq_derivations1: "derives1 x y = ((x, y)  derivations1)"
  by (simp add: derivations1_def)

lemma derives_induct[consumes 1, case_names Base Step]:
  assumes derives: "derives a b"
  assumes Pa: "P a"
  assumes induct: "y z. derives a y  derives1 y z  P y  P z"
  shows "P b"
proof -
  note rtrancl_lemma = rtrancl_induct[where a = a and b = b and r = derivations1 and P=P]
  from derives Pa induct rtrancl_lemma show "P b"
    by (metis derives_def derivations_def derives1_eq_derivations1)
qed

end

(* Derives1 and Derivation, LDerives1 and LDerivation *)
context CFG begin

definition Derives1 :: "sentence  nat  rule  sentence  bool"
where
  "Derives1 u i r v = 
     ( x y N α. 
          u = x @ [N] @ y
         v = x @ α @ y
         is_sentence x
         is_sentence y
         (N, α)  
         r = (N, α)  i = length x)"  

lemma Derives1_split:
  "Derives1 u i r v   x y. u = x @ [fst r] @ y  v = x @ (snd r) @ y  length x = i"
by (metis Derives1_def fst_conv snd_conv)

lemma Derives1_implies_derives1: "Derives1 u i r v  derives1 u v"
  by (auto simp add: Derives1_def derives1_def)

lemma derives1_implies_Derives1: "derives1 u v   i r. Derives1 u i r v"
  by (auto simp add: Derives1_def derives1_def)

lemma Derives1_unique_dest: "Derives1 u i r v  Derives1 u i r w  v = w"
  by (auto simp add: Derives1_def derives1_def)

lemma Derives1_unique_src: "Derives1 u i r w  Derives1 v i r w  u = v"
  by (auto simp add: Derives1_def derives1_def)

type_synonym derivation = "(nat × rule) list"

fun Derivation :: "sentence  derivation  sentence  bool"
where
  "Derivation a [] b = (a = b)"
| "Derivation a (d#D) b = ( x. Derives1 a (fst d) (snd d) x  Derivation x D b)"

lemma Derivation_implies_derives: "Derivation a D b  derives a b"
proof (induct D arbitrary: a b)
  case Nil thus ?case 
    by (simp add: derives_def derivations_def)
next
  case (Cons d D)
    note ihyps = this
    from ihyps have " x. Derives1 a (fst d) (snd d) x  Derivation x D b" by auto
    then obtain x where "Derives1 a (fst d) (snd d) x" and xb: "Derivation x D b" by blast
    with Derives1_implies_derives1 have d1: "derives a x" by auto
    from ihyps xb have d2:"derives x b" by simp
    show "derives a b" by (rule derives_trans[OF d1 d2])
qed 

lemma Derivation_Derives1: "Derivation a S y  Derives1 y i r z  Derivation a (S@[(i,r)]) z"
proof (induct S arbitrary: a y z i r)
  case Nil thus ?case by simp
next
  case (Cons s S) thus ?case 
    by (metis Derivation.simps(2) append_Cons) 
qed

lemma derives_implies_Derivation: "derives a b   D. Derivation a D b"
proof (induct rule: derives_induct)
  case Base
  show ?case by (rule exI[where x="[]"], simp)
next
  case (Step y z)
  note ihyps = this
  from ihyps obtain D where ay: "Derivation a D y" by blast
  from ihyps derives1_implies_Derives1 obtain i r where yz: "Derives1 y i r z" by blast
  from Derivation_Derives1[OF ay yz] show ?case by auto
qed
    
lemma Derives1_take: "Derives1 a i r b  take i a = take i b"
  by (auto simp add: Derives1_def)

lemma Derives1_drop: "Derives1 a i r b  drop (Suc i) a = drop (i + length (snd r)) b"
  by (auto simp add: Derives1_def)

lemma Derives1_bound: "Derives1 a i r b  i < length a"
  by (auto simp add: Derives1_def)

lemma Derives1_length: "Derives1 a i r b  length b = length a + length (snd r) - 1"
  by (auto simp add: Derives1_def)

definition leftmost :: "nat  sentence  bool"
where
  "leftmost i s = (i < length s  is_word (take i s)  is_nonterminal (s ! i))" 

lemma set_take: "set (take n s) = { s ! i | i. i < n  i < length s}"
proof (cases "n  length s")
  case True thus ?thesis
  by (subst List.nth_image[symmetric], auto)
next
  case False thus ?thesis
    apply (subst set_conv_nth)
    by (metis less_trans linear not_le take_all)
qed
  
lemma list_all_take: "list_all P (take n s) = ( i. i < n  i < length s  P (s ! i))"
  by (auto simp add: set_take list_all_iff)

lemma is_sentence_concat: "is_sentence (x@y) = (is_sentence x  is_sentence y)"
  by (auto simp add: is_sentence_def)

lemma is_sentence_cons: "is_sentence (x#xs) = (is_symbol x  is_sentence xs)"
  by (auto simp add: is_sentence_def)

lemma rule_nonterminal_type[simp]: "(N, α)    is_nonterminal N"
  apply (insert validRules)
  by (auto simp add: is_nonterminal_def)

lemma rule_α_type[simp]: "(N, α)    is_sentence α"
  apply (insert validRules)
  by (auto simp add: is_sentence_def is_symbol_def list_all_iff is_terminal_def is_nonterminal_def)

lemma [simp]: "is_nonterminal N  is_symbol N"
  by (simp add: is_symbol_def)

lemma Derives1_sentence1[elim]: "Derives1 a i r b  is_sentence a"
  by (auto simp add: Derives1_def is_sentence_cons is_sentence_concat)

lemma Derives1_sentence2[elim]: "Derives1 a i r b  is_sentence b"
  by (auto simp add: Derives1_def is_sentence_cons is_sentence_concat)

lemma [elim]: "Derives1 a i r b  r  "
  using Derives1_def by auto

lemma is_sentence_symbol: "is_sentence a  i < length a  is_symbol (a ! i)"
  by (simp add: is_sentence_def list_all_iff)

lemma is_symbol_distinct: "is_symbol x  is_terminal x  is_nonterminal x"
  apply (insert disjunct_symbols)
  apply (auto simp add: is_symbol_def is_terminal_def is_nonterminal_def)
  done

lemma is_terminal_nonterminal: "is_terminal x  is_nonterminal x  False"
  by (metis is_symbol_def is_symbol_distinct)

lemma Derives1_leftmost:
  assumes "Derives1 a i r b"
  shows " j. leftmost j a  j  i"
proof -
  let ?J = "{j . j < length a  is_nonterminal (a ! j)}"
  let ?M = "Min ?J"
  from assms have J1:"i  ?J"
    apply (auto simp add: Derives1_def is_nonterminal_def)
    by (metis (mono_tags, lifting) prod.simps(2) validRules)
  have J2:"finite ?J" by auto
  note J = J1 J2
  from J have M1: "?M  ?J" by (rule_tac Min_in, auto) 
  {
    fix j
    assume "j  ?J"
    with J have "?M  j" by auto
  }
  note M3 = this[OF J1]
  from assms have a_sentence: "is_sentence a" by (simp add: Derives1_sentence1)
  have is_word: "is_word (take ?M a)"
    apply (auto simp add: is_word_def list_all_take)
    proof -
      fix i
      assume i_less_M: "i < ?M"
      assume i_inbounds: "i < length a"
      show "is_terminal (a ! i)"
      proof(cases "is_terminal (a ! i)")
        case True thus ?thesis by auto
      next
        case False
        then have "is_nonterminal (a ! i)"
        using i_inbounds a_sentence is_sentence_symbol is_symbol_distinct by blast
        then have "i  ?J" by (metis i_inbounds mem_Collect_eq) 
        then have "?M < i" by (metis J2 Min_le i_less_M leD) 
        then have "False" by (metis i_less_M less_asym') 
        then show ?thesis by auto
      qed
    qed  
  show ?thesis 
    apply (rule_tac exI[where x="?M"])
    apply (simp add: leftmost_def)
    by (metis (mono_tags, lifting) M1 M3 is_word mem_Collect_eq)
qed

lemma Derivation_leftmost: "D  []  Derivation a D b   i. leftmost i a"
  apply (case_tac "D")
  apply (auto)
  apply (metis Derives1_leftmost)
  done

lemma nonword_has_nonterminal:
  "is_sentence a   ¬ (is_word a)   k. k < length a  is_nonterminal (a ! k)"
  apply (auto simp add: is_sentence_def list_all_iff is_word_def)
  by (metis in_set_conv_nth is_symbol_distinct)

lemma leftmost_cons_nonterminal: 
  "is_nonterminal x  leftmost 0 (x#xs)"
by (metis CFG.is_word_def CFG_axioms leftmost_def length_greater_0_conv list.distinct(1) 
    list_all_simps(2) nth_Cons_0 take_Cons')

lemma leftmost_cons_terminal: 
  "is_terminal x  leftmost i (x#xs) = (i > 0  leftmost (i - 1) xs)"
by (metis Suc_diff_1 Suc_less_eq is_terminal_nonterminal is_word_def leftmost_def length_Cons 
    list_all_simps(1) not_gr0 nth_Cons' take_Cons')

lemma is_nonterminal_cons_terminal: 
  "is_terminal x  k < length (x # a)  is_nonterminal ((x # a) ! k) 
   k > 0  k - 1 < length a  is_nonterminal (a ! (k - 1))"
by (metis One_nat_def Suc_leI is_terminal_nonterminal less_diff_conv2 
    list.size(4) nth_non_equal_first_eq)

lemma leftmost_exists:
  "is_sentence a  k < length a  is_nonterminal (a ! k)  
    i. leftmost i a  i  k" 
proof (induct a arbitrary: k)
  case Nil thus ?case by auto
next
  case (Cons x a) 
  show ?case
  proof(cases "is_nonterminal x")
    case True thus ?thesis
      apply(rule_tac exI[where x="0"])
      apply (simp add: leftmost_cons_nonterminal)
      done
  next
    case False
    then have x: "is_terminal x"
      by (metis Cons.prems(1) is_sentence_cons is_symbol_distinct)
    note k = is_nonterminal_cons_terminal[OF x Cons(3) Cons(4)]
    with Cons have "i. leftmost i a  i  k - 1" by (metis is_sentence_cons)
    then show ?thesis
      apply (auto simp add: leftmost_cons_terminal[OF x])
      by (metis le_diff_conv2 Suc_leI add_Suc_right add_diff_cancel_right' k 
          le_0_eq le_imp_less_Suc nat_le_linear)
  qed
qed

lemma nonword_leftmost_exists: 
  "is_sentence a  ¬ (is_word a)   i. leftmost i a"
  by (metis leftmost_exists nonword_has_nonterminal)
  
lemma leftmost_unaffected_Derives1: "leftmost j a  j < i  Derives1 a i r b  leftmost j b"
apply (simp add: leftmost_def)
proof -
  assume a1: "j < length a  is_word (take j a)  is_nonterminal (a ! j)"
  assume a2: "j < i"
  assume "Derives1 a i r b"
  then have f3: "take i a = take i b"
    by (metis Derives1_take)
  have f4: "n ss ssa. take (length (take n (ss::symbol list))) (ssa::symbol list) = take (length ss) (take n ssa)"
    by (metis length_take take_take)
  have f5: "ss. take j (ss::symbol list) = take i (take j ss)"
    using a2 by (metis dual_order.strict_implies_order min.absorb2 take_take)
  have f6: "length (take j a) = j"
    using a1 by (metis dual_order.strict_implies_order length_take min.absorb2)
  then have f7: "n. min j n = length (take n (take j a))"
    by (metis length_take)
  have f8: "n ss. n = length (take n (ss::symbol list))  length ss < n"
    by (metis leI length_take min.absorb2)
  have f9: "ss. take j (ss::symbol list) = take j (take i ss)"
    using f7 f6 f5 by (metis take_take)
  have f10: "ss n. length (ss::symbol list)  n  length (take n ss) = n"
    using f8 by (metis dual_order.strict_implies_order)
  then have f11: "ss ssa. length (ss::symbol list) = length (take (length ss) (ssa::symbol list))  length (take (length ssa) ss) = length ssa"
    by (metis length_take min.absorb2)
  have f12: "ss ssa n. take (length (ss::symbol list)) (ssa::symbol list) = take n (take (length ss) ssa)  length (take n ss) = n"
    using f10 by (metis min.absorb2 take_take)
  { assume "¬ j < j"
    { assume "¬ j < j  i  j"
      moreover
      { assume "length a  j  length (take i a)  i"
        then have "ss. length (take (length (take i (take (length a) (ss::symbol list)))) (take j ss))  length (take i (take (length a) ss))"
          using f12 f11 f6 f5 f4 by metis
        then have "ss ssa. take (length (ss::symbol list)) (take j (ssa::symbol list))  take (length ss) (take i (take (length a) ssa))"
          using f11 by metis
        then have "length b  j"
          using f9 f4 f3 by metis }
      ultimately have "length b  j"
        using f7 f6 f5 f3 a1 by (metis length_take) }
    then have "length b = j  j < j"
      using a2 by metis }
  then have "j < length b"
    using f9 f8 f7 f6 f4 f3 by metis
  then show "j < length b  is_word (take j b)  is_nonterminal (b ! j)"
    using f9 f3 a2 a1 by (metis nth_take)
qed

definition derivation_ge :: "derivation  nat  bool"
where
  "derivation_ge D i = ( d  set D. fst d  i)"

lemma derivation_ge_cons: "derivation_ge (d#D) i = (fst d  i  derivation_ge D i)"
  by (auto simp add: derivation_ge_def)

lemma derivation_ge_append: 
  "derivation_ge (D@E) i = (derivation_ge D i  derivation_ge E i)"
  by (auto simp add: derivation_ge_def)

lemma leftmost_unaffected_Derivation: 
  "derivation_ge D (Suc i)  leftmost i a  Derivation a D b  leftmost i b"
proof (induct D arbitrary: a)
  case Nil thus ?case by auto
next
  case (Cons d D) 
  then have " x. Derives1 a (fst d) (snd d) x  Derivation x D b" by simp
  then obtain x where x1: "Derives1 a (fst d) (snd d) x" and x2: "Derivation x D b" by blast  
  with Cons have leftmost_x: "leftmost i x"
    apply (rule_tac leftmost_unaffected_Derives1[
           where a=a and j=i and b="x" and i="fst d" and r="snd d"])
    by (auto simp add: derivation_ge_def)
  with Cons x2 show ?case by (auto simp add: derivation_ge_def)
qed

lemma le_Derives1_take: 
  assumes le: "i  j" 
  and D: "Derives1 a j r b"
  shows "take i a = take i b"
proof -
  note Derives1_take[where a=a and i=j and r=r and b=b]
  with le D show ?thesis by (rule_tac le_take_same[where i=i and j=j], auto)
qed  

lemma Derivation_take: "derivation_ge D i  Derivation a D b  take i a = take i b"
proof(induct D arbitrary: a b)
  case Nil thus ?case by auto
next
  case (Cons d D)
  then have " x. Derives1 a (fst d) (snd d) x  Derivation x D b"
    by simp
  then obtain x where ax: "Derives1 a (fst d) (snd d) x" and xb: "Derivation x D b" by blast  
  from derivation_ge_cons Cons(2) have d: "i  fst d" and D: "derivation_ge D i" by auto
  note take_i_xb = Cons(1)[OF D xb]
  note take_i_ax = le_Derives1_take[OF d ax]
  from take_i_xb take_i_ax show ?case by auto
qed

lemma leftmost_cons_less: "i < length u  leftmost i (u@v) = leftmost i u"
  by (auto simp add: leftmost_def nth_append)

lemma leftmost_is_nonterminal: "leftmost i u  is_nonterminal (u ! i)"
  by (metis leftmost_def)

lemma is_word_is_terminal: "i < length u  is_word u  is_terminal (u ! i)"
  by (metis is_word_def list_all_length)
  
lemma leftmost_append: 
  assumes leftmost: "leftmost i (u@v)"
  and is_word: "is_word u"
  shows "length u  i"
proof (cases "i < length u")
  case False thus ?thesis by auto
next
  case True 
  with leftmost have "leftmost i u" using leftmost_cons_less[OF True] by simp
  then have is_nonterminal: "is_nonterminal (u ! i)" by (rule leftmost_is_nonterminal)
  note is_terminal = is_word_is_terminal[OF True is_word]
  note is_terminal_nonterminal[OF is_terminal is_nonterminal]
  then show ?thesis by auto
qed

lemma derivation_ge_empty[simp]: "derivation_ge [] i" 
by (simp add: derivation_ge_def)

lemma leftmost_notword: "leftmost i a  j > i  ¬ (is_word (take j a))"
by (metis is_terminal_nonterminal is_word_def leftmost_def list_all_take)

lemma leftmost_unique: "leftmost i a  leftmost j a  i = j" 
by (metis leftmost_def leftmost_notword linorder_neqE_nat)

lemma leftmost_Derives1: "leftmost i a  Derives1 a j r b  i  j"
by (metis Derives1_leftmost leftmost_unique)

lemma leftmost_Derives1_propagate: 
  assumes leftmost: "leftmost i a"
      and Derives1: "Derives1 a j r b"
    shows "(is_word b  i = j)  ( k. leftmost k b  i  k)"
proof -
  from leftmost_Derives1[OF leftmost Derives1] have ij: "i  j" by auto
  show ?thesis
  proof (cases "is_word b")
    case True show ?thesis
      by (metis Derives1 True ij le_neq_implies_less leftmost 
          leftmost_unaffected_Derives1 order_refl)
  next
    case False show ?thesis
      by (metis (no_types, opaque_lifting) Derives1 Derives1_bound Derives1_sentence2 
          Derives1_take append_take_drop_id ij le_neq_implies_less leftmost 
          leftmost_append leftmost_cons_less leftmost_def length_take 
          min.absorb2 nat_le_linear nonword_leftmost_exists not_le)
  qed
qed

lemma is_word_Derives1[elim]: "is_word a  Derives1 a i r b  False"
by (metis Derives1_leftmost is_terminal_nonterminal is_word_is_terminal leftmost_def)
  
lemma is_word_Derivation[elim]: "is_word a  Derivation a D b  D = []"
by (metis Derivation_leftmost is_terminal_nonterminal is_word_def 
    leftmost_def list_all_length)
 
lemma leftmost_Derivation: 
  "leftmost i a  Derivation a D b  j  i  derivation_ge D j"
proof (induct D arbitrary: a b i j)
  case Nil thus ?case by auto
next
  case (Cons d D)
  then have " x. Derives1 a (fst d) (snd d) x  Derivation x D b" by auto
  then obtain x where ax:"Derives1 a (fst d) (snd d) x" and xb:"Derivation x D b" by blast
  note ji = Cons(4)
  note i_fstd = leftmost_Derives1[OF Cons(2) ax]
  note disj = leftmost_Derives1_propagate[OF Cons(2) ax]
  thus ?case
  proof(induct rule: disjCases2)
    case 1 
    with xb have "D = []" by auto
    with 1 ji show ?case by (simp add: derivation_ge_def)
  next
    case 2 
    then obtain k where k: "leftmost k x" and ik: "i  k" by blast
    note ge = Cons(1)[OF k xb, where j=j]
    from ji ik i_fstd ge show ?case
      by (simp add: derivation_ge_cons)
  qed
qed

lemma derivation_ge_list_all: "derivation_ge D i = list_all (λ d. fst d  i) D"
by (simp add: Ball_set derivation_ge_def)

lemma split_derivation_leftmost:
  assumes "derivation_ge D i"
  and "¬ (derivation_ge D (Suc i))"
  shows " E F r. D = E@[(i, r)]@F  derivation_ge E (Suc i)"
proof -
  from assms have " k. k < length D  fst(D ! k)  i  ¬(fst(D ! k)  Suc i)"
    by (metis derivation_ge_def in_set_conv_nth)
  then have " k. k < length D  fst(D ! k) = i" by auto
  then show ?thesis
  proof(induct rule: ex_minimal_witness)
    case (Minimal k)
      then have k_len: "k < length D" and k_i: "fst (D ! k) = i" by auto
      let ?E = "take k D"
      let ?r = "snd (D ! k)"
      let ?F = "drop (Suc k) D"
      note split = split_list_at[OF k_len]
      from k_i have D_k: "D ! k = (i, ?r)" by auto
      show ?case
        apply (rule exI[where x="?E"])
        apply (rule exI[where x="?F"])
        apply (rule exI[where x="?r"])
        apply (subst D_k[symmetric])
        apply (rule conjI)
        apply (rule split)
        by (metis (mono_tags, lifting) Minimal.hyps(2) Suc_leI assms(1) 
            derivation_ge_list_all le_neq_implies_less list_all_length list_all_take)
  qed
qed

lemma Derives1_Derives1_swap:
  assumes "i < j"
  and "Derives1 a j p b"
  and "Derives1 b i q c"
  shows " b'. Derives1 a i q b'  Derives1 b' (j - 1 + length (snd q)) p c"
proof -
  from Derives1_split[OF assms(2)] obtain a1 a2 where
    a_src: "a = a1 @ [fst p] @ a2" and a_dest: "b = a1 @ snd p @ a2" 
    and a1_len: "length a1 = j" by blast
  note a = this
  from a have is_sentence_a1: "is_sentence a1"
    using Derives1_sentence2 assms(2) is_sentence_concat by blast
  from a have is_sentence_a2: "is_sentence a2"
    using Derives1_sentence2 assms(2) is_sentence_concat by blast
  from a have is_symbol_fst_p:  "is_symbol (fst p)"
    by (metis Derives1_sentence1 assms(2) is_sentence_concat is_sentence_cons)
  from Derives1_split[OF assms(3)] obtain b1 b2 where
    b_src: "b = b1 @ [fst q] @ b2" and b_dest: "c = b1 @ snd q @ b2" 
    and b1_len: "length b1 = i" by blast
  have a_take_j: "a1 = take j a" by (metis a1_len a_src append_eq_conv_conj) 
  have b_take_i: "b1 @ [fst q] = take (Suc i) b"
    by (metis append_assoc append_eq_conv_conj b1_len b_src length_append_singleton) 
  from a_take_j b_take_i  take_eq_take_append[where j=j and i="Suc i" and a=a]
  have " u. a1 = (b1 @ [fst q]) @ u"
    by (metis le_iff_add Suc_leI a1_len a_dest append_eq_conv_conj assms(1) take_add) 
  then obtain u where u1: "a1 = (b1 @ [fst q]) @ u" by blast
  then have j_i_u: "j = i + 1 + length u"
    using Suc_eq_plus1 a1_len b1_len length_append length_append_singleton by auto
  from u1 is_sentence_a1 have is_sentence_b1_u: "is_sentence b1  is_sentence u"
    using is_sentence_concat by blast    
  have u2: "b2 = u @ snd p @ a2" by (metis a_dest append_assoc b_src same_append_eq u1) 
  let ?b = "b1 @ (snd q) @ u @ [fst p] @ a2"
  from assms have q_dom: "q  " by auto
  have a_b': "Derives1 a i q ?b"
    apply (subst Derives1_def)
    apply (rule exI[where x="b1"])
    apply (rule exI[where x="u@[fst p]@a2"])
    apply (rule exI[where x="fst q"])
    apply (rule exI[where x="snd q"])
    apply (auto simp add: b1_len is_sentence_cons is_sentence_concat
           is_sentence_a2 is_symbol_fst_p is_sentence_b1_u a_src u1 q_dom)
    done
  from assms have p_dom: "p  " by auto
  have is_sentence_snd_q: "is_sentence (snd q)" 
    using Derives1_sentence2 a_b' is_sentence_concat by blast
  have b'_c: "Derives1 ?b (j - 1 + length (snd q)) p c"
    apply (subst Derives1_def)
    apply (rule exI[where x="b1 @ (snd q) @ u"])
    apply (rule exI[where x="a2"])
    apply (rule exI[where x="fst p"])
    apply (rule exI[where x="snd p"])
    apply (auto simp add: is_sentence_concat is_sentence_b1_u is_sentence_a2 p_dom
           is_sentence_snd_q b_dest u2 b1_len j_i_u)
    done
  show ?thesis
    apply (rule exI[where x="?b"])
    apply (rule conjI)
    apply (rule a_b')
    apply (rule b'_c)
    done
qed

definition derivation_shift :: "derivation  nat  nat  derivation"
where
  "derivation_shift D left right = map (λ d. (fst d - left + right, snd d)) D"

lemma derivation_shift_empty[simp]: "derivation_shift [] left right = []" 
  by (auto simp add: derivation_shift_def)

lemma derivation_shift_cons[simp]:
  "derivation_shift (d#D) left right = ((fst d - left + right, snd d)#(derivation_shift D left right))"
by (simp add: derivation_shift_def)

lemma Derivation_append: "Derivation a (D@E) c = ( b. Derivation a D b  Derivation b E c)"
proof(induct D arbitrary: a c E)
  case Nil thus ?case by auto
next
  case (Cons d D) thus ?case by auto
qed

lemma Derivation_implies_append: 
  "Derivation a D b  Derivation b E c  Derivation a (D@E) c"
using Derivation_append by blast

lemma Derivation_swap_single_end_to_front: 
  "i < j  derivation_ge D j  Derivation a (D@[(i,r)]) b 
   Derivation a ((i,r)#(derivation_shift D 1 (length (snd r)))) b"
proof(induct D arbitrary: a)
  case Nil thus ?case by auto
next
  case (Cons d D) 
  from Cons have " c. Derives1 a (fst d) (snd d) c  Derivation c (D @ [(i, r)]) b"
    by simp
  then obtain c where ac: "Derives1 a (fst d) (snd d) c"
    and cb: "Derivation c (D @ [(i, r)]) b" by blast
  from Cons(3) have D_j: "derivation_ge D j" by (simp add: derivation_ge_cons)
  from Cons(1)[OF Cons(2) D_j cb, simplified]
  obtain x where cx: "Derives1 c i r x" and  
    xb: "Derivation x (derivation_shift D 1 (length (snd r))) b" by auto
  have i_fst_d: "i < fst d" using Cons derivation_ge_cons by auto
  from Derives1_Derives1_swap[OF i_fst_d ac cx]
  obtain b' where ab': "Derives1 a i r b'" and 
    b'x: "Derives1 b' (fst d - 1 + length (snd r)) (snd d) x" by blast
  show ?case using ab' b'x xb by auto
qed    

lemma Derivation_swap_single_mid_to_front: 
  assumes "i < j"
  and "derivation_ge D j" 
  and "Derivation a (D@[(i,r)]@E) b"
  shows "Derivation a ((i,r)#((derivation_shift D 1 (length (snd r)))@E)) b"
proof -
  from assms have " x. Derivation a (D@[(i, r)]) x  Derivation x E b"
    using Derivation_append by auto
  then obtain x where ax: "Derivation a (D@[(i, r)]) x" and xb: "Derivation x E b"
    by blast
  with assms have "Derivation a ((i, r)#(derivation_shift D 1 (length (snd r)))) x"
    using Derivation_swap_single_end_to_front by blast
  then show ?thesis using Derivation_append xb by auto
qed

lemma length_derivation_shift[simp]: 
  "length(derivation_shift D left right) = length D"
  by (simp add: derivation_shift_def)

definition LeftDerives1 :: "sentence  nat  rule  sentence  bool"
where 
  "LeftDerives1 u i r v = (leftmost i u  Derives1 u i r v)"

lemma LeftDerives1_implies_leftderives1: "LeftDerives1 u i r v  leftderives1 u v"
by (metis Derives1_def LeftDerives1_def append_eq_conv_conj leftderives1_def 
    leftmost_def)
    
lemma leftmost_Derives1_leftderives: 
  "leftmost i a  Derives1 a i r b  leftderives b c  leftderives a c"
using LeftDerives1_def LeftDerives1_implies_leftderives1 
  leftderives1_implies_leftderives leftderives_trans by blast

theorem Derivation_implies_leftderives_gen:
  "Derivation a D (u@v)  is_word u  ( w. 
          leftderives a (u@w)  
          (v = []  w = [])  
          ( X. is_first X v  is_first X w))"
proof (induct "length D" arbitrary: D a u v)
  case 0
    then have "a = u@v" by auto
    thus ?case by (rule_tac x = v in exI, auto)
next
  case (Suc n)
    from Suc have "D  []" by auto
    with Suc Derivation_leftmost have " i. leftmost i a" by auto
    then obtain i where i: "leftmost i a" by blast
    show "?case"
    proof (cases "derivation_ge D (Suc i)")
      case True
        with Suc have leftmost: "leftmost i (u@v)" 
          by (rule_tac leftmost_unaffected_Derivation[OF True i], auto)
        have length_u: "length u  i" 
          using leftmost_append[OF leftmost Suc(4)] .
        have take_Suc: "take (Suc i) a = take (Suc i) (u@v)" 
          using  Derivation_take[OF True Suc(3)] .
        with length_u have is_prefix_u: "is_prefix u a"
          by (metis append_assoc append_take_drop_id dual_order.strict_implies_order 
              is_prefix_def le_imp_less_Suc take_all take_append)  
        have a: "u @ drop (length u) a = a" 
          using is_prefix_unsplit[OF is_prefix_u] .
        from take_Suc have length_take_Suc: "length (take (Suc i) a) = Suc i"
          by (metis Suc_leI i leftmost_def length_take min.absorb2)
        have v: "v  []"
        proof(cases "v = []")
          case False thus ?thesis by auto
        next
          case True
          with length_u have right: "length(take (Suc i) (u@v)) = length u" by simp
          note left = length_take_Suc
          from left right take_Suc have "Suc i = length u" by auto
          with length_u show ?thesis by auto
        qed
        then have " X w. v = X#w" by (cases v, auto)
        then obtain X w where v: "v = X#w" by blast
        have is_first_X: "is_first X (drop (length u) a)"
          apply (rule_tac is_first_drop_length[where v=v and w=w and k="Suc i"])
          apply (simp_all add: take_Suc v)
          apply (metis Suc_leI i leftmost_def)
          apply (insert length_u)
          apply arith
          done
        show ?thesis
          apply (rule exI[where x="drop (length u) a"])
          by (simp add: a v is_first_cons is_first_X)
    next
      case False
      have Di: "derivation_ge D i" 
      using leftmost_Derivation[OF i Suc(3), where j=i, simplified] .
      from split_derivation_leftmost[OF Di False]
      obtain E F r where D_split: "D = E @ [(i, r)] @ F" 
        and E_Suc: "derivation_ge E (Suc i)" by auto
      let ?D = "(derivation_shift E 1 (length (snd r)))@F"
      from D_split 
      have "Derivation a ((i,r) # ?D) (u @ v)"
        using Derivation_swap_single_mid_to_front E_Suc Suc.prems(1) lessI by blast
      then have " y. Derives1 a i r y  Derivation y ?D (u @ v)" by simp
      then obtain y where ay:"Derives1 a i r y" 
        and yuv: "Derivation y ?D (u @ v)" by blast
      have length_D': "length ?D = n" using D_split Suc.hyps(2) by auto
      from Suc(1)[OF length_D'[symmetric] yuv Suc(4)] 
      obtain w where "leftderives y (u @ w)" and "(v = []  w = [])" 
        and "X. is_first X v  is_first X w" by blast 
      then show ?thesis using ay i leftmost_Derives1_leftderives by blast
    qed    
qed   

lemma derives_implies_leftderives_gen: "derives a (u@v)  is_word u  ( w. 
          leftderives a (u@w)  
          (v = []  w = [])  
          ( X. is_first X v  is_first X w))"
using Derivation_implies_leftderives_gen derives_implies_Derivation by blast

lemma derives_implies_leftderives: "derives a b  is_word b  leftderives a b"
using derives_implies_leftderives_gen by force

fun LeftDerivation :: "sentence  derivation  sentence  bool"
where
  "LeftDerivation a [] b = (a = b)"
| "LeftDerivation a (d#D) b = ( x. LeftDerives1 a (fst d) (snd d) x  LeftDerivation x D b)"
  
lemma LeftDerives1_implies_Derives1: "LeftDerives1 a i r b  Derives1 a i r b"
by (metis LeftDerives1_def)

lemma LeftDerivation_implies_Derivation:
  "LeftDerivation a D b  Derivation a D b"
proof (induct D arbitrary: a)
  case (Nil) thus ?case by simp
next
  case (Cons d D)
  thus ?case
  using CFG.LeftDerivation.simps(2) CFG_axioms Derivation.simps(2) 
    LeftDerives1_implies_Derives1 by blast 
qed

lemma LeftDerivation_implies_leftderives: "LeftDerivation a D b  leftderives a b"
proof (induct D arbitrary: a b)
  case Nil thus ?case by simp
next
  case (Cons d D)
    note ihyps = this
    from ihyps have " x. LeftDerives1 a (fst d) (snd d) x  LeftDerivation x D b" by auto
    then obtain x where "LeftDerives1 a (fst d) (snd d) x" and xb: "LeftDerivation x D b" by blast
    with LeftDerives1_implies_leftderives1 have d1: "leftderives a x" by auto
    from ihyps xb have d2:"leftderives x b" by simp
    show "leftderives a b" by (rule leftderives_trans[OF d1 d2])
qed 

lemma leftmost_witness[simp]: "leftmost (length x) (x@(N#y)) = (is_word x  is_nonterminal N)"
  by (auto simp add: leftmost_def)

lemma leftderives1_implies_LeftDerives1: 
  assumes leftderives1: "leftderives1 u v"
  shows " i r. LeftDerives1 u i r v"
proof -
  from leftderives1 have 
    "x y N α. u = x @ [N] @ y  v = x @ α @ y  is_word x  is_sentence y  (N, α)  "
    by (simp add: leftderives1_def)
  then obtain x y N α where 
    u:"u = x @ [N] @ y" and
    v:"v = x @ α @ y" and
    x:"is_word x" and  
    y:"is_sentence y" and 
    r:"(N, α)  "
    by blast
  show ?thesis
    apply (rule_tac x="length x" in exI)
    apply (rule_tac x="(N, α)" in exI)
    apply (auto simp add: LeftDerives1_def)
    apply (simp add: leftmost_def x u rule_nonterminal_type[OF r])
    apply (simp add: Derives1_def u v)
    apply (rule_tac x=x in exI)
    apply (rule_tac x=y in exI)
    apply (auto simp add: x y r)
    done
qed    

lemma LeftDerivation_LeftDerives1: 
  "LeftDerivation a S y  LeftDerives1 y i r z  LeftDerivation a (S@[(i,r)]) z"
proof (induct S arbitrary: a y z i r)
  case Nil thus ?case by simp
next
  case (Cons s S) thus ?case 
    by (metis LeftDerivation.simps(2) append_Cons) 
qed

lemma leftderives_implies_LeftDerivation: "leftderives a b   D. LeftDerivation a D b"
proof (induct rule: leftderives_induct)
  case Base
  show ?case by (rule exI[where x="[]"], simp)
next
  case (Step y z)
  note ihyps = this
  from ihyps obtain D where ay: "LeftDerivation a D y" by blast
  from ihyps leftderives1_implies_LeftDerives1 obtain i r where yz: "LeftDerives1 y i r z" by blast
  from LeftDerivation_LeftDerives1[OF ay yz] show ?case by auto
qed

lemma LeftDerivation_append: 
  "LeftDerivation a (D@E) c = ( b. LeftDerivation a D b  LeftDerivation b E c)"
proof(induct D arbitrary: a c E)
  case Nil thus ?case by auto
next
  case (Cons d D) thus ?case by auto
qed

lemma LeftDerivation_implies_append: 
  "LeftDerivation a D b  LeftDerivation b E c  LeftDerivation a (D@E) c"
using LeftDerivation_append by blast

lemma Derivation_unique_dest: "Derivation a D b  Derivation a D c  b = c"
  apply (induct D arbitrary: a b c)
  apply auto
  using Derives1_unique_dest by blast

lemma Derivation_unique_src: "Derivation a D c  Derivation b D c  a = b"
  apply (induct D arbitrary: a b c)
  apply auto
  using Derives1_unique_src by blast

lemma LeftDerives1_unique: "LeftDerives1 a i r b  LeftDerives1 a j s b  i = j  r = s"
using Derives1_def LeftDerives1_def leftmost_unique by auto
 
lemma leftlang: " = { v | v. is_word v  is_leftderivation v }"
by (metis (no_types, lifting) CFG.is_derivation_def CFG.is_leftderivation_def 
    CFG.leftderivation_implies_derivation CFG_axioms Collect_cong 
    ℒ_def derives_implies_leftderives)
  
lemma leftprefixlang:  "P = { u | u v. is_word u  is_leftderivation (u@v) }"
apply (auto simp add: P_def)
using derives_implies_leftderives_gen is_derivation_def is_leftderivation_def apply blast
using leftderivation_implies_derivation by blast

lemma derives_implies_leftderives_cons:
  "is_word a  derives u (a@X#b)   c. leftderives u  (a@X#c)"
by (metis append_Cons append_Nil derives_implies_leftderives_gen is_first_def) 

lemma is_word_append[simp]: "is_word (a@b) = (is_word a  is_word b)"
  by (auto simp add: is_word_def)

lemma P_split: "a@b  P  a  P"
  by (auto simp add: P_def)

lemma P_is_word: "a  P  is_word a"
  by (metis (no_types, lifting) leftprefixlang mem_Collect_eq)

definition Derive :: "sentence  derivation  sentence"
where 
  "Derive a D = (THE b. Derivation a D b)"

lemma Derivation_dest_ex_unique: "Derivation a D b  ∃! x. Derivation a D x"
using CFG.Derivation_unique_dest CFG_axioms by blast

lemma Derive:
  assumes ab: "Derivation a D b"
  shows "Derive a D = b"
proof -
  note the1_equality[OF Derivation_dest_ex_unique[OF ab] ab]
  thus ?thesis by (simp add: Derive_def)
qed

end

end