theory CFG
imports Main Containers.Containers
begin

type_synonym ('a, 'b) symbol = "('a + 'b)"

type_synonym ('a, 'b) rule = "('a , 'b) symbol \<times> ('a , 'b) symbol list"

type_synonym ('a, 'b) sentence = "('a , 'b) symbol list"

locale CFG =
  fixes \<A> :: "'a::ccompare set" (*nonterminal set*)
  fixes \<B> :: "'b::ccompare set" (*terminal set*)
  fixes \<RR> :: "('a, 'b) rule set"
  fixes \<S> ::"'a"
  assumes finite_grammar:"finite \<RR>"
  assumes finite_terminals:"finite \<B>"
  assumes startsymbol_dom: "\<S> \<in> \<A>"
  assumes validRules: "\<forall> (N, \<alpha>) \<in> \<RR>. N \<in> (Inl ` \<A>) \<and> (\<forall> s \<in> set \<alpha>. s \<in> (Inl ` \<A>) \<union> (Inr ` \<B>))"
begin

definition \<NN>::"('a, 'b) symbol set" where
"\<NN> = Inl ` \<A>"

definition \<TT>::"('a, 'b) symbol set" where
"\<TT> = Inr ` \<B>"

definition \<SS>::"('a, 'b) symbol" where
"\<SS> = Inl \<S>"

lemma  disjunct_symbols:"\<TT> \<inter> \<NN> = {}"
  by(auto simp add: \<TT>_def \<NN>_def)

definition is_terminal :: "('a, 'b) symbol \<Rightarrow> bool"
where
  "is_terminal = case_sum (\<lambda> t. False) (\<lambda> s. s \<in> \<B>) "

definition is_nonterminal :: "('a, 'b) symbol \<Rightarrow> bool"
where
  "is_nonterminal = case_sum  (\<lambda> s. s \<in> \<A>) (\<lambda> t. False)"

lemma is_nonterminal_startsymbol:"is_nonterminal  \<SS>"
  by (simp add: is_nonterminal_def startsymbol_dom \<SS>_def)

definition is_symbol :: "('a, 'b) symbol \<Rightarrow> bool"
where
  "is_symbol s = (is_terminal s \<or> is_nonterminal s)"

lemma \<SS>_symbol:"is_symbol \<SS>"
  by (auto simp add: is_symbol_def \<SS>_def is_nonterminal_def startsymbol_dom)

definition is_sentence :: "('a, 'b) sentence \<Rightarrow> bool"
where
  "is_sentence s =  list_all is_symbol s"

definition is_word :: "('a, 'b) sentence \<Rightarrow> bool"
where
  "is_word s = list_all is_terminal s"

definition derives1 :: "('a, 'b) sentence \<Rightarrow> ('a, 'b) sentence \<Rightarrow> bool"
where
  "derives1 u v =
     (\<exists> x y N \<alpha>.
          u = x @ [N] @ y
        \<and> v = x @ \<alpha> @ y
        \<and> is_sentence x
        \<and> is_sentence y
        \<and> (N, \<alpha>) \<in> \<RR>)"

definition derivations1 :: "(('a, 'b) sentence \<times> ('a, 'b) sentence) set"
where
  "derivations1 = { (u,v) | u v. derives1 u v }"

definition derivations :: "(('a, 'b) sentence \<times> ('a, 'b) sentence) set"
where
  "derivations = derivations1^*"

definition derives :: "('a, 'b) sentence \<Rightarrow> ('a, 'b) sentence \<Rightarrow> bool"
where
  "derives u v = ((u, v) \<in> derivations)"

definition is_derivation :: "('a, 'b) sentence \<Rightarrow> bool"
where
  "is_derivation u = derives [\<SS>] u"

definition \<L> :: "('a, 'b) sentence set"
where
  "\<L> = { v | v. is_word v \<and> is_derivation v}"

definition \<L>_t::"'b list set" where
"\<L>_t = (map projr )` \<L>"

