theory Big_Step imports Com begin

text \<open>
The big-step semantics is a straight-forward inductive definition
with concrete syntax. Note that the first parameter is a tuple,
so the syntax becomes \<open>(c,s) \<Rightarrow> s'\<close>.
\<close>

text_raw\<open>\snip{BigStepdef}{0}{1}{%\<close>
inductive
  big_step :: "com \<times> state \<Rightarrow> state \<Rightarrow> bool" (infix "\<Rightarrow>" 55)
where
Skip: "(SKIP,s) \<Rightarrow> s" |
Assign: "(x ::= a,s) \<Rightarrow> s(x := aval a s)" |
Seq: "\<lbrakk> (c\<^sub>1,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (c\<^sub>2,s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk> \<Longrightarrow> (c\<^sub>1;;c\<^sub>2, s\<^sub>1) \<Rightarrow> s\<^sub>3" |
IfTrue: "\<lbrakk> bval b s;  (c\<^sub>1,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
IfFalse: "\<lbrakk> \<not>bval b s;  (c\<^sub>2,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t" |
WhileFalse: "\<not>bval b s \<Longrightarrow> (WHILE b DO c,s) \<Rightarrow> s" |
WhileTrue:
"\<lbrakk> bval b s\<^sub>1;  (c,s\<^sub>1) \<Rightarrow> s\<^sub>2;  (WHILE b DO c, s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk>
\<Longrightarrow> (WHILE b DO c, s\<^sub>1) \<Rightarrow> s\<^sub>3"
text_raw\<open>}%endsnip\<close>

text_raw\<open>\snip{BigStepEx}{1}{2}{%\<close>
schematic_goal ex: "(''x'' ::= N 5;; ''y'' ::= V ''x'', s) \<Rightarrow> ?t"
apply(rule Seq)
apply(rule Assign)
apply simp
apply(rule Assign)
done
text_raw\<open>}%endsnip\<close>

thm ex[simplified]

text\<open>We want to execute the big-step rules:\<close>

code_pred big_step .

text\<open>For inductive definitions we need command
       \texttt{values} instead of \texttt{value}.\<close>

values "{t. (SKIP, \<lambda>_. 0) \<Rightarrow> t}"

text\<open>We need to translate the result state into a list
to display it.\<close>

values "{map t [''x''] |t. (SKIP, <''x'' := 42>) \<Rightarrow> t}"

values "{map t [''x''] |t. (''x'' ::= N 2, <''x'' := 42>) \<Rightarrow> t}"

values "{map t [''x'',''y''] |t.
  (WHILE Less (V ''x'') (V ''y'') DO (''x'' ::= Plus (V ''x'') (N 5)),
   <''x'' := 0, ''y'' := 13>) \<Rightarrow> t}"

text\<open>Proof automation:\<close>

text \<open>The introduction rules are good for automatically
construction small program executions. The recursive cases
may require backtracking, so we declare the set as unsafe
intro rules.\<close>
declare big_step.intros [intro]

text\<open>The standard induction rule
@{thm [display] big_step.induct [no_vars]}\<close>

thm big_step.induct

text\<open>
This induction schema is almost perfect for our purposes, but
our trick for reusing the tuple syntax means that the induction
schema has two parameters instead of the \<open>c\<close>, \<open>s\<close>,
and \<open>s'\<close> that we are likely to encounter. Splitting
the tuple parameter fixes this:
\<close>
lemmas big_step_induct = big_step.induct[split_format(complete)]
thm big_step_induct
text \<open>
@{thm [display] big_step_induct [no_vars]}
\<close>

subsection "Rule inversion"

text\<open>What can we deduce from \<^prop>\<open>(SKIP,s) \<Rightarrow> t\<close> ?
That \<^prop>\<open>s = t\<close>. This is how we can automatically prove it:\<close>

inductive_cases SkipE[elim!]: "(SKIP,s) \<Rightarrow> t"
thm SkipE

text\<open>This is an \emph{elimination rule}. The [elim] attribute tells auto,
blast and friends (but not simp!) to use it automatically; [elim!] means that
it is applied eagerly.

Similarly for the other commands:\<close>

inductive_cases AssignE[elim!]: "(x ::= a,s) \<Rightarrow> t"
thm AssignE
inductive_cases SeqE[elim!]: "(c1;;c2,s1) \<Rightarrow> s3"
thm SeqE
inductive_cases IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<Rightarrow> t"
thm IfE

inductive_cases WhileE[elim]: "(WHILE b DO c,s) \<Rightarrow> t"
thm WhileE
text\<open>Only [elim]: [elim!] would not terminate.\<close>

text\<open>An automatic example:\<close>

lemma "(IF b THEN SKIP ELSE SKIP, s) \<Rightarrow> t \<Longrightarrow> t = s"
by blast

text\<open>Rule inversion by hand via the ``cases'' method:\<close>

lemma assumes "(IF b THEN SKIP ELSE SKIP, s) \<Rightarrow> t"
shows "t = s"
proof-
  from assms show ?thesis
  proof cases  \<comment> \<open>inverting assms\<close>
    case IfTrue thm IfTrue
    thus ?thesis by blast
  next
    case IfFalse thus ?thesis by blast
  qed
qed

(* Using rule inversion to prove simplification rules: *)
lemma assign_simp:
  "(x ::= a,s) \<Rightarrow> s' \<longleftrightarrow> (s' = s(x := aval a s))"
  by auto

text \<open>An example combining rule inversion and derivations\<close>
lemma Seq_assoc:
  "(c1;; c2;; c3, s) \<Rightarrow> s' \<longleftrightarrow> (c1;; (c2;; c3), s) \<Rightarrow> s'"
proof
  assume "(c1;; c2;; c3, s) \<Rightarrow> s'"
  then obtain s1 s2 where
    c1: "(c1, s) \<Rightarrow> s1" and
    c2: "(c2, s1) \<Rightarrow> s2" and
    c3: "(c3, s2) \<Rightarrow> s'" by auto
  from c2 c3
  have "(c2;; c3, s1) \<Rightarrow> s'" by (rule Seq)
  with c1
  show "(c1;; (c2;; c3), s) \<Rightarrow> s'" by (rule Seq)
next
  \<comment> \<open>The other direction is analogous\<close>
  assume "(c1;; (c2;; c3), s) \<Rightarrow> s'"
  thus "(c1;; c2;; c3, s) \<Rightarrow> s'" by auto
qed

subsection "Command Equivalence"

