(*  Author:  Gertrud Bauer, Tobias Nipkow  *)

section\<open>Properties of Patch Enumeration\<close>

theory EnumeratorProps
imports Enumerator GraphProps
begin

lemma length_hideDupsRec[simp]: "\<And>x. length(hideDupsRec x xs) = length xs"
by(induct xs) auto

lemma length_hideDups[simp]: "length(hideDups xs) = length xs"
by(cases xs) simp_all

lemma length_indexToVertexList[simp]:
 "length(indexToVertexList x y xs) = length xs"
by(simp add:indexToVertexList_def)

(***************************** List not decreasing ***************************)
definition increasing :: "('a::linorder) list \<Rightarrow> bool" where
 "increasing ls \<equiv> \<forall> x y as bs. ls = as @ x # y # bs \<longrightarrow> x \<le> y"

lemma increasing1: "\<And> as x. increasing ls \<Longrightarrow> ls = as @ x # cs @ y # bs \<Longrightarrow> x \<le> y"
proof (induct cs)
  case Nil then show ?case
    by (auto simp: increasing_def)
next
  case (Cons c cs) then show ?case
    apply (subgoal_tac "c \<le> y")
    apply (force simp: increasing_def)
    apply (rule_tac Cons) by simp_all
qed

lemma increasing2: "increasing (as@bs) \<Longrightarrow> x \<in> set as \<Longrightarrow> y \<in> set bs \<Longrightarrow> x \<le> y"
proof-
  assume n:"increasing (as@bs)" and x:"x \<in> set as" and y: "y \<in> set bs"
  from x obtain as' as'' where as: "as = as' @ x # as''" by (auto simp: in_set_conv_decomp)
  from y obtain bs' bs'' where bs: "bs = bs' @ y # bs''" by (auto simp: in_set_conv_decomp)
  from n as bs show ?thesis
  apply (auto intro!: increasing1)
  apply (subgoal_tac "as' @ x # as'' @ bs' @ y # bs'' = as' @ x # (as'' @ bs') @ y # bs''")
  by (assumption) auto
qed

