(*  Author: Lukas Bulwahn <lukas.bulwahn-at-gmail.com> *)

section \<open>Functions from A to B\<close>

theory Twelvefold_Way_Entry1
imports Preliminaries
begin

text \<open>
Note that the cardinality theorems of both structures, lists and finite
functions, are already available. Hence, this development creates the
bijection between those two structures and transfers the one cardinality
theorem to the other structures and vice versa, although not strictly
needed as both cardinality theorems were already available.
\<close>

subsection \<open>Definition of Bijections\<close>

definition sequence_of :: "'a set \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b list"
where
  "sequence_of A enum f = map (\<lambda>n. f (enum n)) [0..<card A]"

definition function_of :: "'a set \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> 'b list \<Rightarrow> ('a \<Rightarrow> 'b)"
where
  "function_of A enum xs = (\<lambda>a. if a \<in> A then xs ! inv_into {0..<length xs} enum a else undefined)"

subsection \<open>Properties for Bijections\<close>

lemma nth_sequence_of:
  assumes "i < card A"
  shows "(sequence_of A enum f) ! i = f (enum i)"
using assms unfolding sequence_of_def by auto

lemma nth_sequence_of_inv_into:
  assumes "bij_betw enum {0..<card A} A"
  assumes "a \<in> A"
  shows "(sequence_of A enum f) ! (inv_into {0..<card A} enum a) = f a"
proof -
  have "inv_into {0..<card A} enum a \<in> {0..<card A}"
    using assms bij_betwE bij_betw_inv_into by blast
  from this assms show "(sequence_of A enum f) ! (inv_into {0..<card A} enum a) = f a"
    unfolding sequence_of_def by (simp add: bij_betw_inv_into_right)
qed

lemma set_sequence_of:
  assumes "bij_betw enum {0..<card A} A"
  assumes "f \<in> A \<rightarrow>\<^sub>E B"
  shows "set (sequence_of A enum f) \<subseteq> B"
using PiE bij_betwE assms
unfolding sequence_of_def by fastforce

lemma length_sequence_of:
  assumes "bij_betw enum {0..<card A} A"
  assumes "f \<in> A \<rightarrow>\<^sub>E B"
  shows "length (sequence_of A enum f) = card A"
using assms unfolding sequence_of_def by simp

lemma function_of_enum:
  assumes "bij_betw enum {0..<card A} A"
  assumes "length xs = card A"
  assumes "i < card A"
  shows "function_of A enum xs (enum i) = xs ! i"
using assms unfolding function_of_def
by (auto simp add: bij_betw_inv_into_left bij_betwE)

lemma function_of_in_extensional_funcset:
  assumes "bij_betw enum {0..<card A} A"
  assumes "set xs \<subseteq> B" "length xs = card A"
  shows "function_of A enum xs \<in> A \<rightarrow>\<^sub>E B"
proof
  fix x
  assume "x \<in> A"
  have "inv_into {0..<length xs} enum x \<in> {0..<length xs}"
    using \<open>x \<in> A\<close> assms(1, 3) by (metis bij_betw_def inv_into_into)
  from this have "xs ! inv_into {0..<length xs} enum x \<in> set xs" by simp
  from this \<open>set xs \<subseteq> B\<close> show "function_of A enum xs x \<in> B"
    using \<open>x \<in> A\<close> unfolding function_of_def by auto
next
  fix x
  assume "x \<notin> A"
  from this show "function_of A enum xs x = undefined"
    unfolding function_of_def by simp
qed

lemma sequence_of_function_of:
  assumes "bij_betw enum {0..<card A} A"
  assumes "set xs \<subseteq> B" "length xs = card A"
  shows "sequence_of A enum (function_of A enum xs) = xs"
proof (rule nth_equalityI)
  have "function_of A enum xs \<in> A \<rightarrow>\<^sub>E B"
    using assms by (rule function_of_in_extensional_funcset)
  from this show "length (sequence_of A enum (function_of A enum xs)) = length xs"
    using assms(1,3) by (simp add: length_sequence_of)
  from this show "\<And>i. i < length (sequence_of A enum (function_of A enum xs)) \<Longrightarrow> sequence_of A enum (function_of A enum xs) ! i = xs ! i"
    using assms by (auto simp add: nth_sequence_of function_of_enum)
qed

lemma function_of_sequence_of:
  assumes "bij_betw enum {0..<card A} A"
  assumes "f \<in> A \<rightarrow>\<^sub>E B"
  shows "function_of A enum (sequence_of A enum f) = f"
proof
  fix x
  show "function_of A enum (sequence_of A enum f) x = f x"
    using assms unfolding function_of_def
    by (auto simp add: length_sequence_of nth_sequence_of_inv_into)
qed

subsection \<open>Bijections\<close>

lemma bij_betw_sequence_of:
  assumes "bij_betw enum {0..<card A} A"
  shows "bij_betw (sequence_of A enum) (A \<rightarrow>\<^sub>E B) {xs. set xs \<subseteq> B \<and> length xs = card A}"
