/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.seq.seq
import Mathlib.Lean3Lib.data.dlist
import Mathlib.PostPort

universes u_1 u v w

namespace Mathlib

/-
coinductive wseq (α : Type u) : Type u
| nil : wseq α
| cons : α → wseq α → wseq α
| think : wseq α → wseq α
-/

/-- Weak sequences.

  While the `seq` structure allows for lists which may not be finite,
  a weak sequence also allows the computation of each element to
  involve an indeterminate amount of computation, including possibly
  an infinite loop. This is represented as a regular `seq` interspersed
  with `none` elements to indicate that computation is ongoing.

  This model is appropriate for Haskell style lazy lists, and is closed
  under most interesting computation patterns on infinite lists,
  but conversely it is difficult to extract elements from it. -/
def wseq (α : Type u_1) :=
  seq (Option α)

namespace wseq

/-- Turn a sequence into a weak sequence -/
def of_seq {α : Type u} : seq α → wseq α :=
  Functor.map some

/-- Turn a list into a weak sequence -/
def of_list {α : Type u} (l : List α) : wseq α :=
  of_seq ↑l

/-- Turn a stream into a weak sequence -/
def of_stream {α : Type u} (l : stream α) : wseq α :=
  of_seq ↑l

protected instance coe_seq {α : Type u} : has_coe (seq α) (wseq α) :=
  has_coe.mk of_seq

protected instance coe_list {α : Type u} : has_coe (List α) (wseq α) :=
  has_coe.mk of_list

protected instance coe_stream {α : Type u} : has_coe (stream α) (wseq α) :=
  has_coe.mk of_stream

/-- The empty weak sequence -/
def nil {α : Type u} : wseq α :=
  seq.nil

protected instance inhabited {α : Type u} : Inhabited (wseq α) :=
  { default := nil }

/-- Prepend an element to a weak sequence -/
def cons {α : Type u} (a : α) : wseq α → wseq α :=
  seq.cons (some a)

/-- Compute for one tick, without producing any elements -/
def think {α : Type u} : wseq α → wseq α :=
  seq.cons none

/-- Destruct a weak sequence, to (eventually possibly) produce either
  `none` for `nil` or `some (a, s)` if an element is produced. -/
def destruct {α : Type u} : wseq α → computation (Option (α × wseq α)) :=
  computation.corec fun (s : wseq α) => sorry

def cases_on {α : Type u} {C : wseq α → Sort v} (s : wseq α) (h1 : C nil) (h2 : (x : α) → (s : wseq α) → C (cons x s)) (h3 : (s : wseq α) → C (think s)) : C s :=
  seq.cases_on s h1 fun (o : Option α) => option.cases_on o h3 h2

protected def mem {α : Type u} (a : α) (s : wseq α) :=
  seq.mem (some a) s

protected instance has_mem {α : Type u} : has_mem α (wseq α) :=
  has_mem.mk wseq.mem

theorem not_mem_nil {α : Type u} (a : α) : ¬a ∈ nil :=
  seq.not_mem_nil ↑a

/-- Get the head of a weak sequence. This involves a possibly
  infinite computation. -/
def head {α : Type u} (s : wseq α) : computation (Option α) :=
  computation.map (Functor.map prod.fst) (destruct s)

/-- Encode a computation yielding a weak sequence into additional
  `think` constructors in a weak sequence -/
def flatten {α : Type u} : computation (wseq α) → wseq α :=
  seq.corec fun (c : computation (wseq α)) => sorry

/-- Get the tail of a weak sequence. This doesn't need a `computation`
  wrapper, unlike `head`, because `flatten` allows us to hide this
  in the construction of the weak sequence itself. -/
def tail {α : Type u} (s : wseq α) : wseq α :=
  flatten ((fun (o : Option (α × wseq α)) => option.rec_on o nil prod.snd) <$> destruct s)

/-- drop the first `n` elements from `s`. -/
@[simp] def drop {α : Type u} (s : wseq α) : ℕ → wseq α :=
  sorry

/-- Get the nth element of `s`. -/
def nth {α : Type u} (s : wseq α) (n : ℕ) : computation (Option α) :=
  head (drop s n)

/-- Convert `s` to a list (if it is finite and completes in finite time). -/
def to_list {α : Type u} (s : wseq α) : computation (List α) :=
  computation.corec (fun (_x : List α × wseq α) => sorry) ([], s)

/-- Get the length of `s` (if it is finite and completes in finite time). -/
def length {α : Type u} (s : wseq α) : computation ℕ :=
  computation.corec (fun (_x : ℕ × wseq α) => sorry) (0, s)

/-- A weak sequence is finite if `to_list s` terminates. Equivalently,
  it is a finite number of `think` and `cons` applied to `nil`. -/
def is_finite {α : Type u} (s : wseq α) :=
  computation.terminates (to_list s)

protected instance to_list_terminates {α : Type u} (s : wseq α) [h : is_finite s] : computation.terminates (to_list s) :=
  h

/-- Get the list corresponding to a finite weak sequence. -/
def get {α : Type u} (s : wseq α) [is_finite s] : List α :=
  computation.get (to_list s)

/-- A weak sequence is *productive* if it never stalls forever - there are
 always a finite number of `think`s between `cons` constructors.
 The sequence itself is allowed to be infinite though. -/
def productive {α : Type u} (s : wseq α) :=
  ∀ (n : ℕ), computation.terminates (nth s n)

protected instance nth_terminates {α : Type u} (s : wseq α) [h : productive s] (n : ℕ) : computation.terminates (nth s n) :=
  h

protected instance head_terminates {α : Type u} (s : wseq α) [h : productive s] : computation.terminates (head s) :=
  h 0

/-- Replace the `n`th element of `s` with `a`. -/
def update_nth {α : Type u} (s : wseq α) (n : ℕ) (a : α) : wseq α :=
  seq.corec (fun (_x : ℕ × wseq α) => sorry) (n + 1, s)

/-- Remove the `n`th element of `s`. -/
def remove_nth {α : Type u} (s : wseq α) (n : ℕ) : wseq α :=
  seq.corec (fun (_x : ℕ × wseq α) => sorry) (n + 1, s)

/-- Map the elements of `s` over `f`, removing any values that yield `none`. -/
def filter_map {α : Type u} {β : Type v} (f : α → Option β) : wseq α → wseq β :=
  seq.corec fun (s : wseq α) => sorry

/-- Select the elements of `s` that satisfy `p`. -/
def filter {α : Type u} (p : α → Prop) [decidable_pred p] : wseq α → wseq α :=
  filter_map fun (a : α) => ite (p a) (some a) none

-- example of infinite list manipulations

/-- Get the first element of `s` satisfying `p`. -/
def find {α : Type u} (p : α → Prop) [decidable_pred p] (s : wseq α) : computation (Option α) :=
  head (filter p s)

/-- Zip a function over two weak sequences -/
def zip_with {α : Type u} {β : Type v} {γ : Type w} (f : α → β → γ) (s1 : wseq α) (s2 : wseq β) : wseq γ :=
  seq.corec (fun (_x : wseq α × wseq β) => sorry) (s1, s2)

/-- Zip two weak sequences into a single sequence of pairs -/
def zip {α : Type u} {β : Type v} : wseq α → wseq β → wseq (α × β) :=
  zip_with Prod.mk

/-- Get the list of indexes of elements of `s` satisfying `p` -/
def find_indexes {α : Type u} (p : α → Prop) [decidable_pred p] (s : wseq α) : wseq ℕ :=
  filter_map (fun (_x : α × ℕ) => sorry) (zip s ↑stream.nats)

/-- Get the index of the first element of `s` satisfying `p` -/
def find_index {α : Type u} (p : α → Prop) [decidable_pred p] (s : wseq α) : computation ℕ :=
  (fun (o : Option ℕ) => option.get_or_else o 0) <$> head (find_indexes p s)

/-- Get the index of the first occurrence of `a` in `s` -/
def index_of {α : Type u} [DecidableEq α] (a : α) : wseq α → computation ℕ :=
  find_index (Eq a)

/-- Get the indexes of occurrences of `a` in `s` -/
def indexes_of {α : Type u} [DecidableEq α] (a : α) : wseq α → wseq ℕ :=
  find_indexes (Eq a)

/-- `union s1 s2` is a weak sequence which interleaves `s1` and `s2` in
  some order (nondeterministically). -/
def union {α : Type u} (s1 : wseq α) (s2 : wseq α) : wseq α :=
  seq.corec (fun (_x : wseq α × wseq α) => sorry) (s1, s2)

/-- Returns `tt` if `s` is `nil` and `ff` if `s` has an element -/
def is_empty {α : Type u} (s : wseq α) : computation Bool :=
  computation.map option.is_none (head s)

/-- Calculate one step of computation -/
def compute {α : Type u} (s : wseq α) : wseq α :=
  sorry

/-- Get the first `n` elements of a weak sequence -/
def take {α : Type u} (s : wseq α) (n : ℕ) : wseq α :=
  seq.corec (fun (_x : ℕ × wseq α) => sorry) (n, s)

/-- Split the sequence at position `n` into a finite initial segment
  and the weak sequence tail -/
def split_at {α : Type u} (s : wseq α) (n : ℕ) : computation (List α × wseq α) :=
  computation.corec (fun (_x : ℕ × List α × wseq α) => sorry) (n, [], s)

/-- Returns `tt` if any element of `s` satisfies `p` -/
def any {α : Type u} (s : wseq α) (p : α → Bool) : computation Bool :=
  computation.corec (fun (s : wseq α) => sorry) s

/-- Returns `tt` if every element of `s` satisfies `p` -/
def all {α : Type u} (s : wseq α) (p : α → Bool) : computation Bool :=
  computation.corec (fun (s : wseq α) => sorry) s

/-- Apply a function to the elements of the sequence to produce a sequence
  of partial results. (There is no `scanr` because this would require
  working from the end of the sequence, which may not exist.) -/
def scanl {α : Type u} {β : Type v} (f : α → β → α) (a : α) (s : wseq β) : wseq α :=
  cons a (seq.corec (fun (_x : α × wseq β) => sorry) (a, s))

/-- Get the weak sequence of initial segments of the input sequence -/
def inits {α : Type u} (s : wseq α) : wseq (List α) :=
  cons [] (seq.corec (fun (_x : dlist α × wseq α) => sorry) (dlist.empty, s))

/-- Like take, but does not wait for a result. Calculates `n` steps of
  computation and returns the sequence computed so far -/
def collect {α : Type u} (s : wseq α) (n : ℕ) : List α :=
  list.filter_map id (seq.take n s)

/-- Append two weak sequences. As with `seq.append`, this may not use
  the second sequence if the first one takes forever to compute -/
def append {α : Type u} : wseq α → wseq α → wseq α :=
  seq.append

/-- Map a function over a weak sequence -/
def map {α : Type u} {β : Type v} (f : α → β) : wseq α → wseq β :=
  seq.map (option.map f)

/-- Flatten a sequence of weak sequences. (Note that this allows
  empty sequences, unlike `seq.join`.) -/
def join {α : Type u} (S : wseq (wseq α)) : wseq α :=
  seq.join ((fun (o : Option (wseq α)) => sorry) <$> S)

/-- Monadic bind operator for weak sequences -/
def bind {α : Type u} {β : Type v} (s : wseq α) (f : α → wseq β) : wseq β :=
  join (map f s)

@[simp] def lift_rel_o {α : Type u} {β : Type v} (R : α → β → Prop) (C : wseq α → wseq β → Prop) : Option (α × wseq α) → Option (β × wseq β) → Prop :=
  sorry

theorem lift_rel_o.imp {α : Type u} {β : Type v} {R : α → β → Prop} {S : α → β → Prop} {C : wseq α → wseq β → Prop} {D : wseq α → wseq β → Prop} (H1 : ∀ (a : α) (b : β), R a b → S a b) (H2 : ∀ (s : wseq α) (t : wseq β), C s t → D s t) {o : Option (α × wseq α)} {p : Option (β × wseq β)} : lift_rel_o R C o p → lift_rel_o S D o p := sorry

theorem lift_rel_o.imp_right {α : Type u} {β : Type v} (R : α → β → Prop) {C : wseq α → wseq β → Prop} {D : wseq α → wseq β → Prop} (H : ∀ (s : wseq α) (t : wseq β), C s t → D s t) {o : Option (α × wseq α)} {p : Option (β × wseq β)} : lift_rel_o R C o p → lift_rel_o R D o p :=
  lift_rel_o.imp (fun (_x : α) (_x_1 : β) => id) H

@[simp] def bisim_o {α : Type u} (R : wseq α → wseq α → Prop) : Option (α × wseq α) → Option (α × wseq α) → Prop :=
  lift_rel_o Eq R