lemma increasing3: "\<forall> as bs. (ls = as @ bs \<longrightarrow> (\<forall> x \<in> set as. \<forall> y \<in> set bs. x \<le> y)) \<Longrightarrow> increasing (ls)"
apply (simp add: increasing_def) apply safe
proof -
  fix as bs x y
  assume p: "\<forall>asa bsa. as @ x # y # bs = asa @ bsa \<longrightarrow> (\<forall>x\<in>set asa. \<forall>y\<in>set bsa. x \<le> y)"
  then have p': "\<And> asa bsa. as @ x # y # bs = asa @ bsa \<Longrightarrow> (\<forall>x\<in>set asa. \<forall>y\<in>set bsa. x \<le> y)" by auto
  then have "(\<forall>x\<in>set (as @ [x]). \<forall>y\<in>set (y # bs). x \<le> y)" by (rule_tac p') auto
  then show "x \<le> y" by (auto simp: increasing_def)
qed

lemma increasing4: "increasing (as@bs) \<Longrightarrow> increasing as"
apply (simp add: increasing_def) apply safe by auto

lemma increasing5: "increasing (as@bs) \<Longrightarrow> increasing bs"
proof -
  assume nd: "increasing (as@bs)"
  then have r: "\<And> x y asa bsa. (\<exists>asa bsa. as @ bs = asa @ x # y # bsa) \<Longrightarrow> x \<le> y" by (auto simp: increasing_def)
  show ?thesis apply (clarsimp simp add: increasing_def)
    apply (rule_tac r)
    apply (rule_tac x="as @ _" in exI)
    apply auto
    done
qed

(*********************************** EnumeratorProps *************************************)

(********** enumBase ***********)

lemma enumBase_length: "ls \<in> set (enumBase nmax) \<Longrightarrow> length ls = 1"
by (auto simp: enumBase_def)

lemma enumBase_bound: "\<forall>y \<in> set (enumBase nmax). \<forall>z \<in> set y. z \<le> nmax"
by (auto simp: enumBase_def)

lemmas enumBase_simps = enumBase_length enumBase_bound

(********** enumAppend ************)

lemma enumAppend_bound: "ls \<in> set ((enumAppend nmax) lss) \<Longrightarrow>
 \<forall> y \<in> set lss. \<forall> z \<in> set y. z \<le> nmax \<Longrightarrow> x \<in> set ls \<Longrightarrow> x \<le>  nmax"
by (auto simp add: enumAppend_def split: if_split_asm)

lemma enumAppend_bound_rec: "ls \<in> set (((enumAppend nmax) ^^ n) lss) \<Longrightarrow>
  \<forall> y \<in> set lss. \<forall> z \<in> set y. z \<le> nmax \<Longrightarrow> x \<in> set ls \<Longrightarrow> x \<le>  nmax"
proof -
  assume ls: "ls \<in> set ((enumAppend nmax ^^ n) lss)" and lss: "\<forall>y\<in>set lss. \<forall>z\<in>set y. z \<le> nmax" and x: "x \<in> set ls"
  have ind:"\<And> lss. \<forall>y\<in>set lss. \<forall>z\<in>set y. z \<le> nmax \<Longrightarrow> \<forall> y \<in> set (((enumAppend nmax) ^^ n) lss). \<forall> z \<in> set y. z \<le> nmax"
  proof (induct n)
    case 0 then show ?case by auto
  next
    case (Suc n) show ?case apply (intro ballI) apply (rule enumAppend_bound) by (auto intro!: Suc)
  qed
  with lss have "\<forall> y \<in> set (((enumAppend nmax) ^^ n) lss). \<forall> z \<in> set y. z \<le> nmax" apply (rule_tac ind) .
  with ls x show ?thesis by auto
qed

lemma enumAppend_increase_rec:
  "\<And> m as bs. ls \<in> set (((enumAppend nmax) ^^ m) (enumBase nmax)) \<Longrightarrow>
  as @ bs = ls \<Longrightarrow>  \<forall> x \<in> set as. \<forall> y \<in> set bs. x \<le> y"
apply (induct ls rule: rev_induct) apply force apply auto apply (case_tac "m") apply simp  apply (drule_tac enumBase_length)
apply (case_tac as) apply simp_all
proof -
  fix x xs m as bs xa xb n
  assume ih: "\<And>m as bs.
           \<lbrakk>xs \<in> set ((enumAppend nmax ^^ m) (enumBase nmax)); as @ bs = xs\<rbrakk>
           \<Longrightarrow> \<forall>x\<in>set as. \<forall>xa\<in>set bs. x \<le> xa"
    and xs:"xs @ [x] \<in> set (enumAppend nmax ((enumAppend nmax ^^ n) (enumBase nmax)))"
    and asbs: "as @ bs = xs @ [x]" and xa:"xa \<in> set as" and xb: "xb \<in> set bs" and m: "m = Suc n"
  from ih have ih2: "\<And> as bs x y. \<lbrakk>xs \<in> set ((enumAppend nmax ^^ n) (enumBase nmax)); as @ bs = xs; x \<in> set as; y \<in> set bs\<rbrakk>
           \<Longrightarrow> x \<le> y" by auto

  from xb have "bs \<noteq> []"  by auto
  then obtain bs' b where bs': "bs = bs' @ [b]" apply (cases rule: rev_exhaust) by auto
  with asbs have beq:"b = x" by auto
  from bs' asbs have xs': "as @ bs' = xs" by auto
  with xs have "xa \<le> x"
  proof (cases "xs" rule: rev_exhaust)
    case Nil with xa xs' show ?thesis by auto
  next
    case (snoc ys y)
    have "xa \<le> y"
    proof (cases "xa = y")
      case True then show ?thesis by auto
    next
      case False
      from xa xs' have "xa \<in> set xs" by auto
      with False snoc have "xa \<in> set ys" by auto
      with xs snoc  show ?thesis
        apply (rule_tac ih2)
        by (auto simp: enumAppend_def)
    qed
    with xs snoc show "xa \<le> x" by (auto simp: enumAppend_def split:if_split_asm)
  qed
  then show "xa \<le> xb" apply (cases "xb = b") apply (simp add: beq)
  proof (rule_tac ih2)
    from xs
    show "xs \<in> set ((enumAppend nmax ^^ n) (enumBase nmax))"
    by (auto simp: enumAppend_def)
  next
    from xs' show "as @ bs' = xs" by auto
  next
    from xa show "xa \<in> set as" by auto
  next
    assume "xb \<noteq> b"
    with xb bs' show "xb \<in> set bs'" by auto
  qed
qed

lemma enumAppend_length1: "\<And>ls. ls \<in> set ((enumAppend nmax ^^ n) lss) \<Longrightarrow>
 (\<forall>l \<in> set lss. |l| = k) \<Longrightarrow> |ls| = k + n"
apply (induct n)
apply simp
by (auto simp add:enumAppend_def split: if_split_asm)

lemma enumAppend_length2: "\<And>ls. ls \<in> set ((enumAppend nmax ^^ n) lss) \<Longrightarrow>
 (\<And>l. l \<in> set lss \<Longrightarrow> |l| = k) \<Longrightarrow> K = k + n \<Longrightarrow> |ls| = K"
 by (auto simp add: enumAppend_length1)

(*********** enum *********)

lemma enum_enumerator:
 "enum i j = enumerator i j"
by(simp add: enum_def enumTab_def tabulate2_def tabulate_def)

(*********** enumerator *********)

lemma enumerator_hd: "ls \<in> set (enumerator m n) \<Longrightarrow> hd ls = 0"
by (auto simp: enumerator_def split: if_split_asm)

lemma enumerator_last: "ls \<in> set (enumerator m n) \<Longrightarrow> last ls = (n - 1)"
by (auto simp: enumerator_def split: if_split_asm)

lemma enumerator_length: "ls \<in> set (enumerator m n) \<Longrightarrow> 2 \<le> length ls"
by (auto simp: enumerator_def split: if_split_asm)

lemmas set_enumerator_simps = enumerator_hd enumerator_last enumerator_length

lemma enumerator_not_empty[dest]: "ls \<in> set (enumerator m n) \<Longrightarrow> ls \<noteq>  []"
apply (subgoal_tac "2 \<le> length ls") apply force  by (rule enumerator_length)

lemma enumerator_length2: "ls \<in> set (enumerator m n) \<Longrightarrow> 2 < m \<Longrightarrow> length ls = m"
proof -
  assume ls:"ls \<in> set (enumerator m n)" and m: "2 < m"
  define k where "k = m - 3"
  with m have k: "m = k + 3" by arith
  with ls have "ls \<in> set (enumerator (k+3) n)" by auto
  then have "length ls = k + 3"
    apply (auto simp: enumerator_def enumBase_def)
    apply (erule enumAppend_length2) by auto
  with k show ?thesis by simp
qed

lemma enumerator_bound: "ls \<in> set (enumerator m nmax) \<Longrightarrow>
 0 < nmax \<Longrightarrow> x \<in> set ls \<Longrightarrow> x < nmax"
apply (auto simp: enumerator_def split: if_split_asm)
apply (subgoal_tac "x \<le> nmax - 2") apply arith
apply (rule_tac enumAppend_bound_rec) by(auto simp:enumBase_simps)

lemma enumerator_bound3: "ls \<in> set (enumerator m nmax) \<Longrightarrow> 1 < nmax \<Longrightarrow> last (butlast ls) < nmax - Suc 0"
apply (case_tac "ls" rule: rev_exhaust) apply force
apply (rule_tac enumerator_bound2) apply assumption
apply auto
apply (case_tac "ys" rule: rev_exhaust) apply simp
apply (subgoal_tac "2 \<le> length (ys @ [y])") apply simp
apply (rule_tac enumerator_length) by auto

lemma enumerator_increase: "\<And> as bs. ls \<in> set (enumerator m nmax) \<Longrightarrow>  as @ bs = ls \<Longrightarrow> \<forall> x \<in> set as. \<forall> y \<in> set bs. x \<le> y"
apply (auto simp: enumerator_def del: Nat.diff_is_0_eq' split: if_split_asm intro: enumAppend_increase_rec)
apply (case_tac as) apply simp apply simp
apply (case_tac bs rule: rev_exhaust)  apply simp apply simp apply auto
apply (drule_tac enumAppend_bound_rec) apply (auto simp:enumBase_simps)
by (auto dest!: enumAppend_increase_rec)

lemma enumerator_increasing: "ls \<in> set (enumerator m nmax) \<Longrightarrow> increasing ls"
apply (rule increasing3)
by (auto dest: enumerator_increase)

definition incrIndexList :: "nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
 "incrIndexList ls m nmax \<equiv>
  1 < m \<and> 1 < nmax \<and>
  hd ls = 0 \<and> last ls = (nmax - 1) \<and> length ls = m
 \<and> last (butlast ls) < last ls \<and> increasing ls"

lemma incrIndexList_1lem[simp]: "incrIndexList ls m nmax \<Longrightarrow> Suc 0 < m"
by (unfold incrIndexList_def) simp

lemma incrIndexList_1len[simp]: "incrIndexList ls m nmax \<Longrightarrow> Suc 0 < nmax"
by (unfold incrIndexList_def) simp

lemma incrIndexList_help2[simp]: "incrIndexList ls m nmax \<Longrightarrow> hd ls = 0"
by (unfold incrIndexList_def) simp

lemma incrIndexList_help21[simp]: "incrIndexList (l # ls) m nmax \<Longrightarrow> l = 0"
by (auto dest: incrIndexList_help2)

lemma incrIndexList_help3[simp]: "incrIndexList ls m nmax \<Longrightarrow> last ls = (nmax - (Suc 0))"
by (unfold incrIndexList_def)  simp

lemma incrIndexList_help4[simp]: "incrIndexList ls m nmax \<Longrightarrow> length ls = m "
by (unfold incrIndexList_def)  simp

lemma incrIndexList_help5[intro]: "incrIndexList ls m nmax \<Longrightarrow>  last (butlast ls) < nmax - Suc 0"
by (unfold incrIndexList_def) auto

lemma incrIndexList_help6[simp]: "incrIndexList ls m nmax \<Longrightarrow> increasing ls"
by (unfold incrIndexList_def) simp

lemma incrIndexList_help7[simp]: "incrIndexList ls m nmax \<Longrightarrow> ls \<noteq> []"
apply (subgoal_tac "length ls \<noteq>  0") apply force
apply simp
apply (subgoal_tac "1 < m")  apply arith apply force done

lemma incrIndexList_help71[simp]: "\<not> incrIndexList [] m nmax"
by (auto dest: incrIndexList_help7)

lemma incrIndexList_help8[simp]: "incrIndexList ls m nmax \<Longrightarrow> butlast ls \<noteq> []"
proof (rule ccontr)
  assume props: "incrIndexList ls m nmax" and butl: "\<not> butlast ls \<noteq> []"
  then have "ls \<noteq> []" by auto
  then have ls': "ls = (butlast ls) @ [last ls]" by auto
  define l where "l = last ls"
  with butl ls' have "ls = [l]" by auto
  then have "length ls = 1" by auto
  with props have "m = 1" by auto
  with props show "False" by (auto dest: incrIndexList_1lem)
qed

lemma incrIndexList_help81[simp]: "\<not> incrIndexList [l] m nmax"
by (auto dest: incrIndexList_help8)

lemma incrIndexList_help9[intro]: "(incrIndexList ls m nmax)  \<Longrightarrow>
  x \<in> set (butlast ls) \<Longrightarrow> x \<le> nmax - 2"
proof -
  assume props: "(incrIndexList ls m nmax)"  and x: "x \<in> set (butlast ls)"
  then have "last (butlast ls) < last ls" by auto
  with props have "last (butlast ls) < nmax - 1" by auto
  then have leq: "last (butlast ls) \<le>  nmax - 2" by arith
  from props  have "ls \<noteq> []" by auto
  then have ls1: "ls = butlast ls @ [last ls]" by auto
  define ls' where "ls' = butlast (butlast ls)"
  define last2 where "last2 = last (butlast ls)"
  define last1 where "last1 = last ls"
  from props  have "butlast ls \<noteq> []" by auto
  with ls'_def last2_def have bls: "butlast ls = ls' @ [last2]" by auto
  with last1_def ls1 props have ls3: "ls = ls' @ [last2] @ [last1]" by auto
  from props  have "increasing ls" by auto
  with ls3 have increasing: "increasing (ls' @ ([last2] @ [last1]))" by auto
  then have "x \<in> set ls' \<Longrightarrow> x \<le> last2" by (auto intro: increasing2)
  then have "x \<in> set (ls' @ [last2]) \<Longrightarrow> x \<le> last2" by auto
  with bls x have "x \<le> last2" by auto
  with leq last2_def show ?thesis by auto
qed

lemma incrIndexList_help10[intro]: "(incrIndexList ls m nmax)  \<Longrightarrow>
  x \<in> set ls \<Longrightarrow> x < nmax" apply (cases ls rule: rev_exhaust) apply auto
  apply (frule incrIndexList_help3) apply (auto dest: incrIndexList_1len)
  apply (frule incrIndexList_help9) apply auto apply (drule incrIndexList_1len)
  by arith

lemma enumerator_correctness: "2 < m \<Longrightarrow> 1 < nmax \<Longrightarrow>
  ls \<in> set (enumerator m nmax) \<Longrightarrow>
  incrIndexList ls m nmax"
proof -
  assume m: "2 < m" and nmax: "1 < nmax" and enum: "ls \<in> set (enumerator m nmax)"
  then have "(hd ls = 0 \<and> last ls = (nmax - 1) \<and> length ls = m \<and> last (butlast ls) < last ls \<and>  increasing ls)"
    by (auto intro: enumerator_increasing enumerator_hd enumerator_last enumerator_length2 enumerator_bound3 simp: set_enumerator_simps)
  with m nmax show ?thesis by (unfold incrIndexList_def) auto
qed

lemma enumerator_completeness_help: "\<And> ls. increasing ls \<Longrightarrow> ls \<noteq> [] \<Longrightarrow> length ls = Suc ks \<Longrightarrow> list_all (\<lambda>x. x < Suc nmax) ls \<Longrightarrow> ls \<in> set ((enumAppend nmax ^^ ks) (enumBase nmax))"
proof (induct ks)
  case 0
  assume "increasing ls" "ls \<noteq> []" "length ls = Suc 0" "list_all (\<lambda>x. x < Suc nmax) ls"
  then have "\<exists> x. ls = [x]"
    apply (case_tac "ls::nat list") by auto
  then obtain x where ls1: "ls = [x]" by auto
  with 0 have "x < Suc nmax" by auto
  with ls1 show ?case apply (simp add: enumBase_def) by auto
next
  case (Suc n)
  define ls' where "ls' = butlast ls"
  define l where "l = last ls"
  define ll where "ll = last ls'"
  define bl where "bl = butlast ls'"
  define ls'list where "ls'list = (enumAppend nmax ^^ n) (enumBase nmax)"
  then have short: "(enumAppend nmax ^^ n) (enumBase nmax) = ls'list" by simp
  from Suc have "ls \<noteq> []" by auto
  then have "ls = butlast ls @ [last ls]" by auto
  with ls'_def l_def have ls1: "ls = ls' @ [l]" by auto
  with Suc have "length ls' = Suc n" by auto
  then have ls'ne: "ls' \<noteq> []" by auto
  with ll_def bl_def have ls'1: "ls' = bl @ [ll]" by auto
  then have ll_in_ls': "ll \<in> set ls'" by simp
  from Suc ls1 have "list_all (\<lambda>x. x < Suc nmax) ls'" by auto
  with ll_in_ls' have "ll < Suc nmax" by (induct ls') auto
  with ll_def have llsmall: "last ls' \<le> nmax"  by auto

  from ls1 have l_in_ls: "l \<in> set ls" by auto
  from Suc have "list_all (\<lambda>x. x < Suc nmax) ls" by auto
  with l_in_ls have "l < Suc nmax" by (induct ls) auto
  then have lo: "l \<le> nmax" by auto

  from Suc ls1 ls'1 have "increasing ((bl @ [ll]) @ [l])" by auto
  then have "ll \<le>  l" by (rule increasing2) auto
  with ll_def have lu: "last ls' \<le> l" by simp

  from Suc ls1 have vors: "ls' \<in> set ((enumAppend nmax ^^ n) (enumBase nmax))"
    by (rule_tac Suc) (auto intro: increasing4)
  with short have "ls' \<in> set ls'list"  by  auto
  with short llsmall ls1 lo lu show ?case  apply simp  apply (simp add: enumAppend_def)
    apply (intro bexI) by auto
qed

lemma enumerator_completeness: "2 < m \<Longrightarrow> incrIndexList ls m nmax \<Longrightarrow>
  ls \<in> set (enumerator m nmax)"
proof -
  assume m: "2 < m" and props: "incrIndexList ls m nmax"
  then have props': "(hd ls = 0 \<and> last ls = (nmax - 1)
   \<and> length ls = m \<and> last (butlast ls) < last ls \<and>  increasing ls)"
   by (unfold incrIndexList_def) auto
  show ?thesis
  proof -
    have props'': "hd ls = 0 \<and> last ls = (nmax - 1) \<and> length ls = m \<and>
       increasing ls"
      by (auto simp: props')
    show "ls \<in> set (enumerator m nmax)"
    proof -
      from m props'' have l_ls: "2 < length ls"  by auto
      then have "\<exists> x y ks. ls = x # ks @ [y]"
        apply (case_tac "ls::(nat list)") apply auto
        apply (case_tac "list" rule: rev_exhaust) by auto
      then obtain x y ks where "ls = x # ks @ [y]" by auto
      with props'' have ls': "ls = 0 # ks @ [nmax - 1]" by auto
      with l_ls have l_ms: "0 < length ks" by auto
      then have ms_ne: "ks \<noteq> []" by auto
      from ls' have lks: "length ks = length ls - 2" by auto
      from props'' have nd: "increasing ls" by auto
      from props'' have "\<And> z. z \<in> set ks \<Longrightarrow> 0 \<le> z" by auto
      from props'' ls' have "increasing ((0 # ks) @ [nmax - 1])" by auto
      then have z: "\<And> z. z \<in> set ks \<Longrightarrow> z \<le> (nmax - 1)"
        by (drule_tac increasing2) auto
      from props  ls' have z': "\<And> z. z \<in> set ks \<Longrightarrow> z \<le> (nmax - 2)" by auto

      have "ks \<in> set ((enumAppend (nmax - 2)
         ^^ (length ks - Suc 0)) (enumBase (nmax - 2)))"
      proof (cases "ks = []")
        case True with ms_ne show ?thesis by simp
      next
        case False
        from props'' have "increasing ls" by auto
        with ls' have "increasing (0 # ks)" by (auto intro: increasing4)
        then have "increasing ([0] @ ks)" by auto
        then have ndks: "increasing ks" by (rule_tac increasing5)
        have listall: "list_all (\<lambda>x. x < Suc (nmax - 2)) ks"
          apply (simp add: list_all_iff)
          by (auto dest: z')
        with False ndks show ?thesis
          apply (rule_tac enumerator_completeness_help) by auto
      qed
      with lks props' have
        "ks \<in> set ((enumAppend (nmax - 2) ^^ (m - 3)) (enumBase (nmax - 2)))" by auto
      with m ls' show ?thesis by (simp add: enumerator_def)
    qed
  qed
qed

lemma enumerator_equiv[simp]:
 "2 < n \<Longrightarrow> 1 < m \<Longrightarrow> is \<in> set(enumerator n m) = incrIndexList is n m"
by (auto intro: enumerator_correctness enumerator_completeness)

end


(*  Title:      ZF/ex/misc.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1993  University of Cambridge

Composition of homomorphisms, Pastre's examples, ...
*)

section\<open>Miscellaneous ZF Examples\<close>

theory misc imports ZF begin

subsection\<open>Various Small Problems\<close>

text\<open>The singleton problems are much harder in HOL.\<close>
lemma singleton_example_1:
     "\<forall>x \<in> S. \<forall>y \<in> S. x \<subseteq> y \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
  by blast

lemma singleton_example_2:
     "\<forall>x \<in> S. \<Union>S \<subseteq> x \<Longrightarrow> \<exists>z. S \<subseteq> {z}"
  \<comment> \<open>Variant of the problem above.\<close>
  by blast

lemma "\<exists>!x. f (g(x)) = x \<Longrightarrow> \<exists>!y. g (f(y)) = y"
  \<comment> \<open>A unique fixpoint theorem --- \<open>fast\<close>/\<open>best\<close>/\<open>auto\<close> all fail.\<close>
  apply (erule ex1E, rule ex1I, erule subst_context)
  apply (rule subst, assumption, erule allE, rule subst_context, erule mp)
  apply (erule subst_context)
  done

text\<open>A weird property of ordered pairs.\<close>
lemma "b\<noteq>c ==> <a,b> \<inter> <a,c> = <a,a>"
by (simp add: Pair_def Int_cons_left Int_cons_right doubleton_eq_iff, blast)

text\<open>These two are cited in Benzmueller and Kohlhase's system description of
 LEO, CADE-15, 1998 (page 139-143) as theorems LEO could not prove.\<close>
lemma "(X = Y \<union> Z) \<longleftrightarrow> (Y \<subseteq> X & Z \<subseteq> X & (\<forall>V. Y \<subseteq> V & Z \<subseteq> V \<longrightarrow> X \<subseteq> V))"
by (blast intro!: equalityI)

text\<open>the dual of the previous one\<close>
lemma "(X = Y \<inter> Z) \<longleftrightarrow> (X \<subseteq> Y & X \<subseteq> Z & (\<forall>V. V \<subseteq> Y & V \<subseteq> Z \<longrightarrow> V \<subseteq> X))"
by (blast intro!: equalityI)

text\<open>trivial example of term synthesis: apparently hard for some provers!\<close>
schematic_goal "a \<noteq> b ==> a:?X & b \<notin> ?X"
by blast

text\<open>Nice blast benchmark.  Proved in 0.3s; old tactics can't manage it!\<close>
lemma "\<forall>x \<in> S. \<forall>y \<in> S. x \<subseteq> y ==> \<exists>z. S \<subseteq> {z}"
by blast

text\<open>variant of the benchmark above\<close>
lemma "\<forall>x \<in> S. \<Union>(S) \<subseteq> x ==> \<exists>z. S \<subseteq> {z}"
by blast

(*Example 12 (credited to Peter Andrews) from
 W. Bledsoe.  A Maximal Method for Set Variables in Automatic Theorem-proving.
 In: J. Hayes and D. Michie and L. Mikulich, eds.  Machine Intelligence 9.
 Ellis Horwood, 53-100 (1979). *)
lemma "(\<forall>F. {x} \<in> F \<longrightarrow> {y} \<in> F) \<longrightarrow> (\<forall>A. x \<in> A \<longrightarrow> y \<in> A)"
by best

text\<open>A characterization of functions suggested by Tobias Nipkow\<close>
lemma "r \<in> domain(r)->B  \<longleftrightarrow>  r \<subseteq> domain(r)*B & (\<forall>X. r `` (r -`` X) \<subseteq> X)"
by (unfold Pi_def function_def, best)

subsection\<open>Composition of homomorphisms is a Homomorphism\<close>

text\<open>Given as a challenge problem in
  R. Boyer et al.,
  Set Theory in First-Order Logic: Clauses for G\"odel's Axioms,
  JAR 2 (1986), 287-327\<close>

text\<open>collecting the relevant lemmas\<close>
declare comp_fun [simp] SigmaI [simp] apply_funtype [simp]

(*Force helps prove conditions of rewrites such as comp_fun_apply, since
  rewriting does not instantiate Vars.*)
lemma "(\<forall>A f B g. hom(A,f,B,g) =
           {H \<in> A->B. f \<in> A*A->A & g \<in> B*B->B &
                     (\<forall>x \<in> A. \<forall>y \<in> A. H`(f`<x,y>) = g`<H`x,H`y>)}) \<longrightarrow>
       J \<in> hom(A,f,B,g) & K \<in> hom(B,g,C,h) \<longrightarrow>
       (K O J) \<in> hom(A,f,C,h)"
by force

text\<open>Another version, with meta-level rewriting\<close>
lemma "(!! A f B g. hom(A,f,B,g) ==
           {H \<in> A->B. f \<in> A*A->A & g \<in> B*B->B &
                     (\<forall>x \<in> A. \<forall>y \<in> A. H`(f`<x,y>) = g`<H`x,H`y>)})
       ==> J \<in> hom(A,f,B,g) & K \<in> hom(B,g,C,h) \<longrightarrow> (K O J) \<in> hom(A,f,C,h)"