lemma word_proj[simp]:"is_word b \<Longrightarrow> map (Inr ) (map projr b) = b"
  apply(induction b)
   apply(auto simp add: is_word_def is_terminal_def split: sum.splits)
  done
lemma " map Inr `  \<L>_t =  \<L>"
  apply(auto simp add:  \<L>_def  \<L>_t_def simp del: map_map)
using word_proj
  by (metis (no_types, lifting) imageI mem_Collect_eq)

definition "\<L>\<^sub>P"  :: "('a, 'b) sentence set"
where
  "\<L>\<^sub>P = { u | u v. is_word u \<and> is_derivation (u@v) }"

end

end


(* Proofs: ------------------------------------------------- *)
theory Example06
imports Main
begin

(* Isabelle isn't just a tool for defining and calculating
   values: it can also be used to help us prove properties.

   Isabelle helps to automate the task of constructing proofs:

   - it checks all of the proof steps to make sure that they
     are valid

   - it has built in algorithms/tactics for simplifying
     complicated terms, searching for proofs by exploring
     different proof strategies, etc...

   But, in general, it still needs guidance from a human
   operator (which is why we refer to Isabelle as a proof
   *assistant*.  In this lab, we'll limit ourselves to
   a very small (but important) set of the tools that
   Isabelle provides:

   - the ability to perform proofs by induction

   - automatic proof search (using "auto")

   - the definition of intermediate "lemmas"

   By following the model of some of the examples that we
   provide, you should be able to construct very simple
   proofs on your own.  However, this is an advanced and
   deep topic, so you can be assured that we won't expect
   you to construct substantial new proofs on your own.
*)

(* We previously defined a function for calculating the
   maximum of two inputs:
*)
definition myMax :: "int \<Rightarrow> int \<Rightarrow> int"
 where "myMax x y = (if x > y then x else y)"
value "myMax 5 4"
value "myMax 4 5"

(* We would expect the maximum of two numbers to be
   greater than or equal to each of those two numbers:
*)
lemma "(myMax x y \<ge> x) \<and> (myMax x y \<ge> y)"
  apply (simp add: myMax_def)
  done

(* We also defined a function for adding up the numbers
   in a list of integers:
*)
fun sum :: "int list \<Rightarrow> int"
  where "sum []       = 0"
      | "sum (x # xs) = x + sum xs"

(* We would expect the sum of a concatenated pair of lists
   to give the same result as adding the sums of the
   individual lists:
*)
theorem "sum (xs @ ys) = sum xs + sum ys"
  apply (induction xs)
  apply auto
  done

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


theory T50
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z)))
"
nitpick[card nat=7,timeout=86400]
oops
end


theory AbstractSwapOrNotShuffle
imports
  HOL.List
  "HOL-Library.Permutation"
  "HOL-Algebra.Ring"
begin

(* Swap or not primitive for shuffling a single element *)
definition (in abelian_group)
  swap_or_not  :: "'a \<Rightarrow> ('a \<times> ('a set \<Rightarrow> bool)) list \<Rightarrow> 'a"