theorem bisim_o.imp {α : Type u} {R : wseq α → wseq α → Prop} {S : wseq α → wseq α → Prop} (H : ∀ (s t : wseq α), R s t → S s t) {o : Option (α × wseq α)} {p : Option (α × wseq α)} : bisim_o R o p → bisim_o S o p :=
  lift_rel_o.imp_right Eq H

/-- Two weak sequences are `lift_rel R` related if they are either both empty,
  or they are both nonempty and the heads are `R` related and the tails are
  `lift_rel R` related. (This is a coinductive definition.) -/
def lift_rel {α : Type u} {β : Type v} (R : α → β → Prop) (s : wseq α) (t : wseq β) :=
  ∃ (C : wseq α → wseq β → Prop),
    C s t ∧ ∀ {s : wseq α} {t : wseq β}, C s t → computation.lift_rel (lift_rel_o R C) (destruct s) (destruct t)

/-- If two sequences are equivalent, then they have the same values and
  the same computational behavior (i.e. if one loops forever then so does
  the other), although they may differ in the number of `think`s needed to
  arrive at the answer. -/
def equiv {α : Type u} : wseq α → wseq α → Prop :=
  lift_rel Eq

theorem lift_rel_destruct {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α} {t : wseq β} : lift_rel R s t → computation.lift_rel (lift_rel_o R (lift_rel R)) (destruct s) (destruct t) := sorry

theorem lift_rel_destruct_iff {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α} {t : wseq β} : lift_rel R s t ↔ computation.lift_rel (lift_rel_o R (lift_rel R)) (destruct s) (destruct t) := sorry

infixl:50 " ~ " => Mathlib.wseq.equiv

theorem destruct_congr {α : Type u} {s : wseq α} {t : wseq α} : s ~ t → computation.lift_rel (bisim_o equiv) (destruct s) (destruct t) :=
  lift_rel_destruct

theorem destruct_congr_iff {α : Type u} {s : wseq α} {t : wseq α} : s ~ t ↔ computation.lift_rel (bisim_o equiv) (destruct s) (destruct t) :=
  lift_rel_destruct_iff

theorem lift_rel.refl {α : Type u} (R : α → α → Prop) (H : reflexive R) : reflexive (lift_rel R) := sorry

theorem lift_rel_o.swap {α : Type u} {β : Type v} (R : α → β → Prop) (C : wseq α → wseq β → Prop) : function.swap (lift_rel_o R C) = lift_rel_o (function.swap R) (function.swap C) := sorry

theorem lift_rel.swap_lem {α : Type u} {β : Type v} {R : α → β → Prop} {s1 : wseq α} {s2 : wseq β} (h : lift_rel R s1 s2) : lift_rel (function.swap R) s2 s1 := sorry

theorem lift_rel.swap {α : Type u} {β : Type v} (R : α → β → Prop) : function.swap (lift_rel R) = lift_rel (function.swap R) :=
  funext fun (x : wseq β) => funext fun (y : wseq α) => propext { mp := lift_rel.swap_lem, mpr := lift_rel.swap_lem }

theorem lift_rel.symm {α : Type u} (R : α → α → Prop) (H : symmetric R) : symmetric (lift_rel R) := sorry

theorem lift_rel.trans {α : Type u} (R : α → α → Prop) (H : transitive R) : transitive (lift_rel R) := sorry

theorem lift_rel.equiv {α : Type u} (R : α → α → Prop) : equivalence R → equivalence (lift_rel R) := sorry

theorem equiv.refl {α : Type u} (s : wseq α) : s ~ s :=
  lift_rel.refl Eq Eq.refl

theorem equiv.symm {α : Type u} {s : wseq α} {t : wseq α} : s ~ t → t ~ s :=
  lift_rel.symm Eq Eq.symm

theorem equiv.trans {α : Type u} {s : wseq α} {t : wseq α} {u : wseq α} : s ~ t → t ~ u → s ~ u :=
  lift_rel.trans Eq Eq.trans

theorem equiv.equivalence {α : Type u} : equivalence equiv :=
  { left := equiv.refl, right := { left := equiv.symm, right := equiv.trans } }

@[simp] theorem destruct_nil {α : Type u} : destruct nil = computation.return none :=
  computation.destruct_eq_ret rfl

@[simp] theorem destruct_cons {α : Type u} (a : α) (s : wseq α) : destruct (cons a s) = computation.return (some (a, s)) := sorry

@[simp] theorem destruct_think {α : Type u} (s : wseq α) : destruct (think s) = computation.think (destruct s) := sorry

@[simp] theorem seq_destruct_nil {α : Type u} : seq.destruct nil = none :=
  seq.destruct_nil

@[simp] theorem seq_destruct_cons {α : Type u} (a : α) (s : wseq α) : seq.destruct (cons a s) = some (some a, s) :=
  seq.destruct_cons (some a) s

@[simp] theorem seq_destruct_think {α : Type u} (s : wseq α) : seq.destruct (think s) = some (none, s) :=
  seq.destruct_cons none s

@[simp] theorem head_nil {α : Type u} : head nil = computation.return none := sorry

@[simp] theorem head_cons {α : Type u} (a : α) (s : wseq α) : head (cons a s) = computation.return (some a) := sorry

@[simp] theorem head_think {α : Type u} (s : wseq α) : head (think s) = computation.think (head s) := sorry

@[simp] theorem flatten_ret {α : Type u} (s : wseq α) : flatten (computation.return s) = s := sorry

@[simp] theorem flatten_think {α : Type u} (c : computation (wseq α)) : flatten (computation.think c) = think (flatten c) := sorry

@[simp] theorem destruct_flatten {α : Type u} (c : computation (wseq α)) : destruct (flatten c) = c >>= destruct := sorry

theorem head_terminates_iff {α : Type u} (s : wseq α) : computation.terminates (head s) ↔ computation.terminates (destruct s) :=
  computation.terminates_map_iff (Functor.map prod.fst) (destruct s)

@[simp] theorem tail_nil {α : Type u} : tail nil = nil := sorry

@[simp] theorem tail_cons {α : Type u} (a : α) (s : wseq α) : tail (cons a s) = s := sorry

@[simp] theorem tail_think {α : Type u} (s : wseq α) : tail (think s) = think (tail s) := sorry

@[simp] theorem dropn_nil {α : Type u} (n : ℕ) : drop nil n = nil := sorry

@[simp] theorem dropn_cons {α : Type u} (a : α) (s : wseq α) (n : ℕ) : drop (cons a s) (n + 1) = drop s n := sorry

@[simp] theorem dropn_think {α : Type u} (s : wseq α) (n : ℕ) : drop (think s) n = think (drop s n) := sorry

theorem dropn_add {α : Type u} (s : wseq α) (m : ℕ) (n : ℕ) : drop s (m + n) = drop (drop s m) n := sorry

theorem dropn_tail {α : Type u} (s : wseq α) (n : ℕ) : drop (tail s) n = drop s (n + 1) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (drop (tail s) n = drop s (n + 1))) (add_comm n 1))) (Eq.symm (dropn_add s 1 n))

theorem nth_add {α : Type u} (s : wseq α) (m : ℕ) (n : ℕ) : nth s (m + n) = nth (drop s m) n :=
  congr_arg head (dropn_add s m n)

theorem nth_tail {α : Type u} (s : wseq α) (n : ℕ) : nth (tail s) n = nth s (n + 1) :=
  congr_arg head (dropn_tail s n)

@[simp] theorem join_nil {α : Type u} : join nil = nil :=
  seq.join_nil

@[simp] theorem join_think {α : Type u} (S : wseq (wseq α)) : join (think S) = think (join S) := sorry

@[simp] theorem join_cons {α : Type u} (s : wseq α) (S : wseq (wseq α)) : join (cons s S) = think (append s (join S)) := sorry

@[simp] theorem nil_append {α : Type u} (s : wseq α) : append nil s = s :=
  seq.nil_append s

@[simp] theorem cons_append {α : Type u} (a : α) (s : wseq α) (t : wseq α) : append (cons a s) t = cons a (append s t) :=
  seq.cons_append (some a) s t

@[simp] theorem think_append {α : Type u} (s : wseq α) (t : wseq α) : append (think s) t = think (append s t) :=
  seq.cons_append none s t

@[simp] theorem append_nil {α : Type u} (s : wseq α) : append s nil = s :=
  seq.append_nil s

@[simp] theorem append_assoc {α : Type u} (s : wseq α) (t : wseq α) (u : wseq α) : append (append s t) u = append s (append t u) :=
  seq.append_assoc s t u

@[simp] def tail.aux {α : Type u} : Option (α × wseq α) → computation (Option (α × wseq α)) :=
  sorry

theorem destruct_tail {α : Type u} (s : wseq α) : destruct (tail s) = destruct s >>= tail.aux := sorry

@[simp] def drop.aux {α : Type u} : ℕ → Option (α × wseq α) → computation (Option (α × wseq α)) :=
  sorry

theorem drop.aux_none {α : Type u} (n : ℕ) : drop.aux n none = computation.return none := sorry

theorem destruct_dropn {α : Type u} (s : wseq α) (n : ℕ) : destruct (drop s n) = destruct s >>= drop.aux n := sorry

theorem head_terminates_of_head_tail_terminates {α : Type u} (s : wseq α) [T : computation.terminates (head (tail s))] : computation.terminates (head s) := sorry

theorem destruct_some_of_destruct_tail_some {α : Type u} {s : wseq α} {a : α × wseq α} (h : some a ∈ destruct (tail s)) : ∃ (a' : α × wseq α), some a' ∈ destruct s := sorry

theorem head_some_of_head_tail_some {α : Type u} {s : wseq α} {a : α} (h : some a ∈ head (tail s)) : ∃ (a' : α), some a' ∈ head s := sorry

theorem head_some_of_nth_some {α : Type u} {s : wseq α} {a : α} {n : ℕ} (h : some a ∈ nth s n) : ∃ (a' : α), some a' ∈ head s := sorry

protected instance productive_tail {α : Type u} (s : wseq α) [productive s] : productive (tail s) :=
  fun (n : ℕ) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (computation.terminates (nth (tail s) n))) (nth_tail s n)))
      (wseq.nth_terminates s (n + 1))

protected instance productive_dropn {α : Type u} (s : wseq α) [productive s] (n : ℕ) : productive (drop s n) :=
  fun (m : ℕ) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (computation.terminates (nth (drop s n) m))) (Eq.symm (nth_add s n m))))
      (wseq.nth_terminates s (n + m))

/-- Given a productive weak sequence, we can collapse all the `think`s to
  produce a sequence. -/
def to_seq {α : Type u} (s : wseq α) [productive s] : seq α :=
  { val := fun (n : ℕ) => computation.get (nth s n), property := sorry }

theorem nth_terminates_le {α : Type u} {s : wseq α} {m : ℕ} {n : ℕ} (h : m ≤ n) : computation.terminates (nth s n) → computation.terminates (nth s m) := sorry

theorem head_terminates_of_nth_terminates {α : Type u} {s : wseq α} {n : ℕ} : computation.terminates (nth s n) → computation.terminates (head s) :=
  nth_terminates_le (nat.zero_le n)

theorem destruct_terminates_of_nth_terminates {α : Type u} {s : wseq α} {n : ℕ} (T : computation.terminates (nth s n)) : computation.terminates (destruct s) :=
  iff.mp (head_terminates_iff s) (head_terminates_of_nth_terminates T)