by force

subsection\<open>Pastre's Examples\<close>

text\<open>D Pastre.  Automatic theorem proving in set theory.
        Artificial Intelligence, 10:1--27, 1978.
Previously, these were done using ML code, but blast manages fine.\<close>

lemmas compIs [intro] = comp_surj comp_inj comp_fun [intro]
lemmas compDs [dest] =  comp_mem_injD1 comp_mem_surjD1
                        comp_mem_injD2 comp_mem_surjD2

lemma pastre1:
    "[| (h O g O f) \<in> inj(A,A);
        (f O h O g) \<in> surj(B,B);
        (g O f O h) \<in> surj(C,C);
        f \<in> A->B;  g \<in> B->C;  h \<in> C->A |] ==> h \<in> bij(C,A)"
by (unfold bij_def, blast)

lemma pastre3:
    "[| (h O g O f) \<in> surj(A,A);
        (f O h O g) \<in> surj(B,B);
        (g O f O h) \<in> inj(C,C);
        f \<in> A->B;  g \<in> B->C;  h \<in> C->A |] ==> h \<in> bij(C,A)"
by (unfold bij_def, blast)

lemma pastre4:
    "[| (h O g O f) \<in> surj(A,A);
        (f O h O g) \<in> inj(B,B);
        (g O f O h) \<in> inj(C,C);
        f \<in> A->B;  g \<in> B->C;  h \<in> C->A |] ==> h \<in> bij(C,A)"