where
  "swap_or_not x kfs \<equiv>
    fold
      (\<lambda>(ki, fi) x. let
        x' = ki \<ominus> x in
        if fi {x, x'} then x' else x
      )
      kfs
      x"

lemma (in abelian_group) swap_or_not_nil:
  "swap_or_not x [] = x"
  by (fastforce simp: swap_or_not_def)

lemma (in abelian_group) swap_or_not_rec:
  "swap_or_not x ((ki, fi) # kfs) =
    (if fi {x, ki \<ominus> x} then
      swap_or_not (ki \<ominus> x) kfs
    else
      swap_or_not x kfs)"
  by (fastforce simp: swap_or_not_def)

(* Swap or not shuffle on lists, parameterised by keys (k) and round functions (f) *)
(* The number of rounds is determined by the number of keys and round functions provided *)
definition (in abelian_group)
  swap_or_not_shuffle :: "'a list \<Rightarrow> ('a \<times> ('a set \<Rightarrow> bool)) list \<Rightarrow> 'a list"
where
  "swap_or_not_shuffle xs kfs \<equiv> [swap_or_not x kfs. x \<leftarrow> xs]"

lemma (in abelian_group) swap_or_not_shuffle_rec:
  "swap_or_not_shuffle xs (kfs @ [(k, f)]) =
     map (\<lambda>x. swap_or_not x [(k, f)]) (swap_or_not_shuffle xs kfs)"
  by (fastforce simp: swap_or_not_shuffle_def swap_or_not_def)

(* Mapping a bijection over a permuted list yields another permutation *)
lemma map_perm:
  "\<lbrakk>xs <~~> ys; bij_betw f (set ys) (set ys); distinct xs\<rbrakk>
  \<Longrightarrow> xs <~~> map f ys"
  apply (clarsimp simp: mset_eq_perm[symmetric])
  apply (clarsimp simp: bij_betw_def dest!: mset_set_set[symmetric])
  using image_mset_mset_set mset_eq_setD by fastforce

lemma (in abelian_group) plus_left_cancel:
  "\<lbrakk>a \<oplus> b = a \<oplus> c; a \<in> carrier G; b \<in> carrier G; c \<in> carrier G\<rbrakk> \<Longrightarrow> b = c"
  by fastforce

lemma (in abelian_group) minus_left_cancel:
  "\<lbrakk>a \<ominus> b = a \<ominus> c; a \<in> carrier G; b \<in> carrier G; c \<in> carrier G\<rbrakk> \<Longrightarrow> b = c"
  by (metis add.Units_eq add.Units_l_cancel add.inv_closed l_neg local.minus_eq)

lemma (in abelian_group) double_minus_eq:
  "\<lbrakk>a \<in> carrier G; b \<in> carrier G\<rbrakk> \<Longrightarrow> a \<ominus> (a \<ominus> b) = b"
  by (metis (no_types, lifting) abelian_group.minus_add abelian_group.minus_minus
      abelian_group.r_neg1 abelian_group_axioms add.inv_closed local.minus_eq)

(* The swap or not function is a bijection *)
lemma (in abelian_group) swap_or_not_bij:
  "k \<in> carrier G \<Longrightarrow>
   set xs = carrier G \<Longrightarrow>
   bij_betw (\<lambda>x. swap_or_not x [(k, f)]) (set xs) (set xs)"
  apply (clarsimp simp: bij_betw_def)
  apply (rule conjI)
   apply (clarsimp simp: swap_or_not_def Let_def inj_on_def)
   apply safe
      apply (erule (1) minus_left_cancel)
       apply ((fastforce simp: double_minus_eq insert_commute)+)[4]
   apply (fastforce simp: swap_or_not_def Let_def)
  apply (clarsimp simp: swap_or_not_def Let_def image_def)
  apply (frule_tac x="k \<ominus> x" in bspec;
         fastforce simp: double_minus_eq insert_commute)
  done

(* Swap or not shuffle yields a permutation of the original list *)
lemma (in abelian_group) swap_or_not_shuffle_perm:
  "\<lbrakk>distinct xs; set xs = carrier G; set (map fst kfs) \<subseteq> carrier G\<rbrakk>
  \<Longrightarrow> xs <~~> swap_or_not_shuffle xs kfs"
  apply (induct kfs arbitrary: xs rule: List.rev_induct)
   apply (fastforce simp: swap_or_not_shuffle_def swap_or_not_nil)
  apply (rename_tac kf kfs' xs')
  apply (case_tac kf, rename_tac k f)
  apply (clarsimp simp: swap_or_not_shuffle_rec)
  apply (rule map_perm)
    apply fastforce
   apply (erule swap_or_not_bij)
  using perm_set_eq by blast

end