theorem mem_rec_on {α : Type u} {C : wseq α → Prop} {a : α} {s : wseq α} (M : a ∈ s) (h1 : ∀ (b : α) (s' : wseq α), a = b ∨ C s' → C (cons b s')) (h2 : ∀ (s : wseq α), C s → C (think s)) : C s := sorry

@[simp] theorem mem_think {α : Type u} (s : wseq α) (a : α) : a ∈ think s ↔ a ∈ s := sorry

theorem eq_or_mem_iff_mem {α : Type u} {s : wseq α} {a : α} {a' : α} {s' : wseq α} : some (a', s') ∈ destruct s → (a ∈ s ↔ a = a' ∨ a ∈ s') := sorry

@[simp] theorem mem_cons_iff {α : Type u} (s : wseq α) (b : α) {a : α} : a ∈ cons b s ↔ a = b ∨ a ∈ s := sorry

theorem mem_cons_of_mem {α : Type u} {s : wseq α} (b : α) {a : α} (h : a ∈ s) : a ∈ cons b s :=
  iff.mpr (mem_cons_iff s b) (Or.inr h)

theorem mem_cons {α : Type u} (s : wseq α) (a : α) : a ∈ cons a s :=
  iff.mpr (mem_cons_iff s a) (Or.inl rfl)

theorem mem_of_mem_tail {α : Type u} {s : wseq α} {a : α} : a ∈ tail s → a ∈ s := sorry

theorem mem_of_mem_dropn {α : Type u} {s : wseq α} {a : α} {n : ℕ} : a ∈ drop s n → a ∈ s := sorry

theorem nth_mem {α : Type u} {s : wseq α} {a : α} {n : ℕ} : some a ∈ nth s n → a ∈ s := sorry

theorem exists_nth_of_mem {α : Type u} {s : wseq α} {a : α} (h : a ∈ s) : ∃ (n : ℕ), some a ∈ nth s n := sorry

theorem exists_dropn_of_mem {α : Type u} {s : wseq α} {a : α} (h : a ∈ s) : ∃ (n : ℕ), ∃ (s' : wseq α), some (a, s') ∈ destruct (drop s n) := sorry

theorem lift_rel_dropn_destruct {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α} {t : wseq β} (H : lift_rel R s t) (n : ℕ) : computation.lift_rel (lift_rel_o R (lift_rel R)) (destruct (drop s n)) (destruct (drop t n)) := sorry

theorem exists_of_lift_rel_left {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α} {t : wseq β} (H : lift_rel R s t) {a : α} (h : a ∈ s) : Exists fun {b : β} => b ∈ t ∧ R a b := sorry

theorem exists_of_lift_rel_right {α : Type u} {β : Type v} {R : α → β → Prop} {s : wseq α} {t : wseq β} (H : lift_rel R s t) {b : β} (h : b ∈ t) : Exists fun {a : α} => a ∈ s ∧ R a b :=
  exists_of_lift_rel_left
    (eq.mp (Eq._oldrec (Eq.refl (lift_rel R s t)) (Eq.symm (lift_rel.swap fun (x : β) (y : α) => R y x))) H) h

theorem head_terminates_of_mem {α : Type u} {s : wseq α} {a : α} (h : a ∈ s) : computation.terminates (head s) := sorry

theorem of_mem_append {α : Type u} {s₁ : wseq α} {s₂ : wseq α} {a : α} : a ∈ append s₁ s₂ → a ∈ s₁ ∨ a ∈ s₂ :=
  seq.of_mem_append

theorem mem_append_left {α : Type u} {s₁ : wseq α} {s₂ : wseq α} {a : α} : a ∈ s₁ → a ∈ append s₁ s₂ :=
  seq.mem_append_left

theorem exists_of_mem_map {α : Type u} {β : Type v} {f : α → β} {b : β} {s : wseq α} : b ∈ map f s → ∃ (a : α), a ∈ s ∧ f a = b := sorry

@[simp] theorem lift_rel_nil {α : Type u} {β : Type v} (R : α → β → Prop) : lift_rel R nil nil := sorry

@[simp] theorem lift_rel_cons {α : Type u} {β : Type v} (R : α → β → Prop) (a : α) (b : β) (s : wseq α) (t : wseq β) : lift_rel R (cons a s) (cons b t) ↔ R a b ∧ lift_rel R s t := sorry

@[simp] theorem lift_rel_think_left {α : Type u} {β : Type v} (R : α → β → Prop) (s : wseq α) (t : wseq β) : lift_rel R (think s) t ↔ lift_rel R s t := sorry

@[simp] theorem lift_rel_think_right {α : Type u} {β : Type v} (R : α → β → Prop) (s : wseq α) (t : wseq β) : lift_rel R s (think t) ↔ lift_rel R s t := sorry

theorem cons_congr {α : Type u} {s : wseq α} {t : wseq α} (a : α) (h : s ~ t) : cons a s ~ cons a t := sorry

theorem think_equiv {α : Type u} (s : wseq α) : think s ~ s :=
  eq.mpr (id (congr_fun (congr_fun equiv.equations._eqn_1 (think s)) s))
    (eq.mpr (id (propext (lift_rel_think_left Eq s s))) (equiv.refl s))

theorem think_congr {α : Type u} {s : wseq α} {t : wseq α} (a : α) (h : s ~ t) : think s ~ think t :=
  eq.mpr (id (congr_fun (congr_fun equiv.equations._eqn_1 (think s)) (think t)))
    (eq.mpr (id (Eq.trans (propext (lift_rel_think_right Eq (think s) t)) (propext (lift_rel_think_left Eq s t)))) h)

theorem head_congr {α : Type u} {s : wseq α} {t : wseq α} : s ~ t → head s ~ head t := sorry

theorem flatten_equiv {α : Type u} {c : computation (wseq α)} {s : wseq α} (h : s ∈ c) : flatten c ~ s := sorry

theorem lift_rel_flatten {α : Type u} {β : Type v} {R : α → β → Prop} {c1 : computation (wseq α)} {c2 : computation (wseq β)} (h : computation.lift_rel (lift_rel R) c1 c2) : lift_rel R (flatten c1) (flatten c2) := sorry

theorem flatten_congr {α : Type u} {c1 : computation (wseq α)} {c2 : computation (wseq α)} : computation.lift_rel equiv c1 c2 → flatten c1 ~ flatten c2 :=
  lift_rel_flatten

theorem tail_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) : tail s ~ tail t := sorry

theorem dropn_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) (n : ℕ) : drop s n ~ drop t n := sorry

theorem nth_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) (n : ℕ) : nth s n ~ nth t n :=
  head_congr (dropn_congr h n)

theorem mem_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) (a : α) : a ∈ s ↔ a ∈ t := sorry

theorem productive_congr {α : Type u} {s : wseq α} {t : wseq α} (h : s ~ t) : productive s ↔ productive t :=
  forall_congr fun (n : ℕ) => computation.terminates_congr (nth_congr h n)

theorem equiv.ext {α : Type u} {s : wseq α} {t : wseq α} (h : ∀ (n : ℕ), nth s n ~ nth t n) : s ~ t := sorry

theorem length_eq_map {α : Type u} (s : wseq α) : length s = computation.map list.length (to_list s) := sorry

@[simp] theorem of_list_nil {α : Type u} : of_list [] = nil :=
  rfl

@[simp] theorem of_list_cons {α : Type u} (a : α) (l : List α) : of_list (a :: l) = cons a (of_list l) := sorry

@[simp] theorem to_list'_nil {α : Type u} (l : List α) : computation.corec to_list._match_2 (l, nil) = computation.return (list.reverse l) :=
  computation.destruct_eq_ret rfl

@[simp] theorem to_list'_cons {α : Type u} (l : List α) (s : wseq α) (a : α) : computation.corec to_list._match_2 (l, cons a s) = computation.think (computation.corec to_list._match_2 (a :: l, s)) := sorry

@[simp] theorem to_list'_think {α : Type u} (l : List α) (s : wseq α) : computation.corec to_list._match_2 (l, think s) = computation.think (computation.corec to_list._match_2 (l, s)) := sorry

theorem to_list'_map {α : Type u} (l : List α) (s : wseq α) : computation.corec to_list._match_2 (l, s) = append (list.reverse l) <$> to_list s := sorry

@[simp] theorem to_list_cons {α : Type u} (a : α) (s : wseq α) : to_list (cons a s) = computation.think (List.cons a <$> to_list s) := sorry

@[simp] theorem to_list_nil {α : Type u} : to_list nil = computation.return [] :=
  computation.destruct_eq_ret rfl

theorem to_list_of_list {α : Type u} (l : List α) : l ∈ to_list (of_list l) := sorry

@[simp] theorem destruct_of_seq {α : Type u} (s : seq α) : destruct (of_seq s) = computation.return (option.map (fun (a : α) => (a, of_seq (seq.tail s))) (seq.head s)) := sorry

@[simp] theorem head_of_seq {α : Type u} (s : seq α) : head (of_seq s) = computation.return (seq.head s) := sorry

@[simp] theorem tail_of_seq {α : Type u} (s : seq α) : tail (of_seq s) = of_seq (seq.tail s) := sorry

@[simp] theorem dropn_of_seq {α : Type u} (s : seq α) (n : ℕ) : drop (of_seq s) n = of_seq (seq.drop s n) := sorry

theorem nth_of_seq {α : Type u} (s : seq α) (n : ℕ) : nth (of_seq s) n = computation.return (seq.nth s n) := sorry

protected instance productive_of_seq {α : Type u} (s : seq α) : productive (of_seq s) :=
  fun (n : ℕ) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (computation.terminates (nth (of_seq s) n))) (nth_of_seq s n)))
      (computation.ret_terminates (seq.nth s n))

theorem to_seq_of_seq {α : Type u} (s : seq α) : to_seq (of_seq s) = s := sorry

/-- The monadic `return a` is a singleton list containing `a`. -/
def ret {α : Type u} (a : α) : wseq α :=
  of_list [a]

@[simp] theorem map_nil {α : Type u} {β : Type v} (f : α → β) : map f nil = nil :=
  rfl

@[simp] theorem map_cons {α : Type u} {β : Type v} (f : α → β) (a : α) (s : wseq α) : map f (cons a s) = cons (f a) (map f s) :=
  seq.map_cons (option.map f) (some a) s

@[simp] theorem map_think {α : Type u} {β : Type v} (f : α → β) (s : wseq α) : map f (think s) = think (map f s) :=
  seq.map_cons (option.map f) none s

@[simp] theorem map_id {α : Type u} (s : wseq α) : map id s = s := sorry

@[simp] theorem map_ret {α : Type u} {β : Type v} (f : α → β) (a : α) : map f (ret a) = ret (f a) := sorry

@[simp] theorem map_append {α : Type u} {β : Type v} (f : α → β) (s : wseq α) (t : wseq α) : map f (append s t) = append (map f s) (map f t) :=
  seq.map_append (option.map f) s t

theorem map_comp {α : Type u} {β : Type v} {γ : Type w} (f : α → β) (g : β → γ) (s : wseq α) : map (g ∘ f) s = map g (map f s) := sorry

theorem mem_map {α : Type u} {β : Type v} (f : α → β) {a : α} {s : wseq α} : a ∈ s → f a ∈ map f s :=
  seq.mem_map (option.map f)

-- The converse is not true without additional assumptions

theorem exists_of_mem_join {α : Type u} {a : α} {S : wseq (wseq α)} : a ∈ join S → ∃ (s : wseq α), s ∈ S ∧ a ∈ s := sorry

theorem exists_of_mem_bind {α : Type u} {β : Type v} {s : wseq α} {f : α → wseq β} {b : β} (h : b ∈ bind s f) : ∃ (a : α), ∃ (H : a ∈ s), b ∈ f a := sorry

theorem destruct_map {α : Type u} {β : Type v} (f : α → β) (s : wseq α) : destruct (map f s) = computation.map (option.map (prod.map f (map f))) (destruct s) := sorry

theorem lift_rel_map {α : Type u} {β : Type v} {γ : Type w} {δ : Type u_1} (R : α → β → Prop) (S : γ → δ → Prop) {s1 : wseq α} {s2 : wseq β} {f1 : α → γ} {f2 : β → δ} (h1 : lift_rel R s1 s2) (h2 : ∀ {a : α} {b : β}, R a b → S (f1 a) (f2 b)) : lift_rel S (map f1 s1) (map f2 s2) := sorry

theorem map_congr {α : Type u} {β : Type v} (f : α → β) {s : wseq α} {t : wseq α} (h : s ~ t) : map f s ~ map f t :=
  lift_rel_map Eq Eq h fun (_x _x_1 : α) => congr_arg fun (_x : α) => f _x

@[simp] def destruct_append.aux {α : Type u} (t : wseq α) : Option (α × wseq α) → computation (Option (α × wseq α)) :=
  sorry

theorem destruct_append {α : Type u} (s : wseq α) (t : wseq α) : destruct (append s t) = computation.bind (destruct s) (destruct_append.aux t) := sorry

@[simp] def destruct_join.aux {α : Type u} : Option (wseq α × wseq (wseq α)) → computation (Option (α × wseq α)) :=
  sorry

theorem destruct_join {α : Type u} (S : wseq (wseq α)) : destruct (join S) = computation.bind (destruct S) destruct_join.aux := sorry

theorem lift_rel_append {α : Type u} {β : Type v} (R : α → β → Prop) {s1 : wseq α} {s2 : wseq α} {t1 : wseq β} {t2 : wseq β} (h1 : lift_rel R s1 t1) (h2 : lift_rel R s2 t2) : lift_rel R (append s1 s2) (append t1 t2) := sorry