by (unfold bij_def, blast)

lemma pastre5:
    "[| (h O g O f) \<in> inj(A,A);
        (f O h O g) \<in> surj(B,B);
        (g O f O h) \<in> inj(C,C);
        f \<in> A->B;  g \<in> B->C;  h \<in> C->A |] ==> h \<in> bij(C,A)"
by (unfold bij_def, blast)

lemma pastre6:
    "[| (h O g O f) \<in> inj(A,A);
        (f O h O g) \<in> inj(B,B);
        (g O f O h) \<in> surj(C,C);
        f \<in> A->B;  g \<in> B->C;  h \<in> C->A |] ==> h \<in> bij(C,A)"
by (unfold bij_def, blast)

end


theory BeispielPerson
imports Main
begin

section\<open>Beispiel Person\<close>
text\<open>Wir führen eine Beispielbevölkerung für Beispiele ein.
Sie besteht aus vier Personen.\<close>

datatype person = Alice | Bob | Carol | Eve

text\<open>In Isabelle/HOL steht die Konstante \<^term>\<open>UNIV::'a set\<close> vom Typ \<^typ>\<open>'a set\<close> für die Menge aller \<^typ>\<open>'a\<close>,
also das Universum über \<^typ>\<open>'a\<close>.
Das Universum \<^term>\<open>UNIV::person set\<close> vom Typ \<^typ>\<open>person set\<close> unserer Bevölkerung ist sehr endlich:\<close>
lemma UNIV_person: \<open>UNIV = {Alice, Bob, Carol, Eve}\<close>
  by(auto intro:person.exhaust UNIV_eq_I)