text \<open>
  We call two statements \<open>c\<close> and \<open>c'\<close> equivalent wrt.\ the
  big-step semantics when \emph{\<open>c\<close> started in \<open>s\<close> terminates
  in \<open>s'\<close> iff \<open>c'\<close> started in the same \<open>s\<close> also terminates
  in the same \<open>s'\<close>}. Formally:
\<close>
text_raw\<open>\snip{BigStepEquiv}{0}{1}{%\<close>
abbreviation
  equiv_c :: "com \<Rightarrow> com \<Rightarrow> bool" (infix "\<sim>" 50) where
  "c \<sim> c' \<equiv> (\<forall>s t. (c,s) \<Rightarrow> t  =  (c',s) \<Rightarrow> t)"
text_raw\<open>}%endsnip\<close>

text \<open>
Warning: \<open>\<sim>\<close> is the symbol written \verb!\ < s i m >! (without spaces).

  As an example, we show that loop unfolding is an equivalence
  transformation on programs:
\<close>
lemma unfold_while:
  "(WHILE b DO c) \<sim> (IF b THEN c;; WHILE b DO c ELSE SKIP)" (is "?w \<sim> ?iw")
proof -
  \<comment> \<open>to show the equivalence, we look at the derivation tree for\<close>
  \<comment> \<open>each side and from that construct a derivation tree for the other side\<close>
  have "(?iw, s) \<Rightarrow> t" if assm: "(?w, s) \<Rightarrow> t" for s t
  proof -
    from assm show ?thesis
    proof cases \<comment> \<open>rule inversion on \<open>(?w, s) \<Rightarrow> t\<close>\<close>
      case WhileFalse
      thus ?thesis by blast
    next
      case WhileTrue
      from \<open>bval b s\<close> \<open>(?w, s) \<Rightarrow> t\<close> obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      \<comment> \<open>now we can build a derivation tree for the \<^text>\<open>IF\<close>\<close>
      \<comment> \<open>first, the body of the True-branch:\<close>
      hence "(c;; ?w, s) \<Rightarrow> t" by (rule Seq)
      \<comment> \<open>then the whole \<^text>\<open>IF\<close>\<close>
      with \<open>bval b s\<close> show ?thesis by (rule IfTrue)
    qed
  qed
  moreover
  \<comment> \<open>now the other direction:\<close>
  have "(?w, s) \<Rightarrow> t" if assm: "(?iw, s) \<Rightarrow> t" for s t
  proof -
    from assm show ?thesis
    proof cases \<comment> \<open>rule inversion on \<open>(?iw, s) \<Rightarrow> t\<close>\<close>
      case IfFalse
      hence "s = t" using \<open>(?iw, s) \<Rightarrow> t\<close> by blast
      thus ?thesis using \<open>\<not>bval b s\<close> by blast
    next
      case IfTrue
      \<comment> \<open>and for this, only the Seq-rule is applicable:\<close>
      from \<open>(c;; ?w, s) \<Rightarrow> t\<close> obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      \<comment> \<open>with this information, we can build a derivation tree for \<^text>\<open>WHILE\<close>\<close>
      with \<open>bval b s\<close> show ?thesis by (rule WhileTrue)
    qed
  qed
  ultimately
  show ?thesis by blast
qed

text \<open>Luckily, such lengthy proofs are seldom necessary.  Isabelle can
prove many such facts automatically.\<close>

lemma while_unfold:
  "(WHILE b DO c) \<sim> (IF b THEN c;; WHILE b DO c ELSE SKIP)"
by blast

lemma triv_if:
  "(IF b THEN c ELSE c) \<sim> c"
by blast

lemma commute_if:
  "(IF b1 THEN (IF b2 THEN c11 ELSE c12) ELSE c2)
   \<sim>
   (IF b2 THEN (IF b1 THEN c11 ELSE c2) ELSE (IF b1 THEN c12 ELSE c2))"
by blast

lemma sim_while_cong_aux:
  "(WHILE b DO c,s) \<Rightarrow> t  \<Longrightarrow> c \<sim> c' \<Longrightarrow>  (WHILE b DO c',s) \<Rightarrow> t"
apply(induction "WHILE b DO c" s t arbitrary: b c rule: big_step_induct)
 apply blast
apply blast
done

lemma sim_while_cong: "c \<sim> c' \<Longrightarrow> WHILE b DO c \<sim> WHILE b DO c'"
by (metis sim_while_cong_aux)

text \<open>Command equivalence is an equivalence relation, i.e.\ it is
reflexive, symmetric, and transitive. Because we used an abbreviation
above, Isabelle derives this automatically.\<close>

lemma sim_refl:  "c \<sim> c" by simp
lemma sim_sym:   "(c \<sim> c') = (c' \<sim> c)" by auto
lemma sim_trans: "c \<sim> c' \<Longrightarrow> c' \<sim> c'' \<Longrightarrow> c \<sim> c''" by auto

subsection "Execution is deterministic"

text \<open>This proof is automatic.\<close>

theorem big_step_determ: "\<lbrakk> (c,s) \<Rightarrow> t; (c,s) \<Rightarrow> u \<rbrakk> \<Longrightarrow> u = t"
  by (induction arbitrary: u rule: big_step.induct) blast+

text \<open>
  This is the proof as you might present it in a lecture. The remaining
  cases are simple enough to be proved automatically:
\<close>
text_raw\<open>\snip{BigStepDetLong}{0}{2}{%\<close>
theorem
  "(c,s) \<Rightarrow> t  \<Longrightarrow>  (c,s) \<Rightarrow> t'  \<Longrightarrow>  t' = t"
proof (induction arbitrary: t' rule: big_step.induct)
  \<comment> \<open>the only interesting case, \<^text>\<open>WhileTrue\<close>:\<close>
  fix b c s s\<^sub>1 t t'
  \<comment> \<open>The assumptions of the rule:\<close>
  assume "bval b s" and "(c,s) \<Rightarrow> s\<^sub>1" and "(WHILE b DO c,s\<^sub>1) \<Rightarrow> t"
  \<comment> \<open>Ind.Hyp; note the \<^text>\<open>\<And>\<close> because of arbitrary:\<close>
  assume IHc: "\<And>t'. (c,s) \<Rightarrow> t' \<Longrightarrow> t' = s\<^sub>1"
  assume IHw: "\<And>t'. (WHILE b DO c,s\<^sub>1) \<Rightarrow> t' \<Longrightarrow> t' = t"
  \<comment> \<open>Premise of implication:\<close>
  assume "(WHILE b DO c,s) \<Rightarrow> t'"
  with \<open>bval b s\<close> obtain s\<^sub>1' where
      c: "(c,s) \<Rightarrow> s\<^sub>1'" and
      w: "(WHILE b DO c,s\<^sub>1') \<Rightarrow> t'"
    by auto
  from c IHc have "s\<^sub>1' = s\<^sub>1" by blast
  with w IHw show "t' = t" by blast
qed blast+ \<comment> \<open>prove the rest automatically\<close>
text_raw\<open>}%endsnip\<close>

end


(*  Title:      ZF/Induct/Mutil.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1996  University of Cambridge
*)

section \<open>The Mutilated Chess Board Problem, formalized inductively\<close>

theory Mutil imports ZF begin

text \<open>
  Originator is Max Black, according to J A Robinson.  Popularized as
  the Mutilated Checkerboard Problem by J McCarthy.
\<close>

consts
  domino :: i
  tiling :: "i => i"

inductive
  domains "domino" \<subseteq> "Pow(nat \<times> nat)"
  intros
    horiz: "[| i \<in> nat;  j \<in> nat |] ==> {<i,j>, <i,succ(j)>} \<in> domino"
    vertl: "[| i \<in> nat;  j \<in> nat |] ==> {<i,j>, <succ(i),j>} \<in> domino"
  type_intros empty_subsetI cons_subsetI PowI SigmaI nat_succI

inductive
  domains "tiling(A)" \<subseteq> "Pow(\<Union>(A))"
  intros
    empty: "0 \<in> tiling(A)"
    Un: "[| a \<in> A;  t \<in> tiling(A);  a \<inter> t = 0 |] ==> a \<union> t \<in> tiling(A)"
  type_intros empty_subsetI Union_upper Un_least PowI
  type_elims PowD [elim_format]

definition
  evnodd :: "[i, i] => i"  where
  "evnodd(A,b) == {z \<in> A. \<exists>i j. z = <i,j> \<and> (i #+ j) mod 2 = b}"

subsection \<open>Basic properties of evnodd\<close>

lemma evnodd_iff: "<i,j>: evnodd(A,b) \<longleftrightarrow> <i,j>: A & (i#+j) mod 2 = b"
  by (unfold evnodd_def) blast

lemma evnodd_subset: "evnodd(A, b) \<subseteq> A"
  by (unfold evnodd_def) blast

lemma Finite_evnodd: "Finite(X) ==> Finite(evnodd(X,b))"
  by (rule lepoll_Finite, rule subset_imp_lepoll, rule evnodd_subset)

lemma evnodd_Un: "evnodd(A \<union> B, b) = evnodd(A,b) \<union> evnodd(B,b)"
  by (simp add: evnodd_def Collect_Un)

lemma evnodd_Diff: "evnodd(A - B, b) = evnodd(A,b) - evnodd(B,b)"
  by (simp add: evnodd_def Collect_Diff)

lemma evnodd_cons [simp]:
  "evnodd(cons(<i,j>,C), b) =
    (if (i#+j) mod 2 = b then cons(<i,j>, evnodd(C,b)) else evnodd(C,b))"
  by (simp add: evnodd_def Collect_cons)

lemma evnodd_0 [simp]: "evnodd(0, b) = 0"
  by (simp add: evnodd_def)

subsection \<open>Dominoes\<close>

lemma domino_Finite: "d \<in> domino ==> Finite(d)"
  by (blast intro!: Finite_cons Finite_0 elim: domino.cases)

lemma domino_singleton:
    "[| d \<in> domino; b<2 |] ==> \<exists>i' j'. evnodd(d,b) = {<i',j'>}"
  apply (erule domino.cases)
   apply (rule_tac [2] k1 = "i#+j" in mod2_cases [THEN disjE])
     apply (rule_tac k1 = "i#+j" in mod2_cases [THEN disjE])
       apply (rule add_type | assumption)+
      (*Four similar cases: case (i#+j) mod 2 = b, 2#-b, ...*)
      apply (auto simp add: mod_succ succ_neq_self dest: ltD)
  done

subsection \<open>Tilings\<close>

text \<open>The union of two disjoint tilings is a tiling\<close>

lemma tiling_UnI:
    "t \<in> tiling(A) ==> u \<in> tiling(A) ==> t \<inter> u = 0 ==> t \<union> u \<in> tiling(A)"
  apply (induct set: tiling)
   apply (simp add: tiling.intros)
  apply (simp add: Un_assoc subset_empty_iff [THEN iff_sym])
  apply (blast intro: tiling.intros)
  done

lemma tiling_domino_Finite: "t \<in> tiling(domino) ==> Finite(t)"
  apply (induct set: tiling)
   apply (rule Finite_0)
  apply (blast intro!: Finite_Un intro: domino_Finite)
  done

lemma tiling_domino_0_1: "t \<in> tiling(domino) ==> |evnodd(t,0)| = |evnodd(t,1)|"
  apply (induct set: tiling)
   apply (simp add: evnodd_def)
  apply (rule_tac b1 = 0 in domino_singleton [THEN exE])
    prefer 2
    apply simp
   apply assumption
  apply (rule_tac b1 = 1 in domino_singleton [THEN exE])
    prefer 2
    apply simp
   apply assumption
  apply safe
  apply (subgoal_tac "\<forall>p b. p \<in> evnodd (a,b) \<longrightarrow> p\<notin>evnodd (t,b)")
   apply (simp add: evnodd_Un Un_cons tiling_domino_Finite
     evnodd_subset [THEN subset_Finite] Finite_imp_cardinal_cons)
  apply (blast dest!: evnodd_subset [THEN subsetD] elim: equalityE)
  done

lemma dominoes_tile_row:
    "[| i \<in> nat;  n \<in> nat |] ==> {i} * (n #+ n) \<in> tiling(domino)"
  apply (induct_tac n)
   apply (simp add: tiling.intros)
  apply (simp add: Un_assoc [symmetric] Sigma_succ2)
  apply (rule tiling.intros)
    prefer 2 apply assumption
   apply (rename_tac n')
   apply (subgoal_tac (*seems the easiest way of turning one to the other*)
     "{i}*{succ (n'#+n') } \<union> {i}*{n'#+n'} =
       {<i,n'#+n'>, <i,succ (n'#+n') >}")
    prefer 2 apply blast
  apply (simp add: domino.horiz)
  apply (blast elim: mem_irrefl mem_asym)
  done

lemma dominoes_tile_matrix:
    "[| m \<in> nat;  n \<in> nat |] ==> m * (n #+ n) \<in> tiling(domino)"
  apply (induct_tac m)
   apply (simp add: tiling.intros)
  apply (simp add: Sigma_succ1)
  apply (blast intro: tiling_UnI dominoes_tile_row elim: mem_irrefl)
  done

lemma eq_lt_E: "[| x=y; x<y |] ==> P"
  by auto

theorem mutil_not_tiling: "[| m \<in> nat;  n \<in> nat;
         t = (succ(m)#+succ(m))*(succ(n)#+succ(n));
         t' = t - {<0,0>} - {<succ(m#+m), succ(n#+n)>} |]
      ==> t' \<notin> tiling(domino)"
  apply (rule notI)
  apply (drule tiling_domino_0_1)
  apply (erule_tac x = "|A|" for A in eq_lt_E)
  apply (subgoal_tac "t \<in> tiling (domino)")
   prefer 2 (*Requires a small simpset that won't move the succ applications*)
   apply (simp only: nat_succI add_type dominoes_tile_matrix)
  apply (simp add: evnodd_Diff mod2_add_self mod2_succ_succ
    tiling_domino_0_1 [symmetric])
  apply (rule lt_trans)
   apply (rule Finite_imp_cardinal_Diff,
     simp add: tiling_domino_Finite Finite_evnodd Finite_Diff,
     simp add: evnodd_iff nat_0_le [THEN ltD] mod2_add_self)+
  done

end


(*  Title:      CCL/Fix.thy
    Author:     Martin Coen
    Copyright   1993  University of Cambridge
*)

section {* Tentative attempt at including fixed point induction; justified by Smith *}

theory Fix
imports Type
begin

definition idgen :: "i \<Rightarrow> i"
  where "idgen(f) == lam t. case(t,true,false, \<lambda>x y.<f`x, f`y>, \<lambda>u. lam x. f ` u(x))"

axiomatization INCL :: "[i\<Rightarrow>o]\<Rightarrow>o" where
  INCL_def: "INCL(\<lambda>x. P(x)) == (ALL f.(ALL n:Nat. P(f^n`bot)) \<longrightarrow> P(fix(f)))" and
  po_INCL: "INCL(\<lambda>x. a(x) [= b(x))" and
  INCL_subst: "INCL(P) \<Longrightarrow> INCL(\<lambda>x. P((g::i\<Rightarrow>i)(x)))"

subsection {* Fixed Point Induction *}

lemma fix_ind:
  assumes base: "P(bot)"
    and step: "\<And>x. P(x) \<Longrightarrow> P(f(x))"
    and incl: "INCL(P)"
  shows "P(fix(f))"
  apply (rule incl [unfolded INCL_def, rule_format])
  apply (rule Nat_ind [THEN ballI], assumption)
   apply simp_all
   apply (rule base)
  apply (erule step)
  done

subsection {* Inclusive Predicates *}

lemma inclXH: "INCL(P) \<longleftrightarrow> (ALL f. (ALL n:Nat. P(f ^ n ` bot)) \<longrightarrow> P(fix(f)))"
  by (simp add: INCL_def)

lemma inclI: "\<lbrakk>\<And>f. ALL n:Nat. P(f^n`bot) \<Longrightarrow> P(fix(f))\<rbrakk> \<Longrightarrow> INCL(\<lambda>x. P(x))"
  unfolding inclXH by blast

lemma inclD: "\<lbrakk>INCL(P); \<And>n. n:Nat \<Longrightarrow> P(f^n`bot)\<rbrakk> \<Longrightarrow> P(fix(f))"
  unfolding inclXH by blast

lemma inclE: "\<lbrakk>INCL(P); (ALL n:Nat. P(f^n`bot)) \<longrightarrow> P(fix(f)) \<Longrightarrow> R\<rbrakk> \<Longrightarrow> R"
  by (blast dest: inclD)

subsection {* Lemmas for Inclusive Predicates *}

lemma npo_INCL: "INCL(\<lambda>x. \<not> a(x) [= t)"
  apply (rule inclI)
  apply (drule bspec)
   apply (rule zeroT)
  apply (erule contrapos)
  apply (rule po_trans)
   prefer 2
   apply assumption
  apply (subst napplyBzero)
  apply (rule po_cong, rule po_bot)
  done

lemma conj_INCL: "\<lbrakk>INCL(P); INCL(Q)\<rbrakk> \<Longrightarrow> INCL(\<lambda>x. P(x) \<and> Q(x))"
  by (blast intro!: inclI dest!: inclD)

lemma all_INCL: "(\<And>a. INCL(P(a))) \<Longrightarrow> INCL(\<lambda>x. ALL a. P(a,x))"
  by (blast intro!: inclI dest!: inclD)

lemma ball_INCL: "(\<And>a. a:A \<Longrightarrow> INCL(P(a))) \<Longrightarrow> INCL(\<lambda>x. ALL a:A. P(a,x))"
  by (blast intro!: inclI dest!: inclD)

lemma eq_INCL: "INCL(\<lambda>x. a(x) = (b(x)::'a::prog))"
  apply (simp add: eq_iff)
  apply (rule conj_INCL po_INCL)+
  done

subsection {* Derivation of Reachability Condition *}

(* Fixed points of idgen *)

lemma fix_idgenfp: "idgen(fix(idgen)) = fix(idgen)"
  apply (rule fixB [symmetric])
  done

lemma id_idgenfp: "idgen(lam x. x) = lam x. x"
  apply (simp add: idgen_def)
  apply (rule term_case [THEN allI])
      apply simp_all
  done

(* All fixed points are lam-expressions *)

schematic_lemma idgenfp_lam: "idgen(d) = d \<Longrightarrow> d = lam x. ?f(x)"
  apply (unfold idgen_def)
  apply (erule ssubst)
  apply (rule refl)
  done

(* Lemmas for rewriting fixed points of idgen *)

lemma l_lemma: "\<lbrakk>a = b; a ` t = u\<rbrakk> \<Longrightarrow> b ` t = u"
  by (simp add: idgen_def)

lemma idgen_lemmas:
  "idgen(d) = d \<Longrightarrow> d ` bot = bot"
  "idgen(d) = d \<Longrightarrow> d ` true = true"
  "idgen(d) = d \<Longrightarrow> d ` false = false"
  "idgen(d) = d \<Longrightarrow> d ` <a,b> = <d ` a,d ` b>"
  "idgen(d) = d \<Longrightarrow> d ` (lam x. f(x)) = lam x. d ` f(x)"
  by (erule l_lemma, simp add: idgen_def)+

(* Proof of Reachability law - show that fix and lam x.x both give LEAST fixed points
  of idgen and hence are they same *)

lemma po_eta:
  "\<lbrakk>ALL x. t ` x [= u ` x; EX f. t=lam x. f(x); EX f. u=lam x. f(x)\<rbrakk> \<Longrightarrow> t [= u"
  apply (drule cond_eta)+
  apply (erule ssubst)
  apply (erule ssubst)
  apply (rule po_lam [THEN iffD2])
  apply simp
  done

schematic_lemma po_eta_lemma: "idgen(d) = d \<Longrightarrow> d = lam x. ?f(x)"
  apply (unfold idgen_def)
  apply (erule sym)
  done

lemma lemma1:
  "idgen(d) = d \<Longrightarrow>
    {p. EX a b. p=<a,b> \<and> (EX t. a=fix(idgen) ` t \<and> b = d ` t)} <=
      POgen({p. EX a b. p=<a,b> \<and> (EX t. a=fix(idgen) ` t  \<and> b = d ` t)})"
  apply clarify
  apply (rule_tac t = t in term_case)
      apply (simp_all add: POgenXH idgen_lemmas idgen_lemmas [OF fix_idgenfp])
   apply blast
  apply fast
  done

lemma fix_least_idgen: "idgen(d) = d \<Longrightarrow> fix(idgen) [= d"
  apply (rule allI [THEN po_eta])
    apply (rule lemma1 [THEN [2] po_coinduct])
     apply (blast intro: po_eta_lemma fix_idgenfp)+
  done

lemma lemma2:
  "idgen(d) = d \<Longrightarrow>
    {p. EX a b. p=<a,b> \<and> b = d ` a} <= POgen({p. EX a b. p=<a,b> \<and> b = d ` a})"
  apply clarify
  apply (rule_tac t = a in term_case)
      apply (simp_all add: POgenXH idgen_lemmas)
  apply fast
  done

lemma id_least_idgen: "idgen(d) = d \<Longrightarrow> lam x. x [= d"
  apply (rule allI [THEN po_eta])
    apply (rule lemma2 [THEN [2] po_coinduct])
     apply simp
    apply (fast intro: po_eta_lemma fix_idgenfp)+
  done

lemma reachability: "fix(idgen) = lam x. x"
  apply (fast intro: eq_iff [THEN iffD2]
    id_idgenfp [THEN fix_least_idgen] fix_idgenfp [THEN id_least_idgen])
  done

(********)

lemma id_apply: "f = lam x. x \<Longrightarrow> f`t = t"
  apply (erule ssubst)
  apply (rule applyB)
  done

lemma term_ind:
  assumes 1: "P(bot)" and 2: "P(true)" and 3: "P(false)"
    and 4: "\<And>x y. \<lbrakk>P(x); P(y)\<rbrakk> \<Longrightarrow> P(<x,y>)"
    and 5: "\<And>u.(\<And>x. P(u(x))) \<Longrightarrow> P(lam x. u(x))"
    and 6: "INCL(P)"
  shows "P(t)"
  apply (rule reachability [THEN id_apply, THEN subst])
  apply (rule_tac x = t in spec)
  apply (rule fix_ind)
    apply (unfold idgen_def)
    apply (rule allI)
    apply (subst applyBbot)
    apply (rule 1)
   apply (rule allI)
   apply (rule applyB [THEN ssubst])
    apply (rule_tac t = "xa" in term_case)
       apply simp_all
       apply (fast intro: assms INCL_subst all_INCL)+
  done

end


theory Insert
  imports Balance
begin

fun rbt_insert_ad' where
  "rbt_insert_ad' k\<^sub>n v\<^sub>n rbt.Empty = rbt.Branch color.R rbt.Empty k\<^sub>n v\<^sub>n rbt.Empty"
| "rbt_insert_ad' k\<^sub>n v\<^sub>n (rbt.Branch color.B l k v r) = (
    if k\<^sub>n < k then rbt_balance (rbt_insert_ad' k\<^sub>n v\<^sub>n l) k v r
    else if k\<^sub>n > k then rbt_balance l k v (rbt_insert_ad' k\<^sub>n v\<^sub>n r)
    else rbt.Branch color.B l k\<^sub>n v\<^sub>n r
  )"
| "rbt_insert_ad' k\<^sub>n v\<^sub>n (rbt.Branch color.R l k v r) = (
    if k\<^sub>n < k then rbt.Branch color.R (rbt_insert_ad' k\<^sub>n v\<^sub>n l) k v r
    else if k\<^sub>n > k then rbt.Branch color.R l k v (rbt_insert_ad' k\<^sub>n v\<^sub>n r)
    else rbt.Branch color.R l k\<^sub>n v\<^sub>n r
  )"

definition rbt_insert_ad where
  "rbt_insert_ad k v t = paint color.B (rbt_insert_ad' k v t)"

lemma rbt_insert_ad'_correct:
  "rbt_insert_ad' k v t = rbt_ins (\<lambda>_ _ nv. nv) k v t"
  by (induction k v t rule: rbt_insert_ad'.induct; auto)

lemma rbt_insert_ad_correct:
  "rbt_insert_ad k v t = rbt_insert k v t"
  unfolding rbt_insert_def rbt_insert_ad_def rbt_insert_with_key_def
  using rbt_insert_ad'_correct
  by (rule arg_cong)

context rbt_impl
begin
interpretation rbt_impl_deps .

partial_function (M) insert' ::
  "'ki \<Rightarrow> 'vi \<Rightarrow> ('ki, 'vi) rbti \<Rightarrow> ('ki, 'vi) rbti llM" where
  "insert' k\<^sub>n v\<^sub>n n_p = do {
    if n_p = null
    then new (RBT_NODE 0 null k\<^sub>n v\<^sub>n null)
    else do {
      n \<leftarrow> ll_load n_p;
      ll_free n_p;
      case n of (RBT_NODE col l k v r) \<Rightarrow>
      do {
        if col = 0
        then do {
          if! lt_impl k\<^sub>n k
          then! do { l\<^sub>n \<leftarrow> insert' k\<^sub>n v\<^sub>n l; new (RBT_NODE 0 l\<^sub>n k v r) }
          else! do {
            if! lt_impl k k\<^sub>n
            then! do { r\<^sub>n \<leftarrow> insert' k\<^sub>n v\<^sub>n r; new (RBT_NODE 0 l k v r\<^sub>n) }
            else! do {
              key_free k;
              value_free v;
              new (RBT_NODE 0 l k\<^sub>n v\<^sub>n r)
            }
          }
        }
        else do {
          if! lt_impl k\<^sub>n k
          then! do { l\<^sub>n \<leftarrow> insert' k\<^sub>n v\<^sub>n l; balance l\<^sub>n k v r }
          else! do {
            if! lt_impl k k\<^sub>n
            then! do { r\<^sub>n \<leftarrow> insert' k\<^sub>n v\<^sub>n r; balance l k v r\<^sub>n }
            else! do {
              key_free k;
              value_free v;
              new (RBT_NODE 1 l k\<^sub>n v\<^sub>n r)
            }
          }
        }
      }
    }
  }"

lemma insert'_correct:
  "
    llvm_htriple
    (rbt_assn tree treei ** \<upharpoonleft>key_assn k ki ** \<upharpoonleft>value_assn v vi)
    (insert' ki vi treei)
    (\<lambda>r. rbt_assn (rbt_insert_ad' k v tree) r)
  "
proof (induction k v tree arbitrary: treei ki v rule: rbt_insert_ad'.induct)
  case (1 k\<^sub>n v\<^sub>n)
  then show ?case
    apply (subst insert'.simps)
    apply vcg
    done
next
  case (2 k\<^sub>n v\<^sub>n l k v r)

  note [vcg_rules] = 2

  show ?case
    apply (subst insert'.simps)
    apply vcg
    done
next
  case (3 k\<^sub>n v\<^sub>n l k v r)

  note [vcg_rules] = 3

  show ?case
    apply (subst insert'.simps)
    apply vcg
    done
qed

lemmas [llvm_code] = insert'.simps

definition insert where
  "insert k v tree \<equiv>
  do {
    r_p \<leftarrow> insert' k v tree;
    set_color_p 1 r_p;
    return r_p
  }"

lemma rbt_balance_non_empty:
  "rbt_balance l k v r \<noteq> rbt.Empty"
  by (induction l k v r rule: RBT_Impl.balance.induct, auto)

lemma rbt_insert_ad'_non_empty:
  "rbt_insert_ad' k v tree \<noteq> rbt.Empty"
  by(induction k v tree rule: rbt_insert_ad'.induct,
      simp_all add: rbt_balance_non_empty)

lemma insert_correct':
  "
    llvm_htriple
    (rbt_assn tree treei ** \<upharpoonleft>key_assn k ki ** \<upharpoonleft>value_assn v vi)
    (insert ki vi treei)
    (\<lambda>r. rbt_assn (rbt_insert_ad k v tree) r)
  "
  unfolding insert_def rbt_insert_ad_def
  supply insert'_correct[vcg_rules]
  apply vcg
  apply (cases "rbt_insert_ad' k v tree")
  subgoal using rbt_insert_ad'_non_empty by fast
  subgoal
    apply simp
    apply vcg
    done
  done

lemma insert_correct [vcg_rules]:
  "
    llvm_htriple
    (rbt_assn tree treei ** \<upharpoonleft>key_assn k ki ** \<upharpoonleft>value_assn v vi)
    (insert ki vi treei)
    (\<lambda>r. rbt_assn (rbt_insert k v tree) r)
  "
  using insert_correct' rbt_insert_ad_correct by metis

lemmas [llvm_code] = insert_def

end

end


theory Exe2p9
  imports Main
begin

fun itadd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"itadd 0 n = n" |
"itadd (Suc m) n = itadd m (Suc n)"

lemma "itadd m n = m + n"
  apply(induction m arbitrary: n)
   apply(auto)
  done

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
section \<open>Set-Theoretic Coproduct (\<Coprod>-types)\<close>
theory TSCoproduct
  imports
    HOTG.Coproduct
    Sets
begin

definition [typedef]: "Coprod A B \<equiv>
  type (\<lambda>x. \<exists>a : A. x = inl a) \<bar> type (\<lambda>x. \<exists>b : B. x = inr b)"

bundle isa_set_coprod_syntax begin notation Coprod (infixl "\<Coprod>" 70) end
bundle no_isa_set_coprod_syntax begin no_notation Coprod (infixl "\<Coprod>" 70) end

unbundle isa_set_coprod_syntax

lemma mem_coprod_iff_Coprod:
  "x \<in> (A \<Coprod> B) \<longleftrightarrow> x : (Element A \<Coprod> Element B)"
  by unfold_types auto

soft_type_translation
  "x \<in> (A \<Coprod> B)" \<rightleftharpoons> "x : (Element A \<Coprod> Element B)"
  using mem_coprod_iff_Coprod by auto

(* TODO: this translation should be automatic whenever it is needed *)
lemma Element_coprod_iff_Coprod:
  "p : Element (A \<Coprod> B) \<longleftrightarrow> p : Element A \<Coprod> Element B"
  using mem_coprod_iff_Coprod by (auto iff: mem_iff_Element)

context
  includes no_hotg_coprod_syntax
begin

lemma CoprodE [elim]:
  assumes "x : A \<Coprod> B"
  obtains (inl) a where "a : A" "x = inl a" | (inr) b where "b : B" "x = inr b"
  using assms unfolding Coprod_def
  by (auto dest!: Union_typeD simp: meaning_of_type)

lemma inl_type [type]: "inl : A \<Rightarrow> (A \<Coprod> B)"
  by unfold_types auto

lemma inr_type [type]: "inr : B \<Rightarrow> (A \<Coprod> B)"
  by unfold_types auto

lemma Dep_Pair_covariant_left:
  "x : A \<Coprod> B \<Longrightarrow> (\<And>x. x : A \<Longrightarrow> x : A') \<Longrightarrow> x : A' \<Coprod> B"
  by auto

lemma Dep_Pair_covariant_right:
  "x : A \<Coprod> B \<Longrightarrow> (\<And>x. x : B \<Longrightarrow> x : B') \<Longrightarrow> x : A \<Coprod> B'"
  by auto

lemma coprod_rec_type [type]: "coprod_rec : (A \<Rightarrow> X) \<Rightarrow> (B \<Rightarrow> X) \<Rightarrow> (A \<Coprod> B) \<Rightarrow> X"
  by unfold_types auto

lemma type_if_inl_self_Coprod: "inl a : A \<Coprod> B \<Longrightarrow> a : A"
  by auto

lemma type_if_inr_self_Coprod: "inr b : A \<Coprod> B \<Longrightarrow> b : B"
  by auto

end

end


(*
  File:   Arith_Prog_Rel_Primes.thy
  Author: Jose Manuel Rodriguez Caballero, University of Tartu
*)
section \<open>Problem ARITHMETIC PROGRESSIONS (Putnam exam problems 2002)\<close>
theory Arith_Prog_Rel_Primes
  imports
    Complex_Main
    "HOL-Number_Theory.Number_Theory"
begin

text \<open>
 Statement of the problem (from ~\<^cite>\<open>"putnam"\<close>): For which integers $n>1$ does the set of positive
 integers less than and relatively prime to $n$ constitute an arithmetic progression?

 The solution of the above problem is theorem @{text arith_prog_rel_primes_solution}.

 First, we will require some auxiliary material before we get started with the actual
 solution.
\<close>

subsection \<open>Auxiliary results\<close>

lemma even_and_odd_parts:
  fixes n::nat
  assumes \<open>n \<noteq> 0\<close>
  shows \<open>\<exists> k q::nat. n = (2::nat)^k*q \<and> odd q\<close>
proof-
  have \<open>prime (2::nat)\<close>
    by simp
  thus ?thesis
    using prime_power_canonical[where p = "2" and m = "n"]
      assms semiring_normalization_rules(7) by auto
qed

lemma only_one_odd_div_power2:
  fixes n::nat
  assumes \<open>n \<noteq> 0\<close> and  \<open>\<And> x. x dvd n \<Longrightarrow> odd x \<Longrightarrow> x = 1\<close>
  shows \<open>\<exists> k. n = (2::nat)^k\<close>
  by (metis even_and_odd_parts assms(1) assms(2) dvd_triv_left semiring_normalization_rules(11)
      semiring_normalization_rules(7))

lemma coprime_power2:
  fixes n::nat
  assumes \<open>n \<noteq> 0\<close> and \<open>\<And> x. x < n \<Longrightarrow> (coprime x n \<longleftrightarrow> odd x)\<close>
  shows \<open>\<exists> k. n = (2::nat)^k\<close>
proof-
  have \<open>x dvd n \<Longrightarrow> odd x \<Longrightarrow> x = 1\<close>
    for x
    by (metis neq0_conv One_nat_def Suc_1 Suc_lessI assms(1) assms(2) coprime_left_2_iff_odd
        dvd_refl linorder_neqE_nat nat_dvd_1_iff_1 nat_dvd_not_less not_coprimeI)
  thus ?thesis
    using assms(1) only_one_odd_div_power2
    by auto
qed

subsection \<open>Main result\<close>

text \<open>
  The solution to the problem  ARITHMETIC PROGRESSIONS (Putnam exam problems 2002)
\<close>

theorem arith_prog_rel_primes_solution:
  fixes n :: nat
  assumes \<open>n > 1\<close>
  shows \<open>(prime n \<or> (\<exists> k. n = 2^k) \<or> n = 6) \<longleftrightarrow>
(\<exists> a b m. m \<noteq> 0 \<and> {x | x. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m})\<close>
proof-
  have \<open> (prime n \<or> (\<exists> k. n = 2^k) \<or>  n = 6) \<longleftrightarrow>
 (\<exists> b m. m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m})\<close>
  proof
    show "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
      if "prime n \<or> (\<exists>k. n = 2 ^ k) \<or> n = 6"
    proof-
      have "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
        if "prime n"
      proof-
        have \<open>\<exists>m.   m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < m}\<close>
        proof-
          have \<open>{x | x :: nat. x < n \<and> coprime x n} =  {x | x :: nat. x \<noteq> 0 \<and> x < n}\<close>
          proof
            show "{x |x. x < n \<and> coprime x n} \<subseteq> {x |x. x \<noteq> 0 \<and> x < n}"
              by (smt Collect_mono not_le ord_0_nat ord_eq_0 order_refl prime_gt_1_nat that zero_neq_one)
            show "{x |x. x \<noteq> 0 \<and> x < n} \<subseteq> {x |x. x < n \<and> coprime x n}"
              using coprime_commute prime_nat_iff'' that
              by fastforce
          qed
          obtain m where \<open>m+1 = n\<close>
            using add.commute assms less_imp_add_positive by blast
          have \<open>{1+j| j::nat. j < (m::nat)} =  {x | x :: nat. x \<noteq> 0 \<and> x < m+1}\<close>
            by (metis Suc_eq_plus1   \<open>m + 1 = n\<close> gr0_implies_Suc le_simps(3)   less_nat_zero_code   linorder_not_less nat.simps(3) nat_neq_iff  plus_1_eq_Suc )
          hence  \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < (m::nat)}\<close>
            using \<open>{x | x :: nat. x < n \<and> coprime x n} =  {x | x :: nat. x \<noteq> 0 \<and> x < n}\<close>  \<open>m+1 = n\<close>
            by auto
          from \<open>n > 1\<close> have \<open>m \<noteq> 0\<close>
            using \<open>m + 1 = n\<close> by linarith
          have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < m}\<close>
            using Suc_eq_plus1 \<open>1 < n\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j |j. j < m}\<close>
            by auto
          hence \<open>(\<exists> m.  m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j| j::nat. j < m})\<close>
            using \<open>m \<noteq> 0\<close>
            by blast
          thus ?thesis by blast
        qed
        hence \<open>\<exists>m.  m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j*1| j::nat. j < m}\<close>
          by auto
        thus ?thesis
          by blast
      qed
      moreover have "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
        if "\<exists>k. n = 2 ^ k"
      proof-
        obtain k where \<open>n = 2 ^ k\<close>
          using \<open>\<exists>k. n = 2 ^ k\<close> by auto
        have \<open>k \<noteq> 0\<close>
          by (metis \<open>1 < n\<close> \<open>n = 2 ^ k\<close> nat_less_le power.simps(1))
        obtain t where \<open>Suc t = k\<close>
          by (metis \<open>k \<noteq> 0\<close> fib.cases)
        have \<open>n = 2^(Suc t)\<close>
          by (simp add: \<open>Suc t = k\<close> \<open>n = 2 ^ k\<close>)
        have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < 2^t}\<close>
        proof
          show "{x |x. x < n \<and> coprime x n} \<subseteq> {1 + j * 2 |j. j < 2^t}"
          proof
            fix x
            assume \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
            hence \<open>x < n\<close>
              by blast
            have \<open>coprime x n\<close>
              using \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
              by blast
            hence \<open>coprime x (2^(Suc k))\<close>
              by (simp add: \<open>k \<noteq> 0\<close> \<open>n = 2 ^ k\<close>)
            have \<open>odd x\<close>
              using \<open>coprime x n\<close> \<open>k \<noteq> 0\<close> \<open>n = 2 ^ k\<close>
              by auto
            then obtain j where \<open>x = 1+j*2\<close>
              by (metis add.commute add.left_commute left_add_twice mult_2_right oddE)
            have \<open>x < 2^k\<close>
              using \<open>n = 2 ^ k\<close> \<open>x < n\<close> \<open>x = 1+j*2\<close>
              by linarith
            hence \<open>1+j*2 < 2^k\<close>
              using \<open>x = 1+j*2\<close>
              by blast
            hence \<open>j < 2^t\<close>
              using \<open>Suc t = k\<close> by auto
            thus \<open>x \<in> {1 + j * 2 |j. j < 2^t}\<close>
              using \<open>x = 1+j*2\<close>
              by blast
          qed
          show "{1 + j * 2 |j. j < 2 ^ t} \<subseteq> {x |x. x < n \<and> coprime x n}"
          proof
            fix x::nat
            assume \<open>x \<in> {1 + j * 2 |j. j < 2 ^ t}\<close>
            then obtain j where \<open>x = 1 + j * 2\<close> and \<open>j < 2 ^ t\<close>
              by blast
            have \<open>x < 2*(2^t)\<close>
              using  \<open>x = 1 + j * 2\<close>  \<open>j < 2 ^ t\<close>
              by linarith
            hence \<open>x < n\<close>
              by (simp add: \<open>n = 2 ^ Suc t\<close>)
            moreover have \<open>coprime x n\<close>
              by (metis (no_types) \<open>\<And>thesis. (\<And>j. \<lbrakk>x = 1 + j * 2; j < 2 ^ t\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close> \<open>n = 2 ^ k\<close> coprime_Suc_left_nat coprime_mult_right_iff coprime_power_right_iff plus_1_eq_Suc)
            ultimately show \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
              by blast
          qed
        qed
        have \<open>(2::nat)^(t::nat) \<noteq> 0\<close>
          by simp
        obtain m where \<open>m = (2::nat)^t\<close> by blast
        have \<open>m \<noteq> 0\<close>
          using \<open>m = 2 ^ t\<close>
          by auto
        have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < m}\<close>
          using \<open>m = 2 ^ t\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * 2 |j. j < 2 ^ t}\<close>
          by auto
        from  \<open>m \<noteq> 0\<close>  \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < m}\<close>
        show ?thesis by blast
      qed
      moreover have "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
        if "n = 6"
      proof-
        have  \<open>{x | x. x < 6 \<and> coprime x 6} = {1+j*4| j::nat. j < 2}\<close>
        proof-
          have \<open>{x | x::nat. x < 6 \<and> coprime x 6} = {1, 5}\<close>
          proof
            show "{u. \<exists>x. u = (x::nat) \<and> x < 6 \<and> coprime x 6} \<subseteq> {1, 5}"
            proof
              fix u::nat
              assume \<open>u \<in> {u. \<exists>x. u = x \<and> x < 6 \<and> coprime x 6}\<close>
              hence \<open>coprime u 6\<close>
                by blast
              have \<open>u < 6\<close>
                using \<open>u \<in> {u. \<exists>x. u = x \<and> x < 6 \<and> coprime x 6}\<close>
                by blast
              moreover have \<open>u \<noteq> 0\<close>
                using \<open>coprime u 6\<close> ord_eq_0
                by fastforce
              moreover have \<open>u \<noteq> 2\<close>
                using \<open>coprime u 6\<close>
                by auto
              moreover have \<open>u \<noteq> 3\<close>
              proof-
                have \<open>gcd (3::nat) 6 = 3\<close>
                  by auto
                thus ?thesis
                  by (metis (no_types) \<open>coprime u 6\<close> \<open>gcd 3 6 = 3\<close> coprime_iff_gcd_eq_1
                      numeral_eq_one_iff semiring_norm(86))
              qed
              moreover have \<open>u \<noteq> 4\<close>
              proof-
                have \<open>gcd (4::nat) 6 = 2\<close>
                  by (metis (no_types, lifting) add_numeral_left gcd_add1 gcd_add2 gcd_nat.idem
                      numeral_Bit0 numeral_One one_plus_numeral semiring_norm(4) semiring_norm(5))
                thus ?thesis
                  using \<open>coprime u 6\<close> coprime_iff_gcd_eq_1
                  by auto
              qed
              ultimately have \<open>u = 1 \<or> u = 5\<close>
                by auto
              thus \<open>u \<in> {1, 5}\<close>
                by blast
            qed
            show "{1::nat, 5} \<subseteq> {x |x. x < 6 \<and> coprime x 6}"
            proof-
              have \<open>(1::nat) \<in> {x |x. x < 6 \<and> coprime x 6}\<close>
                by simp
              moreover have \<open>(5::nat) \<in> {x |x. x < 6 \<and> coprime x 6}\<close>
                by (metis Suc_numeral coprime_Suc_right_nat less_add_one mem_Collect_eq
                    numeral_plus_one semiring_norm(5) semiring_norm(8))
              ultimately show ?thesis
                by blast
            qed
          qed
          moreover have \<open>{1+j*4| j::nat. j < 2} = {1, 5}\<close>
            by auto
          ultimately show ?thesis by auto
        qed
        moreover have \<open>(2::nat) \<noteq> 0\<close>
          by simp
        ultimately have \<open>\<exists> m.  m \<noteq> 0 \<and> {x | x :: nat. x < 6 \<and> coprime x 6} = {1+j*4| j::nat. j < m}\<close>
          by blast
        thus ?thesis
          using that
          by auto
      qed
      ultimately show ?thesis
        using that
        by blast
    qed
    show "prime n \<or> (\<exists>k. n = 2 ^ k) \<or> n = 6"
      if "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
    proof-
      obtain b m where \<open>m \<noteq> 0\<close> and \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
        using \<open>\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
        by auto
      show ?thesis
      proof(cases \<open>n = 2\<close>)
        case True
        thus ?thesis
          by auto
      next
        case False
        have \<open>b \<le> 4\<close>
        proof(cases \<open>odd b\<close>)
          case True
          show ?thesis
          proof(rule classical)
            assume \<open>\<not>(b \<le> 4)\<close>
            hence \<open>b > 4\<close>
              using le_less_linear
              by blast
            obtain m where \<open>m \<noteq> 0\<close>
              and \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m}\<close>
              using \<open>m \<noteq> 0\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
              by blast
            have \<open>b \<noteq> 0\<close>
              using \<open>4 < b\<close>
              by linarith
            have \<open>n = 2 + (m-1)*b\<close>
            proof-
              have \<open>n-1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
                using \<open>1 < n\<close> coprime_diff_one_left_nat
                by auto
              have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close>
                using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close>
                  \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                by blast
              then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close>
                by blast
              have \<open>i \<le> m-1\<close>
                using \<open>i < m\<close>
                by linarith
              have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close>
                using \<open>m \<noteq> 0\<close>
                by auto
              hence \<open>1 + (m-1)*b \<in> {x | x::nat. x < n \<and> coprime x n}\<close>
                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                by blast
              hence \<open>1 + (m-1)*b < n\<close>
                by blast
              hence \<open>1 + (m-1)*b \<le> n-1\<close>
                by linarith
              hence \<open>1 + (m-1)*b \<le> 1+i*b\<close>
                using \<open>n - 1 = 1 + i * b\<close>
                by linarith
              hence \<open>(m-1)*b \<le> i*b\<close>
                by linarith
              hence \<open>m-1 \<le> i\<close>
                using \<open>b \<noteq> 0\<close>
                by auto
              hence \<open>m-1 = i\<close>
                using \<open>i \<le> m - 1\<close> le_antisym
                by blast
              thus ?thesis
                using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close>
                by auto
            qed
            have \<open>m \<ge> 2\<close>
              using \<open>n = 2 + (m - 1)*b\<close> \<open>n \<noteq> 2\<close>
              by auto
            hence \<open>1+b \<in> {1+j*b| j. j < m}\<close>
              by fastforce
            hence  \<open>1+b \<in> {x | x::nat. x < n \<and> coprime x n}\<close>
              using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
              by blast
            hence \<open>coprime (1+b) n\<close>
              by blast
            have \<open>(2::nat) dvd (1+b)\<close>
              using \<open>odd b\<close>
              by simp
            hence \<open>coprime (2::nat) n\<close>
              using \<open>coprime (1 + b) n\<close> coprime_common_divisor coprime_left_2_iff_odd odd_one
              by blast
            have \<open>(2::nat) < n\<close>
              using \<open>1 < n\<close> \<open>n \<noteq> 2\<close>
              by linarith
            have \<open>2 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
              using \<open>2 < n\<close> \<open>coprime 2 n\<close>
              by blast
            hence  \<open>2 \<in> {1+j*b| j::nat. j < m}\<close>
              using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
              by blast
            then obtain j::nat where \<open>2 = 1+j*b\<close>
              by blast
            have  \<open>1 = j*b\<close>
              using \<open>2 = 1+j*b\<close>
              by linarith
            thus ?thesis
              by simp
          qed
        next
          case False
          hence \<open>even b\<close>
            by simp
          show ?thesis
          proof(rule classical)
            assume \<open>\<not>(b \<le> 4)\<close>
            hence \<open>b > 4\<close>
              using le_less_linear
              by blast
            obtain m where  \<open> m \<noteq> 0\<close>
              and \<open>{x | x::nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m}\<close>
              using \<open>m \<noteq> 0\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
              by blast
            have \<open>b \<noteq> 0\<close>
              using \<open>4 < b\<close>
              by linarith
            have \<open>n = 2 + (m-1)*b\<close>
            proof-
              have \<open>n-1 \<in> {x | x::nat. x < n \<and> coprime x n}\<close>
                using \<open>1 < n\<close> coprime_diff_one_left_nat
                by auto
              have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close>
                using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close>
                  \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                by blast
              then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close>
                by blast
              have \<open>i \<le> m-1\<close>
                using \<open>i < m\<close>
                by linarith
              have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close>
                using \<open>m \<noteq> 0\<close>
                by auto
              hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                by blast
              hence \<open>1 + (m-1)*b < n\<close>
                by blast
              hence \<open>1 + (m-1)*b \<le> n-1\<close>
                by linarith
              hence \<open>1 + (m-1)*b \<le> 1+i*b\<close>
                using \<open>n - 1 = 1 + i * b\<close>
                by linarith
              hence \<open>(m-1)*b \<le> i*b\<close>
                by linarith
              hence \<open>m-1 \<le> i\<close>
                using \<open>b \<noteq> 0\<close>
                by auto
              hence \<open>m-1 = i\<close>
                using \<open>i \<le> m - 1\<close> le_antisym
                by blast
              thus ?thesis
                using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close>
                by auto
            qed
            obtain k :: nat where \<open>b = 2*k\<close>
              using \<open>even b\<close>
              by blast
            have \<open>n = 2*(1 + (m-1)*k)\<close>
              using  \<open>n = 2 + (m-1)*b\<close>  \<open>b = 2*k\<close>
              by simp
            show ?thesis
            proof (cases \<open>odd m\<close>)
              case True
              hence \<open>odd m\<close> by blast
              then obtain t::nat where \<open>m-1 = 2*t\<close>
                by (metis odd_two_times_div_two_nat)
              have  \<open>n = 2*(1 + b*t)\<close>
                using \<open>m - 1 = 2 * t\<close> \<open>n = 2 + (m - 1) * b\<close>
                by auto
              have \<open>t < m\<close>
                using \<open>m - 1 = 2 * t\<close> \<open>m \<noteq> 0\<close>
                by linarith
              have \<open>1 + b*t \<in> {1+j*b| j::nat. j < m}\<close>
                using \<open>t < m\<close>
                by auto
              hence \<open>1 + b*t \<in> {x | x::nat. x < n \<and> coprime x n}\<close>
                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                by blast
              hence \<open>coprime (1 + b*t) n\<close>
                by auto
              thus ?thesis
                by (metis (no_types, lifting) \<open>b = 2 * k\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> \<open>n = 2 * (1 + b * t)\<close> \<open>n = 2 + (m - 1) * b\<close> \<open>n \<noteq> 2\<close> add_cancel_right_right coprime_mult_right_iff coprime_self mult_cancel_left mult_is_0 nat_dvd_1_iff_1)
            next
              case False
              thus ?thesis
              proof(cases \<open>odd k\<close>)
                case True
                hence \<open>odd k\<close>
                  by blast
                have \<open>even (1 + (m - 1) * k)\<close>
                  by (simp add: False True \<open>m \<noteq> 0\<close>)
                have \<open>coprime (2 + (m - 1) * k) (1 + (m - 1) * k)\<close>
                  by simp
                have \<open>coprime (2 + (m - 1) * k) n\<close>
                  using \<open>coprime (2 + (m - 1) * k) (1 + (m - 1) * k)\<close> \<open>even (1 + (m - 1) * k)\<close>
                    \<open>n = 2 * (1 + (m - 1) * k)\<close> coprime_common_divisor coprime_mult_right_iff
                    coprime_right_2_iff_odd odd_one
                  by blast
                have \<open>2 + (m - 1) * k < n\<close>
                  by (metis (no_types, lifting) \<open>even (1 + (m - 1) * k)\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close>
                      add_gr_0 add_mono_thms_linordered_semiring(1) dvd_add_left_iff dvd_add_triv_left_iff dvd_imp_le le_add2 le_neq_implies_less less_numeral_extra(1) mult_2 odd_one)
                have \<open>2 + (m - 1) * k  \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
                  using \<open>2 + (m - 1) * k < n\<close> \<open>coprime (2 + (m - 1) * k) n\<close>
                  by blast
                hence \<open>2 + (m - 1) * k  \<in> {1 + j * b |j. j < m}\<close>
                  using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                  by blast
                then obtain j::nat where  \<open>2 + (m - 1) * k  = 1 + j * b\<close> and \<open>j < m\<close>
                  by blast
                have  \<open>1 + (m - 1) * k  = j * b\<close>
                  using \<open>2 + (m - 1) * k  = 1 + j * b\<close>
                  by simp
                hence  \<open>1 + (m - 1) * k  = j * (2*k)\<close>
                  using \<open>b = 2 * k\<close> by blast
                thus ?thesis
                  by (metis \<open>b = 2 * k\<close> \<open>even b\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> \<open>n = 2 + (m - 1) * b\<close> dvd_add_times_triv_right_iff dvd_antisym dvd_imp_le dvd_triv_right even_numeral mult_2 zero_less_numeral)
              next
                case False
                hence \<open>even k\<close> by auto
                have \<open>odd (1 + (m - 1) * k)\<close>
                  by (simp add: \<open>even k\<close> )
                hence \<open>coprime (3 + (m - 1) * k) (1 + (m - 1) * k)\<close>
                  by (smt add_numeral_left coprime_common_divisor coprime_right_2_iff_odd dvd_add_left_iff not_coprimeE numeral_Bit1 numeral_One numeral_plus_one one_add_one)
                hence \<open>coprime (3 + (m - 1) * k) n\<close>
                  by (metis \<open>even k\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> coprime_mult_right_iff coprime_right_2_iff_odd even_add even_mult_iff odd_numeral)
                have \<open>3 + (m - 1) * k < n\<close>
                  by (smt Groups.add_ac(2) \<open>even k\<close> \<open>n = 2 * (1 + (m - 1) * k)\<close> \<open>n = 2 + (m - 1) * b\<close> \<open>n \<noteq> 2\<close> add_Suc_right add_cancel_right_right add_mono_thms_linordered_semiring(1) dvd_imp_le even_add even_mult_iff le_add2 le_neq_implies_less left_add_twice mult_2 neq0_conv numeral_Bit1 numeral_One odd_numeral one_add_one plus_1_eq_Suc)
                have \<open>3 + (m - 1) * k \<in> {x |x. x < n \<and> coprime x n}\<close>
                  using \<open>3 + (m - 1) * k < n\<close> \<open>coprime (3 + (m - 1) * k) n\<close>
                  by blast
                hence \<open>3 + (m - 1) * k \<in> {1 + j * b |j. j < m}\<close>
                  using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                  by blast
                then obtain j::nat where \<open>3 + (m - 1) * k = 1 + j * b\<close>
                  by blast
                have \<open>2 + (m - 1) * k = j * b\<close>
                  using \<open>3 + (m - 1) * k = 1 + j * b\<close>
                  by simp
                hence  \<open>2 + (m - 1) * k = j * 2*k\<close>
                  by (simp add: \<open>b = 2 * k\<close>)
                thus ?thesis
                  by (metis \<open>4 < b\<close> \<open>b = 2 * k\<close> \<open>even k\<close> dvd_add_times_triv_right_iff dvd_antisym
                      dvd_triv_right mult_2 nat_neq_iff numeral_Bit0)
              qed
            qed
          qed
        qed
        moreover have \<open>b \<noteq> 3\<close>
        proof (rule classical)
          assume \<open>\<not> (b \<noteq> 3)\<close>
          hence \<open>b = 3\<close>
            by blast
          obtain m where  \<open>m \<noteq> 0\<close> and
            \<open>{x | x::nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m}\<close>
            using \<open>m \<noteq> 0\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
            by blast
          have \<open>b \<noteq> 0\<close>
            by (simp add: \<open>b = 3\<close>)
          have \<open>n = 2 + (m-1)*b\<close>
          proof-
            have \<open>n-1 \<in> {x | x::nat. x < n \<and> coprime x n}\<close>
              using \<open>1 < n\<close> coprime_diff_one_left_nat
              by auto
            have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close>
              using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close>
                \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
              by blast
            then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close>
              by blast
            have \<open>i \<le> m-1\<close>
              using \<open>i < m\<close>
              by linarith
            have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close>
              using \<open>m \<noteq> 0\<close>
              by auto
            hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
              using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
              by blast
            hence \<open>1 + (m-1)*b < n\<close>
              by blast
            hence \<open>1 + (m-1)*b \<le> n-1\<close>
              by linarith
            hence \<open>1 + (m-1)*b \<le> 1+i*b\<close>
              using \<open>n - 1 = 1 + i * b\<close>
              by linarith
            hence \<open>(m-1)*b \<le> i*b\<close>
              by linarith
            hence \<open>m-1 \<le> i\<close>
              using \<open>b \<noteq> 0\<close>
              by auto
            hence \<open>m-1 = i\<close>
              using \<open>i \<le> m - 1\<close> le_antisym
              by blast
            thus ?thesis
              using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close>
              by auto
          qed
          have \<open>n > 2\<close>
            using \<open>1 < n\<close> \<open>n \<noteq> 2\<close>
            by linarith
          hence \<open> m \<ge> 2 \<close> using  \<open>n = 2 + (m-1)*b\<close> \<open>b = 3\<close>
            by simp
          have \<open>4 \<in> {1+j*(b::nat)| j::nat. j < m}\<close>
            using \<open>2 \<le> m\<close> \<open>b = 3\<close>
            by force
          hence \<open>(4::nat) \<in>  {x | x :: nat. x < n \<and> coprime x n}\<close>
            using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
            by auto
          hence \<open>coprime (4::nat) n\<close>
            by blast
          have \<open>(2::nat) dvd 4\<close>
            by auto
          hence \<open>coprime (2::nat) n\<close>
            using \<open>coprime (4::nat) n\<close> coprime_divisors dvd_refl
            by blast
          have \<open>4 < n\<close>
            using \<open>4 \<in> {x |x. x < n \<and> coprime x n}\<close>
            by blast
          have \<open>2 < (4::nat)\<close>
            by auto
          have  \<open>2 < n\<close>
            by (simp add: \<open>2 < n\<close>)
          hence \<open>2 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
            using  \<open>coprime (2::nat) n\<close>
            by blast
          hence  \<open>2 \<in> {1+j*(b::nat)| j::nat. j < m}\<close>
            using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
            by blast
          then obtain j::nat where \<open>2 = 1+j*3\<close>
            using \<open>b = 3\<close>
            by blast
          from  \<open>2 = 1+j*3\<close>
          have  \<open>1 = j*3\<close>
            by auto
          hence \<open>3 dvd 1\<close>
            by auto
          thus ?thesis
            using nat_dvd_1_iff_1 numeral_eq_one_iff
            by blast
        qed
        ultimately have \<open>b = 0 \<or> b = 1 \<or> b = 2 \<or> b = 4\<close>
          by auto
        moreover have \<open>b = 0 \<Longrightarrow> \<exists>k. n = 2^k\<close>
        proof-
          assume \<open>b = 0\<close>
          have \<open>{1 + j * b |j. j < m} = {1}\<close>
            using \<open>b = 0\<close> \<open>m \<noteq> 0\<close>
            by auto
          hence \<open>{x |x. x < n \<and> coprime x n} = {1}\<close>
            using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
            by blast
          hence \<open>n = 2\<close>
          proof-
            have \<open>n-1 \<in>  {x | x :: nat. x < n \<and> coprime x n}\<close>
              using \<open>1 < n\<close> coprime_diff_one_left_nat
              by auto
            have \<open>n-1 \<in> {1}\<close>
              using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> \<open>{x |x. x < n \<and> coprime x n} = {1}\<close>
              by blast
            hence \<open>n-1 = 1\<close>
              by blast
            hence \<open>n = 2\<close>
              by simp
            thus ?thesis
              by blast
          qed
          hence \<open>n = 2^1\<close>
            by auto
          thus ?thesis
            by blast
        qed
        moreover have \<open>b = 1 \<Longrightarrow> prime n\<close>
        proof-
          assume \<open>b = 1\<close>
          have \<open>x < n \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> coprime x n\<close>
            for x
          proof-
            assume \<open>x < n\<close> and \<open>x \<noteq> 0\<close>
            have \<open>{1+j| j::nat. j < m} = {x | x::nat. x < m+1 \<and> x \<noteq> 0}\<close>
              by (metis (full_types) Suc_eq_plus1  add_mono1 less_Suc_eq_0_disj  nat.simps(3) plus_1_eq_Suc )
            hence \<open>{x | x :: nat. x < n \<and> coprime x n} = {x | x :: nat. x < m+1 \<and> x \<noteq> 0}\<close>
              using \<open>b = 1\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
              by auto
            have \<open>coprime (n-1) n\<close>
              using \<open>1 < n\<close> coprime_diff_one_left_nat
              by auto
            have \<open>n-1 < n\<close>
              using \<open>1 < n\<close>
              by auto
            have \<open>n-1 \<in> {x |x. x < n \<and> coprime x n}\<close>
              using \<open>coprime (n - 1) n\<close> \<open>n - 1 < n\<close>
              by blast
            have \<open>n-1 \<le> m\<close>
              by (metis (no_types, lifting) CollectD Suc_eq_plus1 Suc_less_eq2 \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close> \<open>{x |x. x < n \<and> coprime x n} = {x |x. x < m + 1 \<and> x \<noteq> 0}\<close>   leD  le_less_linear not_less_eq_eq )
            have \<open>m \<in>  {x | x :: nat. x < m+1 \<and> x \<noteq> 0}\<close>
              using \<open>m \<noteq> 0\<close>
              by auto
            have \<open>m \<in> {x |x. x < n \<and> coprime x n} \<close>
              using \<open>m \<in> {x |x. x < m + 1 \<and> x \<noteq> 0}\<close>
                \<open>{x |x. x < n \<and> coprime x n} = {x |x. x < m + 1 \<and> x \<noteq> 0}\<close>
              by blast
            have \<open>m < n\<close>
              using \<open>m \<in> {x |x. x < n \<and> coprime x n}\<close>
              by blast
            have \<open>m+1 = n\<close>
              using \<open>m < n\<close> \<open>n - 1 \<le> m\<close>
              by linarith
            have \<open>x \<in>  {x | x :: nat. x < m+1 \<and> x \<noteq> 0}\<close>
              using \<open>m + 1 = n\<close> \<open>x < n\<close> \<open>x \<noteq> 0\<close>
              by blast
            hence \<open>x \<in> {x |x. x < n \<and> coprime x n}\<close>
              using \<open>{x |x. x < n \<and> coprime x n} = {x |x. x < m + 1 \<and> x \<noteq> 0}\<close>
              by blast
            thus ?thesis
              by blast
          qed
          thus ?thesis
            using assms coprime_commute nat_neq_iff prime_nat_iff'' by auto
        qed
        moreover have \<open>b = 2 \<Longrightarrow> \<exists> k. n = 2^k\<close>
        proof-
          assume \<open>b = 2\<close>
          have \<open>{x | x :: nat. x < n \<and> coprime x n} = {1+j*2| j::nat. j < m}\<close>
            using \<open>b = 2\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
            by auto
          have \<open>x < n \<Longrightarrow> coprime x n \<longleftrightarrow> odd x\<close>
            for x::nat
          proof-
            assume \<open>x < n\<close>
            have \<open>coprime x n \<Longrightarrow> odd x\<close>
            proof-
              assume \<open>coprime x n\<close>
              have \<open>x \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
                by (simp add: \<open>coprime x n\<close> \<open>x < n\<close>)
              hence \<open>x \<in> {1+j*2| j::nat. j < m}\<close>
                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * 2 |j. j < m}\<close>
                by blast
              then obtain j where \<open>x = 1+j*2\<close>
                by blast
              thus ?thesis
                by simp
            qed
            moreover have \<open>odd x \<Longrightarrow> coprime x n\<close>
            proof-
              assume \<open>odd x\<close>
              obtain j::nat where \<open>x = 1+j*2\<close>
                by (metis \<open>odd x\<close> add.commute mult_2_right odd_two_times_div_two_succ one_add_one semiring_normalization_rules(16))
              have \<open>j < (n-1)/2\<close>
                using \<open>x < n\<close> \<open>x = 1 + j * 2\<close>
                by linarith
              have \<open>n = 2*m\<close>
              proof-
                have  \<open>(2::nat) \<noteq> 0\<close>
                  by auto
                have \<open>n = 2+(m-1)*2\<close>
                proof-
                  have \<open>n-1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
                    using \<open>1 < n\<close> coprime_diff_one_left_nat
                    by auto
                  have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close>
                    using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close>
                      \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                    by blast
                  then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close>
                    by blast
                  have \<open>i \<le> m-1\<close>
                    using \<open>i < m\<close>
                    by linarith
                  have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close>
                    using \<open>m \<noteq> 0\<close> by auto
                  hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
                    using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                    by blast
                  hence \<open>1 + (m-1)*b < n\<close>
                    by blast
                  hence \<open>1 + (m-1)*b \<le> n-1\<close>
                    by linarith
                  hence \<open>1 + (m-1)*b \<le> 1+i*b\<close>
                    using \<open>n - 1 = 1 + i * b\<close>
                    by linarith
                  hence \<open>(m-1)*b \<le> i*b\<close>
                    by linarith
                  hence \<open>m-1 \<le> i\<close>
                  proof-
                    have \<open>b \<noteq> 0\<close>
                      using \<open>b = 2\<close>
                      by simp
                    thus ?thesis
                      using \<open>(m - 1) * b \<le> i * b\<close> mult_le_cancel2
                      by blast
                  qed
                  hence \<open>m-1 = i\<close>
                    using \<open>i \<le> m - 1\<close> le_antisym
                    by blast
                  thus ?thesis
                    using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close>
                    by (simp add: \<open>b = 2\<close>)
                qed
                thus  ?thesis
                  by (simp add: \<open>m \<noteq> 0\<close> \<open>n = 2 + (m - 1) * 2\<close> mult.commute mult_eq_if)
              qed
              hence \<open>j < m\<close>
                using \<open>x < n\<close> \<open>x = 1 + j * 2\<close>
                by linarith
              hence \<open>x \<in> {1+j*2| j::nat. j < m}\<close>
                using \<open>x = 1 + j * 2\<close>
                by blast
              hence \<open>x \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * 2 |j. j < m}\<close>
                by blast
              thus ?thesis
                by blast
            qed
            ultimately show ?thesis
              by blast
          qed
          thus ?thesis
            using coprime_power2 assms
            by auto
        qed
        moreover have \<open>b = 4 \<Longrightarrow> n = 6\<close>
        proof-
          assume \<open>b = 4\<close>
          have \<open>n = 2 \<or> n = 6\<close>
          proof(rule classical)
            assume \<open>\<not> (n = 2 \<or> n = 6)\<close>
            have  \<open>(4::nat) \<noteq> 0\<close>
              by auto
            have \<open>n =  2+(m-1)*4\<close>
            proof-
              have \<open>n-1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
                using \<open>1 < n\<close> coprime_diff_one_left_nat
                by auto
              have \<open>n-1 \<in> {1+j*b| j::nat. j < m}\<close>
                using \<open>n - 1 \<in> {x |x. x < n \<and> coprime x n}\<close>
                  \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                by blast
              then obtain i::nat where \<open>n-1 = 1+i*b\<close> and \<open>i < m\<close>
                by blast
              have \<open>i \<le> m-1\<close>
                using \<open>i < m\<close>
                by linarith
              have \<open>1 + (m-1)*b \<in> {1+j*b| j::nat. j < m}\<close>
                using \<open>m \<noteq> 0\<close>
                by auto
              hence \<open>1 + (m-1)*b \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
                using \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
                by blast
              hence \<open>1 + (m-1)*b < n\<close>
                by blast
              hence \<open>1 + (m-1)*b \<le> n-1\<close>
                by linarith
              hence \<open>1 + (m-1)*b \<le> 1+i*b\<close>
                using \<open>n - 1 = 1 + i * b\<close>
                by linarith
              hence \<open>(m-1)*b \<le> i*b\<close>
                by linarith
              hence \<open>m-1 \<le> i\<close>
              proof-
                have \<open>b \<noteq> 0\<close>
                  using \<open>b = 4\<close> by auto
                thus ?thesis
                  using \<open>(m - 1) * b \<le> i * b\<close> mult_le_cancel2
                  by blast
              qed
              hence \<open>m-1 = i\<close>
                using \<open>i \<le> m - 1\<close> le_antisym
                by blast
              thus ?thesis
                using \<open>m \<noteq> 0\<close> \<open>n - 1 = 1 + i * b\<close>
                by (simp add: \<open>b = 4\<close>)
            qed
            hence \<open>n = 4*m - 2\<close>
              by (simp add: \<open>m \<noteq> 0\<close> mult.commute mult_eq_if)
            have \<open>m \<ge> 3\<close>
              using \<open>\<not> (n = 2 \<or> n = 6)\<close> \<open>n = 2 + (m - 1) * 4\<close>
              by auto
            hence \<open> {1+j*4| j::nat. j < 3} \<subseteq> {1+j*4| j::nat. j < m}\<close>
              by force
            hence \<open>9 \<in> {1+j*4| j::nat. j < 3}\<close>
              by force
            hence \<open>9 \<in> {1+j*4| j::nat. j < m}\<close>
              using  \<open> {1+j*4| j::nat. j < 3} \<subseteq> {1+j*4| j::nat. j < m}\<close>
              by blast
            hence \<open>9 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
              using \<open>b = 4\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
              by auto
            hence \<open>coprime (9::nat) n\<close>
              by blast
            have \<open>(3::nat) dvd 9\<close>
              by auto
            have  \<open>coprime (3::nat) n\<close> using  \<open>coprime (9::nat) n\<close> \<open>(3::nat) dvd 9\<close>
              by (metis coprime_commute coprime_mult_right_iff dvd_def)
            have \<open>(3::nat) < n\<close>
              by (metis One_nat_def Suc_lessI \<open>1 < n\<close> \<open>\<not> (n = 2 \<or> n = 6)\<close> \<open>coprime 3 n\<close>
                  coprime_self numeral_2_eq_2 numeral_3_eq_3 less_numeral_extra(1) nat_dvd_not_less)
            have \<open>3 \<in>  {x | x :: nat. x < n \<and> coprime x n}\<close>
              using \<open>3 < n\<close> \<open>coprime 3 n\<close>
              by blast
            hence  \<open>(3::nat) \<in> {1+j*4| j::nat. j < m}\<close>
              using \<open>b = 4\<close> \<open>{x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}\<close>
              by blast
            then obtain j::nat where \<open>(3::nat) = 1 + j*4\<close>
              by blast
            have \<open>2 = j*4\<close>
              using numeral_3_eq_3 \<open>(3::nat) = 1 + j*4\<close>
              by linarith
            hence \<open>1 = j*2\<close>
              by linarith
            hence \<open>even 1\<close>
              by simp
            thus ?thesis
              using odd_one
              by blast
          qed
          thus ?thesis
            by (simp add: False)
        qed
        ultimately show ?thesis
          by blast
      qed
    qed
  qed
  moreover have \<open>(\<exists> b m. m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {1+j*b| j::nat. j < m})
  \<longleftrightarrow> (\<exists> a b m. m \<noteq> 0 \<and> {x | x :: nat. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m})\<close>
  proof
    show "\<exists>a b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}"
      if "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
      using that
      by blast
    show "\<exists>b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {1 + j * b |j. j < m}"
      if "\<exists>a b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}"
    proof-
      obtain a b m::nat where \<open>m \<noteq> 0\<close>
        and \<open>{x | x :: nat. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m}\<close>
        using \<open>\<exists>a b m. m \<noteq> 0 \<and> {x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close>
        by auto
      have \<open>a = 1\<close>
      proof-
        have \<open>{x | x :: nat. x < n \<and> coprime x n} = {(a::nat)+j*(b::nat)| j::nat. j < m} \<Longrightarrow> a = 1\<close>
        proof-
          have \<open>Min {x | x :: nat. x < n \<and> coprime x n} = Min {a+j*b| j::nat. j < m}\<close>
            using \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close>
            by auto
          have  \<open>Min {x | x :: nat. x < n \<and> coprime x n} = 1\<close>
          proof-
            have \<open>finite {x | x :: nat. x < n \<and> coprime x n}\<close>
              by auto
            have \<open>{x | x :: nat. x < n \<and> coprime x n} \<noteq> {}\<close>
              using \<open>1 < n\<close> by auto
            have \<open>1 \<in> {x | x :: nat. x < n \<and> coprime x n}\<close>
              using \<open>1 < n\<close>
              by auto
            have \<open>\<forall> x. coprime x n \<longrightarrow> x \<ge> 1\<close>
              using \<open>1 < n\<close> le_less_linear
              by fastforce
            hence \<open>\<forall> x.  x < n \<and> coprime x n \<longrightarrow> x \<ge> 1\<close>
              by blast
            hence \<open>\<forall> x \<in> {x | x :: nat. x < n \<and> coprime x n}. x \<ge> 1\<close>
              by blast
            hence \<open>Min {x | x :: nat. x < n \<and> coprime x n} \<ge> 1\<close>
              using \<open>finite {x | x :: nat. x < n \<and> coprime x n}\<close> \<open>{x |x. x < n \<and> coprime x n} \<noteq> {}\<close>
              by auto
            thus ?thesis
              using Min_le \<open>1 \<in> {x |x. x < n \<and> coprime x n}\<close> \<open>finite {x |x. x < n \<and> coprime x n}\<close>
                antisym by blast
          qed
          have \<open>Min  {a+j*b| j::nat. j < m} = a\<close>
          proof -
            have f1: "\<exists>n. a = a + n * b \<and> n < m"
              using \<open>m \<noteq> 0\<close>
              by auto
            have f2: "\<exists>n. 1 = a + n * b \<and> n < m"
              using \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> assms coprime_1_left
              by blast
            have f3: "\<exists>na. a = na \<and> na < n \<and> coprime na n"
              using f1 \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> by blast
            have "n \<noteq> 1"
              by (metis (lifting) assms less_irrefl_nat)
            then have "\<not> coprime 0 n"
              by simp
            then show ?thesis
              using f3 f2 by (metis \<open>Min {x |x. x < n \<and> coprime x n} = 1\<close> \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close> less_one linorder_neqE_nat not_add_less1)
          qed
          hence \<open>Min  {a+j*b| j::nat. j < m} = a\<close> by blast
          thus ?thesis
            using \<open>Min {x | x :: nat. x < n \<and> coprime x n} = 1\<close> \<open>Min {x | x :: nat. x < n \<and> coprime x n} = Min {a+j*b| j::nat. j < m}\<close>
            by linarith
        qed
        thus ?thesis
          using \<open>{x |x. x < n \<and> coprime x n} = {a + j * b |j. j < m}\<close>
          by blast
      qed
      thus ?thesis using  \<open>m \<noteq> 0\<close> \<open>{x | x. x < n \<and> coprime x n} = {a+j*b| j::nat. j < m}\<close>
        by auto
    qed
  qed
  ultimately show ?thesis
    by simp
qed

end