import mynat.definition -- hide
import mynat.add -- hide
import game.world2.level5 -- hide
import tactic.ring -- hide
namespace mynat -- hide

/-

# Addition World

## Level 6: `add_right_comm`

Lean sometimes writes `a + b + c`. What does it mean? The convention is
that if there are no brackets displayed in an addition formula, the brackets
are around the left most `+` (Lean's addition is "left associative").
So the goal in this level is `(a + b) + c = (a + c) + b`. This isn't
quite `add_assoc` or `add_comm`, it's something you'll have to prove
by putting these two theorems together.

If you hadn't picked up on this already, `rw add_assoc` will
change `(x + y) + z` to `x + (y + z)`, but to change it back
you will need `rw ← add_assoc`. Get the left arrow by typing `\l`
then the space bar (note that this is L for left, not a number 1).
Similarly, if `h : a = b` then `rw h` will change `a`'s to `b`'s
and `rw ← h` will change `b`'s to `a`'s.

Also, you can be (and will need to be, in this level) more precise
about where to rewrite theorems. `rw add_comm,` will just find the
first `? + ?` it sees and swap it around. You can target more specific
additions like this: `rw add_comm a` will swap around
additions of the form `a + ?`, and `rw add_comm a b,` will only
swap additions of the form `a + b`.

## Where next?

There are thirteen more levels about addition after this one, but before
you can attempt them you need to learn some more tactics. So after this
level you have a choice -- either move on to Multiplication World (which you can
solve with the tactics you know) or try Function World (and learn some new ones).
After solving this level, click "Main Menu" in the top left to take you back
to the overworld, and make your choice. Other things, perhaps of interest
to some players, are mentioned below the lemma.
-/

/- Lemma
For all natural numbers $a, b$ and $c$, we have
$$ a + b + c = a + c + b. $$
-/
lemma add_right_comm (a b c : mynat) : a + b + c = a + c + b :=
begin [nat_num_game]
  rw add_assoc,
  rw add_comm b c,
  rw ←add_assoc,
  refl,
end

/-
If you have got this far, then you have become very good at
manipulating equalities in Lean. You can also now collect
four collectibles (or `instance`s, as Lean calls them)

```
mynat.add_semigroup -- (after level 2)
mynat.add_monoid -- (after level 2)
mynat.add_comm_semigroup mynat (after level 4)
mynat.add_comm_monoid -- (after level 4)
```

In Multiplication World you will be able to collect such
advanced collectibles as `mynat.comm_semiring` and
`mynat.distrib`, and then move on to power world and
the famous collectible at the end of it.

One last thing -- didn't you think that solving this level
`add_right_comm` was boring? Check out this AI that can do it for us.

First we have to get the `add_comm_monoid` collectible,
which we do by saying the magic words which make Lean's type class inference
system give it to us.
-/
instance : add_comm_monoid mynat := by structure_helper

/-
Now the `simp` AI becomes accessible (it's just an advanced
tactic really), and can nail some really tedious-for-a-human-to-solve
goals. For example check out this one-line proof:
-/

example (a b c d e : mynat) :
(((a+b)+c)+d)+e=(c+((b+e)+a))+d := begin
  simp
end

/-
Imagine having to do that one by hand! The AI closes the goal
because it knows how to use associativity and commutativity
sensibly in a commutative monoid.

You are now done with addition world. Go back to the main menu (top left)
and decide whether to press on with multiplication world and power world
(which can be solved with `rw`, `refl` and `induction`), or to go on
to Function World where you can learn the tactics needed to prove
goals of the form $P\implies Q$, thus enabling you to solve more
advanced addition world levels such as $a+t=b+t\implies a=b$. Note that
Function World is more challenging mathematically; but if you can do Addition
World you can surely do Multiplication World and Power World.
-/

end mynat -- hide

/- Tactic : simp

## Summary

The `simp` tactic is a high-level tactic which tries
to prove equalities using facts in its database (such
as `add_assoc` and `add_comm`).

## Details

The `simp` tactic does basic automation. By level 6 of
Addition World you
have proved enough about addition for `simp` to be able
to solve all equalities whose proofs involve a tedious number
of rewrites of `add_assoc` and `add_comm`, and by
level 9 of Multiplication World the same is true of `mul_assoc` and `mul_comm`.

### Example:
If our goal is this:
```
⊢ a + b + c + d + e = c + (b + e + a) + d
```

and you have completed addition world, then you've proved
enough about addition to solve this level with `simp`.
Note however that you can't prove `add_assoc` with `simp`,
because `add_assoc` is an ingredient to get `simp` working.

### Example:
If our goal is this:
```
⊢ a * b * c = c * b * a
```
then as long as you've completed Multiplication World, `simp` will close this
goal.
-/


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import algebra.algebra.basic
import algebra.order.nonneg.field
import algebra.order.nonneg.floor

/-!
# Nonnegative rationals

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

This file defines the nonnegative rationals as a subtype of `rat` and provides its algebraic order
structure.

We also define an instance `can_lift ℚ ℚ≥0`. This instance can be used by the `lift` tactic to
replace `x : ℚ` and `hx : 0 ≤ x` in the proof context with `x : ℚ≥0` while replacing all occurences
of `x` with `↑x`. This tactic also works for a function `f : α → ℚ` with a hypothesis
`hf : ∀ x, 0 ≤ f x`.

## Notation

`ℚ≥0` is notation for `nnrat` in locale `nnrat`.
-/

open function
open_locale big_operators

/-- Nonnegative rational numbers. -/
@[derive [canonically_ordered_comm_semiring, canonically_linear_ordered_semifield,
  linear_ordered_comm_group_with_zero, has_sub, has_ordered_sub,
  densely_ordered, archimedean, inhabited]]
def nnrat := {q : ℚ // 0 ≤ q}

localized "notation (name := nnrat) `ℚ≥0` := nnrat" in nnrat

namespace nnrat
variables {α : Type*} {p q : ℚ≥0}

instance : has_coe ℚ≥0 ℚ := ⟨subtype.val⟩

/- Simp lemma to put back `n.val` into the normal form given by the coercion. -/
@[simp] lemma val_eq_coe (q : ℚ≥0) : q.val = q := rfl

instance can_lift : can_lift ℚ ℚ≥0 coe (λ q, 0 ≤ q) :=
{ prf := λ q hq, ⟨⟨q, hq⟩, rfl⟩ }

@[ext] lemma ext : (p : ℚ) = (q : ℚ) → p = q := subtype.ext

protected lemma coe_injective : injective (coe : ℚ≥0 → ℚ) := subtype.coe_injective

@[simp, norm_cast] lemma coe_inj : (p : ℚ) = q ↔ p = q := subtype.coe_inj

lemma ext_iff : p = q ↔ (p : ℚ) = q := subtype.ext_iff

lemma ne_iff {x y : ℚ≥0} : (x : ℚ) ≠ (y : ℚ) ↔ x ≠ y := nnrat.coe_inj.not

@[norm_cast] lemma coe_mk (q : ℚ) (hq) : ((⟨q, hq⟩ : ℚ≥0) : ℚ) = q := rfl

/-- Reinterpret a rational number `q` as a non-negative rational number. Returns `0` if `q ≤ 0`. -/
def _root_.rat.to_nnrat (q : ℚ) : ℚ≥0 := ⟨max q 0, le_max_right _ _⟩

lemma _root_.rat.coe_to_nnrat (q : ℚ) (hq : 0 ≤ q) : (q.to_nnrat : ℚ) = q := max_eq_left hq

lemma _root_.rat.le_coe_to_nnrat (q : ℚ) : q ≤ q.to_nnrat := le_max_left _ _

open _root_.rat (to_nnrat)

@[simp] lemma coe_nonneg (q : ℚ≥0) : (0 : ℚ) ≤ q := q.2

@[simp, norm_cast] lemma coe_zero : ((0 : ℚ≥0) : ℚ) = 0 := rfl
@[simp, norm_cast] lemma coe_one  : ((1 : ℚ≥0) : ℚ) = 1 := rfl
@[simp, norm_cast] lemma coe_add (p q : ℚ≥0) : ((p + q : ℚ≥0) : ℚ) = p + q := rfl
@[simp, norm_cast]

@[simp] lemma coe_eq_zero : (q : ℚ) = 0 ↔ q = 0 := by norm_cast
lemma coe_ne_zero : (q : ℚ) ≠ 0 ↔ q ≠ 0 := coe_eq_zero.not

@[simp, norm_cast] lemma coe_le_coe : (p : ℚ) ≤ q ↔ p ≤ q := iff.rfl
@[simp, norm_cast] lemma coe_lt_coe : (p : ℚ) < q ↔ p < q := iff.rfl
@[simp, norm_cast] lemma coe_pos : (0 : ℚ) < q ↔ 0 < q := iff.rfl

lemma coe_mono : monotone (coe : ℚ≥0 → ℚ) := λ _ _, coe_le_coe.2

lemma to_nnrat_mono : monotone to_nnrat := λ x y h, max_le_max h le_rfl

@[simp] lemma to_nnrat_coe (q : ℚ≥0) : to_nnrat q = q := ext $ max_eq_left q.2

@[simp] lemma to_nnrat_coe_nat (n : ℕ) : to_nnrat n = n :=
ext $ by simp [rat.coe_to_nnrat]

/-- `to_nnrat` and `coe : ℚ≥0 → ℚ` form a Galois insertion. -/
protected def gi : galois_insertion to_nnrat coe :=
galois_insertion.monotone_intro coe_mono to_nnrat_mono rat.le_coe_to_nnrat to_nnrat_coe

/-- Coercion `ℚ≥0 → ℚ` as a `ring_hom`. -/
def coe_hom : ℚ≥0 →+* ℚ := ⟨coe, coe_one, coe_mul, coe_zero, coe_add⟩

@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : (↑(↑n : ℚ≥0) : ℚ) = n := map_nat_cast coe_hom n

@[simp] lemma mk_coe_nat (n : ℕ) : @eq ℚ≥0 (⟨(n : ℚ), n.cast_nonneg⟩ : ℚ≥0) n :=
ext (coe_nat_cast n).symm

/-- The rational numbers are an algebra over the non-negative rationals. -/
instance : algebra ℚ≥0 ℚ := coe_hom.to_algebra

/-- A `mul_action` over `ℚ` restricts to a `mul_action` over `ℚ≥0`. -/
instance [mul_action ℚ α] : mul_action ℚ≥0 α := mul_action.comp_hom α coe_hom.to_monoid_hom

/-- A `distrib_mul_action` over `ℚ` restricts to a `distrib_mul_action` over `ℚ≥0`. -/
instance [add_comm_monoid α] [distrib_mul_action ℚ α] : distrib_mul_action ℚ≥0 α :=
distrib_mul_action.comp_hom α coe_hom.to_monoid_hom

/-- A `module` over `ℚ` restricts to a `module` over `ℚ≥0`. -/
instance [add_comm_monoid α] [module ℚ α] : module ℚ≥0 α := module.comp_hom α coe_hom

@[simp] lemma coe_coe_hom : ⇑coe_hom = coe := rfl

@[simp, norm_cast] lemma coe_indicator (s : set α) (f : α → ℚ≥0) (a : α) :
  ((s.indicator f a : ℚ≥0) : ℚ) = s.indicator (λ x, f x) a :=
(coe_hom : ℚ≥0 →+ ℚ).map_indicator _ _ _

@[simp, norm_cast] lemma coe_pow (q : ℚ≥0) (n : ℕ) : (↑(q ^ n) : ℚ) = q ^ n := coe_hom.map_pow _ _

@[norm_cast] lemma coe_list_sum (l : list ℚ≥0) : (l.sum : ℚ) = (l.map coe).sum :=
coe_hom.map_list_sum _

@[norm_cast] lemma coe_list_prod (l : list ℚ≥0) : (l.prod : ℚ) = (l.map coe).prod :=
coe_hom.map_list_prod _

@[norm_cast] lemma coe_multiset_sum (s : multiset ℚ≥0) : (s.sum : ℚ) = (s.map coe).sum :=
coe_hom.map_multiset_sum _

@[norm_cast] lemma coe_multiset_prod (s : multiset ℚ≥0) : (s.prod : ℚ) = (s.map coe).prod :=
coe_hom.map_multiset_prod _

@[norm_cast] lemma coe_sum {s : finset α} {f : α → ℚ≥0} : ↑(∑ a in s, f a) = ∑ a in s, (f a : ℚ) :=
coe_hom.map_sum _ _

lemma to_nnrat_sum_of_nonneg {s : finset α} {f : α → ℚ} (hf : ∀ a, a ∈ s → 0 ≤ f a) :
  (∑ a in s, f a).to_nnrat = ∑ a in s, (f a).to_nnrat :=
begin
  rw [←coe_inj, coe_sum, rat.coe_to_nnrat _ (finset.sum_nonneg hf)],
  exact finset.sum_congr rfl (λ x hxs, by rw rat.coe_to_nnrat _ (hf x hxs)),
end

@[norm_cast] lemma coe_prod {s : finset α} {f : α → ℚ≥0} : ↑(∏ a in s, f a) = ∏ a in s, (f a : ℚ) :=
coe_hom.map_prod _ _

lemma to_nnrat_prod_of_nonneg {s : finset α} {f : α → ℚ} (hf : ∀ a ∈ s, 0 ≤ f a) :
  (∏ a in s, f a).to_nnrat = ∏ a in s, (f a).to_nnrat :=
begin
  rw [←coe_inj, coe_prod, rat.coe_to_nnrat _ (finset.prod_nonneg hf)],
  exact finset.prod_congr rfl (λ x hxs, by rw rat.coe_to_nnrat _ (hf x hxs)),
end

@[norm_cast] lemma nsmul_coe (q : ℚ≥0) (n : ℕ) : ↑(n • q) = n • (q : ℚ) :=
coe_hom.to_add_monoid_hom.map_nsmul _ _

lemma bdd_above_coe {s : set ℚ≥0} : bdd_above (coe '' s : set ℚ) ↔ bdd_above s :=
⟨λ ⟨b, hb⟩, ⟨to_nnrat b, λ ⟨y, hy⟩ hys, show y ≤ max b 0, from
    (hb $ set.mem_image_of_mem _ hys).trans $ le_max_left _ _⟩,
  λ ⟨b, hb⟩, ⟨b, λ y ⟨x, hx, eq⟩, eq ▸ hb hx⟩⟩

lemma bdd_below_coe (s : set ℚ≥0) : bdd_below ((coe : ℚ≥0 → ℚ) '' s) := ⟨0, λ r ⟨q, _, h⟩, h ▸ q.2⟩

@[simp, norm_cast] lemma coe_max (x y : ℚ≥0) : ((max x y : ℚ≥0) : ℚ) = max (x : ℚ) (y : ℚ) :=
coe_mono.map_max

@[simp, norm_cast] lemma coe_min (x y : ℚ≥0) : ((min x y : ℚ≥0) : ℚ) = min (x : ℚ) (y : ℚ) :=
coe_mono.map_min

lemma sub_def (p q : ℚ≥0) : p - q = to_nnrat (p - q) := rfl

@[simp] lemma abs_coe (q : ℚ≥0) : |(q : ℚ)| = q := abs_of_nonneg q.2

end nnrat

open nnrat

namespace rat
variables {p q : ℚ}

@[simp] lemma to_nnrat_zero : to_nnrat 0 = 0 := by simp [to_nnrat]; refl
@[simp] lemma to_nnrat_one : to_nnrat 1 = 1 := by simp [to_nnrat, max_eq_left zero_le_one]

@[simp] lemma to_nnrat_pos : 0 < to_nnrat q ↔ 0 < q := by simp [to_nnrat, ←coe_lt_coe]

@[simp] lemma to_nnrat_eq_zero : to_nnrat q = 0 ↔ q ≤ 0 :=
by simpa [-to_nnrat_pos] using (@to_nnrat_pos q).not

alias to_nnrat_eq_zero ↔ _ to_nnrat_of_nonpos

@[simp] lemma to_nnrat_le_to_nnrat_iff (hp : 0 ≤ p) : to_nnrat q ≤ to_nnrat p ↔ q ≤ p :=
by simp [←coe_le_coe, to_nnrat, hp]

@[simp] lemma to_nnrat_lt_to_nnrat_iff' : to_nnrat q < to_nnrat p ↔ q < p ∧ 0 < p :=
by { simp [←coe_lt_coe, to_nnrat, lt_irrefl], exact lt_trans' }

lemma to_nnrat_lt_to_nnrat_iff (h : 0 < p) : to_nnrat q < to_nnrat p ↔ q < p :=
to_nnrat_lt_to_nnrat_iff'.trans (and_iff_left h)

lemma to_nnrat_lt_to_nnrat_iff_of_nonneg (hq : 0 ≤ q) : to_nnrat q < to_nnrat p ↔ q < p :=
to_nnrat_lt_to_nnrat_iff'.trans ⟨and.left, λ h, ⟨h, hq.trans_lt h⟩⟩

@[simp] lemma to_nnrat_add (hq : 0 ≤ q) (hp : 0 ≤ p) : to_nnrat (q + p) = to_nnrat q + to_nnrat p :=
nnrat.ext $ by simp [to_nnrat, hq, hp, add_nonneg]

lemma to_nnrat_add_le : to_nnrat (q + p) ≤ to_nnrat q + to_nnrat p :=
coe_le_coe.1 $ max_le (add_le_add (le_max_left _ _) (le_max_left _ _)) $ coe_nonneg _

lemma to_nnrat_le_iff_le_coe {p : ℚ≥0} : to_nnrat q ≤ p ↔ q ≤ ↑p := nnrat.gi.gc q p

lemma le_to_nnrat_iff_coe_le {q : ℚ≥0} (hp : 0 ≤ p) : q ≤ to_nnrat p ↔ ↑q ≤ p :=
by rw [←coe_le_coe, rat.coe_to_nnrat p hp]

lemma le_to_nnrat_iff_coe_le' {q : ℚ≥0} (hq : 0 < q) : q ≤ to_nnrat p ↔ ↑q ≤ p :=
(le_or_lt 0 p).elim le_to_nnrat_iff_coe_le $ λ hp,
  by simp only [(hp.trans_le q.coe_nonneg).not_le, to_nnrat_eq_zero.2 hp.le, hq.not_le]

lemma to_nnrat_lt_iff_lt_coe {p : ℚ≥0} (hq : 0 ≤ q) : to_nnrat q < p ↔ q < ↑p :=
by rw [←coe_lt_coe, rat.coe_to_nnrat q hq]

lemma lt_to_nnrat_iff_coe_lt {q : ℚ≥0} : q < to_nnrat p ↔ ↑q < p := nnrat.gi.gc.lt_iff_lt

@[simp] lemma to_nnrat_bit0 (hq : 0 ≤ q) : to_nnrat (bit0 q) = bit0 (to_nnrat q) :=
to_nnrat_add hq hq

@[simp] lemma to_nnrat_bit1 (hq : 0 ≤ q) : to_nnrat (bit1 q) = bit1 (to_nnrat q) :=
(to_nnrat_add (by simp [hq]) zero_le_one).trans $ by simp [to_nnrat_one, bit1, hq]

lemma to_nnrat_mul (hp : 0 ≤ p) : to_nnrat (p * q) = to_nnrat p * to_nnrat q :=
begin
  cases le_total 0 q with hq hq,
  { ext; simp [to_nnrat, hp, hq, max_eq_left, mul_nonneg] },
  { have hpq := mul_nonpos_of_nonneg_of_nonpos hp hq,
    rw [to_nnrat_eq_zero.2 hq, to_nnrat_eq_zero.2 hpq, mul_zero] }
end

lemma to_nnrat_inv (q : ℚ) : to_nnrat q⁻¹ = (to_nnrat q)⁻¹ :=
begin
  obtain hq | hq := le_total q 0,
  { rw [to_nnrat_eq_zero.mpr hq, inv_zero, to_nnrat_eq_zero.mpr (inv_nonpos.mpr hq)] },
  { nth_rewrite 0 ←rat.coe_to_nnrat q hq,
    rw [←coe_inv, to_nnrat_coe] }
end

lemma to_nnrat_div (hp : 0 ≤ p) : to_nnrat (p / q) = to_nnrat p / to_nnrat q :=
by rw [div_eq_mul_inv, div_eq_mul_inv, ←to_nnrat_inv, ←to_nnrat_mul hp]

lemma to_nnrat_div' (hq : 0 ≤ q) : to_nnrat (p / q) = to_nnrat p / to_nnrat q :=
by rw [div_eq_inv_mul, div_eq_inv_mul, to_nnrat_mul (inv_nonneg.2 hq), to_nnrat_inv]

end rat

/-- The absolute value on `ℚ` as a map to `ℚ≥0`. -/
@[pp_nodot] def rat.nnabs (x : ℚ) : ℚ≥0 := ⟨abs x, abs_nonneg x⟩

@[norm_cast, simp] lemma rat.coe_nnabs (x : ℚ) : (rat.nnabs x : ℚ) = abs x := by simp [rat.nnabs]

/-! ### Numerator and denominator -/

namespace nnrat
variables {p q : ℚ≥0}

/-- The numerator of a nonnegative rational. -/
def num (q : ℚ≥0) : ℕ := (q : ℚ).num.nat_abs

/-- The denominator of a nonnegative rational. -/
def denom (q : ℚ≥0) : ℕ := (q : ℚ).denom

@[simp] lemma nat_abs_num_coe : (q : ℚ).num.nat_abs = q.num := rfl
@[simp] lemma denom_coe : (q : ℚ).denom = q.denom := rfl

lemma ext_num_denom (hn : p.num = q.num) (hd : p.denom = q.denom) : p = q :=
ext $ rat.ext ((int.nat_abs_inj_of_nonneg_of_nonneg
  (rat.num_nonneg_iff_zero_le.2 p.2) $ rat.num_nonneg_iff_zero_le.2 q.2).1 hn) hd

lemma ext_num_denom_iff : p = q ↔ p.num = q.num ∧ p.denom = q.denom :=
⟨by { rintro rfl, exact ⟨rfl, rfl⟩ }, λ h, ext_num_denom h.1 h.2⟩

@[simp] lemma num_div_denom (q : ℚ≥0) : (q.num : ℚ≥0) / q.denom = q :=
begin
  ext1,
  rw [coe_div, coe_nat_cast, coe_nat_cast, num, ←int.cast_coe_nat,
    int.nat_abs_of_nonneg (rat.num_nonneg_iff_zero_le.2 q.prop)],
  exact rat.num_div_denom q,
end

/-- A recursor for nonnegative rationals in terms of numerators and denominators. -/
protected def rec {α : ℚ≥0 → Sort*} (h : Π m n : ℕ, α (m / n)) (q : ℚ≥0) : α q :=
(num_div_denom _).rec (h _ _)

end nnrat


/-
Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------

# Algebra of Functions: Part II
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import ..prooflab
import .lec3_function

set_option pp.beta true
set_option pp.generalized_field_notation false
-- set_option pp.all true

/-
New tactic we'll learn in this lesson:
8. funext
9. linarith
-/

namespace PROOFS

variables {A B C X Y Z U V W : Type} -- curly brackets make type implicit and that is what you get things like M_1? ...

/-! ### Functions evaluation

**Question**: What did all the functions we defined in the previous lecture have in common?

**Answer** : They all had one input and one output.
-/

#check rational_sum_of_squares -- one input one output

/-
We can __evaluate__ a function at an input by applying the function to it.
-/

#check double
#eval double 7
#check double_alt -- the domain of this function is natural numbers and the codomain of this function is natural numbers.
#reduce double_alt -- this function takes one input and returns one output, but it uses in its definition the function `nat.add` which takes 2 inputs and 1 output.
#check nat.add

-- #eval double_alt 7

/-
__The output of a function can be a function__: A function `f : A → B → C` should be read as a function `f : A → (B → C)` where for any input `a : A`, the output is a function `f a : B → C` which upon receiving an input `b : B` returns the ouput `f a b : C`.

Given this, there are two things we should be careful about:
1. Functions can be
* __fully applied__ (e.g., `f a b` if `f` is binary);
* __partially applied__ (e.g., `f a`);
* __left unapplied__ (e.g., `f`).

2. Evaluation/application is __left-associative__: `f a b` = `((f a) b)`.
-/

#check nat.add -- the type of `nat.add` is `ℕ → ℕ → ℕ` which is implicitly understood by Lean to be `ℕ → (ℕ → ℕ)`
#check nat.add 1
#check nat.add 1 2
#eval nat.add 1 2
#eval nat.add 1 (2)

def mul_square (m n : ℕ) :=
m * m * n * n

#check mul_square
#check mul_square 1 -- the type of `mul_square 1` is `ℕ → ℕ`

/-Question: what does the function `mul_square 1` do?  -/

/- The following functions from mathlib all take 2 inputs and return 1 output -/
#check nat.add
#check nat.mul
#check nat.le -- is a function which takes two natural number and returns a proposition. `nat.le m n` is the proposition that `m ≤ n`. `le` is short for less than or equal to.
#check int.add
#check int.mul
#check rat.add
#check rat.mul

def sum_squares (m n : ℕ) :=
m * m + n * n

#check sum_squares
-- #check sum_squares 1
#check sum_squares 1 2
#eval sum_squares 1 2

def fst_fun (x : X) :=
λ (y : Y), x -- the input is of type `X` and the output is a function. the domain is `X` and the codomain `Y → X`.

-- What is the type of fst_fun? And what does it do?
#check fst_fun
#check @fst_fun -- for all types `X` and `Y` the type of `fst_fun` is `X → Y → X`.

def fst_fun_alt (x : X) (y : Y) :=
x
-- What is the type of fst_fun_alt? And what does it do?
#check fst_fun_alt
#check @fst_fun_alt -- make it explicit

#check fst_fun_alt 17 4
#eval fst_fun_alt 17 4

#check fst_fun_alt 17
#check @fst_fun 17 -- why can we not make the second variable explicit? we'll come back to this in the next lecture.

-- CHALLENGE: define the second projection
def snd_fun  : X → Y → Y :=
λ x, λ y, y
-- the domain of `fst_fun` and `snd_fun` are the same but not their codomain.

-- #check snd_fun
section
variables (x : X) (y : Y)
#check snd_fun x y
-- #eval snd_fun x y
end

def fst (p : X × Y) :=
p.1
-- for a pair `p`, i.e. a term of type `X × Y` the output of `fst` is the first coordinate of `p` which we access using projection `.1`.

-- #check fst
-- #check fst
-- #check fst (1 , 2)
#check fst (2, 1)
#eval fst (2, 1)

def snd (p : X × Y) :=
p.2

/-! ### Examples of a function which take a function as its argument -/

def evaluation (f : X → Y) (x : X) := f x
#check evaluation
#eval evaluation double 3

-- CHALLENGE: Write `evaluation` in the lambda notation.

-- `pairing` is a function which takes as input two functions.
def pairing (f : Z → X) (g : Z → Y) (z : Z) : X × Y :=
(f z , g z)

section
variable f : Z → X
variable g : Z → Y
#check pairing f g
end

def pairing_alt (f : Z → X) (g : Z → Y)  :=
λ z, (f z , g z) -- abstracting over z

section
variables (f : Z → X) (g : Z → Y)
#check λ z, (f z , g z)
end

/-
Question: What does the function `pairing switch nat_of_bool` do?
-/
#check pairing switch nat_of_bool
#eval pairing switch nat_of_bool ff
#eval pairing switch nat_of_bool tt

/-
Question: What does the function `pairing double bool_of_nat` do?
-/
-- #check pairing double bool_of_nat

/-
Question: What does the function `cartesian_prod` do?
-/
def cartesian_prod (f : A → B) (g : X → Y) : A × X → B × Y :=
λ p, (f p.1, g p.2)

def decouple (f : Z → X × Y) : (Z → X) × (Z → Y) :=
(λ z, (f z).1, λ z, (f z).2)

/-
Question: What does the function `decouple` do?
-/

-- #check decouple (pairing switch nat_of_bool)
-- #check decouple (pairing switch nat_of_bool)

def swap (x : X) (y : Y) :=
(y , x)

/-
Question: What does the function `swap` do?
-/

-- #check swap

section
-- #check swap 2 4
-- #eval swap 2 4
end

def swap_pair (X Y : Type) : X × Y → Y × X :=
λ a, (a.2, a.1)

/-
Question: What does the function `swap_pair` do?
-/

#check swap_pair
--#check swap_pair (7,3)
--#eval swap_pair (7,3)

def swap_pair_alt {X Y : Type} : X × Y → Y × X :=
λ a, (a.2, a.1)

example :
  swap_pair_alt ( swap_pair_alt (1, 3) ) = (1,3)  :=
begin
  refl,
end

def copy (x : X) : X × X :=
(x, x)

#check copy
#check @copy

def curry : (X × Y → Z) → (X → (Y → Z)) :=
 λf, λ x, λ y, f (x, y)

#check curry
#check @curry
#check @curry X Y Z

def uncurry : (X → (Y → Z)) → (X × Y → Z) :=
λ f, λ p, f p.1 p.2
#check @uncurry
#check @uncurry X Y Z

#check curry ∘ uncurry
#check @curry X Y Z ∘ @uncurry X Y Z

example :
  @curry X Y Z  ∘ @uncurry X Y Z = id :=
begin
  funext f x y,
  dsimp,
  unfold uncurry,
  unfold curry,
end

example :
  @uncurry X Y Z  ∘ @curry X Y Z = id :=
begin
  sorry,
end

--#check curry fst
--#check (curry fst) ff 2
--#eval (curry fst) ff 2
-- #check uncurry (curry fst) (ff, 2) -- why?

/- We use `uncurry` to define the product projections from `fst_fun` and `snd_fun`. -/

#check fst_fun
#check uncurry

-- Challenge: Fix the following definition
def fst_alt (f) :=
uncurry (fst_fun f)

#check fst_alt

/-
Question: What does the function `my_complicated_function` do?
-/
def my_complicated_function : (X → Y → Z) → ((Y → X) → Y) → X → Z :=
λ f g x, f x (g (λy, x))

/-! ### Equality of Functions
Once we have defined functions (or anything) in Lean we can prove properties of them: For instance we might want to prove two functions are equal to each other.

__Function Extensionality__ is a logical principle which says that we can prove two functions `f : X → Y` and `g : X → Y`  (with the same domain and the same codomain) are equal (written as `f = g` ) if for all elements `x : X` we have a proof of `f x = g x`. In Lean, this is `funext`. Here's a little secret: `funext` is assumed in Lean so we do not need to be explicit about it when we use it.
-/

example : (λ n : ℕ, (2 * n)) = (λ n: ℕ, n + n) :=
begin
 funext x, -- we fix x : ℕ (alternatively, let n: ℕ be given)
 rw two_mul, -- we need to prove 2 * n = n + n which is proved by lemma `two_mul`
end

example : (λ n : ℕ, (2 * n)) = (λ n: ℕ, n + n) :=
begin
 funext x, -- we fix x : ℕ (alternatively, let n: ℕ be given)
 rw ← two_mul,
 -- we need to prove 2 * n = n + n which is proved by lemma `two_mul`
end

example : (λ n : ℕ, (2 * n)) = (λ n: ℕ, n + n) :=
begin
 funext, -- we fix n : ℕ (alternatively, let n: ℕ be given)
 exact two_mul n,
end

example : (λ n : ℕ, (2 * n)) = (λ n: ℕ, n + n) :=
begin
funext,
-- After ext, we must show that given x : ℕ, we have 2 * x = x + x
-- refl, note that refl does not work. what error do you get if you try refl after ext?
ring,
end

example : (λ n : ℕ, (2 * n)) = (λ n: ℕ, n + n) :=
begin
funext,
-- After ext, we must show that given x : ℕ, we have 2 * x = x + x
-- refl, note that refl does not work. what error do you get if you try refl after ext?
ring,
end

example :
  mul_square 1 = square :=
begin
  ext a,
  rw mul_square,
  rw square,
  ring,
end

#check two_mul

example : double = double_alt :=
begin
funext x,
rw double,
rw double_alt,
exact two_mul x,
end

example : double = double_alt :=
begin
-- ext n, -- instead of the default variable name x : ℕ , we use n : ℕ.
ext n,
rw double,
rw double_alt,
linarith,  -- we cannot use `ring` here, since natural numbers do not form a ring (recall that a ring). `linarith` is for linear arithmetic.
end

lemma fun_cong_two_args (a a' b b' : X)
    (f : X → X → X) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
begin
  rw ha,
  rw hb,
end

/-! ### Functions out of empty type
There is a type which is called the __empty__ type and is denoted by `empty` in Lean. This type does not have any terms in it. Therefore, to specify a function with domain `empty` and codomain `X` (for any type `X`) we do not need to do anything, since there is no term in `empty` for which we need to return a term of `X`. Therefore, there is always a function `empty → X` for any type `X`.
-/

#check empty.elim
#check (empty.elim : empty → X)

/- Let's prove that any two functions of type `empty → X` are equal. Therefore, there is a __unique__ function `empty → X`. -/

lemma empty_unique_fun (f g : empty → X) :
  f = g :=
begin
  funext,
  exact empty.elim x,
end

/-! ### Functions out of unit type
There is a type which is called the __unit__ type and is denoted by `unit` in Lean. This type has exactly one term in it which is `unit.star`.
-/

#check unit
#print unit
#check unit.star

/- To specify a function with domain `unit` and codomain `X` (for any type `X`) we need to specify which term of `X` is assigned to `unit.star`, in other words which term of `X` does this function return for the input `unit.star`. Therefore there are as many functions `unit → X` as the terms/elements of `X`-/

#check trivial

def elem_fun (x : X) : unit → X :=
λ _, x

#check elem_fun

#check elem_fun ff
#check elem_fun tt

end PROOFS


/-
Copyright (c) 2021 Hanting Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hanting Zhang
-/
import analysis.special_functions.integrals

/-! ### The Wallis Product for Pi -/

namespace real

open_locale real topological_space big_operators
open filter finset interval_integral

lemma integral_sin_pow_div_tendsto_one :
  tendsto (λ k, (∫ x in 0..π, sin x ^ (2 * k + 1)) / ∫ x in 0..π, sin x ^ (2 * k)) at_top (𝓝 1) :=
begin
  have h₃ : ∀ n, (∫ x in 0..π, sin x ^ (2 * n + 1)) / ∫ x in 0..π, sin x ^ (2 * n) ≤ 1 :=
    λ n, (div_le_one (integral_sin_pow_pos _)).mpr (integral_sin_pow_succ_le _),
  have h₄ :
    ∀ n, (∫ x in 0..π, sin x ^ (2 * n + 1)) / ∫ x in 0..π, sin x ^ (2 * n) ≥ 2 * n / (2 * n + 1),
  { rintro ⟨n⟩,
    { have : 0 ≤ (1 + 1) / π, exact div_nonneg (by norm_num) pi_pos.le,
      simp [this] },
    calc (∫ x in 0..π, sin x ^ (2 * n.succ + 1)) / ∫ x in 0..π, sin x ^ (2 * n.succ) ≥
      (∫ x in 0..π, sin x ^ (2 * n.succ + 1)) / ∫ x in 0..π, sin x ^ (2 * n + 1) :
      by { refine div_le_div (integral_sin_pow_pos _).le le_rfl (integral_sin_pow_pos _) _,
        convert integral_sin_pow_succ_le (2 * n + 1) using 1 }
    ... = 2 * ↑(n.succ) / (2 * ↑(n.succ) + 1) :
      by { rw div_eq_iff (integral_sin_pow_pos (2 * n + 1)).ne',
           convert integral_sin_pow (2 * n + 1), simp with field_simps, norm_cast } },
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le _ _ (λ n, (h₄ n).le) (λ n, (h₃ n)),
  { refine metric.tendsto_at_top.mpr (λ ε hε, ⟨⌈1 / ε⌉₊, λ n hn, _⟩),
    have h : (2:ℝ) * n / (2 * n + 1) - 1 = -1 / (2 * n + 1),
    { conv_lhs { congr, skip, rw ← @div_self _ _ ((2:ℝ) * n + 1) (by { norm_cast, linarith }), },
      rw [← sub_div, ← sub_sub, sub_self, zero_sub] },
    have hpos : (0:ℝ) < 2 * n + 1, { norm_cast, norm_num },
    rw [dist_eq, h, abs_div, abs_neg, abs_one, abs_of_pos hpos, one_div_lt hpos hε],
    calc 1 / ε ≤ ⌈1 / ε⌉₊ : nat.le_ceil _
          ... ≤ n : by exact_mod_cast hn.le
          ... < 2 * n + 1 : by { norm_cast, linarith } },
  { exact tendsto_const_nhds },
end

/-- This theorem establishes the Wallis Product for `π`. Our proof is largely about analyzing
  the behavior of the ratio of the integral of `sin x ^ n` as `n → ∞`.
  See: https://en.wikipedia.org/wiki/Wallis_product

  The proof can be broken down into two pieces.
  (Pieces involving general properties of the integral of `sin x ^n` can be found
  in `analysis.special_functions.integrals`.) First, we use integration by parts to obtain a
  recursive formula for `∫ x in 0..π, sin x ^ (n + 2)` in terms of `∫ x in 0..π, sin x ^ n`.
  From this we can obtain closed form products of `∫ x in 0..π, sin x ^ (2 * n)` and
  `∫ x in 0..π, sin x ^ (2 * n + 1)` via induction. Next, we study the behavior of the ratio
  `∫ (x : ℝ) in 0..π, sin x ^ (2 * k + 1)) / ∫ (x : ℝ) in 0..π, sin x ^ (2 * k)` and prove that
  it converges to one using the squeeze theorem. The final product for `π` is obtained after some
  algebraic manipulation. -/
theorem tendsto_prod_pi_div_two :
  tendsto (λ k, ∏ i in range k,
    (((2:ℝ) * i + 2) / (2 * i + 1)) * ((2 * i + 2) / (2 * i + 3))) at_top (𝓝 (π/2)) :=
begin
  suffices h : tendsto (λ k, 2 / π  * ∏ i in range k,
    (((2:ℝ) * i + 2) / (2 * i + 1)) * ((2 * i + 2) / (2 * i + 3))) at_top (𝓝 1),
  { have := tendsto.const_mul (π / 2) h,
    have h : π / 2 ≠ 0, norm_num [pi_ne_zero],
    simp only [← mul_assoc, ← @inv_div _ _ π 2, mul_inv_cancel h, one_mul, mul_one] at this,
    exact this },
  have h : (λ (k : ℕ), (2:ℝ) / π * ∏ (i : ℕ) in range k,
    ((2 * i + 2) / (2 * i + 1)) * ((2 * i + 2) / (2 * i + 3))) =
  λ k, (2 * ∏ i in range k,
    (2 * i + 2) / (2 * i + 3)) / (π * ∏ (i : ℕ) in range k, (2 * i + 1) / (2 * i + 2)),
  { funext,
    have h : ∏ (i : ℕ) in range k, ((2:ℝ) * ↑i + 2) / (2 * ↑i + 1) =
      1 / (∏ (i : ℕ) in range k, (2 * ↑i + 1) / (2 * ↑i + 2)),
    { rw [one_div, ← finset.prod_inv_distrib'],
      refine prod_congr rfl (λ x hx, _),
      field_simp },
    rw [prod_mul_distrib, h],
    field_simp },
  simp only [h, ← integral_sin_pow_even, ← integral_sin_pow_odd],
  exact integral_sin_pow_div_tendsto_one,
end

end real


import algebra.module.basic
import algebra.module.linear_map
import ring_theory.flat
import tactic

universes u v

namespace module
open function (injective)
open linear_map (lsmul)

open_locale tensor_product

variables (M N P: Type v) (R: Type u) [comm_ring R]
[add_comm_group M] [module R M]
[add_comm_group N] [module R N]
[add_comm_group P] [module R P]
(f : M →ₗ[R] N) [flat R P]

lemma main_result : injective f → injective (tensor_product.map (@linear_map.id R P _ _ _) f) :=
begin
intro h,
sorry
end

lemma lemma1 (h : ∀(x : M), x = 0) : subsingleton M :=
begin
apply subsingleton.intro,
intros a b,
simp [h a, h b]
end

lemma lemma2 (h :subsingleton M) : subsingleton (M ⊗[R] N) :=
begin
apply subsingleton.intro,
intros x y,
sorry
end

-- Want to define a function which takes an element x of a vectorspace, and a spanning set, and
-- returns a hypothesis that allows one to rewrite x in terms of said linear combination.

open_locale big_operators

def test_function (x : M) (s : set M) (h : submodule.span R s = ⊤)
: ∃(I : finset s), x = ∑ a in I, a :=
begin
have H : x ∈ submodule.span R s := by {rw h, exact submodule.mem_top},
have H2 := @submodule.mem_span_finite_of_mem_span R M _ _ _ s x H,
cases H2 with s' h,
apply exists.intro;
sorry
end

lemma in_span (x : M) (s : finset M) (h : x ∈ submodule.span R (s : set M)) : ∃(coeff : M → R),
x = ∑ m in s, (coeff m) • m :=
begin
have H := submodule.mem_span_finite_of_mem_span h,
end
end module

variable (S : finset ℕ)

-- mem_span_finite_of_mem_span seems important

variables (M : Type v) (R: Type u) [comm_ring R]
[add_comm_group M] [module R M] (s : set M) (s' : finset s) (a : s)

#check (a : M)

#check @submodule.mem_span_finite_of_mem_span R M _ _ _ s
#check @exists.intro s'

#check @finset.sum M s _ s'

#check span_induction


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Andrew Zipperer, Haitao Zhang, Minchao Wu, Yury Kudryashov
-/
import data.set.basic
import logic.function.conjugate

/-!
# Functions over sets

## Main definitions

### Predicate

* `eq_on f₁ f₂ s` : functions `f₁` and `f₂` are equal at every point of `s`;
* `maps_to f s t` : `f` sends every point of `s` to a point of `t`;
* `inj_on f s` : restriction of `f` to `s` is injective;
* `surj_on f s t` : every point in `s` has a preimage in `s`;
* `bij_on f s t` : `f` is a bijection between `s` and `t`;
* `left_inv_on f' f s` : for every `x ∈ s` we have `f' (f x) = x`;
* `right_inv_on f' f t` : for every `y ∈ t` we have `f (f' y) = y`;
* `inv_on f' f s t` : `f'` is a two-side inverse of `f` on `s` and `t`, i.e.
  we have `left_inv_on f' f s` and `right_inv_on f' f t`.

### Functions

* `restrict f s` : restrict the domain of `f` to the set `s`;
* `cod_restrict f s h` : given `h : ∀ x, f x ∈ s`, restrict the codomain of `f` to the set `s`;
* `maps_to.restrict f s t h`: given `h : maps_to f s t`, restrict the domain of `f` to `s`
  and the codomain to `t`.
-/
universes u v w x y

variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

open function

namespace set

/-! ### Restrict -/

/-- Restrict domain of a function `f` to a set `s`. Same as `subtype.restrict` but this version
takes an argument `↥s` instead of `subtype s`. -/
def restrict (f : α → β) (s : set α) : s → β := λ x, f x

lemma restrict_eq (f : α → β) (s : set α) : s.restrict f = f ∘ coe := rfl

@[simp] lemma restrict_apply (f : α → β) (s : set α) (x : s) : restrict f s x = f x := rfl

@[simp] lemma range_restrict (f : α → β) (s : set α) : set.range (restrict f s) = f '' s :=
(range_comp _ _).trans $ congr_arg (('') f) subtype.range_coe

lemma image_restrict (f : α → β) (s t : set α) : s.restrict f '' (coe ⁻¹' t) = f '' (t ∩ s) :=
by rw [restrict, image_comp, image_preimage_eq_inter_range, subtype.range_coe]

/-- Restrict codomain of a function `f` to a set `s`. Same as `subtype.coind` but this version
has codomain `↥s` instead of `subtype s`. -/
def cod_restrict (f : α → β) (s : set β) (h : ∀ x, f x ∈ s) : α → s :=
λ x, ⟨f x, h x⟩

@[simp] lemma coe_cod_restrict_apply (f : α → β) (s : set β) (h : ∀ x, f x ∈ s) (x : α) :
  (cod_restrict f s h x : β) = f x :=
rfl

variables {s s₁ s₂ : set α} {t t₁ t₂ : set β} {p : set γ} {f f₁ f₂ f₃ : α → β} {g : β → γ}
  {f' f₁' f₂' : β → α} {g' : γ → β}

/-! ### Equality on a set -/

/-- Two functions `f₁ f₂ : α → β` are equal on `s`
  if `f₁ x = f₂ x` for all `x ∈ a`. -/
@[reducible] def eq_on (f₁ f₂ : α → β) (s : set α) : Prop :=
∀ ⦃x⦄, x ∈ s → f₁ x = f₂ x

@[simp] lemma eq_on_empty (f₁ f₂ : α → β) : eq_on f₁ f₂ ∅ := λ x, false.elim

@[symm] lemma eq_on.symm (h : eq_on f₁ f₂ s) : eq_on f₂ f₁ s :=
λ x hx, (h hx).symm

lemma eq_on_comm : eq_on f₁ f₂ s ↔ eq_on f₂ f₁ s :=
⟨eq_on.symm, eq_on.symm⟩

@[refl] lemma eq_on_refl (f : α → β) (s : set α) : eq_on f f s :=
λ _ _, rfl

@[trans] lemma eq_on.trans (h₁ : eq_on f₁ f₂ s) (h₂ : eq_on f₂ f₃ s) : eq_on f₁ f₃ s :=
λ x hx, (h₁ hx).trans (h₂ hx)

theorem eq_on.image_eq (heq : eq_on f₁ f₂ s) : f₁ '' s = f₂ '' s :=
image_congr heq

theorem eq_on.inter_preimage_eq (heq : eq_on f₁ f₂ s) (t : set β) : s ∩ f₁ ⁻¹' t = s ∩ f₂ ⁻¹' t :=
ext $ λ x, and.congr_right_iff.2 $ λ hx, by rw [mem_preimage, mem_preimage, heq hx]

lemma eq_on.mono (hs : s₁ ⊆ s₂) (hf : eq_on f₁ f₂ s₂) : eq_on f₁ f₂ s₁ :=
λ x hx, hf (hs hx)

lemma comp_eq_of_eq_on_range {ι : Sort*} {f : ι → α} {g₁ g₂ : α → β} (h : eq_on g₁ g₂ (range f)) :
  g₁ ∘ f = g₂ ∘ f :=
funext $ λ x, h $ mem_range_self _

/-! ### maps to -/

/-- `maps_to f a b` means that the image of `a` is contained in `b`. -/
@[reducible] def maps_to (f : α → β) (s : set α) (t : set β) : Prop := ∀ ⦃x⦄, x ∈ s → f x ∈ t

/-- Given a map `f` sending `s : set α` into `t : set β`, restrict domain of `f` to `s`
and the codomain to `t`. Same as `subtype.map`. -/
def maps_to.restrict (f : α → β) (s : set α) (t : set β) (h : maps_to f s t) :
  s → t :=
subtype.map f h

@[simp] lemma maps_to.coe_restrict_apply (h : maps_to f s t) (x : s) :
  (h.restrict f s t x : β) = f x := rfl

lemma maps_to_iff_exists_map_subtype : maps_to f s t ↔ ∃ g : s → t, ∀ x : s, f x = g x :=
⟨λ h, ⟨h.restrict f s t, λ _, rfl⟩,
  λ ⟨g, hg⟩ x hx, by { erw [hg ⟨x, hx⟩], apply subtype.coe_prop }⟩

theorem maps_to' : maps_to f s t ↔ f '' s ⊆ t :=
image_subset_iff.symm

theorem maps_to_empty (f : α → β) (t : set β) : maps_to f ∅ t := empty_subset _

theorem maps_to.image_subset (h : maps_to f s t) : f '' s ⊆ t :=
maps_to'.1 h

theorem maps_to.congr (h₁ : maps_to f₁ s t) (h : eq_on f₁ f₂ s) :
  maps_to f₂ s t :=
λ x hx, h hx ▸ h₁ hx

theorem eq_on.maps_to_iff (H : eq_on f₁ f₂ s) : maps_to f₁ s t ↔ maps_to f₂ s t :=
⟨λ h, h.congr H, λ h, h.congr H.symm⟩

theorem maps_to.comp (h₁ : maps_to g t p) (h₂ : maps_to f s t) : maps_to (g ∘ f) s p :=
λ x h, h₁ (h₂ h)

theorem maps_to_id (s : set α) : maps_to id s s := λ x, id

theorem maps_to.iterate {f : α → α} {s : set α} (h : maps_to f s s) :
  ∀ n, maps_to (f^[n]) s s
| 0 := λ _, id
| (n+1) := (maps_to.iterate n).comp h

theorem maps_to.iterate_restrict {f : α → α} {s : set α} (h : maps_to f s s) (n : ℕ) :
  (h.restrict f s s^[n]) = (h.iterate n).restrict _ _ _ :=
begin
  funext x,
  rw [subtype.ext_iff, maps_to.coe_restrict_apply],
  induction n with n ihn generalizing x,
  { refl },
  { simp [nat.iterate, ihn] }
end

theorem maps_to.mono (hs : s₂ ⊆ s₁) (ht : t₁ ⊆ t₂) (hf : maps_to f s₁ t₁) :
  maps_to f s₂ t₂ :=
λ x hx, ht (hf $ hs hx)

theorem maps_to.union_union (h₁ : maps_to f s₁ t₁) (h₂ : maps_to f s₂ t₂) :
  maps_to f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
λ x hx, hx.elim (λ hx, or.inl $ h₁ hx) (λ hx, or.inr $ h₂ hx)

theorem maps_to.union (h₁ : maps_to f s₁ t) (h₂ : maps_to f s₂ t) :
  maps_to f (s₁ ∪ s₂) t :=
union_self t ▸ h₁.union_union h₂

@[simp] theorem maps_to_union : maps_to f (s₁ ∪ s₂) t ↔ maps_to f s₁ t ∧ maps_to f s₂ t :=
⟨λ h, ⟨h.mono (subset_union_left s₁ s₂) (subset.refl t),
  h.mono (subset_union_right s₁ s₂) (subset.refl t)⟩, λ h, h.1.union h.2⟩

theorem maps_to.inter (h₁ : maps_to f s t₁) (h₂ : maps_to f s t₂) :
  maps_to f s (t₁ ∩ t₂) :=
λ x hx, ⟨h₁ hx, h₂ hx⟩

theorem maps_to.inter_inter (h₁ : maps_to f s₁ t₁) (h₂ : maps_to f s₂ t₂) :
  maps_to f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
λ x hx, ⟨h₁ hx.1, h₂ hx.2⟩

@[simp] theorem maps_to_inter : maps_to f s (t₁ ∩ t₂) ↔ maps_to f s t₁ ∧ maps_to f s t₂ :=
⟨λ h, ⟨h.mono (subset.refl s) (inter_subset_left t₁ t₂),
  h.mono (subset.refl s) (inter_subset_right t₁ t₂)⟩, λ h, h.1.inter h.2⟩

theorem maps_to_univ (f : α → β) (s : set α) : maps_to f s univ := λ x h, trivial

theorem maps_to_image (f : α → β) (s : set α) : maps_to f s (f '' s) := by rw maps_to'

theorem maps_to_preimage (f : α → β) (t : set β) : maps_to f (f ⁻¹' t) t := subset.refl _

theorem maps_to_range (f : α → β) (s : set α) : maps_to f s (range f) :=
(maps_to_image f s).mono (subset.refl s) (image_subset_range _ _)

@[simp] lemma maps_image_to (f : α → β) (g : γ → α) (s : set γ) (t : set β) :
  maps_to f (g '' s) t ↔ maps_to (f ∘ g) s t :=
⟨λ h c hc, h ⟨c, hc, rfl⟩, λ h d ⟨c, hc⟩, hc.2 ▸ h hc.1⟩

@[simp] lemma maps_univ_to (f : α → β) (s : set β) :
  maps_to f univ s ↔ ∀ a, f a ∈ s :=
⟨λ h a, h (mem_univ _), λ h x _, h x⟩

@[simp] lemma maps_range_to (f : α → β) (g : γ → α) (s : set β) :
  maps_to f (range g) s ↔ maps_to (f ∘ g) univ s :=
by rw [←image_univ, maps_image_to]

theorem surjective_maps_to_image_restrict (f : α → β) (s : set α) :
  surjective ((maps_to_image f s).restrict f s (f '' s)) :=
λ ⟨y, x, hs, hxy⟩, ⟨⟨x, hs⟩, subtype.ext hxy⟩

theorem maps_to.mem_iff (h : maps_to f s t) (hc : maps_to f sᶜ tᶜ) {x} : f x ∈ t ↔ x ∈ s :=
⟨λ ht, by_contra $ λ hs, hc hs ht, λ hx, h hx⟩

/-! ### Injectivity on a set -/

/-- `f` is injective on `a` if the restriction of `f` to `a` is injective. -/
@[reducible] def inj_on (f : α → β) (s : set α) : Prop :=
∀ ⦃x₁ : α⦄, x₁ ∈ s → ∀ ⦃x₂ : α⦄, x₂ ∈ s → f x₁ = f x₂ → x₁ = x₂

theorem inj_on_empty (f : α → β) : inj_on f ∅ :=
λ _ h₁, false.elim h₁

theorem inj_on.eq_iff {x y} (h : inj_on f s) (hx : x ∈ s) (hy : y ∈ s) :
  f x = f y ↔ x = y :=
⟨h hx hy, λ h, h ▸ rfl⟩

theorem inj_on.congr (h₁ : inj_on f₁ s) (h : eq_on f₁ f₂ s) :
  inj_on f₂ s :=
λ x hx y hy, h hx ▸ h hy ▸ h₁ hx hy

theorem eq_on.inj_on_iff (H : eq_on f₁ f₂ s) : inj_on f₁ s ↔ inj_on f₂ s :=
⟨λ h, h.congr H, λ h, h.congr H.symm⟩

theorem inj_on.mono (h : s₁ ⊆ s₂) (ht : inj_on f s₂) : inj_on f s₁ :=
λ x hx y hy H, ht (h hx) (h hy) H

theorem inj_on_insert {f : α → β} {s : set α} {a : α} (has : a ∉ s) :
  set.inj_on f (insert a s) ↔ set.inj_on f s ∧ f a ∉ f '' s :=
⟨λ hf, ⟨hf.mono $ subset_insert a s,
  λ ⟨x, hxs, hx⟩, has $ mem_of_eq_of_mem (hf (or.inl rfl) (or.inr hxs) hx.symm) hxs⟩,
λ ⟨h1, h2⟩ x hx y hy hfxy, or.cases_on hx
  (λ hxa : x = a, or.cases_on hy
    (λ hya : y = a, hxa.trans hya.symm)
    (λ hys : y ∈ s, h2.elim ⟨y, hys, hxa ▸ hfxy.symm⟩))
  (λ hxs : x ∈ s, or.cases_on hy
    (λ hya : y = a, h2.elim ⟨x, hxs, hya ▸ hfxy⟩)
    (λ hys : y ∈ s, h1 hxs hys hfxy))⟩

lemma injective_iff_inj_on_univ : injective f ↔ inj_on f univ :=
⟨λ h x hx y hy hxy, h hxy, λ h _ _ heq, h trivial trivial heq⟩

lemma inj_on_of_injective (h : injective f) (s : set α) : inj_on f s :=
λ x hx y hy hxy, h hxy

alias inj_on_of_injective ← function.injective.inj_on

theorem inj_on.comp (hg : inj_on g t) (hf: inj_on f s) (h : maps_to f s t) :
  inj_on (g ∘ f) s :=
λ x hx y hy heq, hf hx hy $ hg (h hx) (h hy) heq

lemma inj_on_iff_injective : inj_on f s ↔ injective (restrict f s) :=
⟨λ H a b h, subtype.eq $ H a.2 b.2 h,
 λ H a as b bs h, congr_arg subtype.val $ @H ⟨a, as⟩ ⟨b, bs⟩ h⟩

lemma inj_on_preimage {B : set (set β)} (hB : B ⊆ 𝒫 (range f)) :
  inj_on (preimage f) B :=
λ s hs t ht hst, (preimage_eq_preimage' (hB hs) (hB ht)).1 hst

lemma inj_on.mem_of_mem_image {x} (hf : inj_on f s) (hs : s₁ ⊆ s) (h : x ∈ s) (h₁ : f x ∈ f '' s₁) :
  x ∈ s₁ :=
let ⟨x', h', eq⟩ := h₁ in hf (hs h') h eq ▸ h'

lemma inj_on.mem_image_iff {x} (hf : inj_on f s) (hs : s₁ ⊆ s) (hx : x ∈ s) :
  f x ∈ f '' s₁ ↔ x ∈ s₁ :=
⟨hf.mem_of_mem_image hs hx, mem_image_of_mem f⟩

lemma inj_on.preimage_image_inter (hf : inj_on f s) (hs : s₁ ⊆ s) :
  f ⁻¹' (f '' s₁) ∩ s = s₁ :=
ext $ λ x, ⟨λ ⟨h₁, h₂⟩, hf.mem_of_mem_image hs h₂ h₁, λ h, ⟨mem_image_of_mem _ h, hs h⟩⟩

/-! ### Surjectivity on a set -/

/-- `f` is surjective from `a` to `b` if `b` is contained in the image of `a`. -/
@[reducible] def surj_on (f : α → β) (s : set α) (t : set β) : Prop := t ⊆ f '' s

theorem surj_on.subset_range (h : surj_on f s t) : t ⊆ range f :=
subset.trans h $ image_subset_range f s

lemma surj_on_iff_exists_map_subtype :
  surj_on f s t ↔ ∃ (t' : set β) (g : s → t'), t ⊆ t' ∧ surjective g ∧ ∀ x : s, f x = g x :=
⟨λ h, ⟨_, (maps_to_image f s).restrict f s _, h, surjective_maps_to_image_restrict _ _, λ _, rfl⟩,
  λ ⟨t', g, htt', hg, hfg⟩ y hy, let ⟨x, hx⟩ := hg ⟨y, htt' hy⟩ in
    ⟨x, x.2, by rw [hfg, hx, subtype.coe_mk]⟩⟩

theorem surj_on_empty (f : α → β) (s : set α) : surj_on f s ∅ := empty_subset _

theorem surj_on_image (f : α → β) (s : set α) : surj_on f s (f '' s) := subset.rfl

theorem surj_on.comap_nonempty (h : surj_on f s t) (ht : t.nonempty) : s.nonempty :=
(ht.mono h).of_image

theorem surj_on.congr (h : surj_on f₁ s t) (H : eq_on f₁ f₂ s) : surj_on f₂ s t :=
by rwa [surj_on, ← H.image_eq]

theorem eq_on.surj_on_iff (h : eq_on f₁ f₂ s) : surj_on f₁ s t ↔ surj_on f₂ s t :=
⟨λ H, H.congr h, λ H, H.congr h.symm⟩

theorem surj_on.mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) (hf : surj_on f s₁ t₂) : surj_on f s₂ t₁ :=
subset.trans ht $ subset.trans hf $ image_subset _ hs

theorem surj_on.union (h₁ : surj_on f s t₁) (h₂ : surj_on f s t₂) : surj_on f s (t₁ ∪ t₂) :=
λ x hx, hx.elim (λ hx, h₁ hx) (λ hx, h₂ hx)

theorem surj_on.union_union (h₁ : surj_on f s₁ t₁) (h₂ : surj_on f s₂ t₂) :
  surj_on f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
(h₁.mono (subset_union_left _ _) (subset.refl _)).union
  (h₂.mono (subset_union_right _ _) (subset.refl _))

theorem surj_on.inter_inter (h₁ : surj_on f s₁ t₁) (h₂ : surj_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
  surj_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
begin
  intros y hy,
  rcases h₁ hy.1 with ⟨x₁, hx₁, rfl⟩,
  rcases h₂ hy.2 with ⟨x₂, hx₂, heq⟩,
  have : x₁ = x₂, from h (or.inl hx₁) (or.inr hx₂) heq.symm,
  subst x₂,
  exact mem_image_of_mem f ⟨hx₁, hx₂⟩
end

theorem surj_on.inter (h₁ : surj_on f s₁ t) (h₂ : surj_on f s₂ t) (h : inj_on f (s₁ ∪ s₂)) :
  surj_on f (s₁ ∩ s₂) t :=
inter_self t ▸ h₁.inter_inter h₂ h

theorem surj_on.comp (hg : surj_on g t p) (hf : surj_on f s t) : surj_on (g ∘ f) s p :=
subset.trans hg $ subset.trans (image_subset g hf) $ (image_comp g f s) ▸ subset.refl _

lemma surjective_iff_surj_on_univ : surjective f ↔ surj_on f univ univ :=
by simp [surjective, surj_on, subset_def]

lemma surj_on_iff_surjective : surj_on f s univ ↔ surjective (restrict f s) :=
⟨λ H b, let ⟨a, as, e⟩ := @H b trivial in ⟨⟨a, as⟩, e⟩,
 λ H b _, let ⟨⟨a, as⟩, e⟩ := H b in ⟨a, as, e⟩⟩

lemma surj_on.image_eq_of_maps_to (h₁ : surj_on f s t) (h₂ : maps_to f s t) :
  f '' s = t :=
eq_of_subset_of_subset h₂.image_subset h₁

lemma surj_on.maps_to_compl (h : surj_on f s t) (h' : injective f) : maps_to f sᶜ tᶜ :=
λ x hs ht, let ⟨x', hx', heq⟩ := h ht in hs $ h' heq ▸ hx'

lemma maps_to.surj_on_compl (h : maps_to f s t) (h' : surjective f) : surj_on f sᶜ tᶜ :=
h'.forall.2 $ λ x ht, mem_image_of_mem _ $ λ hs, ht (h hs)

/-! ### Bijectivity -/

/-- `f` is bijective from `s` to `t` if `f` is injective on `s` and `f '' s = t`. -/
@[reducible] def bij_on (f : α → β) (s : set α) (t : set β) : Prop :=
maps_to f s t ∧ inj_on f s ∧ surj_on f s t

lemma bij_on.maps_to (h : bij_on f s t) : maps_to f s t := h.left

lemma bij_on.inj_on (h : bij_on f s t) : inj_on f s := h.right.left

lemma bij_on.surj_on (h : bij_on f s t) : surj_on f s t := h.right.right

lemma bij_on.mk (h₁ : maps_to f s t) (h₂ : inj_on f s) (h₃ : surj_on f s t) :
      bij_on f s t :=
⟨h₁, h₂, h₃⟩

lemma bij_on_empty (f : α → β) : bij_on f ∅ ∅ :=
⟨maps_to_empty f ∅, inj_on_empty f, surj_on_empty f ∅⟩

lemma bij_on.inter (h₁ : bij_on f s₁ t₁) (h₂ : bij_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
  bij_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
⟨h₁.maps_to.inter_inter h₂.maps_to, h₁.inj_on.mono $ inter_subset_left _ _,
  h₁.surj_on.inter_inter h₂.surj_on h⟩

lemma bij_on.union (h₁ : bij_on f s₁ t₁) (h₂ : bij_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
  bij_on f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
⟨h₁.maps_to.union_union h₂.maps_to, h, h₁.surj_on.union_union h₂.surj_on⟩

theorem bij_on.subset_range (h : bij_on f s t) : t ⊆ range f :=
h.surj_on.subset_range

lemma inj_on.bij_on_image (h : inj_on f s) : bij_on f s (f '' s) :=
bij_on.mk (maps_to_image f s) h (subset.refl _)

theorem bij_on.congr (h₁ : bij_on f₁ s t) (h : eq_on f₁ f₂ s) :
  bij_on f₂ s t :=
bij_on.mk (h₁.maps_to.congr h) (h₁.inj_on.congr h) (h₁.surj_on.congr h)

theorem eq_on.bij_on_iff (H : eq_on f₁ f₂ s) : bij_on f₁ s t ↔ bij_on f₂ s t :=
⟨λ h, h.congr H, λ h, h.congr H.symm⟩

lemma bij_on.image_eq (h : bij_on f s t) :
  f '' s = t :=
h.surj_on.image_eq_of_maps_to h.maps_to

theorem bij_on.comp (hg : bij_on g t p) (hf : bij_on f s t) : bij_on (g ∘ f) s p :=
bij_on.mk (hg.maps_to.comp hf.maps_to) (hg.inj_on.comp hf.inj_on hf.maps_to)
  (hg.surj_on.comp hf.surj_on)

theorem bij_on.bijective (h : bij_on f s t) :
  bijective (t.cod_restrict (s.restrict f) $ λ x, h.maps_to x.val_prop) :=
⟨λ x y h', subtype.ext $ h.inj_on x.2 y.2 $ subtype.ext_iff.1 h',
  λ ⟨y, hy⟩, let ⟨x, hx, hxy⟩ := h.surj_on hy in ⟨⟨x, hx⟩, subtype.eq hxy⟩⟩

lemma bijective_iff_bij_on_univ : bijective f ↔ bij_on f univ univ :=
iff.intro
(λ h, let ⟨inj, surj⟩ := h in
⟨maps_to_univ f _, inj.inj_on _, iff.mp surjective_iff_surj_on_univ surj⟩)
(λ h, let ⟨map, inj, surj⟩ := h in
⟨iff.mpr injective_iff_inj_on_univ inj, iff.mpr surjective_iff_surj_on_univ surj⟩)

lemma bij_on.compl (hst : bij_on f s t) (hf : bijective f) : bij_on f sᶜ tᶜ :=
⟨hst.surj_on.maps_to_compl hf.1, hf.1.inj_on _, hst.maps_to.surj_on_compl hf.2⟩

/-! ### left inverse -/

/-- `g` is a left inverse to `f` on `a` means that `g (f x) = x` for all `x ∈ a`. -/
@[reducible] def left_inv_on (f' : β → α) (f : α → β) (s : set α) : Prop :=
∀ ⦃x⦄, x ∈ s → f' (f x) = x

lemma left_inv_on.eq_on (h : left_inv_on f' f s) : eq_on (f' ∘ f) id s := h

lemma left_inv_on.eq (h : left_inv_on f' f s) {x} (hx : x ∈ s) : f' (f x) = x := h hx

lemma left_inv_on.congr_left (h₁ : left_inv_on f₁' f s)
  {t : set β} (h₁' : maps_to f s t) (heq : eq_on f₁' f₂' t) : left_inv_on f₂' f s :=
λ x hx, heq (h₁' hx) ▸ h₁ hx

theorem left_inv_on.congr_right (h₁ : left_inv_on f₁' f₁ s) (heq : eq_on f₁ f₂ s) :
  left_inv_on f₁' f₂ s :=
λ x hx, heq hx ▸ h₁ hx

theorem left_inv_on.inj_on (h : left_inv_on f₁' f s) : inj_on f s :=
λ x₁ h₁ x₂ h₂ heq,
calc
  x₁    = f₁' (f x₁) : eq.symm $ h h₁
  ...   = f₁' (f x₂) : congr_arg f₁' heq
  ...   = x₂         : h h₂

theorem left_inv_on.surj_on (h : left_inv_on f' f s) (hf : maps_to f s t) : surj_on f' t s :=
λ x hx, ⟨f x, hf hx, h hx⟩

theorem left_inv_on.maps_to (h : left_inv_on f' f s) (hf : surj_on f s t) : maps_to f' t s :=
λ y hy, let ⟨x, hs, hx⟩ := hf hy in by rwa [← hx, h hs]

theorem left_inv_on.comp
  (hf' : left_inv_on f' f s) (hg' : left_inv_on g' g t) (hf : maps_to f s t) :
  left_inv_on (f' ∘ g') (g ∘ f) s :=
λ x h,
calc
  (f' ∘ g') ((g ∘ f) x) = f' (f x) : congr_arg f' (hg' (hf h))
  ...                   = x        : hf' h

theorem left_inv_on.mono (hf : left_inv_on f' f s) (ht : s₁ ⊆ s) : left_inv_on f' f s₁ :=
λ x hx, hf (ht hx)

theorem left_inv_on.image_inter' (hf : left_inv_on f' f s) :
  f '' (s₁ ∩ s) = f' ⁻¹' s₁ ∩ f '' s :=
begin
  apply subset.antisymm,
  { rintro _ ⟨x, ⟨h₁, h⟩, rfl⟩, exact ⟨by rwa [mem_preimage, hf h], mem_image_of_mem _ h⟩ },
  { rintro _ ⟨h₁, ⟨x, h, rfl⟩⟩, exact mem_image_of_mem _ ⟨by rwa ← hf h, h⟩ }
end

theorem left_inv_on.image_inter (hf : left_inv_on f' f s) :
  f '' (s₁ ∩ s) = f' ⁻¹' (s₁ ∩ s) ∩ f '' s :=
begin
  rw hf.image_inter',
  refine subset.antisymm _ (inter_subset_inter_left _ (preimage_mono $ inter_subset_left _ _)),
  rintro _ ⟨h₁, x, hx, rfl⟩, exact ⟨⟨h₁, by rwa hf hx⟩, mem_image_of_mem _ hx⟩
end

theorem left_inv_on.image_image (hf : left_inv_on f' f s) :
  f' '' (f '' s) = s :=
by rw [image_image, image_congr hf, image_id']

theorem left_inv_on.image_image' (hf : left_inv_on f' f s) (hs : s₁ ⊆ s) :
  f' '' (f '' s₁) = s₁ :=
(hf.mono hs).image_image

/-! ### Right inverse -/

/-- `g` is a right inverse to `f` on `b` if `f (g x) = x` for all `x ∈ b`. -/
@[reducible] def right_inv_on (f' : β → α) (f : α → β) (t : set β) : Prop :=
left_inv_on f f' t

lemma right_inv_on.eq_on (h : right_inv_on f' f t) : eq_on (f ∘ f') id t := h

lemma right_inv_on.eq (h : right_inv_on f' f t) {y} (hy : y ∈ t) : f (f' y) = y := h hy

lemma left_inv_on.right_inv_on_image (h : left_inv_on f' f s) : right_inv_on f' f (f '' s) :=
λ y ⟨x, hx, eq⟩, eq ▸ congr_arg f $ h.eq hx

theorem right_inv_on.congr_left (h₁ : right_inv_on f₁' f t) (heq : eq_on f₁' f₂' t) :
  right_inv_on f₂' f t :=
h₁.congr_right heq

theorem right_inv_on.congr_right (h₁ : right_inv_on f' f₁ t) (hg : maps_to f' t s)
  (heq : eq_on f₁ f₂ s) : right_inv_on f' f₂ t :=
left_inv_on.congr_left h₁ hg heq

theorem right_inv_on.surj_on (hf : right_inv_on f' f t) (hf' : maps_to f' t s) :
  surj_on f s t :=
hf.surj_on hf'

theorem right_inv_on.maps_to (h : right_inv_on f' f t) (hf : surj_on f' t s) : maps_to f s t :=
h.maps_to hf

theorem right_inv_on.comp (hf : right_inv_on f' f t) (hg : right_inv_on g' g p)
  (g'pt : maps_to g' p t) : right_inv_on (f' ∘ g') (g ∘ f) p :=
hg.comp hf g'pt

theorem right_inv_on.mono (hf : right_inv_on f' f t) (ht : t₁ ⊆ t) : right_inv_on f' f t₁ :=
hf.mono ht

theorem inj_on.right_inv_on_of_left_inv_on (hf : inj_on f s) (hf' : left_inv_on f f' t)
    (h₁ : maps_to f s t) (h₂ : maps_to f' t s) :
  right_inv_on f f' s :=
λ x h, hf (h₂ $ h₁ h) h (hf' (h₁ h))

theorem eq_on_of_left_inv_on_of_right_inv_on (h₁ : left_inv_on f₁' f s) (h₂ : right_inv_on f₂' f t)
  (h : maps_to f₂' t s) : eq_on f₁' f₂' t :=
λ y hy,
calc f₁' y = (f₁' ∘ f ∘ f₂') y : congr_arg f₁' (h₂ hy).symm
      ...  = f₂' y              : h₁ (h hy)

theorem surj_on.left_inv_on_of_right_inv_on (hf : surj_on f s t) (hf' : right_inv_on f f' s) :
  left_inv_on f f' t :=
λ y hy, let ⟨x, hx, heq⟩ := hf hy in by rw [← heq, hf' hx]

/-! ### Two-side inverses -/

/-- `g` is an inverse to `f` viewed as a map from `a` to `b` -/
@[reducible] def inv_on (g : β → α) (f : α → β) (s : set α) (t : set β) : Prop :=
left_inv_on g f s ∧ right_inv_on g f t

lemma inv_on.symm (h : inv_on f' f s t) : inv_on f f' t s := ⟨h.right, h.left⟩

lemma inv_on.mono (h : inv_on f' f s t) (hs : s₁ ⊆ s) (ht : t₁ ⊆ t) : inv_on f' f s₁ t₁ :=
⟨h.1.mono hs, h.2.mono ht⟩

/-- If functions `f'` and `f` are inverse on `s` and `t`, `f` maps `s` into `t`, and `f'` maps `t`
into `s`, then `f` is a bijection between `s` and `t`. The `maps_to` arguments can be deduced from
`surj_on` statements using `left_inv_on.maps_to` and `right_inv_on.maps_to`. -/
theorem inv_on.bij_on (h : inv_on f' f s t) (hf : maps_to f s t) (hf' : maps_to f' t s) :
  bij_on f s t :=
⟨hf, h.left.inj_on, h.right.surj_on hf'⟩

/-! ### `inv_fun_on` is a left/right inverse -/

theorem inj_on.left_inv_on_inv_fun_on [nonempty α] (h : inj_on f s) :
  left_inv_on (inv_fun_on f s) f s :=
λ x hx, inv_fun_on_eq' h hx

lemma inj_on.inv_fun_on_image [nonempty α] (h : inj_on f s₂) (ht : s₁ ⊆ s₂) :
  (inv_fun_on f s₂) '' (f '' s₁) = s₁ :=
h.left_inv_on_inv_fun_on.image_image' ht

theorem surj_on.right_inv_on_inv_fun_on [nonempty α] (h : surj_on f s t) :
  right_inv_on (inv_fun_on f s) f t :=
λ y hy, inv_fun_on_eq $ mem_image_iff_bex.1 $ h hy

theorem bij_on.inv_on_inv_fun_on [nonempty α] (h : bij_on f s t) :
  inv_on (inv_fun_on f s) f s t :=
⟨h.inj_on.left_inv_on_inv_fun_on, h.surj_on.right_inv_on_inv_fun_on⟩

theorem surj_on.inv_on_inv_fun_on [nonempty α] (h : surj_on f s t) :
  inv_on (inv_fun_on f s) f (inv_fun_on f s '' t) t :=
begin
  refine ⟨_, h.right_inv_on_inv_fun_on⟩,
  rintros _ ⟨y, hy, rfl⟩,
  rw [h.right_inv_on_inv_fun_on hy]
end

theorem surj_on.maps_to_inv_fun_on [nonempty α] (h : surj_on f s t) :
  maps_to (inv_fun_on f s) t s :=
λ y hy, mem_preimage.2 $ inv_fun_on_mem $ mem_image_iff_bex.1 $ h hy

theorem surj_on.bij_on_subset [nonempty α] (h : surj_on f s t) :
  bij_on f (inv_fun_on f s '' t) t :=
begin
  refine h.inv_on_inv_fun_on.bij_on _ (maps_to_image _ _),
  rintros _ ⟨y, hy, rfl⟩,
  rwa [h.right_inv_on_inv_fun_on hy]
end

theorem surj_on_iff_exists_bij_on_subset :
  surj_on f s t ↔ ∃ s' ⊆ s, bij_on f s' t :=
begin
  split,
  { rcases eq_empty_or_nonempty t with rfl|ht,
    { exact λ _, ⟨∅, empty_subset _, bij_on_empty f⟩ },
    { assume h,
      haveI : nonempty α := ⟨classical.some (h.comap_nonempty ht)⟩,
      exact ⟨_, h.maps_to_inv_fun_on.image_subset, h.bij_on_subset⟩ }},
  { rintros ⟨s', hs', hfs'⟩,
    exact hfs'.surj_on.mono hs' (subset.refl _) }
end

lemma preimage_inv_fun_of_mem [n : nonempty α] {f : α → β} (hf : injective f) {s : set α}
  (h : classical.choice n ∈ s) : inv_fun f ⁻¹' s = f '' s ∪ (range f)ᶜ :=
begin
  ext x,
  rcases em (x ∈ range f) with ⟨a, rfl⟩|hx,
  { simp [left_inverse_inv_fun hf _, mem_image_of_injective hf] },
  { simp [mem_preimage, inv_fun_neg hx, h, hx] }
end

lemma preimage_inv_fun_of_not_mem [n : nonempty α] {f : α → β} (hf : injective f)
  {s : set α} (h : classical.choice n ∉ s) : inv_fun f ⁻¹' s = f '' s :=
begin
  ext x,
  rcases em (x ∈ range f) with ⟨a, rfl⟩|hx,
  { rw [mem_preimage, left_inverse_inv_fun hf, mem_image_of_injective hf] },
  { have : x ∉ f '' s, from λ h', hx (image_subset_range _ _ h'),
    simp only [mem_preimage, inv_fun_neg hx, h, this] },
end

end set

/-! ### Piecewise defined function -/

namespace set

variables {δ : α → Sort y} (s : set α) (f g : Πi, δ i)

@[simp] lemma piecewise_empty [∀i : α, decidable (i ∈ (∅ : set α))] : piecewise ∅ f g = g :=
by { ext i, simp [piecewise] }

@[simp] lemma piecewise_univ [∀i : α, decidable (i ∈ (set.univ : set α))] :
  piecewise set.univ f g = f :=
by { ext i, simp [piecewise] }

@[simp] lemma piecewise_insert_self {j : α} [∀i, decidable (i ∈ insert j s)] :
  (insert j s).piecewise f g j = f j :=
by simp [piecewise]

variable [∀j, decidable (j ∈ s)]

instance compl.decidable_mem (j : α) : decidable (j ∈ sᶜ) := not.decidable

lemma piecewise_insert [decidable_eq α] (j : α) [∀i, decidable (i ∈ insert j s)] :
  (insert j s).piecewise f g = function.update (s.piecewise f g) j (f j) :=
begin
  simp [piecewise],
  ext i,
  by_cases h : i = j,
  { rw h, simp },
  { by_cases h' : i ∈ s; simp [h, h'] }
end

@[simp, priority 990]
lemma piecewise_eq_of_mem {i : α} (hi : i ∈ s) : s.piecewise f g i = f i := if_pos hi

@[simp, priority 990]
lemma piecewise_eq_of_not_mem {i : α} (hi : i ∉ s) : s.piecewise f g i = g i := if_neg hi

lemma piecewise_singleton (x : α) [Π y, decidable (y ∈ ({x} : set α))] [decidable_eq α]
  (f g : α → β) : piecewise {x} f g = function.update g x (f x) :=
by { ext y, by_cases hy : y = x, { subst y, simp }, { simp [hy] } }

lemma piecewise_eq_on (f g : α → β) : eq_on (s.piecewise f g) f s :=
λ _, piecewise_eq_of_mem _ _ _

lemma piecewise_eq_on_compl (f g : α → β) : eq_on (s.piecewise f g) g sᶜ :=
λ _, piecewise_eq_of_not_mem _ _ _

lemma piecewise_le {δ : α → Type*} [Π i, preorder (δ i)] {s : set α} [Π j, decidable (j ∈ s)]
  {f₁ f₂ g : Π i, δ i} (h₁ : ∀ i ∈ s, f₁ i ≤ g i) (h₂ : ∀ i ∉ s, f₂ i ≤ g i) :
  s.piecewise f₁ f₂ ≤ g :=
λ i, if h : i ∈ s then by simp * else by simp *

lemma le_piecewise {δ : α → Type*} [Π i, preorder (δ i)] {s : set α} [Π j, decidable (j ∈ s)]
  {f₁ f₂ g : Π i, δ i} (h₁ : ∀ i ∈ s, g i ≤ f₁ i) (h₂ : ∀ i ∉ s, g i ≤ f₂ i) :
  g ≤ s.piecewise f₁ f₂ :=
@piecewise_le α (λ i, order_dual (δ i)) _ s _ _ _ _ h₁ h₂

lemma piecewise_le_piecewise {δ : α → Type*} [Π i, preorder (δ i)] {s : set α}
  [Π j, decidable (j ∈ s)] {f₁ f₂ g₁ g₂ : Π i, δ i} (h₁ : ∀ i ∈ s, f₁ i ≤ g₁ i)
  (h₂ : ∀ i ∉ s, f₂ i ≤ g₂ i) :
  s.piecewise f₁ f₂ ≤ s.piecewise g₁ g₂ :=
by apply piecewise_le; intros; simp *

@[simp, priority 990]
lemma piecewise_insert_of_ne {i j : α} (h : i ≠ j) [∀i, decidable (i ∈ insert j s)] :
  (insert j s).piecewise f g i = s.piecewise f g i :=
by simp [piecewise, h]

@[simp] lemma piecewise_compl [∀ i, decidable (i ∈ sᶜ)] : sᶜ.piecewise f g = s.piecewise g f :=
funext $ λ x, if hx : x ∈ s then by simp [hx] else by simp [hx]

@[simp] lemma piecewise_range_comp {ι : Sort*} (f : ι → α) [Π j, decidable (j ∈ range f)]
  (g₁ g₂ : α → β) :
  (range f).piecewise g₁ g₂ ∘ f = g₁ ∘ f :=
comp_eq_of_eq_on_range $ piecewise_eq_on _ _ _

theorem maps_to.piecewise_ite {s s₁ s₂ : set α} {t t₁ t₂ : set β} {f₁ f₂ : α → β}
  [∀ i, decidable (i ∈ s)]
  (h₁ : maps_to f₁ (s₁ ∩ s) (t₁ ∩ t)) (h₂ : maps_to f₂ (s₂ ∩ sᶜ) (t₂ ∩ tᶜ)) :
  maps_to (s.piecewise f₁ f₂) (s.ite s₁ s₂) (t.ite t₁ t₂) :=
begin
  refine (h₁.congr _).union_union (h₂.congr _),
  exacts [(piecewise_eq_on s f₁ f₂).symm.mono (inter_subset_right _ _),
    (piecewise_eq_on_compl s f₁ f₂).symm.mono (inter_subset_right _ _)]
end

theorem eq_on_piecewise {f f' g : α → β} {t} :
  eq_on (s.piecewise f f') g t ↔ eq_on f g (t ∩ s) ∧ eq_on f' g (t ∩ sᶜ) :=
begin
  simp only [eq_on, ← forall_and_distrib],
  refine forall_congr (λ a, _), by_cases a ∈ s; simp *
end

theorem eq_on.piecewise_ite' {f f' g : α → β} {t t'} (h : eq_on f g (t ∩ s))
  (h' : eq_on f' g (t' ∩ sᶜ)) :
  eq_on (s.piecewise f f') g (s.ite t t') :=
by simp [eq_on_piecewise, *]

lemma piecewise_preimage (f g : α → β) (t) :
  s.piecewise f g ⁻¹' t = s.ite (f ⁻¹' t) (g ⁻¹' t) :=
ext $ λ x, by by_cases x ∈ s; simp [*, set.ite]

lemma apply_piecewise {δ' : α → Sort*} (h : Π i, δ i → δ' i) {x : α} :
  h x (s.piecewise f g x) = s.piecewise (λ x, h x (f x)) (λ x, h x (g x)) x :=
by by_cases hx : x ∈ s; simp [hx]

lemma apply_piecewise₂ {δ' δ'' : α → Sort*} (f' g' : Π i, δ' i) (h : Π i, δ i → δ' i → δ'' i)
  {x : α} :
  h x (s.piecewise f g x) (s.piecewise f' g' x) =
    s.piecewise (λ x, h x (f x) (f' x)) (λ x, h x (g x) (g' x)) x :=
by by_cases hx : x ∈ s; simp [hx]

lemma piecewise_op {δ' : α → Sort*} (h : Π i, δ i → δ' i) :
  s.piecewise (λ x, h x (f x)) (λ x, h x (g x)) = λ x, h x (s.piecewise f g x) :=
funext $ λ x, (apply_piecewise _ _ _ _).symm

lemma piecewise_op₂ {δ' δ'' : α → Sort*} (f' g' : Π i, δ' i) (h : Π i, δ i → δ' i → δ'' i) :
  s.piecewise (λ x, h x (f x) (f' x)) (λ x, h x (g x) (g' x)) =
    λ x, h x (s.piecewise f g x) (s.piecewise f' g' x) :=
funext $ λ x, (apply_piecewise₂ _ _ _ _ _ _).symm

@[simp] lemma piecewise_same : s.piecewise f f = f :=
by { ext x, by_cases hx : x ∈ s; simp [hx] }

lemma range_piecewise (f g : α → β) : range (s.piecewise f g) = f '' s ∪ g '' sᶜ :=
begin
  ext y, split,
  { rintro ⟨x, rfl⟩, by_cases h : x ∈ s;[left, right]; use x; simp [h] },
  { rintro (⟨x, hx, rfl⟩|⟨x, hx, rfl⟩); use x; simp * at * }
end

lemma piecewise_mem_pi {δ : α → Type*} {t : set α} {t' : Π i, set (δ i)}
  {f g} (hf : f ∈ pi t t') (hg : g ∈ pi t t') :
  s.piecewise f g ∈ pi t t' :=
by { intros i ht, by_cases hs : i ∈ s; simp [hf i ht, hg i ht, hs] }

@[simp] lemma pi_piecewise {ι : Type*} {α : ι → Type*} (s s' : set ι)
  (t t' : Π i, set (α i)) [Π x, decidable (x ∈ s')] :
  pi s (s'.piecewise t t') = pi (s ∩ s') t ∩ pi (s \ s') t' :=
begin
  ext x,
  simp only [mem_pi, mem_inter_eq, ← forall_and_distrib],
  refine forall_congr (λ i, _),
  by_cases hi : i ∈ s'; simp *
end

lemma univ_pi_piecewise {ι : Type*} {α : ι → Type*} (s : set ι)
  (t : Π i, set (α i)) [Π x, decidable (x ∈ s)] :
  pi univ (s.piecewise t (λ _, univ)) = pi s t :=
by simp

end set

lemma strict_mono_incr_on.inj_on [linear_order α] [preorder β] {f : α → β} {s : set α}
  (H : strict_mono_incr_on f s) :
  s.inj_on f :=
λ x hx y hy hxy, show ordering.eq.compares x y, from (H.compares hx hy).1 hxy

lemma strict_mono_decr_on.inj_on [linear_order α] [preorder β] {f : α → β} {s : set α}
  (H : strict_mono_decr_on f s) :
  s.inj_on f :=
@strict_mono_incr_on.inj_on α (order_dual β) _ _ f s H

lemma strict_mono_incr_on.comp [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_mono_incr_on g t)
  (hf : strict_mono_incr_on f s) (hs : set.maps_to f s t) :
  strict_mono_incr_on (g ∘ f) s :=
λ x hx y hy hxy, hg (hs hx) (hs hy) $ hf hx hy hxy

lemma strict_mono.comp_strict_mono_incr_on [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} (hg : strict_mono g)
  (hf : strict_mono_incr_on f s) :
  strict_mono_incr_on (g ∘ f) s :=
λ x hx y hy hxy, hg $ hf hx hy hxy

lemma strict_mono.cod_restrict [preorder α] [preorder β] {f : α → β} (hf : strict_mono f)
  {s : set β} (hs : ∀ x, f x ∈ s) :
  strict_mono (set.cod_restrict f s hs) :=
hf

namespace function

open set

variables {fa : α → α} {fb : β → β} {f : α → β} {g : β → γ} {s t : set α}

lemma injective.comp_inj_on (hg : injective g) (hf : s.inj_on f) : s.inj_on (g ∘ f) :=
(hg.inj_on univ).comp hf (maps_to_univ _ _)

lemma surjective.surj_on (hf : surjective f) (s : set β) :
  surj_on f univ s :=
(surjective_iff_surj_on_univ.1 hf).mono (subset.refl _) (subset_univ _)

lemma left_inverse.left_inv_on {g : β → α} (h : left_inverse f g) (s : set β) :
  left_inv_on f g s :=
λ x hx, h x

lemma right_inverse.right_inv_on {g : β → α} (h : right_inverse f g) (s : set α) :
  right_inv_on f g s :=
λ x hx, h x

lemma left_inverse.right_inv_on_range {g : β → α} (h : left_inverse f g) :
  right_inv_on f g (range g) :=
forall_range_iff.2 $ λ i, congr_arg g (h i)

namespace semiconj

lemma maps_to_image (h : semiconj f fa fb) (ha : maps_to fa s t) :
  maps_to fb (f '' s) (f '' t) :=
λ y ⟨x, hx, hy⟩, hy ▸ ⟨fa x, ha hx, h x⟩

lemma maps_to_range (h : semiconj f fa fb) : maps_to fb (range f) (range f) :=
λ y ⟨x, hy⟩, hy ▸ ⟨fa x, h x⟩

lemma surj_on_image (h : semiconj f fa fb) (ha : surj_on fa s t) :
  surj_on fb (f '' s) (f '' t) :=
begin
  rintros y ⟨x, hxt, rfl⟩,
  rcases ha hxt with ⟨x, hxs, rfl⟩,
  rw [h x],
  exact mem_image_of_mem _ (mem_image_of_mem _ hxs)
end

lemma surj_on_range (h : semiconj f fa fb) (ha : surjective fa) :
  surj_on fb (range f) (range f) :=
by { rw ← image_univ, exact h.surj_on_image (ha.surj_on univ) }

lemma inj_on_image (h : semiconj f fa fb) (ha : inj_on fa s) (hf : inj_on f (fa '' s)) :
  inj_on fb (f '' s) :=
begin
  rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ H,
  simp only [← h.eq] at H,
  exact congr_arg f (ha hx hy $ hf (mem_image_of_mem fa hx) (mem_image_of_mem fa hy) H)
end

lemma inj_on_range (h : semiconj f fa fb) (ha : injective fa) (hf : inj_on f (range fa)) :
  inj_on fb (range f) :=
by { rw ← image_univ at *, exact h.inj_on_image (ha.inj_on univ) hf }

lemma bij_on_image (h : semiconj f fa fb) (ha : bij_on fa s t) (hf : inj_on f t) :
  bij_on fb (f '' s) (f '' t) :=
⟨h.maps_to_image ha.maps_to, h.inj_on_image ha.inj_on (ha.image_eq.symm ▸ hf),
  h.surj_on_image ha.surj_on⟩

lemma bij_on_range (h : semiconj f fa fb) (ha : bijective fa) (hf : injective f) :
  bij_on fb (range f) (range f) :=
begin
  rw [← image_univ],
  exact h.bij_on_image (bijective_iff_bij_on_univ.1 ha) (hf.inj_on univ)
end

lemma maps_to_preimage (h : semiconj f fa fb) {s t : set β} (hb : maps_to fb s t) :
  maps_to fa (f ⁻¹' s) (f ⁻¹' t) :=
λ x hx, by simp only [mem_preimage, h x, hb hx]

lemma inj_on_preimage (h : semiconj f fa fb) {s : set β} (hb : inj_on fb s)
  (hf : inj_on f (f ⁻¹' s)) :
  inj_on fa (f ⁻¹' s) :=
begin
  intros x hx y hy H,
  have := congr_arg f H,
  rw [h.eq, h.eq] at this,
  exact hf hx hy (hb hx hy this)
end

end semiconj

lemma update_comp_eq_of_not_mem_range' {α β : Sort*} {γ : β → Sort*} [decidable_eq β]
  (g : Π b, γ b) {f : α → β} {i : β} (a : γ i) (h : i ∉ set.range f) :
  (λ j, (function.update g i a) (f j)) = (λ j, g (f j)) :=
update_comp_eq_of_forall_ne' _ _ $ λ x hx, h ⟨x, hx⟩

/-- Non-dependent version of `function.update_comp_eq_of_not_mem_range'` -/
lemma update_comp_eq_of_not_mem_range {α β γ : Sort*} [decidable_eq β]
  (g : β → γ) {f : α → β} {i : β} (a : γ) (h : i ∉ set.range f) :
  (function.update g i a) ∘ f = g ∘ f :=
update_comp_eq_of_not_mem_range' g a h

end function


import data.real.basic

theorem osk2002_4 {x : ℝ} : x < 0 → x < x^2 :=
begin
  intros h,
  transitivity,
  exact h,
  apply sq_pos_of_ne_zero,
  apply ne_of_lt h,
end


import SciLean.Mathlib.Data.Enumtype
import SciLean.Core.Functions

namespace SciLean
structure Idx (n : Nat) where
  val : USize
  property : val < n.toUSize

def Idx.toFin {n} (i : Idx n) : Fin n := ⟨i.1.toNat, sorry⟩

instance {n} : DecidableEq (Idx n) :=
  λ i j => if h : i.1=j.1 then isTrue sorry else isFalse sorry

instance {n} : Enumtype (Idx n) :=
{
  first := if n ≠ 0 then some ⟨0, sorry⟩ else none
  next  := λ i =>
    if h : (i.1+1)<n then some ⟨i.1+1, h⟩ else none
  numOf   := n
  fromFin := λ i => ⟨i.1.toUSize, sorry⟩
  toFin   := λ i => i.toFin
  decEq := by infer_instance

  first_fromFin := sorry
  next_fromFin  := sorry
  next_toFin    := sorry
}

instance [Fact (n≠0)] : Nonempty (Idx n) := sorry

instance {n} : HAdd (Idx n) USize (Idx n) := ⟨λ x y => ⟨(x.1 + y)%n, sorry⟩⟩
instance {n} : HSub (Idx n) USize (Idx n) := ⟨λ x y => ⟨(x.1 + n - (y%n))%n, sorry⟩⟩

instance Idx.HAdd.hAdd.arg_x.isInv (y : USize) : IsInv λ (x : Idx n) => x + y := sorry
instance Idx.HSub.hSub.arg_x.isInv (y : USize) : IsInv λ (x : Idx n) => x - y := sorry
@[simp] theorem Idx.HAdd.hAdd.arg_x.inv_simp [Nonempty (Idx n)] (y : USize)
  : (λ (x : Idx n) => x + y)⁻¹ = λ (x : Idx n) => x - y := sorry
@[simp] theorem Idx.HSub.hSub.arg_x.inv_simp [Nonempty (Idx n)] (y : USize)
  : (λ (x : Idx n) => x - y)⁻¹ = λ (x : Idx n) => x + y := sorry

instance : ToString (Idx n) := ⟨λ i => toString i.1⟩


import data.rat
import data.real.basic
import tactic.ring

lemma abs_neg_of_pos {α : Type*} [linear_ordered_add_comm_group α] (a : α) :
 a > 0 → abs (- a) = a :=
 λ a_pos, (abs_of_neg (neg_neg_of_pos a_pos)).trans (neg_neg a)

def half_Q : ℚ := 1 / 2
def neg_half_Q : ℚ := - half_Q

lemma dist_neg_Q (n : ℤ) (h : n ≥ 0) :
 abs (neg_half_Q - ((- (1 + n)) : ℤ)) = (n : ℚ) + half_Q :=
begin
 let n_Q : ℚ := n,
 have e0 : neg_half_Q + 1 = half_Q := by { dsimp[neg_half_Q,half_Q], norm_num },
 have e1  :=
  calc
   neg_half_Q - ((- (1 + n)) : ℤ) = n + (neg_half_Q + 1) :
    by { rw[int.cast_neg, int.cast_add, int.cast_one, sub_neg_eq_add],
         ring, }
   ... = n_Q + half_Q : by rw[e0],
 have e2 : n_Q + half_Q > 0 :=
   add_pos_of_nonneg_of_pos (int.cast_nonneg.mpr h) one_half_pos,
 rw[e1,abs_of_pos e2],
end

lemma dist_nonneg_Q (n : ℤ) (h : n ≥ 0) :
 abs (neg_half_Q - n) = (n : ℚ) + half_Q :=
begin
 let n_Q : ℚ := n,
 have e1 : neg_half_Q - n = - (n_Q + half_Q) :=
   by {dsimp[neg_half_Q,half_Q], ring_nf },
 have e2 : n_Q + half_Q > 0 :=
   add_pos_of_nonneg_of_pos (int.cast_nonneg.mpr h) one_half_pos,
 have e3 : abs (- (n_Q + half_Q)) = n_Q + half_Q :=
  @abs_neg_of_pos ℚ _ (n_Q + half_Q) e2,
 rw[e1,e3],
end

noncomputable def half_R : ℝ := half_Q
noncomputable def neg_half_R : ℝ := neg_half_Q

lemma dist_neg (n : ℤ) (h : n ≥ 0) :
 abs (neg_half_R - (-(1 + n) : ℤ)) = (n : ℝ) + half_R :=
begin
 let x_Q : ℚ := neg_half_Q - (-(1 + n) : ℤ),
 let x_R : ℝ := neg_half_R - (-(1 + n) : ℤ),
 let d_Q : ℚ := abs x_Q,
 let d_R : ℝ := abs x_R,
 have e0 : x_R = x_Q := by {
   dsimp[x_R,x_Q,neg_half_R,neg_half_Q,half_Q],
   norm_cast
   },
 have e1 : d_R = d_Q := by { dsimp[d_R,d_Q],rw[e0,rat.cast_abs] },
 have e2 : d_Q = (n : ℚ) + half_Q := dist_neg_Q n h,
 exact calc
  d_R = d_Q : e1
  ... = (n : ℚ) + half_Q : by {rw[e2,rat.cast_add]}
  ... = (n : ℝ) + half_R : by {dsimp[half_R],rw[rat.cast_coe_int]}
end

lemma dist_nonneg (n : ℤ) (h : n ≥ 0) :
 abs(neg_half_R - n) = (n : ℝ) + half_R :=
begin
 let x_Q : ℚ := neg_half_Q - n,
 let x_R : ℝ := neg_half_R - n,
 let d_Q : ℚ := abs x_Q,
 let d_R : ℝ := abs x_R,
 have e0 : x_R = x_Q := by {
  dsimp[x_R,x_Q,neg_half_R,neg_half_Q,half_Q],
  norm_cast
 },
 have e1 : d_R = d_Q := by { dsimp[d_R,d_Q],rw[e0,rat.cast_abs] },
 have e2 : d_Q = (n : ℚ) + half_Q := dist_nonneg_Q n h,
 exact calc
  d_R = d_Q : e1
  ... = (n : ℚ) + half_Q : by {rw[e2,rat.cast_add]}
  ... = (n : ℝ) + half_R : by {dsimp[half_R],rw[rat.cast_coe_int]}
end

def is_closest_integer (n : ℤ) (x : ℝ) :=
  ∀ (m : ℤ), m ≠ n → abs(x - n) < abs (x - m)

lemma no_closest_integer (n : ℤ) : ¬ (is_closest_integer n neg_half_R) :=
begin
 have hh : ∀ k : ℤ, k ≥ 0 → ¬ ((k : ℝ) + half_R < half_R) := begin
  intros k k_nonneg k_half_lt,
  have k_half_ge : (k : ℝ) + half_R ≥ half_R :=
    le_add_of_nonneg_left (int.cast_nonneg.mpr k_nonneg),
  exact not_le_of_gt k_half_lt k_half_ge,
 end,
 intro h0,
 by_cases h1 : n ≥ 0,
 {let m : ℤ := -1,
  have : ¬ (m ≥ 0) := dec_trivial,
  have h2 : m ≠ n := λ e, this (e.symm.subst h1),
  let h3 := h0 (-1) h2,
  let h4 := dist_neg 0 (le_refl 0),
  rw[add_zero] at h4,
  rw[h4,dist_nonneg n h1,int.cast_zero,zero_add] at h3,
  exact hh n h1 h3,
 },{
  have h1a : n < 0 := lt_of_not_ge h1,
  let m : ℤ := 0,
  have : ¬ (m < 0) := dec_trivial,
  have h2 : m ≠ n := λ e, this (e.symm.subst h1a),
  let h3 := h0 0 h2,
  let h4 := dist_nonneg 0 (le_refl 0),
  rw[h4,int.cast_zero,zero_add] at h3,
  let k :=  - (1 + n),
  have h5 : n = - (1 + k) := by {dsimp[k],ring},
  let h6 := (neg_nonneg_of_nonpos (int.add_one_le_iff.mpr (lt_of_not_ge h1))),
  rw[add_comm n 1] at h6,
  have h6a : 0 ≤ k := h6,
  let h7 := dist_neg k h6a,
  rw[← h5] at h7,
  rw[h7] at h3,
  exact hh k h6a h3,
 }
end


namespace hidden

inductive myint : Type
  | zero : myint
  | succ : myint -> myint
  | pred : myint -> myint

open myint

axiom succ_pred_eq (n : myint) :
  succ (pred n) = n

axiom pred_succ_eq (n : myint) :
  pred (succ n) = n

def identity : myint := zero

def inverse : myint -> myint
  | zero := zero
  | (succ n) := pred (inverse n)
  | (pred n) := succ (inverse n)

def add : myint -> myint -> myint
  | m zero := m
  | m (succ n) := succ (add m n)
  | m (pred n) := pred (add m n)

-- Identity properties
lemma add_zero (m : myint) :
  add m zero = m :=
  begin
    rw add,
  end

lemma zero_add (m : myint) :
  add zero m = m :=
  begin
    induction m with d hd d hd,

    -- Base case
    {
      rw add,
    },

    -- Succ case
    {
      rw add,
      rw hd,
    },

    -- Pred case
    {
      rw add,
      rw hd,
    }
  end

-- Associativity
lemma associativity (a b c : myint) :
  add a (add b c) = add (add a b) c :=
  begin
    induction c with d hd d hd,

    -- Base case
    {
      repeat {rw add},
    },

    -- Succ case
    {
      repeat {rw add},
      rw hd,
    },

    -- Pred case
    {
      repeat {rw add},
      rw hd,
    },
  end

-- Intermediate lemmas for inverse
lemma add_succ (m n : myint) :
  add (succ m) n = succ (add m n) :=
  begin
    induction n with d hd d hd,

    -- Base case
    {
      repeat {rw add},
    },

    -- Succ case
    {
      repeat {rw add},
      rw hd,
    },

    -- Pred case
    {
      repeat {rw add},
      rw hd,
      rw [pred_succ_eq, succ_pred_eq],
    },
  end

lemma add_pred (m n : myint) :
  add (pred m) n = pred (add m n) :=
  begin
    induction n with d hd d hd,

    -- Base case
    {
      repeat {rw add},
    },

    -- Succ case
    {
      repeat {rw add},
      rw hd,
      rw [succ_pred_eq, pred_succ_eq],
    },

    -- Pred case
    {
      repeat {rw add},
      rw hd,
    },
  end

-- Inverse properties
lemma add_inverse (n : myint) :
  add n (inverse n) = zero :=
  begin
    induction n with d hd d hd,

    -- Base case
    {
      rw inverse,
      rw add,
    },

    -- Succ case
    {
      rw inverse,
      rw add,
      rw add_succ,
      rw pred_succ_eq,
      rw hd,
    },

    -- Pred case
    {
      rw inverse,
      rw add,
      rw add_pred,
      rw succ_pred_eq,
      rw hd,
    },
  end

lemma inverse_add (n : myint) :
  add (inverse n) n = zero :=
  begin
    induction n with d hd d hd,

    -- Base case
    {
      rw inverse,
      rw add,
    },

    -- Succ case
    {
      rw inverse,
      rw add,
      rw add_pred,
      rw succ_pred_eq,
      rw hd,
    },

    -- Pred case
    {
      rw inverse,
      rw add,
      rw add_succ,
      rw pred_succ_eq,
      rw hd,
    },
  end

-- Commutativity, since integers form an abelian group
lemma commutative (m n : myint) :
  add m n = add n m :=
  begin
    induction n with d hd d hd,

    -- Base case
    {
      rw add_zero,
      rw zero_add,
    },

    -- Succ case
    {
      rw add,
      rw add_succ,
      rw hd,
    },

    -- Pred case
    {
      rw add,
      rw add_pred,
      rw hd,
    }
  end

end hidden


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import analysis.convex.join

/-!
# Stone's separation theorem

This file prove Stone's separation theorem. This tells us that any two disjoint convex sets can be
separated by a convex set whose complement is also convex.

In locally convex real topological vector spaces, the Hahn-Banach separation theorems provide
stronger statements: one may find a separating hyperplane, instead of merely a convex set whose
complement is convex.
-/

open set
open_locale big_operators

variables {𝕜 E ι : Type*} [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] {s t : set E}

/-- In a tetrahedron with vertices `x`, `y`, `p`, `q`, any segment `[u, v]` joining the opposite
edges `[x, p]` and `[y, q]` passes through any triangle of vertices `p`, `q`, `z` where
`z ∈ [x, y]`. -/
lemma not_disjoint_segment_convex_hull_triple {p q u v x y z : E}
  (hz : z ∈ segment 𝕜 x y) (hu : u ∈ segment 𝕜 x p) (hv : v ∈ segment 𝕜 y q) :
  ¬ disjoint (segment 𝕜 u v) (convex_hull 𝕜 {p, q, z}) :=
begin
  rw not_disjoint_iff,
  obtain ⟨az, bz, haz, hbz, habz, rfl⟩ := hz,
  obtain rfl | haz' := haz.eq_or_lt,
  { rw zero_add at habz,
    rw [zero_smul, zero_add, habz, one_smul],
    refine ⟨v, right_mem_segment _ _ _, segment_subset_convex_hull _ _ hv⟩; simp },
  obtain ⟨av, bv, hav, hbv, habv, rfl⟩ := hv,
  obtain rfl | hav' := hav.eq_or_lt,
  { rw zero_add at habv,
    rw [zero_smul, zero_add, habv, one_smul],
    exact ⟨q, right_mem_segment _ _ _, subset_convex_hull _ _ $ by simp⟩ },
  obtain ⟨au, bu, hau, hbu, habu, rfl⟩ := hu,
  have hab : 0 < az * av + bz * au :=
    add_pos_of_pos_of_nonneg (mul_pos haz' hav') (mul_nonneg hbz hau),
  refine ⟨(az * av / (az * av + bz * au)) • (au • x + bu • p) +
          (bz * au / (az * av + bz * au)) • (av • y + bv • q), ⟨_, _, _, _, _, rfl⟩, _⟩,
  { exact div_nonneg (mul_nonneg haz hav) hab.le },
  { exact div_nonneg (mul_nonneg hbz hau) hab.le },
  { rw [←add_div, div_self hab.ne'] },
  rw [smul_add, smul_add, add_add_add_comm, add_comm, ←mul_smul, ←mul_smul],
  classical,
  let w : fin 3 → 𝕜 := ![az * av * bu, bz * au * bv, au * av],
  let z : fin 3 → E := ![p, q, az • x + bz • y],
  have hw₀ : ∀ i, 0 ≤ w i,
  { rintro i,
    fin_cases i,
    { exact mul_nonneg (mul_nonneg haz hav) hbu },
    { exact mul_nonneg (mul_nonneg hbz hau) hbv },
    { exact mul_nonneg hau hav } },
  have hw : ∑ i, w i = az * av + bz * au,
  { transitivity az * av * bu + (bz * au * bv + au * av),
    { simp [w, fin.sum_univ_succ, fin.sum_univ_zero] },
    rw [←one_mul (au * av), ←habz, add_mul, ←add_assoc, add_add_add_comm, mul_assoc, ←mul_add,
      mul_assoc, ←mul_add, mul_comm av, ←add_mul, ←mul_add, add_comm bu, add_comm bv, habu, habv,
      one_mul, mul_one] },
  have hz : ∀ i, z i ∈ ({p, q, az • x + bz • y} : set E),
  { rintro i,
    fin_cases i; simp [z] },
  convert finset.center_mass_mem_convex_hull (finset.univ : finset (fin 3)) (λ i _, hw₀ i)
    (by rwa hw) (λ i _, hz i),
  rw finset.center_mass,
  simp_rw [div_eq_inv_mul, hw, mul_assoc, mul_smul (az * av + bz * au)⁻¹, ←smul_add, add_assoc,
    ←mul_assoc],
  congr' 3,
  rw [←mul_smul, ←mul_rotate, mul_right_comm, mul_smul, ←mul_smul _ av, mul_rotate, mul_smul _ bz,
    ←smul_add],
  simp only [list.map, list.pmap, nat.add_def, add_zero, fin.mk_bit0,
    fin.mk_one, list.foldr_cons, list.foldr_nil],
  refl,
end

/-- **Stone's Separation Theorem** -/
lemma exists_convex_convex_compl_subset (hs : convex 𝕜 s) (ht : convex 𝕜 t) (hst : disjoint s t) :
  ∃ C : set E, convex 𝕜 C ∧ convex 𝕜 Cᶜ ∧ s ⊆ C ∧ t ⊆ Cᶜ :=
begin
  let S : set (set E) := {C | convex 𝕜 C ∧ disjoint C t},
  obtain ⟨C, hC, hsC, hCmax⟩ := zorn_subset_nonempty S
    (λ c hcS hc ⟨t, ht⟩, ⟨⋃₀ c, ⟨hc.directed_on.convex_sUnion (λ s hs, (hcS hs).1),
     disjoint_sUnion_left.2 $ λ c hc, (hcS hc).2⟩, λ s, subset_sUnion_of_mem⟩) s ⟨hs, hst⟩,
  refine ⟨C, hC.1, convex_iff_segment_subset.2 $ λ x hx y hy z hz hzC, _, hsC,
     hC.2.subset_compl_left⟩,
  suffices h : ∀ c ∈ Cᶜ, ∃ a ∈ C, (segment 𝕜 c a ∩ t).nonempty,
  { obtain ⟨p, hp, u, hu, hut⟩ := h x hx,
    obtain ⟨q, hq, v, hv, hvt⟩ := h y hy,
    refine not_disjoint_segment_convex_hull_triple hz hu hv
      (hC.2.symm.mono (ht.segment_subset hut hvt) $ convex_hull_min _ hC.1),
    simp [insert_subset, hp, hq, singleton_subset_iff.2 hzC] },
  rintro c hc,
  by_contra' h,
  suffices h : disjoint (convex_hull 𝕜 (insert c C)) t,
  { rw ←hCmax _ ⟨convex_convex_hull _ _, h⟩
      ((subset_insert _ _).trans $ subset_convex_hull _ _) at hc,
    exact hc (subset_convex_hull _ _ $ mem_insert _ _) },
  rw [convex_hull_insert ⟨z, hzC⟩, convex_join_singleton_left],
  refine disjoint_Union₂_left.2 (λ a ha, disjoint_iff_inf_le.mpr $ λ b hb, h a _ ⟨b, hb⟩),
  rwa ←hC.1.convex_hull_eq,
end


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.pure

open_locale classical affine big_operators
open set

namespace affine

variables {m n : ℕ} {E : Type*} [normed_group E] [normed_space ℝ E] {S : simplicial_complex E}
  {x : E} {X Y : finset E} {A B : set (finset E)}

/--
The closure of a set of faces is the set of their subfaces
-/
def simplicial_complex.closure (S : simplicial_complex E) (A : set (finset E)) :
  simplicial_complex E :=
simplicial_complex.of_surcomplex
  {X | X ∈ S.faces ∧ ∃ {X'}, X' ∈ A ∧ X ⊆ X'}
  (λ X ⟨hX, _⟩, hX)
  (λ X Y ⟨hX, X', hX', hXX'⟩ hYX, ⟨S.down_closed hX hYX, X', hX', subset.trans hYX hXX'⟩)

lemma closure_subset :
  (S.closure A).faces ⊆ S.faces :=
λ X ⟨hX, _⟩, hX

--Homonymy problem
lemma closure_empty :
  (S.closure ∅).faces = ∅ :=
begin
  unfold simplicial_complex.closure,
  simp,
end

lemma closure_singleton_empty (hS : S.faces.nonempty) :
  (S.closure {∅}).faces = {∅} :=
begin
  ext X,
  split,
  { rintro ⟨hX, X', (hX' : X' = ∅), hXX'⟩,
    rw hX' at hXX',
    exact finset.subset_empty.1 hXX' },
  { rintro (hX : X = ∅),
    rw hX,
    obtain ⟨Y, hY⟩ := hS,
    exact ⟨S.down_closed hY (empty_subset Y), ∅, mem_singleton ∅, subset.refl ∅⟩ }
end

--Homonymy problem
lemma closure_singleton (hx : {x} ∈ S.faces) :
  (S.closure {{x}}).faces = {∅, {x}} :=
begin
  ext Y,
  split,
  { rintro ⟨hY, Z, (hZ : Z = {x}), hYZ⟩,
    rw hZ at hYZ,
    simp only [mem_singleton_iff, mem_insert_iff],
    rwa ← finset.subset_singleton_iff },
  { have hxS : {x} ∈ (S.closure {{x}}).faces := ⟨hx, {x}, rfl, finset.subset.refl {x}⟩,
    simp only [mem_singleton_iff, mem_insert_iff],
    rintro (rfl | rfl),
    { exact empty_mem_faces_of_nonempty (nonempty_of_mem hxS) },
    { assumption } }
end

lemma mem_closure_singleton_iff :
  Y ∈ (S.closure {X}).faces ↔ Y ∈ S.faces ∧ Y ⊆ X :=
begin
  split,
  { rintro ⟨hY, Z, (hZ : Z = X), hYZ⟩,
    rw hZ at hYZ,
    exact ⟨hY, hYZ⟩ },
  { rintro ⟨hY, hYX⟩,
    exact ⟨hY, X, rfl, hYX⟩ }
end

--Homonymy problem
lemma faces_subset_closure :
  S.faces ∩ A ⊆ (S.closure A).faces :=
λ X hX, ⟨hX.1, X, hX.2, subset.refl _⟩

lemma closure_faces_subset_of_subset (hAB : A ⊆ B) :
  (S.closure A).faces ⊆ (S.closure B).faces :=
λ X ⟨hX, Y, hY, hXY⟩, ⟨hX, Y, hAB hY, hXY⟩

lemma closure_facets_eq (hA : A ⊆ S.faces) (hAtop : ∀ ⦃X Y⦄, X ∈ A → Y ∈ A → X ⊆ Y → X = Y) :
  (S.closure A).facets = A :=
begin
  ext X,
  split,
  { rintro ⟨⟨hX, Y, hY, hXY⟩, hXmax⟩,
    rw hXmax ⟨hA hY, Y, hY, finset.subset.refl _⟩ hXY,
    exact hY },
  { rintro hX,
    use ⟨hA hX, X, hX, finset.subset.refl _⟩,
    rintro Y ⟨hY, Z, hZ, hYZ⟩ hXY,
    have hXZ := hAtop hX hZ (subset.trans hXY hYZ),
    rw ←hXZ at hYZ,
    exact finset.subset.antisymm hXY hYZ }
end

lemma pure_closure_of_pure (hS : S.pure_of n)
  (hA : ∀ {W}, W ∈ A → ∃ {X}, X ∈ A ∧ X ∈ S.faces ∧ (X : finset E).card = m) :
  (S.closure A).pure_of m :=
begin
  sorry
end

end affine


/-
Copyright (c) 2022 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Junyan Xu, Anne Baanen
-/
import linear_algebra.basis
import ring_theory.localization.fraction_ring
import ring_theory.localization.integer

/-!
# Modules / vector spaces over localizations / fraction fields

This file contains some results about vector spaces over the field of fractions of a ring.

## Main results

 * `linear_independent.localization`: `b` is linear independent over a localization of `R`
   if it is linear independent over `R` itself
 * `basis.localization_localization`: promote an `R`-basis `b` of `A` to an `Rₛ`-basis of `Aₛ`,
   where `Rₛ` and `Aₛ` are localizations of `R` and `A` at `s` respectively
 * `linear_independent.iff_fraction_ring`: `b` is linear independent over `R` iff it is
   linear independent over `Frac(R)`
-/

open_locale big_operators
open_locale non_zero_divisors

section localization

variables {R : Type*} (Rₛ : Type*) [comm_ring R] [comm_ring Rₛ] [algebra R Rₛ]
variables (S : submonoid R) [hT : is_localization S Rₛ]

include hT

section add_comm_monoid
variables {M : Type*} [add_comm_monoid M] [module R M] [module Rₛ M] [is_scalar_tower R Rₛ M]

lemma linear_independent.localization {ι : Type*} {b : ι → M} (hli : linear_independent R b) :
  linear_independent Rₛ b :=
begin
  rw linear_independent_iff' at ⊢ hli,
  intros s g hg i hi,
  choose! a g' hg' using is_localization.exist_integer_multiples S s g,
  specialize hli s g' _ i hi,
  { rw [← @smul_zero _ M _ _ (a : R), ← hg, finset.smul_sum],
    refine finset.sum_congr rfl (λ i hi, _),
    rw [← is_scalar_tower.algebra_map_smul Rₛ, hg' i hi, smul_assoc],
    apply_instance },
  refine ((is_localization.map_units Rₛ a).mul_right_eq_zero).mp _,
  rw [← algebra.smul_def, ← map_zero (algebra_map R Rₛ), ← hli, hg' i hi],
end
end add_comm_monoid

section localization_localization

variables {A : Type*} [comm_ring A] [algebra R A]
variables (Aₛ : Type*) [comm_ring Aₛ] [algebra A Aₛ]
variables [algebra Rₛ Aₛ] [algebra R Aₛ] [is_scalar_tower R Rₛ Aₛ] [is_scalar_tower R A Aₛ]
variables [hA : is_localization (algebra.algebra_map_submonoid A S) Aₛ]
include hA

open submodule

lemma linear_independent.localization_localization
  {ι : Type*} {v : ι → A} (hv : linear_independent R v) :
  linear_independent Rₛ (algebra_map A Aₛ ∘ v) :=
begin
  rw linear_independent_iff' at ⊢ hv,
  intros s g hg i hi,
  choose! a g' hg' using is_localization.exist_integer_multiples S s g,
  have h0 : algebra_map A Aₛ (∑ i in s, g' i • v i) = 0,
  { apply_fun ((•) (a : R)) at hg,
    rw [smul_zero, finset.smul_sum] at hg,
    rw [map_sum, ← hg],
    refine finset.sum_congr rfl (λ i hi, _),
    rw [← smul_assoc, ← hg' i hi, algebra.smul_def, map_mul,
        ← is_scalar_tower.algebra_map_apply, ← algebra.smul_def, algebra_map_smul] },
  obtain ⟨⟨_, r, hrS, rfl⟩, (hr : algebra_map R A r * _ = 0)⟩ :=
    (is_localization.map_eq_zero_iff (algebra.algebra_map_submonoid A S) _ _).1 h0,
  simp_rw [finset.mul_sum, ← algebra.smul_def, smul_smul] at hr,
  specialize hv s _ hr i hi,
  rw [← (is_localization.map_units Rₛ a).mul_right_eq_zero, ← algebra.smul_def, ← hg' i hi],
  exact (is_localization.map_eq_zero_iff S _ _).2 ⟨⟨r, hrS⟩, hv⟩,
end

lemma span_eq_top.localization_localization {v : set A} (hv : span R v = ⊤) :
  span Rₛ (algebra_map A Aₛ '' v) = ⊤ :=
begin
  rw eq_top_iff,
  rintros a' -,
  obtain ⟨a, ⟨_, s, hs, rfl⟩, rfl⟩ := is_localization.mk'_surjective
    (algebra.algebra_map_submonoid A S) a',
  rw [is_localization.mk'_eq_mul_mk'_one, mul_comm, ← map_one (algebra_map R A)],
  erw ← is_localization.algebra_map_mk' A Rₛ Aₛ (1 : R) ⟨s, hs⟩, -- `erw` needed to unify `⟨s, hs⟩`
  rw ← algebra.smul_def,
  refine smul_mem _ _ (span_subset_span R _ _ _),
  rw [← algebra.coe_linear_map, ← linear_map.coe_restrict_scalars R, ← linear_map.map_span],
  exact mem_map_of_mem (hv.symm ▸ mem_top),
  { apply_instance }
end

/-- If `A` has an `R`-basis, then localizing `A` at `S` has a basis over `R` localized at `S`.

A suitable instance for `[algebra A Aₛ]` is `localization_algebra`.
-/
noncomputable def basis.localization_localization {ι : Type*} (b : basis ι R A) : basis ι Rₛ Aₛ :=
basis.mk
  (b.linear_independent.localization_localization _ S _)
  (by { rw [set.range_comp, span_eq_top.localization_localization Rₛ S Aₛ b.span_eq],
        exact le_rfl })

@[simp] lemma basis.localization_localization_apply {ι : Type*} (b : basis ι R A) (i) :
  b.localization_localization Rₛ S Aₛ i = algebra_map A Aₛ (b i) :=
basis.mk_apply _ _ _

@[simp] lemma basis.localization_localization_repr_algebra_map
  {ι : Type*} (b : basis ι R A) (x i) :
  (b.localization_localization Rₛ S Aₛ).repr (algebra_map A Aₛ x) i =
    algebra_map R Rₛ (b.repr x i) :=
calc (b.localization_localization Rₛ S Aₛ).repr (algebra_map A Aₛ x) i
    = (b.localization_localization Rₛ S Aₛ).repr
        ((b.repr x).sum (λ j c, algebra_map R Rₛ c • algebra_map A Aₛ (b j))) i :
  by simp_rw [is_scalar_tower.algebra_map_smul, algebra.smul_def,
              is_scalar_tower.algebra_map_apply R A Aₛ, ← _root_.map_mul, ← map_finsupp_sum,
              ← algebra.smul_def, ← finsupp.total_apply, basis.total_repr]
... = (b.repr x).sum (λ j c, algebra_map R Rₛ c • finsupp.single j 1 i) :
  by simp_rw [← b.localization_localization_apply Rₛ S Aₛ, map_finsupp_sum,
              linear_equiv.map_smul, basis.repr_self, finsupp.sum_apply, finsupp.smul_apply]
... = _ : finset.sum_eq_single i
            (λ j _ hj, by simp [hj])
            (λ hi, by simp [finsupp.not_mem_support_iff.mp hi])
... = algebra_map R Rₛ (b.repr x i) : by simp [algebra.smul_def]

end localization_localization

end localization

section fraction_ring

variables (R K : Type*) [comm_ring R] [field K] [algebra R K] [is_fraction_ring R K]
variables {V : Type*} [add_comm_group V] [module R V] [module K V] [is_scalar_tower R K V]

lemma linear_independent.iff_fraction_ring {ι : Type*} {b : ι → V} :
  linear_independent R b ↔ linear_independent K b :=
⟨linear_independent.localization K (R⁰),
 linear_independent.restrict_scalars (smul_left_injective R one_ne_zero)⟩

end fraction_ring