text\<open>Wir werden unterscheiden:
  \<^item> \<^typ>\<open>'person\<close>: generischer Typ, erlaubt es jedes Modell einer Person und Bevölkerung zu haben.
  \<^item> \<^typ>\<open>person\<close>: Unser minimaler Beispielstyp, bestehend aus \<^const>\<open>Alice\<close>, \<^const>\<open>Bob\<close>, ...
\<close>

(*<*)
text\<open>
Technisch müssen wir \<^class>\<open>enum\<close> implementieren, damit wir über alle Personen iterieren können.
Ansonsten würden nur Beweise funktionieren, aber keine ausführbaren Beispiele.
\<close>
instantiation person :: \<open>enum\<close>
begin
  definition \<open>enum_person \<equiv> [Alice, Bob, Carol, Eve]\<close>
  definition \<open>enum_all_person P \<longleftrightarrow> P Alice \<and> P Bob \<and> P Carol \<and> P Eve\<close>
  definition \<open>enum_ex_person P \<longleftrightarrow> P Alice \<or> P Bob \<or> P Carol \<or> P Eve\<close>

instance proof
  qed (simp_all add: enum_person_def enum_all_person_def enum_ex_person_def UNIV_person)
end

text\<open>Also makes maps partially executable.\<close>
lemma \<open>dom [Alice \<mapsto> (3::nat), Carol \<mapsto> 6] = {Alice, Carol}\<close> by eval

