(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

theory ListLibLemmas
imports List_Lib LemmaBucket
begin

(* This theory contains various list results that
are used in proofs related to the abstract cdt_list.*)

(* Sorting a list given a partial ordering, where
        elements are only necessarily comparable if
        relation R holds between them. *)
locale partial_sort =
  fixes less :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
  fixes R :: "'a \<Rightarrow> 'a \<Rightarrow> bool"

  assumes all_comp: "\<And>x y. R x y \<Longrightarrow> (less x y \<or> less y x)"

  (*This is only necessary to guarantee the uniqueness of
    sorted lists. *)
  assumes antisym: "\<And>x y. R x y \<Longrightarrow> less x y \<and> less y x \<Longrightarrow> x = y"

  assumes trans: "\<And>x y z. less x y \<Longrightarrow>  less y z \<Longrightarrow> less x z"

begin

primrec pinsort :: " 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   "pinsort x [] = [x]" |
   "pinsort x (y#ys) = (if (less x y) then (x#y#ys) else y#(pinsort x ys))"

inductive psorted :: "'a list \<Rightarrow> bool" where
  Nil [iff]: "psorted []"
| Cons: "\<forall>y\<in>set xs. less x y \<Longrightarrow> psorted xs \<Longrightarrow> psorted (x # xs)"

definition R_set where
"R_set S \<equiv> \<forall>x y. x \<in> S \<longrightarrow> y \<in> S \<longrightarrow> R x y"

abbreviation R_list where
"R_list xs \<equiv> R_set (set xs)"

definition psort :: "'a list \<Rightarrow> 'a list" where
"psort xs = foldr pinsort xs []"

end

context partial_sort begin

lemma psorted_Cons: "psorted (x#xs) = (psorted xs & (\<forall> y \<in> set xs. less x y))"
  apply (rule iffI)
  apply (erule psorted.cases,simp)
   apply clarsimp
  apply (rule psorted.Cons,clarsimp+)
  done

lemma psorted_distinct_set_unique:
assumes "psorted xs" "distinct xs" "psorted ys" "distinct ys" "set xs = set ys"
        "R_list xs"
shows "xs = ys"
proof -
  from assms have 1: "length xs = length ys" by (auto dest!: distinct_card)
  from assms show ?thesis
  proof(induct rule:list_induct2[OF 1])
    case 1 show ?case by simp
  next
    case 2 thus ?case
    by (simp add: psorted_Cons R_set_def)
         (metis Diff_insert_absorb antisym insertE insert_iff)
  qed
qed

lemma pinsort_set: "set (pinsort a xs) = insert a (set xs)"
  apply (induct xs)
  apply simp
  apply simp
  apply blast
  done

lemma all_comp': "R x y \<Longrightarrow> \<not>less x y \<Longrightarrow> less y x"
  apply (cut_tac x=x and y=y in all_comp,simp+)
  done

lemma pinsort_sorted: "R_set (insert a (set xs)) \<Longrightarrow> psorted xs \<Longrightarrow> psorted (pinsort a xs)"
  apply (induct xs arbitrary: a)
  apply (simp add: psorted_Cons)
  apply (simp add: psorted_Cons)
  apply clarsimp
  apply (simp add: pinsort_set)
  apply (intro impI conjI)
    apply (intro ballI)
    apply (drule_tac x=x in bspec)
     apply simp
    apply (frule(1) trans)
    apply simp
   apply (simp add: R_set_def)
  apply (rule all_comp')
   apply (simp add: R_set_def)
  apply simp
  done

lemma psort_set: "set (psort xs) = set xs"
  apply (simp add: psort_def)
  apply (induct xs)
   apply simp
  apply (simp add: pinsort_set)
  done

lemma psort_psorted: "R_list xs \<Longrightarrow> psorted (psort xs)"
  apply (simp add: psort_def)
  apply (induct xs)
   apply simp
  apply simp
  apply (cut_tac xs =xs in psort_set)
  apply (simp add: psort_def)
  apply (rule pinsort_sorted)
   apply simp
  apply (simp add: R_set_def)
  done

lemma insort_length: "length (pinsort a xs) = Suc (length xs)"
  apply (induct xs)
  apply simp
  apply simp
  done

lemma psort_length: "length (psort xs) = length xs"
  apply (simp add: psort_def)
  apply (induct xs)
   apply simp
  apply simp
  apply (simp add: insort_length)
  done

lemma pinsort_distinct: "\<lbrakk>a \<notin> set xs; distinct xs\<rbrakk>
       \<Longrightarrow> distinct (pinsort a xs)"
  apply (induct xs)
  apply simp
  apply (clarsimp simp add: pinsort_set)
  done

lemma psort_distinct: "distinct xs \<Longrightarrow> distinct (psort xs)"
  apply (simp add: psort_def)
  apply (induct xs)
   apply simp
  apply simp
  apply (rule pinsort_distinct)
   apply (fold psort_def)
   apply (simp add: psort_set)+
  done

lemma in_can_split: "y \<in> set list \<Longrightarrow> \<exists>ys xs. list = xs @ (y # ys)"
  apply (induct list)
   apply simp
  apply clarsimp
  apply (elim disjE)
   apply simp
   apply force
  apply simp
  apply (elim exE)
  apply simp
  apply (rule_tac x=ys in exI)
  apply force
  done

lemma lsorted_sorted:
assumes lsorted: "\<And>x y xs ys . list = xs @ (x # y # ys) \<Longrightarrow> less x y"
shows "psorted list"
  apply (insert lsorted)
  apply atomize
  apply simp
  apply (induct list)
   apply simp
  apply (simp add: psorted_Cons)
  apply (rule context_conjI)
   apply (erule meta_mp)
   apply clarsimp
   apply (drule_tac x="a#xs" in spec)
   apply (drule_tac x=x in spec)
   apply (drule_tac x=y in spec)
   apply (erule mp)
   apply force
  apply (intro ballI)
  apply clarsimp
  apply (drule in_can_split)
  apply (elim exE)
  apply (drule_tac x="[]" in spec)
  apply simp
  apply (case_tac xs)
   apply simp
  apply (clarsimp simp add: psorted_Cons)
  apply (blast intro: trans)
  done

lemma psorted_set: "finite A \<Longrightarrow> R_set A \<Longrightarrow> \<exists>!xs. set xs = A \<and> psorted xs \<and> distinct xs"
  apply (drule finite_distinct_list)
  apply clarify
  apply (rule_tac a="psort xs" in ex1I)
   apply (auto simp: psorted_distinct_set_unique psort_set psort_psorted psort_distinct)
done

end

text {* These list operations roughly correspond to cdt
        operations. *}

lemma after_can_split: "after_in_list list x = Some y \<Longrightarrow> \<exists>ys xs. list = xs @ (x # y # ys)"
  apply (induct list x rule: after_in_list.induct)
  apply simp+
  apply (simp split: if_split_asm)
   apply force
  apply (elim exE)
  apply simp
  apply (rule_tac x="ys" in exI)
  apply simp
  done

lemma distinct_inj_middle: "distinct list \<Longrightarrow> list = (xa @ x # xb) \<Longrightarrow> list = (ya @ x # yb) \<Longrightarrow> xa = ya \<and> xb = yb"
  apply (induct list arbitrary: xa ya)
  apply simp
  apply clarsimp
  apply (case_tac "xa")
   apply simp
   apply (case_tac "ya")
    apply simp
   apply clarsimp
  apply clarsimp
  apply (case_tac "ya")
   apply (simp (no_asm_simp))
   apply simp
  apply clarsimp
  done

lemma after_can_split_distinct:
  "distinct list \<Longrightarrow> after_in_list list x = Some y \<Longrightarrow> \<exists>!ys. \<exists>!xs. list = xs @ (x # y # ys)"
  apply (frule after_can_split)
  apply (elim exE)
  apply (rule ex1I)
   apply (rule ex1I)
    apply assumption
   apply simp
  apply (elim ex1E)
  apply (thin_tac "\<forall>x. P x" for P)
  apply (frule_tac yb="y#ysa" in distinct_inj_middle,assumption+)
  apply simp
  done

lemma after_ignore_head: "x \<notin> set list \<Longrightarrow> after_in_list (list @ list') x = after_in_list list' x"
  apply (induct list x rule: after_in_list.induct)
  apply simp
   apply simp
   apply (case_tac list',simp+)
  done

lemma after_distinct_one_sibling: "distinct list \<Longrightarrow> list = xs @ x # y # ys \<Longrightarrow> after_in_list list x = Some y"
  apply (induct xs)
  apply simp
  apply simp
  apply clarsimp
  apply (subgoal_tac "after_in_list ((a # xs) @ (x # y # ys)) x = after_in_list (x # y # ys) x")
   apply simp
  apply (rule after_ignore_head)
  apply simp
  done

lemma (in partial_sort) after_order_sorted:
assumes after_order: "\<And>x y. after_in_list list x = Some y \<Longrightarrow> less x y"
assumes distinct: "distinct list"
shows "psorted list"
  apply (rule lsorted_sorted)
  apply (rule after_order)
  apply (erule after_distinct_one_sibling[OF distinct])
  done

lemma hd_not_after_in_list:
  "\<lbrakk>distinct xs; x \<notin> set xs\<rbrakk> \<Longrightarrow> after_in_list (x # xs) a \<noteq> Some x"
  apply (induct xs a rule: after_in_list.induct)
    apply simp+
  apply fastforce
  done

lemma after_in_list_inj:
  "\<lbrakk>distinct list; after_in_list list a = Some x; after_in_list list b = Some x\<rbrakk>
    \<Longrightarrow> a = b"
  apply(induct list)
   apply(simp)
  apply(simp)
  apply(case_tac "a=aa")
   apply(case_tac list, simp)
   apply(simp add: hd_not_after_in_list split: if_split_asm)
  apply(case_tac list, simp)
  apply(simp add: hd_not_after_in_list split: if_split_asm)
  done

lemma list_replace_ignore:"a \<notin> set list \<Longrightarrow> list_replace list a b = list"
  apply (simp add: list_replace_def)
  apply (induct list,clarsimp+)
  done

lemma list_replace_empty[simp]: "list_replace [] a b = []"
  by (simp add: list_replace_def)

lemma list_replace_empty2[simp]:
  "(list_replace list a b = []) = (list = [])"
  by (simp add: list_replace_def)

lemma after_in_list_list_replace: "\<lbrakk>p \<noteq> dest; p \<noteq> src;
         after_in_list list p = Some src\<rbrakk>
        \<Longrightarrow> after_in_list (list_replace list src dest) p = Some dest"
  apply (simp add: list_replace_def)
  apply (induct list)
   apply simp+
  apply (case_tac list)
   apply simp+
  apply (intro conjI impI,simp+)
  done

lemma replace_list_preserve_after: "dest \<notin> set list \<Longrightarrow> distinct list \<Longrightarrow>  after_in_list (list_replace list src dest) dest = after_in_list list src"
  apply (simp add: list_replace_def)
  apply (induct list src rule: after_in_list.induct)
    apply (simp+)
  apply fastforce
  done

lemma replace_list_preserve_after': "\<lbrakk>p \<noteq> dest; p \<noteq> src;
         after_in_list list p \<noteq> Some src\<rbrakk>
        \<Longrightarrow> after_in_list (list_replace list src dest) p = after_in_list list p"
  apply (simp add: list_replace_def)
  apply (induct list p rule: after_in_list.induct)
    apply (simp+)
  apply fastforce
  done

lemma distinct_after_in_list_not_self:
  "distinct list \<Longrightarrow> after_in_list list src \<noteq> Some src"
  apply (induct list,simp+)
  apply (case_tac list,clarsimp+)
  done

lemma set_list_insert_after:
  "set (list_insert_after list a b) = set list \<union> (if a \<in> set list then {b} else {})"
  apply(induct list)
   apply(simp)
  apply(simp)
  done

lemma distinct_list_insert_after:
  "\<lbrakk>distinct list; b \<notin> set list \<or> a \<notin> set list\<rbrakk> \<Longrightarrow> distinct (list_insert_after list a b)"
  apply(induct list)
   apply(simp)
  apply(fastforce simp: set_list_insert_after)
  done

lemma list_insert_after_after:
  "\<lbrakk>distinct list; b \<notin> set list; a \<in> set list\<rbrakk>
    \<Longrightarrow> after_in_list (list_insert_after list a b) p
    = (if p = a then Some b else if p = b then after_in_list list a else after_in_list list p)"
  apply(induct list p rule: after_in_list.induct)
    apply (simp split: if_split_asm)+
  apply fastforce
  done

lemma list_remove_removed:
  "set (list_remove list x) = (set list) - {x}"
  apply (induct list,simp+)
  apply blast
  done

lemma remove_distinct_helper: "\<lbrakk>distinct (list_remove list x); a \<noteq> x; a \<notin> set list;
        distinct list\<rbrakk>
       \<Longrightarrow> a \<notin> set (list_remove list x)"
  apply (induct list)
   apply (simp split: if_split_asm)+
  done

lemma list_remove_distinct:
  "distinct list \<Longrightarrow>  distinct (list_remove list x)"
  apply (induct list)
  apply (simp add: remove_distinct_helper split: if_split_asm)+
  done

lemma list_remove_none: "x \<notin> set list \<Longrightarrow> list_remove list x = list"
  apply (induct list)
  apply clarsimp+
  done

lemma replace_distinct: "x \<notin> set list \<Longrightarrow> distinct list \<Longrightarrow> distinct (list_replace list y x)"
  apply (induct list)
  apply (simp add: list_replace_def)+
  apply blast
  done

lemma set_list_replace_list:
  "\<lbrakk>distinct list; slot \<in> set list; slot \<notin> set list'\<rbrakk>
    \<Longrightarrow> set (list_replace_list list slot list') = set list \<union> set list' - {slot}"
  apply (induct list)
  apply auto
  done

lemma after_in_list_in_list:
  "after_in_list list a = Some b \<Longrightarrow> b \<in> set list"
  apply(induct list a arbitrary: b rule: after_in_list.induct)
  apply (simp split: if_split_asm)+
  done

lemma list_replace_empty_after_empty:
  "\<lbrakk>after_in_list list p = Some slot; distinct list\<rbrakk>
    \<Longrightarrow> after_in_list (list_replace_list list slot []) p = after_in_list list slot"
  apply(induct list slot rule: after_in_list.induct)
  apply (simp split: if_split_asm)+
   apply (case_tac xs,simp+)
  apply (case_tac xs,simp+)
  apply (auto dest!: after_in_list_in_list)
  done

lemma list_replace_after_fst_list:
  "\<lbrakk>after_in_list list p = Some slot; distinct list\<rbrakk>
    \<Longrightarrow> after_in_list (list_replace_list list slot (x # xs)) p = Some x"
  apply(induct list p rule: after_in_list.induct)
  apply (simp split: if_split_asm)+
  apply (drule after_in_list_in_list)+
  apply force
  done

lemma after_in_list_append_notin_hd:
  "p \<notin> set list' \<Longrightarrow> after_in_list (list' @ list) p = after_in_list list p"
  apply(induct list', simp, simp)
  apply(case_tac list', simp)
   apply(case_tac list, simp+)
   done

lemma after_in_list_append_last_hd:
  "\<lbrakk>p \<in> set list'; after_in_list list' p = None\<rbrakk>
    \<Longrightarrow> after_in_list (list' @ x # xs) p = Some x"
  apply(induct list' p rule: after_in_list.induct)
    apply(simp)
   apply(simp)
  apply(simp split: if_split_asm)
  done

lemma after_in_list_append_in_hd:
  "after_in_list list p = Some a \<Longrightarrow> after_in_list (list @ list') p = Some a"
  apply(induct list p rule: after_in_list.induct)
    apply(simp split: if_split_asm)+
    done

lemma after_in_list_in_list': "after_in_list list a = Some y \<Longrightarrow> a \<in> set list"
  apply (induct list a rule: after_in_list.induct)
  apply simp+
  apply force
  done

lemma list_replace_after_None_notin_new:
  "\<lbrakk>after_in_list list p = None; p \<notin> set list'\<rbrakk>
    \<Longrightarrow> after_in_list (list_replace_list list slot list') p = None"
  apply(induct list)
   apply(simp)
  apply(simp)
  apply(intro conjI impI)
   apply(simp)
   apply(case_tac list, simp)
    apply(induct list')
     apply(simp)
    apply(simp)
    apply(case_tac list', simp, simp)
   apply(simp split: if_split_asm)
    apply(simp add: after_in_list_append_notin_hd)
   apply(simp add: after_in_list_append_notin_hd)
  apply(case_tac "list_replace_list list slot list'")
   apply(simp)
  apply(simp)
  apply(case_tac list, simp, simp split: if_split_asm)
  done

lemma list_replace_after_notin_new:
  "\<lbrakk>after_in_list list p = Some a; a \<noteq> slot; p \<notin> set list'; p \<noteq> slot\<rbrakk>
    \<Longrightarrow> after_in_list (list_replace_list list slot list') p = Some a"
  apply(induct list)
   apply(simp)
  apply(simp)
  apply(intro conjI impI)
   apply(simp add: after_in_list_append_notin_hd)
   apply(case_tac list, simp, simp)
  apply(case_tac list, simp, simp split: if_split_asm)
  apply(insert after_in_list_append_notin_hd)
  apply(atomize)
  apply(erule_tac x=p in allE, erule_tac x="[aa]" in allE, erule_tac x="list' @ lista" in allE)
  apply(simp)
  done

lemma list_replace_after_None_notin_old:
  "\<lbrakk>after_in_list list' p = None; p \<in> set list'; p \<notin> set list\<rbrakk>
    \<Longrightarrow> after_in_list (list_replace_list list slot list') p = after_in_list list slot"
  apply(induct list)
   apply(simp)
  apply(simp)
  apply(intro conjI impI)
   apply(simp)
   apply(case_tac list)
    apply(simp)
   apply(simp add: after_in_list_append_last_hd)
  apply(case_tac "list_replace_list list slot list'")
   apply(simp)
   apply(case_tac list, simp, simp)
  apply(simp)
  apply(case_tac list, simp, simp)
  done

lemma list_replace_after_notin_old:
  "\<lbrakk>after_in_list list' p = Some a; p \<notin> set list; slot \<in> set list\<rbrakk>
    \<Longrightarrow> after_in_list (list_replace_list list slot list') p = Some a"
  apply(induct list)
   apply(simp)
  apply(simp)
  apply(intro conjI impI)
   apply(simp add: after_in_list_append_in_hd)
  apply(simp)
  apply(case_tac "list_replace_list list slot list'")
   apply(simp)
  apply(simp)
  done

lemma list_replace_set: "x \<in> set list \<Longrightarrow> set (list_replace list x y) = insert y (set (list) - {x})"
  apply (induct list)
  apply (simp add: list_replace_def)+
  apply (intro impI conjI)
  apply blast+
  done

lemma list_swap_both: "x \<in> set list \<Longrightarrow> y \<in> set list \<Longrightarrow> set (list_swap list x y) = set (list)"
  apply (induct list)
  apply (simp add: list_swap_def)+
  apply (intro impI conjI)
  apply blast+
  done

lemma list_swap_self[simp]: "list_swap list x x = list"
  apply (simp add: list_swap_def)
  done

lemma map_ignore: "x \<notin> set list \<Longrightarrow> (map (\<lambda>xa. if xa = x then y else xa)
             list) = list"
  apply (induct list)
  apply simp+
  apply blast
  done

lemma map_ignore2: "y \<notin> set list \<Longrightarrow> (map (\<lambda>xa. if xa = x then y else if xa = y then x else xa)
             list) = (map (\<lambda>xa. if xa = x then y else xa) list)"
  apply (simp add: map_ignore)
  done

lemma map_ignore2': "y \<notin> set list \<Longrightarrow> (map (\<lambda>xa. if xa = y then x else if xa = x then y else xa)
             list) = (map (\<lambda>xa. if xa = x then y else xa) list)"
  apply (simp add: map_ignore)
  apply force
  done

lemma swap_distinct_helper: "\<lbrakk>x \<in> set list; y \<noteq> x; y \<notin> set list; distinct list\<rbrakk>
       \<Longrightarrow> distinct (map (\<lambda>xa. if xa = x then y else xa) list)"
  apply (induct list)
  apply (simp add: map_ignore | elim conjE | intro impI conjI | blast)+
  done

lemma swap_distinct: "x \<in> set list \<Longrightarrow> y \<in> set list \<Longrightarrow> distinct list \<Longrightarrow> distinct (list_swap list x y)"
  apply (induct list)
  apply (simp add: list_swap_def)+
  apply (intro impI conjI,simp_all)
  apply (simp add: map_ignore2 map_ignore2' swap_distinct_helper | elim conjE | force)+
  done

lemma list_swap_none: "x \<notin> set list \<Longrightarrow> y \<notin> set list \<Longrightarrow> list_swap list x y = list"
  apply (induct list)
  apply (simp add: list_swap_def)+
  apply blast
  done

lemma list_swap_one: "x \<in> set list \<Longrightarrow> y \<notin> set list \<Longrightarrow> set (list_swap list x y) = insert y (set (list)) - {x}"
  apply (induct list)
  apply (simp add: list_swap_def)+
  apply (intro impI conjI)
  apply blast+
  done

lemma list_swap_one': "x \<notin> set list \<Longrightarrow> y \<in> set list \<Longrightarrow> set (list_swap list x y) = insert x (set (list)) - {y}"
  apply (induct list)
  apply (simp add: list_swap_def)+
  apply (intro impI conjI)
  apply blast+
  done

lemma in_swapped_list: "y \<in> set list \<Longrightarrow> x \<in> set (list_swap list x y)"
  apply (case_tac "x \<in> set list")
   apply (simp add: list_swap_both)
  apply (simp add: list_swap_one')
  apply (intro notI,simp)
  done

lemma list_swap_empty : "(list_swap list x y = []) = (list = [])"
  by(simp add: list_swap_def)

lemma distinct_after_in_list_antisym:
  "distinct list \<Longrightarrow> after_in_list list a = Some b \<Longrightarrow> after_in_list list b \<noteq> Some a"
  apply (induct list b arbitrary: a rule: after_in_list.induct)
    apply simp+
  apply (case_tac xs)
   apply (clarsimp split: if_split_asm | intro impI conjI)+
  done

lemma after_in_listD: "after_in_list list x = Some y \<Longrightarrow> \<exists>xs ys. list = xs @ (x # y # ys) \<and> x \<notin> set xs"
  apply (induct list x arbitrary: a rule: after_in_list.induct)
    apply (simp split: if_split_asm | elim exE | force)+
  apply (rule_tac x="x # xsa" in exI)
  apply simp
  done

lemma list_swap_symmetric: "list_swap list a b = list_swap list b a"
  apply (simp add: list_swap_def)
  done

lemma list_swap_preserve_after:
  "\<lbrakk>desta \<notin> set list; distinct list\<rbrakk>
\<Longrightarrow> after_in_list (list_swap list srca desta) desta =
   after_in_list list srca"
  apply (induct list desta rule: after_in_list.induct)
  apply (simp add: list_swap_def)+
  apply force
  done

lemma list_swap_preserve_after':
 "\<lbrakk>p \<noteq> desta; p \<noteq> srca; after_in_list list p = Some srca\<rbrakk>
\<Longrightarrow> after_in_list (list_swap list srca desta) p = Some desta"
  apply (induct list p rule: after_in_list.induct)
  apply (simp add: list_swap_def)+
  apply force
  done

lemma list_swap_does_swap:
       "\<lbrakk>distinct list; after_in_list list desta = Some srca\<rbrakk>
       \<Longrightarrow> after_in_list (list_swap list srca desta) srca = Some desta"
  apply (induct list srca rule: after_in_list.induct)
    apply (simp add: list_swap_def)+
  apply (elim conjE)
  apply (intro impI conjI,simp_all)
   apply (frule after_in_list_in_list,simp)+
  done

lemma list_swap_does_swap':
  "distinct list \<Longrightarrow> after_in_list list srca = Some desta \<Longrightarrow>
                after_in_list (list_swap list srca desta) srca =
          after_in_list list desta"
  apply (induct list srca rule: after_in_list.induct)
    apply (simp add: list_swap_def)+
  apply (elim conjE)
  apply (intro impI conjI,simp_all)
   apply (case_tac xs)
    apply (clarsimp+)[2]
  apply (case_tac xs)
   apply clarsimp+
done

lemmas list_swap_preserve_after'' = list_swap_preserve_after'[simplified list_swap_symmetric]

lemma list_swap_preserve_Some_other:
 "\<lbrakk>z \<noteq> desta; z \<noteq> srca; after_in_list list srca = Some z\<rbrakk>
\<Longrightarrow> after_in_list (list_swap list srca desta) desta = Some z"
  apply (induct list srca rule: after_in_list.induct)
  apply (simp add: list_swap_def)+
  apply force
  done

lemmas list_swap_preserve_Some_other' = list_swap_preserve_Some_other[simplified list_swap_symmetric]

lemma list_swap_preserve_None:
 "\<lbrakk>after_in_list list srca = None\<rbrakk>
\<Longrightarrow> after_in_list (list_swap list desta srca) desta = None"
  apply (induct list srca rule: after_in_list.induct)
  apply (simp add: list_swap_def)+
  apply force
  done

lemma list_swap_preserve_None':
 "\<lbrakk>after_in_list list srca = None\<rbrakk>
\<Longrightarrow> after_in_list (list_swap list srca desta) desta = None"
  apply (subst list_swap_symmetric)
  apply (erule list_swap_preserve_None)
  done

lemma list_swap_preserve_after_None:
 "\<lbrakk>p \<noteq> desta; p \<noteq> srca; after_in_list list p = None\<rbrakk>
\<Longrightarrow> after_in_list (list_swap list srca desta) p = None"
  apply (induct list p rule: after_in_list.induct)
  apply (simp add: list_swap_def)+
  apply force
  done

lemma list_swap_preserve_Some_other_distinct:
 "\<lbrakk>distinct list; z \<noteq> desta; after_in_list list srca = Some z\<rbrakk>
\<Longrightarrow> after_in_list (list_swap list srca desta) desta = Some z"
  apply (rule list_swap_preserve_Some_other)
  apply simp+
   apply (rule notI)
   apply simp
   apply (frule distinct_after_in_list_not_self[where src=srca])
   apply simp+
  done

lemma list_swap_preserve_separate:
 "\<lbrakk>p \<noteq> desta; p \<noteq> srca; z \<noteq> desta; z \<noteq> srca; after_in_list list p = Some z\<rbrakk>
\<Longrightarrow> after_in_list (list_swap list srca desta) p = Some z"
  apply (induct list p rule: after_in_list.induct)
  apply (simp add: list_swap_def split: if_split_asm)+
  apply (intro impI conjI)
   apply simp+
  done

fun after_in_list_list where
  "after_in_list_list [] a = []" |
  "after_in_list_list (x # xs) a = (if a = x then xs else after_in_list_list xs a)"

lemma after_in_list_list_in_list:
  notes split_paired_All[simp del] split_paired_Ex[simp del]
  shows "y \<in> set (after_in_list_list list x) \<Longrightarrow> y \<in> set list"
  apply(induct list arbitrary:x y)
  apply(simp)
  apply(case_tac "x=a", simp+)
done

lemma range_nat_relation_induct:
"\<lbrakk> m = Suc (n + k) ; m < cap ; \<forall>n. Suc n < cap \<longrightarrow> P n (Suc n );
   \<forall>i j k. i < cap \<and> j < cap \<and> k < cap \<longrightarrow> P i j \<longrightarrow> P j k \<longrightarrow> P i k \<rbrakk> \<Longrightarrow>  P n m"
  apply (clarify)
  apply (thin_tac "m = t" for t)
  apply (induct k)
   apply (drule_tac x = "n" in spec)
   apply (erule impE, simp, simp)
  apply (frule_tac x = "Suc (n + k)" in spec)
  apply (erule impE)
   apply (simp only: add_Suc_right)
  apply (rotate_tac 3, frule_tac x = n in spec)
  apply (rotate_tac -1, drule_tac x = "Suc (n + k)" in spec)
  apply (rotate_tac -1, drule_tac x = "Suc (n + Suc k) " in spec)
  apply (erule impE)
   apply (intro conjI)
     apply (rule_tac y = "Suc (n + Suc k)" in less_trans)
      apply (rule less_SucI)
      apply (simp only: add_Suc_right)+
done

lemma indexed_trancl_as_set_helper : "\<lbrakk>p < q; q < length list; list ! p = a; list ! q = b;
        q = Suc (p + k); Suc n < length list\<rbrakk>
       \<Longrightarrow> (a, b) \<in> {(i, j). \<exists>p. Suc p <length list \<and> list ! p = i \<and> list ! Suc p = j}\<^sup>+"
  apply (induct k arbitrary: p q a b)
   apply (rule r_into_trancl,simp, rule_tac x = p in exI, simp)
  apply (atomize)
  apply (erule_tac x = p in allE, erule_tac x = "Suc (p + k)" in allE, erule_tac x = "a" in allE, erule_tac x = "list ! Suc (p + k)" in allE)
  apply (elim impE)
        apply (simp)+
  apply (rule_tac b = "list ! Suc (p + k)" in trancl_into_trancl)
   apply (simp)+
  apply (rule_tac x = "Suc (p + k)" in exI, simp)
  done

lemma indexed_trancl_as_set: "distinct list \<Longrightarrow> {(i, j). \<exists> p q. p < q \<and> q < length list \<and> list ! p = i \<and> list ! q = j }
      = {(i, j). \<exists> p. Suc p < length list \<and> list ! p = i \<and> list ! Suc p = j }\<^sup>+"
  apply (rule equalityI)
    apply (rule subsetI)
    apply (case_tac x, simp)
    apply (elim exE conjE)
    apply (frule less_imp_Suc_add)
    apply (erule exE)
    apply (rule_tac cap = "length list" and m = q and n = p and k = k in range_nat_relation_induct)
      apply (simp)
      apply (simp)
      apply (rule allI, rule impI)
      apply (rule_tac p = p and q = q and k = k and n = n in indexed_trancl_as_set_helper)
        apply (simp)+
  apply (rule subsetI)
    apply (case_tac x, simp)
    apply (erule trancl_induct)
      apply (simp, elim exE conjE)
      apply (rule_tac x = p in exI, rule_tac x = "Suc p" in exI, simp)
      apply (simp)
      apply (rotate_tac 4, erule exE, rule_tac x = p in exI)
      apply (erule exE, rule_tac x = "Suc pa" in exI)
      apply (intro conjI)
        defer
        apply (simp)
        apply (erule exE, simp)
        apply (simp)
        apply (erule exE)
        apply (subgoal_tac "pa = q")
          apply (simp)
          apply (frule_tac xs = list and i = pa and j = q in nth_eq_iff_index_eq)
            apply (simp)+
done

lemma indexed_trancl_irrefl: "distinct list \<Longrightarrow> (x,x) \<notin> {(i, j). \<exists> p. Suc p < length list \<and> list ! p = i \<and> list ! Suc p = j }\<^sup>+"
 apply (frule indexed_trancl_as_set [THEN sym])
 apply (simp)
 apply (intro allI impI notI)
 apply (frule_tac xs = list and i = p and j = q in nth_eq_iff_index_eq)
 apply (simp+)
done

lemma after_in_list_trancl_indexed_trancl: "distinct list \<Longrightarrow> {(p, q). after_in_list list p = Some q}\<^sup>+ = {(i, j). \<exists> p. Suc p < length list \<and> list ! p = i \<and> list ! Suc p = j }\<^sup>+"
  apply (rule_tac f = "\<lambda> x. x\<^sup>+" in  arg_cong)
  apply (intro equalityI subsetI)

  apply (case_tac x, simp)
  apply (induct list)
   apply (simp)
   apply (case_tac "a = aa")
     apply (rule_tac x = 0 in exI, case_tac list, simp, simp)
     apply (case_tac list, simp, simp)
     apply (atomize, drule_tac x = x in spec, drule_tac x = aa in spec, drule_tac x = b in spec, simp)
     apply (erule exE, rule_tac x = "Suc p" in exI, simp)

  apply (case_tac x, simp)
  apply (induct list)
    apply (simp)
    apply (case_tac "a = aa")
      apply (erule exE)
      apply (subgoal_tac "p = 0")
        apply (case_tac list, simp, simp)
        apply (subgoal_tac "distinct (aa # list)")
          apply (frule_tac i = 0 and j = p and xs = "aa # list" in nth_eq_iff_index_eq)
          apply (simp, simp, simp, simp)
    apply (atomize, drule_tac x = x in spec, drule_tac x = aa in spec, drule_tac x = b in spec, simp)
    apply (drule mp)
      apply (erule exE)
      apply (case_tac p, simp, simp)
      apply (rule_tac x = nat in exI, simp)
   apply (case_tac list, simp, simp)
done

lemma distinct_after_in_list_not_self_trancl:
  notes split_paired_All[simp del] split_paired_Ex[simp del]
  shows "distinct list \<Longrightarrow> (x, x) \<notin> {(p, q). after_in_list list p = Some q}\<^sup>+"
  by (simp add: after_in_list_trancl_indexed_trancl indexed_trancl_irrefl)

lemma distinct_after_in_list_in_list_trancl:
  notes split_paired_All[simp del] split_paired_Ex[simp del]
  shows "\<lbrakk>distinct list; (x, y) \<in> {(p, q). after_in_list list q = Some p}\<^sup>+\<rbrakk> \<Longrightarrow> x \<in> set list"
  by(erule tranclE2, (drule CollectD, simp, drule after_in_list_in_list, simp)+)

lemma after_in_list_trancl_prepend:
  notes split_paired_All[simp del] split_paired_Ex[simp del]
  shows "\<lbrakk>distinct (y # list); x \<in> set list\<rbrakk> \<Longrightarrow> (y, x) \<in> {(n, p). after_in_list (y # list) n = Some p}\<^sup>+"
  apply(induct list arbitrary:x y)
    apply(simp)
    apply(case_tac "x=a")
      apply(rule r_into_trancl)
      apply(simp)
      apply(drule set_ConsD)
      apply(elim disjE)
        apply(simp)
        apply(atomize)
        apply(drule_tac x=x in spec)
        apply(drule_tac x=y in spec)
        apply(drule_tac mp)
          apply(simp)
        apply(drule_tac mp)
          apply(simp)
        apply(erule trancl_induct)
          apply(drule CollectD, simp)
          apply(rule_tac b = a in trancl_into_trancl2)
            apply(simp)
          apply(rule r_into_trancl)
          apply(rule_tac a = "(a,ya)" in CollectI)
          apply(clarsimp)
          apply(case_tac list)
            apply(simp)
            apply(simp)
          apply(case_tac "ya=a")
            apply(drule CollectD)
            apply(simp del:after_in_list.simps)
            apply(drule after_in_list_in_list')
            apply(simp)
            apply(rule_tac b=ya in trancl_into_trancl)
              apply(simp)
              apply(drule CollectD)
              apply(rule CollectI)
              apply(case_tac "ya=y")
                apply(frule_tac x=y in distinct_after_in_list_not_self_trancl)
                apply(simp)
                apply(case_tac list)
                  apply(simp)
                  apply(simp)
done

lemma after_in_list_append_not_hd:
  notes split_paired_All[simp del] split_paired_Ex[simp del]
  shows "a \<noteq> x \<Longrightarrow> after_in_list (a # list) x = after_in_list list x"
by (case_tac list, simp, simp)

lemma trancl_Collect_rev:
  "(a, b) \<in> {(x, y). P x y}\<^sup>+ \<Longrightarrow> (b, a) \<in> {(x, y). P y x}\<^sup>+"
  apply(induct rule: trancl_induct)
   apply(fastforce intro: trancl_into_trancl2)+
   done

lemma prepend_after_in_list_distinct : "distinct (a # list) \<Longrightarrow> {(next, p). after_in_list (a # list) p = Some next}\<^sup>+ =
       {(next, p). after_in_list (list) p = Some next}\<^sup>+ \<union>
       set list \<times> {a} "
  apply (rule equalityI)
   (* \<subseteq> direction *)
   apply (rule subsetI, case_tac x)
   apply (simp)
   apply (erule trancl_induct)
     (* base case *)
    apply (drule CollectD, simp)
    apply (case_tac list, simp)
    apply (simp split:if_split_asm)
    apply (rule r_into_trancl)
    apply (rule CollectI, simp)
    (* Inductive case *)
   apply (drule CollectD, simp)
   apply (erule disjE)
    apply (case_tac "a \<noteq> z")
     apply (rule disjI1)
     apply (rule_tac b =y in trancl_into_trancl)
      apply (simp, case_tac list, simp, simp)

    apply (simp)
    apply (rule disjI2)
    apply (erule conjE)
    apply (frule_tac x = aa and y = y in distinct_after_in_list_in_list_trancl)
     apply (simp)
    apply (simp)
   apply (subgoal_tac "after_in_list (a # list) z \<noteq> Some a", simp)
   apply (rule_tac hd_not_after_in_list, simp, simp)
(* \<supseteq> direction *)
  apply (rule subsetI)
  apply (case_tac x)
  apply (simp)
  apply (erule disjE)
    (* transitive case *)
   apply (erule tranclE2)
    apply (drule CollectD, simp)
    apply (subgoal_tac "b \<noteq> a")
     apply (rule r_into_trancl)
     apply (rule CollectI, simp)
     apply (case_tac list, simp, simp)
    apply (frule after_in_list_in_list')
    apply (erule conjE)
    apply (blast)
   apply (rule_tac y = c in trancl_trans)
    apply (subgoal_tac "c \<noteq> a")
     apply (case_tac list, simp, simp)
     apply (case_tac "aaa = aa")
      apply (rule r_into_trancl)
      apply (rule CollectI, simp)

     apply (rule r_into_trancl)
     apply (rule CollectI, simp)
    apply (erule CollectE, simp)
    apply (frule after_in_list_in_list')
    apply (erule conjE, blast)
   apply (erule trancl_induct)
    apply (simp)
    apply (rule r_into_trancl, simp)
    apply (subgoal_tac "y \<noteq> a")
     apply (case_tac list, simp, simp)
    apply (rotate_tac 3)
    apply (frule after_in_list_in_list')
    apply (erule conjE, blast)
   apply (rule_tac b = y in trancl_into_trancl, simp)
   apply (rule CollectI, simp)
   apply (subgoal_tac "a \<noteq> z")
    apply (case_tac list, simp, simp)
   apply (rotate_tac 3)
   apply (frule after_in_list_in_list')
   apply (blast)
(* not so transitive case *)
  apply (subgoal_tac "distinct (a # list)")
   apply (frule_tac x = aa in after_in_list_trancl_prepend, simp, simp)
   apply (rule trancl_Collect_rev, simp)
  apply (simp)
done

lemma after_in_list_in_cons:
  notes split_paired_All[simp del] split_paired_Ex[simp del]
  shows "\<lbrakk>after_in_list (x # xs) y = Some z; distinct (x # xs); y \<in> set xs\<rbrakk> \<Longrightarrow> z \<in> set xs"
  apply(case_tac "y=x")
  apply(simp)
  apply(simp add:after_in_list_append_not_hd after_in_list_in_list)
done

lemma after_in_list_list_set:
  notes split_paired_All[simp del] split_paired_Ex[simp del]
  shows "distinct list \<Longrightarrow>
         set (after_in_list_list list x)
         = {a. (a, x) \<in> {(next, p). after_in_list list p = Some next}\<^sup>+}"
  apply(intro equalityI)
  (* \<subseteq> *)
   apply(induct list arbitrary:x)
    apply(simp)
   apply(atomize)
   apply(simp)
   apply(rule conjI, rule impI, rule subsetI)
    apply(rule_tac a = xa in CollectI)
    apply(rule trancl_Collect_rev)
    apply(rule after_in_list_trancl_prepend)
     apply(simp)
    apply(simp)
   apply(clarify)
   apply(drule_tac x=x in spec)
   apply(drule_tac B="{a. (a, x) \<in> {(next, p). after_in_list list p = Some next}\<^sup>+}" in set_rev_mp)
    apply(simp)
   apply(drule CollectD)
   apply(simp add:prepend_after_in_list_distinct)
 (* \<supseteq> *)
  apply(clarsimp)
  apply(drule trancl_Collect_rev)
  apply(erule trancl_induct)
    (* base *)
   apply(simp)
   apply(induct list arbitrary:x)
    apply(simp)
   apply(case_tac "a=x")
    apply(frule_tac src=x in distinct_after_in_list_not_self)
    apply(simp)
    apply(drule after_in_list_in_list)
    apply(simp)+
   apply(drule_tac list=list in after_in_list_append_not_hd)
   apply(simp)
   (* inductive *)
  apply(simp)
  apply(drule trancl_Collect_rev)
  apply(induct list arbitrary: x)
   apply(simp)
  apply(case_tac "a\<noteq>x")
  (* a\<noteq>x *)
   apply(atomize, drule_tac x=y in spec, drule_tac x=z in spec, drule_tac x=x in spec)
   apply(simp add:prepend_after_in_list_distinct)
   apply(case_tac "a=y")
    apply(simp add:after_in_list_list_in_list)
   apply(simp add:after_in_list_append_not_hd)
   (* a=x *)
  apply(frule after_in_list_in_cons, simp+)
done

lemma list_eq_after_in_list':
  "\<lbrakk> distinct xs; p = xs ! i; i < length xs \<rbrakk>
    \<Longrightarrow> \<exists>list. xs = list @ p # after_in_list_list xs p"
   apply (induct xs arbitrary: i)
     apply (simp)
  apply (atomize)
  apply (case_tac i)
   apply (simp)
  apply (drule_tac x = nat in spec, simp)
  apply (erule exE, rule impI, rule_tac x = "a # list" in exI)
  apply (simp)
done

lemma after_in_list_last_None:
  "distinct list \<Longrightarrow> after_in_list list (last list) = None"
  apply(induct list)
   apply(simp)
  apply(case_tac list)
   apply(simp)
  apply(fastforce split: if_split_asm)
  done

lemma after_in_list_None_last:
  "\<lbrakk>after_in_list list x = None; x \<in> set list\<rbrakk> \<Longrightarrow> x = last list"
  by (induct list x rule: after_in_list.induct,(simp split: if_split_asm)+)

end


theory Kongruencije
  imports Main HOL.Real
begin

(* Neka je m prirodni broj veci od 1. Kazemo da su brojevi a, b \<in> Z kongruentni po modulu m
i pisemo a \<equiv> b (mod m) ili a \<equiv>m b ako  m | (a − b) . *)
definition kongruentni_po_modulu :: "int \<Rightarrow> int \<Rightarrow> nat \<Rightarrow> bool"  where
"kongruentni_po_modulu a b m = ((m > 1) \<and> (m dvd (a - b)))"

(* Tvrdjenje 1:  Ako je a \<equiv> a1 (mod m) i b \<equiv> b1 (mod m) onda je:
    a + b \<equiv> a1 + b1 (mod m)
    a * b \<equiv> a1 * b1 (mod m)
 *)
lemma tvrdjenje_1_1:
  assumes "m > 1"
  assumes "kongruentni_po_modulu a a1 m"
  assumes "kongruentni_po_modulu b b1 m"
  shows "kongruentni_po_modulu (a + b) (a1 + b1) m"
  unfolding kongruentni_po_modulu_def
proof-
  have *: "m dvd (a - a1)"
    using assms(1) assms(2)
    using kongruentni_po_modulu_def
    by simp
  have **: "m dvd (b - b1)"
    using assms(1) assms(3)
    using kongruentni_po_modulu_def
    by simp
  have "m dvd ((a - a1) + (b - b1))"
    using * **
    by simp
  hence "m dvd (a + b) - (a1 + b1)"
    by (simp add: algebra_simps)
  thus "(m > 1) \<and> (m dvd (a + b) - (a1 + b1))"
      using assms(1)
      by simp
  qed

lemma tvrdjenje_1_2:
  assumes "m > 1"
  assumes "kongruentni_po_modulu a a1 m"
  assumes "kongruentni_po_modulu b b1 m"
  shows "kongruentni_po_modulu (a * b) (a1 * b1) m"
  unfolding kongruentni_po_modulu_def
proof-
  have "m dvd (a - a1)"
    using assms(1) assms(2)
    using kongruentni_po_modulu_def
    by simp
  hence *:"m dvd (a - a1)*b"
    by simp
  have "m dvd (b - b1)"
    using assms(1) assms(3)
    using kongruentni_po_modulu_def
    by simp
  hence **:"m dvd a1*(b - b1)"
    by simp
  have "m dvd ((a - a1)*b + a1*(b - b1))"
    using * **
    by simp
  hence "m dvd (a*b - a1*b1)"
    by (simp add: algebra_simps)
  thus "(m > 1) \<and> (m dvd (a*b - a1*b1))"
    using assms(1)
    by simp
qed

(* Tvrdjenje 2:  Ako je a \<equiv> a1 (mod m) i k je prirodan broj, onda je a^k \<equiv> a1^k (mod m) *)
lemma tvrdjenje_2:
  fixes k :: nat
  assumes "m > 1"
  assumes "kongruentni_po_modulu a a1 m"
  shows "kongruentni_po_modulu (a^k) (a1^k) m"
 (* unfolding kongruentni_po_modulu_def *)
proof (induction k)
  case 0
  then show ?case
    unfolding kongruentni_po_modulu_def
    using assms
    by simp
 next
  case (Suc k)
  then show ?case
  proof-
    thm assms
    thm Suc
    have "kongruentni_po_modulu (a^k * a) (a1^k * a1) m"
      using assms Suc
      by (simp add: tvrdjenje_1_2)
    hence "kongruentni_po_modulu ((a^(k+1))) ((a1^(k+1))) m"
      by (simp add: algebra_simps)
    thus ?case
      using assms
      by simp
    qed
  qed

(* Tvrdjenje 3:  \<equiv>m je relacija ekvivalencije *)
(* Relacija je relacija ekvivalencije ako je refleksivna, simetricna i tranzitivna.*)

lemma refleksivna:
  assumes "m > 1"
  shows "kongruentni_po_modulu a a m"
unfolding kongruentni_po_modulu_def
proof-
  have "m dvd (a - a)"
    by simp
  thus "(m > 1) \<and> (m dvd (a - a))"
    using assms
    by simp
qed

lemma simetricna:
  assumes "m > 1"
  assumes "kongruentni_po_modulu x y m"
  shows "kongruentni_po_modulu y x m"
unfolding kongruentni_po_modulu_def
proof-
  have "m dvd (x - y)"
    using assms
    unfolding kongruentni_po_modulu_def
    by simp
  hence "m dvd (y - x)"
    by (simp add: dvd_diff_commute)
  thm "dvd_diff_commute"
  thus "(m > 1) \<and> m dvd (y - x)"
    using assms
    by simp
qed

lemma tranzitivna:
  assumes "m > 1"
  assumes "kongruentni_po_modulu x y m"
  assumes "kongruentni_po_modulu y z m"
  shows "kongruentni_po_modulu x z m"
unfolding kongruentni_po_modulu_def
proof-
  have *: "m dvd (x - y)"
    using assms
    unfolding kongruentni_po_modulu_def
    by simp
  have **: "m dvd (y - z)"
    using assms
    unfolding kongruentni_po_modulu_def
    by simp
  have "m dvd (x - y + y - z)"
    using * **
    by (smt zdvd_zdiffD)
    thm "zdvd_zdiffD"
    hence "m dvd (x - z)"
      by simp
    thus "(m > 1) \<and> (m dvd (x - z))"
      using assms
      by simp
qed

(* Za naredna tvrdjenja potreban je i nzd. *)

fun nzd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
   "nzd a b = (if b = 0 then a else nzd b (a mod b))"

value "nzd 120 28"

(* Tvrdjenje 4: Ako je a*b \<equiv> a*c (mod m)  i  nzd(a,m) = 1
   onda je b \<equiv> c (mod m) *)

lemma pomocna_2:
  assumes "nzd a b = d"
  shows "a*x + b*y = d"
  sorry   (* dokazuje se pomocu Euklidovog algoritma *)

lemma pomocna_1:
  assumes "a dvd (b*c)"
  assumes "nzd a b = 1"
  shows "a dvd c"
proof-
  have "a*x + b*y = 1"
    using pomocna_2 `nzd a b = 1`
    by simp
  hence *:" a*c*x + b*c*y = c"
    by (metis add.right_neutral crossproduct_noteq linordered_field_class.sign_simps(6) mult.comm_neutral mult_zero_left nzd.simps(1) pomocna_2 rel_simps(76) semiring_normalization_rules(7))
  have "a dvd a*c*x"
    by simp
  hence "a dvd (a*c*x + b*c*y)"
    using assms(1)
    by simp
  thus "a dvd c"
    using *
    by simp
qed

lemma tvrdjenje_4:
  assumes "m > 1"
  assumes "kongruentni_po_modulu (a*b) (a*c) m"
  assumes "nzd a m = 1"
  shows "kongruentni_po_modulu b c m"
unfolding kongruentni_po_modulu_def
proof-
  have "m dvd (a*b - a*c)"
    using assms
    unfolding kongruentni_po_modulu_def
    by simp
  hence "m dvd (a*(b - c))"
    by (simp add: algebra_simps)
  hence "m dvd (b - c)"
    using pomocna_1 `nzd a m = 1`
    by simp
  thus "(m > 1) \<and> (m dvd (b - c))"
    using assms
    by simp
qed

(*
  Tvrdjenje 5: Neka za prirodne brojeve m i n vece od 1 i ceo broj a vazi:
  m|a i n|a. Ako su brojevi m i n uzajamno prosti, onda m*n|a.
*)

lemma tvrdjenje_5:
  fixes m :: nat
  fixes n :: nat
  fixes a :: int
  assumes "m > 1"
  assumes "n > 1"
  assumes "m dvd a"
  assumes "n dvd a"
  assumes "nzd m n = 1"
  shows "m*n dvd a"
proof-
  have *:" a = m * a1"
    using assms(3)
    by (metis (mono_tags, lifting) One_nat_def add_diff_cancel_left' diff_is_0_eq dvd_div_mult_self dvd_minus_self dvd_refl less_numeral_extra(4) less_one linorder_not_le mult.right_neutral nat_diff_split nonzero_mult_div_cancel_left nzd.simps(1) of_nat_0 of_nat_1 pomocna_2 semiring_1_class.of_nat_simps(2) zero_less_diff)
  hence "n dvd m*a1"
    using assms(4) of_nat_dvd_iff
    by blast
  hence "n dvd a1"
    using pomocna_1 assms(5)
    by simp
  hence **: "a1 = n * a2"
    by (metis (mono_tags, lifting) One_nat_def add_diff_cancel_left' diff_is_0_eq dvd_div_mult_self dvd_minus_self dvd_refl less_numeral_extra(4) less_one linorder_not_le mult.right_neutral nat_diff_split nonzero_mult_div_cancel_left nzd.simps(1) of_nat_0 of_nat_1 pomocna_2 semiring_1_class.of_nat_simps(2) zero_less_diff)
  hence "a = m*n*a2"
    using * **
    by simp
  thus "m*n dvd a"
    by simp
qed

lemma tvrdjenje_6:
  assumes "m > 1"
  assumes "n > 1"
  assumes "nzd m n = 1"
  assumes "kongruentni_po_modulu a a1 m"
  assumes "kongruentni_po_modulu a a1 n"
  shows "kongruentni_po_modulu a a1 (m*n)"
proof-
  have *: "m dvd (a - a1)"
    using assms(4)
    unfolding kongruentni_po_modulu_def
    by simp
  have **: "n dvd (a - a1)"
    using assms(5)
    unfolding kongruentni_po_modulu_def
    by simp
  have "(m*n) dvd (a - a1)"
    using * ** tvrdjenje_5 assms
    by simp
  thus "kongruentni_po_modulu a a1 (m*n)"
    using assms
    unfolding kongruentni_po_modulu_def
    using less_1_mult by blast
qed

(* a \<equiv>m b and c \<equiv>m d \<Longrightarrow> a−c \<equiv>m b−d *)
lemma tvrdjenje_7:
  assumes "m > 1"
  assumes "kongruentni_po_modulu a b m"
  assumes "kongruentni_po_modulu c d m"
  shows "kongruentni_po_modulu (a - c) (b - d) m"
proof-
  have *: "m dvd (a - b)"
    using assms(2) kongruentni_po_modulu_def
    by auto
  have **: "m dvd (c - d)"
    using assms(3) kongruentni_po_modulu_def
    by auto
  have "m dvd ((a - b) - (c - d))"
    using * **
    by auto
  hence "m dvd ((a - c) - (b - d))"
    by (simp add: algebra_simps)
  hence "(m > 1) \<and> (m dvd (a - c) - (b - d))"
      using assms(1)
      by simp
  thus ?thesis
    unfolding kongruentni_po_modulu_def
    by simp
qed

(* a \<equiv>m 0 iff m|a;  *)
lemma tvrdjenje_8:
  assumes "m > 1"
  shows "kongruentni_po_modulu a 0 m \<longleftrightarrow> m dvd a"
proof
  show "kongruentni_po_modulu a 0 m \<Longrightarrow> int m dvd a"
  proof-
    assume "kongruentni_po_modulu a 0 m"
    hence "m dvd (a - 0)"
      unfolding kongruentni_po_modulu_def
      by simp
    thus "m dvd a"
      by simp
  qed
next
  show "m dvd a \<Longrightarrow> kongruentni_po_modulu a 0 m"
  proof-
    assume "m dvd a"
    hence "m dvd (a - 0)"
      by simp
    thus "kongruentni_po_modulu a 0 m"
      unfolding kongruentni_po_modulu_def
      using assms
      by simp
  qed
qed

(* If a \<equiv> b mod m, and c > 1, then ca \<equiv> cb mod cm *)
lemma tvrdjenje_9:
  assumes "c > 1"
  assumes "m > 1"
  assumes "kongruentni_po_modulu a b m"
  shows "kongruentni_po_modulu (c*a) (c*b) (c*m)"
proof-
  have *: "c*m > 1"
    using assms(1) assms(2) less_1_mult
    by blast
  have "m dvd (a - b)"
    using assms kongruentni_po_modulu_def
    by auto
  hence "c*m dvd c*(a - b)"
    by simp
  hence "c*m dvd (c*a - c*b)"
    by (simp add: algebra_simps)
  thus ?thesis
    unfolding kongruentni_po_modulu_def
    using assms *
    by simp
qed

(* Provera da li postoji resenje jednacine a*x \<equiv> b (mod m) *)
definition postoji_resenje :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
"postoji_resenje a b m  = ((nzd a m) dvd b)"

value "postoji_resenje 4 9 14"
value "postoji_resenje 7 1 9"
value "postoji_resenje 8 12 28"

definition postoji_resenje2 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
"postoji_resenje2 a b m  = (\<exists>x. m dvd (a*x - b))"

definition postoji_resenje3 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
"postoji_resenje3 a b m  = (\<exists>x y. a*x - b = m*(-y))"

(* Provera da li je x resenje jednacine a*x \<equiv> b (mod m) *)
definition jeste_resenje :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
"jeste_resenje x a b m = (m dvd (a*x - b))"

definition jeste_resenje2 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
"jeste_resenje2 x a b m = (\<exists>y. a*x - b = m*(-y))"

lemma jeste_resenje_sledi_postoji_resenje:
"jeste_resenje x a b m \<longrightarrow> postoji_resenje2 a b m"
  using jeste_resenje_def postoji_resenje2_def
  by blast

(* Neka je d=nzd(a,m) > 1.
   x je resenje jednacine a*x \<equiv> b (mod m) akko je resenje jednacine a*x \<equiv> b (mod m),
   gde su a'=a/d, b'=b/d i m'=m/d. *)
lemma
  assumes "d = nzd a m"
  assumes "d > 1"
  assumes "a' = a/d" "b' = b/d" "m' = m/d"
  shows "jeste_resenje2 x a b m \<longleftrightarrow> jeste_resenje2 x a' b' m'"
proof
  show "jeste_resenje2 x a b m \<Longrightarrow> jeste_resenje2 x a' b' m'"
  proof-
    assume "jeste_resenje2 x a b m"
    have "\<exists>y. a*x - b = m*(-y)"
      using assms
      unfolding jeste_resenje2_def
      using \<open>jeste_resenje2 x a b m\<close> jeste_resenje2_def by blast
    hence "\<exists>y. a*x + m*y = b"
      by (metis crossproduct_eq pomocna_2)
    hence "\<exists>y. (a/d)*x + (m/d)*y = b/d"
      by (metis (mono_tags, hide_lams) assms(4) crossproduct_eq of_nat_add of_nat_mult pomocna_2)
    hence "\<exists>y. a'*x + m'*y = b'"
      using assms
      by (metis add.commute add_diff_cancel_left' add_diff_cancel_right add_diff_cancel_right' add_mult_distrib add_mult_distrib2 crossproduct_eq diff_commute left_add_mult_distrib less_diff_conv mult.commute not_add_less1 pomocna_2 right_diff_distrib' semiring_normalization_rules(2) semiring_normalization_rules(3))
    thus "jeste_resenje2 x a b m \<Longrightarrow> jeste_resenje2 x a' b' m'"
      unfolding jeste_resenje2_def
      by auto
  qed
next
  show "jeste_resenje2 x a' b' m' \<Longrightarrow> jeste_resenje2 x a b m"
  proof-
    assume "jeste_resenje2 x a' b' m'"
    have "\<exists>y. a'*x - b' = m'*(-y)"
      using assms
      unfolding jeste_resenje2_def
      using \<open>jeste_resenje2 x a' b' m'\<close> jeste_resenje2_def by blast
    hence "\<exists>y. a'*x + m'*y = b'"
      by (metis crossproduct_eq pomocna_2)
    hence "\<exists>y. a'*d*x + m'*d*y = b'*d"
      by (metis (mono_tags, hide_lams) assms(4) crossproduct_eq of_nat_add of_nat_mult pomocna_2)
    hence "\<exists>y. a*x + m*y = b"
      using assms
       by (metis add.commute add_diff_cancel_left' add_diff_cancel_right add_diff_cancel_right' add_mult_distrib add_mult_distrib2 crossproduct_eq diff_commute left_add_mult_distrib less_diff_conv mult.commute not_add_less1 pomocna_2 right_diff_distrib' semiring_normalization_rules(2) semiring_normalization_rules(3))
    thus "jeste_resenje2 x a' b' m' \<Longrightarrow> jeste_resenje2 x a b m"
      unfolding jeste_resenje2_def
      by auto
  qed
qed

definition nzs_dva_broja :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"nzs_dva_broja a b = a*b div (nzd a b)"

primrec nzs_liste_brojeva :: "nat list \<Rightarrow> nat" where
  "nzs_liste_brojeva [] = 1"
| "nzs_liste_brojeva (x # xs) = nzs_dva_broja x (nzs_liste_brojeva xs)"

value "nzs_dva_broja 6 8"
value "nzs_liste_brojeva [3, 4, 12]"

definition postoji_resenje_sistema :: "nat list \<Rightarrow> nat list \<Rightarrow> bool" where
  "postoji_resenje_sistema as ms = (\<forall> i j . i\<in>set([0..<(length as)]) \<and> j\<in>set([0..(length ms)]) \<and> (i = j) \<and> (postoji_resenje 1 (as ! i) (ms ! j)))"

definition jeste_resenje_sistema :: "nat \<Rightarrow> nat list \<Rightarrow> nat list \<Rightarrow> bool" where
"jeste_resenje_sistema x as ms = (\<forall> i j . i\<in>set([0..<(length as)]) \<and> j\<in>set([0..(length ms)]) \<and> (i = j) \<and> (jeste_resenje x 1 (as ! i) (ms ! j)))"

lemma jeste_resenje_sledi_postoji_resenje_sistema:
"jeste_resenje_sistema x as ms \<longrightarrow> postoji_resenje_sistema as ms"
  using jeste_resenje_sistema_def
  by blast

primrec lista_nzd :: "nat list \<Rightarrow> nat \<Rightarrow> nat list" where
  "lista_nzd [] y = []"
| "lista_nzd (x # xs) y = (nzd x y) # (lista_nzd xs y)"

fun lista_istih_elemenata' :: "nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> nat list" where
  "lista_istih_elemenata' x 0 xs = xs"
| "lista_istih_elemenata' x len xs = [x] @ (lista_istih_elemenata' x (len-1) xs)"

fun lista_istih_elemenata :: "nat \<Rightarrow> nat \<Rightarrow> nat list" where
"lista_istih_elemenata x len = lista_istih_elemenata' x len []"

value "lista_istih_elemenata 2 10"

lemma pomocna1_za_kinesku_teoremu:
  "nzd (nzs_liste_brojeva xs) y = nzs_liste_brojeva (lista_nzd xs y)"
  sorry

lemma pomocna2_za_kinesku_teoremu:
  "(nzs_liste_brojeva (lista_nzd xs y)) dvd z = (\<forall>x\<in>set(xs) . (nzd x y) dvd z)"
  sorry

lemma pomocna3_za_kinesku_teoremu:
  fixes x y z :: "nat"
  shows "x - y = (x - z) + (z - y)"
  sorry

lemma pomocna4_za_kinesku_teoremu:
"(postoji_resenje_sistema as ms \<and> postoji_resenje x a m) \<longrightarrow> postoji_resenje_sistema (a # as) (m # ms)"
  using postoji_resenje_sistema_def by blast

lemma pomocna5_za_kinesku_teoremu: "a dvd c \<longrightarrow> nzd a b dvd c"
  by (metis diff_is_0_eq' le_add_diff_inverse2 pomocna3_za_kinesku_teoremu rel_simps(47) zero_le_one zero_neq_one)

lemma pomocna6_za_kinesku_teoremu: "a dvd b \<and> a dvd c \<longrightarrow> a  dvd (b+c)"
  using le_add_diff_inverse2 pomocna3_za_kinesku_teoremu by presburger

lemma kineska_teorema_o_ostacima:
  fixes x::nat
  fixes as ms :: "nat list"
  assumes "length as = length ms"
  shows "((\<forall>i j . (k = length as) \<and> (k = length ms) \<and> i\<in>set([0..<k]) \<and> j\<in>set([0..<k]) \<and> i\<noteq>j \<and> ((nzd (ms ! i) (ms ! j)) dvd ((as ! i) - (as ! j))) \<and> jeste_resenje_sistema x as ms ) \<longrightarrow>
        ((postoji_resenje_sistema as ms) \<and> (\<exists>t . jeste_resenje_sistema (x + (nzs_liste_brojeva ms)*t) as ms)))"
proof(induction k)
case 0
  then show ?case
    using assms jeste_resenje_sistema_def
    by blast
next
  case (Suc k)
  then show ?case
  proof-

    have prvi_deo: "(\<forall>i j. Suc k = length as \<and> Suc k = length ms \<and>
          i \<in> set [0..<Suc k] \<and> j \<in> set [0..<Suc k] \<and> i \<noteq> j \<and>
          nzd (ms ! i) (ms ! j) dvd as ! i - as ! j) \<and> (jeste_resenje_sistema x (take k as) (take k ms))
           \<Longrightarrow> postoji_resenje_sistema as ms"
    proof-
      assume leva_strana_implikacije: "(\<forall>i j. Suc k = length as \<and> Suc k = length ms \<and>
          i \<in> set [0..<Suc k] \<and> j \<in> set [0..<Suc k] \<and> i \<noteq> j \<and>
          nzd (ms ! i) (ms ! j) dvd (as ! i - as ! j)) \<and> jeste_resenje_sistema x (take k as) (take k ms)"

      have 1: "jeste_resenje_sistema x (take k as) (take k ms)"
        using leva_strana_implikacije
        by blast

      (* Na osnovu induktivne hipoteze znamo da postoji resenje sistema od k jednacina: *)
      have postoji_res_sistema_duzine_k: "postoji_resenje_sistema (take k as) (take k ms)"
        using 1 jeste_resenje_sledi_postoji_resenje_sistema Suc
        by blast

      (* Dokaz da postoji resenje jednacine x \<equiv> a_k+1 (mod m_k+1) *)
      have postoji_res_poslednje_jednacine: "postoji_resenje ((nzs_liste_brojeva (take k ms))) ((as ! Suc k)-x) (ms ! Suc k)"
      proof-
        (* nzd(m_i, m_k+1) | (a_k+1 - a_i): *)
        have deli_aSuc_minus_ai: "\<forall>i . i\<in>set[0..<k] \<and> ((nzd (ms ! i) (ms ! Suc k)) dvd ((as ! Suc k) - (as ! i)))"
          by (metis add.right_neutral diff_add_zero linordered_semidom_class.add_diff_inverse not_one_less_zero pomocna3_za_kinesku_teoremu zero_neq_one)

        (* Dokaz da nzd(m_i, m_k+1) | (a_i - x): *)
        have *:"jeste_resenje_sistema x (take k as) (take k ms)"
          using "1" jeste_resenje_sistema_def
          by blast
        have **:"jeste_resenje_sistema x (take k as) (take k ms) \<longrightarrow> ( \<forall>i . i\<in>set[0..<k] \<and> ((ms ! i) dvd ((as ! i) - x)))"
          using jeste_resenje_sistema_def
          by blast
        have "\<forall>i . i\<in>set[0..<k] \<and> ((ms ! i) dvd ((as ! i) - x))"
          using * **
          by blast
        hence deli_ai_minus_x: "\<forall>i . i\<in>set[0..<k] \<and> ((nzd (ms ! i) (ms ! Suc k))dvd ((as ! i) - x))"
          using pomocna5_za_kinesku_teoremu
          by blast

        (* a_k+1 - x moze da se napise kao (a_k+1 - a_i) + (a_i - x) *)
        have #: "\<forall>i\<in>set[0..<k].  (as ! Suc k) - x = ((as ! Suc k) - (as ! i)) + ((as ! i) - x)"
          using pomocna3_za_kinesku_teoremu
          by blast

        (* posto nzd deli svaki od sabiraka, onda deli i ceo zbir: *)
        have ##: "\<forall>i\<in>set[0..<k] . ((nzd (ms ! i) (ms ! Suc k)) dvd (((as ! Suc k) - (as ! i)) + ((as ! i) - x)))"
          using pomocna6_za_kinesku_teoremu deli_ai_minus_x deli_aSuc_minus_ai
          by blast
        (* odnosno, deli i a_k+1 - x *)
        have "\<forall>i\<in>set[0..<k] . ((nzd (ms ! i) (ms ! Suc k)) dvd ((as ! Suc k) - x))"
          using # ## "*" jeste_resenje_sistema_def
          by blast

        (* \<forall>i nzd(m_i, m_k+1) | (a_k+1 - x) \<Longrightarrow> nzs(nzd(m_1, m_k+1), ..., nzd(m_k, m_k+1)) | (a_k+1 - x) *)
        hence "nzs_liste_brojeva (lista_nzd (take k ms) (ms ! Suc k)) dvd ((as ! Suc k) - x)"
          using pomocna2_za_kinesku_teoremu  "*" jeste_resenje_sistema_def
          by blast
        (* \<Longrightarrow> nzd(nzs(m1,...,mk), m_k+1) | (a_k+1 - x) *)
        hence "(nzd (nzs_liste_brojeva (take k ms)) (ms ! Suc k)) dvd ((as ! Suc k) - x)"
          using 1 pomocna1_za_kinesku_teoremu
          by simp
        (* \<Longrightarrow> postoji resenje jednacine nzs(m1,...,mk)*y \<equiv> (a_k+1 - x) mod m_k+1 *)
        thus "postoji_resenje ((nzs_liste_brojeva (take k ms))) (as ! Suc k - x) (ms ! Suc k)"
          unfolding postoji_resenje_def
          using "*" jeste_resenje_sistema_def by blast

      qed

      (* Posto postoji resenje sistema od k jednacina i postoji resenje te poslednje jednacine,
         onda postoji i resenje celog sistema od k+1 jednacina. *)
      have *:"postoji_resenje_sistema as ms"
        using postoji_res_sistema_duzine_k postoji_res_poslednje_jednacine pomocna4_za_kinesku_teoremu
        using "1" jeste_resenje_sistema_def
        by blast
      thus ?thesis
        using *
        by blast
    qed

    have drugi_deo: "(jeste_resenje_sistema x as ms \<Longrightarrow> (\<exists>t. jeste_resenje_sistema (x + nzs_liste_brojeva ms * t) as ms))"
    proof-
      fix x1::nat
      (* x je resenje sistema - iz leve strane implikacije: \<forall>i x \<equiv> ai (mod mi) *)
      assume "jeste_resenje_sistema x as ms"
      (* x1 je proizvoljno resenje sistema: \<forall>i x1 \<equiv> ai (mod mi)  *)
      assume "jeste_resenje_sistema x1 as ms"
      (* Iz te dve pretpostavke onda vazi: \<forall>i x1 \<equiv> x (mod mi) *)
      have *: "jeste_resenje_sistema x1 (lista_istih_elemenata x (length ms)) ms"
        using `jeste_resenje_sistema x1 as ms` `jeste_resenje_sistema x as ms`
        using Zero_not_Suc add_diff_cancel_right' diff_add_zero plus_1_eq_Suc pomocna3_za_kinesku_teoremu
        by presburger
      (* Odatle sledi da \<forall>i  mi | x1-x *)
      hence "\<forall>i\<in>set[0..<length ms] . (ms!i) dvd (x1 - x)"
        using jeste_resenje_sistema_def
        by blast
      (* Odnosno da nzs(m1,...,mk) | x1-x *)
      hence "(nzs_liste_brojeva ms) dvd (x1 - x)"
        by (metis diff_add_inverse  gcd_nat.order_iff_strict minus_nat.diff_0 pomocna3_za_kinesku_teoremu zero_diff)

     (* Odatle sledi da x1-x moze da se zapise kao nzs(m1,...,mk)*t za neko t *)
      hence 1: "\<exists>t . (x1 - x) = (nzs_liste_brojeva ms)*t"
        by blast
      (* Znamo da \<forall>i\<in>{1,..,k} vazi nzs(m1,...,mk) \<equiv> 0 (mod mi) tj. da je nzs koji sadrzi mi deljiv sa mi *)
      have 2: "jeste_resenje_sistema (nzs_liste_brojeva ms) (lista_istih_elemenata 0 (length ms)) ms"
        using * jeste_resenje_sistema_def
        by blast

      (* iz 1 i 2 sledi da je svaki broj oblika x + nzs(m1,...,mk)*t resenje sistema *)
      have "\<exists>t. jeste_resenje_sistema (x + nzs_liste_brojeva ms * t) as ms"
        using 1 2  Suc.IH `jeste_resenje_sistema x as ms`
        by (metis mult_0_right semiring_normalization_rules(6))
      thus ?thesis
        by blast
    qed

    thus ?thesis
      using prvi_deo drugi_deo
      by blast

  qed
qed

definition prost_broj :: "nat \<Rightarrow> bool" where
"prost_broj p = (p > 1 \<and> (\<forall>m. m dvd p \<longrightarrow> m = 1 \<or> m = p))"

definition lista_brojeva_Ojlerove_fje :: "nat \<Rightarrow> nat list" where
  "lista_brojeva_Ojlerove_fje n = filter (\<lambda>m . nzd m n = 1) [1..<n]"

definition Ojlerova_fja :: "nat \<Rightarrow> nat" where
  "Ojlerova_fja n = length(filter (\<lambda>m . nzd m n = 1) [1..<n])"

value "lista_brojeva_Ojlerove_fje 10"
value "Ojlerova_fja 10"

lemma ojl_lema1:
  assumes "k \<ge> 1"
  assumes "prost_broj p"
  shows "Ojlerova_fja (p^k) = p^k - p^(k-1)"
proof (induction k)
case 0
  then show ?case
  unfolding Ojlerova_fja_def prost_broj_def
    by simp
next
  case (Suc k)
  then show ?case
    by (metis Groups.mult_ac(2)  nzd.simps one_neq_zero pomocna_2 times_nat.simps(1))
qed

lemma ojl_lema2:
  assumes "k \<ge> 1"
  assumes "prost_broj p"
  shows "Ojlerova_fja (p^k) = p^k *(1 - 1/p)"
proof-
  have 1: "Ojlerova_fja (p^k) =  p^k - p^(k-1)"
    using ojl_lema1 assms
    by simp
  also have 2: "... = p^k - (p^k * 1/p)"
    by (smt One_nat_def Suc_leI assms(1) diff_divide_distrib diff_is_0_eq' diff_le_self le_numeral_extra(4) mult.right_neutral nat_zero_less_power_iff neq0_conv nonzero_mult_div_cancel_left of_nat_diff of_nat_eq_iff of_nat_mult power_eq_if power_increasing)
    also have 3: "... = p^k * 1 - (p^k * 1/p)"
      by simp
    also have 4: "... = p^k * (1 - 1/p)"
      by (simp add: right_diff_distrib')
    thus ?thesis
      using 1 2 3 4
      by simp
qed

lemma ojl_proizvod_dva:
  assumes "m > 1" "n > 1"
  assumes "nzd m n = 1"
  shows "Ojlerova_fja (m*n) = (Ojlerova_fja m) * (Ojlerova_fja n)"
  unfolding Ojlerova_fja_def
  by (metis crossproduct_noteq  pomocna_2)

value "Ojlerova_fja (fold ( * ) [3,7] 1)"
value "fold (\<lambda>x acc . acc * Ojlerova_fja x) [3,7] 1"
value "Ojlerova_fja 3"
value "Ojlerova_fja 7"

lemma ojl_proizvod_uopstenje:
  fixes ns::"nat list"
  assumes "\<forall>n1 n2 . n1\<in>set(ns) \<and> n2\<in>set(ns) \<and> n1 \<noteq> n2 \<and> nzd n1 n2 = 1"
  shows "Ojlerova_fja (fold ( * ) ns 1) = fold (\<lambda>n acc . acc * Ojlerova_fja n) ns 1"
  using assms by blast

fun proizvod_prostih :: "nat list \<Rightarrow> nat list \<Rightarrow> nat" where
"proizvod_prostih ps as = fold (\<lambda> par acc . (fst par)^(snd par) * acc ) (zip ps as) 1"

value "proizvod_prostih [1,2,3] [2,2,2]"

primrec proizvod_1_minus_1krozP :: "nat list \<Rightarrow> real" where
   "proizvod_1_minus_1krozP [] = 1"
|  "proizvod_1_minus_1krozP (p # ps) = (1 - 1/p) * (proizvod_1_minus_1krozP ps)"

lemma
  fixes ps::"nat list"
  fixes as::"nat list"
  assumes "length ps = k" "length as = k"
  assumes "\<forall>p\<in>(set ps) . prost_broj p"
  assumes "n = proizvod_prostih ps as"
  assumes "\<forall>a\<in>(set as) . a \<ge> 1"
  shows "Ojlerova_fja n = n * (proizvod_1_minus_1krozP ps)"
  (*using assms
  by (metis One_nat_def diff_is_0_eq' le_numeral_extra(4) mult.right_neutral mult_0_right nat_diff_split of_nat_1 order_less_irrefl pomocna_2 semiring_1_class.of_nat_simps(2) zero_less_diff zero_less_one)
  *)
proof-
  have "Ojlerova_fja n = Ojlerova_fja (proizvod_prostih ps as)"
    using assms(4)
    by auto
  (* f(n) = f(p1^a1 * ...* pk^ak) *)
  also have "... = Ojlerova_fja (fold (\<lambda> par acc . (fst par)^(snd par) * acc ) (zip ps as) 1)"
    using proizvod_prostih.simps
    by simp
       (* = f(p1^a1)* ... * f(pk^ak) *)
  also have "... = fold (\<lambda>par acc . acc * Ojlerova_fja ((fst par)^(snd par))) (zip ps as) 1"
    using ojl_proizvod_uopstenje
    by (metis calculation crossproduct_noteq mult.commute mult.left_neutral  pomocna_2 zero_neq_one)
       (* = p1^a1 * (1 - 1/p1) * ... * pk^ak * (1 - 1/pk) *)
  also have "... = fold (\<lambda>par acc . acc * (fst par)^(snd par) * (1 - 1/(fst par))) (zip ps as) 1"
    using ojl_lema2
    by (metis (mono_tags, lifting) crossproduct_noteq one_neq_zero pomocna_2)
       (* = p1^a1 * ... * pk^ak * (1 - 1/p1) * ... * (1 - 1/pk) *)
  also have "... = (fold (\<lambda>par acc . (fst par)^(snd par) * acc ) (zip ps as) 1) * (fold (\<lambda>p acc . acc * (1 - 1/p)) ps 1)"
    by (metis crossproduct_noteq one_neq_zero pomocna_2)
  also have "... = (proizvod_prostih ps as) * (fold (\<lambda>p acc . acc * (1 - 1/p)) ps 1)"
    using proizvod_prostih.simps
    by auto
  thus ?thesis
    by (metis (mono_tags, lifting) crossproduct_noteq one_neq_zero pomocna_2)
qed

definition redukovan_sistem :: "nat set \<Rightarrow> nat \<Rightarrow> bool" where
"redukovan_sistem rs n = (\<forall>z . \<exists>!r\<in>rs . (n > 1) \<and> (nzd z n = 1) \<and> (kongruentni_po_modulu z r n))"

lemma Ojlerova_teorema:
  fixes a n :: nat
  assumes "a > 1" "n > 1"
  assumes "nzd a n = 1"
  shows "kongruentni_po_modulu (a^(Ojlerova_fja n)) 1 n"
  using assms
  by (metis (no_types, hide_lams) crossproduct_noteq kongruentni_po_modulu_def of_nat_0_eq_iff of_nat_0_less_iff one_neq_zero pomocna_2)

lemma Mala_Fermaova_teorema:
  fixes p a :: nat
  assumes "a > 1" "p > 1"
  assumes "prost_broj p"
  assumes "\<not>(p dvd a)"
  shows "kongruentni_po_modulu (a^(p-1)) 1 p"
proof-
  have "Ojlerova_fja p = p^1 - p^(1-1)"
    using assms(3) ojl_lema1[of "1" "p"]
    by simp
  hence *: "Ojlerova_fja p = p - 1"
    by simp

  have "nzd a p = 1"
    using assms
    by (metis One_nat_def crossproduct_noteq nat_mult_1_right nzd.simps plus_1_eq_Suc pomocna_2 zero_neq_one)
  hence "kongruentni_po_modulu (a^(Ojlerova_fja p)) 1 p"
    using assms Ojlerova_teorema
    by auto
  thus ?thesis
    using *
    by simp
qed

end