theorem lift_rel_join.lem {α : Type u} {β : Type v} (R : α → β → Prop) {S : wseq (wseq α)} {T : wseq (wseq β)} {U : wseq α → wseq β → Prop} (ST : lift_rel (lift_rel R) S T) (HU : ∀ (s1 : wseq α) (s2 : wseq β),
  (∃ (s : wseq α),
      ∃ (t : wseq β),
        ∃ (S : wseq (wseq α)),
          ∃ (T : wseq (wseq β)),
            s1 = append s (join S) ∧ s2 = append t (join T) ∧ lift_rel R s t ∧ lift_rel (lift_rel R) S T) →
    U s1 s2) {a : Option (α × wseq α)} (ma : a ∈ destruct (join S)) : Exists fun {b : Option (β × wseq β)} => b ∈ destruct (join T) ∧ lift_rel_o R U a b := sorry

theorem lift_rel_join {α : Type u} {β : Type v} (R : α → β → Prop) {S : wseq (wseq α)} {T : wseq (wseq β)} (h : lift_rel (lift_rel R) S T) : lift_rel R (join S) (join T) := sorry

theorem join_congr {α : Type u} {S : wseq (wseq α)} {T : wseq (wseq α)} (h : lift_rel equiv S T) : join S ~ join T :=
  lift_rel_join Eq h

theorem lift_rel_bind {α : Type u} {β : Type v} {γ : Type w} {δ : Type u_1} (R : α → β → Prop) (S : γ → δ → Prop) {s1 : wseq α} {s2 : wseq β} {f1 : α → wseq γ} {f2 : β → wseq δ} (h1 : lift_rel R s1 s2) (h2 : ∀ {a : α} {b : β}, R a b → lift_rel S (f1 a) (f2 b)) : lift_rel S (bind s1 f1) (bind s2 f2) :=
  lift_rel_join S (lift_rel_map R (lift_rel S) h1 h2)

theorem bind_congr {α : Type u} {β : Type v} {s1 : wseq α} {s2 : wseq α} {f1 : α → wseq β} {f2 : α → wseq β} (h1 : s1 ~ s2) (h2 : ∀ (a : α), f1 a ~ f2 a) : bind s1 f1 ~ bind s2 f2 :=
  lift_rel_bind Eq Eq h1
    fun (a b : α) (h : a = b) => eq.mpr (id (Eq._oldrec (Eq.refl (lift_rel Eq (f1 a) (f2 b))) h)) (h2 b)

@[simp] theorem join_ret {α : Type u} (s : wseq α) : join (ret s) ~ s := sorry

@[simp] theorem join_map_ret {α : Type u} (s : wseq α) : join (map ret s) ~ s := sorry

@[simp] theorem join_append {α : Type u} (S : wseq (wseq α)) (T : wseq (wseq α)) : join (append S T) ~ append (join S) (join T) := sorry

@[simp] theorem bind_ret {α : Type u} {β : Type v} (f : α → β) (s : wseq α) : bind s (ret ∘ f) ~ map f s :=
  id (eq.mpr (id (Eq._oldrec (Eq.refl (join (map (ret ∘ f) s) ~ map f s)) (map_comp f ret s))) (join_map_ret (map f s)))

@[simp] theorem ret_bind {α : Type u} {β : Type v} (a : α) (f : α → wseq β) : bind (ret a) f ~ f a := sorry

@[simp] theorem map_join {α : Type u} {β : Type v} (f : α → β) (S : wseq (wseq α)) : map f (join S) = join (map (map f) S) := sorry

@[simp] theorem join_join {α : Type u} (SS : wseq (wseq (wseq α))) : join (join SS) ~ join (map join SS) := sorry

@[simp] theorem bind_assoc {α : Type u} {β : Type v} {γ : Type w} (s : wseq α) (f : α → wseq β) (g : β → wseq γ) : bind (bind s f) g ~ bind s fun (x : α) => bind (f x) g := sorry