lemma obtain_fresh_person:
  \<open>\<exists>p::person. p \<noteq> p1 \<and> p \<noteq> p2\<close>
  apply(cases \<open>p1\<close>, case_tac [!] \<open>p2\<close>)
  by(auto)

(*TODO: use https://www.isa-afp.org/entries/Generic_Deriving.html to get a linorder?
value "sorted_list_of_set {Alice, Carol}"
*)
(*>*)
end


(******************************************************************************)
(* Project: The Isabelle/UTP Proof System                                     *)
(* File: Lens_Laws                                                            *)
(* Authors: Simon Foster and Frank Zeyda                                      *)
(* Authors: Burkhart Wolff (slight modifications)                             *)
(* Emails: simon.foster@york.ac.uk frank.zeyda@york.ac.uk                     *)
(******************************************************************************)
(* LAST REVIEWED: 7/12/2016 *)

text\<open> This file is an except from the "Optics" module of the AFP
      \<^url>\<open>https://www.isa-afp.org/entries/Optics.html\<close>. \<close>

section \<open>Core Lens Laws\<close>

theory Lens_Laws
  imports  Main
begin

subsection \<open>Lens Signature\<close>

text \<open>This theory introduces the signature of lenses and indentifies the core algebraic hierarchy of lens
  classes, including laws for well-behaved, very well-behaved, and bijective lenses~\<^cite>\<open>"Foster07" and "Fischer2015" and "Gibbons17"\<close>.\<close>

record ('a, 'b) lens =
  lens_get :: "'b \<Rightarrow> 'a" ("get\<index>")
  lens_put :: "'b \<Rightarrow> 'a \<Rightarrow> 'b" ("put\<index>")

type_notation
  lens (infixr "\<Longrightarrow>" 0)

text \<open>
  \begin{figure}
  \begin{center}
    \includegraphics[width=6cm]{figures/Lens}
  \end{center}
  \vspace{-5ex}
  \caption{Visualisation of a simple lens}
  \label{fig:Lens}
  \end{figure}

  A lens $X : \view \lto \src$, for source type $\src$ and view type $\view$, identifies
  $\view$ with a subregion of $\src$~\<^cite>\<open>"Foster07" and "Foster09"\<close>, as illustrated in Figure~\ref{fig:Lens}. The arrow denotes
  $X$ and the hatched area denotes the subregion $\view$ it characterises. Transformations on
  $\view$ can be performed without affecting the parts of $\src$ outside the hatched area. The lens
  signature consists of a pair of functions $\lget_X : \src \Rightarrow \view$ that extracts a view
  from a source, and $\lput_X : \src \Rightarrow \view \Rightarrow \src$ that updates a view within
  a given source. \<close>

named_theorems lens_defs

text \<open> \<open>lens_source\<close> gives the set of constructible sources; that is those that can be built
  by putting a value into an arbitrary source. \<close>