proof (rule bij_betw_byWitness[where f'="function_of A enum"])
  show "\<forall>f\<in>A \<rightarrow>\<^sub>E B. function_of A enum (sequence_of A enum f) = f"
    using assms by (simp add: function_of_sequence_of)
  show "\<forall>xs\<in>{xs. set xs \<subseteq> B \<and> length xs = card A}. sequence_of A enum (function_of A enum xs) = xs"
    using assms by (auto simp add: sequence_of_function_of)
  show "sequence_of A enum ` (A \<rightarrow>\<^sub>E B) \<subseteq> {xs. set xs \<subseteq> B \<and> length xs = card A}"
    using assms set_sequence_of[OF assms] length_sequence_of by auto
  show "function_of A enum ` {xs. set xs \<subseteq> B \<and> length xs = card A} \<subseteq> A \<rightarrow>\<^sub>E B"
    using assms function_of_in_extensional_funcset by blast
qed

lemma bij_betw_function_of:
  assumes "bij_betw enum {0..<card A} A"
  shows "bij_betw (function_of A enum) {xs. set xs \<subseteq> B \<and> length xs = card A} (A \<rightarrow>\<^sub>E B)"
proof (rule bij_betw_byWitness[where f'="sequence_of A enum"])
  show "\<forall>f\<in>A \<rightarrow>\<^sub>E B. function_of A enum (sequence_of A enum f) = f"
    using assms by (simp add: function_of_sequence_of)
  show "\<forall>xs\<in>{xs. set xs \<subseteq> B \<and> length xs = card A}. sequence_of A enum (function_of A enum xs) = xs"
    using assms by (auto simp add: sequence_of_function_of)
  show "sequence_of A enum ` (A \<rightarrow>\<^sub>E B) \<subseteq> {xs. set xs \<subseteq> B \<and> length xs = card A}"
    using assms set_sequence_of[OF assms] length_sequence_of by auto
  show "function_of A enum ` {xs. set xs \<subseteq> B \<and> length xs = card A} \<subseteq> A \<rightarrow>\<^sub>E B"
    using assms function_of_in_extensional_funcset by blast
qed

subsection \<open>Cardinality\<close>

lemma
  assumes "finite A"
  shows "card (A \<rightarrow>\<^sub>E B) = card B ^ card A"
proof -
  obtain enum where "bij_betw enum {0..<card A} A"
    using \<open>finite A\<close> ex_bij_betw_nat_finite by blast
  have "bij_betw (sequence_of A enum) (A \<rightarrow>\<^sub>E B) {xs. set xs \<subseteq> B \<and> length xs = card A}"
    using \<open>bij_betw enum {0..<card A} A\<close> by (rule bij_betw_sequence_of)
  from this have "card (A \<rightarrow>\<^sub>E B) = card {xs. set xs \<subseteq> B \<and> length xs = card A}"
    by (rule bij_betw_same_card)
  also have "card {xs. set xs \<subseteq> B \<and> length xs = card A} = card B ^ card A"
    by (rule card_lists_length_eq)
  finally show ?thesis .
qed

lemma card_sequences:
  assumes "finite A"
  shows "card {xs. set xs \<subseteq> B \<and> length xs = card A} = card B ^ card A"
proof -
  obtain enum where "bij_betw enum {0..<card A} A"
    using \<open>finite A\<close> ex_bij_betw_nat_finite by blast
  have "bij_betw (function_of A enum) {xs. set xs \<subseteq> B \<and> length xs = card A} (A \<rightarrow>\<^sub>E B)"
    using \<open>bij_betw enum {0..<card A} A\<close> by (rule bij_betw_function_of)
  from this have "card {xs. set xs \<subseteq> B \<and> length xs = card A} = card (A \<rightarrow>\<^sub>E B)"
    by (rule bij_betw_same_card)
  also have "card (A \<rightarrow>\<^sub>E B) = card B ^ card A"
    using \<open>finite A\<close> by (rule card_extensional_funcset)
  finally show ?thesis .
qed

lemma
  shows "card {xs. set xs \<subseteq> A \<and> length xs = n} = card A ^ n"
proof -
  have "card {xs. set xs \<subseteq> A \<and> length xs = n} = card {xs. set xs \<subseteq> A \<and> length xs = card {0..<n}}"
    by auto
  also have "\<dots> = card A ^ card {0..<n}" by (subst card_sequences) auto
  also have "\<dots> = card A ^ n" by auto
  finally show ?thesis .
qed

end


theory Words
imports Preliminaries
begin

subsection \<open> $\omega$-words \<close>

text \<open>
  Automata recognize languages, which are sets of words. For the
  theory of $\omega$-automata, we are mostly interested in
  $\omega$-words, but it is sometimes useful to reason about
  finite words, too. We are modeling finite words as lists; this
  lets us benefit from the existing library. Other formalizations
  could be investigated, such as representing words as functions
  whose domains are initial intervals of the natural numbers.
\<close>

subsubsection \<open> Type declaration and elementary operations \<close>

text \<open>
  We represent $\omega$-words as functions from the natural numbers
  to the alphabet type. Other possible formalizations include
  a coinductive definition or a uniform encoding of finite and
  infinite words, as studied by M\"uller et al.
\<close>

type_synonym
  'a word = "nat \<Rightarrow> 'a"

definition
  suffix :: "[nat, 'a word] \<Rightarrow> 'a word"
  where "suffix k x \<equiv> \<lambda>n. x (k+n)"

lemma suffix_nth [simp]:
  "(suffix k x) n = x (k+n)"
by (simp add: suffix_def)

lemma suffix_0 [simp]:
  "suffix 0 x = x"
by (simp add: suffix_def)

lemma suffix_suffix [simp]:
  "suffix m (suffix k x) = suffix (k+m) x"
by (rule ext, simp add: suffix_def ac_simps)

text \<open>
  A finite part of an infinite word can be obtained as the
  result of mapping the word over the desired index interval.
  For now, we do not define a separate constant for this
  construction, as it does not occur very often, and we prefer
  to rely on the proof machinery provided by the standard library.
  However, the standard rewriting rules include the theorem @{text upt_Suc},
  which tends to convert, say, $[i..j]$ into $[i..j(] @ [j]$.
  Since this is (almost) never what we want, we remove the theorem
  from the rule base in effect for this session.
\<close>
declare upt_Suc [simp del]

text \<open>
  We can prefix a finite word to an $\omega$-word, and a way
  to obtain an $\omega$-word from a finite, non-empty word is by
  $\omega$-iteration.
\<close>

definition
  conc :: "['a list, 'a word] \<Rightarrow> 'a word"    ("_/ conc _" [66,65] 65)
  where "w conc x == \<lambda>n. if n < length w then w!n else x (n - length w)"

definition
  iter :: "'a list \<Rightarrow> 'a word"
  where "iter w == if w = [] then undefined else (\<lambda>n. w!(n mod (length w)))"

syntax (xsymbols)
  conc :: "['a list, 'a word] \<Rightarrow> 'a word"    ("_/ \<frown> _" [66,65] 65)
  iter :: "'a list \<Rightarrow> 'a word"               ("(_\<^sup>\<omega>)" [1000])

lemma conc_empty[simp]: "[] \<frown> w = w"
  unfolding conc_def by auto

lemma conc_fst:
  "n < length w \<Longrightarrow> (w \<frown> x) n = w!n"
by (simp add: conc_def)

lemma conc_snd:
  "\<not>(n < length w) \<Longrightarrow> (w \<frown> x) n = x (n - length w)"
by (simp add: conc_def)

lemma iter_nth [simp]:
  "0 < length w \<Longrightarrow> w\<^sup>\<omega> n = w!(n mod (length w))"
by (simp add: iter_def)

lemma conc_conc:
  "u \<frown> v \<frown> w = (u @ v) \<frown> w" (is "?lhs = ?rhs")
proof
  fix n
  have u: "n < length u \<Longrightarrow> ?lhs n = ?rhs n"
    by (simp add: conc_def nth_append)
  have v: "\<lbrakk> \<not>(n < length u); n < length u + length v \<rbrakk> \<Longrightarrow> ?lhs n = ?rhs n"
    by (simp add: conc_def nth_append, arith)
  have w: "\<not>(n < length u + length v) \<Longrightarrow> ?lhs n = ?rhs n"
    by (simp add: conc_def nth_append, arith)
  from u v w show "?lhs n = ?rhs n" by auto
qed

lemma prefix_suffix:
  "x = (map x [0..<n] ) \<frown> (suffix n x)"
by (rule ext, simp add: conc_def)

lemma iter_unroll:
  "0 < length w \<Longrightarrow> w\<^sup>\<omega> = w \<frown> w\<^sup>\<omega>"
by (rule ext, simp add: conc_def mod_geq)

subsubsection \<open> The limit set of an $\omega$-word \<close>

text \<open>
  The limit set (also called infinity set) of an $\omega$-word
  is the set of letters that appear infinitely often in the word.
  This set plays an important role in defining acceptance conditions
  of $\omega$-automata.
\<close>

definition
  limit :: "'a word \<Rightarrow> 'a set"
  where "limit x \<equiv> { a . \<exists>\<^sub>\<infinity>n . x n = a }"

lemma limit_iff_frequent:
  "(a \<in> limit x) = (\<exists>\<^sub>\<infinity>n . x n = a)"
by (simp add: limit_def)

text \<open>
  The following is a different way to define the limit,
  using the reverse image, making the laws about reverse
  image applicable to the limit set.
  (Might want to change the definition above?)
\<close>

lemma limit_vimage:
  "(a \<in> limit x) = infinite (x -` {a})"
by (simp add: limit_def Inf_many_def vimage_def)

lemma two_in_limit_iff:
  "({a,b} \<subseteq> limit x) =
   ((\<exists>n. x n =a ) \<and> (\<forall>n. x n = a \<longrightarrow> (\<exists>m>n. x m = b)) \<and> (\<forall>m. x m = b \<longrightarrow> (\<exists>n>m. x n = a)))"
  (is "?lhs = (?r1 \<and> ?r2 \<and> ?r3)")
proof
  assume lhs: "?lhs"
  hence 1: "?r1" by (auto simp: limit_def elim: INFM_EX)
  from lhs have "\<forall>n. \<exists>m>n. x m = b" by (auto simp: limit_def INFM_nat)
  hence 2: "?r2" by simp
  from lhs have "\<forall>m. \<exists>n>m. x n = a" by (auto simp: limit_def INFM_nat)
  hence 3: "?r3" by simp
  from 1 2 3 show "?r1 \<and> ?r2 \<and> ?r3" by simp
next
  assume "?r1 \<and> ?r2 \<and> ?r3"
  hence 1: "?r1" and 2: "?r2" and 3: "?r3" by simp+
  have infa: "\<forall>m. \<exists>n\<ge>m. x n = a"
  proof
    fix m
    show "\<exists>n\<ge>m. x n = a" (is "?A m")
    proof (induct m)
      from 1 show "?A 0" by simp
    next
      fix m
      assume ih: "?A m"
      then obtain n where n: "n \<ge> m" "x n = a" by auto
      with 2 obtain k where k: "k>n" "x k = b" by auto
      with 3 obtain l where l: "l>k" "x l = a" by auto
      from n k l have "l \<ge> Suc m" by auto
      with l show "?A (Suc m)" by auto
    qed
  qed
  hence infa': "\<exists>\<^sub>\<infinity>n. x n = a" by (simp add: INFM_nat_le)
  have "\<forall>n. \<exists>m>n. x m = b"
  proof
    fix n
    from infa obtain k where k1: "k\<ge>n" and k2: "x k = a" by auto
    from 2 k2 obtain l where l1: "l>k" and l2: "x l = b" by auto
    from k1 l1 have "l > n" by auto
    with l2 show "\<exists>m>n. x m = b" by auto
  qed
  hence "\<exists>\<^sub>\<infinity>m. x m = b" by (simp add: INFM_nat)
  with infa' show "?lhs" by (auto simp: limit_def)
qed

text \<open>
  For $\omega$-words over a finite alphabet, the limit set is
  non-empty. Moreover, from some position onward, any such word
  contains only letters from its limit set.
\<close>

lemma limit_nonempty:
  assumes fin: "finite (range x)"
  shows "\<exists>a. a \<in> limit x"
proof -
  from fin obtain a where "a \<in> range x \<and> infinite (x -` {a})"
    by (rule inf_img_fin_domE, auto)
  hence "a \<in> limit x"
    by (auto simp add: limit_vimage)
  thus ?thesis ..
qed

lemmas limit_nonemptyE = limit_nonempty[THEN exE]

lemma limit_inter_INF:
  assumes hyp: "limit w \<inter> S \<noteq> {}"
  shows "\<exists>\<^sub>\<infinity> n. w n \<in> S"
proof -
  from hyp obtain x where "\<exists>\<^sub>\<infinity> n. w n = x" and "x \<in> S"
    by (auto simp add: limit_def)
  thus ?thesis
    by (auto elim: INFM_mono)
qed

text \<open>
  The reverse implication is true only if $S$ is finite.
\<close>

lemma INF_limit_inter:
  assumes hyp: "\<exists>\<^sub>\<infinity> n. w n \<in>  S" and fin: "finite (S \<inter> range w)"
  shows  "\<exists>a. a \<in> limit w \<inter> S"
proof (rule ccontr)
  assume contra: "\<not>(\<exists>a. a \<in> limit w \<inter> S)"
  hence "\<forall>a\<in>S. finite {n. w n = a}"
    by (auto simp add: limit_def Inf_many_def)
  with fin have "finite (UN a:S \<inter> range w. {n. w n = a})"
    by auto
  moreover
  have "(UN a:S \<inter> range w. {n. w n = a}) = {n. w n \<in> S}"
    by auto
  moreover
  note hyp
  ultimately show "False"
    by (simp add: Inf_many_def)
qed

lemma fin_ex_inf_eq_limit: "finite A \<Longrightarrow> (\<exists>\<^sub>\<infinity>i. w i \<in> A) \<longleftrightarrow> limit w \<inter> A \<noteq> {}"
  by (metis INF_limit_inter equals0D finite_Int limit_inter_INF)

lemma limit_in_range_suffix:
  "limit x \<subseteq> range (suffix k x)"
proof
  fix a
  assume "a \<in> limit x"
  then obtain l where
    kl: "k < l" and xl: "x l = a"
    by (auto simp add: limit_def INFM_nat)
  from kl obtain m where "l = k+m"
    by (auto simp add:  less_iff_Suc_add)
  with xl show "a \<in> range (suffix k x)"
    by auto
qed

lemma limit_in_range: "limit r \<subseteq> range r"
  using limit_in_range_suffix[of r 0] by simp

lemmas limit_in_range_suffixD = limit_in_range_suffix[THEN subsetD]

theorem limit_is_suffix:
  assumes fin: "finite (range x)"
  shows "\<exists>k. limit x = range (suffix k x)"
proof -
  have "\<exists>k. range (suffix k x) \<subseteq> limit x"
  proof -
    (*"The set of letters that are not in the limit is certainly finite."*)
    from fin have "finite (range x - limit x)"
      by simp
    (* "Moreover, any such letter occurs only finitely often"*)
    moreover
    have "\<forall>a \<in> range x - limit x. finite (x -` {a})"
      by (auto simp add: limit_vimage)
    (* "Thus, there are only finitely many occurrences of such letters."*)
    ultimately have "finite (UN a : range x - limit x. x -` {a})"
      by (blast intro: finite_UN_I)
    (* "Therefore these occurrences are within some initial interval."*)
    then obtain k where "(UN a : range x - limit x. x -` {a}) \<subseteq> {..<k}"
      by (blast dest: finite_nat_bounded)
    (* "This is just the bound we are looking for."*)
    hence "\<forall>m. k \<le> m \<longrightarrow> x m \<in> limit x"
      by (auto simp add: limit_vimage)
    hence "range (suffix k x) \<subseteq> limit x"
      by auto
    thus ?thesis ..
  qed
  then obtain k where "range (suffix k x) \<subseteq> limit x" ..
  with limit_in_range_suffix
  have "limit x = range (suffix k x)"
    by (rule subset_antisym)
  thus ?thesis ..
qed

lemmas limit_is_suffixE = limit_is_suffix[THEN exE]

text \<open>
  The limit set enjoys some simple algebraic laws with respect
  to concatenation, suffixes, iteration, and renaming.
\<close>

theorem limit_conc [simp]:
  "limit (w \<frown> x) = limit x"
proof (auto)
  fix a assume a: "a \<in> limit (w \<frown> x)"
  have "\<forall>m. \<exists>n. m<n \<and> x n = a"
  proof
    fix m
    from a obtain n where "m + length w < n \<and> (w \<frown> x) n = a"
      by (auto simp add: limit_def Inf_many_def infinite_nat_iff_unbounded)
    hence "m < n - length w \<and> x (n - length w) = a"
      by (auto simp add: conc_def)
    thus "\<exists>n. m<n \<and> x n = a" ..
  qed
  hence "infinite {n . x n = a}"
    by (simp add: infinite_nat_iff_unbounded)
  thus "a \<in> limit x"
    by (simp add: limit_def Inf_many_def)
next
  fix a assume a: "a \<in> limit x"
  have "\<forall>m. length w < m \<longrightarrow> (\<exists>n. m<n \<and> (w \<frown> x) n = a)"
  proof (clarify)
    fix m
    assume m: "length w < m"
    with a obtain n where "m - length w < n \<and> x n = a"
      by (auto simp add: limit_def Inf_many_def infinite_nat_iff_unbounded)
    with m have "m < n + length w \<and> (w \<frown> x) (n + length w) = a"
      by (simp add: conc_def, arith)
    thus "\<exists>n. m<n \<and> (w \<frown> x) n = a" ..
  qed
  hence "infinite {n . (w \<frown> x) n = a}"
    by (simp add: unbounded_k_infinite)
  thus "a \<in> limit (w \<frown> x)"
    by (simp add: limit_def Inf_many_def)
qed

theorem limit_suffix [simp]:
  "limit (suffix n x) = limit x"
proof -
  have "x = (map x [0..<n]) \<frown> (suffix n x)"
    by (simp add: prefix_suffix)
  hence "limit x = limit ((map x [0..<n]) \<frown> suffix n x)"
    by simp
  also have "\<dots> = limit (suffix n x)"
    by (rule limit_conc)
  finally show ?thesis
    by (rule sym)
qed

theorem limit_iter [simp]:
  assumes nempty: "0 < length w"
  shows "limit w\<^sup>\<omega> = set w"
proof
  have "limit w\<^sup>\<omega> \<subseteq> range w\<^sup>\<omega>"
    by (auto simp add: limit_def dest: INFM_EX)
  also from nempty have "\<dots> \<subseteq> set w"
    by auto
  finally show "limit w\<^sup>\<omega> \<subseteq> set w" .
next
  {
    fix a assume a: "a \<in> set w"
    then obtain k where k: "k < length w \<and> w!k = a"
      by (auto simp add: set_conv_nth)
    \<comment>\<open>the following bound is terrible, but it simplifies the proof\<close>
    from nempty k
    have "\<forall>m. w\<^sup>\<omega> ((Suc m)*(length w) + k) = a"
      by (metis iter_nth mod_less mod_mult_self3)
      (* by (simp add: mod_add_left_eq) *)
    moreover
    \<comment>\<open>why is the following so hard to prove??\<close>
    have "\<forall>m. m < (Suc m)*(length w) + k"
    proof
      fix m
      from nempty have "1 \<le> length w" by arith
      hence "m*1 \<le> m*length w" by simp
      hence "m \<le> m*length w" by simp
      with nempty have "m < length w + (m*length w) + k" by arith
      thus "m < (Suc m)*(length w) + k" by simp
    qed
    moreover note nempty
    ultimately have "a \<in> limit w\<^sup>\<omega>"
      by (auto simp add: limit_iff_frequent INFM_nat)
  }
  then show "set w \<subseteq> limit w\<^sup>\<omega>" by auto
qed

lemma limit_o [simp]:
  assumes a: "a \<in> limit w"
  shows "f a \<in> limit (f \<circ> w)"
proof -
  from a
  have "\<exists>\<^sub>\<infinity>n. w n = a"
    by (simp add: limit_iff_frequent)
  hence "\<exists>\<^sub>\<infinity>n. f (w n) = f a"
    by (rule INFM_mono, simp)
  thus "f a \<in> limit (f \<circ> w)"
    by (simp add: limit_iff_frequent)
qed

text \<open>
  The converse relation is not true in general: $f(a)$ can be in the
  limit of $f \circ w$ even though $a$ is not in the limit of $w$.
  However, @{text limit} commutes with renaming if the function is
  injective. More generally, if $f(a)$ is the image of only finitely
  many elements, some of these must be in the limit of $w$.
\<close>

lemma limit_o_inv:
  assumes fin: "finite (f -` {x})" and x: "x \<in> limit (f \<circ> w)"
  shows "\<exists>a \<in> (f -` {x}). a \<in> limit w"
proof (rule ccontr)
  assume contra: "\<not>(\<exists>a \<in> (f -` {x}). a \<in> limit w)"
  \<comment>\<open>hence, every element in the pre-image occurs only finitely often\<close>
  then have "\<forall>a \<in> (f -` {x}). finite {n. w n = a}"
    by (simp add: limit_def Inf_many_def)
  \<comment>\<open>so there are only finitely many occurrences of any such element\<close>
  with fin have "finite (\<Union> a \<in> (f -` {x}). {n. w n = a})"
    by auto
  \<comment>\<open>these are precisely those positions where $x$ occurs in $f \circ w$ \<close>
  moreover
  have "(\<Union> a \<in> (f -` {x}). {n. w n = a}) = {n. f(w n) = x}"
    by auto
  ultimately
  \<comment>\<open>so $x$ can occur only finitely often in the translated word\<close>
  have "finite {n. f(w n) = x}"
    by simp
  \<comment>\<open> \ldots\ which yields a contradiction \<close>
  with x show "False"
    by (simp add: limit_def Inf_many_def)
qed

theorem limit_inj [simp]:
  assumes inj: "inj f"
  shows "limit (f \<circ> w) = f ` (limit w)"
proof
  show "f ` limit w \<subseteq> limit (f \<circ> w)"
    by auto
next
  show "limit (f \<circ> w) \<subseteq> f ` limit w"
  proof
    fix x
    assume x: "x \<in> limit (f \<circ> w)"
    from inj have "finite (f -` {x})"
      by (blast intro: finite_vimageI)
    with x obtain a where a: "a \<in> (f -` {x}) \<and> a \<in> limit w"
      by (blast dest: limit_o_inv)
    thus "x \<in> f ` (limit w)"
      by auto
  qed
qed

subsubsection \<open> Index sequences and piecewise definitions \<close>

text \<open>
  A word can be defined piecewise: given a sequence of words $w_0, w_1, \ldots$
  and a strictly increasing sequence of integers $i_0, i_1, \ldots$ where $i_0=0$,
  a single word is obtained by concatenating subwords of the $w_n$ as given by
  the integers: the resulting word is
  \[
    (w_0)_{i_0} \ldots (w_0)_{i_1-1} (w_1)_{i_1} \ldots (w_1)_{i_2-1} \ldots
  \]
  We prepare the field by proving some trivial facts about such sequences of
  indexes.
\<close>

definition
  idx_sequence :: "nat word \<Rightarrow> bool"
  where "idx_sequence idx \<equiv> (idx 0 = 0) \<and> (\<forall>n. idx n < idx (Suc n))"

lemma idx_sequence_less:
  assumes iseq: "idx_sequence idx"
  shows "idx n < idx (Suc(n+k))"
proof (induct k)
  from iseq show "idx n < idx (Suc (n + 0))"
    by (simp add: idx_sequence_def)
next
  fix k
  assume ih: "idx n < idx (Suc(n+k))"
  from iseq have "idx (Suc(n+k)) < idx (Suc(n + Suc k))"
    by (simp add: idx_sequence_def)
  with ih show "idx n < idx (Suc(n + Suc k))"
    by (rule less_trans)
qed

lemma idx_sequence_inj:
  assumes iseq: "idx_sequence idx"
  and eq: "idx m = idx n"
  shows "m = n"
proof (rule linorder_cases)
  assume "n<m"
  then obtain k where "m = Suc(n+k)"
    by (auto simp add: less_iff_Suc_add)
  with iseq have "idx n < idx m"
    by (simp add: idx_sequence_less)
  with eq show ?thesis
    by simp
next
  assume "m<n"
  then obtain k where "n = Suc(m+k)"
    by (auto simp add: less_iff_Suc_add)
  with iseq have "idx m < idx n"
    by (simp add: idx_sequence_less)
  with eq show ?thesis
    by simp
qed (simp)

lemma idx_sequence_mono:
  assumes iseq: "idx_sequence idx"
  and m: "m \<le> n"
  shows "idx m \<le> idx n"
proof (cases "m=n")
  case True
  thus ?thesis by simp
next
  case False
  with m have "m < n" by simp
  then obtain k where "n = Suc(m+k)"
    by (auto simp add: less_iff_Suc_add)
  with iseq have "idx m < idx n"
    by (simp add: idx_sequence_less)
  thus ?thesis by simp
qed

text \<open>
  Given an index sequence, every natural number is contained in the
  interval defined by two adjacent indexes, and in fact this interval
  is determined uniquely.
\<close>

lemma idx_sequence_idx:
  assumes "idx_sequence idx"
  shows "idx k \<in> {idx k ..< idx (Suc k)}"
using assms by (auto simp add: idx_sequence_def)

lemma idx_sequence_interval:
  assumes iseq: "idx_sequence idx"
  shows "\<exists>k. n \<in> {idx k ..< idx (Suc k) }"
    (is "?P n" is "\<exists>k. ?in n k")
proof (induct n)
  from iseq have "0 = idx 0"
    by (simp add: idx_sequence_def)
  moreover
  from iseq have "idx 0 \<in> {idx 0 ..< idx (Suc 0) }"
    by (rule idx_sequence_idx)
  ultimately
  show "?P 0" by auto
next
  fix n
  assume "?P n"
  then obtain k where k: "?in n k" ..
  show "?P (Suc n)"
  proof (cases "Suc n < idx (Suc k)")
    case True
    with k have "?in (Suc n) k"
      by simp
    thus ?thesis ..
  next
    case False
    with k have "Suc n = idx (Suc k)"
      by auto
    with iseq have "?in (Suc n) (Suc k)"
      by (simp add: idx_sequence_def)
    thus ?thesis ..
  qed
qed

lemma idx_sequence_interval_unique:
  assumes iseq: "idx_sequence idx"
  and k: "n \<in> {idx k ..< idx (Suc k) }"
  and m: "n \<in> {idx m ..< idx (Suc m) }"
  shows "k = m"
proof (rule linorder_cases)
  assume "k < m"
  hence "Suc k \<le> m" by simp
  with iseq have "idx (Suc k) \<le> idx m"
    by (rule idx_sequence_mono)
  with m have "idx (Suc k) \<le> n"
    by auto
  with k have "False"
    by simp
  thus ?thesis ..
next
  assume "m < k"
  hence "Suc m \<le> k" by simp
  with iseq have "idx (Suc m) \<le> idx k"
    by (rule idx_sequence_mono)
  with k have "idx (Suc m) \<le> n"
    by auto
  with m have "False"
    by simp
  thus ?thesis ..
qed (simp)

lemma idx_sequence_unique_interval:
  assumes iseq: "idx_sequence idx"
  shows "\<exists>! k. n \<in> {idx k ..< idx (Suc k) }"
proof (rule ex_ex1I)
  from iseq show "\<exists>k. n \<in> {idx k ..< idx (Suc k)}"
    by (rule idx_sequence_interval)
next
  fix k y
  assume "n \<in> {idx k..<idx (Suc k)}" and "n \<in> {idx y..<idx (Suc y)}"
  with iseq show "k = y" by (auto elim: idx_sequence_interval_unique)
qed

text \<open>
  Now we can define the piecewise construction of a word using
  an index sequence.
\<close>

definition
  merge :: "['a word word, nat word] \<Rightarrow> 'a word"
  where "merge ws idx \<equiv>
           \<lambda> n. let i = THE i. n \<in> {idx i ..< idx (Suc i) } in ws i n"

lemma merge:
  assumes idx: "idx_sequence idx"
  and n: "n \<in> {idx i ..< idx (Suc i) }"
  shows "merge ws idx n = ws i n"
proof -
  from n have "(THE k. n \<in> {idx k ..< idx (Suc k) }) = i"
    by (rule the_equality[OF _ sym[OF idx_sequence_interval_unique[OF idx n]]]) simp
  thus ?thesis
    by (simp add: merge_def Let_def)
qed

lemma merge0:
  assumes idx: "idx_sequence idx"
  shows "merge ws idx 0 = ws 0 0"
proof (rule merge[OF idx])
  from idx have "idx 0 < idx (Suc 0)"
    by (unfold idx_sequence_def, blast)
  with idx show "0 \<in> {idx 0 ..< idx (Suc 0)}"
    by (simp add: idx_sequence_def)
qed

lemma merge_Suc:
  assumes idx: "idx_sequence idx"
  and n: "n \<in> {idx i ..< idx (Suc i) }"
  shows "merge ws idx (Suc n) =
         (if Suc n = idx (Suc i) then ws (Suc i) else ws i) (Suc n)"
proof (auto)
  assume eq: "Suc n = idx (Suc i)"
  from idx have "idx (Suc i) < idx (Suc(Suc i))"
    by (unfold idx_sequence_def, blast)
  with eq idx show "merge ws idx (idx (Suc i)) = ws (Suc i) (idx (Suc i))"
    by (simp add: merge)
next
  assume neq: "Suc n \<noteq> idx (Suc i)"
  with n have "Suc n \<in> {idx i ..< idx (Suc i) }"
    by auto
  with idx show "merge ws idx (Suc n) = ws i (Suc n)"
    by (rule merge)
qed

end


(*  Title:      HOL/ex/ThreeDivides.thy
    Author:     Benjamin Porter, 2005
*)

section \<open>Three Divides Theorem\<close>

theory ThreeDivides
imports Main "HOL-Library.LaTeXsugar"
begin

subsection \<open>Abstract\<close>

text \<open>
The following document presents a proof of the Three Divides N theorem
formalised in the Isabelle/Isar theorem proving system.

{\em Theorem}: $3$ divides $n$ if and only if $3$ divides the sum of all
digits in $n$.

{\em Informal Proof}:
Take $n = \sum{n_j * 10^j}$ where $n_j$ is the $j$'th least
significant digit of the decimal denotation of the number n and the
sum ranges over all digits. Then $$ (n - \sum{n_j}) = \sum{n_j * (10^j
- 1)} $$ We know $\forall j\; 3|(10^j - 1) $ and hence $3|LHS$,
therefore $$\forall n\; 3|n \Longleftrightarrow 3|\sum{n_j}$$
\<open>\<box>\<close>
\<close>

subsection \<open>Formal proof\<close>

subsubsection \<open>Miscellaneous summation lemmas\<close>

text \<open>If $a$ divides \<open>A x\<close> for all x then $a$ divides any
sum over terms of the form \<open>(A x)*(P x)\<close> for arbitrary $P$.\<close>

lemma div_sum:
  fixes a::nat and n::nat
  shows "\<forall>x. a dvd A x \<Longrightarrow> a dvd (\<Sum>x<n. A x * D x)"
proof (induct n)
  case 0 show ?case by simp
next
  case (Suc n)
  from Suc
  have "a dvd (A n * D n)" by (simp add: dvd_mult2)
  with Suc
  have "a dvd ((\<Sum>x<n. A x * D x) + (A n * D n))" by (simp add: dvd_add)
  thus ?case by simp
qed

subsubsection \<open>Generalised Three Divides\<close>

text \<open>This section solves a generalised form of the three divides
problem. Here we show that for any sequence of numbers the theorem
holds. In the next section we specialise this theorem to apply
directly to the decimal expansion of the natural numbers.\<close>

text \<open>Here we show that the first statement in the informal proof is
true for all natural numbers. Note we are using @{term "D i"} to
denote the $i$'th element in a sequence of numbers.\<close>

lemma digit_diff_split:
  fixes n::nat and nd::nat and x::nat
  shows "n = (\<Sum>x\<in>{..<nd}. (D x)*((10::nat)^x)) \<Longrightarrow>
             (n - (\<Sum>x<nd. (D x))) = (\<Sum>x<nd. (D x)*(10^x - 1))"
by (simp add: sum_diff_distrib diff_mult_distrib2)

text \<open>Now we prove that 3 always divides numbers of the form $10^x - 1$.\<close>
lemma three_divs_0:
  shows "(3::nat) dvd (10^x - 1)"
proof (induct x)
  case 0 show ?case by simp
next
  case (Suc n)
  let ?thr = "(3::nat)"
  have "?thr dvd 9" by simp
  moreover
  have "?thr dvd (10*(10^n - 1))" by (rule dvd_mult) (rule Suc)
  hence "?thr dvd (10^(n+1) - 10)" by (simp add: nat_distrib)
  ultimately
  have"?thr dvd ((10^(n+1) - 10) + 9)"
    by (simp only: ac_simps) (rule dvd_add)
  thus ?case by simp
qed

text \<open>Expanding on the previous lemma and lemma \<open>div_sum\<close>.\<close>
lemma three_divs_1:
  fixes D :: "nat \<Rightarrow> nat"
  shows "3 dvd (\<Sum>x<nd. D x * (10^x - 1))"
  by (subst mult.commute, rule div_sum) (simp add: three_divs_0 [simplified])

text \<open>Using lemmas \<open>digit_diff_split\<close> and
\<open>three_divs_1\<close> we now prove the following lemma.
\<close>
lemma three_divs_2:
  fixes nd::nat and D::"nat\<Rightarrow>nat"
  shows "3 dvd ((\<Sum>x<nd. (D x)*(10^x)) - (\<Sum>x<nd. (D x)))"
proof -
  from three_divs_1 have "3 dvd (\<Sum>x<nd. D x * (10 ^ x - 1))" .
  thus ?thesis by (simp only: digit_diff_split)
qed

text \<open>
We now present the final theorem of this section. For any
sequence of numbers (defined by a function @{term "D :: (nat\<Rightarrow>nat)"}),
we show that 3 divides the expansive sum $\sum{(D\;x)*10^x}$ over $x$
if and only if 3 divides the sum of the individual numbers
$\sum{D\;x}$.
\<close>
lemma three_div_general:
  fixes D :: "nat \<Rightarrow> nat"
  shows "(3 dvd (\<Sum>x<nd. D x * 10^x)) = (3 dvd (\<Sum>x<nd. D x))"
proof
  have mono: "(\<Sum>x<nd. D x) \<le> (\<Sum>x<nd. D x * 10^x)"
    by (rule sum_mono) simp
  txt \<open>This lets us form the term
         @{term "(\<Sum>x<nd. D x * 10^x) - (\<Sum>x<nd. D x)"}\<close>

  {
    assume "3 dvd (\<Sum>x<nd. D x)"
    with three_divs_2 mono
    show "3 dvd (\<Sum>x<nd. D x * 10^x)"
      by (blast intro: dvd_diffD)
  }
  {
    assume "3 dvd (\<Sum>x<nd. D x * 10^x)"
    with three_divs_2 mono
    show "3 dvd (\<Sum>x<nd. D x)"
      by (blast intro: dvd_diffD1)
  }
qed

subsubsection \<open>Three Divides Natural\<close>

text \<open>This section shows that for all natural numbers we can
generate a sequence of digits less than ten that represent the decimal
expansion of the number. We then use the lemma \<open>three_div_general\<close> to prove our final theorem.\<close>

text \<open>\medskip Definitions of length and digit sum.\<close>

text \<open>This section introduces some functions to calculate the
required properties of natural numbers. We then proceed to prove some
properties of these functions.

The function \<open>nlen\<close> returns the number of digits in a natural
number n.\<close>

fun nlen :: "nat \<Rightarrow> nat"
where
  "nlen 0 = 0"
| "nlen x = 1 + nlen (x div 10)"

text \<open>The function \<open>sumdig\<close> returns the sum of all digits in
some number n.\<close>

definition
  sumdig :: "nat \<Rightarrow> nat" where
  "sumdig n = (\<Sum>x < nlen n. n div 10^x mod 10)"

text \<open>Some properties of these functions follow.\<close>

lemma nlen_zero:
  "0 = nlen x \<Longrightarrow> x = 0"
  by (induct x rule: nlen.induct) auto

lemma nlen_suc:
  "Suc m = nlen n \<Longrightarrow> m = nlen (n div 10)"
  by (induct n rule: nlen.induct) simp_all

text \<open>The following lemma is the principle lemma required to prove
our theorem. It states that an expansion of some natural number $n$
into a sequence of its individual digits is always possible.\<close>

lemma exp_exists:
  "m = (\<Sum>x<nlen m. (m div (10::nat)^x mod 10) * 10^x)"
proof (induct "nlen m" arbitrary: m)
  case 0 thus ?case by (simp add: nlen_zero)
next
  case (Suc nd)
  obtain c where mexp: "m = 10*(m div 10) + c \<and> c < 10"
    and cdef: "c = m mod 10" by simp
  show "m = (\<Sum>x<nlen m. m div 10^x mod 10 * 10^x)"
  proof -
    from \<open>Suc nd = nlen m\<close>
    have "nd = nlen (m div 10)" by (rule nlen_suc)
    with Suc have
      "m div 10 = (\<Sum>x<nd. m div 10 div 10^x mod 10 * 10^x)" by simp
    with mexp have
      "m = 10*(\<Sum>x<nd. m div 10 div 10^x mod 10 * 10^x) + c" by simp
    also have
      "\<dots> = (\<Sum>x<nd. m div 10 div 10^x mod 10 * 10^(x+1)) + c"
      by (subst sum_distrib_left) (simp add: ac_simps)
    also have
      "\<dots> = (\<Sum>x<nd. m div 10^(Suc x) mod 10 * 10^(Suc x)) + c"
      by (simp add: div_mult2_eq[symmetric])
    also have
      "\<dots> = (\<Sum>x\<in>{Suc 0..<Suc nd}. m div 10^x  mod 10 * 10^x) + c"
      by (simp only: sum_shift_bounds_Suc_ivl)
         (simp add: atLeast0LessThan)
    also have
      "\<dots> = (\<Sum>x<Suc nd. m div 10^x mod 10 * 10^x)"
      by (simp add: atLeast0LessThan[symmetric] sum_head_upt_Suc cdef)
    also note \<open>Suc nd = nlen m\<close>
    finally
    show "m = (\<Sum>x<nlen m. m div 10^x mod 10 * 10^x)" .
  qed
qed

text \<open>\medskip Final theorem.\<close>

text \<open>We now combine the general theorem \<open>three_div_general\<close>
and existence result of \<open>exp_exists\<close> to prove our final
theorem.\<close>

theorem three_divides_nat:
  shows "(3 dvd n) = (3 dvd sumdig n)"
proof (unfold sumdig_def)
  have "n = (\<Sum>x<nlen n. (n div (10::nat)^x mod 10) * 10^x)"
    by (rule exp_exists)
  moreover
  have "3 dvd (\<Sum>x<nlen n. (n div (10::nat)^x mod 10) * 10^x) =
        (3 dvd (\<Sum>x<nlen n. n div 10^x mod 10))"
    by (rule three_div_general)
  ultimately
  show "3 dvd n = (3 dvd (\<Sum>x<nlen n. n div 10^x mod 10))" by simp
qed

end