protected instance monad : Monad wseq :=
  { toApplicative :=
      { toFunctor := { map := map, mapConst := fun (α β : Type u_1) => map ∘ function.const β },
        toPure := { pure := ret },
        toSeq := { seq := fun (α β : Type u_1) (f : wseq (α → β)) (x : wseq α) => bind f fun (_x : α → β) => map _x x },
        toSeqLeft :=
          { seqLeft :=
              fun (α β : Type u_1) (a : wseq α) (b : wseq β) =>
                (fun (α β : Type u_1) (f : wseq (α → β)) (x : wseq α) => bind f fun (_x : α → β) => map _x x) β α
                  (map (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α β : Type u_1) (a : wseq α) (b : wseq β) =>
                (fun (α β : Type u_1) (f : wseq (α → β)) (x : wseq α) => bind f fun (_x : α → β) => map _x x) β β
                  (map (function.const α id) a) b } },
    toBind := { bind := bind } }


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j),
  from by auto [int.fract_eq_iff, hα_irrat, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by auto [abs_sub_lt_iff] using [linarith],

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that $\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$
  cases h2 ε h7 with N1 h8,

  --As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that $\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by auto [lt_of_le_of_lt, le_max_left, le_max_right],

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by auto [h8, h10, h5, h9],

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by auto [h11] using [linarith],

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by auto [h5, h15],

end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import topology.metric_space.basic
import topology.algebra.uniform_group
import topology.algebra.uniform_mul_action
import topology.algebra.ring.basic
import topology.algebra.star
import topology.algebra.order.field
import ring_theory.subring.basic
import group_theory.archimedean
import algebra.order.group.bounds
import algebra.periodic
import topology.instances.int

/-!
# Topological properties of ℝ

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
-/

noncomputable theory
open classical filter int metric set topological_space
open_locale classical topology filter uniformity interval

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

instance : noncompact_space ℝ := int.closed_embedding_coe_real.noncompact_space

theorem real.uniform_continuous_add : uniform_continuous (λp : ℝ × ℝ, p.1 + p.2) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_add_continuous_lemma abs ε0 in
⟨δ, δ0, λ a b h, let ⟨h₁, h₂⟩ := max_lt_iff.1 h in Hδ h₁ h₂⟩

theorem real.uniform_continuous_neg : uniform_continuous (@has_neg.neg ℝ _) :=
metric.uniform_continuous_iff.2 $ λ ε ε0, ⟨_, ε0, λ a b h,
  by rw dist_comm at h; simpa [real.dist_eq] using h⟩

instance : has_continuous_star ℝ := ⟨continuous_id⟩

instance : uniform_add_group ℝ :=
uniform_add_group.mk' real.uniform_continuous_add real.uniform_continuous_neg

 -- short-circuit type class inference
instance : topological_add_group ℝ := by apply_instance

instance : proper_space ℝ :=
{ is_compact_closed_ball := λx r, by { rw real.closed_ball_eq_Icc, apply is_compact_Icc } }

instance : second_countable_topology ℝ := second_countable_of_proper

lemma real.is_topological_basis_Ioo_rat :
  @is_topological_basis ℝ _ (⋃(a b : ℚ) (h : a < b), {Ioo a b}) :=
is_topological_basis_of_open_of_nhds
  (by simp [is_open_Ioo] {contextual:=tt})
  (assume a v hav hv,
    let ⟨l, u, ⟨hl, hu⟩, h⟩ := mem_nhds_iff_exists_Ioo_subset.mp (is_open.mem_nhds hv hav),
        ⟨q, hlq, hqa⟩ := exists_rat_btwn hl,
        ⟨p, hap, hpu⟩ := exists_rat_btwn hu in
    ⟨Ioo q p,
      by { simp only [mem_Union], exact ⟨q, p, rat.cast_lt.1 $ hqa.trans hap, rfl⟩ },
      ⟨hqa, hap⟩, assume a' ⟨hqa', ha'p⟩, h ⟨hlq.trans hqa', ha'p.trans hpu⟩⟩)

@[simp] lemma real.cocompact_eq : cocompact ℝ = at_bot ⊔ at_top :=
by simp only [← comap_dist_right_at_top_eq_cocompact (0 : ℝ), real.dist_eq, sub_zero,
  comap_abs_at_top]

/- TODO(Mario): Prove that these are uniform isomorphisms instead of uniform embeddings
lemma uniform_embedding_add_rat {r : ℚ} : uniform_embedding (λp:ℚ, p + r) :=
_

lemma uniform_embedding_mul_rat {q : ℚ} (hq : q ≠ 0) : uniform_embedding ((*) q) :=
_ -/

lemma real.mem_closure_iff {s : set ℝ} {x : ℝ} :
  x ∈ closure s ↔ ∀ ε > 0, ∃ y ∈ s, |y - x| < ε :=
by simp [mem_closure_iff_nhds_basis nhds_basis_ball, real.dist_eq]

lemma real.uniform_continuous_inv (s : set ℝ) {r : ℝ} (r0 : 0 < r) (H : ∀ x ∈ s, r ≤ |x|) :
  uniform_continuous (λp:s, p.1⁻¹) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_inv_continuous_lemma abs ε0 r0 in
⟨δ, δ0, λ a b h, Hδ (H _ a.2) (H _ b.2) h⟩

lemma real.uniform_continuous_abs : uniform_continuous (abs : ℝ → ℝ) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
  ⟨ε, ε0, λ a b, lt_of_le_of_lt (abs_abs_sub_abs_le_abs_sub _ _)⟩

lemma real.tendsto_inv {r : ℝ} (r0 : r ≠ 0) : tendsto (λq, q⁻¹) (𝓝 r) (𝓝 r⁻¹) :=
by rw ← abs_pos at r0; exact
tendsto_of_uniform_continuous_subtype
  (real.uniform_continuous_inv {x | |r| / 2 < |x|} (half_pos r0) (λ x h, le_of_lt h))
  (is_open.mem_nhds ((is_open_lt' (|r| / 2)).preimage continuous_abs) (half_lt_self r0))

lemma real.continuous_inv : continuous (λa:{r:ℝ // r ≠ 0}, a.val⁻¹) :=
continuous_iff_continuous_at.mpr $ assume ⟨r, hr⟩,
  tendsto.comp (real.tendsto_inv hr) (continuous_iff_continuous_at.mp continuous_subtype_val _)

lemma real.continuous.inv [topological_space α] {f : α → ℝ} (h : ∀a, f a ≠ 0) (hf : continuous f) :
  continuous (λa, (f a)⁻¹) :=
show continuous ((has_inv.inv ∘ @subtype.val ℝ (λr, r ≠ 0)) ∘ λa, ⟨f a, h a⟩),
  from real.continuous_inv.comp (hf.subtype_mk _)

lemma real.uniform_continuous_const_mul {x : ℝ} : uniform_continuous ((*) x) :=
uniform_continuous_const_smul x

lemma real.uniform_continuous_mul (s : set (ℝ × ℝ))
  {r₁ r₂ : ℝ} (H : ∀ x ∈ s, |(x : ℝ × ℝ).1| < r₁ ∧ |x.2| < r₂) :
  uniform_continuous (λp:s, p.1.1 * p.1.2) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
let ⟨δ, δ0, Hδ⟩ := rat_mul_continuous_lemma abs ε0 in
⟨δ, δ0, λ a b h,
  let ⟨h₁, h₂⟩ := max_lt_iff.1 h in Hδ (H _ a.2).1 (H _ b.2).2 h₁ h₂⟩

protected lemma real.continuous_mul : continuous (λp : ℝ × ℝ, p.1 * p.2) :=
continuous_iff_continuous_at.2 $ λ ⟨a₁, a₂⟩,
tendsto_of_uniform_continuous_subtype
  (real.uniform_continuous_mul
    ({x | |x| < |a₁| + 1} ×ˢ {x | |x| < |a₂| + 1})
    (λ x, id))
  (is_open.mem_nhds
    (((is_open_gt' (|a₁| + 1)).preimage continuous_abs).prod
      ((is_open_gt' (|a₂| + 1)).preimage continuous_abs ))
    ⟨lt_add_one (|a₁|), lt_add_one (|a₂|)⟩)

instance : topological_ring ℝ :=
{ continuous_mul := real.continuous_mul, ..real.topological_add_group }

instance : complete_space ℝ :=
begin
  apply complete_of_cauchy_seq_tendsto,
  intros u hu,
  let c : cau_seq ℝ abs := ⟨u, metric.cauchy_seq_iff'.1 hu⟩,
  refine ⟨c.lim, λ s h, _⟩,
  rcases metric.mem_nhds_iff.1 h with ⟨ε, ε0, hε⟩,
  have := c.equiv_lim ε ε0,
  simp only [mem_map, mem_at_top_sets, mem_set_of_eq],
  refine this.imp (λ N hN n hn, hε (hN n hn))
end

lemma real.totally_bounded_ball (x ε : ℝ) : totally_bounded (ball x ε) :=
by rw real.ball_eq_Ioo; apply totally_bounded_Ioo

section

lemma closure_of_rat_image_lt {q : ℚ} : closure ((coe:ℚ → ℝ) '' {x | q < x}) = {r | ↑q ≤ r} :=
subset.antisymm
  ((is_closed_ge' _).closure_subset_iff.2
    (image_subset_iff.2 $ λ p h, le_of_lt $ (@rat.cast_lt ℝ _ _ _).2 h)) $
λ x hx, mem_closure_iff_nhds.2 $ λ t ht,
let ⟨ε, ε0, hε⟩ := metric.mem_nhds_iff.1 ht in
let ⟨p, h₁, h₂⟩ := exists_rat_btwn ((lt_add_iff_pos_right x).2 ε0) in
⟨_, hε (show abs _ < _,
    by rwa [abs_of_nonneg (le_of_lt $ sub_pos.2 h₁), sub_lt_iff_lt_add']),
  p, rat.cast_lt.1 (@lt_of_le_of_lt ℝ _ _ _ _ hx h₁), rfl⟩

/- TODO(Mario): Put these back only if needed later
lemma closure_of_rat_image_le_eq {q : ℚ} : closure ((coe:ℚ → ℝ) '' {x | q ≤ x}) = {r | ↑q ≤ r} :=
_

lemma closure_of_rat_image_le_le_eq {a b : ℚ} (hab : a ≤ b) :
  closure (of_rat '' {q:ℚ | a ≤ q ∧ q ≤ b}) = {r:ℝ | of_rat a ≤ r ∧ r ≤ of_rat b} :=
_-/

lemma real.bounded_iff_bdd_below_bdd_above {s : set ℝ} : bounded s ↔ bdd_below s ∧ bdd_above s :=
⟨begin
  assume bdd,
  rcases (bounded_iff_subset_ball 0).1 bdd with ⟨r, hr⟩, -- hr : s ⊆ closed_ball 0 r
  rw real.closed_ball_eq_Icc at hr, -- hr : s ⊆ Icc (0 - r) (0 + r)
  exact ⟨bdd_below_Icc.mono hr, bdd_above_Icc.mono hr⟩
end,
λ h, bounded_of_bdd_above_of_bdd_below h.2 h.1⟩

lemma real.subset_Icc_Inf_Sup_of_bounded {s : set ℝ} (h : bounded s) :
  s ⊆ Icc (Inf s) (Sup s) :=
subset_Icc_cInf_cSup (real.bounded_iff_bdd_below_bdd_above.1 h).1
  (real.bounded_iff_bdd_below_bdd_above.1 h).2

end

section periodic

namespace function

lemma periodic.compact_of_continuous' [topological_space α] {f : ℝ → α} {c : ℝ}
  (hp : periodic f c) (hc : 0 < c) (hf : continuous f) :
  is_compact (range f) :=
begin
  convert is_compact_Icc.image hf,
  ext x,
  refine ⟨_, mem_range_of_mem_image f (Icc 0 c)⟩,
  rintros ⟨y, h1⟩,
  obtain ⟨z, hz, h2⟩ := hp.exists_mem_Ico₀ hc y,
  exact ⟨z, mem_Icc_of_Ico hz, h2.symm.trans h1⟩,
end

/-- A continuous, periodic function has compact range. -/
lemma periodic.compact_of_continuous [topological_space α] {f : ℝ → α} {c : ℝ}
  (hp : periodic f c) (hc : c ≠ 0) (hf : continuous f) :
  is_compact (range f) :=
begin
  cases lt_or_gt_of_ne hc with hneg hpos,
  exacts [hp.neg.compact_of_continuous' (neg_pos.mpr hneg) hf, hp.compact_of_continuous' hpos hf],
end

/-- A continuous, periodic function is bounded. -/
lemma periodic.bounded_of_continuous [pseudo_metric_space α] {f : ℝ → α} {c : ℝ}
  (hp : periodic f c) (hc : c ≠ 0) (hf : continuous f) :
  bounded (range f) :=
(hp.compact_of_continuous hc hf).bounded

end function

end periodic

section subgroups

namespace int
open metric

/-- Under the coercion from `ℤ` to `ℝ`, inverse images of compact sets are finite. -/
lemma tendsto_coe_cofinite : tendsto (coe : ℤ → ℝ) cofinite (cocompact ℝ) :=
begin
  refine tendsto_cocompact_of_tendsto_dist_comp_at_top (0 : ℝ) _,
  simp only [filter.tendsto_at_top, eventually_cofinite, not_le, ← mem_ball],
  change ∀ r : ℝ, (coe ⁻¹' (ball (0 : ℝ) r)).finite,
  simp [real.ball_eq_Ioo, set.finite_Ioo],
end

/-- For nonzero `a`, the "multiples of `a`" map `zmultiples_hom` from `ℤ` to `ℝ` is discrete, i.e.
inverse images of compact sets are finite. -/
lemma tendsto_zmultiples_hom_cofinite {a : ℝ} (ha : a ≠ 0) :
  tendsto (zmultiples_hom ℝ a) cofinite (cocompact ℝ) :=
begin
  convert (tendsto_cocompact_mul_right₀ ha).comp int.tendsto_coe_cofinite,
  ext n,
  simp,
end

end int

namespace add_subgroup

/-- The subgroup "multiples of `a`" (`zmultiples a`) is a discrete subgroup of `ℝ`, i.e. its
intersection with compact sets is finite. -/
lemma tendsto_zmultiples_subtype_cofinite (a : ℝ) :
  tendsto (zmultiples a).subtype cofinite (cocompact ℝ) :=
begin
  rcases eq_or_ne a 0 with rfl | ha,
  { rw add_subgroup.zmultiples_zero_eq_bot,
    intros K hK,
    rw [filter.mem_map, mem_cofinite],
    apply set.to_finite },
  intros K hK,
  have H := int.tendsto_zmultiples_hom_cofinite ha hK,
  simp only [filter.mem_map, mem_cofinite, ← preimage_compl] at ⊢ H,
  rw [← (zmultiples_hom ℝ a).range_restrict_surjective.image_preimage
    ((zmultiples a).subtype ⁻¹' Kᶜ), ← preimage_comp, ← add_monoid_hom.coe_comp_range_restrict],
  exact finite.image _ H,
end

end add_subgroup

/-- Given a nontrivial subgroup `G ⊆ ℝ`, if `G ∩ ℝ_{>0}` has no minimum then `G` is dense. -/
lemma real.subgroup_dense_of_no_min {G : add_subgroup ℝ} {g₀ : ℝ} (g₀_in : g₀ ∈ G) (g₀_ne : g₀ ≠ 0)
  (H' : ¬ ∃ a : ℝ, is_least {g : ℝ | g ∈ G ∧ 0 < g} a) :
  dense (G : set ℝ) :=
begin
  let G_pos := {g : ℝ | g ∈ G ∧ 0 < g},
  push_neg at H',
  intros x,
  suffices : ∀ ε > (0 : ℝ), ∃ g ∈ G, |x - g| < ε,
    by simpa only [real.mem_closure_iff, abs_sub_comm],
  intros ε ε_pos,
  obtain ⟨g₁, g₁_in, g₁_pos⟩ : ∃ g₁ : ℝ, g₁ ∈ G ∧ 0 < g₁,
  { cases lt_or_gt_of_ne g₀_ne with Hg₀ Hg₀,
    { exact ⟨-g₀, G.neg_mem g₀_in, neg_pos.mpr Hg₀⟩ },
    { exact ⟨g₀, g₀_in, Hg₀⟩ } },
  obtain ⟨a, ha⟩ : ∃ a, is_glb G_pos a :=
    ⟨Inf G_pos, is_glb_cInf ⟨g₁, g₁_in, g₁_pos⟩ ⟨0, λ _ hx, le_of_lt hx.2⟩⟩,
  have a_notin : a ∉ G_pos,
  { intros H,
    exact H' a ⟨H, ha.1⟩ },
  obtain ⟨g₂, g₂_in, g₂_pos, g₂_lt⟩ : ∃ g₂ : ℝ, g₂ ∈ G ∧ 0 < g₂ ∧ g₂ < ε,
  { obtain ⟨b, hb, hb', hb''⟩ := ha.exists_between_self_add' a_notin ε_pos,
    obtain ⟨c, hc, hc', hc''⟩ := ha.exists_between_self_add' a_notin (sub_pos.2 hb'),
    refine ⟨b - c, G.sub_mem hb.1 hc.1, _, _⟩ ;
    linarith },
  refine ⟨floor (x/g₂) * g₂, _, _⟩,
  { exact add_subgroup.int_mul_mem _ g₂_in },
  { rw abs_of_nonneg (sub_floor_div_mul_nonneg x g₂_pos),
    linarith [sub_floor_div_mul_lt x g₂_pos] }
end

/-- Subgroups of `ℝ` are either dense or cyclic. See `real.subgroup_dense_of_no_min` and
`subgroup_cyclic_of_min` for more precise statements. -/
lemma real.subgroup_dense_or_cyclic (G : add_subgroup ℝ) :
  dense (G : set ℝ) ∨ ∃ a : ℝ, G = add_subgroup.closure {a} :=
begin
  cases add_subgroup.bot_or_exists_ne_zero G with H H,
  { right,
    use 0,
    rw [H, add_subgroup.closure_singleton_zero] },
  { let G_pos := {g : ℝ | g ∈ G ∧ 0 < g},
    by_cases H' : ∃ a, is_least G_pos a,
    { right,
      rcases H' with ⟨a, ha⟩,
      exact ⟨a, add_subgroup.cyclic_of_min ha⟩ },
    { left,
      rcases H with ⟨g₀, g₀_in, g₀_ne⟩,
      exact real.subgroup_dense_of_no_min g₀_in g₀_ne H' } }
end

end subgroups


import topology.basic
import topology.compact_open
import data.nat.prime
import data.real.basic
import data.real.irrational
import data.complex.basic
import data.fin.basic
import geometry.euclidean.basic
import analysis.inner_product_space.pi_L2
import algebra.group.defs
import algebra.field.basic
import combinatorics.configuration
import ring_theory.polynomial.basic
import group_theory.free_group
import combinatorics.simple_graph.basic
import ring_theory.integral_closure
import data.fintype.card
import category_theory.category.basic
import ring_theory.discrete_valuation_ring
import group_theory.torsion
import linear_algebra.matrix.charpoly.basic
import algebra.order.absolute_value
import analysis.convex.basic
import topology.uniform_space.uniform_convergence_topology
import topology.sequences
import analysis.normed.group.infinite_sum
import data.nat.choose.sum
import group_theory.specific_groups.cyclic
import group_theory.order_of_element
import analysis.mean_inequalities
import analysis.normed_space.banach
import topology.algebra.continuous_monoid_hom
import linear_algebra.matrix.symmetric
import analysis.inner_product_space.spectrum
import ring_theory.class_group
import ring_theory.dedekind_domain.basic
import ring_theory.principal_ideal_domain
import model_theory.satisfiability
import probability.integration
import ring_theory.simple_module
import category_theory.preadditive.schur
import representation_theory.maschke
import topology.paracompact
import combinatorics.simple_graph.coloring
--Prove that Overflow  in Lean mathlib

--OUTPUT 1
theorem overflow_thm : ∀ n m p : ℤ, (n < m) ∧ (m < p) → (n < p) :=
begin
  intros n m p h,
  cases h with nm mp,
  apply lt_of_lt_of_le,
  -- This proof is done using 3 different tactics in one block
  { apply nm },
  { apply le_trans mp nm }

--OUTPUT 2
theorem Overflow:
∀(n:ℕ), ∃(y:ℕ), (2 * y) ≥ n
-> ∃(x:ℕ), (2 * x) < n
-> n = 0
:=
begin

intro n,
intro EX1,
intro EX2,
cases EX2 with x EX2,
cases EX1 with y EX1,

have HYP1: 2 * y ≥ (2 * x) + 1,
have HYP2: 2 * x < 2 * y,

linarith,

have HYP3: ¬(2 * x + 1 = 2 * y),

intro CONTRA,

have LHS: 2 * y = 2 * x + 1,
rw CONTRA,

have RHS: 2 * x + 1 ∣ 2 * y,
existsi (2 * y) / (2 * x + 1),
simp,
norm_num,

have HYP4: ∃(w:ℕ), 2 * x + 1 = 2 * w,
apply eq_two_factors,
assumption,

have HYP5: 2 * x + 1 = 2 * (2 * x + 1),
existsi (2 * x + 1),
simp,
norm_num,

have HYP6: 2 ∣ (2 * x + 1),
existsi (2 * x + 1),
simp,
norm_num,

have HYP7: 2 ∣ (2 * y),
existsi (2 * y) / 2,
simp,
norm_num,

have RHS: (2 * x + 1) = (2 * y),
rw LHS,

have HYP8: 2 ≤ 2 * x + 1,
linarith,

have HYP9: 2 ≤ 2 * y,
linarith,

apply div_eq_of_eq_mul,
assumption,
assumption,
assumption,
assumption,
assumption,
assumption,
assumption,
assumption,
assumption,
assumption,

have HYP10: 2 * y ≥ n,
linarith,

have HYP11: n = 0,
linarith,
assumption,

assumption,
assumption,
assumption,
assumption,

--OUTPUT 3
theorem overflow_proof {a b c : ℤ} (h : a * b = c) (bound: ℤ) (bound_pos: 0 < bound) : c ≤ a * (b - bound) ∧ c ≥ a * (b + bound) :=
begin
    rw ← h,
    -- From the assumption, we know that a * b = c.
    -- So we can just rewrite the concatenation and
    -- start to prove it.
    have h1 : a * (b - bound) ≤ a * b + -(a * bound), {
        apply add_le_add_right,
        apply mul_le_mul_of_ge_left h_1;
        -- Here, we use the hypothesis 'h_1' which
        -- means b - bound >= 0, given by the
        -- tactic 'cases' above.
        all_goals {exact bound_pos},
        -- And we can also use all_goals to
        -- examine all the goals generated, in
        -- this case, we get a new subgoal which
        -- claims that a >= 0. We can use the
        -- hypothesis 'bound_pos' which is given
        -- by the parameter of the function.
    },
    have h2 : a * (b - bound) ≤ a * b + -(a * bound), {
        linarith,
        -- The tactic 'linarith' will
        -- automatically prove this
        -- goal for us.
    },
    have h3 : a * b + -(a * bound) ≤ c, {
        rw ← h,
        -- rewrite the equation again
        linarith,
    },
    -- Now, we can just use the transitivity of
    -- the relation '<=' to prove the first goal
    -- which is c <= a * (b - bound).
    have h4 : c ≤ a * (b - bound), {
        transitivity,
        {
            exact h1,
        },
        {
            exact h2,
        },
    },
    -- Now let's prove the second goal c >= a * (b + bound).
    have h5 : a * b + -(a * bound) ≤ a * (b + bound), {
        linarith,
    },
    have h6 : c ≤ a * (b + bound), {
        transitivity,
        {
            exact h3,
        },
        {
            exact h5,
        },
    },
    split,
    {
        exact h6,
    },
    {
        -- To prove the second goal, we need to
        -- prove the commutativity of the relation
        -- '<=' firstly.
        have h7 : a * (b + bound) ≤ a * (b - bound), {
            have h8 : b + bound ≤ b - bound, {
                linarith,
            },
            apply mul_le_mul_of_ge_left h8;
            -- Here, we use the hypothesis 'h8' which
            -- means b + bound <= b - bound, given by the
            -- tactic 'linarith' above.
            all_goals {exact bound_pos},
            -- And we can also use all_goals to
            -- examine all the goals generated, in
            -- this case, we get a new subgoal which
            -- claims that a >= 0. We can use the
            -- hypothesis 'bound_pos' which is given
            -- by the parameter of the function.
        },
        -- Now, we just need to use the transitivity
        -- of the relation '<=' to prove the second
        -- goal.
        have h9 : c ≥ a * (b + bound), {
            transitivity,
            {
                exact h4,
            },
            {
                exact h7,
            },
        },
        exact h9,
    }


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import category_theory.natural_transformation
import category_theory.isomorphism

/-!
# The category of functors and natural transformations between two fixed categories.

We provide the category instance on `C ⥤ D`, with morphisms the natural transformations.

## Universes

If `C` and `D` are both small categories at the same universe level,
this is another small category at that level.
However if `C` and `D` are both large categories at the same universe level,
this is a small category at the next higher level.
-/

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ u₁ u₂ u₃

open nat_trans category category_theory.functor

variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

local attribute [simp] vcomp_app
/--
`functor.category C D` gives the category structure on functors and natural transformations
between categories `C` and `D`.

Notice that if `C` and `D` are both small categories at the same universe level,
this is another small category at that level.
However if `C` and `D` are both large categories at the same universe level,
this is a small category at the next higher level.
-/
instance functor.category : category.{(max u₁ v₂)} (C ⥤ D) :=
{ hom     := λ F G, nat_trans F G,
  id      := λ F, nat_trans.id F,
  comp    := λ _ _ _ α β, vcomp α β }

variables {C D} {E : Type u₃} [category.{v₃} E]
variables {F G H I : C ⥤ D}

namespace nat_trans

@[simp] lemma vcomp_eq_comp (α : F ⟶ G) (β : G ⟶ H) : vcomp α β = α ≫ β := rfl

lemma vcomp_app' (α : F ⟶ G) (β : G ⟶ H) (X : C) :
  (α ≫ β).app X = (α.app X) ≫ (β.app X) := rfl

lemma congr_app {α β : F ⟶ G} (h : α = β) (X : C) : α.app X = β.app X := by rw h
@[simp] lemma id_app (F : C ⥤ D) (X : C) : (𝟙 F : F ⟶ F).app X = 𝟙 (F.obj X) := rfl
@[simp] lemma comp_app {F G H : C ⥤ D} (α : F ⟶ G) (β : G ⟶ H) (X : C) :
  (α ≫ β).app X = α.app X ≫ β.app X := rfl

lemma app_naturality {F G : C ⥤ (D ⥤ E)} (T : F ⟶ G) (X : C) {Y Z : D} (f : Y ⟶ Z) :
  ((F.obj X).map f) ≫ ((T.app X).app Z) = ((T.app X).app Y) ≫ ((G.obj X).map f) :=
(T.app X).naturality f

lemma naturality_app {F G : C ⥤ (D ⥤ E)} (T : F ⟶ G) (Z : D) {X Y : C} (f : X ⟶ Y) :
  ((F.map f).app Z) ≫ ((T.app Y).app Z) = ((T.app X).app Z) ≫ ((G.map f).app Z) :=
congr_fun (congr_arg app (T.naturality f)) Z

/-- A natural transformation is a monomorphism if each component is. -/
lemma mono_app_of_mono (α : F ⟶ G) [∀ (X : C), mono (α.app X)] : mono α :=
⟨λ H g h eq, by { ext X, rw [←cancel_mono (α.app X), ←comp_app, eq, comp_app] }⟩

/-- A natural transformation is an epimorphism if each component is. -/
lemma epi_app_of_epi (α : F ⟶ G) [∀ (X : C), epi (α.app X)] : epi α :=
⟨λ H g h eq, by { ext X, rw [←cancel_epi (α.app X), ←comp_app, eq, comp_app] }⟩

/-- `hcomp α β` is the horizontal composition of natural transformations. -/
def hcomp {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) : (F ⋙ H) ⟶ (G ⋙ I) :=
{ app         := λ X : C, (β.app (F.obj X)) ≫ (I.map (α.app X)),
  naturality' := λ X Y f,
  begin
    rw [functor.comp_map, functor.comp_map, ←assoc, naturality, assoc,
        ←map_comp I, naturality, map_comp, assoc]
  end }

infix ` ◫ `:80 := hcomp

@[simp] lemma hcomp_app {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) (X : C) :
  (α ◫ β).app X = (β.app (F.obj X)) ≫ (I.map (α.app X)) := rfl

@[simp] lemma hcomp_id_app {H : D ⥤ E} (α : F ⟶ G) (X : C) : (α ◫ 𝟙 H).app X = H.map (α.app X) :=
  by {dsimp, simp} -- See note [dsimp, simp].

lemma id_hcomp_app {H : E ⥤ C} (α : F ⟶ G) (X : E) : (𝟙 H ◫ α).app X = α.app _ := by simp

-- Note that we don't yet prove a `hcomp_assoc` lemma here: even stating it is painful, because we
-- need to use associativity of functor composition. (It's true without the explicit associator,
-- because functor composition is definitionally associative,
-- but relying on the definitional equality causes bad problems with elaboration later.)

lemma exchange {I J K : D ⥤ E} (α : F ⟶ G) (β : G ⟶ H)
  (γ : I ⟶ J) (δ : J ⟶ K) : (α ≫ β) ◫ (γ ≫ δ) = (α ◫ γ) ≫ (β ◫ δ) :=
by ext; simp

end nat_trans
open nat_trans
namespace functor

/-- Flip the arguments of a bifunctor. See also `currying.lean`. -/
protected def flip (F : C ⥤ (D ⥤ E)) : D ⥤ (C ⥤ E) :=
{ obj := λ k,
  { obj := λ j, (F.obj j).obj k,
    map := λ j j' f, (F.map f).app k,
    map_id' := λ X, begin rw category_theory.functor.map_id, refl end,
    map_comp' := λ X Y Z f g, by rw [map_comp, ←comp_app] },
  map := λ c c' f,
  { app := λ j, (F.obj j).map f } }.

@[simp] lemma flip_obj_obj (F : C ⥤ (D ⥤ E)) (c) (d) : (F.flip.obj d).obj c = (F.obj c).obj d := rfl
@[simp] lemma flip_obj_map (F : C ⥤ (D ⥤ E)) {c c' : C} (f : c ⟶ c') (d : D) :
  (F.flip.obj d).map f = (F.map f).app d := rfl
@[simp] lemma flip_map_app (F : C ⥤ (D ⥤ E)) {d d' : D} (f : d ⟶ d') (c : C) :
  (F.flip.map f).app c = (F.obj c).map f := rfl

end functor

@[simp, reassoc] lemma map_hom_inv_app (F : C ⥤ D ⥤ E) {X Y : C} (e : X ≅ Y) (Z : D) :
  (F.map e.hom).app Z ≫ (F.map e.inv).app Z = 𝟙 _ :=
by simp [← nat_trans.comp_app, ← functor.map_comp]

@[simp, reassoc] lemma map_inv_hom_app (F : C ⥤ D ⥤ E) {X Y : C} (e : X ≅ Y) (Z : D) :
  (F.map e.inv).app Z ≫ (F.map e.hom).app Z = 𝟙 _ :=
by simp [← nat_trans.comp_app, ← functor.map_comp]

end category_theory


import .diffeomorph

open function set
open_locale topological_space

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{F' : Type*} [normed_group F'] [normed_space 𝕜 F']
{H : Type*} [topological_space H]
{H' : Type*} [topological_space H']
{G : Type*} [topological_space G]
{G' : Type*} [topological_space G']

/-- local diffeomorphisms, defined on open subsets of the space -/
@[nolint has_inhabited_instance]
structure local_diffeomorph
(I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
(M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
(M' : Type*) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']
extends local_homeomorph M M' :=
(smooth_to_fun      : smooth_in_charts_on I I' to_fun source)
(smooth_inv_fun     : smooth_in_charts_on I' I inv_fun target)

/-- A diffomorphism induces a local diffeomorphism on the whole space -/
def diffeomorph.to_local_diffeomorph
(I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
(M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
(M' : Type*) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']
(e : diffeomorph I I' M M') :
  local_diffeomorph I I' M M' :=
{ smooth_to_fun  := by { simp only [smooth_in_charts_on], erw times_cont_mdiff_in_charts_on_univ, exact e.smooth_to_fun },
  smooth_inv_fun := by { simp only [smooth_in_charts_on], erw times_cont_mdiff_in_charts_on_univ, exact e.smooth_inv_fun },
  ..e.to_homeomorph.to_local_homeomorph }

namespace local_diffeomorph

variables {I : model_with_corners 𝕜 E H} {I' : model_with_corners 𝕜 E' H'}
{J : model_with_corners 𝕜 F G} {J' : model_with_corners 𝕜 F' G'}
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{M' : Type*} [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']
{N : Type*} [topological_space N] [charted_space G N] [smooth_manifold_with_corners J N]
{N' : Type*} [topological_space N'] [charted_space G' N'] [smooth_manifold_with_corners J' N']
(e : local_diffeomorph I I' M M') (e' : local_diffeomorph J J' N N')

instance : has_coe (local_diffeomorph I I' M M') (local_homeomorph M M') := ⟨local_diffeomorph.to_local_homeomorph⟩
instance : has_coe_to_fun (local_diffeomorph I I' M M') := ⟨_, λ e, e.to_local_equiv.to_fun⟩

/-- The inverse of a local homeomorphism -/
protected def symm : local_diffeomorph I' I M' M :=
{ smooth_to_fun      := e.smooth_inv_fun,
  smooth_inv_fun     := e.smooth_to_fun,
  ..e.to_local_homeomorph.symm }

protected lemma smooth_in_charts_on : smooth_in_charts_on I I' e e.source := e.smooth_to_fun

lemma smooth_in_charts_on_symm : smooth_in_charts_on I' I e.symm e.target := e.smooth_inv_fun

/- Register a few simp lemmas to make sure that `simp` puts the application of a local
diffeomorphism in its normal form, i.e., in terms of its coercion to a function. -/

@[simp, mfld_simps] lemma to_fun_eq_coe (e : local_diffeomorph I I' M M') : e.to_fun = e := rfl

@[simp, mfld_simps] lemma inv_fun_eq_coe (e : local_diffeomorph I I' M M') : e.inv_fun = e.symm := rfl

@[simp, mfld_simps] lemma coe_coe : (e.to_local_equiv : M → M') = e := rfl

@[simp, mfld_simps] lemma coe_coe_symm : (e.to_local_equiv.symm : M' → M) = e.symm := rfl

@[simp, mfld_simps] lemma map_source {x : M} (h : x ∈ e.source) : e x ∈ e.target :=
e.map_source' h

@[simp, mfld_simps] lemma map_target {x : M'} (h : x ∈ e.target) : e.symm x ∈ e.source :=
e.map_target' h

@[simp, mfld_simps] lemma left_inv {x : M} (h : x ∈ e.source) : e.symm (e x) = x :=
e.left_inv' h

@[simp, mfld_simps] lemma right_inv {x : M'} (h : x ∈ e.target) : e (e.symm x) = x :=
e.right_inv' h

lemma eq_of_local_equiv_eq {e e' : local_diffeomorph I I' M M'}
  (h : e.to_local_equiv = e'.to_local_equiv) : e = e' :=
begin
  cases e, cases e',
  dsimp at *,
  induction h,
  refl
end

lemma eventually_left_inverse (e : local_diffeomorph I I' M M') {x} (hx : x ∈ e.source) :
  ∀ᶠ y in 𝓝 x, e.symm (e y) = y :=
filter.eventually.mono (mem_nhds_sets e.open_source hx) e.left_inv'

end local_diffeomorph


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem two_colorable_bipartite {G : Type*} [graph G] : two_colorable G ↔ bipartite G :=
begin
  have h1 : two_colorable G → bipartite G, from sorry,
  have h2 : bipartite G → two_colorable G, from sorry,
  show two_colorable G ↔ bipartite G, from sorry,
end

--OUTPUT 2
theorem two_colorable_iff_bipartite {G : Type*} [graph G] : two_colorable G ↔ bipartite G :=
begin
  sorry,
end

--OUTPUT 3
theorem bipartite_graph_two_colorable {G : Type*} [graph G] : is_bipartite G ↔ is_two_colorable G :=
begin
  show is_bipartite G ↔ is_two_colorable G, from sorry,
end

--OUTPUT 4
theorem bipartite_two_colorable (G : Type*) [graph G] : two_colorable G ↔ bipartite G :=
begin
  have h1 : two_colorable G → bipartite G, from by {
    assume h1 : two_colorable G,
    have h2 : ∃ A B : set G, ∀ a : G, a ∈ A ∨ a ∈ B ∧ (∀ a b : G, a ∈ A ∧ b ∈ A → ¬(a b)) ∧ (∀ a b : G, a ∈ B ∧ b ∈ B → ¬(a b)) ∧ (∀ a b : G, a ∈ A ∧ b ∈ B → (a b)), from sorry,
    show bipartite G, from sorry,
  },
  have h2 : bipartite G → two_colorable G, from by {
    assume h2 : bipartite G,
    have h3 : ∃ A B : set G, ∀ a : G, a ∈ A ∨ a ∈ B ∧ (∀ a b : G, a ∈ A ∧ b ∈ A → ¬(a b)) ∧ (∀ a b : G, a ∈ B ∧ b ∈ B → ¬(a b)) ∧ (∀ a b : G, a ∈ A ∧ b ∈ B → (a b)), from sorry,
    show two_colorable G, from sorry,
  },
  show two_colorable G ↔ bipartite G, from sorry,
end

--OUTPUT 5
theorem bipartite_two_colorable (G : Type*) [graph G] : 2-colorable G ↔ bipartite G :=
begin
  have h1 : 2-colorable G → bipartite G, from sorry,
  have h2 : bipartite G → 2-colorable G, from sorry,
  show 2-colorable G ↔ bipartite G, from sorry,
end

--OUTPUT 6
theorem bipartite_graph_two_colorable (G : Type*) [graph G] :
  (∃ V1 V2 : set G, ∀ v1 ∈ V1, ∀ v2 ∈ V2, ∀ e : G, e ∈ edges G → v1 = e.1 ∨ v2 = e.2) ↔
  (∃ f : G → ℕ, ∀ e : G, e ∈ edges G → f e.1 ≠ f e.2) :=
begin
  split,
  {
    assume h1 : ∃ V1 V2 : set G, ∀ v1 ∈ V1, ∀ v2 ∈ V2, ∀ e : G, e ∈ edges G → v1 = e.1 ∨ v2 = e.2,
    have h2 : ∃ V1 V2 : set G, ∀ v1 ∈ V1, ∀ v2 ∈ V2, ∀ e : G, e ∈ edges G → v1 = e.1 ∨ v2 = e.2, from h1,
    cases h2 with V1 h2,
    cases h2 with V2 h2,
    use (λ v : G, if v ∈ V1 then 0 else 1),
    assume (v1 v2 : G) (h3 : v1 ∈ V1) (h4 : v2 ∈ V2) (e : G) (h5 : e ∈ edges G),
    have h6 : v1 ∉ V2, from sorry,
    have h7 : v2 ∉ V1, from sorry,
    show (if v1 ∈ V1 then 0 else 1) ≠ (if v2 ∈ V1 then 0 else 1), from sorry,
  },
  {
    assume h1 : ∃ f : G → ℕ, ∀ e : G, e ∈ edges G → f e.1 ≠ f e.2,
    have h2 : ∃ f : G → ℕ, ∀ e : G, e ∈ edges G → f e.1 ≠ f e.2, from h1,
    cases h2 with f h2,
    use (λ v : G, if f v = 0 then true else false),
    use (λ v : G, if f v = 1 then true else false),
    assume (v1 v2 : G) (h3 : v1 ∈ (λ v : G, if f v = 0 then true else false)) (h4 : v2 ∈ (λ v : G, if f v = 1 then true else false)) (e : G) (h5 : e ∈ edges G),
    have h6 : v1 ∉ (λ v : G, if f v = 1 then true else false), from sorry,
    have h7 : v2 ∉ (λ v : G, if f v = 0 then true else false), from sorry,
    show v1 = e.1 ∨ v2 = e.2, from sorry,
  }
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.module.basic
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Prod instances for module and multiplicative actions

This file defines instances for binary product of modules
-/

namespace prod

protected instance has_scalar {α : Type u_1} {β : Type u_2} {γ : Type u_3} [has_scalar α β] [has_scalar α γ] : has_scalar α (β × γ) :=
  has_scalar.mk fun (a : α) (p : β × γ) => (a • fst p, a • snd p)

@[simp] theorem smul_fst {α : Type u_1} {β : Type u_2} {γ : Type u_3} [has_scalar α β] [has_scalar α γ] (a : α) (x : β × γ) : fst (a • x) = a • fst x :=
  rfl

@[simp] theorem smul_snd {α : Type u_1} {β : Type u_2} {γ : Type u_3} [has_scalar α β] [has_scalar α γ] (a : α) (x : β × γ) : snd (a • x) = a • snd x :=
  rfl

@[simp] theorem smul_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} [has_scalar α β] [has_scalar α γ] (a : α) (b : β) (c : γ) : a • (b, c) = (a • b, a • c) :=
  rfl

protected instance semimodule {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : semiring α} [add_comm_monoid β] [add_comm_monoid γ] [semimodule α β] [semimodule α γ] : semimodule α (β × γ) :=
  semimodule.mk sorry sorry


import tactic
--import structures
-- dEAduction imports
import snippets.tactics.structures
import snippets.definitions.definitions

namespace tactic.interactive
open lean.parser tactic interactive
open interactive (loc.ns)
open interactive.types
open tactic expr
local postfix *:9001 := many -- sinon ne comprends pas ident*

/- Appelle l'analyse récursive sur le but ou sur une hypothèse. Non utilisé par la suite. -/
meta def estcepi (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (is_pi goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace(is_pi expr_t)
    | _ := skip
    end

meta def estcefl (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (is_arrow goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace(is_arrow expr_t)
    | _ := skip
    end

meta def estceprop (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (is_prop goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace(is_prop expr_t)
    | _ := skip
    end

/-
Tactic to get the list of definitions, ie lemmas from the definitions spacename
-/

meta def is_theorem : declaration → bool
| (declaration.defn _ _ _ _ _ _) :=  ff
| (declaration.thm _ _ _ _) := tt
| (declaration.cnst _ _ _ _) := ff
| (declaration.ax _ _ _) := tt

meta def get_all_theorems : tactic (list name) :=
do
    env ← tactic.get_env,
    pure (environment.fold env [] (λ decl nams,
         if is_theorem decl then
            declaration.to_name decl :: nams
         else
            nams))

meta def print_all_theorems' : tactic unit :=
do
    nams ← get_all_theorems,
    nams.mmap (λ h, tactic.trace h),
    return ()

meta def name.get_ante_suffix : name → name
| (name.mk_string s1 (name.mk_string s2 p))  := s2
| (name.mk_numeral s1 (name.mk_string s2 p)) := s2
| p := name.anonymous

meta def print_all_as_theorems : tactic unit :=
do
    nams ← get_all_theorems,
    nams.mmap (λ h, tactic.trace $ name.get_ante_suffix h),
    return ()

meta def is_definitions_as (n : name) : bool :=
if (name.get_ante_suffix n = "set") then tt else ff

meta def print_all_is_as_theorems : tactic unit :=
do
    nams ← get_all_theorems,
    nams.mmap (λ h, tactic.trace $ is_definitions_as h),
    return ()

meta def is_definitions_as' (n : name) : tactic bool :=
if (name.get_ante_suffix n = "definitions") then return tt else return ff

meta def print_all_is_as_theorems' : tactic unit :=
do
    nams ← get_all_theorems,
    nams.mmap (λ h, tactic.trace $ is_definitions_as' h),
    return ()

meta def print_all_definitions' : tactic unit :=
do
    nams ← get_all_theorems,
    def_nams ← list.mfilter is_definitions_as' nams,
    def_nams.mmap (λ h, tactic.trace h),
    return ()

meta def pprint_all_complete_goals : tactic unit :=
do
    tactic.trace_state

meta def print_all_complete_goals : tactic unit :=
do
  gs ← get_goals,
  gs.mmap' $ λ g, set_goals [g] >>
  local_context >>= mmap (λ h, analyse_expr h >>= trace),
  return ()

end tactic.interactive

variable X : Type
example {A A' : set X} : (A = A') ↔ ( ∀ x:X, x ∈ A ↔ x ∈ A' ) :=
begin
    hypo_analysis,
    targets_analysis,
end

lemma essai3 (P Q : Prop)   :  P ∨ Q → Q ∨ P :=
begin
    intro H,

end

------------ Théorie des ensembles --------------
%namespace set_theory

variables {X : Type} {Y : Type}
-- mem_compl_iff
--lemma complement {A : set X} {x : X} : x ∈ - A ↔ ¬ x ∈ A :=
--iff.rfl

lemma def.essai : true :=
begin
    print_all_theorems,
    print_all_as_theorems,
    print_all_is_as_theorems,
    print_all_is_as_theorems',
    print_all_definitions,
    tautology,
end

lemma essai (X : Type) (P Q : Prop) : P ∧ Q → P :=
begin
    hypo_analysis,

end

lemma definitions.complement {A : set X} {x : X} : x ∈ set.univ \ A ↔ x ∉ A :=
begin
    finish
end

lemma definitions.complement_1 {A : set X} {x : X} : x ∈ set.compl A ↔ x ∉ A :=
by finish

lemma exercises.toto (P Q : Prop) (H: P → Q): ∀ R: Prop, R → R :=
begin
    print_all_definitions,
    estcefl,
    intro H1,
    estcefl H1,
    estcefl,
    sorry
end

open tactic

example (y : ℕ) : true :=
by do e ← to_expr ```(∀ x : ℕ, y = 1), trace e, trace e.is_arrow, trace e.is_pi

example (X Y : Type) (A : set Y) (f : X → Y): ∀ x : X, ∃ y ∈ A, f x = y → y = f x :=
begin
--    interactive.goals_analysis,
    hypo_analysis,
    print_all_exercises,
    print_all_definitions,
    goals_analysis,
    estcefl f,
    estcefl,
    intros x y,
    estcefl,
end

#check is_prop

example (X Y I : Type) (y_1 : Y) (E : I → set X) : ∀ i' : I , ∀ x : E i',  ∀ f : (E i') → Y, f x = y_1 :=
begin
    targets_analysis,
end

#print set

example (X : Type) (x : X) (A : set $ set X)
 (B : X → Prop) (a : A) : X :=
begin
    hypo_analysis,

end

example (X : Type) (n : ℕ) (u : ℕ → X): tt :=
begin
    hypo_analysis
end

lemma exercise.union_distributive_inter (P Q R : Prop) : ( P → Q ) ∧ ( R → Q ) :=

begin
    split, intro HP,
    rotate, intro HR,
    print_all_complete_goals,

end

example : true ∧ ∀ x : ℕ, true :=
by do
  `[refine ⟨_, λ i, _⟩], -- give ourselves two goals with different local contexts
  trace_state,
  gs ← get_goals,
  gs.mmap' $ λ g, set_goals [g] >> local_context >>= trace,
  set_goals gs,
  trace_state

end


import data.quot tactic
open classical
noncomputable theory

variables (p : Type) {α : Type*} {β : Type*}

inductive eq' (a : α) : α → Type
| refl : eq' a
infix ` =' `:50 := eq'

def eq'.symm : ∀ {a b : α}, a =' b → b =' a
| _ _ (eq'.refl _) := (eq'.refl _)

def eq'.trans : ∀ {a b c : α}, a =' b → b =' c → a =' c
| _ _ _ (eq'.refl _) (eq'.refl _) := (eq'.refl _)

def eq'.congr_arg (f : α → β): ∀ {a b : α}, a =' b → f a =' f b
| _ _ (eq'.refl a) := eq'.refl _

def eq'.cast : ∀ {a b : Type}, a =' b → a → b
| _ _ (eq'.refl a) := id

def U (x : Type) : Type := trunc (trunc x =' trunc unit ⊕ p)
def V (x : Type) : Type := trunc (trunc x =' trunc empty ⊕ p)

def exU : trunc (Σ x : Type, U p x) := trunc.mk ⟨unit, trunc.mk $ sum.inl (eq'.refl _)⟩
def exV : trunc (Σ x : Type, V p x) := trunc.mk ⟨empty, trunc.mk $ sum.inl (eq'.refl _)⟩

axiom choice' {α  : Type*} {β : α → Type*} {r : Π x, β x → Type*}
  (f : Π i, trunc (Σ b : β i, r i b)) :
  trunc (Π i, Σ b : β i, r i b)

lemma choice'2 {α  : Type*} {β : α → Type*} (f : Π a, trunc (β a)) :
  trunc (Π a, β a) :=
let g : Π a, trunc (Σ b : β a, unit) := λ a, trunc.map (λ x, ⟨x, ()⟩) (f a) in
trunc.map (by intros g a; exact (g a).1) (choice' g)

lemma choice3 {α : Type*} : trunc (Σ f : α → α, Π a b : α, f a =' f b) :=
trunc.rec_on_subsingleton (choice'2 (@trunc.mk α))
begin

end

def not_uv_or_p : ∀ (u : Σ x : Type, U p x) (v : Σ x : Type, V p x),
  trunc ((trunc u.fst =' trunc v.fst → empty) ⊕ p) :=
begin
  rintros ⟨u, hu⟩ ⟨v, hv⟩,
  dsimp [U, V] at *,
  refine trunc.lift_on hu (λ hu, _) (λ _ _, subsingleton.elim _ _),
  refine trunc.lift_on hv (λ hv, _) (λ _ _, subsingleton.elim _ _),
  cases hu with hu hu,
  { cases hv with hv hv,
    { refine trunc.mk (sum.inl (λ e, _)),
      have : trunc unit =' trunc empty, from eq'.rec_on hu (eq'.rec_on hv e),
      have : trunc empty, from this.cast (trunc.mk ()),
      refine trunc.lift_on this id (assume a, by cases a) },
    { exact trunc.mk (sum.inr hv) } },
  { exact trunc.mk (sum.inr hu) }
end

axiom funext' {β : α → Type*}
  {f₁ f₂ : Π x : α, β x} (h : ∀ x, f₁ x =' f₂ x) : f₁ =' f₂

axiom univalence {α β : Sort*} : α ≃ β → α =' β

noncomputable lemma trunc_eq'_trunc_of_true {α β : Sort*} : α → β → trunc α =' trunc β :=
λ a b, univalence ⟨λ _, trunc.mk b, λ _, trunc.mk a, λ _, subsingleton.elim _ _,
  λ _, subsingleton.elim _ _⟩

-- noncomputable def p_implies_uv (hp : p) (u : Σ x : Type, U p x)
--   (v : Σ x : Type, V p x) : u.fst =' v.fst :=
-- begin
--   have : U p =' V p,
--   { refine funext' (λ x, _),
--     exact trunc_eq'_trunc_of_true (sum.inr hp) (sum.inr hp), },
--   revert u v,
--   refine eq'.rec_on this _,
--   assume u v,
--   exact trunc_eq'_trunc_of_true _ _,
-- end

noncomputable def em : trunc (p ⊕ (p → empty)) :=
let fU : trunc (Π {α : Type → Type → Type}, (Π p : Type, Σ x : Type, α p x)) :=
  choice'2 (λ α, choice' (λ p, _))  in
let fV : trunc (Π p : Type, Σ x : Type, V p x) := choice' exV in
trunc.rec_on_subsingleton fU (assume fU', trunc.rec_on_subsingleton fV (assume fV',
  let exU := fU' p, exV := fV' p in
  have p → trunc exU.1 =' trunc exV.1,
    from λ hp, have U p =' V p, from funext'
        (λ x, trunc_eq'_trunc_of_true (sum.inr hp) (sum.inr hp)),
      begin
        revert exU exV fU' fV',
        dsimp [fU, fV],
        refine eq'.rec_on this _,
        intros,
        exact trunc_eq'_trunc_of_true _ _,
      end,

  trunc.mk begin
    refine sum.rec_on (not_uv_or_p p(fU p) (fV p)) _ _,
    { assume h,
      exact sum.inr (assume hp : p, h (p_implies_uv p hp _ _)) },
    { exact sum.inl }
end))


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_403 :
  ∑ k in (nat.proper_divisors 198), k = 270 :=
begin
  refl,
end


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import category_theory.limits.shapes.finite_products
import category_theory.limits.shapes.zero_morphisms
import category_theory.limits.types
import category_theory.limits.mono_coprod

universe u

noncomputable theory

open category_theory category_theory.category category_theory.limits

namespace category_theory

namespace limits

variables {C : Type*} [category C] [has_finite_coproducts C]

variable {C}

namespace mono_coprod

namespace mono_inclusion_sub_coproduct

variables {I J : Type*} [fintype I] [decidable_eq I] [fintype J] [mono_coprod C] (X : I → C) (γ : J → I)
  (hγ : function.injective γ)

def α : sigma_obj (λ j, X (γ j)) ⟶ sigma_obj X := sigma.desc (λ j, sigma.ι _ (γ j))
def β : sigma_obj (λ (k : (finset.image γ ⊤)ᶜ), X k) ⟶ sigma_obj X := sigma.desc (λ k, sigma.ι _ k)
def φ := coprod.desc (α X γ) (β X γ)
def index (i : I) (hi : i ∈ finset.image γ ⊤) : J := (finset.mem_image.mp hi).some
lemma index_cond (i : I) (hi : i ∈ finset.image γ ⊤) : i = γ (index γ i hi) :=
(finset.mem_image.mp hi).some_spec.some_spec.symm

include hγ

lemma index_eq (i : I) (j : J) (hj : i = γ j) : index γ i (by { simp only [finset.mem_image],
  exact ⟨j, finset.mem_univ j, hj.symm⟩, }) = j :=
begin
  apply hγ,
  rw [← index_cond γ i, hj],
end

omit hγ

def ψ₁ (i : I) (hi : i ∈ finset.image γ ⊤) : X i ⟶ sigma_obj (λ j, X (γ j)) :=
eq_to_hom (by { congr, exact index_cond γ i hi,}) ≫ sigma.ι _ (index γ i hi)

lemma sigma.congr_ι {J D : Type*} [category D] (F : J → D) [has_coproduct F]
  (a b : J) (h : a = b) : eq_to_hom (by rw h) ≫ sigma.ι F a = sigma.ι F b :=
by { subst h, simp only [eq_to_hom_refl, id_comp], }

include hγ

lemma ψ₁_eq_ι (j : J) : ψ₁ X γ (γ j) (by { rw finset.mem_image, exact ⟨j, finset.mem_univ _, rfl⟩}) =
  sigma.ι _ j :=
sigma.congr_ι (λ (j : J), X (γ j)) (index γ (γ j) _) j (index_eq γ hγ (γ j) j rfl)

omit hγ

def ψ₂ (i : I) (hi : ¬ i ∈ (finset.image γ ⊤)) :
  X i ⟶ sigma_obj (λ (k : (finset.image γ ⊤)ᶜ), X k) :=
sigma.ι (λ (k : (finset.image γ ⊤)ᶜ), X k) ⟨i, by simpa only [finset.mem_compl] using hi⟩

def ψ : sigma_obj X ⟶ sigma_obj (λ j, X (γ j)) ⨿ sigma_obj (λ (k : (finset.image γ ⊤)ᶜ), X k) :=
sigma.desc (λ i, begin
  by_cases hi : i ∈ finset.image γ finset.univ,
  { exact ψ₁ X γ i hi ≫ coprod.inl, },
  { exact ψ₂ X γ i hi ≫ coprod.inr, },
end)

include hγ
@[simps]
def iso : sigma_obj (λ j, X (γ j)) ⨿ sigma_obj (λ (k : (finset.image γ ⊤)ᶜ), X k) ≅ sigma_obj X :=
{ hom := φ X γ,
  inv := ψ X γ,
  hom_inv_id' := begin
    dsimp only [φ, ψ, α, β],
    ext; discrete_cases,
    { rw [coprod.inl_desc_assoc, colimit.ι_desc_assoc, cofan.mk_ι_app, colimit.ι_desc,
        cofan.mk_ι_app, comp_id],
      dsimp,
      rw dif_pos, swap,
      { simp only [finset.mem_image],
        exact ⟨j, finset.mem_univ _, rfl⟩, },
      erw ψ₁_eq_ι X γ hγ j, },
    { rw [coprod.inr_desc_assoc, colimit.ι_desc_assoc, cofan.mk_ι_app, colimit.ι_desc,
        cofan.mk_ι_app, comp_id],
      dsimp,
      rw dif_neg, swap,
      { simpa only [finset.mem_compl] using j.2, },
      dsimp [ψ₂],
      congr,
      simp only [finset.mk_coe], },
  end,
  inv_hom_id' := begin
    dsimp only [φ, ψ, α, β],
    ext,
    discrete_cases,
    simp only [colimit.ι_desc_assoc, cofan.mk_ι_app, comp_id],
    dsimp only,
    split_ifs with hj,
    { simp [finset.mem_image] at hj,
      rcases hj with ⟨i, hi⟩,
      subst hi,
      erw ψ₁_eq_ι X γ hγ i,
      tidy },
    { dsimp [ψ₂],
      erw [category.assoc, coprod.inr_desc, colimit.ι_desc, cofan.mk_ι_app],
      refl, },
  end, }

end mono_inclusion_sub_coproduct

section

variables {I J : Type*} [fintype I] [fintype J] [mono_coprod C]
  (X : I → C) (γ : J → I)

@[simp]
def map_coproduct : sigma_obj (λ j, X (γ j)) ⟶ sigma_obj X := sigma.desc (λ j, sigma.ι _ (γ j))

lemma mono_inclusion_sub_coproduct (hγ : function.injective γ) : mono (map_coproduct X γ) :=
begin
  classical,
  let α : sigma_obj (λ j, X (γ j)) ⟶ sigma_obj X := sigma.desc
    (λ j, sigma.ι X (γ j)),
  change mono α,
  rw [show α = coprod.inl ≫ (mono_inclusion_sub_coproduct.iso X γ hγ).hom, by tidy],
  apply mono_comp,
end

end

instance mono_sigma_ι {I : Type*} [fintype I] [mono_coprod C] (X : I → C) (i : I):
  mono (sigma.ι X i) :=
begin
  let γ : fin 1 → I := λ x, i,
  have hγ : function.injective γ := λ x₁ x₂ h, subsingleton.elim _ _,
  let e : X i ≅ (∐ λ (j : fin 1), X (γ j)) :=
  { hom := sigma.ι (λ (j : fin 1), X (γ j)) 0,
    inv := sigma.desc (λ j, 𝟙 _),
    hom_inv_id' := by tidy,
    inv_hom_id' := by { ext, discrete_cases, tidy, }, },
  haveI := mono_inclusion_sub_coproduct X γ hγ,
  convert (mono_comp _ _ : mono (e.hom ≫ map_coproduct X γ)),
  simp only [map_coproduct, colimit.ι_desc, cofan.mk_ι_app],
end

end mono_coprod

end limits

end category_theory