definition lens_source :: "('a \<Longrightarrow> 'b) \<Rightarrow> 'b set" ("\<S>\<index>") where
"lens_source X = {s. \<exists> v s'. s = put\<^bsub>X\<^esub> s' v}"

abbreviation some_source :: "('a \<Longrightarrow> 'b) \<Rightarrow> 'b" ("src\<index>") where
"some_source X \<equiv> (SOME s. s \<in> \<S>\<^bsub>X\<^esub>)"

definition lens_create :: "('a \<Longrightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b" ("create\<index>") where
[lens_defs]: "create\<^bsub>X\<^esub> v = put\<^bsub>X\<^esub> (src\<^bsub>X\<^esub>) v"

text \<open> Function $\lcreate_X~v$ creates an instance of the source type of $X$ by injecting $v$
  as the view, and leaving the remaining context arbitrary. \<close>

subsection \<open>Weak Lenses\<close>

text \<open> Weak lenses are the least constrained class of lenses in our algebraic hierarchy. They
  simply require that the PutGet law~\<^cite>\<open>"Foster09" and "Fischer2015"\<close> is satisfied, meaning that
  $\lget$ is the inverse of $\lput$. \<close>

locale weak_lens =
  fixes x :: "'a \<Longrightarrow> 'b" (structure)
  assumes put_get: "get (put \<sigma> v) = v"
begin
  lemma source_nonempty: "\<exists> s. s \<in> \<S>"
    by (auto simp add: lens_source_def)

  lemma put_closure: "put \<sigma> v \<in> \<S>"
    by (auto simp add: lens_source_def)

  lemma create_closure: "create v \<in> \<S>"
    by (simp add: lens_create_def put_closure)

  lemma src_source [simp]: "src \<in> \<S>"
    using some_in_eq source_nonempty by auto

  lemma create_get: "get (create v) = v"
    by (simp add: lens_create_def put_get)

  lemma create_inj: "inj create"
    by (metis create_get injI)

  text \<open> The update function is analogous to the record update function which lifts a function
    on a view type to one on the source type. \<close>

  definition update :: "('a \<Rightarrow> 'a) \<Rightarrow> ('b \<Rightarrow> 'b)" where
  [lens_defs]: "update f \<sigma> = put \<sigma> (f (get \<sigma>))"

  lemma get_update: "get (update f \<sigma>) = f (get \<sigma>)"
    by (simp add: put_get update_def)

  lemma view_determination:
    assumes "put \<sigma> u = put \<rho> v"
    shows "u = v"
    by (metis assms put_get)

  lemma put_inj: "inj (put \<sigma>)"
    by (simp add: injI view_determination)
end

declare weak_lens.put_get [simp]
declare weak_lens.create_get [simp]

subsection \<open>Well-behaved Lenses\<close>

text \<open> Well-behaved lenses add to weak lenses that requirement that the GetPut law~\<^cite>\<open>"Foster09" and "Fischer2015"\<close>
  is satisfied, meaning that $\lput$ is the inverse of $\lget$. \<close>

locale wb_lens = weak_lens +
  assumes get_put: "put \<sigma> (get \<sigma>) = \<sigma>"
begin

  lemma put_twice: "put (put \<sigma> v) v = put \<sigma> v"
    by (metis get_put put_get)

  lemma put_surjectivity: "\<exists> \<rho> v. put \<rho> v = \<sigma>"
    using get_put by blast

  lemma source_stability: "\<exists> v. put \<sigma> v = \<sigma>"
    using get_put by auto

  lemma source_UNIV [simp]: "\<S> = UNIV"
    by (metis UNIV_eq_I put_closure wb_lens.source_stability wb_lens_axioms)

end

declare wb_lens.get_put [simp]

lemma wb_lens_weak [simp]: "wb_lens x \<Longrightarrow> weak_lens x"
  by (simp add: wb_lens_def)

subsection \<open> Mainly Well-behaved Lenses \<close>

text \<open> Mainly well-behaved lenses extend weak lenses with the PutPut law that shows how one put
  override a previous one. \<close>

locale mwb_lens = weak_lens +
  assumes put_put: "put (put \<sigma> v) u = put \<sigma> u"
begin

  text \<open> Mainly well-behaved lenses give rise to a weakened version of the $get-put$ law,
    where the source must be within the set of constructible sources. \<close>

  lemma weak_get_put: "\<sigma> \<in> \<S> \<Longrightarrow> put \<sigma> (get \<sigma>) = \<sigma>"
    by (auto simp add: lens_source_def put_get put_put)

  lemma weak_source_determination:
    assumes "\<sigma> \<in> \<S>" "\<rho> \<in> \<S>" "get \<sigma> = get \<rho>" "put \<sigma> v = put \<rho> v"
    shows "\<sigma> = \<rho>"
    by (metis assms put_put weak_get_put)

   lemma weak_put_eq:
     assumes "\<sigma> \<in> \<S>" "get \<sigma> = k" "put \<sigma> u = put \<rho> v"
     shows "put \<rho> k = \<sigma>"
     by (metis assms put_put weak_get_put)

  text \<open> Provides $s$ is constructible, then @{term get} can be uniquely determined from @{term put} \<close>

  lemma weak_get_via_put: "s \<in> \<S> \<Longrightarrow> get s = (THE v. put s v = s)"
    by (rule sym, auto intro!: the_equality weak_get_put, metis put_get)

end

declare mwb_lens.put_put [simp]
declare mwb_lens.weak_get_put [simp]

lemma mwb_lens_weak [simp]:
  "mwb_lens x \<Longrightarrow> weak_lens x"
  by (simp add: mwb_lens.axioms(1))

subsection \<open>Very Well-behaved Lenses\<close>

text \<open>Very well-behaved lenses combine all three laws, as in the literature~\<^cite>\<open>"Foster09" and "Fischer2015"\<close>.\<close>

locale vwb_lens = wb_lens + mwb_lens
begin

  lemma source_determination:
    assumes "get \<sigma> = get \<rho>" "put \<sigma> v = put \<rho> v"
    shows "\<sigma> = \<rho>"
    by (metis assms get_put put_put)

 lemma put_eq:
   assumes "get \<sigma> = k" "put \<sigma> u = put \<rho> v"
   shows "put \<rho> k = \<sigma>"
   using assms weak_put_eq[of \<sigma> k u \<rho> v] by (simp)

  text \<open> @{term get} can be uniquely determined from @{term put} \<close>

  lemma get_via_put: "get s = (THE v. put s v = s)"
    by (simp add: weak_get_via_put)

end

lemma vwb_lens_wb [simp]: "vwb_lens x \<Longrightarrow> wb_lens x"
  by (simp add: vwb_lens_def)

lemma vwb_lens_mwb [simp]: "vwb_lens x \<Longrightarrow> mwb_lens x"
  using vwb_lens_def by auto

subsection \<open> Ineffectual Lenses \<close>

text \<open>Ineffectual lenses can have no effect on the view type -- application of the $\lput$ function
  always yields the same source. They are thus, trivially, very well-behaved lenses.\<close>

locale ief_lens = weak_lens +
  assumes put_inef: "put \<sigma> v = \<sigma>"
begin

sublocale vwb_lens
proof
  fix \<sigma> v u
  show "put \<sigma> (get \<sigma>) = \<sigma>"
    by (simp add: put_inef)
  show "put (put \<sigma> v) u = put \<sigma> u"
    by (simp add: put_inef)
qed

lemma ineffectual_const_get:
  "\<exists> v.  \<forall> \<sigma>\<in>\<S>. get \<sigma> = v"
  using put_get put_inef by auto

end

abbreviation "eff_lens X \<equiv> (weak_lens X \<and> (\<not> ief_lens X))"

subsection \<open> Bijective Lenses \<close>

text \<open>Bijective lenses characterise the situation where the source and view type are equivalent:
  in other words the view type full characterises the whole source type. It is often useful
  when the view type and source type are syntactically different, but nevertheless correspond
  precisely in terms of what they observe. Bijective lenses are formulates using
  the strong GetPut law~\<^cite>\<open>"Foster09" and "Fischer2015"\<close>.\<close>

locale bij_lens = weak_lens +
  assumes strong_get_put: "put \<sigma> (get \<rho>) = \<rho>"
begin

sublocale vwb_lens
proof
  fix \<sigma> v u
  show "put \<sigma> (get \<sigma>) = \<sigma>"
    by (simp add: strong_get_put)
  show "put (put \<sigma> v) u = put \<sigma> u"
    by (metis bij_lens.strong_get_put bij_lens_axioms put_get)
qed

  lemma put_bij: "bij_betw (put \<sigma>) UNIV UNIV"
    by (metis bijI put_inj strong_get_put surj_def)

  lemma get_create: "\<sigma> \<in> \<S> \<Longrightarrow> create (get \<sigma>) = \<sigma>"
    by (simp add: lens_create_def strong_get_put)

end

declare bij_lens.strong_get_put [simp]
declare bij_lens.get_create [simp]

lemma bij_lens_weak [simp]:
  "bij_lens x \<Longrightarrow> weak_lens x"
  by (simp_all add: bij_lens_def)

lemma bij_lens_vwb [simp]: "bij_lens x \<Longrightarrow> vwb_lens x"
  by (metis bij_lens.strong_get_put bij_lens_weak mwb_lens.intro mwb_lens_axioms.intro vwb_lens_def wb_lens.intro wb_lens_axioms.intro weak_lens.put_get)

subsection \<open>Lens Independence\<close>

text \<open>
  \begin{figure}
  \begin{center}
    \includegraphics[width=6cm]{figures/Independence}
  \end{center}
  \vspace{-5ex}
  \caption{Lens Independence}
  \label{fig:Indep}
  \end{figure}

  Lens independence shows when two lenses $X$ and $Y$ characterise disjoint regions of the
  source type, as illustrated in Figure~\ref{fig:Indep}. We specify this by requiring that the $\lput$
  functions of the two lenses commute, and that the $\lget$ function of each lens is unaffected by
  application of $\lput$ from the corresponding lens. \<close>

locale lens_indep =
  fixes X :: "'a \<Longrightarrow> 'c" and Y :: "'b \<Longrightarrow> 'c"
  assumes lens_put_comm: "put\<^bsub>X\<^esub> (put\<^bsub>Y\<^esub> \<sigma> v) u = put\<^bsub>Y\<^esub> (put\<^bsub>X\<^esub> \<sigma> u) v"
  and lens_put_irr1: "get\<^bsub>X\<^esub> (put\<^bsub>Y\<^esub> \<sigma> v) = get\<^bsub>X\<^esub> \<sigma>"
  and lens_put_irr2: "get\<^bsub>Y\<^esub> (put\<^bsub>X\<^esub> \<sigma> u) = get\<^bsub>Y\<^esub> \<sigma>"

notation lens_indep (infix "\<bowtie>" 50)

lemma lens_indepI:
  "\<lbrakk> \<And> u v \<sigma>. lens_put x (lens_put y \<sigma> v) u = lens_put y (lens_put x \<sigma> u) v;
     \<And> v \<sigma>. lens_get x (lens_put y \<sigma> v) = lens_get x \<sigma>;
     \<And> u \<sigma>. lens_get y (lens_put x \<sigma> u) = lens_get y \<sigma> \<rbrakk> \<Longrightarrow> x \<bowtie> y"
  by (simp add: lens_indep_def)

text \<open>Lens independence is symmetric.\<close>

lemma lens_indep_sym:  "x \<bowtie> y \<Longrightarrow> y \<bowtie> x"
  by (simp add: lens_indep_def)

lemma lens_indep_sym':  "(x \<bowtie> y) = (y \<bowtie> x)"
  by (auto simp: lens_indep_def)

lemma lens_indep_comm:
  "x \<bowtie> y \<Longrightarrow> lens_put x (lens_put y \<sigma> v) u = lens_put y (lens_put x \<sigma> u) v"
  by (simp add: lens_indep_def)

lemma lens_indep_get [simp]:
  assumes "x \<bowtie> y"
  shows "lens_get x (lens_put y \<sigma> v) = lens_get x \<sigma>"
  using assms lens_indep_def by fastforce

end