diff --git a/.github/workflows/add_ported_warnings.yml b/.github/workflows/add_ported_warnings.yml
new file mode 100644
index 0000000000000..b80932bc22d8a
--- /dev/null
+++ b/.github/workflows/add_ported_warnings.yml
@@ -0,0 +1,29 @@
+name: Add mathlib4 porting warnings
+
+on:
+  pull_request:
+
+jobs:
+  build:
+    name: Check for modifications to ported files
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v3
+
+      - name: install Python
+        uses: actions/setup-python@v3
+        with:
+          python-version: 3.8
+
+      - name: install latest mathlibtools
+        run: |
+          pip install git+https://github.com/leanprover-community/mathlib-tools
+
+      # TODO: is this really faster than just calling git from python?
+      - name: Get changed files
+        id: changed-files
+        uses: tj-actions/changed-files@v34
+
+      - name: run the script
+        run: |
+          python scripts/detect_ported_files.py ${{ steps.changed-files.outputs.all_changed_files }}
diff --git a/archive/100-theorems-list/16_abel_ruffini.lean b/archive/100-theorems-list/16_abel_ruffini.lean
index 8504650903498..b377089fa8056 100644
--- a/archive/100-theorems-list/16_abel_ruffini.lean
+++ b/archive/100-theorems-list/16_abel_ruffini.lean
@@ -3,11 +3,13 @@ Copyright (c) 2021 Thomas Browning. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning
 -/
-import field_theory.abel_ruffini
 import analysis.calculus.local_extr
+import data.nat.prime_norm_num
+import field_theory.abel_ruffini
 import ring_theory.eisenstein_criterion
+
 /-!
-Construction of an algebraic number that is not solvable by radicals.
+# Construction of an algebraic number that is not solvable by radicals.
 
 The main ingredients are:
  * `solvable_by_rad.is_solvable'` in `field_theory/abel_ruffini` :
@@ -131,7 +133,7 @@ begin
   have q_ne_zero : Φ ℚ a b ≠ 0 := (monic_Phi a b).ne_zero,
   obtain ⟨x, y, hxy, hx, hy⟩ := real_roots_Phi_ge_aux a b hab,
   have key : ↑({x, y} : finset ℝ) ⊆ (Φ ℚ a b).root_set ℝ,
-  { simp [set.insert_subset, mem_root_set q_ne_zero, hx, hy] },
+  { simp [set.insert_subset, mem_root_set_of_ne q_ne_zero, hx, hy] },
   convert fintype.card_le_of_embedding (set.embedding_of_subset _ _ key),
   simp only [finset.coe_sort_coe, fintype.card_coe, finset.card_singleton,
              finset.card_insert_of_not_mem (mt finset.mem_singleton.mp hxy)]
diff --git a/archive/100-theorems-list/42_inverse_triangle_sum.lean b/archive/100-theorems-list/42_inverse_triangle_sum.lean
index bb722ed24db98..063c4d35bf0b7 100644
--- a/archive/100-theorems-list/42_inverse_triangle_sum.lean
+++ b/archive/100-theorems-list/42_inverse_triangle_sum.lean
@@ -3,6 +3,7 @@ Copyright (c) 2020. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jalex Stark, Yury Kudryashov
 -/
+import algebra.big_operators.basic
 import data.real.basic
 
 /-!
diff --git a/archive/100-theorems-list/82_cubing_a_cube.lean b/archive/100-theorems-list/82_cubing_a_cube.lean
index a7d7e8b2174b8..330a23188f703 100644
--- a/archive/100-theorems-list/82_cubing_a_cube.lean
+++ b/archive/100-theorems-list/82_cubing_a_cube.lean
@@ -3,10 +3,9 @@ Copyright (c) 2019 Floris van Doorn. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn
 -/
-import data.fin.tuple
 import data.real.basic
+import data.set.finite
 import data.set.intervals
-import data.set.pairwise
 
 /-!
 Proof that a cube (in dimension n ≥ 3) cannot be cubed:
diff --git a/archive/imo/imo1988_q6.lean b/archive/imo/imo1988_q6.lean
index ffceec71d3b10..9260dd93be09a 100644
--- a/archive/imo/imo1988_q6.lean
+++ b/archive/imo/imo1988_q6.lean
@@ -8,6 +8,7 @@ import data.nat.prime
 import data.rat.defs
 import order.well_founded
 import tactic.linarith
+import tactic.wlog
 
 /-!
 # IMO 1988 Q6 and constant descent Vieta jumping
@@ -111,8 +112,8 @@ begin
       -- And hence we are done by H_zero and H_diag.
       solve_by_elim } },
   -- To finish the main proof, we need to show that the exceptional locus is nonempty.
-  -- So we assume that the exceptional locus is empty, and work towards dering a contradiction.
-  rw ← set.ne_empty_iff_nonempty,
+  -- So we assume that the exceptional locus is empty, and work towards deriving a contradiction.
+  rw set.nonempty_iff_ne_empty,
   assume exceptional_empty,
   -- Observe that S is nonempty.
   have S_nonempty : S.nonempty,
diff --git a/archive/imo/imo1998_q2.lean b/archive/imo/imo1998_q2.lean
index 3c897525b8abe..c4133b49d376e 100644
--- a/archive/imo/imo1998_q2.lean
+++ b/archive/imo/imo1998_q2.lean
@@ -3,7 +3,7 @@ Copyright (c) 2020 Oliver Nash. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Oliver Nash
 -/
-import data.fintype.basic
+import data.fintype.prod
 import data.int.parity
 import algebra.big_operators.order
 import tactic.ring
@@ -138,7 +138,7 @@ lemma norm_bound_of_odd_sum {x y z : ℤ} (h : x + y = 2*z + 1) :
   2*z*z + 2*z + 1 ≤ x*x + y*y :=
 begin
   suffices : 4*z*z + 4*z + 1 + 1 ≤ 2*x*x + 2*y*y,
-  { rw ← mul_le_mul_left (@zero_lt_two _ _ int.nontrivial), convert this; ring, },
+  { rw ← mul_le_mul_left (zero_lt_two' ℤ), convert this; ring, },
   have h' : (x + y) * (x + y) = 4*z*z + 4*z + 1, { rw h, ring, },
   rw [← add_sq_add_sq_sub, h', add_le_add_iff_left],
   suffices : 0 < (x - y) * (x - y), { apply int.add_one_le_of_lt this, },
diff --git a/archive/imo/imo2005_q4.lean b/archive/imo/imo2005_q4.lean
index 76ea4b2f299f6..c6d854167e288 100644
--- a/archive/imo/imo2005_q4.lean
+++ b/archive/imo/imo2005_q4.lean
@@ -80,7 +80,7 @@ begin
   have hp : nat.prime p := nat.min_fac_prime hk',
   -- So `3 ≤ p`
   have hp₃ : 3 ≤ p,
-  { have : 2 ≠ p := by rwa nat.coprime_primes (by norm_num : nat.prime 2) hp at hp₂,
+  { have : 2 ≠ p := by rwa nat.coprime_primes nat.prime_two hp at hp₂,
     apply nat.lt_of_le_and_ne hp.two_le this, },
   -- Testing the special property of `k` for the `p - 2`th term of the sequence, we see that `p` is
   -- coprime to `a (p - 2)`.
diff --git a/counterexamples/char_p_zero_ne_char_zero.lean b/counterexamples/char_p_zero_ne_char_zero.lean
index 39d631178bad0..36fd17d6adcf9 100644
--- a/counterexamples/char_p_zero_ne_char_zero.lean
+++ b/counterexamples/char_p_zero_ne_char_zero.lean
@@ -18,11 +18,8 @@ This file shows that there are semiring `R` for which `char_p R 0` holds and `ch
 The example is `{0, 1}` with saturating addition.
 -/
 
-local attribute [semireducible] with_zero
-
-@[simp] lemma add_one_eq_one : ∀ (x : with_zero unit), x + 1 = 1
-| 0 := rfl
-| 1 := rfl
+@[simp] lemma add_one_eq_one (x : with_zero unit) : x + 1 = 1 :=
+with_zero.cases_on x (by refl) (λ h, by refl)
 
 lemma with_zero_unit_char_p_zero : char_p (with_zero unit) 0 :=
 ⟨λ x, by cases x; simp⟩
diff --git a/counterexamples/direct_sum_is_internal.lean b/counterexamples/direct_sum_is_internal.lean
index 2153f27c4098c..c9febdae9b63d 100644
--- a/counterexamples/direct_sum_is_internal.lean
+++ b/counterexamples/direct_sum_is_internal.lean
@@ -5,6 +5,7 @@ Authors: Eric Wieser, Kevin Buzzard
 -/
 
 import algebra.direct_sum.module
+import algebra.group.conj_finite
 import tactic.fin_cases
 
 /-!
diff --git a/counterexamples/homogeneous_prime_not_prime.lean b/counterexamples/homogeneous_prime_not_prime.lean
index 9532317504c1c..8b9f1a9328952 100644
--- a/counterexamples/homogeneous_prime_not_prime.lean
+++ b/counterexamples/homogeneous_prime_not_prime.lean
@@ -118,14 +118,14 @@ instance : graded_algebra (grading R) :=
 /-- The counterexample is the ideal `I = span {(2, 2)}`. -/
 def I : ideal (R × R) := ideal.span {((2, 2) : (R × R))}.
 
-set_option class.instance_max_depth 33
+set_option class.instance_max_depth 34
 
 lemma I_not_prime : ¬ I.is_prime :=
 begin
   rintro ⟨rid1, rid2⟩,
   apply rid1, clear rid1, revert rid2,
   simp only [I, ideal.mem_span_singleton, ideal.eq_top_iff_one],
-  dec_trivial, -- this is what we change the max instance depth for, it's only 1 above the default
+  dec_trivial, -- this is what we change the max instance depth for, it's only 2 above the default
 end
 
 set_option class.instance_max_depth 32
diff --git a/counterexamples/phillips.lean b/counterexamples/phillips.lean
index 95067c8ce8e41..1be7228367598 100644
--- a/counterexamples/phillips.lean
+++ b/counterexamples/phillips.lean
@@ -532,7 +532,7 @@ begin
     ⊆ ⋃ y ∈ φ.to_bounded_additive_measure.discrete_support, {x | y ∈ spf Hcont x},
   { assume x hx,
     dsimp at hx,
-    rw [← ne.def, ne_empty_iff_nonempty] at hx,
+    rw [← ne.def, ←nonempty_iff_ne_empty] at hx,
     simp only [exists_prop, mem_Union, mem_set_of_eq],
     exact hx },
   apply countable.mono (subset.trans A B),
diff --git a/scripts/add_port_comments.py b/scripts/add_port_comments.py
index 6511b38e9b65a..7bf81c9db5742 100644
--- a/scripts/add_port_comments.py
+++ b/scripts/add_port_comments.py
@@ -57,23 +57,30 @@ def add_port_status(fcontent: str, fstatus: FileStatus) -> str:
     module_comment_end = module_comment.end(1)
     module_comment = module_comment.group(1)
 
-    # remove any existing comment
-    comment_re = re.compile(
+    # replace any markers that appear at the start of the docstring
+    module_comment = re.compile(
+        r"\A\n((?:> )?)THIS FILE IS SYNCHRONIZED WITH MATHLIB4\."
+        r"(?:\n\1[^\n]+)*\n?",
+        re.MULTILINE
+    ).sub('', module_comment)
+
+    # markers which appear with two blank lines before
+    module_comment = re.compile(
         r"\n{,2}((?:> )?)THIS FILE IS SYNCHRONIZED WITH MATHLIB4\."
         r"(?:\n\1[^\n]+)*",
         re.MULTILINE
-    )
-    module_comment = comment_re.sub('', module_comment)
+    ).sub('', module_comment)
 
     # find the header
     header_re = re.compile('(#[^\n]*)', re.MULTILINE)
     existing_header = header_re.search(module_comment)
-    if not existing_header:
-        raise ValueError(f"No header in {module_comment!r}")
-
-    # insert a comment below the header
-    module_comment = replace_range(module_comment, existing_header.end(1), existing_header.end(1),
-        "\n\n" + make_comment(f_status))
+    if existing_header:
+        # insert a comment below the header
+        module_comment = replace_range(module_comment, existing_header.end(1), existing_header.end(1),
+            "\n\n" + make_comment(f_status))
+    else:
+        # insert the comment at the top
+        module_comment = "\n" + make_comment(f_status) + "\n" + module_comment
 
     # and insert the new module docstring
     fcontent = replace_range(fcontent, module_comment_start, module_comment_end, module_comment)
diff --git a/scripts/detect_ported_files.py b/scripts/detect_ported_files.py
new file mode 100644
index 0000000000000..b76308aa5bf31
--- /dev/null
+++ b/scripts/detect_ported_files.py
@@ -0,0 +1,28 @@
+# this script is only intended to be run by CI
+import sys
+from pathlib import Path
+
+from mathlibtools.file_status import PortStatus, FileStatus
+
+status = PortStatus.deserialize_old()
+
+src_path = Path(__file__).parent.parent / 'src'
+
+def encode_msg_text_for_github(msg):
+    # even though this is probably url quoting, we match the implementation at
+    # https://github.com/actions/toolkit/blob/af821474235d3c5e1f49cee7c6cf636abb0874c4/packages/core/src/command.ts#L36-L94
+    return msg.replace('%', '%25').replace('\r', '%0D').replace('\n', '%0A')
+
+def fname_for(import_path: str) -> Path:
+    return src_path / Path(*import_path.split('.')).with_suffix('.lean')
+
+if __name__ == '__main__':
+    files = [Path(f) for f in sys.argv[1:]]
+    for iname, f_status in status.file_statuses.items():
+        if f_status.ported:
+            fname = fname_for(iname)
+            if fname in files:
+                msg = ("Changes to this file will need to be ported to mathlib 4!\n"
+                    "Please consider retracting the changes to this file unless you are willing "
+                    "to immediately forward-port them." )
+                print(f"::warning file={fname},line=1,col=1::{encode_msg_text_for_github(msg)}")
diff --git a/scripts/port_status.py b/scripts/port_status.py
index e529e7985dca5..d4456453058a1 100755
--- a/scripts/port_status.py
+++ b/scripts/port_status.py
@@ -8,18 +8,20 @@
 from mathlibtools.lib import PortStatus, LeanProject, FileStatus
 from sys import argv
 from pathlib import Path
+import shlex
 
 import_re = re.compile(r"^import ([^ ]*)")
 synchronized_re = re.compile(r".*SYNCHRONIZED WITH MATHLIB4.*")
 hash_re = re.compile(r"[0-9a-f]*")
 
-# not using re.compile as this is passed to git
-comment_git_re = '^' + '|'.join(re.escape(line) for line in [
-    "> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.",
-    "> https://github.com/leanprover-community/mathlib4/pull/.*",
-    "> Any changes to this file require a corresponding PR to mathlib4.",
-    ""
-]) + '$'
+# Not using re.compile as this is passed to git which uses a different regex dialect:
+# https://www.sjoerdlangkemper.nl/2021/08/13/how-does-git-diff-ignore-matching-lines-work/
+comment_git_re = r'\`(' + r'|'.join([
+    re.escape("> THIS FILE IS SYNCHRONIZED WITH MATHLIB4."),
+    re.escape("> https://github.com/leanprover-community/mathlib4/pull/") + r"[0-9]*",
+    re.escape("> Any changes to this file require a corresponding PR to mathlib4."),
+    r"",
+]) + r")" + "\n"
 
 proj = LeanProject.from_path(Path(__file__).parent.parent)
 
@@ -69,12 +71,12 @@ def mk_label(path: Path) -> str:
 for node in graph.nodes:
     if data[node].mathlib3_hash:
         verified[node] = data[node].mathlib3_hash
-        git_command = ['git', 'diff', '--name-only',
+        git_command = ['git', 'diff', '--quiet',
             f'--ignore-matching-lines={comment_git_re}',
-            data[node].mathlib3_hash + "..HEAD", "src" + os.sep + node.replace('.', os.sep) + ".lean"]
-        result = subprocess.run(git_command, stdout=subprocess.PIPE)
-        if result.stdout != b'':
-            del(git_command[2:4])
+            data[node].mathlib3_hash + "..HEAD", "--", "src" + os.sep + node.replace('.', os.sep) + ".lean"]
+        result = subprocess.run(git_command)
+        if result.returncode == 1:
+            git_command.remove('--quiet')
             touched[node] = git_command
     elif data[node].ported:
         print("Bad status for " + node)
@@ -120,4 +122,4 @@ def mk_label(path: Path) -> str:
     print()
     print('# The following files have been modified since the commit at which they were verified.')
     for v in touched.values():
-        print(' '.join(v))
+        print(' '.join(shlex.quote(vi) for vi in v))
diff --git a/src/algebra/add_torsor.lean b/src/algebra/add_torsor.lean
index 2ac1976a1a76d..09deb0a0fe63f 100644
--- a/src/algebra/add_torsor.lean
+++ b/src/algebra/add_torsor.lean
@@ -3,7 +3,7 @@ Copyright (c) 2020 Joseph Myers. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Myers, Yury Kudryashov
 -/
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 
 /-!
 # Torsors of additive group actions
diff --git a/src/algebra/algebra/basic.lean b/src/algebra/algebra/basic.lean
index 9194f766831e1..a20c4ffa7eb78 100644
--- a/src/algebra/algebra/basic.lean
+++ b/src/algebra/algebra/basic.lean
@@ -28,27 +28,18 @@ See the implementation notes for remarks about non-associative and non-unital al
 ## Main definitions:
 
 * `algebra R A`: the algebra typeclass.
-* `alg_hom R A B`: the type of `R`-algebra morphisms from `A` to `B`.
-* `alg_equiv R A B`: the type of `R`-algebra isomorphisms between `A` to `B`.
 * `algebra_map R A : R →+* A`: the canonical map from `R` to `A`, as a `ring_hom`. This is the
-  preferred spelling of this map.
-* `algebra.linear_map R A : R →ₗ[R] A`: the canonical map from `R` to `A`, as a `linear_map`.
-* `algebra.of_id R A : R →ₐ[R] A`: the canonical map from `R` to `A`, as n `alg_hom`.
+  preferred spelling of this map, it is also available as:
+  * `algebra.linear_map R A : R →ₗ[R] A`, a `linear_map`.
+  * `algebra.of_id R A : R →ₐ[R] A`, an `alg_hom` (defined in a later file).
 * Instances of `algebra` in this file:
   * `algebra.id`
-  * `pi.algebra`
-  * `prod.algebra`
   * `algebra_nat`
   * `algebra_int`
   * `algebra_rat`
   * `mul_opposite.algebra`
   * `module.End.algebra`
 
-## Notations
-
-* `A →ₐ[R] B` : `R`-algebra homomorphism from `A` to `B`.
-* `A ≃ₐ[R] B` : `R`-algebra equivalence from `A` to `B`.
-
 ## Implementation notes
 
 Given a commutative (semi)ring `R`, there are two ways to define an `R`-algebra structure on a
@@ -419,22 +410,6 @@ lemma _root_.ulift.algebra_map_eq (r : R) :
 
 end ulift
 
-section prod
-variables (R A B)
-
-instance _root_.prod.algebra : algebra R (A × B) :=
-{ commutes' := by { rintro r ⟨a, b⟩, dsimp, rw [commutes r a, commutes r b] },
-  smul_def' := by { rintro r ⟨a, b⟩, dsimp, rw [smul_def r a, smul_def r b] },
-  .. prod.module,
-  .. ring_hom.prod (algebra_map R A) (algebra_map R B) }
-
-variables {R A B}
-
-@[simp] lemma algebra_map_prod_apply (r : R) :
-  algebra_map R (A × B) r = (algebra_map R A r, algebra_map R B r) := rfl
-
-end prod
-
 /-- Algebra over a subsemiring. This builds upon `subsemiring.module`. -/
 instance of_subsemiring (S : subsemiring R) : algebra S A :=
 { smul := (•),
@@ -608,847 +583,11 @@ by rw [←algebra.commutes, ←algebra.commutes, map_algebra_map_mul]
 
 end linear_map
 
-set_option old_structure_cmd true
-/-- Defining the homomorphism in the category R-Alg. -/
-@[nolint has_nonempty_instance]
-structure alg_hom (R : Type u) (A : Type v) (B : Type w)
-  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] extends ring_hom A B :=
-(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r)
-
-run_cmd tactic.add_doc_string `alg_hom.to_ring_hom "Reinterpret an `alg_hom` as a `ring_hom`"
-
-infixr ` →ₐ `:25 := alg_hom _
-notation A ` →ₐ[`:25 R `] ` B := alg_hom R A B
-
-/-- `alg_hom_class F R A B` asserts `F` is a type of bundled algebra homomorphisms
-from `A` to `B`.  -/
-class alg_hom_class (F : Type*) (R : out_param Type*) (A : out_param Type*) (B : out_param Type*)
-  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
-  extends ring_hom_class F A B :=
-(commutes : ∀ (f : F) (r : R), f (algebra_map R A r) = algebra_map R B r)
-
--- `R` becomes a metavariable but that's fine because it's an `out_param`
-attribute [nolint dangerous_instance] alg_hom_class.to_ring_hom_class
-
-attribute [simp] alg_hom_class.commutes
-
-namespace alg_hom_class
-
-variables {R : Type*} {A : Type*} {B : Type*} [comm_semiring R] [semiring A] [semiring B]
-  [algebra R A] [algebra R B]
-
-@[priority 100] -- see Note [lower instance priority]
-instance {F : Type*} [alg_hom_class F R A B] : linear_map_class F R A B :=
-{ map_smulₛₗ := λ f r x, by simp only [algebra.smul_def, map_mul, commutes, ring_hom.id_apply],
-  ..‹alg_hom_class F R A B› }
-
-instance {F : Type*} [alg_hom_class F R A B] : has_coe_t F (A →ₐ[R] B) :=
-{ coe := λ f,
-  { to_fun := f,
-    commutes' := alg_hom_class.commutes f,
-    .. (f : A →+* B) } }
-
-end alg_hom_class
-
-namespace alg_hom
-
-variables {R : Type u} {A : Type v} {B : Type w} {C : Type u₁} {D : Type v₁}
-
-section semiring
-
-variables [comm_semiring R] [semiring A] [semiring B] [semiring C] [semiring D]
-variables [algebra R A] [algebra R B] [algebra R C] [algebra R D]
-
-instance : has_coe_to_fun (A →ₐ[R] B) (λ _, A → B) := ⟨alg_hom.to_fun⟩
-
-initialize_simps_projections alg_hom (to_fun → apply)
-
-@[simp, protected] lemma coe_coe {F : Type*} [alg_hom_class F R A B] (f : F) :
-  ⇑(f : A →ₐ[R] B) = f := rfl
-
-@[simp] lemma to_fun_eq_coe (f : A →ₐ[R] B) : f.to_fun = f := rfl
-
-instance : alg_hom_class (A →ₐ[R] B) R A B :=
-{ coe := to_fun,
-  coe_injective' := λ f g h, by { cases f, cases g, congr' },
-  map_add := map_add',
-  map_zero := map_zero',
-  map_mul := map_mul',
-  map_one := map_one',
-  commutes := λ f, f.commutes' }
-
-instance coe_ring_hom : has_coe (A →ₐ[R] B) (A →+* B) := ⟨alg_hom.to_ring_hom⟩
-
-instance coe_monoid_hom : has_coe (A →ₐ[R] B) (A →* B) := ⟨λ f, ↑(f : A →+* B)⟩
-
-instance coe_add_monoid_hom : has_coe (A →ₐ[R] B) (A →+ B) := ⟨λ f, ↑(f : A →+* B)⟩
-
-@[simp, norm_cast] lemma coe_mk {f : A → B} (h₁ h₂ h₃ h₄ h₅) :
-  ⇑(⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := rfl
-
--- make the coercion the simp-normal form
-@[simp] lemma to_ring_hom_eq_coe (f : A →ₐ[R] B) : f.to_ring_hom = f := rfl
-
-@[simp, norm_cast] lemma coe_to_ring_hom (f : A →ₐ[R] B) : ⇑(f : A →+* B) = f := rfl
-
-@[simp, norm_cast] lemma coe_to_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →* B) = f := rfl
-
-@[simp, norm_cast] lemma coe_to_add_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →+ B) = f := rfl
-
-variables (φ : A →ₐ[R] B)
-
-theorem coe_fn_injective : @function.injective (A →ₐ[R] B) (A → B) coe_fn := fun_like.coe_injective
-
-theorem coe_fn_inj {φ₁ φ₂ : A →ₐ[R] B} : (φ₁ : A → B) = φ₂ ↔ φ₁ = φ₂ := fun_like.coe_fn_eq
-
-theorem coe_ring_hom_injective : function.injective (coe : (A →ₐ[R] B) → (A →+* B)) :=
-λ φ₁ φ₂ H, coe_fn_injective $ show ((φ₁ : (A →+* B)) : A → B) = ((φ₂ : (A →+* B)) : A → B),
-  from congr_arg _ H
-
-theorem coe_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B)  → (A →* B)) :=
-ring_hom.coe_monoid_hom_injective.comp coe_ring_hom_injective
-
-theorem coe_add_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B)  → (A →+ B)) :=
-ring_hom.coe_add_monoid_hom_injective.comp coe_ring_hom_injective
-
-protected lemma congr_fun {φ₁ φ₂ : A →ₐ[R] B} (H : φ₁ = φ₂) (x : A) : φ₁ x = φ₂ x :=
-fun_like.congr_fun H x
-protected lemma congr_arg (φ : A →ₐ[R] B) {x y : A} (h : x = y) : φ x = φ y :=
-fun_like.congr_arg φ h
-
-@[ext]
-theorem ext {φ₁ φ₂ : A →ₐ[R] B} (H : ∀ x, φ₁ x = φ₂ x) : φ₁ = φ₂ := fun_like.ext _ _ H
-
-theorem ext_iff {φ₁ φ₂ : A →ₐ[R] B} : φ₁ = φ₂ ↔ ∀ x, φ₁ x = φ₂ x := fun_like.ext_iff
-
-@[simp] theorem mk_coe {f : A →ₐ[R] B} (h₁ h₂ h₃ h₄ h₅) :
-  (⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := ext $ λ _, rfl
-
-@[simp]
-theorem commutes (r : R) : φ (algebra_map R A r) = algebra_map R B r := φ.commutes' r
-
-theorem comp_algebra_map : (φ : A →+* B).comp (algebra_map R A) = algebra_map R B :=
-ring_hom.ext $ φ.commutes
-
-protected lemma map_add (r s : A) : φ (r + s) = φ r + φ s := map_add _ _ _
-protected lemma map_zero : φ 0 = 0 := map_zero _
-protected lemma map_mul (x y) : φ (x * y) = φ x * φ y := map_mul _ _ _
-protected lemma map_one : φ 1 = 1 := map_one _
-protected lemma map_pow (x : A) (n : ℕ) : φ (x ^ n) = (φ x) ^ n := map_pow _ _ _
-
-@[simp] protected lemma map_smul (r : R) (x : A) : φ (r • x) = r • φ x := map_smul _ _ _
-
-protected lemma map_sum {ι : Type*} (f : ι → A) (s : finset ι) :
-  φ (∑ x in s, f x) = ∑ x in s, φ (f x) := map_sum _ _ _
-
-protected lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) :
-  φ (f.sum g) = f.sum (λ i a, φ (g i a)) := map_finsupp_sum _ _ _
-
-protected lemma map_bit0 (x) : φ (bit0 x) = bit0 (φ x) := map_bit0 _ _
-protected lemma map_bit1 (x) : φ (bit1 x) = bit1 (φ x) := map_bit1 _ _
-
-/-- If a `ring_hom` is `R`-linear, then it is an `alg_hom`. -/
-def mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : A →ₐ[R] B :=
-{ to_fun := f,
-  commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, h, f.map_one],
-  .. f }
-
-@[simp] lemma coe_mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : ⇑(mk' f h) = f := rfl
-
-section
-
-variables (R A)
-/-- Identity map as an `alg_hom`. -/
-protected def id : A →ₐ[R] A :=
-{ commutes' := λ _, rfl,
-  ..ring_hom.id A }
-
-@[simp] lemma coe_id : ⇑(alg_hom.id R A) = id := rfl
-
-@[simp] lemma id_to_ring_hom : (alg_hom.id R A : A →+* A) = ring_hom.id _ := rfl
-
-end
-
-lemma id_apply (p : A) : alg_hom.id R A p = p := rfl
-
-/-- Composition of algebra homeomorphisms. -/
-def comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : A →ₐ[R] C :=
-{ commutes' := λ r : R, by rw [← φ₁.commutes, ← φ₂.commutes]; refl,
-  .. φ₁.to_ring_hom.comp ↑φ₂ }
-
-@[simp] lemma coe_comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : ⇑(φ₁.comp φ₂) = φ₁ ∘ φ₂ := rfl
-
-lemma comp_apply (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) (p : A) : φ₁.comp φ₂ p = φ₁ (φ₂ p) := rfl
-
-lemma comp_to_ring_hom (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) :
-  (φ₁.comp φ₂ : A →+* C) = (φ₁ : B →+* C).comp ↑φ₂ := rfl
-
-@[simp] theorem comp_id : φ.comp (alg_hom.id R A) = φ :=
-ext $ λ x, rfl
-
-@[simp] theorem id_comp : (alg_hom.id R B).comp φ = φ :=
-ext $ λ x, rfl
-
-theorem comp_assoc (φ₁ : C →ₐ[R] D) (φ₂ : B →ₐ[R] C) (φ₃ : A →ₐ[R] B) :
-  (φ₁.comp φ₂).comp φ₃ = φ₁.comp (φ₂.comp φ₃) :=
-ext $ λ x, rfl
-
-/-- R-Alg ⥤ R-Mod -/
-def to_linear_map : A →ₗ[R] B :=
-{ to_fun := φ,
-  map_add' := map_add _,
-  map_smul' := map_smul _ }
-
-@[simp] lemma to_linear_map_apply (p : A) : φ.to_linear_map p = φ p := rfl
-
-theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A →ₗ[R] B)) :=
-λ φ₁ φ₂ h, ext $ linear_map.congr_fun h
-
-@[simp] lemma comp_to_linear_map (f : A →ₐ[R] B) (g : B →ₐ[R] C) :
-  (g.comp f).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl
-
-@[simp] lemma to_linear_map_id : to_linear_map (alg_hom.id R A) = linear_map.id :=
-linear_map.ext $ λ _, rfl
-
-/-- Promote a `linear_map` to an `alg_hom` by supplying proofs about the behavior on `1` and `*`. -/
-@[simps]
-def of_linear_map (f : A →ₗ[R] B) (map_one : f 1 = 1) (map_mul : ∀ x y, f (x * y) = f x * f y) :
-  A →ₐ[R] B :=
-{ to_fun := f,
-  map_one' := map_one,
-  map_mul' := map_mul,
-  commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, f.map_smul, map_one],
-  .. f.to_add_monoid_hom }
-
-@[simp] lemma of_linear_map_to_linear_map (map_one) (map_mul) :
-  of_linear_map φ.to_linear_map map_one map_mul = φ :=
-by { ext, refl }
-
-@[simp] lemma to_linear_map_of_linear_map (f : A →ₗ[R] B) (map_one) (map_mul) :
-  to_linear_map (of_linear_map f map_one map_mul) = f :=
-by { ext, refl }
-
-@[simp] lemma of_linear_map_id (map_one) (map_mul) :
-  of_linear_map linear_map.id map_one map_mul = alg_hom.id R A :=
-ext $ λ _, rfl
-
-lemma map_smul_of_tower {R'} [has_smul R' A] [has_smul R' B]
-  [linear_map.compatible_smul A B R' R] (r : R') (x : A) : φ (r • x) = r • φ x :=
-φ.to_linear_map.map_smul_of_tower r x
-
-lemma map_list_prod (s : list A) :
-  φ s.prod = (s.map φ).prod :=
-φ.to_ring_hom.map_list_prod s
-
-@[simps mul one {attrs := []}] instance End : monoid (A →ₐ[R] A) :=
-{ mul := comp,
-  mul_assoc := λ ϕ ψ χ, rfl,
-  one := alg_hom.id R A,
-  one_mul := λ ϕ, ext $ λ x, rfl,
-  mul_one := λ ϕ, ext $ λ x, rfl }
-
-@[simp] lemma one_apply (x : A) : (1 : A →ₐ[R] A) x = x := rfl
-
-@[simp] lemma mul_apply (φ ψ : A →ₐ[R] A) (x : A) : (φ * ψ) x = φ (ψ x) := rfl
-
-section prod
-
-variables (R A B)
-
-/-- First projection as `alg_hom`. -/
-def fst : A × B →ₐ[R] A :=
-{ commutes' := λ r, rfl, .. ring_hom.fst A B}
-
-/-- Second projection as `alg_hom`. -/
-def snd : A × B →ₐ[R] B :=
-{ commutes' := λ r, rfl, .. ring_hom.snd A B}
-
-variables {R A B}
-
-/-- The `pi.prod` of two morphisms is a morphism. -/
-@[simps] def prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : (A →ₐ[R] B × C) :=
-{ commutes' := λ r, by simp only [to_ring_hom_eq_coe, ring_hom.to_fun_eq_coe, ring_hom.prod_apply,
-    coe_to_ring_hom, commutes, algebra.algebra_map_prod_apply],
-  .. (f.to_ring_hom.prod g.to_ring_hom) }
-
-lemma coe_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : ⇑(f.prod g) = pi.prod f g := rfl
-
-@[simp] theorem fst_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) :
-  (fst R B C).comp (prod f g) = f := by ext; refl
-
-@[simp] theorem snd_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) :
-  (snd R B C).comp (prod f g) = g := by ext; refl
-
-@[simp] theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 :=
-fun_like.coe_injective pi.prod_fst_snd
-
-/-- Taking the product of two maps with the same domain is equivalent to taking the product of
-their codomains. -/
-@[simps] def prod_equiv : ((A →ₐ[R] B) × (A →ₐ[R] C)) ≃ (A →ₐ[R] B × C) :=
-{ to_fun := λ f, f.1.prod f.2,
-  inv_fun := λ f, ((fst _ _ _).comp f, (snd _ _ _).comp f),
-  left_inv := λ f, by ext; refl,
-  right_inv := λ f, by ext; refl }
-
-end prod
-
-lemma algebra_map_eq_apply (f : A →ₐ[R] B) {y : R} {x : A} (h : algebra_map R A y = x) :
-  algebra_map R B y = f x :=
-h ▸ (f.commutes _).symm
-
-end semiring
-
-section comm_semiring
-
-variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
-variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B)
-
-protected lemma map_multiset_prod (s : multiset A) :
-  φ s.prod = (s.map φ).prod := map_multiset_prod _ _
-
-protected lemma map_prod {ι : Type*} (f : ι → A) (s : finset ι) :
-  φ (∏ x in s, f x) = ∏ x in s, φ (f x) := map_prod _ _ _
-
-protected lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) :
-  φ (f.prod g) = f.prod (λ i a, φ (g i a)) := map_finsupp_prod _ _ _
-
-end comm_semiring
-
-section ring
-
-variables [comm_semiring R] [ring A] [ring B]
-variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B)
-
-protected lemma map_neg (x) : φ (-x) = -φ x := map_neg _ _
-protected lemma map_sub (x y) : φ (x - y) = φ x - φ y := map_sub _ _ _
-
-end ring
-
-end alg_hom
 
 @[simp] lemma rat.smul_one_eq_coe {A : Type*} [division_ring A] [algebra ℚ A] (m : ℚ) :
   @@has_smul.smul algebra.to_has_smul m (1 : A) = ↑m :=
 by rw [algebra.smul_def, mul_one, eq_rat_cast]
 
-set_option old_structure_cmd true
-/-- An equivalence of algebras is an equivalence of rings commuting with the actions of scalars. -/
-structure alg_equiv (R : Type u) (A : Type v) (B : Type w)
-  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
-  extends A ≃ B, A ≃* B, A ≃+ B, A ≃+* B :=
-(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r)
-
-attribute [nolint doc_blame] alg_equiv.to_ring_equiv
-attribute [nolint doc_blame] alg_equiv.to_equiv
-attribute [nolint doc_blame] alg_equiv.to_add_equiv
-attribute [nolint doc_blame] alg_equiv.to_mul_equiv
-
-notation A ` ≃ₐ[`:50 R `] ` A' := alg_equiv R A A'
-
-/-- `alg_equiv_class F R A B` states that `F` is a type of algebra structure preserving
-  equivalences. You should extend this class when you extend `alg_equiv`. -/
-class alg_equiv_class (F : Type*) (R A B : out_param Type*)
-  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
-  extends ring_equiv_class F A B :=
-(commutes : ∀ (f : F) (r : R), f (algebra_map R A r) = algebra_map R B r)
-
--- `R` becomes a metavariable but that's fine because it's an `out_param`
-attribute [nolint dangerous_instance] alg_equiv_class.to_ring_equiv_class
-
-namespace alg_equiv_class
-
-@[priority 100] -- See note [lower instance priority]
-instance to_alg_hom_class (F R A B : Type*)
-  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
-  [h : alg_equiv_class F R A B] : alg_hom_class F R A B :=
-{ coe := coe_fn,
-  coe_injective' := fun_like.coe_injective,
-  map_zero := map_zero,
-  map_one := map_one,
-  .. h }
-
-@[priority 100]
-instance to_linear_equiv_class (F R A B : Type*)
-  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
-  [h : alg_equiv_class F R A B] : linear_equiv_class F R A B :=
-{ map_smulₛₗ := λ f, map_smulₛₗ f,
-  ..h }
-
-instance (F R A B : Type*) [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
-  [h : alg_equiv_class F R A B] : has_coe_t F (A ≃ₐ[R] B) :=
-{ coe := λ f,
-  { to_fun := f,
-  inv_fun := equiv_like.inv f,
-  commutes' := alg_hom_class.commutes f,
-  .. (f : A ≃+* B) } }
-
-end alg_equiv_class
-
-namespace alg_equiv
-
-variables {R : Type u} {A₁ : Type v} {A₂ : Type w} {A₃ : Type u₁}
-
-section semiring
-
-variables [comm_semiring R] [semiring A₁] [semiring A₂] [semiring A₃]
-variables [algebra R A₁] [algebra R A₂] [algebra R A₃]
-variables (e : A₁ ≃ₐ[R] A₂)
-
-instance : alg_equiv_class (A₁ ≃ₐ[R] A₂) R A₁ A₂ :=
-{ coe := to_fun,
-  inv := inv_fun,
-  coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' },
-  map_add := map_add',
-  map_mul := map_mul',
-  commutes := commutes',
-  left_inv := left_inv,
-  right_inv := right_inv }
-
-/--  Helper instance for when there's too many metavariables to apply
-`fun_like.has_coe_to_fun` directly. -/
-instance : has_coe_to_fun (A₁ ≃ₐ[R] A₂) (λ _, A₁ → A₂) := ⟨alg_equiv.to_fun⟩
-
-@[simp, protected] lemma coe_coe {F : Type*} [alg_equiv_class F R A₁ A₂] (f : F) :
-  ⇑(f : A₁ ≃ₐ[R] A₂) = f := rfl
-
-@[ext]
-lemma ext {f g : A₁ ≃ₐ[R] A₂} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
-
-protected lemma congr_arg {f : A₁ ≃ₐ[R] A₂} {x x' : A₁} : x = x' → f x = f x' :=
-fun_like.congr_arg f
-
-protected lemma congr_fun {f g : A₁ ≃ₐ[R] A₂} (h : f = g) (x : A₁) : f x = g x :=
-fun_like.congr_fun h x
-
-protected lemma ext_iff {f g : A₁ ≃ₐ[R] A₂} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
-
-lemma coe_fun_injective : @function.injective (A₁ ≃ₐ[R] A₂) (A₁ → A₂) (λ e, (e : A₁ → A₂)) :=
-fun_like.coe_injective
-
-instance has_coe_to_ring_equiv : has_coe (A₁ ≃ₐ[R] A₂) (A₁ ≃+* A₂) := ⟨alg_equiv.to_ring_equiv⟩
-
-@[simp] lemma coe_mk {to_fun inv_fun left_inv right_inv map_mul map_add commutes} :
-  ⇑(⟨to_fun, inv_fun, left_inv, right_inv, map_mul, map_add, commutes⟩ : A₁ ≃ₐ[R] A₂) = to_fun :=
-rfl
-
-@[simp] theorem mk_coe (e : A₁ ≃ₐ[R] A₂) (e' h₁ h₂ h₃ h₄ h₅) :
-  (⟨e, e', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂) = e := ext $ λ _, rfl
-
-@[simp] lemma to_fun_eq_coe (e : A₁ ≃ₐ[R] A₂) : e.to_fun = e := rfl
-
-@[simp] lemma to_equiv_eq_coe : e.to_equiv = e := rfl
-
-@[simp] lemma to_ring_equiv_eq_coe : e.to_ring_equiv = e := rfl
-
-@[simp, norm_cast] lemma coe_ring_equiv : ((e : A₁ ≃+* A₂) : A₁ → A₂) = e := rfl
-
-lemma coe_ring_equiv' : (e.to_ring_equiv : A₁ → A₂) = e := rfl
-
-lemma coe_ring_equiv_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ ≃+* A₂)) :=
-λ e₁ e₂ h, ext $ ring_equiv.congr_fun h
-
-protected lemma map_add : ∀ x y, e (x + y) = e x + e y := map_add e
-protected lemma map_zero : e 0 = 0 := map_zero e
-protected lemma map_mul : ∀ x y, e (x * y) = (e x) * (e y) := map_mul e
-protected lemma map_one : e 1 = 1 := map_one e
-
-@[simp] lemma commutes : ∀ (r : R), e (algebra_map R A₁ r) = algebra_map R A₂ r :=
-  e.commutes'
-
-@[simp] lemma map_smul (r : R) (x : A₁) : e (r • x) = r • e x :=
-by simp only [algebra.smul_def, map_mul, commutes]
-
-lemma map_sum {ι : Type*} (f : ι → A₁) (s : finset ι) :
-  e (∑ x in s, f x) = ∑ x in s, e (f x) :=
-e.to_add_equiv.map_sum f s
-
-lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) :
-  e (f.sum g) = f.sum (λ i b, e (g i b)) :=
-e.map_sum _ _
-
-/-- Interpret an algebra equivalence as an algebra homomorphism.
-
-This definition is included for symmetry with the other `to_*_hom` projections.
-The `simp` normal form is to use the coercion of the `alg_hom_class.has_coe_t` instance. -/
-def to_alg_hom : A₁ →ₐ[R] A₂ :=
-{ map_one' := e.map_one, map_zero' := e.map_zero, ..e }
-
-@[simp] lemma to_alg_hom_eq_coe : e.to_alg_hom = e := rfl
-
-@[simp, norm_cast] lemma coe_alg_hom : ((e : A₁ →ₐ[R] A₂) : A₁ → A₂) = e :=
-rfl
-
-lemma coe_alg_hom_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ →ₐ[R] A₂)) :=
-λ e₁ e₂ h, ext $ alg_hom.congr_fun h
-
-/-- The two paths coercion can take to a `ring_hom` are equivalent -/
-lemma coe_ring_hom_commutes : ((e : A₁ →ₐ[R] A₂) : A₁ →+* A₂) = ((e : A₁ ≃+* A₂) : A₁ →+* A₂) :=
-rfl
-
-protected lemma map_pow : ∀ (x : A₁) (n : ℕ), e (x ^ n) = (e x) ^ n := map_pow _
-protected lemma injective : function.injective e := equiv_like.injective e
-protected lemma surjective : function.surjective e := equiv_like.surjective e
-protected lemma bijective : function.bijective e := equiv_like.bijective e
-
-/-- Algebra equivalences are reflexive. -/
-@[refl] def refl : A₁ ≃ₐ[R] A₁ := {commutes' := λ r, rfl, ..(1 : A₁ ≃+* A₁)}
-
-instance : inhabited (A₁ ≃ₐ[R] A₁) := ⟨refl⟩
-
-@[simp] lemma refl_to_alg_hom : ↑(refl : A₁ ≃ₐ[R] A₁) = alg_hom.id R A₁ := rfl
-
-@[simp] lemma coe_refl : ⇑(refl : A₁ ≃ₐ[R] A₁) = id := rfl
-
-/-- Algebra equivalences are symmetric. -/
-@[symm]
-def symm (e : A₁ ≃ₐ[R] A₂) : A₂ ≃ₐ[R] A₁ :=
-{ commutes' := λ r, by { rw ←e.to_ring_equiv.symm_apply_apply (algebra_map R A₁ r), congr,
-                         change _ = e _, rw e.commutes, },
-  ..e.to_ring_equiv.symm, }
-
-/-- See Note [custom simps projection] -/
-def simps.symm_apply (e : A₁ ≃ₐ[R] A₂) : A₂ → A₁ := e.symm
-
-initialize_simps_projections alg_equiv (to_fun → apply, inv_fun → symm_apply)
-
-@[simp] lemma coe_apply_coe_coe_symm_apply {F : Type*} [alg_equiv_class F R A₁ A₂]
-  (f : F) (x : A₂) : f ((f : A₁ ≃ₐ[R] A₂).symm x) = x := equiv_like.right_inv f x
-
-@[simp] lemma coe_coe_symm_apply_coe_apply {F : Type*} [alg_equiv_class F R A₁ A₂]
-  (f : F) (x : A₁) : (f : A₁ ≃ₐ[R] A₂).symm (f x) = x := equiv_like.left_inv f x
-
-@[simp] lemma inv_fun_eq_symm {e : A₁ ≃ₐ[R] A₂} : e.inv_fun = e.symm := rfl
-
-@[simp] lemma symm_symm (e : A₁ ≃ₐ[R] A₂) : e.symm.symm = e :=
-by { ext, refl, }
-
-lemma symm_bijective : function.bijective (symm : (A₁ ≃ₐ[R] A₂) → (A₂ ≃ₐ[R] A₁)) :=
-equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩
-
-@[simp] lemma mk_coe' (e : A₁ ≃ₐ[R] A₂) (f h₁ h₂ h₃ h₄ h₅) :
-  (⟨f, e, h₁, h₂, h₃, h₄, h₅⟩ : A₂ ≃ₐ[R] A₁) = e.symm :=
-symm_bijective.injective $ ext $ λ x, rfl
-
-@[simp] theorem symm_mk (f f') (h₁ h₂ h₃ h₄ h₅) :
-  (⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm =
-  { to_fun := f', inv_fun := f,
-    ..(⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm } := rfl
-
-@[simp] theorem refl_symm : (alg_equiv.refl : A₁ ≃ₐ[R] A₁).symm = alg_equiv.refl := rfl
-
---this should be a simp lemma but causes a lint timeout
-lemma to_ring_equiv_symm (f : A₁ ≃ₐ[R] A₁) : (f : A₁ ≃+* A₁).symm = f.symm := rfl
-
-@[simp] lemma symm_to_ring_equiv : (e.symm : A₂ ≃+* A₁) = (e : A₁ ≃+* A₂).symm := rfl
-
-/-- Algebra equivalences are transitive. -/
-@[trans]
-def trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : A₁ ≃ₐ[R] A₃ :=
-{ commutes' := λ r, show e₂.to_fun (e₁.to_fun _) = _, by rw [e₁.commutes', e₂.commutes'],
-  ..(e₁.to_ring_equiv.trans e₂.to_ring_equiv), }
-
-@[simp] lemma apply_symm_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e (e.symm x) = x :=
-  e.to_equiv.apply_symm_apply
-
-@[simp] lemma symm_apply_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e.symm (e x) = x :=
-  e.to_equiv.symm_apply_apply
-
-@[simp] lemma symm_trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₃) :
-  (e₁.trans e₂).symm x = e₁.symm (e₂.symm x) := rfl
-
-@[simp] lemma coe_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) :
-  ⇑(e₁.trans e₂) = e₂ ∘ e₁ := rfl
-
-@[simp] lemma trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₁) :
-  (e₁.trans e₂) x = e₂ (e₁ x) := rfl
-
-@[simp] lemma comp_symm (e : A₁ ≃ₐ[R] A₂) :
-  alg_hom.comp (e : A₁ →ₐ[R] A₂) ↑e.symm = alg_hom.id R A₂ :=
-by { ext, simp }
-
-@[simp] lemma symm_comp (e : A₁ ≃ₐ[R] A₂) :
-  alg_hom.comp ↑e.symm (e : A₁ →ₐ[R] A₂) = alg_hom.id R A₁ :=
-by { ext, simp }
-
-theorem left_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.left_inverse e.symm e := e.left_inv
-
-theorem right_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.right_inverse e.symm e := e.right_inv
-
-/-- If `A₁` is equivalent to `A₁'` and `A₂` is equivalent to `A₂'`, then the type of maps
-`A₁ →ₐ[R] A₂` is equivalent to the type of maps `A₁' →ₐ[R] A₂'`. -/
-def arrow_congr {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂'] [algebra R A₁'] [algebra R A₂']
-  (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') : (A₁ →ₐ[R] A₂) ≃ (A₁' →ₐ[R] A₂') :=
-{ to_fun := λ f, (e₂.to_alg_hom.comp f).comp e₁.symm.to_alg_hom,
-  inv_fun := λ f, (e₂.symm.to_alg_hom.comp f).comp e₁.to_alg_hom,
-  left_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, symm_comp],
-    simp only [←alg_hom.comp_assoc, symm_comp, alg_hom.id_comp, alg_hom.comp_id] },
-  right_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, comp_symm],
-    simp only [←alg_hom.comp_assoc, comp_symm, alg_hom.id_comp, alg_hom.comp_id] } }
-
-lemma arrow_congr_comp {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃']
-  [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂')
-  (e₃ : A₃ ≃ₐ[R] A₃') (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₃) :
-  arrow_congr e₁ e₃ (g.comp f) = (arrow_congr e₂ e₃ g).comp (arrow_congr e₁ e₂ f) :=
-by { ext, simp only [arrow_congr, equiv.coe_fn_mk, alg_hom.comp_apply],
-  congr, exact (e₂.symm_apply_apply _).symm }
-
-@[simp] lemma arrow_congr_refl :
-  arrow_congr alg_equiv.refl alg_equiv.refl = equiv.refl (A₁ →ₐ[R] A₂) :=
-by { ext, refl }
-
-@[simp] lemma arrow_congr_trans {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃']
-  [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₂) (e₁' : A₁' ≃ₐ[R] A₂')
-  (e₂ : A₂ ≃ₐ[R] A₃) (e₂' : A₂' ≃ₐ[R] A₃') :
-  arrow_congr (e₁.trans e₂) (e₁'.trans e₂') = (arrow_congr e₁ e₁').trans (arrow_congr e₂ e₂') :=
-by { ext, refl }
-
-@[simp] lemma arrow_congr_symm {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂']
-  [algebra R A₁'] [algebra R A₂'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') :
-  (arrow_congr e₁ e₂).symm = arrow_congr e₁.symm e₂.symm :=
-by { ext, refl }
-
-/-- If an algebra morphism has an inverse, it is a algebra isomorphism. -/
-def of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ : f.comp g = alg_hom.id R A₂)
-  (h₂ : g.comp f = alg_hom.id R A₁) : A₁ ≃ₐ[R] A₂ :=
-{ to_fun    := f,
-  inv_fun   := g,
-  left_inv  := alg_hom.ext_iff.1 h₂,
-  right_inv := alg_hom.ext_iff.1 h₁,
-  ..f }
-
-lemma coe_alg_hom_of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
-  ↑(of_alg_hom f g h₁ h₂) = f := alg_hom.ext $ λ _, rfl
-
-@[simp]
-lemma of_alg_hom_coe_alg_hom (f : A₁ ≃ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
-  of_alg_hom ↑f g h₁ h₂ = f := ext $ λ _, rfl
-
-lemma of_alg_hom_symm (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
-  (of_alg_hom f g h₁ h₂).symm = of_alg_hom g f h₂ h₁ := rfl
-
-/-- Promotes a bijective algebra homomorphism to an algebra equivalence. -/
-noncomputable def of_bijective (f : A₁ →ₐ[R] A₂) (hf : function.bijective f) : A₁ ≃ₐ[R] A₂ :=
-{ .. ring_equiv.of_bijective (f : A₁ →+* A₂) hf, .. f }
-
-@[simp] lemma coe_of_bijective {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} :
-  (alg_equiv.of_bijective f hf : A₁ → A₂) = f := rfl
-
-lemma of_bijective_apply {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} (a : A₁) :
-  (alg_equiv.of_bijective f hf) a = f a := rfl
-
-/-- Forgetting the multiplicative structures, an equivalence of algebras is a linear equivalence. -/
-@[simps apply] def to_linear_equiv (e : A₁ ≃ₐ[R] A₂) : A₁ ≃ₗ[R] A₂ :=
-{ to_fun    := e,
-  map_smul' := e.map_smul,
-  inv_fun   := e.symm,
-  .. e }
-
-@[simp] lemma to_linear_equiv_refl :
-  (alg_equiv.refl : A₁ ≃ₐ[R] A₁).to_linear_equiv = linear_equiv.refl R A₁ := rfl
-
-@[simp] lemma to_linear_equiv_symm (e : A₁ ≃ₐ[R] A₂) :
-  e.to_linear_equiv.symm = e.symm.to_linear_equiv := rfl
-
-@[simp] lemma to_linear_equiv_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) :
-  (e₁.trans e₂).to_linear_equiv = e₁.to_linear_equiv.trans e₂.to_linear_equiv := rfl
-
-theorem to_linear_equiv_injective : function.injective (to_linear_equiv : _ → (A₁ ≃ₗ[R] A₂)) :=
-λ e₁ e₂ h, ext $ linear_equiv.congr_fun h
-
-/-- Interpret an algebra equivalence as a linear map. -/
-def to_linear_map : A₁ →ₗ[R] A₂ :=
-e.to_alg_hom.to_linear_map
-
-@[simp] lemma to_alg_hom_to_linear_map :
-  (e : A₁ →ₐ[R] A₂).to_linear_map = e.to_linear_map := rfl
-
-@[simp] lemma to_linear_equiv_to_linear_map :
-  e.to_linear_equiv.to_linear_map = e.to_linear_map := rfl
-
-@[simp] lemma to_linear_map_apply (x : A₁) : e.to_linear_map x = e x := rfl
-
-theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A₁ →ₗ[R] A₂)) :=
-λ e₁ e₂ h, ext $ linear_map.congr_fun h
-
-@[simp] lemma trans_to_linear_map (f : A₁ ≃ₐ[R] A₂) (g : A₂ ≃ₐ[R] A₃) :
-  (f.trans g).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl
-
-section of_linear_equiv
-
-variables (l : A₁ ≃ₗ[R] A₂)
-  (map_mul : ∀ x y : A₁, l (x * y) = l x * l y)
-  (commutes : ∀ r : R, l (algebra_map R A₁ r) = algebra_map R A₂ r)
-
-/--
-Upgrade a linear equivalence to an algebra equivalence,
-given that it distributes over multiplication and action of scalars.
--/
-@[simps apply]
-def of_linear_equiv : A₁ ≃ₐ[R] A₂ :=
-{ to_fun := l,
-  inv_fun := l.symm,
-  map_mul' := map_mul,
-  commutes' := commutes,
-  ..l }
-
-@[simp]
-lemma of_linear_equiv_symm :
-  (of_linear_equiv l map_mul commutes).symm = of_linear_equiv l.symm
-    ((of_linear_equiv l map_mul commutes).symm.map_mul)
-    ((of_linear_equiv l map_mul commutes).symm.commutes) :=
-rfl
-
-@[simp] lemma of_linear_equiv_to_linear_equiv (map_mul) (commutes) :
-  of_linear_equiv e.to_linear_equiv map_mul commutes = e :=
-by { ext, refl }
-
-@[simp] lemma to_linear_equiv_of_linear_equiv :
-  to_linear_equiv (of_linear_equiv l map_mul commutes) = l :=
-by { ext, refl }
-
-end of_linear_equiv
-
-section of_ring_equiv
-
-/-- Promotes a linear ring_equiv to an alg_equiv. -/
-@[simps]
-def of_ring_equiv {f : A₁ ≃+* A₂}
-  (hf : ∀ x, f (algebra_map R A₁ x) = algebra_map R A₂ x) : A₁ ≃ₐ[R] A₂ :=
-{ to_fun := f,
-  inv_fun := f.symm,
-  commutes' := hf,
-  .. f }
-
-end of_ring_equiv
-
-@[simps mul one {attrs := []}] instance aut : group (A₁ ≃ₐ[R] A₁) :=
-{ mul := λ ϕ ψ, ψ.trans ϕ,
-  mul_assoc := λ ϕ ψ χ, rfl,
-  one := refl,
-  one_mul := λ ϕ, ext $ λ x, rfl,
-  mul_one := λ ϕ, ext $ λ x, rfl,
-  inv := symm,
-  mul_left_inv := λ ϕ, ext $ symm_apply_apply ϕ }
-
-@[simp] lemma one_apply (x : A₁) : (1 : A₁ ≃ₐ[R] A₁) x = x := rfl
-
-@[simp] lemma mul_apply (e₁ e₂ : A₁ ≃ₐ[R] A₁) (x : A₁) : (e₁ * e₂) x = e₁ (e₂ x) := rfl
-
-/-- An algebra isomorphism induces a group isomorphism between automorphism groups -/
-@[simps apply]
-def aut_congr (ϕ : A₁ ≃ₐ[R] A₂) : (A₁ ≃ₐ[R] A₁) ≃* (A₂ ≃ₐ[R] A₂) :=
-{ to_fun := λ ψ, ϕ.symm.trans (ψ.trans ϕ),
-  inv_fun := λ ψ, ϕ.trans (ψ.trans ϕ.symm),
-  left_inv := λ ψ, by { ext, simp_rw [trans_apply, symm_apply_apply] },
-  right_inv := λ ψ, by { ext, simp_rw [trans_apply, apply_symm_apply] },
-  map_mul' := λ ψ χ, by { ext, simp only [mul_apply, trans_apply, symm_apply_apply] } }
-
-@[simp] lemma aut_congr_refl : aut_congr (alg_equiv.refl) = mul_equiv.refl (A₁ ≃ₐ[R] A₁) :=
-by { ext, refl }
-
-@[simp] lemma aut_congr_symm (ϕ : A₁ ≃ₐ[R] A₂) : (aut_congr ϕ).symm = aut_congr ϕ.symm := rfl
-
-@[simp] lemma aut_congr_trans (ϕ : A₁ ≃ₐ[R] A₂) (ψ : A₂ ≃ₐ[R] A₃) :
-  (aut_congr ϕ).trans (aut_congr ψ) = aut_congr (ϕ.trans ψ) := rfl
-
-/-- The tautological action by `A₁ ≃ₐ[R] A₁` on `A₁`.
-
-This generalizes `function.End.apply_mul_action`. -/
-instance apply_mul_semiring_action : mul_semiring_action (A₁ ≃ₐ[R] A₁) A₁ :=
-{ smul := ($),
-  smul_zero := alg_equiv.map_zero,
-  smul_add := alg_equiv.map_add,
-  smul_one := alg_equiv.map_one,
-  smul_mul := alg_equiv.map_mul,
-  one_smul := λ _, rfl,
-  mul_smul := λ _ _ _, rfl }
-
-@[simp] protected lemma smul_def (f : A₁ ≃ₐ[R] A₁) (a : A₁) : f • a = f a := rfl
-
-instance apply_has_faithful_smul : has_faithful_smul (A₁ ≃ₐ[R] A₁) A₁ :=
-⟨λ _ _, alg_equiv.ext⟩
-
-instance apply_smul_comm_class : smul_comm_class R (A₁ ≃ₐ[R] A₁) A₁ :=
-{ smul_comm := λ r e a, (e.map_smul r a).symm }
-
-instance apply_smul_comm_class' : smul_comm_class (A₁ ≃ₐ[R] A₁) R A₁ :=
-{ smul_comm := λ e r a, (e.map_smul r a) }
-
-@[simp] lemma algebra_map_eq_apply (e : A₁ ≃ₐ[R] A₂) {y : R} {x : A₁} :
-  (algebra_map R A₂ y = e x) ↔ (algebra_map R A₁ y = x) :=
-⟨λ h, by simpa using e.symm.to_alg_hom.algebra_map_eq_apply h,
- λ h, e.to_alg_hom.algebra_map_eq_apply h⟩
-
-end semiring
-
-section comm_semiring
-
-variables [comm_semiring R] [comm_semiring A₁] [comm_semiring A₂]
-variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂)
-
-lemma map_prod {ι : Type*} (f : ι → A₁) (s : finset ι) :
-  e (∏ x in s, f x) = ∏ x in s, e (f x) :=
-map_prod _ f s
-
-lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) :
-  e (f.prod g) = f.prod (λ i a, e (g i a)) :=
-map_finsupp_prod _ f g
-
-end comm_semiring
-
-section ring
-
-variables [comm_semiring R] [ring A₁] [ring A₂]
-variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂)
-
-protected lemma map_neg (x) : e (-x) = -e x := map_neg e x
-protected lemma map_sub (x y) : e (x - y) = e x - e y := map_sub e x y
-
-end ring
-
-end alg_equiv
-
-namespace mul_semiring_action
-
-variables {M G : Type*} (R A : Type*) [comm_semiring R] [semiring A] [algebra R A]
-
-section
-variables [monoid M] [mul_semiring_action M A] [smul_comm_class M R A]
-
-/-- Each element of the monoid defines a algebra homomorphism.
-
-This is a stronger version of `mul_semiring_action.to_ring_hom` and
-`distrib_mul_action.to_linear_map`. -/
-@[simps]
-def to_alg_hom (m : M) : A →ₐ[R] A :=
-{ to_fun := λ a, m • a,
-  commutes' := smul_algebra_map _,
-  ..mul_semiring_action.to_ring_hom _ _ m }
-
-theorem to_alg_hom_injective [has_faithful_smul M A] :
-  function.injective (mul_semiring_action.to_alg_hom R A : M → A →ₐ[R] A) :=
-λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_hom.ext_iff.1 h r
-
-end
-
-section
-variables [group G] [mul_semiring_action G A] [smul_comm_class G R A]
-
-/-- Each element of the group defines a algebra equivalence.
-
-This is a stronger version of `mul_semiring_action.to_ring_equiv` and
-`distrib_mul_action.to_linear_equiv`. -/
-@[simps]
-def to_alg_equiv (g : G) : A ≃ₐ[R] A :=
-{ .. mul_semiring_action.to_ring_equiv _ _ g,
-  .. mul_semiring_action.to_alg_hom R A g }
-
-theorem to_alg_equiv_injective [has_faithful_smul G A] :
-  function.injective (mul_semiring_action.to_alg_equiv R A : G → A ≃ₐ[R] A) :=
-λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_equiv.ext_iff.1 h r
-
-end
-
-end mul_semiring_action
 
 section nat
 
@@ -1472,55 +611,14 @@ namespace ring_hom
 
 variables {R S : Type*}
 
-/-- Reinterpret a `ring_hom` as an `ℕ`-algebra homomorphism. -/
-def to_nat_alg_hom [semiring R] [semiring S] (f : R →+* S) :
-  R →ₐ[ℕ] S :=
-{ to_fun := f, commutes' := λ n, by simp, .. f }
-
-/-- Reinterpret a `ring_hom` as a `ℤ`-algebra homomorphism. -/
-def to_int_alg_hom [ring R] [ring S] [algebra ℤ R] [algebra ℤ S] (f : R →+* S) :
-  R →ₐ[ℤ] S :=
-{ commutes' := λ n, by simp, .. f }
-
 -- note that `R`, `S` could be `semiring`s but this is useless mathematically speaking -
 -- a ℚ-algebra is a ring. furthermore, this change probably slows down elaboration.
 @[simp] lemma map_rat_algebra_map [ring R] [ring S] [algebra ℚ R] [algebra ℚ S]
   (f : R →+* S) (r : ℚ) : f (algebra_map ℚ R r) = algebra_map ℚ S r :=
 ring_hom.ext_iff.1 (subsingleton.elim (f.comp (algebra_map ℚ R)) (algebra_map ℚ S)) r
 
-/-- Reinterpret a `ring_hom` as a `ℚ`-algebra homomorphism. This actually yields an equivalence,
-see `ring_hom.equiv_rat_alg_hom`. -/
-def to_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] (f : R →+* S) :
-  R →ₐ[ℚ] S :=
-{ commutes' := f.map_rat_algebra_map, .. f }
-
-@[simp]
-lemma to_rat_alg_hom_to_ring_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S]
-  (f : R →+* S) : ↑f.to_rat_alg_hom = f :=
-ring_hom.ext $ λ x, rfl
-
 end ring_hom
 
-section
-
-variables {R S : Type*}
-
-@[simp]
-lemma alg_hom.to_ring_hom_to_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S]
-  (f : R →ₐ[ℚ] S) : (f : R →+* S).to_rat_alg_hom = f :=
-alg_hom.ext $ λ x, rfl
-
-/-- The equivalence between `ring_hom` and `ℚ`-algebra homomorphisms. -/
-@[simps]
-def ring_hom.equiv_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] :
-  (R →+* S) ≃ (R →ₐ[ℚ] S) :=
-{ to_fun := ring_hom.to_rat_alg_hom,
-  inv_fun := alg_hom.to_ring_hom,
-  left_inv := ring_hom.to_rat_alg_hom_to_ring_hom,
-  right_inv := alg_hom.to_ring_hom_to_rat_alg_hom, }
-
-end
-
 section rat
 
 instance algebra_rat {α} [division_ring α] [char_zero α] : algebra ℚ α :=
@@ -1541,22 +639,6 @@ instance algebra_rat_subsingleton {α} [semiring α] :
 
 end rat
 
-namespace algebra
-open module
-
-variables (R : Type u) (A : Type v)
-
-variables [comm_semiring R] [semiring A] [algebra R A]
-
-/-- `algebra_map` as an `alg_hom`. -/
-def of_id : R →ₐ[R] A :=
-{ commutes' := λ _, rfl, .. algebra_map R A }
-variables {R}
-
-theorem of_id_apply (r) : of_id R A r = algebra_map R A r := rfl
-
-end algebra
-
 section int
 
 variables (R : Type*) [ring R]
@@ -1638,109 +720,6 @@ end field
 
 end no_zero_smul_divisors
 
-/-!
-The R-algebra structure on `Π i : I, A i` when each `A i` is an R-algebra.
-
-We couldn't set this up back in `algebra.pi_instances` because this file imports it.
--/
-namespace pi
-
-variable {I : Type u}     -- The indexing type
-variable {R : Type*}      -- The scalar type
-variable {f : I → Type v} -- The family of types already equipped with instances
-variables (x y : Π i, f i) (i : I)
-variables (I f)
-
-instance algebra {r : comm_semiring R}
-  [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] :
-  algebra R (Π i : I, f i) :=
-{ commutes' := λ a f, begin ext, simp [algebra.commutes], end,
-  smul_def' := λ a f, begin ext, simp [algebra.smul_def], end,
-  ..(pi.ring_hom (λ i, algebra_map R (f i)) : R →+* Π i : I, f i) }
-
-lemma algebra_map_def {r : comm_semiring R}
-  [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] (a : R) :
-  algebra_map R (Π i, f i) a = (λ i, algebra_map R (f i) a) := rfl
-
-@[simp] lemma algebra_map_apply {r : comm_semiring R}
-  [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] (a : R) (i : I) :
-  algebra_map R (Π i, f i) a i = algebra_map R (f i) a := rfl
-
--- One could also build a `Π i, R i`-algebra structure on `Π i, A i`,
--- when each `A i` is an `R i`-algebra, although I'm not sure that it's useful.
-
-variables {I} (R) (f)
-
-/-- `function.eval` as an `alg_hom`. The name matches `pi.eval_ring_hom`, `pi.eval_monoid_hom`,
-etc. -/
-@[simps]
-def eval_alg_hom {r : comm_semiring R} [Π i, semiring (f i)] [Π i, algebra R (f i)] (i : I) :
-  (Π i, f i) →ₐ[R] f i :=
-{ to_fun := λ f, f i, commutes' := λ r, rfl, .. pi.eval_ring_hom f i}
-
-variables (A B : Type*) [comm_semiring R] [semiring B] [algebra R B]
-
-/-- `function.const` as an `alg_hom`. The name matches `pi.const_ring_hom`, `pi.const_monoid_hom`,
-etc. -/
-@[simps]
-def const_alg_hom : B →ₐ[R] (A → B) :=
-{ to_fun := function.const _,
-  commutes' := λ r, rfl,
-  .. pi.const_ring_hom A B}
-
-/-- When `R` is commutative and permits an `algebra_map`, `pi.const_ring_hom` is equal to that
-map. -/
-@[simp] lemma const_ring_hom_eq_algebra_map : const_ring_hom A R = algebra_map R (A → R) :=
-rfl
-
-@[simp] lemma const_alg_hom_eq_algebra_of_id : const_alg_hom R A R = algebra.of_id R (A → R) :=
-rfl
-
-end pi
-
-/-- A special case of `pi.algebra` for non-dependent types. Lean struggles to elaborate
-definitions elsewhere in the library without this, -/
-instance function.algebra {R : Type*} (I : Type*)  (A : Type*) [comm_semiring R]
-  [semiring A] [algebra R A] : algebra R (I → A) :=
-pi.algebra _ _
-
-namespace alg_equiv
-
-/-- A family of algebra equivalences `Π j, (A₁ j ≃ₐ A₂ j)` generates a
-multiplicative equivalence between `Π j, A₁ j` and `Π j, A₂ j`.
-
-This is the `alg_equiv` version of `equiv.Pi_congr_right`, and the dependent version of
-`alg_equiv.arrow_congr`.
--/
-@[simps apply]
-def Pi_congr_right {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R]
-  [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)]
-  (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Π i, A₁ i) ≃ₐ[R] Π i, A₂ i :=
-{ to_fun := λ x j, e j (x j),
-  inv_fun := λ x j, (e j).symm (x j),
-  commutes' := λ r, by { ext i, simp },
-  .. @ring_equiv.Pi_congr_right ι A₁ A₂ _ _ (λ i, (e i).to_ring_equiv) }
-
-@[simp]
-lemma Pi_congr_right_refl {R ι : Type*} {A : ι → Type*} [comm_semiring R]
-  [Π i, semiring (A i)] [Π i, algebra R (A i)] :
-  Pi_congr_right (λ i, (alg_equiv.refl : A i ≃ₐ[R] A i)) = alg_equiv.refl := rfl
-
-@[simp]
-lemma Pi_congr_right_symm {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R]
-  [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)]
-  (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Pi_congr_right e).symm = (Pi_congr_right $ λ i, (e i).symm) := rfl
-
-@[simp]
-lemma Pi_congr_right_trans {R ι : Type*} {A₁ A₂ A₃ : ι → Type*} [comm_semiring R]
-  [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, semiring (A₃ i)]
-  [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)] [Π i, algebra R (A₃ i)]
-  (e₁ : Π i, A₁ i ≃ₐ[R] A₂ i) (e₂ : Π i, A₂ i ≃ₐ[R] A₃ i) :
-  (Pi_congr_right e₁).trans (Pi_congr_right e₂) = (Pi_congr_right $ λ i, (e₁ i).trans (e₂ i)) :=
-rfl
-
-end alg_equiv
-
 section is_scalar_tower
 
 variables {R : Type*} [comm_semiring R]
@@ -1851,22 +830,6 @@ end
 
 end submodule
 
-namespace alg_hom
-
-variables {R : Type u} {A : Type v} {B : Type w} {I : Type*}
-
-variables [comm_semiring R] [semiring A] [semiring B]
-variables [algebra R A] [algebra R B]
-
-/-- `R`-algebra homomorphism between the function spaces `I → A` and `I → B`, induced by an
-`R`-algebra homomorphism `f` between `A` and `B`. -/
-@[simps] protected def comp_left (f : A →ₐ[R] B) (I : Type*) : (I → A) →ₐ[R] (I → B) :=
-{ to_fun := λ h, f ∘ h,
-  commutes' := λ c, by { ext, exact f.commutes' c },
-  .. f.to_ring_hom.comp_left I }
-
-end alg_hom
-
 example {R A} [comm_semiring R] [semiring A]
   [module R A] [smul_comm_class R A A] [is_scalar_tower R A A] : algebra R A :=
 algebra.of_module smul_mul_assoc mul_smul_comm
diff --git a/src/algebra/algebra/bilinear.lean b/src/algebra/algebra/bilinear.lean
index b51a110222f82..3e3a3fe292da4 100644
--- a/src/algebra/algebra/bilinear.lean
+++ b/src/algebra/algebra/bilinear.lean
@@ -165,18 +165,27 @@ variables {R A : Type*} [comm_semiring R] [ring A] [algebra R A]
 
 lemma mul_left_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) :
   function.injective (mul_left R x) :=
-by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› },
-     exact mul_right_injective₀ hx }
+begin
+  letI : nontrivial A := ⟨⟨x, 0, hx⟩⟩,
+  letI := no_zero_divisors.to_is_domain A,
+  exact mul_right_injective₀ hx,
+end
 
 lemma mul_right_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) :
   function.injective (mul_right R x) :=
-by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› },
-     exact mul_left_injective₀ hx }
+begin
+  letI : nontrivial A := ⟨⟨x, 0, hx⟩⟩,
+  letI := no_zero_divisors.to_is_domain A,
+  exact mul_left_injective₀ hx,
+end
 
 lemma mul_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) :
   function.injective (mul R A x) :=
-by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› },
-     exact mul_right_injective₀ hx }
+begin
+  letI : nontrivial A := ⟨⟨x, 0, hx⟩⟩,
+  letI := no_zero_divisors.to_is_domain A,
+  exact mul_right_injective₀ hx,
+end
 
 end ring
 
diff --git a/src/algebra/algebra/equiv.lean b/src/algebra/algebra/equiv.lean
new file mode 100644
index 0000000000000..02524aa77f60d
--- /dev/null
+++ b/src/algebra/algebra/equiv.lean
@@ -0,0 +1,525 @@
+/-
+Copyright (c) 2018 Kenny Lau. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kenny Lau, Yury Kudryashov
+-/
+import algebra.algebra.hom
+
+/-!
+# Isomorphisms of `R`-algebras
+
+This file defines bundled isomorphisms of `R`-algebras.
+
+## Main definitions
+
+* `alg_equiv R A B`: the type of `R`-algebra isomorphisms between `A` and `B`.
+
+## Notations
+
+* `A ≃ₐ[R] B` : `R`-algebra equivalence from `A` to `B`.
+-/
+
+open_locale big_operators
+
+universes u v w u₁ v₁
+
+set_option old_structure_cmd true
+/-- An equivalence of algebras is an equivalence of rings commuting with the actions of scalars. -/
+structure alg_equiv (R : Type u) (A : Type v) (B : Type w)
+  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
+  extends A ≃ B, A ≃* B, A ≃+ B, A ≃+* B :=
+(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r)
+
+attribute [nolint doc_blame] alg_equiv.to_ring_equiv
+attribute [nolint doc_blame] alg_equiv.to_equiv
+attribute [nolint doc_blame] alg_equiv.to_add_equiv
+attribute [nolint doc_blame] alg_equiv.to_mul_equiv
+
+notation A ` ≃ₐ[`:50 R `] ` A' := alg_equiv R A A'
+
+/-- `alg_equiv_class F R A B` states that `F` is a type of algebra structure preserving
+  equivalences. You should extend this class when you extend `alg_equiv`. -/
+class alg_equiv_class (F : Type*) (R A B : out_param Type*)
+  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
+  extends ring_equiv_class F A B :=
+(commutes : ∀ (f : F) (r : R), f (algebra_map R A r) = algebra_map R B r)
+
+-- `R` becomes a metavariable but that's fine because it's an `out_param`
+attribute [nolint dangerous_instance] alg_equiv_class.to_ring_equiv_class
+
+namespace alg_equiv_class
+
+@[priority 100] -- See note [lower instance priority]
+instance to_alg_hom_class (F R A B : Type*)
+  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
+  [h : alg_equiv_class F R A B] : alg_hom_class F R A B :=
+{ coe := coe_fn,
+  coe_injective' := fun_like.coe_injective,
+  map_zero := map_zero,
+  map_one := map_one,
+  .. h }
+
+@[priority 100]
+instance to_linear_equiv_class (F R A B : Type*)
+  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
+  [h : alg_equiv_class F R A B] : linear_equiv_class F R A B :=
+{ map_smulₛₗ := λ f, map_smulₛₗ f,
+  ..h }
+
+instance (F R A B : Type*) [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
+  [h : alg_equiv_class F R A B] : has_coe_t F (A ≃ₐ[R] B) :=
+{ coe := λ f,
+  { to_fun := f,
+  inv_fun := equiv_like.inv f,
+  commutes' := alg_hom_class.commutes f,
+  .. (f : A ≃+* B) } }
+
+end alg_equiv_class
+
+namespace alg_equiv
+
+variables {R : Type u} {A₁ : Type v} {A₂ : Type w} {A₃ : Type u₁}
+
+section semiring
+
+variables [comm_semiring R] [semiring A₁] [semiring A₂] [semiring A₃]
+variables [algebra R A₁] [algebra R A₂] [algebra R A₃]
+variables (e : A₁ ≃ₐ[R] A₂)
+
+instance : alg_equiv_class (A₁ ≃ₐ[R] A₂) R A₁ A₂ :=
+{ coe := to_fun,
+  inv := inv_fun,
+  coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' },
+  map_add := map_add',
+  map_mul := map_mul',
+  commutes := commutes',
+  left_inv := left_inv,
+  right_inv := right_inv }
+
+/--  Helper instance for when there's too many metavariables to apply
+`fun_like.has_coe_to_fun` directly. -/
+instance : has_coe_to_fun (A₁ ≃ₐ[R] A₂) (λ _, A₁ → A₂) := ⟨alg_equiv.to_fun⟩
+
+@[simp, protected] lemma coe_coe {F : Type*} [alg_equiv_class F R A₁ A₂] (f : F) :
+  ⇑(f : A₁ ≃ₐ[R] A₂) = f := rfl
+
+@[ext]
+lemma ext {f g : A₁ ≃ₐ[R] A₂} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
+
+protected lemma congr_arg {f : A₁ ≃ₐ[R] A₂} {x x' : A₁} : x = x' → f x = f x' :=
+fun_like.congr_arg f
+
+protected lemma congr_fun {f g : A₁ ≃ₐ[R] A₂} (h : f = g) (x : A₁) : f x = g x :=
+fun_like.congr_fun h x
+
+protected lemma ext_iff {f g : A₁ ≃ₐ[R] A₂} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
+
+lemma coe_fun_injective : @function.injective (A₁ ≃ₐ[R] A₂) (A₁ → A₂) (λ e, (e : A₁ → A₂)) :=
+fun_like.coe_injective
+
+instance has_coe_to_ring_equiv : has_coe (A₁ ≃ₐ[R] A₂) (A₁ ≃+* A₂) := ⟨alg_equiv.to_ring_equiv⟩
+
+@[simp] lemma coe_mk {to_fun inv_fun left_inv right_inv map_mul map_add commutes} :
+  ⇑(⟨to_fun, inv_fun, left_inv, right_inv, map_mul, map_add, commutes⟩ : A₁ ≃ₐ[R] A₂) = to_fun :=
+rfl
+
+@[simp] theorem mk_coe (e : A₁ ≃ₐ[R] A₂) (e' h₁ h₂ h₃ h₄ h₅) :
+  (⟨e, e', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂) = e := ext $ λ _, rfl
+
+@[simp] lemma to_fun_eq_coe (e : A₁ ≃ₐ[R] A₂) : e.to_fun = e := rfl
+
+@[simp] lemma to_equiv_eq_coe : e.to_equiv = e := rfl
+
+@[simp] lemma to_ring_equiv_eq_coe : e.to_ring_equiv = e := rfl
+
+@[simp, norm_cast] lemma coe_ring_equiv : ((e : A₁ ≃+* A₂) : A₁ → A₂) = e := rfl
+
+lemma coe_ring_equiv' : (e.to_ring_equiv : A₁ → A₂) = e := rfl
+
+lemma coe_ring_equiv_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ ≃+* A₂)) :=
+λ e₁ e₂ h, ext $ ring_equiv.congr_fun h
+
+protected lemma map_add : ∀ x y, e (x + y) = e x + e y := map_add e
+protected lemma map_zero : e 0 = 0 := map_zero e
+protected lemma map_mul : ∀ x y, e (x * y) = (e x) * (e y) := map_mul e
+protected lemma map_one : e 1 = 1 := map_one e
+
+@[simp] lemma commutes : ∀ (r : R), e (algebra_map R A₁ r) = algebra_map R A₂ r :=
+  e.commutes'
+
+@[simp] lemma map_smul (r : R) (x : A₁) : e (r • x) = r • e x :=
+by simp only [algebra.smul_def, map_mul, commutes]
+
+lemma map_sum {ι : Type*} (f : ι → A₁) (s : finset ι) :
+  e (∑ x in s, f x) = ∑ x in s, e (f x) :=
+e.to_add_equiv.map_sum f s
+
+lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) :
+  e (f.sum g) = f.sum (λ i b, e (g i b)) :=
+e.map_sum _ _
+
+/-- Interpret an algebra equivalence as an algebra homomorphism.
+
+This definition is included for symmetry with the other `to_*_hom` projections.
+The `simp` normal form is to use the coercion of the `alg_hom_class.has_coe_t` instance. -/
+def to_alg_hom : A₁ →ₐ[R] A₂ :=
+{ map_one' := e.map_one, map_zero' := e.map_zero, ..e }
+
+@[simp] lemma to_alg_hom_eq_coe : e.to_alg_hom = e := rfl
+
+@[simp, norm_cast] lemma coe_alg_hom : ((e : A₁ →ₐ[R] A₂) : A₁ → A₂) = e :=
+rfl
+
+lemma coe_alg_hom_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ →ₐ[R] A₂)) :=
+λ e₁ e₂ h, ext $ alg_hom.congr_fun h
+
+/-- The two paths coercion can take to a `ring_hom` are equivalent -/
+lemma coe_ring_hom_commutes : ((e : A₁ →ₐ[R] A₂) : A₁ →+* A₂) = ((e : A₁ ≃+* A₂) : A₁ →+* A₂) :=
+rfl
+
+protected lemma map_pow : ∀ (x : A₁) (n : ℕ), e (x ^ n) = (e x) ^ n := map_pow _
+protected lemma injective : function.injective e := equiv_like.injective e
+protected lemma surjective : function.surjective e := equiv_like.surjective e
+protected lemma bijective : function.bijective e := equiv_like.bijective e
+
+/-- Algebra equivalences are reflexive. -/
+@[refl] def refl : A₁ ≃ₐ[R] A₁ := {commutes' := λ r, rfl, ..(1 : A₁ ≃+* A₁)}
+
+instance : inhabited (A₁ ≃ₐ[R] A₁) := ⟨refl⟩
+
+@[simp] lemma refl_to_alg_hom : ↑(refl : A₁ ≃ₐ[R] A₁) = alg_hom.id R A₁ := rfl
+
+@[simp] lemma coe_refl : ⇑(refl : A₁ ≃ₐ[R] A₁) = id := rfl
+
+/-- Algebra equivalences are symmetric. -/
+@[symm]
+def symm (e : A₁ ≃ₐ[R] A₂) : A₂ ≃ₐ[R] A₁ :=
+{ commutes' := λ r, by { rw ←e.to_ring_equiv.symm_apply_apply (algebra_map R A₁ r), congr,
+                         change _ = e _, rw e.commutes, },
+  ..e.to_ring_equiv.symm, }
+
+/-- See Note [custom simps projection] -/
+def simps.symm_apply (e : A₁ ≃ₐ[R] A₂) : A₂ → A₁ := e.symm
+
+initialize_simps_projections alg_equiv (to_fun → apply, inv_fun → symm_apply)
+
+@[simp] lemma coe_apply_coe_coe_symm_apply {F : Type*} [alg_equiv_class F R A₁ A₂]
+  (f : F) (x : A₂) : f ((f : A₁ ≃ₐ[R] A₂).symm x) = x := equiv_like.right_inv f x
+
+@[simp] lemma coe_coe_symm_apply_coe_apply {F : Type*} [alg_equiv_class F R A₁ A₂]
+  (f : F) (x : A₁) : (f : A₁ ≃ₐ[R] A₂).symm (f x) = x := equiv_like.left_inv f x
+
+@[simp] lemma inv_fun_eq_symm {e : A₁ ≃ₐ[R] A₂} : e.inv_fun = e.symm := rfl
+
+@[simp] lemma symm_symm (e : A₁ ≃ₐ[R] A₂) : e.symm.symm = e :=
+by { ext, refl, }
+
+lemma symm_bijective : function.bijective (symm : (A₁ ≃ₐ[R] A₂) → (A₂ ≃ₐ[R] A₁)) :=
+equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩
+
+@[simp] lemma mk_coe' (e : A₁ ≃ₐ[R] A₂) (f h₁ h₂ h₃ h₄ h₅) :
+  (⟨f, e, h₁, h₂, h₃, h₄, h₅⟩ : A₂ ≃ₐ[R] A₁) = e.symm :=
+symm_bijective.injective $ ext $ λ x, rfl
+
+@[simp] theorem symm_mk (f f') (h₁ h₂ h₃ h₄ h₅) :
+  (⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm =
+  { to_fun := f', inv_fun := f,
+    ..(⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm } := rfl
+
+@[simp] theorem refl_symm : (alg_equiv.refl : A₁ ≃ₐ[R] A₁).symm = alg_equiv.refl := rfl
+
+--this should be a simp lemma but causes a lint timeout
+lemma to_ring_equiv_symm (f : A₁ ≃ₐ[R] A₁) : (f : A₁ ≃+* A₁).symm = f.symm := rfl
+
+@[simp] lemma symm_to_ring_equiv : (e.symm : A₂ ≃+* A₁) = (e : A₁ ≃+* A₂).symm := rfl
+
+/-- Algebra equivalences are transitive. -/
+@[trans]
+def trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : A₁ ≃ₐ[R] A₃ :=
+{ commutes' := λ r, show e₂.to_fun (e₁.to_fun _) = _, by rw [e₁.commutes', e₂.commutes'],
+  ..(e₁.to_ring_equiv.trans e₂.to_ring_equiv), }
+
+@[simp] lemma apply_symm_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e (e.symm x) = x :=
+  e.to_equiv.apply_symm_apply
+
+@[simp] lemma symm_apply_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e.symm (e x) = x :=
+  e.to_equiv.symm_apply_apply
+
+@[simp] lemma symm_trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₃) :
+  (e₁.trans e₂).symm x = e₁.symm (e₂.symm x) := rfl
+
+@[simp] lemma coe_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) :
+  ⇑(e₁.trans e₂) = e₂ ∘ e₁ := rfl
+
+@[simp] lemma trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₁) :
+  (e₁.trans e₂) x = e₂ (e₁ x) := rfl
+
+@[simp] lemma comp_symm (e : A₁ ≃ₐ[R] A₂) :
+  alg_hom.comp (e : A₁ →ₐ[R] A₂) ↑e.symm = alg_hom.id R A₂ :=
+by { ext, simp }
+
+@[simp] lemma symm_comp (e : A₁ ≃ₐ[R] A₂) :
+  alg_hom.comp ↑e.symm (e : A₁ →ₐ[R] A₂) = alg_hom.id R A₁ :=
+by { ext, simp }
+
+theorem left_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.left_inverse e.symm e := e.left_inv
+
+theorem right_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.right_inverse e.symm e := e.right_inv
+
+/-- If `A₁` is equivalent to `A₁'` and `A₂` is equivalent to `A₂'`, then the type of maps
+`A₁ →ₐ[R] A₂` is equivalent to the type of maps `A₁' →ₐ[R] A₂'`. -/
+def arrow_congr {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂'] [algebra R A₁'] [algebra R A₂']
+  (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') : (A₁ →ₐ[R] A₂) ≃ (A₁' →ₐ[R] A₂') :=
+{ to_fun := λ f, (e₂.to_alg_hom.comp f).comp e₁.symm.to_alg_hom,
+  inv_fun := λ f, (e₂.symm.to_alg_hom.comp f).comp e₁.to_alg_hom,
+  left_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, symm_comp],
+    simp only [←alg_hom.comp_assoc, symm_comp, alg_hom.id_comp, alg_hom.comp_id] },
+  right_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, comp_symm],
+    simp only [←alg_hom.comp_assoc, comp_symm, alg_hom.id_comp, alg_hom.comp_id] } }
+
+lemma arrow_congr_comp {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃']
+  [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂')
+  (e₃ : A₃ ≃ₐ[R] A₃') (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₃) :
+  arrow_congr e₁ e₃ (g.comp f) = (arrow_congr e₂ e₃ g).comp (arrow_congr e₁ e₂ f) :=
+by { ext, simp only [arrow_congr, equiv.coe_fn_mk, alg_hom.comp_apply],
+  congr, exact (e₂.symm_apply_apply _).symm }
+
+@[simp] lemma arrow_congr_refl :
+  arrow_congr alg_equiv.refl alg_equiv.refl = equiv.refl (A₁ →ₐ[R] A₂) :=
+by { ext, refl }
+
+@[simp] lemma arrow_congr_trans {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃']
+  [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₂) (e₁' : A₁' ≃ₐ[R] A₂')
+  (e₂ : A₂ ≃ₐ[R] A₃) (e₂' : A₂' ≃ₐ[R] A₃') :
+  arrow_congr (e₁.trans e₂) (e₁'.trans e₂') = (arrow_congr e₁ e₁').trans (arrow_congr e₂ e₂') :=
+by { ext, refl }
+
+@[simp] lemma arrow_congr_symm {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂']
+  [algebra R A₁'] [algebra R A₂'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') :
+  (arrow_congr e₁ e₂).symm = arrow_congr e₁.symm e₂.symm :=
+by { ext, refl }
+
+/-- If an algebra morphism has an inverse, it is a algebra isomorphism. -/
+def of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ : f.comp g = alg_hom.id R A₂)
+  (h₂ : g.comp f = alg_hom.id R A₁) : A₁ ≃ₐ[R] A₂ :=
+{ to_fun    := f,
+  inv_fun   := g,
+  left_inv  := alg_hom.ext_iff.1 h₂,
+  right_inv := alg_hom.ext_iff.1 h₁,
+  ..f }
+
+lemma coe_alg_hom_of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
+  ↑(of_alg_hom f g h₁ h₂) = f := alg_hom.ext $ λ _, rfl
+
+@[simp]
+lemma of_alg_hom_coe_alg_hom (f : A₁ ≃ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
+  of_alg_hom ↑f g h₁ h₂ = f := ext $ λ _, rfl
+
+lemma of_alg_hom_symm (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) :
+  (of_alg_hom f g h₁ h₂).symm = of_alg_hom g f h₂ h₁ := rfl
+
+/-- Promotes a bijective algebra homomorphism to an algebra equivalence. -/
+noncomputable def of_bijective (f : A₁ →ₐ[R] A₂) (hf : function.bijective f) : A₁ ≃ₐ[R] A₂ :=
+{ .. ring_equiv.of_bijective (f : A₁ →+* A₂) hf, .. f }
+
+@[simp] lemma coe_of_bijective {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} :
+  (alg_equiv.of_bijective f hf : A₁ → A₂) = f := rfl
+
+lemma of_bijective_apply {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} (a : A₁) :
+  (alg_equiv.of_bijective f hf) a = f a := rfl
+
+/-- Forgetting the multiplicative structures, an equivalence of algebras is a linear equivalence. -/
+@[simps apply] def to_linear_equiv (e : A₁ ≃ₐ[R] A₂) : A₁ ≃ₗ[R] A₂ :=
+{ to_fun    := e,
+  map_smul' := e.map_smul,
+  inv_fun   := e.symm,
+  .. e }
+
+@[simp] lemma to_linear_equiv_refl :
+  (alg_equiv.refl : A₁ ≃ₐ[R] A₁).to_linear_equiv = linear_equiv.refl R A₁ := rfl
+
+@[simp] lemma to_linear_equiv_symm (e : A₁ ≃ₐ[R] A₂) :
+  e.to_linear_equiv.symm = e.symm.to_linear_equiv := rfl
+
+@[simp] lemma to_linear_equiv_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) :
+  (e₁.trans e₂).to_linear_equiv = e₁.to_linear_equiv.trans e₂.to_linear_equiv := rfl
+
+theorem to_linear_equiv_injective : function.injective (to_linear_equiv : _ → (A₁ ≃ₗ[R] A₂)) :=
+λ e₁ e₂ h, ext $ linear_equiv.congr_fun h
+
+/-- Interpret an algebra equivalence as a linear map. -/
+def to_linear_map : A₁ →ₗ[R] A₂ :=
+e.to_alg_hom.to_linear_map
+
+@[simp] lemma to_alg_hom_to_linear_map :
+  (e : A₁ →ₐ[R] A₂).to_linear_map = e.to_linear_map := rfl
+
+@[simp] lemma to_linear_equiv_to_linear_map :
+  e.to_linear_equiv.to_linear_map = e.to_linear_map := rfl
+
+@[simp] lemma to_linear_map_apply (x : A₁) : e.to_linear_map x = e x := rfl
+
+theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A₁ →ₗ[R] A₂)) :=
+λ e₁ e₂ h, ext $ linear_map.congr_fun h
+
+@[simp] lemma trans_to_linear_map (f : A₁ ≃ₐ[R] A₂) (g : A₂ ≃ₐ[R] A₃) :
+  (f.trans g).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl
+
+section of_linear_equiv
+
+variables (l : A₁ ≃ₗ[R] A₂)
+  (map_mul : ∀ x y : A₁, l (x * y) = l x * l y)
+  (commutes : ∀ r : R, l (algebra_map R A₁ r) = algebra_map R A₂ r)
+
+/--
+Upgrade a linear equivalence to an algebra equivalence,
+given that it distributes over multiplication and action of scalars.
+-/
+@[simps apply]
+def of_linear_equiv : A₁ ≃ₐ[R] A₂ :=
+{ to_fun := l,
+  inv_fun := l.symm,
+  map_mul' := map_mul,
+  commutes' := commutes,
+  ..l }
+
+@[simp]
+lemma of_linear_equiv_symm :
+  (of_linear_equiv l map_mul commutes).symm = of_linear_equiv l.symm
+    ((of_linear_equiv l map_mul commutes).symm.map_mul)
+    ((of_linear_equiv l map_mul commutes).symm.commutes) :=
+rfl
+
+@[simp] lemma of_linear_equiv_to_linear_equiv (map_mul) (commutes) :
+  of_linear_equiv e.to_linear_equiv map_mul commutes = e :=
+by { ext, refl }
+
+@[simp] lemma to_linear_equiv_of_linear_equiv :
+  to_linear_equiv (of_linear_equiv l map_mul commutes) = l :=
+by { ext, refl }
+
+end of_linear_equiv
+
+section of_ring_equiv
+
+/-- Promotes a linear ring_equiv to an alg_equiv. -/
+@[simps]
+def of_ring_equiv {f : A₁ ≃+* A₂}
+  (hf : ∀ x, f (algebra_map R A₁ x) = algebra_map R A₂ x) : A₁ ≃ₐ[R] A₂ :=
+{ to_fun := f,
+  inv_fun := f.symm,
+  commutes' := hf,
+  .. f }
+
+end of_ring_equiv
+
+@[simps mul one {attrs := []}] instance aut : group (A₁ ≃ₐ[R] A₁) :=
+{ mul := λ ϕ ψ, ψ.trans ϕ,
+  mul_assoc := λ ϕ ψ χ, rfl,
+  one := refl,
+  one_mul := λ ϕ, ext $ λ x, rfl,
+  mul_one := λ ϕ, ext $ λ x, rfl,
+  inv := symm,
+  mul_left_inv := λ ϕ, ext $ symm_apply_apply ϕ }
+
+@[simp] lemma one_apply (x : A₁) : (1 : A₁ ≃ₐ[R] A₁) x = x := rfl
+
+@[simp] lemma mul_apply (e₁ e₂ : A₁ ≃ₐ[R] A₁) (x : A₁) : (e₁ * e₂) x = e₁ (e₂ x) := rfl
+
+/-- An algebra isomorphism induces a group isomorphism between automorphism groups -/
+@[simps apply]
+def aut_congr (ϕ : A₁ ≃ₐ[R] A₂) : (A₁ ≃ₐ[R] A₁) ≃* (A₂ ≃ₐ[R] A₂) :=
+{ to_fun := λ ψ, ϕ.symm.trans (ψ.trans ϕ),
+  inv_fun := λ ψ, ϕ.trans (ψ.trans ϕ.symm),
+  left_inv := λ ψ, by { ext, simp_rw [trans_apply, symm_apply_apply] },
+  right_inv := λ ψ, by { ext, simp_rw [trans_apply, apply_symm_apply] },
+  map_mul' := λ ψ χ, by { ext, simp only [mul_apply, trans_apply, symm_apply_apply] } }
+
+@[simp] lemma aut_congr_refl : aut_congr (alg_equiv.refl) = mul_equiv.refl (A₁ ≃ₐ[R] A₁) :=
+by { ext, refl }
+
+@[simp] lemma aut_congr_symm (ϕ : A₁ ≃ₐ[R] A₂) : (aut_congr ϕ).symm = aut_congr ϕ.symm := rfl
+
+@[simp] lemma aut_congr_trans (ϕ : A₁ ≃ₐ[R] A₂) (ψ : A₂ ≃ₐ[R] A₃) :
+  (aut_congr ϕ).trans (aut_congr ψ) = aut_congr (ϕ.trans ψ) := rfl
+
+/-- The tautological action by `A₁ ≃ₐ[R] A₁` on `A₁`.
+
+This generalizes `function.End.apply_mul_action`. -/
+instance apply_mul_semiring_action : mul_semiring_action (A₁ ≃ₐ[R] A₁) A₁ :=
+{ smul := ($),
+  smul_zero := alg_equiv.map_zero,
+  smul_add := alg_equiv.map_add,
+  smul_one := alg_equiv.map_one,
+  smul_mul := alg_equiv.map_mul,
+  one_smul := λ _, rfl,
+  mul_smul := λ _ _ _, rfl }
+
+@[simp] protected lemma smul_def (f : A₁ ≃ₐ[R] A₁) (a : A₁) : f • a = f a := rfl
+
+instance apply_has_faithful_smul : has_faithful_smul (A₁ ≃ₐ[R] A₁) A₁ :=
+⟨λ _ _, alg_equiv.ext⟩
+
+instance apply_smul_comm_class : smul_comm_class R (A₁ ≃ₐ[R] A₁) A₁ :=
+{ smul_comm := λ r e a, (e.map_smul r a).symm }
+
+instance apply_smul_comm_class' : smul_comm_class (A₁ ≃ₐ[R] A₁) R A₁ :=
+{ smul_comm := λ e r a, (e.map_smul r a) }
+
+@[simp] lemma algebra_map_eq_apply (e : A₁ ≃ₐ[R] A₂) {y : R} {x : A₁} :
+  (algebra_map R A₂ y = e x) ↔ (algebra_map R A₁ y = x) :=
+⟨λ h, by simpa using e.symm.to_alg_hom.algebra_map_eq_apply h,
+ λ h, e.to_alg_hom.algebra_map_eq_apply h⟩
+
+end semiring
+
+section comm_semiring
+
+variables [comm_semiring R] [comm_semiring A₁] [comm_semiring A₂]
+variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂)
+
+lemma map_prod {ι : Type*} (f : ι → A₁) (s : finset ι) :
+  e (∏ x in s, f x) = ∏ x in s, e (f x) :=
+map_prod _ f s
+
+lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) :
+  e (f.prod g) = f.prod (λ i a, e (g i a)) :=
+map_finsupp_prod _ f g
+
+end comm_semiring
+
+section ring
+
+variables [comm_semiring R] [ring A₁] [ring A₂]
+variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂)
+
+protected lemma map_neg (x) : e (-x) = -e x := map_neg e x
+protected lemma map_sub (x y) : e (x - y) = e x - e y := map_sub e x y
+
+end ring
+
+end alg_equiv
+
+namespace mul_semiring_action
+
+variables {M G : Type*} (R A : Type*) [comm_semiring R] [semiring A] [algebra R A]
+
+section
+variables [group G] [mul_semiring_action G A] [smul_comm_class G R A]
+
+/-- Each element of the group defines a algebra equivalence.
+
+This is a stronger version of `mul_semiring_action.to_ring_equiv` and
+`distrib_mul_action.to_linear_equiv`. -/
+@[simps]
+def to_alg_equiv (g : G) : A ≃ₐ[R] A :=
+{ .. mul_semiring_action.to_ring_equiv _ _ g,
+  .. mul_semiring_action.to_alg_hom R A g }
+
+theorem to_alg_equiv_injective [has_faithful_smul G A] :
+  function.injective (mul_semiring_action.to_alg_equiv R A : G → A ≃ₐ[R] A) :=
+λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_equiv.ext_iff.1 h r
+
+end
+
+end mul_semiring_action
diff --git a/src/algebra/algebra/hom.lean b/src/algebra/algebra/hom.lean
new file mode 100644
index 0000000000000..e0bc7c2029b1d
--- /dev/null
+++ b/src/algebra/algebra/hom.lean
@@ -0,0 +1,381 @@
+/-
+Copyright (c) 2018 Kenny Lau. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kenny Lau, Yury Kudryashov
+-/
+import algebra.algebra.basic
+
+/-!
+# Homomorphisms of `R`-algebras
+
+This file defines bundled homomorphisms of `R`-algebras.
+
+## Main definitions
+
+* `alg_hom R A B`: the type of `R`-algebra morphisms from `A` to `B`.
+* `algebra.of_id R A : R →ₐ[R] A`: the canonical map from `R` to `A`, as an `alg_hom`.
+
+## Notations
+
+* `A →ₐ[R] B` : `R`-algebra homomorphism from `A` to `B`.
+-/
+
+open_locale big_operators
+
+universes u v w u₁ v₁
+
+set_option old_structure_cmd true
+/-- Defining the homomorphism in the category R-Alg. -/
+@[nolint has_nonempty_instance]
+structure alg_hom (R : Type u) (A : Type v) (B : Type w)
+  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] extends ring_hom A B :=
+(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r)
+
+run_cmd tactic.add_doc_string `alg_hom.to_ring_hom "Reinterpret an `alg_hom` as a `ring_hom`"
+
+infixr ` →ₐ `:25 := alg_hom _
+notation A ` →ₐ[`:25 R `] ` B := alg_hom R A B
+
+/-- `alg_hom_class F R A B` asserts `F` is a type of bundled algebra homomorphisms
+from `A` to `B`.  -/
+class alg_hom_class (F : Type*) (R : out_param Type*) (A : out_param Type*) (B : out_param Type*)
+  [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B]
+  extends ring_hom_class F A B :=
+(commutes : ∀ (f : F) (r : R), f (algebra_map R A r) = algebra_map R B r)
+
+-- `R` becomes a metavariable but that's fine because it's an `out_param`
+attribute [nolint dangerous_instance] alg_hom_class.to_ring_hom_class
+
+attribute [simp] alg_hom_class.commutes
+
+namespace alg_hom_class
+
+variables {R : Type*} {A : Type*} {B : Type*} [comm_semiring R] [semiring A] [semiring B]
+  [algebra R A] [algebra R B]
+
+@[priority 100] -- see Note [lower instance priority]
+instance {F : Type*} [alg_hom_class F R A B] : linear_map_class F R A B :=
+{ map_smulₛₗ := λ f r x, by simp only [algebra.smul_def, map_mul, commutes, ring_hom.id_apply],
+  ..‹alg_hom_class F R A B› }
+
+instance {F : Type*} [alg_hom_class F R A B] : has_coe_t F (A →ₐ[R] B) :=
+{ coe := λ f,
+  { to_fun := f,
+    commutes' := alg_hom_class.commutes f,
+    .. (f : A →+* B) } }
+
+end alg_hom_class
+
+namespace alg_hom
+
+variables {R : Type u} {A : Type v} {B : Type w} {C : Type u₁} {D : Type v₁}
+
+section semiring
+
+variables [comm_semiring R] [semiring A] [semiring B] [semiring C] [semiring D]
+variables [algebra R A] [algebra R B] [algebra R C] [algebra R D]
+
+instance : has_coe_to_fun (A →ₐ[R] B) (λ _, A → B) := ⟨alg_hom.to_fun⟩
+
+initialize_simps_projections alg_hom (to_fun → apply)
+
+@[simp, protected] lemma coe_coe {F : Type*} [alg_hom_class F R A B] (f : F) :
+  ⇑(f : A →ₐ[R] B) = f := rfl
+
+@[simp] lemma to_fun_eq_coe (f : A →ₐ[R] B) : f.to_fun = f := rfl
+
+instance : alg_hom_class (A →ₐ[R] B) R A B :=
+{ coe := to_fun,
+  coe_injective' := λ f g h, by { cases f, cases g, congr' },
+  map_add := map_add',
+  map_zero := map_zero',
+  map_mul := map_mul',
+  map_one := map_one',
+  commutes := λ f, f.commutes' }
+
+instance coe_ring_hom : has_coe (A →ₐ[R] B) (A →+* B) := ⟨alg_hom.to_ring_hom⟩
+
+instance coe_monoid_hom : has_coe (A →ₐ[R] B) (A →* B) := ⟨λ f, ↑(f : A →+* B)⟩
+
+instance coe_add_monoid_hom : has_coe (A →ₐ[R] B) (A →+ B) := ⟨λ f, ↑(f : A →+* B)⟩
+
+@[simp, norm_cast] lemma coe_mk {f : A → B} (h₁ h₂ h₃ h₄ h₅) :
+  ⇑(⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := rfl
+
+-- make the coercion the simp-normal form
+@[simp] lemma to_ring_hom_eq_coe (f : A →ₐ[R] B) : f.to_ring_hom = f := rfl
+
+@[simp, norm_cast] lemma coe_to_ring_hom (f : A →ₐ[R] B) : ⇑(f : A →+* B) = f := rfl
+
+@[simp, norm_cast] lemma coe_to_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →* B) = f := rfl
+
+@[simp, norm_cast] lemma coe_to_add_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →+ B) = f := rfl
+
+variables (φ : A →ₐ[R] B)
+
+theorem coe_fn_injective : @function.injective (A →ₐ[R] B) (A → B) coe_fn := fun_like.coe_injective
+
+theorem coe_fn_inj {φ₁ φ₂ : A →ₐ[R] B} : (φ₁ : A → B) = φ₂ ↔ φ₁ = φ₂ := fun_like.coe_fn_eq
+
+theorem coe_ring_hom_injective : function.injective (coe : (A →ₐ[R] B) → (A →+* B)) :=
+λ φ₁ φ₂ H, coe_fn_injective $ show ((φ₁ : (A →+* B)) : A → B) = ((φ₂ : (A →+* B)) : A → B),
+  from congr_arg _ H
+
+theorem coe_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B)  → (A →* B)) :=
+ring_hom.coe_monoid_hom_injective.comp coe_ring_hom_injective
+
+theorem coe_add_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B)  → (A →+ B)) :=
+ring_hom.coe_add_monoid_hom_injective.comp coe_ring_hom_injective
+
+protected lemma congr_fun {φ₁ φ₂ : A →ₐ[R] B} (H : φ₁ = φ₂) (x : A) : φ₁ x = φ₂ x :=
+fun_like.congr_fun H x
+protected lemma congr_arg (φ : A →ₐ[R] B) {x y : A} (h : x = y) : φ x = φ y :=
+fun_like.congr_arg φ h
+
+@[ext]
+theorem ext {φ₁ φ₂ : A →ₐ[R] B} (H : ∀ x, φ₁ x = φ₂ x) : φ₁ = φ₂ := fun_like.ext _ _ H
+
+theorem ext_iff {φ₁ φ₂ : A →ₐ[R] B} : φ₁ = φ₂ ↔ ∀ x, φ₁ x = φ₂ x := fun_like.ext_iff
+
+@[simp] theorem mk_coe {f : A →ₐ[R] B} (h₁ h₂ h₃ h₄ h₅) :
+  (⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := ext $ λ _, rfl
+
+@[simp]
+theorem commutes (r : R) : φ (algebra_map R A r) = algebra_map R B r := φ.commutes' r
+
+theorem comp_algebra_map : (φ : A →+* B).comp (algebra_map R A) = algebra_map R B :=
+ring_hom.ext $ φ.commutes
+
+protected lemma map_add (r s : A) : φ (r + s) = φ r + φ s := map_add _ _ _
+protected lemma map_zero : φ 0 = 0 := map_zero _
+protected lemma map_mul (x y) : φ (x * y) = φ x * φ y := map_mul _ _ _
+protected lemma map_one : φ 1 = 1 := map_one _
+protected lemma map_pow (x : A) (n : ℕ) : φ (x ^ n) = (φ x) ^ n := map_pow _ _ _
+
+@[simp] protected lemma map_smul (r : R) (x : A) : φ (r • x) = r • φ x := map_smul _ _ _
+
+protected lemma map_sum {ι : Type*} (f : ι → A) (s : finset ι) :
+  φ (∑ x in s, f x) = ∑ x in s, φ (f x) := map_sum _ _ _
+
+protected lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) :
+  φ (f.sum g) = f.sum (λ i a, φ (g i a)) := map_finsupp_sum _ _ _
+
+protected lemma map_bit0 (x) : φ (bit0 x) = bit0 (φ x) := map_bit0 _ _
+protected lemma map_bit1 (x) : φ (bit1 x) = bit1 (φ x) := map_bit1 _ _
+
+/-- If a `ring_hom` is `R`-linear, then it is an `alg_hom`. -/
+def mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : A →ₐ[R] B :=
+{ to_fun := f,
+  commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, h, f.map_one],
+  .. f }
+
+@[simp] lemma coe_mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : ⇑(mk' f h) = f := rfl
+
+section
+
+variables (R A)
+/-- Identity map as an `alg_hom`. -/
+protected def id : A →ₐ[R] A :=
+{ commutes' := λ _, rfl,
+  ..ring_hom.id A }
+
+@[simp] lemma coe_id : ⇑(alg_hom.id R A) = id := rfl
+
+@[simp] lemma id_to_ring_hom : (alg_hom.id R A : A →+* A) = ring_hom.id _ := rfl
+
+end
+
+lemma id_apply (p : A) : alg_hom.id R A p = p := rfl
+
+/-- Composition of algebra homeomorphisms. -/
+def comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : A →ₐ[R] C :=
+{ commutes' := λ r : R, by rw [← φ₁.commutes, ← φ₂.commutes]; refl,
+  .. φ₁.to_ring_hom.comp ↑φ₂ }
+
+@[simp] lemma coe_comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : ⇑(φ₁.comp φ₂) = φ₁ ∘ φ₂ := rfl
+
+lemma comp_apply (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) (p : A) : φ₁.comp φ₂ p = φ₁ (φ₂ p) := rfl
+
+lemma comp_to_ring_hom (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) :
+  (φ₁.comp φ₂ : A →+* C) = (φ₁ : B →+* C).comp ↑φ₂ := rfl
+
+@[simp] theorem comp_id : φ.comp (alg_hom.id R A) = φ :=
+ext $ λ x, rfl
+
+@[simp] theorem id_comp : (alg_hom.id R B).comp φ = φ :=
+ext $ λ x, rfl
+
+theorem comp_assoc (φ₁ : C →ₐ[R] D) (φ₂ : B →ₐ[R] C) (φ₃ : A →ₐ[R] B) :
+  (φ₁.comp φ₂).comp φ₃ = φ₁.comp (φ₂.comp φ₃) :=
+ext $ λ x, rfl
+
+/-- R-Alg ⥤ R-Mod -/
+def to_linear_map : A →ₗ[R] B :=
+{ to_fun := φ,
+  map_add' := map_add _,
+  map_smul' := map_smul _ }
+
+@[simp] lemma to_linear_map_apply (p : A) : φ.to_linear_map p = φ p := rfl
+
+theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A →ₗ[R] B)) :=
+λ φ₁ φ₂ h, ext $ linear_map.congr_fun h
+
+@[simp] lemma comp_to_linear_map (f : A →ₐ[R] B) (g : B →ₐ[R] C) :
+  (g.comp f).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl
+
+@[simp] lemma to_linear_map_id : to_linear_map (alg_hom.id R A) = linear_map.id :=
+linear_map.ext $ λ _, rfl
+
+/-- Promote a `linear_map` to an `alg_hom` by supplying proofs about the behavior on `1` and `*`. -/
+@[simps]
+def of_linear_map (f : A →ₗ[R] B) (map_one : f 1 = 1) (map_mul : ∀ x y, f (x * y) = f x * f y) :
+  A →ₐ[R] B :=
+{ to_fun := f,
+  map_one' := map_one,
+  map_mul' := map_mul,
+  commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, f.map_smul, map_one],
+  .. f.to_add_monoid_hom }
+
+@[simp] lemma of_linear_map_to_linear_map (map_one) (map_mul) :
+  of_linear_map φ.to_linear_map map_one map_mul = φ :=
+by { ext, refl }
+
+@[simp] lemma to_linear_map_of_linear_map (f : A →ₗ[R] B) (map_one) (map_mul) :
+  to_linear_map (of_linear_map f map_one map_mul) = f :=
+by { ext, refl }
+
+@[simp] lemma of_linear_map_id (map_one) (map_mul) :
+  of_linear_map linear_map.id map_one map_mul = alg_hom.id R A :=
+ext $ λ _, rfl
+
+lemma map_smul_of_tower {R'} [has_smul R' A] [has_smul R' B]
+  [linear_map.compatible_smul A B R' R] (r : R') (x : A) : φ (r • x) = r • φ x :=
+φ.to_linear_map.map_smul_of_tower r x
+
+lemma map_list_prod (s : list A) :
+  φ s.prod = (s.map φ).prod :=
+φ.to_ring_hom.map_list_prod s
+
+@[simps mul one {attrs := []}] instance End : monoid (A →ₐ[R] A) :=
+{ mul := comp,
+  mul_assoc := λ ϕ ψ χ, rfl,
+  one := alg_hom.id R A,
+  one_mul := λ ϕ, ext $ λ x, rfl,
+  mul_one := λ ϕ, ext $ λ x, rfl }
+
+@[simp] lemma one_apply (x : A) : (1 : A →ₐ[R] A) x = x := rfl
+
+@[simp] lemma mul_apply (φ ψ : A →ₐ[R] A) (x : A) : (φ * ψ) x = φ (ψ x) := rfl
+
+lemma algebra_map_eq_apply (f : A →ₐ[R] B) {y : R} {x : A} (h : algebra_map R A y = x) :
+  algebra_map R B y = f x :=
+h ▸ (f.commutes _).symm
+
+end semiring
+
+section comm_semiring
+
+variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
+variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B)
+
+protected lemma map_multiset_prod (s : multiset A) :
+  φ s.prod = (s.map φ).prod := map_multiset_prod _ _
+
+protected lemma map_prod {ι : Type*} (f : ι → A) (s : finset ι) :
+  φ (∏ x in s, f x) = ∏ x in s, φ (f x) := map_prod _ _ _
+
+protected lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) :
+  φ (f.prod g) = f.prod (λ i a, φ (g i a)) := map_finsupp_prod _ _ _
+
+end comm_semiring
+
+section ring
+
+variables [comm_semiring R] [ring A] [ring B]
+variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B)
+
+protected lemma map_neg (x) : φ (-x) = -φ x := map_neg _ _
+protected lemma map_sub (x y) : φ (x - y) = φ x - φ y := map_sub _ _ _
+
+end ring
+
+end alg_hom
+
+
+namespace ring_hom
+variables {R S : Type*}
+
+/-- Reinterpret a `ring_hom` as an `ℕ`-algebra homomorphism. -/
+def to_nat_alg_hom [semiring R] [semiring S] (f : R →+* S) :
+  R →ₐ[ℕ] S :=
+{ to_fun := f, commutes' := λ n, by simp, .. f }
+
+/-- Reinterpret a `ring_hom` as a `ℤ`-algebra homomorphism. -/
+def to_int_alg_hom [ring R] [ring S] [algebra ℤ R] [algebra ℤ S] (f : R →+* S) :
+  R →ₐ[ℤ] S :=
+{ commutes' := λ n, by simp, .. f }
+
+/-- Reinterpret a `ring_hom` as a `ℚ`-algebra homomorphism. This actually yields an equivalence,
+see `ring_hom.equiv_rat_alg_hom`. -/
+def to_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] (f : R →+* S) :
+  R →ₐ[ℚ] S :=
+{ commutes' := f.map_rat_algebra_map, .. f }
+
+@[simp]
+lemma to_rat_alg_hom_to_ring_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S]
+  (f : R →+* S) : ↑f.to_rat_alg_hom = f :=
+ring_hom.ext $ λ x, rfl
+
+end ring_hom
+
+section
+variables {R S : Type*}
+
+@[simp]
+lemma alg_hom.to_ring_hom_to_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S]
+  (f : R →ₐ[ℚ] S) : (f : R →+* S).to_rat_alg_hom = f :=
+alg_hom.ext $ λ x, rfl
+
+/-- The equivalence between `ring_hom` and `ℚ`-algebra homomorphisms. -/
+@[simps]
+def ring_hom.equiv_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] :
+  (R →+* S) ≃ (R →ₐ[ℚ] S) :=
+{ to_fun := ring_hom.to_rat_alg_hom,
+  inv_fun := alg_hom.to_ring_hom,
+  left_inv := ring_hom.to_rat_alg_hom_to_ring_hom,
+  right_inv := alg_hom.to_ring_hom_to_rat_alg_hom, }
+
+end
+
+namespace algebra
+variables (R : Type u) (A : Type v)
+variables [comm_semiring R] [semiring A] [algebra R A]
+
+/-- `algebra_map` as an `alg_hom`. -/
+def of_id : R →ₐ[R] A :=
+{ commutes' := λ _, rfl, .. algebra_map R A }
+variables {R}
+
+theorem of_id_apply (r) : of_id R A r = algebra_map R A r := rfl
+
+end algebra
+
+namespace mul_semiring_action
+variables {M G : Type*} (R A : Type*) [comm_semiring R] [semiring A] [algebra R A]
+variables [monoid M] [mul_semiring_action M A] [smul_comm_class M R A]
+
+/-- Each element of the monoid defines a algebra homomorphism.
+
+This is a stronger version of `mul_semiring_action.to_ring_hom` and
+`distrib_mul_action.to_linear_map`. -/
+@[simps]
+def to_alg_hom (m : M) : A →ₐ[R] A :=
+{ to_fun := λ a, m • a,
+  commutes' := smul_algebra_map _,
+  ..mul_semiring_action.to_ring_hom _ _ m }
+
+theorem to_alg_hom_injective [has_faithful_smul M A] :
+  function.injective (mul_semiring_action.to_alg_hom R A : M → A →ₐ[R] A) :=
+λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_hom.ext_iff.1 h r
+
+end mul_semiring_action
diff --git a/src/algebra/algebra/operations.lean b/src/algebra/algebra/operations.lean
index dcd62747f721e..7945baacf4230 100644
--- a/src/algebra/algebra/operations.lean
+++ b/src/algebra/algebra/operations.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
 import algebra.algebra.bilinear
+import algebra.algebra.equiv
 import algebra.module.submodule.pointwise
 import algebra.module.submodule.bilinear
 import algebra.module.opposites
diff --git a/src/algebra/algebra/pi.lean b/src/algebra/algebra/pi.lean
new file mode 100644
index 0000000000000..005b3f1bee61c
--- /dev/null
+++ b/src/algebra/algebra/pi.lean
@@ -0,0 +1,133 @@
+/-
+Copyright (c) 2018 Kenny Lau. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kenny Lau, Yury Kudryashov
+-/
+import algebra.algebra.equiv
+
+/-!
+# The R-algebra structure on families of R-algebras
+
+The R-algebra structure on `Π i : I, A i` when each `A i` is an R-algebra.
+
+## Main defintions
+
+* `pi.algebra`
+* `pi.eval_alg_hom`
+* `pi.const_alg_hom`
+-/
+universes u v w
+
+namespace pi
+
+variable {I : Type u}     -- The indexing type
+variable {R : Type*}      -- The scalar type
+variable {f : I → Type v} -- The family of types already equipped with instances
+variables (x y : Π i, f i) (i : I)
+variables (I f)
+
+instance algebra {r : comm_semiring R}
+  [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] :
+  algebra R (Π i : I, f i) :=
+{ commutes' := λ a f, begin ext, simp [algebra.commutes], end,
+  smul_def' := λ a f, begin ext, simp [algebra.smul_def], end,
+  ..(pi.ring_hom (λ i, algebra_map R (f i)) : R →+* Π i : I, f i) }
+
+lemma algebra_map_def {r : comm_semiring R}
+  [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] (a : R) :
+  algebra_map R (Π i, f i) a = (λ i, algebra_map R (f i) a) := rfl
+
+@[simp] lemma algebra_map_apply {r : comm_semiring R}
+  [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] (a : R) (i : I) :
+  algebra_map R (Π i, f i) a i = algebra_map R (f i) a := rfl
+
+-- One could also build a `Π i, R i`-algebra structure on `Π i, A i`,
+-- when each `A i` is an `R i`-algebra, although I'm not sure that it's useful.
+
+variables {I} (R) (f)
+
+/-- `function.eval` as an `alg_hom`. The name matches `pi.eval_ring_hom`, `pi.eval_monoid_hom`,
+etc. -/
+@[simps]
+def eval_alg_hom {r : comm_semiring R} [Π i, semiring (f i)] [Π i, algebra R (f i)] (i : I) :
+  (Π i, f i) →ₐ[R] f i :=
+{ to_fun := λ f, f i, commutes' := λ r, rfl, .. pi.eval_ring_hom f i}
+
+variables (A B : Type*) [comm_semiring R] [semiring B] [algebra R B]
+
+/-- `function.const` as an `alg_hom`. The name matches `pi.const_ring_hom`, `pi.const_monoid_hom`,
+etc. -/
+@[simps]
+def const_alg_hom : B →ₐ[R] (A → B) :=
+{ to_fun := function.const _,
+  commutes' := λ r, rfl,
+  .. pi.const_ring_hom A B}
+
+/-- When `R` is commutative and permits an `algebra_map`, `pi.const_ring_hom` is equal to that
+map. -/
+@[simp] lemma const_ring_hom_eq_algebra_map : const_ring_hom A R = algebra_map R (A → R) :=
+rfl
+
+@[simp] lemma const_alg_hom_eq_algebra_of_id : const_alg_hom R A R = algebra.of_id R (A → R) :=
+rfl
+
+end pi
+
+/-- A special case of `pi.algebra` for non-dependent types. Lean struggles to elaborate
+definitions elsewhere in the library without this, -/
+instance function.algebra {R : Type*} (I : Type*)  (A : Type*) [comm_semiring R]
+  [semiring A] [algebra R A] : algebra R (I → A) :=
+pi.algebra _ _
+
+namespace alg_hom
+
+variables {R : Type u} {A : Type v} {B : Type w} {I : Type*}
+
+variables [comm_semiring R] [semiring A] [semiring B]
+variables [algebra R A] [algebra R B]
+
+/-- `R`-algebra homomorphism between the function spaces `I → A` and `I → B`, induced by an
+`R`-algebra homomorphism `f` between `A` and `B`. -/
+@[simps] protected def comp_left (f : A →ₐ[R] B) (I : Type*) : (I → A) →ₐ[R] (I → B) :=
+{ to_fun := λ h, f ∘ h,
+  commutes' := λ c, by { ext, exact f.commutes' c },
+  .. f.to_ring_hom.comp_left I }
+
+end alg_hom
+
+namespace alg_equiv
+
+/-- A family of algebra equivalences `Π j, (A₁ j ≃ₐ A₂ j)` generates a
+multiplicative equivalence between `Π j, A₁ j` and `Π j, A₂ j`.
+
+This is the `alg_equiv` version of `equiv.Pi_congr_right`, and the dependent version of
+`alg_equiv.arrow_congr`.
+-/
+@[simps apply]
+def Pi_congr_right {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R]
+  [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)]
+  (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Π i, A₁ i) ≃ₐ[R] Π i, A₂ i :=
+{ to_fun := λ x j, e j (x j),
+  inv_fun := λ x j, (e j).symm (x j),
+  commutes' := λ r, by { ext i, simp },
+  .. @ring_equiv.Pi_congr_right ι A₁ A₂ _ _ (λ i, (e i).to_ring_equiv) }
+
+@[simp]
+lemma Pi_congr_right_refl {R ι : Type*} {A : ι → Type*} [comm_semiring R]
+  [Π i, semiring (A i)] [Π i, algebra R (A i)] :
+  Pi_congr_right (λ i, (alg_equiv.refl : A i ≃ₐ[R] A i)) = alg_equiv.refl := rfl
+
+@[simp]
+lemma Pi_congr_right_symm {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R]
+  [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)]
+  (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Pi_congr_right e).symm = (Pi_congr_right $ λ i, (e i).symm) := rfl
+
+@[simp]
+lemma Pi_congr_right_trans {R ι : Type*} {A₁ A₂ A₃ : ι → Type*} [comm_semiring R]
+  [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, semiring (A₃ i)]
+  [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)] [Π i, algebra R (A₃ i)]
+  (e₁ : Π i, A₁ i ≃ₐ[R] A₂ i) (e₂ : Π i, A₂ i ≃ₐ[R] A₃ i) :
+  (Pi_congr_right e₁).trans (Pi_congr_right e₂) = (Pi_congr_right $ λ i, (e₁ i).trans (e₂ i)) :=
+rfl
+
+end alg_equiv
diff --git a/src/algebra/algebra/prod.lean b/src/algebra/algebra/prod.lean
new file mode 100644
index 0000000000000..7d24d8b4c08d0
--- /dev/null
+++ b/src/algebra/algebra/prod.lean
@@ -0,0 +1,80 @@
+/-
+Copyright (c) 2018 Kenny Lau. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kenny Lau, Yury Kudryashov
+-/
+import algebra.algebra.hom
+
+/-!
+# The R-algebra structure on products of R-algebras
+
+The R-algebra structure on `Π i : I, A i` when each `A i` is an R-algebra.
+
+## Main defintions
+
+* `pi.algebra`
+* `pi.eval_alg_hom`
+* `pi.const_alg_hom`
+-/
+
+variables {R A B C : Type*}
+variables [comm_semiring R]
+variables [semiring A] [algebra R A] [semiring B] [algebra R B] [semiring C] [algebra R C]
+
+namespace prod
+variables (R A B)
+
+open algebra
+
+instance algebra : algebra R (A × B) :=
+{ commutes' := by { rintro r ⟨a, b⟩, dsimp, rw [commutes r a, commutes r b] },
+  smul_def' := by { rintro r ⟨a, b⟩, dsimp, rw [algebra.smul_def r a, algebra.smul_def r b] },
+  .. prod.module,
+  .. ring_hom.prod (algebra_map R A) (algebra_map R B) }
+
+variables {R A B}
+
+@[simp] lemma algebra_map_apply (r : R) :
+  algebra_map R (A × B) r = (algebra_map R A r, algebra_map R B r) := rfl
+
+end prod
+
+namespace alg_hom
+variables (R A B)
+
+/-- First projection as `alg_hom`. -/
+def fst : A × B →ₐ[R] A :=
+{ commutes' := λ r, rfl, .. ring_hom.fst A B}
+
+/-- Second projection as `alg_hom`. -/
+def snd : A × B →ₐ[R] B :=
+{ commutes' := λ r, rfl, .. ring_hom.snd A B}
+
+variables {R A B}
+
+/-- The `pi.prod` of two morphisms is a morphism. -/
+@[simps] def prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : (A →ₐ[R] B × C) :=
+{ commutes' := λ r, by simp only [to_ring_hom_eq_coe, ring_hom.to_fun_eq_coe, ring_hom.prod_apply,
+    coe_to_ring_hom, commutes, prod.algebra_map_apply],
+  .. (f.to_ring_hom.prod g.to_ring_hom) }
+
+lemma coe_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : ⇑(f.prod g) = pi.prod f g := rfl
+
+@[simp] theorem fst_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) :
+  (fst R B C).comp (prod f g) = f := by ext; refl
+
+@[simp] theorem snd_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) :
+  (snd R B C).comp (prod f g) = g := by ext; refl
+
+@[simp] theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 :=
+fun_like.coe_injective pi.prod_fst_snd
+
+/-- Taking the product of two maps with the same domain is equivalent to taking the product of
+their codomains. -/
+@[simps] def prod_equiv : ((A →ₐ[R] B) × (A →ₐ[R] C)) ≃ (A →ₐ[R] B × C) :=
+{ to_fun := λ f, f.1.prod f.2,
+  inv_fun := λ f, ((fst _ _ _).comp f, (snd _ _ _).comp f),
+  left_inv := λ f, by ext; refl,
+  right_inv := λ f, by ext; refl }
+
+end alg_hom
diff --git a/src/algebra/algebra/tower.lean b/src/algebra/algebra/tower.lean
index 86d4845669ae3..20fd4850d1baa 100644
--- a/src/algebra/algebra/tower.lean
+++ b/src/algebra/algebra/tower.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Anne Baanen
 -/
 
-import algebra.algebra.basic
+import algebra.algebra.equiv
 
 /-!
 # Towers of algebras
@@ -256,7 +256,7 @@ span_induction hx (λ x hx, let ⟨p, q, hp, hq, hpq⟩ := set.mem_smul.1 hx in
   (λ x y ihx ihy, by { rw smul_add, exact add_mem ihx ihy })
   (λ c x hx, smul_comm c k x ▸ smul_mem _ _ hx)
 
-theorem span_smul {s : set S} (hs : span R s = ⊤) (t : set A) :
+theorem span_smul_of_span_eq_top {s : set S} (hs : span R s = ⊤) (t : set A) :
   span R (s • t) = (span S t).restrict_scalars R :=
 le_antisymm (span_le.2 $ λ x hx, let ⟨p, q, hps, hqt, hpqx⟩ := set.mem_smul.1 hx in
   hpqx ▸ (span S t).smul_mem p (subset_span hqt)) $
diff --git a/src/algebra/algebraic_card.lean b/src/algebra/algebraic_card.lean
index 745e11647b6c4..5cf00a5d2af68 100644
--- a/src/algebra/algebraic_card.lean
+++ b/src/algebra/algebraic_card.lean
@@ -19,15 +19,18 @@ proof is given by `liouville.is_transcendental`.
 
 universes u v
 
-open cardinal polynomial
+open cardinal polynomial set
 open_locale cardinal polynomial
 
 namespace algebraic
 
+lemma infinite_of_char_zero (R A : Type*) [comm_ring R] [is_domain R]
+  [ring A] [algebra R A] [char_zero A] : {x : A | is_algebraic R x}.infinite :=
+infinite_of_injective_forall_mem nat.cast_injective is_algebraic_nat
+
 theorem aleph_0_le_cardinal_mk_of_char_zero (R A : Type*) [comm_ring R] [is_domain R]
   [ring A] [algebra R A] [char_zero A] : ℵ₀ ≤ #{x : A // is_algebraic R x} :=
-@mk_le_of_injective (ulift ℕ) {x : A | is_algebraic R x} (λ n, ⟨_, is_algebraic_nat n.down⟩)
-  (λ m n hmn, by simpa using hmn)
+infinite_iff.1 (set.infinite_coe_iff.2 $ infinite_of_char_zero R A)
 
 section lift
 
@@ -35,52 +38,41 @@ variables (R : Type u) (A : Type v) [comm_ring R] [comm_ring A] [is_domain A] [a
   [no_zero_smul_divisors R A]
 
 theorem cardinal_mk_lift_le_mul :
-  cardinal.lift.{u v} (#{x : A // is_algebraic R x}) ≤ cardinal.lift.{v u} #(R[X]) * ℵ₀ :=
+  cardinal.lift.{u} (#{x : A // is_algebraic R x}) ≤ cardinal.lift.{v} #(R[X]) * ℵ₀ :=
 begin
   rw [←mk_ulift, ←mk_ulift],
-  let g : ulift.{u} {x : A | is_algebraic R x} → ulift.{v} R[X] :=
-    λ x, ulift.up (classical.some x.1.2),
-  apply cardinal.mk_le_mk_mul_of_mk_preimage_le g (λ f, _),
-  rsufficesI : fintype (g ⁻¹' {f}),
-  { exact mk_le_aleph_0 },
-  by_cases hf : f.1 = 0,
-  { convert set.fintype_empty,
-    apply set.eq_empty_iff_forall_not_mem.2 (λ x hx, _),
-    simp only [set.mem_preimage, set.mem_singleton_iff] at hx,
-    apply_fun ulift.down at hx,
-    rw hf at hx,
-    exact (classical.some_spec x.1.2).1 hx },
-  let h : g ⁻¹' {f} → f.down.root_set A := λ x, ⟨x.1.1.1, (mem_root_set_iff hf x.1.1.1).2 begin
-    have key' : g x = f := x.2,
-    simp_rw ← key',
-    exact (classical.some_spec x.1.1.2).2
-  end⟩,
-  apply fintype.of_injective h (λ _ _ H, _),
-  simp only [subtype.val_eq_coe, subtype.mk_eq_mk] at H,
-  exact subtype.ext (ulift.down_injective (subtype.ext H))
+  choose g hg₁ hg₂ using λ x : {x : A | is_algebraic R x}, x.coe_prop,
+  refine lift_mk_le_lift_mk_mul_of_lift_mk_preimage_le g (λ f, _),
+  rw [lift_le_aleph_0, le_aleph_0_iff_set_countable],
+  suffices : maps_to coe (g ⁻¹' {f}) (f.root_set A),
+    from this.countable_of_inj_on (subtype.coe_injective.inj_on _) (f.root_set_finite A).countable,
+  rintro x (rfl : g x = f),
+  exact mem_root_set.2 ⟨hg₁ x, hg₂ x⟩
 end
 
 theorem cardinal_mk_lift_le_max :
-  cardinal.lift.{u v} (#{x : A // is_algebraic R x}) ≤ max (cardinal.lift.{v u} (#R)) ℵ₀ :=
+  cardinal.lift.{u} (#{x : A // is_algebraic R x}) ≤ max (cardinal.lift.{v} (#R)) ℵ₀ :=
 (cardinal_mk_lift_le_mul R A).trans $
-  (mul_le_mul_right' (lift_le.2 cardinal_mk_le_max) _).trans $ by simp [le_total]
+  (mul_le_mul_right' (lift_le.2 cardinal_mk_le_max) _).trans $ by simp
 
-theorem cardinal_mk_lift_le_of_infinite [infinite R] :
-  cardinal.lift.{u v} (#{x : A // is_algebraic R x}) ≤ cardinal.lift.{v u} (#R) :=
-(cardinal_mk_lift_le_max R A).trans $ by simp
+@[simp] lemma cardinal_mk_lift_of_infinite [infinite R] :
+  cardinal.lift.{u} (#{x : A // is_algebraic R x}) = cardinal.lift.{v} (#R) :=
+((cardinal_mk_lift_le_max R A).trans_eq (max_eq_left $ aleph_0_le_mk _)).antisymm $
+  lift_mk_le'.2 ⟨⟨λ x, ⟨algebra_map R A x, is_algebraic_algebra_map _⟩,
+    λ x y h, no_zero_smul_divisors.algebra_map_injective R A (subtype.ext_iff.1 h)⟩⟩
 
-variable [encodable R]
+variable [countable R]
 
-@[simp] theorem countable_of_encodable : set.countable {x : A | is_algebraic R x} :=
+@[simp] protected theorem countable : set.countable {x : A | is_algebraic R x} :=
 begin
   rw [←le_aleph_0_iff_set_countable, ←lift_le],
   apply (cardinal_mk_lift_le_max R A).trans,
   simp
 end
 
-@[simp] theorem cardinal_mk_of_encodable_of_char_zero [char_zero A] [is_domain R] :
+@[simp] theorem cardinal_mk_of_countble_of_char_zero [char_zero A] [is_domain R] :
   #{x : A // is_algebraic R x} = ℵ₀ :=
-le_antisymm (by simp) (aleph_0_le_cardinal_mk_of_char_zero R A)
+(algebraic.countable R A).le_aleph_0.antisymm (aleph_0_le_cardinal_mk_of_char_zero R A)
 
 end lift
 
@@ -95,8 +87,8 @@ by { rw [←lift_id (#_), ←lift_id #R[X]], exact cardinal_mk_lift_le_mul R A }
 theorem cardinal_mk_le_max : #{x : A // is_algebraic R x} ≤ max (#R) ℵ₀ :=
 by { rw [←lift_id (#_), ←lift_id (#R)], exact cardinal_mk_lift_le_max R A }
 
-theorem cardinal_mk_le_of_infinite [infinite R] : #{x : A // is_algebraic R x} ≤ #R :=
-(cardinal_mk_le_max R A).trans $ by simp
+@[simp] theorem cardinal_mk_of_infinite [infinite R] : #{x : A // is_algebraic R x} = #R :=
+lift_inj.1 $ cardinal_mk_lift_of_infinite R A
 
 end non_lift
 
diff --git a/src/algebra/associated.lean b/src/algebra/associated.lean
index 4bec54ef8b550..66ce92bbf4598 100644
--- a/src/algebra/associated.lean
+++ b/src/algebra/associated.lean
@@ -6,7 +6,6 @@ Authors: Johannes Hölzl, Jens Wagemaker
 import algebra.divisibility.basic
 import algebra.group_power.lemmas
 import algebra.parity
-import order.atoms
 
 /-!
 # Associated, prime, and irreducible elements.
@@ -987,19 +986,6 @@ begin
   rwa [← mul_assoc, mul_one],
 end
 
-lemma associates.is_atom_iff [cancel_comm_monoid_with_zero α] {p : associates α} (h₁ : p ≠ 0) :
-  is_atom p ↔ irreducible p :=
-⟨λ hp, ⟨by simpa only [associates.is_unit_iff_eq_one] using hp.1,
-        λ a b h, (hp.le_iff.mp ⟨_, h⟩).cases_on
-          (λ ha, or.inl (a.is_unit_iff_eq_one.mpr ha))
-          (λ ha, or.inr (show is_unit b, by {rw ha at h, apply is_unit_of_associated_mul
-          (show associated (p * b) p, by conv_rhs {rw h}) h₁ }))⟩,
- λ hp, ⟨by simpa only [associates.is_unit_iff_eq_one, associates.bot_eq_one] using hp.1,
-        λ b ⟨⟨a, hab⟩, hb⟩, (hp.is_unit_or_is_unit hab).cases_on
-          (λ hb, show b = ⊥, by rwa [associates.is_unit_iff_eq_one, ← associates.bot_eq_one] at hb)
-          (λ ha, absurd (show p ∣ b, from ⟨(ha.unit⁻¹ : units _), by simp [hab]; rw mul_assoc;
-            rw is_unit.mul_coe_inv ha; rw mul_one⟩) hb)⟩⟩
-
 lemma dvd_not_unit.not_associated [cancel_comm_monoid_with_zero α] {p q : α}
   (h : dvd_not_unit p q) : ¬ associated p q :=
 begin
@@ -1044,3 +1030,5 @@ begin
 end
 
 end cancel_comm_monoid_with_zero
+
+assert_not_exists multiset
diff --git a/src/algebra/big_operators/basic.lean b/src/algebra/big_operators/basic.lean
index c81e48ab7fcc9..65edbaf781e7b 100644
--- a/src/algebra/big_operators/basic.lean
+++ b/src/algebra/big_operators/basic.lean
@@ -368,16 +368,8 @@ by simp
 @[to_additive]
 lemma prod_bUnion [decidable_eq α] {s : finset γ} {t : γ → finset α}
   (hs : set.pairwise_disjoint ↑s t) :
-  (∏ x in (s.bUnion t), f x) = ∏ x in s, ∏ i in t x, f i :=
-begin
-  haveI := classical.dec_eq γ,
-  induction s using finset.induction_on with x s hxs ih hd,
-  { simp_rw [bUnion_empty, prod_empty] },
-  { simp_rw [coe_insert, set.pairwise_disjoint_insert, mem_coe] at hs,
-    have : disjoint (t x) (finset.bUnion s t),
-    { exact (disjoint_bUnion_right _ _ _).mpr (λ y hy, hs.2 y hy $ λ H, hxs $ H.substr hy) },
-    rw [bUnion_insert, prod_insert hxs, prod_union this, ih hs.1] }
-end
+  (∏ x in s.bUnion t, f x) = ∏ x in s, ∏ i in t x, f i :=
+by rw [←disj_Union_eq_bUnion _ _ hs, prod_disj_Union]
 
 /-- Product over a sigma type equals the product of fiberwise products. For rewriting
 in the reverse direction, use `finset.prod_sigma'`.  -/
@@ -386,16 +378,7 @@ in the reverse direction, use `finset.sum_sigma'`"]
 lemma prod_sigma {σ : α → Type*}
   (s : finset α) (t : Π a, finset (σ a)) (f : sigma σ → β) :
   (∏ x in s.sigma t, f x) = ∏ a in s, ∏ s in (t a), f ⟨a, s⟩ :=
-by classical;
-calc (∏ x in s.sigma t, f x) =
-       ∏ x in s.bUnion (λ a, (t a).map (function.embedding.sigma_mk a)), f x : by rw sigma_eq_bUnion
-  ... = ∏ a in s, ∏ x in (t a).map (function.embedding.sigma_mk a), f x :
-    prod_bUnion $ λ a₁ ha a₂ ha₂ h, disjoint_left.mpr $
-      by { simp_rw [mem_map, function.embedding.sigma_mk_apply],
-           rintros _ ⟨y, hy, rfl⟩ ⟨z, hz, hz'⟩,
-           exact h (congr_arg sigma.fst hz'.symm) }
-  ... = ∏ a in s, ∏ s in t a, f ⟨a, s⟩ :
-    prod_congr rfl $ λ _ _, prod_map _ _ _
+by simp_rw [←disj_Union_map_sigma_mk, prod_disj_Union, prod_map, function.embedding.sigma_mk_apply]
 
 @[to_additive]
 lemma prod_sigma' {σ : α → Type*}
@@ -501,12 +484,8 @@ lemma prod_fiberwise_of_maps_to [decidable_eq γ] {s : finset α} {t : finset γ
   (h : ∀ x ∈ s, g x ∈ t) (f : α → β) :
   (∏ y in t, ∏ x in s.filter (λ x, g x = y), f x) = ∏ x in s, f x :=
 begin
-  letI := classical.dec_eq α,
-  rw [← bUnion_filter_eq_of_maps_to h] {occs := occurrences.pos [2]},
-  refine (prod_bUnion $ λ x' hx y' hy hne, _).symm,
-  rw [function.on_fun, disjoint_filter],
-  rintros x hx rfl,
-  exact hne
+  rw [← disj_Union_filter_eq_of_maps_to h] {occs := occurrences.pos [2]},
+  rw prod_disj_Union,
 end
 
 @[to_additive]
@@ -1731,7 +1710,8 @@ lemma sup_powerset_len {α : Type*} [decidable_eq α] (x : multiset α) :
 begin
   convert bind_powerset_len x,
   rw [multiset.bind, multiset.join, ←finset.range_coe, ←finset.sum_eq_multiset_sum],
-  exact eq.symm (finset_sum_eq_sup_iff_disjoint.mpr (λ _ _ _ _ h, disjoint_powerset_len x h)),
+  exact eq.symm (finset_sum_eq_sup_iff_disjoint.mpr
+    (λ _ _ _ _ h, pairwise_disjoint_powerset_len x h)),
 end
 
 @[simp] lemma to_finset_sum_count_eq (s : multiset α) :
diff --git a/src/algebra/big_operators/finprod.lean b/src/algebra/big_operators/finprod.lean
index 2948189aebd12..1f10a690f35a1 100644
--- a/src/algebra/big_operators/finprod.lean
+++ b/src/algebra/big_operators/finprod.lean
@@ -540,7 +540,7 @@ lemma finprod_mem_empty : ∏ᶠ i ∈ (∅ : set α), f i = 1 := by simp
 /-- A set `s` is nonempty if the product of some function over `s` is not equal to `1`. -/
 @[to_additive "A set `s` is nonempty if the sum of some function over `s` is not equal to `0`."]
 lemma nonempty_of_finprod_mem_ne_one (h : ∏ᶠ i ∈ s, f i ≠ 1) : s.nonempty :=
-ne_empty_iff_nonempty.1 $ λ h', h $ h'.symm ▸ finprod_mem_empty
+nonempty_iff_ne_empty.2 $ λ h', h $ h'.symm ▸ finprod_mem_empty
 
 /-- Given finite sets `s` and `t`, the product of `f i` over `i ∈ s ∪ t` times the product of
 `f i` over `i ∈ s ∩ t` equals the product of `f i` over `i ∈ s` times the product of `f i`
diff --git a/src/algebra/big_operators/intervals.lean b/src/algebra/big_operators/intervals.lean
index 1c8260ea535de..ac3699ea592de 100644
--- a/src/algebra/big_operators/intervals.lean
+++ b/src/algebra/big_operators/intervals.lean
@@ -32,10 +32,7 @@ variables [comm_monoid β]
 lemma prod_Ico_add' [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α]
   [locally_finite_order α] (f : α → β) (a b c : α) :
   (∏ x in Ico a b, f (x + c)) = (∏ x in Ico (a + c) (b + c), f x) :=
-begin
-  classical,
-  rw [←image_add_right_Ico, prod_image (λ x hx y hy h, add_right_cancel h)],
-end
+by { rw [← map_add_right_Ico, prod_map], refl }
 
 @[to_additive]
 lemma prod_Ico_add [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α]
diff --git a/src/algebra/big_operators/ring.lean b/src/algebra/big_operators/ring.lean
index 191ba358c799a..5966de272a8c1 100644
--- a/src/algebra/big_operators/ring.lean
+++ b/src/algebra/big_operators/ring.lean
@@ -249,15 +249,7 @@ end
 `card s = k`, for `k = 1, ..., card s`"]
 lemma prod_powerset [comm_monoid β] (s : finset α) (f : finset α → β) :
   ∏ t in powerset s, f t = ∏ j in range (card s + 1), ∏ t in powerset_len j s, f t :=
-begin
-  classical,
-  rw [powerset_card_bUnion, prod_bUnion],
-  intros i hi j hj hij,
-  rw [function.on_fun, powerset_len_eq_filter, powerset_len_eq_filter, disjoint_filter],
-  intros x hx hc hnc,
-  apply hij,
-  rwa ← hc,
-end
+by rw [powerset_card_disj_Union, prod_disj_Union]
 
 lemma sum_range_succ_mul_sum_range_succ [non_unital_non_assoc_semiring β] (n k : ℕ) (f g : ℕ → β) :
   (∑ i in range (n+1), f i) * (∑ i in range (k+1), g i) =
diff --git a/src/algebra/bounds.lean b/src/algebra/bounds.lean
index b85c49e5106d2..dad2177fa3681 100644
--- a/src/algebra/bounds.lean
+++ b/src/algebra/bounds.lean
@@ -3,7 +3,9 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
+import algebra.order.group.order_iso
 import data.set.pointwise.basic
+import order.bounds.order_iso
 import order.conditionally_complete_lattice.basic
 
 /-!
diff --git a/src/algebra/category/Module/algebra.lean b/src/algebra/category/Module/algebra.lean
index 85c0477ab0249..1851f61081c1d 100644
--- a/src/algebra/category/Module/algebra.lean
+++ b/src/algebra/category/Module/algebra.lean
@@ -29,13 +29,13 @@ that carries these typeclasses, this seems hard to achieve.
 requiring users to write `Module' ℤ A` when `A` is merely a ring.)
 -/
 
-universes v u
+universes v u w
 open category_theory
 
 namespace Module
 
 variables {k : Type u} [field k]
-variables {A : Type u} [ring A] [algebra k A]
+variables {A : Type w} [ring A] [algebra k A]
 
 /--
 Type synonym for considering a module over a `k`-algebra as a `k`-module.
diff --git a/src/algebra/category/Module/simple.lean b/src/algebra/category/Module/simple.lean
index 0e42b77ac2145..4d2453c3be8a3 100644
--- a/src/algebra/category/Module/simple.lean
+++ b/src/algebra/category/Module/simple.lean
@@ -5,7 +5,9 @@ Authors: Pierre-Alexandre Bazin, Scott Morrison
 -/
 import category_theory.simple
 import algebra.category.Module.subobject
+import algebra.category.Module.algebra
 import ring_theory.simple_module
+import linear_algebra.finite_dimensional
 
 /-!
 # Simple objects in the category of `R`-modules
@@ -19,6 +21,9 @@ open category_theory Module
 lemma simple_iff_is_simple_module : simple (of R M) ↔ is_simple_module R M :=
 (simple_iff_subobject_is_simple_order _).trans (subobject_Module (of R M)).is_simple_order_iff
 
+lemma simple_iff_is_simple_module' (M : Module R) : simple M ↔ is_simple_module R M :=
+(simple.iff_of_iso (of_self_iso M).symm).trans simple_iff_is_simple_module
+
 /-- A simple module is a simple object in the category of modules. -/
 instance simple_of_is_simple_module [is_simple_module R M] : simple (of R M) :=
 simple_iff_is_simple_module.mpr ‹_›
@@ -26,3 +31,12 @@ simple_iff_is_simple_module.mpr ‹_›
 /-- A simple object in the category of modules is a simple module. -/
 instance is_simple_module_of_simple (M : Module R) [simple M] : is_simple_module R M :=
 simple_iff_is_simple_module.mp (simple.of_iso (of_self_iso M))
+
+open finite_dimensional
+
+local attribute [instance] module_of_algebra_Module is_scalar_tower_of_algebra_Module
+
+/-- Any `k`-algebra module which is 1-dimensional over `k` is simple. -/
+lemma simple_of_finrank_eq_one {k : Type*} [field k] [algebra k R]
+  {V : Module R} (h : finrank k V = 1) : simple V :=
+(simple_iff_is_simple_module' V).mpr (is_simple_module_of_finrank_eq_one h)
diff --git a/src/algebra/char_zero/infinite.lean b/src/algebra/char_zero/infinite.lean
index 38a50918e2cf5..e9cebe06e7997 100644
--- a/src/algebra/char_zero/infinite.lean
+++ b/src/algebra/char_zero/infinite.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
 import algebra.char_zero.defs
-import data.fintype.lattice
+import data.fintype.card
 
 /-! # A characteristic-zero semiring is infinite -/
 
diff --git a/src/algebra/cubic_discriminant.lean b/src/algebra/cubic_discriminant.lean
index edd52127e2663..2ac5858261166 100644
--- a/src/algebra/cubic_discriminant.lean
+++ b/src/algebra/cubic_discriminant.lean
@@ -132,6 +132,63 @@ lemma ne_zero_of_c_ne_zero (hc : P.c ≠ 0) : P.to_poly ≠ 0 :=
 lemma ne_zero_of_d_ne_zero (hd : P.d ≠ 0) : P.to_poly ≠ 0 :=
 (or_imp_distrib.mp (or_imp_distrib.mp (or_imp_distrib.mp ne_zero).2).2).2 hd
 
+@[simp] lemma leading_coeff_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly.leading_coeff = P.a :=
+leading_coeff_cubic ha
+
+@[simp] lemma leading_coeff_of_a_ne_zero' (ha : a ≠ 0) : (to_poly ⟨a, b, c, d⟩).leading_coeff = a :=
+leading_coeff_of_a_ne_zero ha
+
+@[simp] lemma leading_coeff_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) :
+  P.to_poly.leading_coeff = P.b :=
+by rw [of_a_eq_zero ha, leading_coeff_quadratic hb]
+
+@[simp] lemma leading_coeff_of_b_ne_zero' (hb : b ≠ 0) : (to_poly ⟨0, b, c, d⟩).leading_coeff = b :=
+leading_coeff_of_b_ne_zero rfl hb
+
+@[simp] lemma leading_coeff_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) :
+  P.to_poly.leading_coeff = P.c :=
+by rw [of_b_eq_zero ha hb, leading_coeff_linear hc]
+
+@[simp] lemma leading_coeff_of_c_ne_zero' (hc : c ≠ 0) : (to_poly ⟨0, 0, c, d⟩).leading_coeff = c :=
+leading_coeff_of_c_ne_zero rfl rfl hc
+
+@[simp] lemma leading_coeff_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) :
+  P.to_poly.leading_coeff = P.d :=
+by rw [of_c_eq_zero ha hb hc, leading_coeff_C]
+
+@[simp] lemma leading_coeff_of_c_eq_zero' : (to_poly ⟨0, 0, 0, d⟩).leading_coeff = d :=
+leading_coeff_of_c_eq_zero rfl rfl rfl
+
+lemma monic_of_a_eq_one (ha : P.a = 1) : P.to_poly.monic :=
+begin
+  nontriviality,
+  rw [monic, leading_coeff_of_a_ne_zero $ by { rw [ha], exact one_ne_zero }, ha]
+end
+
+lemma monic_of_a_eq_one' : (to_poly ⟨1, b, c, d⟩).monic := monic_of_a_eq_one rfl
+
+lemma monic_of_b_eq_one (ha : P.a = 0) (hb : P.b = 1) : P.to_poly.monic :=
+begin
+  nontriviality,
+  rw [monic, leading_coeff_of_b_ne_zero ha $ by { rw [hb], exact one_ne_zero }, hb]
+end
+
+lemma monic_of_b_eq_one' : (to_poly ⟨0, 1, c, d⟩).monic := monic_of_b_eq_one rfl rfl
+
+lemma monic_of_c_eq_one (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 1) : P.to_poly.monic :=
+begin
+  nontriviality,
+  rw [monic, leading_coeff_of_c_ne_zero ha hb $ by { rw [hc], exact one_ne_zero }, hc]
+end
+
+lemma monic_of_c_eq_one' : (to_poly ⟨0, 0, 1, d⟩).monic := monic_of_c_eq_one rfl rfl rfl
+
+lemma monic_of_d_eq_one (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 1) :
+  P.to_poly.monic :=
+by rw [monic, leading_coeff_of_c_eq_zero ha hb hc, hd]
+
+lemma monic_of_d_eq_one' : (to_poly ⟨0, 0, 0, 1⟩).monic := monic_of_d_eq_one rfl rfl rfl rfl
+
 end coeff
 
 /-! ### Degrees -/
@@ -200,32 +257,45 @@ degree_of_d_eq_zero rfl rfl rfl rfl
 
 @[simp] lemma degree_of_zero : (0 : cubic R).to_poly.degree = ⊥ := degree_of_d_eq_zero'
 
-@[simp] lemma leading_coeff_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly.leading_coeff = P.a :=
-leading_coeff_cubic ha
+@[simp] lemma nat_degree_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly.nat_degree = 3 :=
+nat_degree_cubic ha
 
-@[simp] lemma leading_coeff_of_a_ne_zero' (ha : a ≠ 0) : (to_poly ⟨a, b, c, d⟩).leading_coeff = a :=
-leading_coeff_of_a_ne_zero ha
+@[simp] lemma nat_degree_of_a_ne_zero' (ha : a ≠ 0) : (to_poly ⟨a, b, c, d⟩).nat_degree = 3 :=
+nat_degree_of_a_ne_zero ha
 
-@[simp] lemma leading_coeff_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) :
-  P.to_poly.leading_coeff = P.b :=
-by rw [of_a_eq_zero ha, leading_coeff_quadratic hb]
+lemma nat_degree_of_a_eq_zero (ha : P.a = 0) : P.to_poly.nat_degree ≤ 2 :=
+by simpa only [of_a_eq_zero ha] using nat_degree_quadratic_le
 
-@[simp] lemma leading_coeff_of_b_ne_zero' (hb : b ≠ 0) : (to_poly ⟨0, b, c, d⟩).leading_coeff = b :=
-leading_coeff_of_b_ne_zero rfl hb
+lemma nat_degree_of_a_eq_zero' : (to_poly ⟨0, b, c, d⟩).nat_degree ≤ 2 :=
+nat_degree_of_a_eq_zero rfl
 
-@[simp] lemma leading_coeff_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) :
-  P.to_poly.leading_coeff = P.c :=
-by rw [of_b_eq_zero ha hb, leading_coeff_linear hc]
+@[simp] lemma nat_degree_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.to_poly.nat_degree = 2 :=
+by rw [of_a_eq_zero ha, nat_degree_quadratic hb]
 
-@[simp] lemma leading_coeff_of_c_ne_zero' (hc : c ≠ 0) : (to_poly ⟨0, 0, c, d⟩).leading_coeff = c :=
-leading_coeff_of_c_ne_zero rfl rfl hc
+@[simp] lemma nat_degree_of_b_ne_zero' (hb : b ≠ 0) : (to_poly ⟨0, b, c, d⟩).nat_degree = 2 :=
+nat_degree_of_b_ne_zero rfl hb
 
-@[simp] lemma leading_coeff_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) :
-  P.to_poly.leading_coeff = P.d :=
-by rw [of_c_eq_zero ha hb hc, leading_coeff_C]
+lemma nat_degree_of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.to_poly.nat_degree ≤ 1 :=
+by simpa only [of_b_eq_zero ha hb] using nat_degree_linear_le
 
-@[simp] lemma leading_coeff_of_c_eq_zero' : (to_poly ⟨0, 0, 0, d⟩).leading_coeff = d :=
-leading_coeff_of_c_eq_zero rfl rfl rfl
+lemma nat_degree_of_b_eq_zero' : (to_poly ⟨0, 0, c, d⟩).nat_degree ≤ 1 :=
+nat_degree_of_b_eq_zero rfl rfl
+
+@[simp] lemma nat_degree_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) :
+  P.to_poly.nat_degree = 1 :=
+by rw [of_b_eq_zero ha hb, nat_degree_linear hc]
+
+@[simp] lemma nat_degree_of_c_ne_zero' (hc : c ≠ 0) : (to_poly ⟨0, 0, c, d⟩).nat_degree = 1 :=
+nat_degree_of_c_ne_zero rfl rfl hc
+
+@[simp] lemma nat_degree_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) :
+  P.to_poly.nat_degree = 0 :=
+by rw [of_c_eq_zero ha hb hc, nat_degree_C]
+
+@[simp] lemma nat_degree_of_c_eq_zero' : (to_poly ⟨0, 0, 0, d⟩).nat_degree = 0 :=
+nat_degree_of_c_eq_zero rfl rfl rfl
+
+@[simp] lemma nat_degree_of_zero : (0 : cubic R).to_poly.nat_degree = 0 := nat_degree_of_c_eq_zero'
 
 end degree
 
diff --git a/src/algebra/divisibility/basic.lean b/src/algebra/divisibility/basic.lean
index 79400687391e8..b374dd07c905b 100644
--- a/src/algebra/divisibility/basic.lean
+++ b/src/algebra/divisibility/basic.lean
@@ -10,6 +10,10 @@ import algebra.hom.group
 /-!
 # Divisibility
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/833
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the basics of the divisibility relation in the context of `(comm_)` `monoid`s.
 
 ## Main definitions
diff --git a/src/algebra/divisibility/units.lean b/src/algebra/divisibility/units.lean
index 368f442d83435..974e7654eac3f 100644
--- a/src/algebra/divisibility/units.lean
+++ b/src/algebra/divisibility/units.lean
@@ -9,6 +9,10 @@ import algebra.group.units
 
 /-!
 # Lemmas about divisibility and units
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/848
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 variables {α : Type*}
diff --git a/src/algebra/euclidean_domain/basic.lean b/src/algebra/euclidean_domain/basic.lean
index 676b8b96855e8..6a9c99df93b0f 100644
--- a/src/algebra/euclidean_domain/basic.lean
+++ b/src/algebra/euclidean_domain/basic.lean
@@ -7,6 +7,7 @@ import algebra.euclidean_domain.defs
 import algebra.ring.divisibility
 import algebra.ring.regular
 import algebra.group_with_zero.divisibility
+import algebra.ring.basic
 
 /-!
 # Lemmas about Euclidean domains
@@ -171,12 +172,15 @@ by { have := @xgcd_aux_P _ _ _ a b a b 1 0 0 1
 rwa [xgcd_aux_val, xgcd_val] at this }
 
 @[priority 70] -- see Note [lower instance priority]
-instance (R : Type*) [e : euclidean_domain R] : is_domain R :=
+instance (R : Type*) [e : euclidean_domain R] : no_zero_divisors R :=
 by { haveI := classical.dec_eq R, exact
 { eq_zero_or_eq_zero_of_mul_eq_zero :=
     λ a b h, (or_iff_not_and_not.2 $ λ h0,
-      h0.1 $ by rw [← mul_div_cancel a h0.2, h, zero_div]),
-  ..e }}
+      h0.1 $ by rw [← mul_div_cancel a h0.2, h, zero_div]) }}
+
+@[priority 70] -- see Note [lower instance priority]
+instance (R : Type*) [e : euclidean_domain R] : is_domain R :=
+{ .. e, .. no_zero_divisors.to_is_domain R }
 
 end gcd
 
diff --git a/src/algebra/euclidean_domain/defs.lean b/src/algebra/euclidean_domain/defs.lean
index 8b83ec1fc225a..cd8945dff425e 100644
--- a/src/algebra/euclidean_domain/defs.lean
+++ b/src/algebra/euclidean_domain/defs.lean
@@ -11,6 +11,10 @@ import algebra.ring.defs
 /-!
 # Euclidean domains
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/871
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file introduces Euclidean domains and provides the extended Euclidean algorithm. To be precise,
 a slightly more general version is provided which is sometimes called a transfinite Euclidean domain
 and differs in the fact that the degree function need not take values in `ℕ` but can take values in
diff --git a/src/algebra/field/basic.lean b/src/algebra/field/basic.lean
index 78eb496fa6eca..4dde0718e8d15 100644
--- a/src/algebra/field/basic.lean
+++ b/src/algebra/field/basic.lean
@@ -126,8 +126,7 @@ by rw [(mul_sub_left_distrib (1 / a)), (one_div_mul_cancel ha), mul_sub_right_di
 
 @[priority 100] -- see Note [lower instance priority]
 instance division_ring.is_domain : is_domain K :=
-{ ..‹division_ring K›,
-  ..(by apply_instance : no_zero_divisors K) }
+no_zero_divisors.to_is_domain _
 
 end division_ring
 
diff --git a/src/algebra/gcd_monoid/multiset.lean b/src/algebra/gcd_monoid/multiset.lean
index b00b7a2084a85..a5979fe6249a2 100644
--- a/src/algebra/gcd_monoid/multiset.lean
+++ b/src/algebra/gcd_monoid/multiset.lean
@@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
 import algebra.gcd_monoid.basic
+import data.multiset.finset_ops
+import data.multiset.fold
 
 /-!
 # GCD and LCM operations on multisets
diff --git a/src/algebra/group/conj.lean b/src/algebra/group/conj.lean
index 26a13ed2bd812..6912b20fa5912 100644
--- a/src/algebra/group/conj.lean
+++ b/src/algebra/group/conj.lean
@@ -7,8 +7,6 @@ import algebra.group.semiconj
 import algebra.group_with_zero.basic
 import algebra.hom.aut
 import algebra.hom.group
-import data.finite.basic
-import data.fintype.units
 
 /-!
 # Conjugacy of group elements
@@ -174,13 +172,6 @@ begin
   exact ⟨conj_classes.mk a, rfl⟩,
 end
 
-instance [fintype α] [decidable_rel (is_conj : α → α → Prop)] :
-  fintype (conj_classes α) :=
-quotient.fintype (is_conj.setoid α)
-
-instance [finite α] : finite (conj_classes α) :=
-quotient.finite _
-
 /--
 Certain instances trigger further searches when they are considered as candidate instances;
 these instances should be assigned a priority lower than the default of 1000 (for example, 900).
@@ -215,9 +206,6 @@ library_note "slow-failing instance priority"
 instance [decidable_rel (is_conj : α → α → Prop)] : decidable_eq (conj_classes α) :=
 quotient.decidable_eq
 
-instance [decidable_eq α] [fintype α] : decidable_rel (is_conj : α → α → Prop) :=
-λ a b, by { delta is_conj semiconj_by, apply_instance }
-
 end monoid
 
 section comm_monoid
@@ -261,9 +249,6 @@ lemma is_conj_iff_conjugates_of_eq {a b : α} :
   rwa ← h at ha,
 end⟩
 
-instance [fintype α] [decidable_rel (is_conj : α → α → Prop)] {a : α} : fintype (conjugates_of a) :=
-@subtype.fintype _ _ (‹decidable_rel is_conj› a) _
-
 end monoid
 
 namespace conj_classes
@@ -292,13 +277,6 @@ lemma carrier_eq_preimage_mk {a : conj_classes α} :
   a.carrier = conj_classes.mk ⁻¹' {a} :=
 set.ext (λ x, mem_carrier_iff_mk_eq)
 
-section fintype
-
-variables [fintype α] [decidable_rel (is_conj : α → α → Prop)]
-
-instance {x : conj_classes α} : fintype (carrier x) :=
-quotient.rec_on_subsingleton x $ λ a, conjugates_of.fintype
-
-end fintype
-
 end conj_classes
+
+assert_not_exists multiset
diff --git a/src/algebra/group/conj_finite.lean b/src/algebra/group/conj_finite.lean
new file mode 100644
index 0000000000000..44b67a8656686
--- /dev/null
+++ b/src/algebra/group/conj_finite.lean
@@ -0,0 +1,39 @@
+/-
+Copyright (c) 2022 Eric Rodriguez. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Rodriguez
+-/
+
+import algebra.group.conj
+import data.finite.basic
+import data.fintype.units
+
+/-!
+# Conjugacy of elements of finite groups
+-/
+
+variables {α : Type*} [monoid α]
+
+local attribute [instance, priority 100] is_conj.setoid
+
+instance [fintype α] [decidable_rel (is_conj : α → α → Prop)] :
+  fintype (conj_classes α) :=
+quotient.fintype (is_conj.setoid α)
+
+instance [finite α] : finite (conj_classes α) :=
+quotient.finite _
+
+instance [decidable_eq α] [fintype α] : decidable_rel (is_conj : α → α → Prop) :=
+λ a b, by { delta is_conj semiconj_by, apply_instance }
+
+instance [fintype α] [decidable_rel (is_conj : α → α → Prop)] {a : α} : fintype (conjugates_of a) :=
+@subtype.fintype _ _ (‹decidable_rel is_conj› a) _
+
+namespace conj_classes
+
+variables [fintype α] [decidable_rel (is_conj : α → α → Prop)]
+
+instance {x : conj_classes α} : fintype (carrier x) :=
+quotient.rec_on_subsingleton x $ λ a, conjugates_of.fintype
+
+end conj_classes
diff --git a/src/algebra/group/ext.lean b/src/algebra/group/ext.lean
index bdb05f1d5cc5e..f5bccda5bbcf6 100644
--- a/src/algebra/group/ext.lean
+++ b/src/algebra/group/ext.lean
@@ -8,6 +8,10 @@ import algebra.hom.group
 /-!
 # Extensionality lemmas for monoid and group structures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/850
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove extensionality lemmas for `monoid` and higher algebraic structures with one
 binary operation. Extensionality lemmas for structures that are lower in the hierarchy can be found
 in `algebra.group.defs`.
diff --git a/src/algebra/group/type_tags.lean b/src/algebra/group/type_tags.lean
index d03b666e93413..b4b13f9c76de3 100644
--- a/src/algebra/group/type_tags.lean
+++ b/src/algebra/group/type_tags.lean
@@ -9,6 +9,10 @@ import data.finite.defs
 /-!
 # Type tags that turn additive structures into multiplicative, and vice versa
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/832
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define two type tags:
 
 * `additive α`: turns any multiplicative structure on `α` into the corresponding
diff --git a/src/algebra/group/with_one/defs.lean b/src/algebra/group/with_one/defs.lean
index 3fc88f27803a3..202aa8907ec70 100644
--- a/src/algebra/group/with_one/defs.lean
+++ b/src/algebra/group/with_one/defs.lean
@@ -9,6 +9,10 @@ import algebra.ring.defs
 /-!
 # Adjoining a zero/one to semigroups and related algebraic structures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/841
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains different results about adjoining an element to an algebraic structure which then
 behaves like a zero or a one. An example is adjoining a one to a semigroup to obtain a monoid. That
 this provides an example of an adjunction is proved in `algebra.category.Mon.adjunctions`.
diff --git a/src/algebra/group_power/basic.lean b/src/algebra/group_power/basic.lean
index 9910c50bcb1b9..64f57d6890159 100644
--- a/src/algebra/group_power/basic.lean
+++ b/src/algebra/group_power/basic.lean
@@ -10,6 +10,10 @@ import algebra.group.type_tags
 /-!
 # Power operations on monoids and groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/874
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The power operation on monoids and groups.
 We separate this from group, because it depends on `ℕ`,
 which in turn depends on other parts of algebra.
diff --git a/src/algebra/group_power/order.lean b/src/algebra/group_power/order.lean
index 2eb3f41689bc5..95e0b4bc817bb 100644
--- a/src/algebra/group_power/order.lean
+++ b/src/algebra/group_power/order.lean
@@ -489,7 +489,7 @@ variables [linear_ordered_comm_group_with_zero M] {a : M} {m n : ℕ}
 
 lemma pow_lt_pow_succ (ha : 1 < a) : a ^ n < a ^ n.succ :=
 by { rw [←one_mul (a ^ n), pow_succ],
-  exact mul_lt_right₀ _ ha (pow_ne_zero _ (zero_lt_one₀.trans ha).ne') }
+  exact mul_lt_right₀ _ ha (pow_ne_zero _ (zero_lt_one.trans ha).ne') }
 
 lemma pow_lt_pow₀ (ha : 1 < a) (hmn : m < n) : a ^ m < a ^ n :=
 by { induction hmn with n hmn ih, exacts [pow_lt_pow_succ ha, lt_trans ih (pow_lt_pow_succ ha)] }
diff --git a/src/algebra/group_with_zero/divisibility.lean b/src/algebra/group_with_zero/divisibility.lean
index 91c4a44532674..d9c9c5b1ba160 100644
--- a/src/algebra/group_with_zero/divisibility.lean
+++ b/src/algebra/group_with_zero/divisibility.lean
@@ -10,6 +10,10 @@ import algebra.divisibility.units
 /-!
 # Divisibility in groups with zero.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/870
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Lemmas about divisibility in groups and monoids with zero.
 
 -/
diff --git a/src/algebra/hom/commute.lean b/src/algebra/hom/commute.lean
index 5f4ef0a44fc8d..7622db4ae5c55 100644
--- a/src/algebra/hom/commute.lean
+++ b/src/algebra/hom/commute.lean
@@ -9,6 +9,10 @@ import algebra.group.commute
 
 /-!
 # Multiplicative homomorphisms respect semiconjugation and commutation.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/831
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 section commute
diff --git a/src/algebra/hom/equiv/basic.lean b/src/algebra/hom/equiv/basic.lean
index cedc374820889..153a5ec737989 100644
--- a/src/algebra/hom/equiv/basic.lean
+++ b/src/algebra/hom/equiv/basic.lean
@@ -11,6 +11,10 @@ import data.pi.algebra
 /-!
 # Multiplicative and additive equivs
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/835
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define two extensions of `equiv` called `add_equiv` and `mul_equiv`, which are
 datatypes representing isomorphisms of `add_monoid`s/`add_group`s and `monoid`s/`group`s.
 
@@ -450,16 +454,16 @@ def Pi_congr_right {η : Type*}
   map_mul' := λ x y, funext $ λ j, (es j).map_mul (x j) (y j),
   .. equiv.Pi_congr_right (λ j, (es j).to_equiv) }
 
-@[simp]
+@[simp, to_additive]
 lemma Pi_congr_right_refl {η : Type*} {Ms : η → Type*} [Π j, has_mul (Ms j)] :
   Pi_congr_right (λ j, mul_equiv.refl (Ms j)) = mul_equiv.refl _ := rfl
 
-@[simp]
+@[simp, to_additive]
 lemma Pi_congr_right_symm {η : Type*}
   {Ms Ns : η → Type*} [Π j, has_mul (Ms j)] [Π j, has_mul (Ns j)]
   (es : ∀ j, Ms j ≃* Ns j) : (Pi_congr_right es).symm = (Pi_congr_right $ λ i, (es i).symm) := rfl
 
-@[simp]
+@[simp, to_additive]
 lemma Pi_congr_right_trans {η : Type*}
   {Ms Ns Ps : η → Type*} [Π j, has_mul (Ms j)] [Π j, has_mul (Ns j)]
   [Π j, has_mul (Ps j)]
diff --git a/src/algebra/hom/equiv/units/basic.lean b/src/algebra/hom/equiv/units/basic.lean
index c92a20ca3a8d1..1b60a7678fac3 100644
--- a/src/algebra/hom/equiv/units/basic.lean
+++ b/src/algebra/hom/equiv/units/basic.lean
@@ -8,6 +8,10 @@ import algebra.hom.units
 
 /-!
 # Multiplicative and additive equivalence acting on units.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/895
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 variables {F α β A B M N P Q G H : Type*}
diff --git a/src/algebra/hom/equiv/units/group_with_zero.lean b/src/algebra/hom/equiv/units/group_with_zero.lean
index a8325367140ac..5bb1b951fe459 100644
--- a/src/algebra/hom/equiv/units/group_with_zero.lean
+++ b/src/algebra/hom/equiv/units/group_with_zero.lean
@@ -8,6 +8,10 @@ import algebra.group_with_zero.units.basic
 
 /-!
 # Multiplication by a nonzero element in a `group_with_zero` is a permutation.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/901
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 variables {G : Type*}
diff --git a/src/algebra/hom/group.lean b/src/algebra/hom/group.lean
index 6495831cbf058..dac0966e0b3d6 100644
--- a/src/algebra/hom/group.lean
+++ b/src/algebra/hom/group.lean
@@ -12,6 +12,10 @@ import data.fun_like.basic
 /-!
 # Monoid and group homomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/659
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the bundled structures for monoid and group homomorphisms. Namely, we define
 `monoid_hom` (resp., `add_monoid_hom`) to be bundled homomorphisms between multiplicative (resp.,
 additive) monoids or groups.
diff --git a/src/algebra/hom/iterate.lean b/src/algebra/hom/iterate.lean
index 5b5e517f9fca9..726af4b26357a 100644
--- a/src/algebra/hom/iterate.lean
+++ b/src/algebra/hom/iterate.lean
@@ -164,8 +164,34 @@ smul_iterate (mul_opposite.op a) n
 lemma mul_right_iterate_apply_one : (* a)^[n] 1 = a ^ n :=
 by simp [mul_right_iterate]
 
+@[simp, to_additive]
+lemma pow_iterate (n : ℕ) (j : ℕ) : ((λ (x : G), x^n)^[j]) = λ x, x^(n^j) :=
+begin
+  letI : mul_action ℕ G :=
+  { smul := λ n g, g^n,
+    one_smul := pow_one,
+    mul_smul := λ m n g, pow_mul' g m n },
+  exact smul_iterate n j,
+end
+
 end monoid
 
+section group
+
+variables [group G]
+
+@[simp, to_additive]
+lemma zpow_iterate (n : ℤ) (j : ℕ) : ((λ (x : G), x^n)^[j]) = λ x, x^(n^j) :=
+begin
+  letI : mul_action ℤ G :=
+  { smul := λ n g, g^n,
+    one_smul := zpow_one,
+    mul_smul := λ m n g, zpow_mul' g m n },
+  exact smul_iterate n j,
+end
+
+end group
+
 section semigroup
 
 variables [semigroup G] {a b c : G}
diff --git a/src/algebra/hom/non_unital_alg.lean b/src/algebra/hom/non_unital_alg.lean
index 80cfcc6a71363..c60ff8177307c 100644
--- a/src/algebra/hom/non_unital_alg.lean
+++ b/src/algebra/hom/non_unital_alg.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Oliver Nash. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Oliver Nash
 -/
-import algebra.algebra.basic
+import algebra.algebra.hom
 
 /-!
 # Morphisms of non-unital algebras
diff --git a/src/algebra/hom/ring.lean b/src/algebra/hom/ring.lean
index 3e323eb28a218..ebf2272eeeab3 100644
--- a/src/algebra/hom/ring.lean
+++ b/src/algebra/hom/ring.lean
@@ -8,7 +8,7 @@ import algebra.ring.basic
 import algebra.divisibility.basic
 import data.pi.algebra
 import algebra.hom.units
-import data.set.basic
+import data.set.image
 
 /-!
 # Homomorphisms of semirings and rings
@@ -528,9 +528,13 @@ end ring_hom
 
 /-- Pullback `is_domain` instance along an injective function. -/
 protected theorem function.injective.is_domain [ring α] [is_domain α] [ring β] (f : β →+* α)
-  (hf : injective f) :
-  is_domain β :=
-{ .. pullback_nonzero f f.map_zero f.map_one, .. hf.no_zero_divisors f f.map_zero f.map_mul }
+  (hf : injective f) : is_domain β :=
+begin
+  haveI := pullback_nonzero f f.map_zero f.map_one,
+  haveI := is_right_cancel_mul_zero.to_no_zero_divisors α,
+  haveI := hf.no_zero_divisors f f.map_zero f.map_mul,
+  exact no_zero_divisors.to_is_domain β,
+end
 
 namespace add_monoid_hom
 variables [comm_ring α] [is_domain α] [comm_ring β] (f : β →+ α)
diff --git a/src/algebra/hom/units.lean b/src/algebra/hom/units.lean
index 9e5a0f813322b..0972bdf866549 100644
--- a/src/algebra/hom/units.lean
+++ b/src/algebra/hom/units.lean
@@ -8,6 +8,10 @@ import algebra.group.units
 /-!
 # Monoid homomorphisms and units
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/745
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file allows to lift monoid homomorphisms to group homomorphisms of their units subgroups. It
 also contains unrelated results about `units` that depend on `monoid_hom`.
 
diff --git a/src/algebra/homology/additive.lean b/src/algebra/homology/additive.lean
index 072555a1eabce..2d2d5662d2939 100644
--- a/src/algebra/homology/additive.lean
+++ b/src/algebra/homology/additive.lean
@@ -110,6 +110,17 @@ def functor.map_homological_complex (F : V ⥤ W) [F.additive] (c : complex_shap
 instance functor.map_homogical_complex_additive
   (F : V ⥤ W) [F.additive] (c : complex_shape ι) : (F.map_homological_complex c).additive := {}
 
+instance functor.map_homological_complex_reflects_iso
+  (F : V ⥤ W) [F.additive] [reflects_isomorphisms F] (c : complex_shape ι) :
+  reflects_isomorphisms (F.map_homological_complex c) :=
+⟨λ X Y f, begin
+  introI,
+  haveI : ∀ (n : ι), is_iso (F.map (f.f n)) := λ n, is_iso.of_iso
+    ((homological_complex.eval W c n).map_iso (as_iso ((F.map_homological_complex c).map f))),
+  haveI := λ n, is_iso_of_reflects_iso (f.f n) F,
+  exact homological_complex.hom.is_iso_of_components f,
+end⟩
+
 /--
 A natural transformation between functors induces a natural transformation
 between those functors applied to homological complexes.
diff --git a/src/algebra/homology/homological_complex.lean b/src/algebra/homology/homological_complex.lean
index 4d183ab8b5dae..c948c649e5010 100644
--- a/src/algebra/homology/homological_complex.lean
+++ b/src/algebra/homology/homological_complex.lean
@@ -428,6 +428,14 @@ def iso_of_components (f : Π i, C₁.X i ≅ C₂.X i)
   iso_app (iso_of_components f hf) i = f i :=
 by { ext, simp, }
 
+lemma is_iso_of_components (f : C₁ ⟶ C₂) [∀ (n : ι), is_iso (f.f n)] : is_iso f :=
+begin
+  convert is_iso.of_iso (homological_complex.hom.iso_of_components (λ n, as_iso (f.f n))
+    (by tidy)),
+  ext n,
+  refl,
+end
+
 /-! Lemmas relating chain maps and `d_to`/`d_from`. -/
 
 /-- `f.prev j` is `f.f i` if there is some `r i j`, and `f.f j` otherwise. -/
diff --git a/src/algebra/lie/solvable.lean b/src/algebra/lie/solvable.lean
index ec058f075296a..463baa24be718 100644
--- a/src/algebra/lie/solvable.lean
+++ b/src/algebra/lie/solvable.lean
@@ -333,8 +333,8 @@ lemma derived_length_zero (I : lie_ideal R L) [hI : is_solvable R I] :
 begin
   let s := {k | derived_series_of_ideal R L k I = ⊥}, change Inf s = 0 ↔ _,
   have hne : s ≠ ∅,
-  { rw set.ne_empty_iff_nonempty,
-    obtain ⟨k, hk⟩ := id hI, use k,
+  { obtain ⟨k, hk⟩ := id hI,
+    refine set.nonempty.ne_empty ⟨k, _⟩,
     rw [derived_series_def, lie_ideal.derived_series_eq_bot_iff] at hk, exact hk, },
   simp [hne],
 end
diff --git a/src/algebra/module/dedekind_domain.lean b/src/algebra/module/dedekind_domain.lean
index c7e533928a18d..775f0ed143055 100644
--- a/src/algebra/module/dedekind_domain.lean
+++ b/src/algebra/module/dedekind_domain.lean
@@ -62,7 +62,7 @@ theorem is_internal_prime_power_torsion [module.finite R M] (hM : module.is_tors
 begin
   obtain ⟨I, hI, hM'⟩ := is_torsion_by_ideal_of_finite_of_is_torsion hM,
   refine is_internal_prime_power_torsion_of_is_torsion_by_ideal _ hM',
-  rw set.ne_empty_iff_nonempty at hI, rw submodule.ne_bot_iff,
+  rw ←set.nonempty_iff_ne_empty at hI, rw submodule.ne_bot_iff,
   obtain ⟨x, H, hx⟩ := hI, exact ⟨x, H, non_zero_divisors.ne_zero hx⟩
 end
 
diff --git a/src/algebra/module/linear_map.lean b/src/algebra/module/linear_map.lean
index 7d66c2567ba6e..96457fd912eb8 100644
--- a/src/algebra/module/linear_map.lean
+++ b/src/algebra/module/linear_map.lean
@@ -7,7 +7,7 @@ Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro, Anne
 import algebra.hom.group_action
 import algebra.module.pi
 import algebra.star.basic
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 import algebra.ring.comp_typeclasses
 
 /-!
diff --git a/src/algebra/module/localized_module.lean b/src/algebra/module/localized_module.lean
index ac588db9262ab..6c33c39d43e93 100644
--- a/src/algebra/module/localized_module.lean
+++ b/src/algebra/module/localized_module.lean
@@ -964,6 +964,31 @@ begin
   exact ⟨⟨m, s⟩, mk'_eq_iff.mpr e.symm⟩
 end
 
+section algebra
+
+lemma mk_of_algebra {R S S' : Type*} [comm_ring R] [comm_ring S] [comm_ring S']
+  [algebra R S] [algebra R S'] (M : submonoid R) (f : S →ₐ[R] S')
+  (h₁ : ∀ x ∈ M, is_unit (algebra_map R S' x))
+  (h₂ : ∀ y, ∃ (x : S × M), x.2 • y = f x.1)
+  (h₃ : ∀ x, f x = 0 → ∃ m : M, m • x = 0) :
+  is_localized_module M f.to_linear_map :=
+begin
+  replace h₃ := λ x, iff.intro (h₃ x) (λ ⟨⟨m, hm⟩, e⟩, (h₁ m hm).mul_left_cancel $
+    by { rw ← algebra.smul_def, simpa [submonoid.smul_def] using f.congr_arg e }),
+  constructor,
+  { intro x,
+    rw module.End_is_unit_iff,
+    split,
+    { rintros a b (e : x • a = x • b), simp_rw [submonoid.smul_def, algebra.smul_def] at e,
+      exact (h₁ x x.2).mul_left_cancel e },
+    { intro a, refine ⟨((h₁ x x.2).unit⁻¹ : _) * a, _⟩, change (x : R) • (_ * a) = _,
+      rw [algebra.smul_def, ← mul_assoc, is_unit.mul_coe_inv, one_mul] } },
+  { exact h₂ },
+  { intros, dsimp, rw [eq_comm, ← sub_eq_zero, ← map_sub, h₃], simp_rw [smul_sub, sub_eq_zero] },
+end
+
+end algebra
+
 end is_localized_module
 
 end is_localized_module
diff --git a/src/algebra/module/pointwise_pi.lean b/src/algebra/module/pointwise_pi.lean
index c4998a51756b3..3572a8a1d31a5 100644
--- a/src/algebra/module/pointwise_pi.lean
+++ b/src/algebra/module/pointwise_pi.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Alex J. Best. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Alex J. Best
 -/
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 import group_theory.group_action.pi
 
 /-!
diff --git a/src/algebra/module/submodule/pointwise.lean b/src/algebra/module/submodule/pointwise.lean
index f62ea5d75f703..b119c8f629ff1 100644
--- a/src/algebra/module/submodule/pointwise.lean
+++ b/src/algebra/module/submodule/pointwise.lean
@@ -179,6 +179,13 @@ open_locale pointwise
 lemma smul_mem_pointwise_smul (m : M) (a : α) (S : submodule R M) : m ∈ S → a • m ∈ a • S :=
 (set.smul_mem_smul_set : _ → _ ∈ a • (S : set M))
 
+/-- See also `submodule.smul_bot`. -/
+@[simp] lemma smul_bot' (a : α) : a • (⊥ : submodule R M) = ⊥ := map_bot _
+/-- See also `submodule.smul_sup`. -/
+lemma smul_sup' (a : α) (S T : submodule R M) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+lemma smul_span (a : α) (s : set M) : a • span R s = span R (a • s) := map_span _ _
+lemma span_smul (a : α) (s : set M) : span R (a • s) = a • span R s := eq.symm (span_image _).symm
+
 instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ M] [smul_comm_class αᵐᵒᵖ R M]
   [is_central_scalar α M] :
   is_central_scalar α (submodule R M) :=
diff --git a/src/algebra/module/torsion.lean b/src/algebra/module/torsion.lean
index 8143e0c3fc300..2921d1496bda2 100644
--- a/src/algebra/module/torsion.lean
+++ b/src/algebra/module/torsion.lean
@@ -501,8 +501,7 @@ lemma is_torsion_by_ideal_of_finite_of_is_torsion [module.finite R M] (hM : modu
 begin
   cases (module.finite_def.mp infer_instance : (⊤ : submodule R M).fg) with S h,
   refine ⟨∏ x in S, ideal.torsion_of R M x, _, _⟩,
-  { rw set.ne_empty_iff_nonempty,
-    refine ⟨_, _, (∏ x in S, (@hM x).some : R⁰).2⟩,
+  { refine set.nonempty.ne_empty ⟨_, _, (∏ x in S, (@hM x).some : R⁰).2⟩,
     rw [subtype.val_eq_coe, submonoid.coe_finset_prod],
     apply ideal.prod_mem_prod,
     exact λ x _, (@hM x).some_spec },
diff --git a/src/algebra/monoid_algebra/basic.lean b/src/algebra/monoid_algebra/basic.lean
index 2b974ff06455c..5eac4ef411e8b 100644
--- a/src/algebra/monoid_algebra/basic.lean
+++ b/src/algebra/monoid_algebra/basic.lean
@@ -3,6 +3,7 @@ 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, Yury G. Kudryashov, Scott Morrison
 -/
+import algebra.algebra.equiv
 import algebra.big_operators.finsupp
 import algebra.hom.non_unital_alg
 import algebra.module.big_operators
diff --git a/src/algebra/order/absolute_value.lean b/src/algebra/order/absolute_value.lean
index 6571e26ced82f..fa3cf5f55fc3b 100644
--- a/src/algebra/order/absolute_value.lean
+++ b/src/algebra/order/absolute_value.lean
@@ -63,6 +63,8 @@ instance subadditive_hom_class : subadditive_hom_class (absolute_value R S) R S
 
 @[simp] lemma coe_mk (f : R →ₙ* S) {h₁ h₂ h₃} : ((absolute_value.mk f h₁ h₂ h₃) : R → S) = f := rfl
 
+@[ext] lemma ext ⦃f g : absolute_value R S⦄ : (∀ x, f x = g x) → f = g := fun_like.ext _ _
+
 /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
 directly. -/
 instance : has_coe_to_fun (absolute_value R S) (λ f, R → S) := fun_like.has_coe_to_fun
diff --git a/src/algebra/order/field/basic.lean b/src/algebra/order/field/basic.lean
index 6a7f7390defb5..8318abff932d4 100644
--- a/src/algebra/order/field/basic.lean
+++ b/src/algebra/order/field/basic.lean
@@ -216,16 +216,16 @@ lemma lt_inv (ha : 0 < a) (hb : 0 < b) : a < b⁻¹ ↔ b < a⁻¹ :=
 lt_iff_lt_of_le_iff_le (inv_le hb ha)
 
 lemma inv_lt_one (ha : 1 < a) : a⁻¹ < 1 :=
-by rwa [inv_lt ((@zero_lt_one α _ _).trans ha) zero_lt_one, inv_one]
+by rwa [inv_lt (zero_lt_one.trans ha) zero_lt_one, inv_one]
 
 lemma one_lt_inv (h₁ : 0 < a) (h₂ : a < 1) : 1 < a⁻¹ :=
-by rwa [lt_inv (@zero_lt_one α _ _) h₁, inv_one]
+by rwa [lt_inv zero_lt_one h₁, inv_one]
 
 lemma inv_le_one (ha : 1 ≤ a) : a⁻¹ ≤ 1 :=
-by rwa [inv_le ((@zero_lt_one α _ _).trans_le ha) zero_lt_one, inv_one]
+by rwa [inv_le (zero_lt_one.trans_le ha) zero_lt_one, inv_one]
 
 lemma one_le_inv (h₁ : 0 < a) (h₂ : a ≤ 1) : 1 ≤ a⁻¹ :=
-by rwa [le_inv (@zero_lt_one α _ _) h₁, inv_one]
+by rwa [le_inv zero_lt_one h₁, inv_one]
 
 lemma inv_lt_one_iff_of_pos (h₀ : 0 < a) : a⁻¹ < 1 ↔ 1 < a :=
 ⟨λ h₁, inv_inv a ▸ one_lt_inv (inv_pos.2 h₀) h₁, inv_lt_one⟩
@@ -372,10 +372,10 @@ lemma one_div_lt_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a < 1 / b ↔ b < a :=
 div_lt_div_left zero_lt_one ha hb
 
 lemma one_lt_one_div (h1 : 0 < a) (h2 : a < 1) : 1 < 1 / a :=
-by rwa [lt_one_div (@zero_lt_one α _ _) h1, one_div_one]
+by rwa [lt_one_div zero_lt_one h1, one_div_one]
 
 lemma one_le_one_div (h1 : 0 < a) (h2 : a ≤ 1) : 1 ≤ 1 / a :=
-by rwa [le_one_div (@zero_lt_one α _ _) h1, one_div_one]
+by rwa [le_one_div zero_lt_one h1, one_div_one]
 
 /-!
 ### Results about halving.
@@ -397,7 +397,7 @@ lemma half_pos (h : 0 < a) : 0 < a / 2 := div_pos h zero_lt_two
 lemma one_half_pos : (0:α) < 1 / 2 := half_pos zero_lt_one
 
 lemma div_two_lt_of_pos (h : 0 < a) : a / 2 < a :=
-by { rw [div_lt_iff (@zero_lt_two α _ _)], exact lt_mul_of_one_lt_right h one_lt_two }
+by { rw [div_lt_iff (zero_lt_two' α)], exact lt_mul_of_one_lt_right h one_lt_two }
 
 lemma half_lt_self : 0 < a → a / 2 < a := div_two_lt_of_pos
 
@@ -723,7 +723,7 @@ by rw [sub_add_eq_sub_sub, sub_self, zero_sub]
 lemma add_sub_div_two_lt (h : a < b) : a + (b - a) / 2 < b :=
 begin
   rwa [← div_sub_div_same, sub_eq_add_neg, add_comm (b/2), ← add_assoc, ← sub_eq_add_neg,
-    ← lt_sub_iff_add_lt, sub_self_div_two, sub_self_div_two, div_lt_div_right (@zero_lt_two α _ _)]
+    ← lt_sub_iff_add_lt, sub_self_div_two, sub_self_div_two, div_lt_div_right (zero_lt_two' α)]
 end
 
 /--  An inequality involving `2`. -/
diff --git a/src/algebra/order/group/defs.lean b/src/algebra/order/group/defs.lean
index 3371c10208718..66a8b7df0b616 100644
--- a/src/algebra/order/group/defs.lean
+++ b/src/algebra/order/group/defs.lean
@@ -5,11 +5,15 @@ Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
 -/
 import order.hom.basic
 import algebra.order.sub.defs
-import algebra.order.monoid.defs
+import algebra.order.monoid.cancel.defs
 
 /-!
 # Ordered groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/869
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file develops the basics of ordered groups.
 
 ## Implementation details
@@ -43,9 +47,27 @@ instance ordered_comm_group.to_covariant_class_left_le (α : Type u) [ordered_co
   covariant_class α α (*) (≤) :=
 { elim := λ a b c bc, ordered_comm_group.mul_le_mul_left b c bc a }
 
+@[priority 100, to_additive] -- See note [lower instance priority]
+instance ordered_comm_group.to_ordered_cancel_comm_monoid [ordered_comm_group α] :
+  ordered_cancel_comm_monoid α :=
+{ le_of_mul_le_mul_left := λ a b c, le_of_mul_le_mul_left',
+  ..‹ordered_comm_group α› }
+
 example (α : Type u) [ordered_add_comm_group α] : covariant_class α α (swap (+)) (<) :=
 add_right_cancel_semigroup.covariant_swap_add_lt_of_covariant_swap_add_le α
 
+/-- A choice-free shortcut instance. -/
+@[to_additive "A choice-free shortcut instance."]
+instance ordered_comm_group.to_contravariant_class_left_le (α : Type u) [ordered_comm_group α] :
+  contravariant_class α α (*) (≤) :=
+{ elim := λ a b c bc, by simpa using mul_le_mul_left' bc a⁻¹, }
+
+/-- A choice-free shortcut instance. -/
+@[to_additive "A choice-free shortcut instance."]
+instance ordered_comm_group.to_contravariant_class_right_le (α : Type u) [ordered_comm_group α] :
+  contravariant_class α α (swap (*)) (≤) :=
+{ elim := λ a b c bc, by simpa using mul_le_mul_right' bc a⁻¹, }
+
 section group
 variables [group α]
 
@@ -791,6 +813,11 @@ instance linear_ordered_comm_group.to_no_min_order [nontrivial α] : no_min_orde
     exact λ a, ⟨a / y, (div_lt_self_iff a).mpr hy⟩
   end ⟩
 
+@[priority 100, to_additive] -- See note [lower instance priority]
+instance linear_ordered_comm_group.to_linear_ordered_cancel_comm_monoid :
+  linear_ordered_cancel_comm_monoid α :=
+{ ..‹linear_ordered_comm_group α›, ..ordered_comm_group.to_ordered_cancel_comm_monoid }
+
 end linear_ordered_comm_group
 
 namespace add_comm_group
diff --git a/src/algebra/order/group/instances.lean b/src/algebra/order/group/instances.lean
index eef52eac6ed15..c352f5cb860ff 100644
--- a/src/algebra/order/group/instances.lean
+++ b/src/algebra/order/group/instances.lean
@@ -9,25 +9,17 @@ import algebra.order.monoid.order_dual
 /-!
 # Additional instances for ordered commutative groups.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/890
+> Any changes to this file require a corresponding PR to mathlib4.
+
 -/
 
 variables {α : Type*}
 
-@[priority 100, to_additive]    -- see Note [lower instance priority]
-instance ordered_comm_group.to_ordered_cancel_comm_monoid [s : ordered_comm_group α] :
-  ordered_cancel_comm_monoid α :=
-{ le_of_mul_le_mul_left := λ a b c, (mul_le_mul_iff_left a).mp,
-  ..s }
-
 @[to_additive] instance [ordered_comm_group α] : ordered_comm_group αᵒᵈ :=
 { .. order_dual.ordered_comm_monoid, .. order_dual.group }
 
 @[to_additive] instance [linear_ordered_comm_group α] :
   linear_ordered_comm_group αᵒᵈ :=
 { .. order_dual.ordered_comm_group, .. order_dual.linear_order α }
-
-@[priority 100, to_additive] -- see Note [lower instance priority]
-instance linear_ordered_comm_group.to_linear_ordered_cancel_comm_monoid
-  [linear_ordered_comm_group α] : linear_ordered_cancel_comm_monoid α :=
-{ le_of_mul_le_mul_left := λ x y z, le_of_mul_le_mul_left',
-  ..‹linear_ordered_comm_group α› }
diff --git a/src/algebra/order/group/order_iso.lean b/src/algebra/order/group/order_iso.lean
index b62e0e9792051..2b068637fe8e3 100644
--- a/src/algebra/order/group/order_iso.lean
+++ b/src/algebra/order/group/order_iso.lean
@@ -9,6 +9,10 @@ import algebra.hom.equiv.units.basic
 /-!
 # Inverse and multiplication as order isomorphisms in ordered groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/895
+> Any changes to this file require a corresponding PR to mathlib4.
+
 -/
 
 set_option old_structure_cmd true
diff --git a/src/algebra/order/group/units.lean b/src/algebra/order/group/units.lean
index db8aec98bda15..cefbbf4427f22 100644
--- a/src/algebra/order/group/units.lean
+++ b/src/algebra/order/group/units.lean
@@ -9,6 +9,10 @@ import algebra.order.monoid.units
 
 /-!
 # Adjoining a top element to a `linear_ordered_add_comm_group_with_top`.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/898
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 variable {α : Type*}
diff --git a/src/algebra/order/interval.lean b/src/algebra/order/interval.lean
index efc73854dbf88..aa63d9e1d7b84 100644
--- a/src/algebra/order/interval.lean
+++ b/src/algebra/order/interval.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
 import algebra.big_operators.order
+import algebra.group.prod
 import data.option.n_ary
 import data.set.pointwise.basic
 import order.interval
diff --git a/src/algebra/order/monoid/basic.lean b/src/algebra/order/monoid/basic.lean
index 50bd75e3cf753..05fa36ffe746c 100644
--- a/src/algebra/order/monoid/basic.lean
+++ b/src/algebra/order/monoid/basic.lean
@@ -10,6 +10,10 @@ import order.hom.basic
 /-!
 # Ordered monoids
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/872
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file develops some additional material on ordered monoids.
 -/
 
diff --git a/src/algebra/order/monoid/cancel/basic.lean b/src/algebra/order/monoid/cancel/basic.lean
index e0c897c779871..f3d8090e97b84 100644
--- a/src/algebra/order/monoid/cancel/basic.lean
+++ b/src/algebra/order/monoid/cancel/basic.lean
@@ -9,6 +9,10 @@ import algebra.order.monoid.cancel.defs
 /-!
 # Basic results on ordered cancellative monoids.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/883
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We pull back ordered cancellative monoids along injective maps.
 -/
 
diff --git a/src/algebra/order/monoid/nat_cast.lean b/src/algebra/order/monoid/nat_cast.lean
new file mode 100644
index 0000000000000..66f8238dec857
--- /dev/null
+++ b/src/algebra/order/monoid/nat_cast.lean
@@ -0,0 +1,88 @@
+/-
+Copyright (c) 2016 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl, Yuyang Zhao
+-/
+import algebra.order.monoid.lemmas
+import algebra.order.zero_le_one
+import data.nat.cast.defs
+
+/-!
+# Order of numerials in an `add_monoid_with_one`.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/893
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+variable {α : Type*}
+
+open function
+
+lemma lt_add_one [has_one α] [add_zero_class α] [partial_order α] [zero_le_one_class α]
+  [ne_zero (1 : α)] [covariant_class α α (+) (<)] (a : α) : a < a + 1 :=
+lt_add_of_pos_right _ zero_lt_one
+
+lemma lt_one_add [has_one α] [add_zero_class α] [partial_order α] [zero_le_one_class α]
+  [ne_zero (1 : α)] [covariant_class α α (swap (+)) (<)] (a : α) : a < 1 + a :=
+lt_add_of_pos_left _ zero_lt_one
+
+variable [add_monoid_with_one α]
+
+lemma zero_le_two [preorder α] [zero_le_one_class α] [covariant_class α α (+) (≤)] :
+  (0 : α) ≤ 2 :=
+add_nonneg zero_le_one zero_le_one
+
+lemma zero_le_three [preorder α] [zero_le_one_class α] [covariant_class α α (+) (≤)] :
+  (0 : α) ≤ 3 :=
+add_nonneg zero_le_two zero_le_one
+
+lemma zero_le_four [preorder α] [zero_le_one_class α] [covariant_class α α (+) (≤)] :
+  (0 : α) ≤ 4 :=
+add_nonneg zero_le_two zero_le_two
+
+lemma one_le_two [has_le α] [zero_le_one_class α] [covariant_class α α (+) (≤)] :
+  (1 : α) ≤ 2 :=
+calc 1 = 1 + 0 : (add_zero 1).symm
+   ... ≤ 1 + 1 : add_le_add_left zero_le_one _
+
+lemma one_le_two' [has_le α] [zero_le_one_class α] [covariant_class α α (swap (+)) (≤)] :
+  (1 : α) ≤ 2 :=
+calc 1 = 0 + 1 : (zero_add 1).symm
+   ... ≤ 1 + 1 : add_le_add_right zero_le_one _
+
+section
+variables [partial_order α] [zero_le_one_class α] [ne_zero (1 : α)]
+
+section
+variables [covariant_class α α (+) (≤)]
+
+/-- See `zero_lt_two'` for a version with the type explicit. -/
+@[simp] lemma zero_lt_two : (0 : α) < 2 := zero_lt_one.trans_le one_le_two
+/-- See `zero_lt_three'` for a version with the type explicit. -/
+@[simp] lemma zero_lt_three : (0 : α) < 3 := lt_add_of_lt_of_nonneg zero_lt_two zero_le_one
+/-- See `zero_lt_four'` for a version with the type explicit. -/
+@[simp] lemma zero_lt_four : (0 : α) < 4 := lt_add_of_lt_of_nonneg zero_lt_two zero_le_two
+
+variables (α)
+
+/-- See `zero_lt_two` for a version with the type implicit. -/
+lemma zero_lt_two' : (0 : α) < 2 := zero_lt_two
+/-- See `zero_lt_three` for a version with the type implicit. -/
+lemma zero_lt_three' : (0 : α) < 3 := zero_lt_three
+/-- See `zero_lt_four` for a version with the type implicit. -/
+lemma zero_lt_four' : (0 : α) < 4 := zero_lt_four
+
+instance zero_le_one_class.ne_zero.two : ne_zero (2 : α) := ⟨zero_lt_two.ne'⟩
+instance zero_le_one_class.ne_zero.three : ne_zero (3 : α) := ⟨zero_lt_three.ne'⟩
+instance zero_le_one_class.ne_zero.four : ne_zero (4 : α) := ⟨zero_lt_four.ne'⟩
+
+end
+
+lemma one_lt_two [covariant_class α α (+) (<)] : (1 : α) < 2 := lt_add_one _
+
+end
+
+alias zero_lt_two ← two_pos
+alias zero_lt_three ← three_pos
+alias zero_lt_four ← four_pos
diff --git a/src/algebra/order/monoid/type_tags.lean b/src/algebra/order/monoid/type_tags.lean
index f0544665e062f..144f216326f77 100644
--- a/src/algebra/order/monoid/type_tags.lean
+++ b/src/algebra/order/monoid/type_tags.lean
@@ -7,7 +7,11 @@ import algebra.group.type_tags
 import algebra.order.monoid.cancel.defs
 import algebra.order.monoid.canonical.defs
 
-/-! # Ordered monoid structures on `multiplicative α` and `additive α`. -/
+/-! # Ordered monoid structures on `multiplicative α` and `additive α`. 
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/873
+> Any changes to this file require a corresponding PR to mathlib4.-/
 
 universes u
 variables {α : Type u}
diff --git a/src/algebra/order/monoid/units.lean b/src/algebra/order/monoid/units.lean
index 07a43cda6279b..2f834c3d51c55 100644
--- a/src/algebra/order/monoid/units.lean
+++ b/src/algebra/order/monoid/units.lean
@@ -9,6 +9,10 @@ import algebra.group.units
 
 /-!
 # Units in ordered monoids
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/873
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 variables {α : Type*}
diff --git a/src/algebra/order/monoid/with_zero/basic.lean b/src/algebra/order/monoid/with_zero/basic.lean
index 35dc431688163..09f752abf89a3 100644
--- a/src/algebra/order/monoid/with_zero/basic.lean
+++ b/src/algebra/order/monoid/with_zero/basic.lean
@@ -9,6 +9,10 @@ import algebra.group_with_zero.basic
 /-!
 # An instance orphaned from `algebra.order.monoid.with_zero.defs`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/851
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We put this here to minimise imports: if you can move it back into
 `algebra.order.monoid.with_zero.defs` without increasing imports, please do.
 -/
diff --git a/src/algebra/order/monoid/with_zero/defs.lean b/src/algebra/order/monoid/with_zero/defs.lean
index 4a28fc9c287cf..5abe890007ec8 100644
--- a/src/algebra/order/monoid/with_zero/defs.lean
+++ b/src/algebra/order/monoid/with_zero/defs.lean
@@ -5,22 +5,21 @@ Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
 -/
 import algebra.group.with_one.defs
 import algebra.order.monoid.canonical.defs
+import algebra.order.zero_le_one
 
 /-!
 # Adjoining a zero element to an ordered monoid.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/851
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 set_option old_structure_cmd true
 
-open function
-
 universe u
 variables {α : Type u}
 
-/-- Typeclass for expressing that the `0` of a type is less or equal to its `1`. -/
-class zero_le_one_class (α : Type*) [has_zero α] [has_one α] [has_le α] :=
-(zero_le_one : (0 : α) ≤ 1)
-
 /-- A linearly ordered commutative monoid with a zero element. -/
 class linear_ordered_comm_monoid_with_zero (α : Type*)
   extends linear_ordered_comm_monoid α, comm_monoid_with_zero α :=
@@ -36,36 +35,6 @@ instance canonically_ordered_add_monoid.to_zero_le_one_class [canonically_ordere
   [has_one α] : zero_le_one_class α :=
 ⟨zero_le 1⟩
 
-/-- `zero_le_one` with the type argument implicit. -/
-@[simp] lemma zero_le_one [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] : (0 : α) ≤ 1 :=
-zero_le_one_class.zero_le_one
-
-/-- `zero_le_one` with the type argument explicit. -/
-lemma zero_le_one' (α) [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] : (0 : α) ≤ 1 :=
-zero_le_one
-
-lemma zero_le_two [preorder α] [has_one α] [add_zero_class α] [zero_le_one_class α]
-  [covariant_class α α (+) (≤)] : (0 : α) ≤ 2 :=
-add_nonneg zero_le_one zero_le_one
-
-lemma zero_le_three [preorder α] [has_one α] [add_zero_class α] [zero_le_one_class α]
-  [covariant_class α α (+) (≤)] : (0 : α) ≤ 3 :=
-add_nonneg zero_le_two zero_le_one
-
-lemma zero_le_four [preorder α] [has_one α] [add_zero_class α] [zero_le_one_class α]
-  [covariant_class α α (+) (≤)] : (0 : α) ≤ 4 :=
-add_nonneg zero_le_two zero_le_two
-
-lemma one_le_two [has_le α] [has_one α] [add_zero_class α] [zero_le_one_class α]
-  [covariant_class α α (+) (≤)] : (1 : α) ≤ 2 :=
-calc 1 = 1 + 0 : (add_zero 1).symm
-   ... ≤ 1 + 1 : add_le_add_left zero_le_one _
-
-lemma one_le_two' [has_le α] [has_one α] [add_zero_class α] [zero_le_one_class α]
-  [covariant_class α α (swap (+)) (≤)] : (1 : α) ≤ 2 :=
-calc 1 = 0 + 1 : (zero_add 1).symm
-   ... ≤ 1 + 1 : add_le_add_right zero_le_one _
-
 namespace with_zero
 
 local attribute [semireducible] with_zero
diff --git a/src/algebra/order/pointwise.lean b/src/algebra/order/pointwise.lean
index f45493aee21cc..c40bd3a229907 100644
--- a/src/algebra/order/pointwise.lean
+++ b/src/algebra/order/pointwise.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Alex J. Best, Yaël Dillies
 -/
 import algebra.bounds
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 
 /-!
 # Pointwise operations on ordered algebraic objects
diff --git a/src/algebra/order/ring/defs.lean b/src/algebra/order/ring/defs.lean
index 7ad75d6d5c29a..612305ddff8a8 100644
--- a/src/algebra/order/ring/defs.lean
+++ b/src/algebra/order/ring/defs.lean
@@ -7,6 +7,7 @@ Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Yaël Dillies
 import algebra.order.group.defs
 import algebra.order.monoid.cancel.defs
 import algebra.order.monoid.canonical.defs
+import algebra.order.monoid.nat_cast
 import algebra.order.monoid.with_zero.defs
 import algebra.order.ring.lemmas
 import algebra.ring.defs
@@ -255,44 +256,9 @@ lemma monotone.mul (hf : monotone f) (hg : monotone g) (hf₀ : ∀ x, 0 ≤ f x
 
 end monotone
 
-section nontrivial
-variables [nontrivial α]
-
-/-- See `zero_lt_one'` for a version with the type explicit. -/
-@[simp] lemma zero_lt_one : (0 : α) < 1 := zero_le_one.lt_of_ne zero_ne_one
-/-- See `zero_lt_two'` for a version with the type explicit. -/
-@[simp] lemma zero_lt_two : (0 : α) < 2 := zero_lt_one.trans_le one_le_two
-/-- See `zero_lt_three'` for a version with the type explicit. -/
-@[simp] lemma zero_lt_three : (0 : α) < 3 :=
-zero_lt_one.trans_le $ bit1_zero.symm.trans_le $ bit1_mono zero_le_one
-/-- See `zero_lt_four'` for a version with the type explicit. -/
-@[simp] lemma zero_lt_four : (0 : α) < 4 := zero_lt_two.trans_le $ bit0_mono one_le_two
-
-instance zero_le_one_class.ne_zero.two : ne_zero (2 : α) := ⟨zero_lt_two.ne'⟩
-instance zero_le_one_class.ne_zero.three : ne_zero (3 : α) := ⟨zero_lt_three.ne'⟩
-instance zero_le_one_class.ne_zero.four : ne_zero (4 : α) := ⟨zero_lt_four.ne'⟩
-
-alias zero_lt_one ← one_pos
-alias zero_lt_two ← two_pos
-alias zero_lt_three ← three_pos
-alias zero_lt_four ← four_pos
-
-lemma bit1_pos (h : 0 ≤ a) : 0 < bit1 a :=
+lemma bit1_pos [nontrivial α] (h : 0 ≤ a) : 0 < bit1 a :=
 zero_lt_one.trans_le $ bit1_zero.symm.trans_le $ bit1_mono h
 
-variables (α)
-
-/-- See `zero_lt_one` for a version with the type implicit. -/
-lemma zero_lt_one' : (0 : α) < 1 := zero_lt_one
-/-- See `zero_lt_two` for a version with the type implicit. -/
-lemma zero_lt_two' : (0 : α) < 2 := zero_lt_two
-/-- See `zero_lt_three` for a version with the type implicit. -/
-lemma zero_lt_three' : (0 : α) < 3 := zero_lt_three
-/-- See `zero_lt_four` for a version with the type implicit. -/
-lemma zero_lt_four' : (0 : α) < 4 := zero_lt_four
-
-end nontrivial
-
 lemma bit1_pos' (h : 0 < a) : 0 < bit1 a := by { nontriviality, exact bit1_pos h.le }
 
 lemma mul_le_one (ha : a ≤ 1) (hb' : 0 ≤ b) (hb : b ≤ 1) : a * b ≤ 1 :=
@@ -533,11 +499,6 @@ lemma strict_mono.mul (hf : strict_mono f) (hg : strict_mono g) (hf₀ : ∀ x,
 
 end monotone
 
-lemma lt_one_add (a : α) : a < 1 + a := lt_add_of_pos_left _ zero_lt_one
-lemma lt_add_one (a : α) : a < a + 1 := lt_add_of_pos_right _ zero_lt_one
-
-lemma one_lt_two : (1 : α) < 2 := lt_add_one _
-
 lemma lt_two_mul_self (ha : 0 < a) : a < 2 * a := lt_mul_of_one_lt_left ha one_lt_two
 
 @[priority 100] -- see Note [lower instance priority]
@@ -824,7 +785,7 @@ instance linear_ordered_ring.to_linear_ordered_add_comm_group : linear_ordered_a
 { ..‹linear_ordered_ring α› }
 
 @[priority 100] -- see Note [lower instance priority]
-instance linear_ordered_ring.is_domain : is_domain α :=
+instance linear_ordered_ring.no_zero_divisors : no_zero_divisors α :=
 { eq_zero_or_eq_zero_of_mul_eq_zero :=
     begin
       intros a b hab,
@@ -835,6 +796,21 @@ instance linear_ordered_ring.is_domain : is_domain α :=
     end,
   .. ‹linear_ordered_ring α› }
 
+@[priority 100] -- see Note [lower instance priority]
+--We don't want to import `algebra.ring.basic`, so we cannot use `no_zero_divisors.to_is_domain`.
+instance linear_ordered_ring.is_domain : is_domain α :=
+{ mul_left_cancel_of_ne_zero := λ a b c ha h,
+  begin
+    rw [← sub_eq_zero, ← mul_sub] at h,
+    exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left ha)
+  end,
+  mul_right_cancel_of_ne_zero := λ a b c hb h,
+  begin
+    rw [← sub_eq_zero, ← sub_mul] at h,
+    exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hb)
+  end,
+  .. (infer_instance : nontrivial α) }
+
 lemma mul_pos_iff : 0 < a * b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 :=
 ⟨pos_and_pos_or_neg_and_neg_of_mul_pos,
   λ h, h.elim (and_imp.2 mul_pos) (and_imp.2 mul_pos_of_neg_of_neg)⟩
@@ -859,10 +835,10 @@ lemma mul_self_nonneg (a : α) : 0 ≤ a * a :=
 (le_total 0 a).elim (λ h, mul_nonneg h h) (λ h, mul_nonneg_of_nonpos_of_nonpos h h)
 
 @[simp] lemma neg_le_self_iff : -a ≤ a ↔ 0 ≤ a :=
-by simp [neg_le_iff_add_nonneg, ← two_mul, mul_nonneg_iff, zero_le_one, (@zero_lt_two α _ _).not_le]
+by simp [neg_le_iff_add_nonneg, ← two_mul, mul_nonneg_iff, zero_le_one, (zero_lt_two' α).not_le]
 
 @[simp] lemma neg_lt_self_iff : -a < a ↔ 0 < a :=
-by simp [neg_lt_iff_pos_add, ← two_mul, mul_pos_iff, zero_lt_one, (@zero_lt_two α _ _).not_lt]
+by simp [neg_lt_iff_pos_add, ← two_mul, mul_pos_iff, zero_lt_one, (zero_lt_two' α).not_lt]
 
 @[simp] lemma le_neg_self_iff : a ≤ -a ↔ a ≤ 0 :=
 calc a ≤ -a ↔ -(-a) ≤ -a : by rw neg_neg
diff --git a/src/algebra/order/smul.lean b/src/algebra/order/smul.lean
index 786e387c07c33..9082ac44abeca 100644
--- a/src/algebra/order/smul.lean
+++ b/src/algebra/order/smul.lean
@@ -7,7 +7,7 @@ import algebra.module.pi
 import algebra.module.prod
 import algebra.order.monoid.prod
 import algebra.order.pi
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 import tactic.positivity
 
 /-!
diff --git a/src/algebra/order/upper_lower.lean b/src/algebra/order/upper_lower.lean
index e6845bdde35db..9cb3be7ba60e7 100644
--- a/src/algebra/order/upper_lower.lean
+++ b/src/algebra/order/upper_lower.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
 import algebra.order.group.defs
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 import order.upper_lower
 
 /-!
diff --git a/src/algebra/order/with_zero.lean b/src/algebra/order/with_zero.lean
index 785b0f93ba677..8d5df167e102d 100644
--- a/src/algebra/order/with_zero.lean
+++ b/src/algebra/order/with_zero.lean
@@ -115,9 +115,6 @@ end linear_ordered_comm_monoid
 
 variables [linear_ordered_comm_group_with_zero α]
 
-lemma zero_lt_one₀ : (0 : α) < 1 :=
-lt_of_le_of_ne zero_le_one zero_ne_one
-
 -- TODO: Do we really need the following two?
 
 /-- Alias of `mul_le_one'` for unification. -/
diff --git a/src/algebra/order/zero_le_one.lean b/src/algebra/order/zero_le_one.lean
new file mode 100644
index 0000000000000..454b2fc25830c
--- /dev/null
+++ b/src/algebra/order/zero_le_one.lean
@@ -0,0 +1,46 @@
+/-
+Copyright (c) 2016 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
+-/
+import order.basic
+import algebra.ne_zero
+
+/-!
+# Typeclass expressing `0 ≤ 1`.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/893
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+variables {α : Type*}
+
+open function
+
+/-- Typeclass for expressing that the `0` of a type is less or equal to its `1`. -/
+class zero_le_one_class (α : Type*) [has_zero α] [has_one α] [has_le α] :=
+(zero_le_one : (0 : α) ≤ 1)
+
+/-- `zero_le_one` with the type argument implicit. -/
+@[simp] lemma zero_le_one [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] : (0 : α) ≤ 1 :=
+zero_le_one_class.zero_le_one
+
+/-- `zero_le_one` with the type argument explicit. -/
+lemma zero_le_one' (α) [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] : (0 : α) ≤ 1 :=
+zero_le_one
+
+section
+variables [has_zero α] [has_one α] [partial_order α] [zero_le_one_class α] [ne_zero (1 : α)]
+
+/-- See `zero_lt_one'` for a version with the type explicit. -/
+@[simp] lemma zero_lt_one : (0 : α) < 1 := zero_le_one.lt_of_ne (ne_zero.ne' 1)
+
+variables (α)
+
+/-- See `zero_lt_one` for a version with the type implicit. -/
+lemma zero_lt_one' : (0 : α) < 1 := zero_lt_one
+
+end
+
+alias zero_lt_one ← one_pos
diff --git a/src/algebra/punit_instances.lean b/src/algebra/punit_instances.lean
index ebebbba052893..a5b75fee4bb52 100644
--- a/src/algebra/punit_instances.lean
+++ b/src/algebra/punit_instances.lean
@@ -8,6 +8,7 @@ import algebra.module.basic
 import algebra.gcd_monoid.basic
 import algebra.group_ring_action.basic
 import group_theory.group_action.defs
+import order.complete_boolean_algebra
 
 /-!
 # Instances on punit
diff --git a/src/algebra/quandle.lean b/src/algebra/quandle.lean
index 50c82ac3cf1fd..481d9047c8649 100644
--- a/src/algebra/quandle.lean
+++ b/src/algebra/quandle.lean
@@ -162,8 +162,7 @@ This is used in the natural rack homomorphism `to_conj` from `R` to
 lemma ad_conj {R : Type*} [rack R] (x y : R) :
   act (x ◃ y) = act x * act y * (act x)⁻¹ :=
 begin
-  apply @mul_right_cancel _ _ _ (act x), ext z,
-  simp only [inv_mul_cancel_right],
+  rw [eq_mul_inv_iff_mul_eq], ext z,
   apply self_distrib.symm,
 end
 
diff --git a/src/algebra/quaternion.lean b/src/algebra/quaternion.lean
index 62f97a483b852..b9b6694cb7567 100644
--- a/src/algebra/quaternion.lean
+++ b/src/algebra/quaternion.lean
@@ -3,7 +3,7 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
-import algebra.algebra.basic
+import algebra.algebra.equiv
 import set_theory.cardinal.ordinal
 import tactic.ring_exp
 
@@ -572,12 +572,15 @@ by simpa only [le_antisymm_iff, norm_sq_nonneg, and_true] using @norm_sq_eq_zero
 instance : nontrivial ℍ[R] :=
 { exists_pair_ne := ⟨0, 1, mt (congr_arg re) zero_ne_one⟩, }
 
-instance : is_domain ℍ[R] :=
+instance : no_zero_divisors ℍ[R] :=
 { eq_zero_or_eq_zero_of_mul_eq_zero := λ a b hab,
     have norm_sq a * norm_sq b = 0, by rwa [← norm_sq.map_mul, norm_sq_eq_zero],
     (eq_zero_or_eq_zero_of_mul_eq_zero this).imp norm_sq_eq_zero.1 norm_sq_eq_zero.1,
   ..quaternion.nontrivial, }
 
+instance : is_domain ℍ[R] :=
+no_zero_divisors.to_is_domain _
+
 end linear_ordered_comm_ring
 
 section field
diff --git a/src/algebra/ring/add_aut.lean b/src/algebra/ring/add_aut.lean
new file mode 100644
index 0000000000000..f92c57847c04a
--- /dev/null
+++ b/src/algebra/ring/add_aut.lean
@@ -0,0 +1,34 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import group_theory.group_action.group
+import algebra.module.basic
+
+/-!
+# Multiplication on the left/right as additive automorphisms
+
+In this file we define `add_aut.mul_left` and `add_aut.mul_right`.
+
+See also `add_monoid_hom.mul_left`, `add_monoid_hom.mul_right`, `add_monoid.End.mul_left`, and
+`add_monoid.End.mul_right` for multiplication by `R` as an endomorphism instead of multiplication by
+`Rˣ` as an automorphism.
+-/
+
+namespace add_aut
+variables {R : Type*} [semiring R]
+
+/-- Left multiplication by a unit of a semiring as an additive automorphism. -/
+@[simps { simp_rhs := tt }]
+def mul_left : Rˣ →* add_aut R := distrib_mul_action.to_add_aut _ _
+
+/-- Right multiplication by a unit of a semiring as an additive automorphism. -/
+def mul_right (u : Rˣ) : add_aut R :=
+distrib_mul_action.to_add_aut Rᵐᵒᵖˣ R (units.op_equiv.symm $ mul_opposite.op u)
+
+@[simp] lemma mul_right_apply (u : Rˣ) (x : R) : mul_right u x = x * u := rfl
+@[simp] lemma mul_right_symm_apply (u : Rˣ) (x : R) : (mul_right u).symm x = x * ↑u⁻¹ := rfl
+
+end add_aut
+
diff --git a/src/algebra/ring/basic.lean b/src/algebra/ring/basic.lean
index 70ca08a5be13a..d0514bfd38581 100644
--- a/src/algebra/ring/basic.lean
+++ b/src/algebra/ring/basic.lean
@@ -10,6 +10,10 @@ import algebra.opposites
 /-!
 # Semirings and rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/830
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file gives lemmas about semirings, rings and domains.
 This is analogous to `algebra.group.basic`,
 the difference being that the former is about `+` and `*` separately, while
@@ -118,3 +122,55 @@ lemma succ_ne_self [non_assoc_ring α] [nontrivial α] (a : α) : a + 1 ≠ a :=
 
 lemma pred_ne_self [non_assoc_ring α] [nontrivial α] (a : α) : a - 1 ≠ a :=
 λ h, one_ne_zero (neg_injective ((add_right_inj a).mp (by simpa [sub_eq_add_neg] using h)))
+
+section no_zero_divisors
+
+variable (α)
+
+lemma is_left_cancel_mul_zero.to_no_zero_divisors [ring α] [is_left_cancel_mul_zero α] :
+  no_zero_divisors α :=
+begin
+  refine ⟨λ x y h, _⟩,
+  by_cases hx : x = 0,
+  { left, exact hx },
+  { right,
+    rw [← sub_zero (x * y), ← mul_zero x, ← mul_sub] at h,
+    convert (is_left_cancel_mul_zero.mul_left_cancel_of_ne_zero) hx h,
+    rw [sub_zero] }
+end
+
+lemma is_right_cancel_mul_zero.to_no_zero_divisors [ring α] [is_right_cancel_mul_zero α] :
+  no_zero_divisors α :=
+begin
+  refine ⟨λ x y h, _⟩,
+  by_cases hy : y = 0,
+  { right, exact hy },
+  { left,
+    rw [← sub_zero (x * y), ← zero_mul y, ← sub_mul] at h,
+    convert (is_right_cancel_mul_zero.mul_right_cancel_of_ne_zero) hy h,
+    rw [sub_zero] }
+end
+
+@[priority 100]
+instance no_zero_divisors.to_is_cancel_mul_zero [ring α] [no_zero_divisors α] :
+  is_cancel_mul_zero α :=
+{ mul_left_cancel_of_ne_zero := λ a b c ha h,
+  begin
+    rw [← sub_eq_zero, ← mul_sub] at h,
+    exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left ha)
+  end,
+  mul_right_cancel_of_ne_zero := λ a b c hb h,
+  begin
+    rw [← sub_eq_zero, ← sub_mul] at h,
+    exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hb)
+  end }
+
+lemma no_zero_divisors.to_is_domain [ring α] [h : nontrivial α] [no_zero_divisors α] :
+  is_domain α :=
+{ .. no_zero_divisors.to_is_cancel_mul_zero α, .. h }
+
+@[priority 100]
+instance is_domain.to_no_zero_divisors [ring α] [is_domain α] : no_zero_divisors α :=
+is_right_cancel_mul_zero.to_no_zero_divisors α
+
+end no_zero_divisors
diff --git a/src/algebra/ring/defs.lean b/src/algebra/ring/defs.lean
index 7f28e7eb12f26..2d75aeec601a2 100644
--- a/src/algebra/ring/defs.lean
+++ b/src/algebra/ring/defs.lean
@@ -413,10 +413,12 @@ instance comm_ring.to_comm_semiring [s : comm_ring α] : comm_semiring α :=
 instance comm_ring.to_non_unital_comm_ring [s : comm_ring α] : non_unital_comm_ring α :=
 { mul_zero := mul_zero, zero_mul := zero_mul, ..s }
 
-/-- A domain is a nontrivial ring with no zero divisors, i.e. satisfying
-  the condition `a * b = 0 ↔ a = 0 ∨ b = 0`.
+/-- A domain is a nontrivial semiring such multiplication by a non zero element is cancellative,
+  on both sides. In other words, a nontrivial semiring `R` satisfying
+  `∀ {a b c : R}, a ≠ 0 → a * b = a * c → b = c` and
+  `∀ {a b c : R}, b ≠ 0 → a * b = c * b → a = c`.
 
-  This is implemented as a mixin for `ring α`.
+  This is implemented as a mixin for `semiring α`.
   To obtain an integral domain use `[comm_ring α] [is_domain α]`. -/
-@[protect_proj, ancestor no_zero_divisors nontrivial]
-class is_domain (α : Type u) [ring α] extends no_zero_divisors α, nontrivial α : Prop
+@[protect_proj, ancestor is_cancel_mul_zero nontrivial]
+class is_domain (α : Type u) [semiring α] extends is_cancel_mul_zero α, nontrivial α : Prop
diff --git a/src/algebra/ring/divisibility.lean b/src/algebra/ring/divisibility.lean
index c85a65b518d8a..f8c2857808642 100644
--- a/src/algebra/ring/divisibility.lean
+++ b/src/algebra/ring/divisibility.lean
@@ -8,6 +8,10 @@ import algebra.ring.defs
 
 /-!
 # Lemmas about divisibility in rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/864
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 variables {α β : Type*}
diff --git a/src/algebra/ring/equiv.lean b/src/algebra/ring/equiv.lean
index 2e33e967e2b2f..f5686ae575014 100644
--- a/src/algebra/ring/equiv.lean
+++ b/src/algebra/ring/equiv.lean
@@ -601,14 +601,24 @@ variables [has_add R] [has_add S] [has_mul R] [has_mul S]
 @[simp] theorem self_trans_symm (e : R ≃+* S) : e.trans e.symm = ring_equiv.refl R := ext e.3
 @[simp] theorem symm_trans_self (e : R ≃+* S) : e.symm.trans e = ring_equiv.refl S := ext e.4
 
+/-- If two rings are isomorphic, and the second doesn't have zero divisors,
+then so does the first. -/
+protected lemma no_zero_divisors
+  {A : Type*} (B : Type*) [ring A] [ring B] [no_zero_divisors B]
+  (e : A ≃+* B) : no_zero_divisors A :=
+{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y hxy,
+    have e x * e y = 0, by rw [← e.map_mul, hxy, e.map_zero],
+    by simpa using eq_zero_or_eq_zero_of_mul_eq_zero this }
+
 /-- If two rings are isomorphic, and the second is a domain, then so is the first. -/
 protected lemma is_domain
   {A : Type*} (B : Type*) [ring A] [ring B] [is_domain B]
   (e : A ≃+* B) : is_domain A :=
-{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y hxy,
-    have e x * e y = 0, by rw [← e.map_mul, hxy, e.map_zero],
-    by simpa using eq_zero_or_eq_zero_of_mul_eq_zero this,
-  exists_pair_ne := ⟨e.symm 0, e.symm 1, e.symm.injective.ne zero_ne_one⟩ }
+begin
+  haveI : nontrivial A := ⟨⟨e.symm 0, e.symm 1, e.symm.injective.ne zero_ne_one⟩⟩,
+  haveI := e.no_zero_divisors B,
+  exact no_zero_divisors.to_is_domain _
+end
 
 end ring_equiv
 
diff --git a/src/algebra/ring/opposite.lean b/src/algebra/ring/opposite.lean
index cdd63d02a77c8..55be00f3ffae3 100644
--- a/src/algebra/ring/opposite.lean
+++ b/src/algebra/ring/opposite.lean
@@ -81,7 +81,7 @@ instance [has_zero α] [has_mul α] [no_zero_divisors α] : no_zero_divisors α
       (λ hy, or.inr $ unop_injective $ hy) (λ hx, or.inl $ unop_injective $ hx), }
 
 instance [ring α] [is_domain α] : is_domain αᵐᵒᵖ :=
-{ .. mul_opposite.no_zero_divisors α, .. mul_opposite.ring α, .. mul_opposite.nontrivial α }
+no_zero_divisors.to_is_domain _
 
 instance [group_with_zero α] : group_with_zero αᵐᵒᵖ :=
 { mul_inv_cancel := λ x hx, unop_injective $ inv_mul_cancel $ unop_injective.ne hx,
@@ -157,7 +157,7 @@ instance [has_zero α] [has_mul α] [no_zero_divisors α] : no_zero_divisors α
   ((@eq_zero_or_eq_zero_of_mul_eq_zero α _ _ _ _ _) $ op_injective H) }
 
 instance [ring α] [is_domain α] : is_domain αᵃᵒᵖ :=
-{ .. add_opposite.no_zero_divisors α, .. add_opposite.ring α, .. add_opposite.nontrivial α }
+no_zero_divisors.to_is_domain _
 
 instance [group_with_zero α] : group_with_zero αᵃᵒᵖ :=
 { mul_inv_cancel := λ x hx, unop_injective $ mul_inv_cancel $ unop_injective.ne hx,
diff --git a/src/algebra/ring/prod.lean b/src/algebra/ring/prod.lean
index a42dfd687bd8a..a92376d1a0f37 100644
--- a/src/algebra/ring/prod.lean
+++ b/src/algebra/ring/prod.lean
@@ -252,7 +252,7 @@ end ring_equiv
 lemma false_of_nontrivial_of_product_domain (R S : Type*) [ring R] [ring S]
   [is_domain (R × S)] [nontrivial R] [nontrivial S] : false :=
 begin
-  have := is_domain.eq_zero_or_eq_zero_of_mul_eq_zero
+  have := no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero
     (show ((0 : R), (1 : S)) * (1, 0) = 0, by simp),
   rw [prod.mk_eq_zero,prod.mk_eq_zero] at this,
   rcases this with (⟨_,h⟩|⟨h,_⟩),
diff --git a/src/algebra/ring/regular.lean b/src/algebra/ring/regular.lean
index 992b03b2c72c0..81f632d81eb43 100644
--- a/src/algebra/ring/regular.lean
+++ b/src/algebra/ring/regular.lean
@@ -69,13 +69,20 @@ def no_zero_divisors.to_cancel_comm_monoid_with_zero [comm_ring α] [no_zero_div
 section is_domain
 
 @[priority 100] -- see Note [lower instance priority]
-instance is_domain.to_cancel_monoid_with_zero [ring α] [is_domain α] : cancel_monoid_with_zero α :=
-no_zero_divisors.to_cancel_monoid_with_zero
+instance is_domain.to_cancel_monoid_with_zero [semiring α] [is_domain α] :
+  cancel_monoid_with_zero α :=
+{ mul_left_cancel_of_ne_zero := λ a b c ha h,
+    is_cancel_mul_zero.mul_left_cancel_of_ne_zero ha h,
+  mul_right_cancel_of_ne_zero := λ a b c ha h,
+    is_cancel_mul_zero.mul_right_cancel_of_ne_zero ha h,
+  .. semiring.to_monoid_with_zero α }
 
-variables [comm_ring α] [is_domain α]
+variables [comm_semiring α] [is_domain α]
 
 @[priority 100] -- see Note [lower instance priority]
 instance is_domain.to_cancel_comm_monoid_with_zero : cancel_comm_monoid_with_zero α :=
-no_zero_divisors.to_cancel_comm_monoid_with_zero
+{ mul_left_cancel_of_ne_zero := λ a b c ha H, is_domain.mul_left_cancel_of_ne_zero ha H,
+  mul_right_cancel_of_ne_zero := λ a b c hb H, is_domain.mul_right_cancel_of_ne_zero hb H,
+  .. (infer_instance : comm_semiring α) }
 
 end is_domain
diff --git a/src/algebra/ring/units.lean b/src/algebra/ring/units.lean
index 342760f1582be..5005f799cbd52 100644
--- a/src/algebra/ring/units.lean
+++ b/src/algebra/ring/units.lean
@@ -95,4 +95,7 @@ end
   (a /ₚ u₁) - (b /ₚ u₂) = ((a * u₂) - (u₁ * b)) /ₚ (u₁ * u₂) :=
 by simp_rw [sub_eq_add_neg, neg_divp, divp_add_divp, mul_neg]
 
+lemma add_eq_mul_one_add_div [semiring R] {a : Rˣ} {b : R} : ↑a + b = a * (1 + ↑a⁻¹ * b) :=
+by rwa [mul_add, mul_one, ← mul_assoc, units.mul_inv, one_mul]
+
 end units
diff --git a/src/algebra/ring_quot.lean b/src/algebra/ring_quot.lean
index 7d70ddb62fe77..3c0b59d055a7e 100644
--- a/src/algebra/ring_quot.lean
+++ b/src/algebra/ring_quot.lean
@@ -3,7 +3,7 @@ Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
-import algebra.algebra.basic
+import algebra.algebra.hom
 import ring_theory.ideal.quotient
 
 /-!
diff --git a/src/algebra/star/basic.lean b/src/algebra/star/basic.lean
index 9d943463532a5..9e4be9cab8f6b 100644
--- a/src/algebra/star/basic.lean
+++ b/src/algebra/star/basic.lean
@@ -3,7 +3,6 @@ Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
-import algebra.big_operators.basic
 import algebra.ring.aut
 import algebra.ring.comp_typeclasses
 import data.rat.cast
@@ -39,6 +38,8 @@ positive cone which is the closure of the sums of elements `star r * r`. A weake
 advantage of not requiring a topology.
 -/
 
+assert_not_exists finset
+assert_not_exists subgroup
 
 universes u v
 
@@ -165,16 +166,6 @@ op_injective $
   star (x / y) = star x / star y :=
 map_div (star_mul_aut : R ≃* R) _ _
 
-section
-open_locale big_operators
-
-@[simp] lemma star_prod [comm_monoid R] [star_semigroup R] {α : Type*}
-  (s : finset α) (f : α → R):
-  star (∏ x in s, f x) = ∏ x in s, star (f x) :=
-map_prod (star_mul_aut : R ≃* R) _ _
-
-end
-
 /--
 Any commutative monoid admits the trivial `*`-structure.
 
@@ -240,16 +231,6 @@ star_eq_zero.not
   star (n • x) = n • star x :=
 (star_add_equiv : R ≃+ R).to_add_monoid_hom.map_zsmul _ _
 
-section
-open_locale big_operators
-
-@[simp] lemma star_sum [add_comm_monoid R] [star_add_monoid R] {α : Type*}
-  (s : finset α) (f : α → R):
-  star (∑ x in s, f x) = ∑ x in s, star (f x) :=
-(star_add_equiv : R ≃+ R).map_sum _ _
-
-end
-
 /--
 A `*`-ring `R` is a (semi)ring with an involutive `star` operation which is additive
 which makes `R` with its multiplicative structure into a `*`-semigroup
diff --git a/src/algebra/star/big_operators.lean b/src/algebra/star/big_operators.lean
new file mode 100644
index 0000000000000..156f2f8f3ec94
--- /dev/null
+++ b/src/algebra/star/big_operators.lean
@@ -0,0 +1,26 @@
+/-
+Copyright (c) 2021 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import algebra.big_operators.basic
+import algebra.star.basic
+
+/-! # Big-operators lemmas about `star` algebraic operations
+
+These results are kept separate from `algebra.star.basic` to avoid it needing to import `finset`.
+-/
+
+variables {R : Type*}
+
+open_locale big_operators
+
+@[simp] lemma star_prod [comm_monoid R] [star_semigroup R] {α : Type*}
+  (s : finset α) (f : α → R):
+  star (∏ x in s, f x) = ∏ x in s, star (f x) :=
+map_prod (star_mul_aut : R ≃* R) _ _
+
+@[simp] lemma star_sum [add_comm_monoid R] [star_add_monoid R] {α : Type*}
+  (s : finset α) (f : α → R):
+  star (∑ x in s, f x) = ∑ x in s, star (f x) :=
+(star_add_equiv : R ≃+ R).map_sum _ _
diff --git a/src/algebra/star/pointwise.lean b/src/algebra/star/pointwise.lean
index d547b3d994970..0b27e91d40628 100644
--- a/src/algebra/star/pointwise.lean
+++ b/src/algebra/star/pointwise.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jireh Loreaux
 -/
 import algebra.star.basic
+import data.set.finite
 import data.set.pointwise.basic
 
 /-!
diff --git a/src/algebra/star/star_alg_hom.lean b/src/algebra/star/star_alg_hom.lean
index be5435d5b07c3..5d3c2e4682044 100644
--- a/src/algebra/star/star_alg_hom.lean
+++ b/src/algebra/star/star_alg_hom.lean
@@ -6,6 +6,7 @@ Authors: Jireh Loreaux
 
 import algebra.hom.non_unital_alg
 import algebra.star.prod
+import algebra.algebra.prod
 
 /-!
 # Morphisms of star algebras
diff --git a/src/algebra/support.lean b/src/algebra/support.lean
index aa0957f5b89c8..79286fe5e7232 100644
--- a/src/algebra/support.lean
+++ b/src/algebra/support.lean
@@ -76,7 +76,7 @@ by { simp_rw [← subset_empty_iff, mul_support_subset_iff', funext_iff], simp }
 
 @[simp, to_additive] lemma mul_support_nonempty_iff {f : α → M} :
   (mul_support f).nonempty ↔ f ≠ 1 :=
-by rw [← ne_empty_iff_nonempty, ne.def, mul_support_eq_empty_iff]
+by rw [nonempty_iff_ne_empty, ne.def, mul_support_eq_empty_iff]
 
 @[to_additive]
 lemma range_subset_insert_image_mul_support (f : α → M) :
diff --git a/src/algebraic_geometry/EllipticCurve.lean b/src/algebraic_geometry/EllipticCurve.lean
deleted file mode 100644
index 5208e75178cf3..0000000000000
--- a/src/algebraic_geometry/EllipticCurve.lean
+++ /dev/null
@@ -1,234 +0,0 @@
-/-
-Copyright (c) 2021 Kevin Buzzard. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kevin Buzzard, David Kurniadi Angdinata
--/
-
-import algebra.cubic_discriminant
-import tactic.linear_combination
-
-/-!
-# The category of elliptic curves (over a field or a PID)
-
-We give a working definition of elliptic curves which is mathematically accurate
-in many cases, and also good for computation.
-
-## Mathematical background
-
-Let `S` be a scheme. The actual category of elliptic curves over `S` is a large category,
-whose objects are schemes `E` equipped with a map `E → S`, a section `S → E`, and some
-axioms (the map is smooth and proper and the fibres are geometrically connected group varieties
-of dimension one). In the special case where `S` is `Spec R` for some commutative ring `R`
-whose Picard group is trivial (this includes all fields, all principal ideal domains, and many
-other commutative rings) then it can be shown (using rather a lot of algebro-geometric machinery)
-that every elliptic curve is, up to isomorphism, a projective plane cubic defined by
-the equation `y² + a₁xy + a₃y = x³ + a₂x² + a₄x + a₆`, with `aᵢ : R`, and such that
-the discriminant of the aᵢ is a unit in `R`.
-
-Some more details of the construction can be found on pages 66-69 of
-[N. Katz and B. Mazur, *Arithmetic moduli of elliptic curves*][katz_mazur] or pages
-53-56 of [P. Deligne, *Courbes elliptiques: formulaire d'après J. Tate*][deligne_formulaire].
-
-## Warning
-
-The definition in this file makes sense for all commutative rings `R`, but it only gives
-a type which can be beefed up to a category which is equivalent to the category of elliptic
-curves over `Spec R` in the case that `R` has trivial Picard group `Pic R` or, slightly more
-generally, when its `12`-torsion is trivial. The issue is that for a general ring `R`, there
-might be elliptic curves over `Spec R` in the sense of algebraic geometry which are not
-globally defined by a cubic equation valid over the entire base.
-
-## TODO
-
-Define the `R`-points (or even `A`-points if `A` is an `R`-algebra). Care will be needed at infinity
-if `R` is not a field. Define the group law on the `R`-points. Prove associativity (hard).
--/
-
-universes u v
-
-/-- The discriminant of an elliptic curve given by the long Weierstrass equation
-  `y² + a₁xy + a₃y = x³ + a₂x² + a₄x + a₆`. If `R` is a field, then this polynomial vanishes iff the
-  cubic curve cut out by this equation is singular. Sometimes only defined up to sign in the
-  literature; we choose the sign used by the LMFDB. For more discussion, see
-  [the LMFDB page on discriminants](https://www.lmfdb.org/knowledge/show/ec.discriminant). -/
-@[simp] def EllipticCurve.Δ_aux {R : Type u} [comm_ring R] (a₁ a₂ a₃ a₄ a₆ : R) : R :=
-let b₂ : R := a₁ ^ 2 + 4 * a₂,
-    b₄ : R := 2 * a₄ + a₁ * a₃,
-    b₆ : R := a₃ ^ 2 + 4 * a₆,
-    b₈ : R := a₁ ^ 2 * a₆ + 4 * a₂ * a₆ - a₁ * a₃ * a₄ + a₂ * a₃ ^ 2 - a₄ ^ 2
-in  -b₂ ^ 2 * b₈ - 8 * b₄ ^ 3 - 27 * b₆ ^ 2 + 9 * b₂ * b₄ * b₆
-
-/-- The category of elliptic curves over `R` (note that this definition is only mathematically
-  correct for certain rings `R` with `Pic(R)[12] = 0`, for example if `R` is a field or a PID). -/
-structure EllipticCurve (R : Type u) [comm_ring R] :=
-(a₁ a₂ a₃ a₄ a₆ : R) (Δ : Rˣ) (Δ_eq : ↑Δ = EllipticCurve.Δ_aux a₁ a₂ a₃ a₄ a₆)
-
-namespace EllipticCurve
-
-instance : inhabited (EllipticCurve ℚ) :=
-⟨⟨0, 0, 1, -1, 0, ⟨37, 37⁻¹, by norm_num1, by norm_num1⟩, show (37 : ℚ) = _ + _, by norm_num1 ⟩⟩
-
-variables {R : Type u} [comm_ring R] (E : EllipticCurve R)
-
-section quantity
-
-/-! ### Standard quantities -/
-
-/-- The `b₂` coefficient of an elliptic curve. -/
-@[simp] def b₂ : R := E.a₁ ^ 2 + 4 * E.a₂
-
-/-- The `b₄` coefficient of an elliptic curve. -/
-@[simp] def b₄ : R := 2 * E.a₄ + E.a₁ * E.a₃
-
-/-- The `b₆` coefficient of an elliptic curve. -/
-@[simp] def b₆ : R := E.a₃ ^ 2 + 4 * E.a₆
-
-/-- The `b₈` coefficient of an elliptic curve. -/
-@[simp] def b₈ : R :=
-E.a₁ ^ 2 * E.a₆ + 4 * E.a₂ * E.a₆ - E.a₁ * E.a₃ * E.a₄ + E.a₂ * E.a₃ ^ 2 - E.a₄ ^ 2
-
-lemma b_relation : 4 * E.b₈ = E.b₂ * E.b₆ - E.b₄ ^ 2 := by { simp, ring1 }
-
-/-- The `c₄` coefficient of an elliptic curve. -/
-@[simp] def c₄ : R := E.b₂ ^ 2 - 24 * E.b₄
-
-/-- The `c₆` coefficient of an elliptic curve. -/
-@[simp] def c₆ : R := -E.b₂ ^ 3 + 36 * E.b₂ * E.b₄ - 216 * E.b₆
-
-@[simp] lemma coe_Δ :
-  ↑E.Δ = -E.b₂ ^ 2 * E.b₈ - 8 * E.b₄ ^ 3 - 27 * E.b₆ ^ 2 + 9 * E.b₂ * E.b₄ * E.b₆ :=
-E.Δ_eq
-
-lemma c_relation : 1728 * ↑E.Δ = E.c₄ ^ 3 - E.c₆ ^ 2 := by { simp, ring1 }
-
-/-- The j-invariant of an elliptic curve, which is invariant under isomorphisms over `R`. -/
-@[simp] def j : R := ↑E.Δ⁻¹ * E.c₄ ^ 3
-
-end quantity
-
-section torsion_polynomial
-
-/-! ### `2`-torsion polynomials -/
-
-/-- The polynomial whose roots over a splitting field of `R` are the `2`-torsion points of the
-  elliptic curve when `R` is a field of characteristic different from `2`, and whose discriminant
-  happens to be a multiple of the discriminant of the elliptic curve. -/
-def two_torsion_polynomial : cubic R := ⟨4, E.b₂, 2 * E.b₄, E.b₆⟩
-
-lemma two_torsion_polynomial.disc_eq : E.two_torsion_polynomial.disc = 16 * E.Δ :=
-by { simp only [two_torsion_polynomial, cubic.disc, coe_Δ, b₂, b₄, b₆, b₈], ring1 }
-
-lemma two_torsion_polynomial.disc_ne_zero [nontrivial R] [invertible (2 : R)] :
-  E.two_torsion_polynomial.disc ≠ 0 :=
-λ hdisc, E.Δ.ne_zero $ (is_unit_of_invertible $ 2 ^ 4).mul_left_cancel $
-by linear_combination hdisc - two_torsion_polynomial.disc_eq E
-    with { normalization_tactic := `[ring1] }
-
-end torsion_polynomial
-
-section base_change
-
-/-! ### Base changes -/
-
-variables (A : Type v) [comm_ring A] [algebra R A]
-
-private meta def simp_map : tactic unit :=
-`[simp only [map_one, map_bit0, map_bit1, map_neg, map_add, map_sub, map_mul, map_pow]]
-
-/-- The elliptic curve over `R` base changed to `A`. -/
-@[simps] def base_change : EllipticCurve A :=
-{ a₁   := algebra_map R A E.a₁,
-  a₂   := algebra_map R A E.a₂,
-  a₃   := algebra_map R A E.a₃,
-  a₄   := algebra_map R A E.a₄,
-  a₆   := algebra_map R A E.a₆,
-  Δ    := units.map ↑(algebra_map R A) E.Δ,
-  Δ_eq := by { simp only [units.coe_map, ring_hom.coe_monoid_hom, Δ_eq, Δ_aux], simp_map } }
-
-@[simp] lemma base_change_b₂ : (E.base_change A).b₂ = algebra_map R A E.b₂ :=
-by { simp only [b₂, base_change_a₁, base_change_a₂], simp_map }
-
-@[simp] lemma base_change_b₄ : (E.base_change A).b₄ = algebra_map R A E.b₄ :=
-by { simp only [b₄, base_change_a₁, base_change_a₃, base_change_a₄], simp_map }
-
-@[simp] lemma base_change_b₆ : (E.base_change A).b₆ = algebra_map R A E.b₆ :=
-by { simp only [b₆, base_change_a₃, base_change_a₆], simp_map }
-
-@[simp] lemma base_change_b₈ : (E.base_change A).b₈ = algebra_map R A E.b₈ :=
-by { simp only [b₈, base_change_a₁, base_change_a₂, base_change_a₃, base_change_a₄, base_change_a₆],
-     simp_map }
-
-@[simp] lemma base_change_c₄ : (E.base_change A).c₄ = algebra_map R A E.c₄ :=
-by { simp only [c₄, base_change_b₂, base_change_b₄], simp_map }
-
-@[simp] lemma base_change_c₆ : (E.base_change A).c₆ = algebra_map R A E.c₆ :=
-by { simp only [c₆, base_change_b₂, base_change_b₄, base_change_b₆], simp_map }
-
-lemma base_change_Δ_coe : ↑(E.base_change A).Δ = algebra_map R A E.Δ := rfl
-
-lemma base_change_Δ_inv_coe : ↑(E.base_change A).Δ⁻¹ = algebra_map R A ↑E.Δ⁻¹ := rfl
-
-@[simp] lemma base_change_j : (E.base_change A).j = algebra_map R A E.j :=
-by { simp only [j, base_change_c₄, base_change_Δ_inv_coe], simp_map }
-
-end base_change
-
-section variable_change
-
-/-! ### Variable changes -/
-
-variables (u : Rˣ) (r s t : R)
-
-/-- The elliptic curve over `R` induced by an admissible linear change of variables
-  `(x, y) ↦ (u²x + r, u³y + u²sx + t)` for some `u ∈ Rˣ` and some `r, s, t ∈ R`.
-  When `R` is a field, any two isomorphic long Weierstrass equations are related by this. -/
-@[simps] def variable_change : EllipticCurve R :=
-{ a₁   := ↑u⁻¹ * (E.a₁ + 2 * s),
-  a₂   := ↑u⁻¹ ^ 2 * (E.a₂ - s * E.a₁ + 3 * r - s ^ 2),
-  a₃   := ↑u⁻¹ ^ 3 * (E.a₃ + r * E.a₁ + 2 * t),
-  a₄   := ↑u⁻¹ ^ 4 * (E.a₄ - s * E.a₃ + 2 * r * E.a₂ - (t + r * s) * E.a₁ + 3 * r ^ 2 - 2 * s * t),
-  a₆   := ↑u⁻¹ ^ 6 * (E.a₆ + r * E.a₄ + r ^ 2 * E.a₂ + r ^ 3 - t * E.a₃ - t ^ 2 - r * t * E.a₁),
-  Δ    := u⁻¹ ^ 12 * E.Δ,
-  Δ_eq := by { simp [-inv_pow], ring1 } }
-
-@[simp] lemma variable_change_b₂ : (E.variable_change u r s t).b₂ = ↑u⁻¹ ^ 2 * (E.b₂ + 12 * r) :=
-by { simp only [b₂, variable_change_a₁, variable_change_a₂], ring1 }
-
-@[simp] lemma variable_change_b₄ :
-  (E.variable_change u r s t).b₄ = ↑u⁻¹ ^ 4 * (E.b₄ + r * E.b₂ + 6 * r ^ 2) :=
-by { simp only [b₂, b₄, variable_change_a₁, variable_change_a₃, variable_change_a₄], ring1 }
-
-@[simp] lemma variable_change_b₆ :
-  (E.variable_change u r s t).b₆ = ↑u⁻¹ ^ 6 * (E.b₆ + 2 * r * E.b₄ + r ^ 2 * E.b₂ + 4 * r ^ 3) :=
-by { simp only [b₂, b₄, b₆, variable_change_a₃, variable_change_a₆], ring1 }
-
-@[simp] lemma variable_change_b₈ :
-  (E.variable_change u r s t).b₈
-    = ↑u⁻¹ ^ 8 * (E.b₈ + 3 * r * E.b₆ + 3 * r ^ 2 * E.b₄ + r ^ 3 * E.b₂ + 3 * r ^ 4) :=
-by { simp only [b₂, b₄, b₆, b₈, variable_change_a₁, variable_change_a₂, variable_change_a₃,
-                variable_change_a₄, variable_change_a₆], ring1 }
-
-@[simp] lemma variable_change_c₄ : (E.variable_change u r s t).c₄ = ↑u⁻¹ ^ 4 * E.c₄ :=
-by { simp only [c₄, variable_change_b₂, variable_change_b₄], ring1 }
-
-@[simp] lemma variable_change_c₆ : (E.variable_change u r s t).c₆ = ↑u⁻¹ ^ 6 * E.c₆ :=
-by { simp only [c₆, variable_change_b₂, variable_change_b₄, variable_change_b₆], ring1 }
-
-lemma variable_change_Δ_coe : (↑(E.variable_change u r s t).Δ : R) = ↑u⁻¹ ^ 12 * E.Δ :=
-by rw [variable_change_Δ, units.coe_mul, units.coe_pow]
-
-lemma variable_change_Δ_inv_coe : (↑(E.variable_change u r s t).Δ⁻¹ : R) = u ^ 12 * ↑E.Δ⁻¹ :=
-by rw [variable_change_Δ, mul_inv, inv_pow, inv_inv, units.coe_mul, units.coe_pow]
-
-@[simp] lemma variable_change_j : (E.variable_change u r s t).j = E.j :=
-begin
-  simp only [b₂, b₄, c₄, j, variable_change_c₄, variable_change_Δ, mul_inv, inv_pow, inv_inv,
-             units.coe_mul, u.coe_pow],
-  have hu : (u * ↑u⁻¹ : R) ^ 12 = 1 := by rw [u.mul_inv, one_pow],
-  linear_combination ↑E.Δ⁻¹ * ((E.a₁ ^ 2 + 4 * E.a₂) ^ 2 - 24 * (2 * E.a₄ + E.a₁ * E.a₃)) ^ 3 * hu
-    with { normalization_tactic := `[ring1] }
-end
-
-end variable_change
-
-end EllipticCurve
diff --git a/src/algebraic_geometry/Spec.lean b/src/algebraic_geometry/Spec.lean
index 05e1db2032b95..fa176f103806e 100644
--- a/src/algebraic_geometry/Spec.lean
+++ b/src/algebraic_geometry/Spec.lean
@@ -9,6 +9,7 @@ import logic.equiv.transfer_instance
 import ring_theory.localization.localization_localization
 import topology.sheaves.sheaf_condition.sites
 import topology.sheaves.functors
+import algebra.module.localized_module
 
 /-!
 # $Spec$ as a functor to locally ringed spaces.
@@ -224,7 +225,8 @@ section Spec_Γ
 open algebraic_geometry.LocallyRingedSpace
 
 /-- The counit morphism `R ⟶ Γ(Spec R)` given by `algebraic_geometry.structure_sheaf.to_open`.  -/
-@[simps] def to_Spec_Γ (R : CommRing) : R ⟶ Γ.obj (op (Spec.to_LocallyRingedSpace.obj (op R))) :=
+@[simps {rhs_md := tactic.transparency.semireducible}]
+def to_Spec_Γ (R : CommRing) : R ⟶ Γ.obj (op (Spec.to_LocallyRingedSpace.obj (op R))) :=
 structure_sheaf.to_open R ⊤
 
 instance is_iso_to_Spec_Γ (R : CommRing) : is_iso (to_Spec_Γ R) :=
@@ -257,5 +259,104 @@ begin
   apply_instance
 end
 
+namespace structure_sheaf
+
+variables {R S : CommRing.{u}} (f : R ⟶ S) (p : prime_spectrum R)
+
+/--
+For an algebra `f : R →+* S`, this is the ring homomorphism `S →+* (f∗ 𝒪ₛ)ₚ` for a `p : Spec R`.
+This is shown to be the localization at `p` in `is_localized_module_to_pushforward_stalk_alg_hom`.
+-/
+def to_pushforward_stalk :
+  S ⟶ (Spec.Top_map f _* (structure_sheaf S).1).stalk p :=
+structure_sheaf.to_open S ⊤ ≫
+  @Top.presheaf.germ _ _ _ _ (Spec.Top_map f _* (structure_sheaf S).1) ⊤ ⟨p, trivial⟩
+
+@[reassoc]
+lemma to_pushforward_stalk_comp :
+  f ≫ structure_sheaf.to_pushforward_stalk f p =
+  structure_sheaf.to_stalk R p ≫
+    (Top.presheaf.stalk_functor _ _).map (Spec.SheafedSpace_map f).c :=
+begin
+  rw structure_sheaf.to_stalk,
+  erw category.assoc,
+  rw Top.presheaf.stalk_functor_map_germ,
+  exact Spec_Γ_naturality_assoc f _,
+end
+
+instance : algebra R ((Spec.Top_map f _* (structure_sheaf S).1).stalk p) :=
+(f ≫ structure_sheaf.to_pushforward_stalk f p).to_algebra
+
+lemma algebra_map_pushforward_stalk :
+  algebra_map R ((Spec.Top_map f _* (structure_sheaf S).1).stalk p) =
+    f ≫ structure_sheaf.to_pushforward_stalk f p := rfl
+
+variables (R S) [algebra R S]
+
+/--
+This is the `alg_hom` version of `to_pushforward_stalk`, which is the map `S ⟶ (f∗ 𝒪ₛ)ₚ` for some
+algebra `R ⟶ S` and some `p : Spec R`.
+-/
+@[simps]
+def to_pushforward_stalk_alg_hom :
+  S →ₐ[R] (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).stalk p :=
+{ commutes' := λ _, rfl, ..(structure_sheaf.to_pushforward_stalk (algebra_map R S) p) }
+
+.
+lemma is_localized_module_to_pushforward_stalk_alg_hom_aux (y) :
+  ∃ (x : S × p.as_ideal.prime_compl), x.2 • y = to_pushforward_stalk_alg_hom R S p x.1 :=
+begin
+  obtain ⟨U, hp, s, e⟩ := Top.presheaf.germ_exist _ _ y,
+  obtain ⟨_, ⟨r, rfl⟩, hpr, hrU⟩ := prime_spectrum.is_topological_basis_basic_opens
+    .exists_subset_of_mem_open (show p ∈ U.1, from hp) U.2,
+  change prime_spectrum.basic_open r ≤ U at hrU,
+  replace e := ((Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1)
+    .germ_res_apply (hom_of_le hrU) ⟨p, hpr⟩ _).trans e,
+  set s' := (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).map (hom_of_le hrU).op s
+    with h,
+  rw ← h at e,
+  clear_value s', clear_dependent U,
+  obtain ⟨⟨s, ⟨_, n, rfl⟩⟩, hsn⟩ := @is_localization.surj _ _ _
+    _ _ _ (structure_sheaf.is_localization.to_basic_open S $ algebra_map R S r) s',
+  refine ⟨⟨s, ⟨r, hpr⟩ ^ n⟩, _⟩,
+  rw [submonoid.smul_def, algebra.smul_def, algebra_map_pushforward_stalk, to_pushforward_stalk,
+    comp_apply, comp_apply],
+  iterate 2 { erw ← (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).germ_res_apply
+    (hom_of_le le_top) ⟨p, hpr⟩ },
+  rw [← e, ← map_mul, mul_comm],
+  dsimp only [subtype.coe_mk] at hsn,
+  rw ← map_pow (algebra_map R S) at hsn,
+  congr' 1
+end
+
+instance is_localized_module_to_pushforward_stalk_alg_hom :
+  is_localized_module p.as_ideal.prime_compl (to_pushforward_stalk_alg_hom R S p).to_linear_map :=
+begin
+  apply is_localized_module.mk_of_algebra,
+  { intros x hx, rw [algebra_map_pushforward_stalk, to_pushforward_stalk_comp, comp_apply],
+    exact (is_localization.map_units ((structure_sheaf R).presheaf.stalk p) ⟨x, hx⟩).map _ },
+  { apply is_localized_module_to_pushforward_stalk_alg_hom_aux },
+  { intros x hx,
+    rw [to_pushforward_stalk_alg_hom_apply, ring_hom.to_fun_eq_coe,
+      ← (to_pushforward_stalk (algebra_map R S) p).map_zero, to_pushforward_stalk, comp_apply,
+      comp_apply, map_zero] at hx,
+    obtain ⟨U, hpU, i₁, i₂, e⟩ := Top.presheaf.germ_eq _ _ _ _ _ _ hx,
+    obtain ⟨_, ⟨r, rfl⟩, hpr, hrU⟩ := prime_spectrum.is_topological_basis_basic_opens
+      .exists_subset_of_mem_open (show p ∈ U.1, from hpU) U.2,
+    change prime_spectrum.basic_open r ≤ U at hrU,
+    apply_fun (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).map (hom_of_le hrU).op at e,
+    simp only [Top.presheaf.pushforward_obj_map, functor.op_map, map_zero, ← comp_apply,
+      to_open_res] at e,
+    have : to_open S (prime_spectrum.basic_open $ algebra_map R S r) x = 0,
+    { refine eq.trans _ e, refl },
+    have := (@is_localization.mk'_one _ _ _
+      _ _ _ (structure_sheaf.is_localization.to_basic_open S $ algebra_map R S r) x).trans this,
+    obtain ⟨⟨_, n, rfl⟩, e⟩ := (is_localization.mk'_eq_zero_iff _ _).mp this,
+    refine ⟨⟨r, hpr⟩ ^ n, _⟩,
+    rw [submonoid.smul_def, algebra.smul_def, submonoid.coe_pow, subtype.coe_mk, mul_comm, map_pow],
+    exact e },
+end
+
+end structure_sheaf
 
 end algebraic_geometry
diff --git a/src/algebraic_geometry/elliptic_curve/weierstrass.lean b/src/algebraic_geometry/elliptic_curve/weierstrass.lean
new file mode 100644
index 0000000000000..750dd897746c6
--- /dev/null
+++ b/src/algebraic_geometry/elliptic_curve/weierstrass.lean
@@ -0,0 +1,292 @@
+/-
+Copyright (c) 2021 Kevin Buzzard. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kevin Buzzard, David Kurniadi Angdinata
+-/
+
+import algebra.cubic_discriminant
+import tactic.linear_combination
+
+/-!
+# Weierstrass equations of elliptic curves
+
+We give a working definition of an elliptic curve as a non-singular Weierstrass curve given by a
+Weierstrass equation, which is mathematically accurate in many cases but also good for computation.
+
+## Mathematical background
+
+Let `S` be a scheme. The actual category of elliptic curves over `S` is a large category, whose
+objects are schemes `E` equipped with a map `E → S`, a section `S → E`, and some axioms (the map
+is smooth and proper and the fibres are geometrically-connected one-dimensional group varieties). In
+the special case where `S` is the spectrum of some commutative ring `R` whose Picard group is zero
+(this includes all fields, all PIDs, and many other commutative rings) it can be shown (using a lot
+of algebro-geometric machinery) that every elliptic curve `E` is a projective plane cubic isomorphic
+to a Weierstrass curve given by the equation $y^2 + a_1xy + a_3y = x^3 + a_2x^2 + a_4x + a_6$ for
+some $a_i$ in `R`, and such that a certain quantity called the discriminant of `E` is a unit in `R`.
+If `R` is a field, this quantity divides the discriminant of a cubic polynomial whose roots over a
+splitting field of `R` are precisely the x-coordinates of the non-zero 2-torsion points of `E`.
+
+## Main definitions
+
+ * `weierstrass_curve`: a Weierstrass curve over a commutative ring.
+ * `weierstrass_curve.variable_change`: the Weierstrass curve induced by a change of variables.
+ * `weierstrass_curve.base_change`: the Weierstrass curve base changed over an algebra.
+ * `weierstrass_curve.two_torsion_polynomial`: the 2-torsion polynomial of a Weierstrass curve.
+ * `elliptic_curve`: an elliptic curve over a commutative ring.
+ * `elliptic_curve.j`: the j-invariant of an elliptic curve.
+
+## Main statements
+
+ * `weierstrass_curve.two_torsion_polynomial_disc`: the discriminant of a Weierstrass curve is a
+    constant factor of the cubic discriminant of its 2-torsion polynomial.
+ * `elliptic_curve.variable_change_j`: the j-invariant of an elliptic curve is invariant under an
+    admissible linear change of variables.
+
+## Implementation notes
+
+The definition of elliptic curves in this file makes sense for all commutative rings `R`, but it
+only gives a type which can be beefed up to a category which is equivalent to the category of
+elliptic curves over the spectrum $\mathrm{Spec}(R)$ of `R` in the case that `R` has trivial Picard
+group $\mathrm{Pic}(R)$ or, slightly more generally, when its 12-torsion is trivial. The issue is
+that for a general ring `R`, there might be elliptic curves over $\mathrm{Spec}(R)$ in the sense of
+algebraic geometry which are not globally defined by a cubic equation valid over the entire base.
+
+## References
+
+ * [N Katz and B Mazur, *Arithmetic Moduli of Elliptic Curves*][katz_mazur]
+ * [P Deligne, *Courbes Elliptiques: Formulaire (d'après J. Tate)*][deligne_formulaire]
+ * [J Silverman, *The Arithmetic of Elliptic Curves*][silverman2009]
+
+## Tags
+
+elliptic curve, weierstrass equation, j invariant
+-/
+
+private meta def map_simp : tactic unit :=
+`[simp only [map_one, map_bit0, map_bit1, map_neg, map_add, map_sub, map_mul, map_pow]]
+
+universes u v
+
+variable {R : Type u}
+
+/-! ## Weierstrass curves -/
+
+/-- A Weierstrass curve $y^2 + a_1xy + a_3y = x^3 + a_2x^2 + a_4x + a_6$ with parameters $a_i$. -/
+@[ext] structure weierstrass_curve (R : Type u) := (a₁ a₂ a₃ a₄ a₆ : R)
+
+instance [inhabited R] : inhabited $ weierstrass_curve R :=
+⟨⟨default, default, default, default, default⟩⟩
+
+namespace weierstrass_curve
+
+variables [comm_ring R] (C : weierstrass_curve R)
+
+section quantity
+
+/-! ### Standard quantities -/
+
+/-- The `b₂` coefficient of a Weierstrass curve. -/
+@[simp] def b₂ : R := C.a₁ ^ 2 + 4 * C.a₂
+
+/-- The `b₄` coefficient of a Weierstrass curve. -/
+@[simp] def b₄ : R := 2 * C.a₄ + C.a₁ * C.a₃
+
+/-- The `b₆` coefficient of a Weierstrass curve. -/
+@[simp] def b₆ : R := C.a₃ ^ 2 + 4 * C.a₆
+
+/-- The `b₈` coefficient of a Weierstrass curve. -/
+@[simp] def b₈ : R :=
+C.a₁ ^ 2 * C.a₆ + 4 * C.a₂ * C.a₆ - C.a₁ * C.a₃ * C.a₄ + C.a₂ * C.a₃ ^ 2 - C.a₄ ^ 2
+
+lemma b_relation : 4 * C.b₈ = C.b₂ * C.b₆ - C.b₄ ^ 2 := by { simp only [b₂, b₄, b₆, b₈], ring1 }
+
+/-- The `c₄` coefficient of a Weierstrass curve. -/
+@[simp] def c₄ : R := C.b₂ ^ 2 - 24 * C.b₄
+
+/-- The `c₆` coefficient of a Weierstrass curve. -/
+@[simp] def c₆ : R := -C.b₂ ^ 3 + 36 * C.b₂ * C.b₄ - 216 * C.b₆
+
+/-- The discriminant `Δ` of a Weierstrass curve. If `R` is a field, then this polynomial vanishes
+if and only if the cubic curve cut out by this equation is singular. Sometimes only defined up to
+sign in the literature; we choose the sign used by the LMFDB. For more discussion, see
+[the LMFDB page on discriminants](https://www.lmfdb.org/knowledge/show/ec.discriminant). -/
+@[simp] def Δ : R := -C.b₂ ^ 2 * C.b₈ - 8 * C.b₄ ^ 3 - 27 * C.b₆ ^ 2 + 9 * C.b₂ * C.b₄ * C.b₆
+
+lemma c_relation : 1728 * C.Δ = C.c₄ ^ 3 - C.c₆ ^ 2 :=
+by { simp only [b₂, b₄, b₆, b₈, c₄, c₆, Δ], ring1 }
+
+end quantity
+
+section variable_change
+
+/-! ### Variable changes -/
+
+variables (u : Rˣ) (r s t : R)
+
+/-- The Weierstrass curve over `R` induced by an admissible linear change of variables
+$(x, y) \mapsto (u^2x + r, u^3y + u^2sx + t)$ for some $u \in R^\times$ and some $r, s, t \in R$. -/
+@[simps] def variable_change : weierstrass_curve R :=
+{ a₁ := ↑u⁻¹ * (C.a₁ + 2 * s),
+  a₂ := ↑u⁻¹ ^ 2 * (C.a₂ - s * C.a₁ + 3 * r - s ^ 2),
+  a₃ := ↑u⁻¹ ^ 3 * (C.a₃ + r * C.a₁ + 2 * t),
+  a₄ := ↑u⁻¹ ^ 4 * (C.a₄ - s * C.a₃ + 2 * r * C.a₂ - (t + r * s) * C.a₁ + 3 * r ^ 2 - 2 * s * t),
+  a₆ := ↑u⁻¹ ^ 6 * (C.a₆ + r * C.a₄ + r ^ 2 * C.a₂ + r ^ 3 - t * C.a₃ - t ^ 2 - r * t * C.a₁) }
+
+@[simp] lemma variable_change_b₂ : (C.variable_change u r s t).b₂ = ↑u⁻¹ ^ 2 * (C.b₂ + 12 * r) :=
+by { simp only [b₂, variable_change_a₁, variable_change_a₂], ring1 }
+
+@[simp] lemma variable_change_b₄ :
+  (C.variable_change u r s t).b₄ = ↑u⁻¹ ^ 4 * (C.b₄ + r * C.b₂ + 6 * r ^ 2) :=
+by { simp only [b₂, b₄, variable_change_a₁, variable_change_a₃, variable_change_a₄], ring1 }
+
+@[simp] lemma variable_change_b₆ :
+  (C.variable_change u r s t).b₆ = ↑u⁻¹ ^ 6 * (C.b₆ + 2 * r * C.b₄ + r ^ 2 * C.b₂ + 4 * r ^ 3) :=
+by { simp only [b₂, b₄, b₆, variable_change_a₃, variable_change_a₆], ring1 }
+
+@[simp] lemma variable_change_b₈ :
+  (C.variable_change u r s t).b₈
+    = ↑u⁻¹ ^ 8 * (C.b₈ + 3 * r * C.b₆ + 3 * r ^ 2 * C.b₄ + r ^ 3 * C.b₂ + 3 * r ^ 4) :=
+by { simp only [b₂, b₄, b₆, b₈, variable_change_a₁, variable_change_a₂, variable_change_a₃,
+                variable_change_a₄, variable_change_a₆], ring1 }
+
+@[simp] lemma variable_change_c₄ : (C.variable_change u r s t).c₄ = ↑u⁻¹ ^ 4 * C.c₄ :=
+by { simp only [c₄, variable_change_b₂, variable_change_b₄], ring1 }
+
+@[simp] lemma variable_change_c₆ : (C.variable_change u r s t).c₆ = ↑u⁻¹ ^ 6 * C.c₆ :=
+by { simp only [c₆, variable_change_b₂, variable_change_b₄, variable_change_b₆], ring1 }
+
+@[simp] lemma variable_change_Δ : (C.variable_change u r s t).Δ = ↑u⁻¹ ^ 12 * C.Δ :=
+by { dsimp, ring1 }
+
+end variable_change
+
+section base_change
+
+/-! ### Base changes -/
+
+variables (A : Type v) [comm_ring A] [algebra R A]
+
+/-- The Weierstrass curve over `R` base changed to `A`. -/
+@[simps] def base_change : weierstrass_curve A :=
+⟨algebra_map R A C.a₁, algebra_map R A C.a₂, algebra_map R A C.a₃, algebra_map R A C.a₄,
+algebra_map R A C.a₆⟩
+
+@[simp] lemma base_change_b₂ : (C.base_change A).b₂ = algebra_map R A C.b₂ :=
+by { simp only [b₂, base_change_a₁, base_change_a₂], map_simp }
+
+@[simp] lemma base_change_b₄ : (C.base_change A).b₄ = algebra_map R A C.b₄ :=
+by { simp only [b₄, base_change_a₁, base_change_a₃, base_change_a₄], map_simp }
+
+@[simp] lemma base_change_b₆ : (C.base_change A).b₆ = algebra_map R A C.b₆ :=
+by { simp only [b₆, base_change_a₃, base_change_a₆], map_simp }
+
+@[simp] lemma base_change_b₈ : (C.base_change A).b₈ = algebra_map R A C.b₈ :=
+by { simp only [b₈, base_change_a₁, base_change_a₂, base_change_a₃, base_change_a₄, base_change_a₆],
+     map_simp }
+
+@[simp] lemma base_change_c₄ : (C.base_change A).c₄ = algebra_map R A C.c₄ :=
+by { simp only [c₄, base_change_b₂, base_change_b₄], map_simp }
+
+@[simp] lemma base_change_c₆ : (C.base_change A).c₆ = algebra_map R A C.c₆ :=
+by { simp only [c₆, base_change_b₂, base_change_b₄, base_change_b₆], map_simp }
+
+@[simp, nolint simp_nf] lemma base_change_Δ : (C.base_change A).Δ = algebra_map R A C.Δ :=
+by { simp only [Δ, base_change_b₂, base_change_b₄, base_change_b₆, base_change_b₈], map_simp }
+
+end base_change
+
+section torsion_polynomial
+
+/-! ### 2-torsion polynomials -/
+
+/-- A cubic polynomial whose discriminant is a multiple of the Weierstrass curve discriminant.
+If `C` is an elliptic curve over a field `R` of characteristic different from 2, then its roots over
+a splitting field of `R` are precisely the x-coordinates of the non-zero 2-torsion points of `C`. -/
+def two_torsion_polynomial : cubic R := ⟨4, C.b₂, 2 * C.b₄, C.b₆⟩
+
+lemma two_torsion_polynomial_disc : C.two_torsion_polynomial.disc = 16 * C.Δ :=
+by { dsimp [two_torsion_polynomial, cubic.disc], ring1 }
+
+lemma two_torsion_polynomial_disc_is_unit [invertible (2 : R)] :
+  is_unit C.two_torsion_polynomial.disc ↔ is_unit C.Δ :=
+begin
+  rw [two_torsion_polynomial_disc, is_unit.mul_iff, show (16 : R) = 2 ^ 4, by norm_num1],
+  exact and_iff_right (is_unit_of_invertible $ 2 ^ 4)
+end
+
+end torsion_polynomial
+
+end weierstrass_curve
+
+/-! ## Elliptic curves -/
+
+/-- An elliptic curve over a commutative ring. Note that this definition is only mathematically
+accurate for certain rings whose Picard group has trivial 12-torsion, such as a field or a PID. -/
+@[ext] structure elliptic_curve (R : Type u) [comm_ring R] extends weierstrass_curve R :=
+(Δ' : Rˣ) (coe_Δ' : ↑Δ' = to_weierstrass_curve.Δ)
+
+instance : inhabited $ elliptic_curve ℚ :=
+⟨⟨⟨0, 0, 1, -1, 0⟩, ⟨37, 37⁻¹, by norm_num1, by norm_num1⟩, by { dsimp, ring1 }⟩⟩
+
+namespace elliptic_curve
+
+variables [comm_ring R] (E : elliptic_curve R)
+
+/-- The j-invariant `j` of an elliptic curve, which is invariant under isomorphisms over `R`. -/
+@[simp] def j : R := ↑E.Δ'⁻¹ * E.c₄ ^ 3
+
+lemma two_torsion_polynomial.disc_ne_zero [nontrivial R] [invertible (2 : R)] :
+  E.two_torsion_polynomial.disc ≠ 0 :=
+(E.two_torsion_polynomial_disc_is_unit.mpr $ E.coe_Δ' ▸ E.Δ'.is_unit).ne_zero
+
+section variable_change
+
+/-! ### Variable changes -/
+
+variables (u : Rˣ) (r s t : R)
+
+/-- The elliptic curve over `R` induced by an admissible linear change of variables
+$(x, y) \mapsto (u^2x + r, u^3y + u^2sx + t)$ for some $u \in R^\times$ and some $r, s, t \in R$.
+When `R` is a field, any two Weierstrass equations isomorphic to `E` are related by this. -/
+@[simps] def variable_change : elliptic_curve R :=
+⟨E.variable_change u r s t, u⁻¹ ^ 12 * E.Δ',
+by rw [units.coe_mul, units.coe_pow, coe_Δ', E.variable_change_Δ]⟩
+
+lemma coe_variable_change_Δ' : (↑(E.variable_change u r s t).Δ' : R) = ↑u⁻¹ ^ 12 * E.Δ' :=
+by rw [variable_change_Δ', units.coe_mul, units.coe_pow]
+
+lemma coe_variable_change_Δ'_inv :
+  (↑(E.variable_change u r s t).Δ'⁻¹ : R) = u ^ 12 * ↑E.Δ'⁻¹ :=
+by rw [variable_change_Δ', mul_inv, inv_pow, inv_inv, units.coe_mul, units.coe_pow]
+
+@[simp] lemma variable_change_j : (E.variable_change u r s t).j = E.j :=
+begin
+  rw [j, coe_variable_change_Δ'_inv],
+  have hu : (u * ↑u⁻¹ : R) ^ 12 = 1 := by rw [u.mul_inv, one_pow],
+  linear_combination E.j * hu with { normalization_tactic := `[dsimp, ring1] }
+end
+
+end variable_change
+
+section base_change
+
+/-! ### Base changes -/
+
+variables (A : Type v) [comm_ring A] [algebra R A]
+
+/-- The elliptic curve over `R` base changed to `A`. -/
+@[simps] def base_change : elliptic_curve A :=
+⟨E.base_change A, units.map ↑(algebra_map R A) E.Δ',
+by rw [units.coe_map, ring_hom.coe_monoid_hom, coe_Δ', E.base_change_Δ]⟩
+
+lemma coe_base_change_Δ' : ↑(E.base_change A).Δ' = algebra_map R A E.Δ' := rfl
+
+lemma coe_base_change_Δ'_inv : ↑(E.base_change A).Δ'⁻¹ = algebra_map R A ↑E.Δ'⁻¹ := rfl
+
+@[simp] lemma base_change_j : (E.base_change A).j = algebra_map R A E.j :=
+by { simp only [j, coe_base_change_Δ'_inv, base_change_to_weierstrass_curve, E.base_change_c₄],
+     map_simp }
+
+end base_change
+
+end elliptic_curve
diff --git a/src/algebraic_geometry/function_field.lean b/src/algebraic_geometry/function_field.lean
index 838621d04d50b..a56d5c1e1635c 100644
--- a/src/algebraic_geometry/function_field.lean
+++ b/src/algebraic_geometry/function_field.lean
@@ -54,7 +54,7 @@ begin
   replace ha := ne_of_apply_ne _ ha,
   have hs : generic_point X.carrier ∈ RingedSpace.basic_open _ s,
   { rw [← opens.mem_coe, (generic_point_spec X.carrier).mem_open_set_iff, set.top_eq_univ,
-      set.univ_inter, ← set.ne_empty_iff_nonempty, ne.def, ← opens.coe_bot,
+      set.univ_inter, set.nonempty_iff_ne_empty, ne.def, ← opens.coe_bot,
       subtype.coe_injective.eq_iff, ← opens.empty_eq],
     erw basic_open_eq_bot_iff,
     exacts [ha, (RingedSpace.basic_open _ _).prop] },
diff --git a/src/algebraic_geometry/morphisms/open_immersion.lean b/src/algebraic_geometry/morphisms/open_immersion.lean
new file mode 100644
index 0000000000000..1294196c149bf
--- /dev/null
+++ b/src/algebraic_geometry/morphisms/open_immersion.lean
@@ -0,0 +1,101 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import algebraic_geometry.morphisms.ring_hom_properties
+import topology.local_at_target
+
+/-!
+
+# Open immersions
+
+A morphism is an open immersions if the underlying map of spaces is an open embedding
+`f : X ⟶ U ⊆ Y`, and the sheaf map `Y(V) ⟶ f _* X(V)` is an iso for each `V ⊆ U`.
+
+Most of the theories are developed in `algebraic_geometry/open_immersion`, and we provide the
+remaining theorems analogous to other lemmas in `algebraic_geometry/morphisms/*`.
+
+-/
+
+noncomputable theory
+
+open category_theory category_theory.limits opposite topological_space
+
+universe u
+
+namespace algebraic_geometry
+
+variables {X Y Z : Scheme.{u}} (f : X ⟶ Y) (g : Y ⟶ Z)
+
+lemma is_open_immersion_iff_stalk {f : X ⟶ Y} :
+  is_open_immersion f ↔
+    open_embedding f.1.base ∧ ∀ x, is_iso (PresheafedSpace.stalk_map f.1 x) :=
+begin
+  split,
+  { intro h, exactI ⟨h.1, infer_instance⟩ },
+  { rintro ⟨h₁, h₂⟩, exactI is_open_immersion.of_stalk_iso f h₁ }
+end
+
+lemma is_open_immersion_stable_under_composition :
+  morphism_property.stable_under_composition @is_open_immersion :=
+begin
+  introsI X Y Z f g h₁ h₂, apply_instance
+end
+
+lemma is_open_immersion_respects_iso :
+  morphism_property.respects_iso @is_open_immersion :=
+begin
+  apply is_open_immersion_stable_under_composition.respects_iso,
+  intros _ _ _, apply_instance
+end
+
+lemma is_open_immersion_is_local_at_target : property_is_local_at_target @is_open_immersion :=
+begin
+  constructor,
+  { exact is_open_immersion_respects_iso },
+  { introsI, apply_instance },
+  { intros X Y f 𝒰 H,
+    rw is_open_immersion_iff_stalk,
+    split,
+    { apply (open_embedding_iff_open_embedding_of_supr_eq_top
+        𝒰.supr_opens_range f.1.base.2).mpr,
+      intro i,
+      have := ((is_open_immersion_respects_iso.arrow_iso_iff
+        (morphism_restrict_opens_range f (𝒰.map i))).mpr (H i)).1,
+      rwa [arrow.mk_hom, morphism_restrict_val_base] at this },
+    { intro x,
+      have := arrow.iso_w (morphism_restrict_stalk_map f ((𝒰.map $ 𝒰.f $ f.1 x).opens_range)
+        ⟨x, 𝒰.covers _⟩),
+      dsimp only [arrow.mk_hom] at this,
+      rw this,
+      haveI : is_open_immersion (f ∣_ (𝒰.map $ 𝒰.f $ f.1 x).opens_range) :=
+        (is_open_immersion_respects_iso.arrow_iso_iff
+          (morphism_restrict_opens_range f (𝒰.map _))).mpr (H _),
+      apply_instance } }
+end
+
+lemma is_open_immersion.open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) :
+  tfae [is_open_immersion f,
+    ∃ (𝒰 : Scheme.open_cover.{u} Y), ∀ (i : 𝒰.J),
+      is_open_immersion (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
+    ∀ (𝒰 : Scheme.open_cover.{u} Y) (i : 𝒰.J),
+      is_open_immersion (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
+    ∀ (U : opens Y.carrier), is_open_immersion (f ∣_ U),
+    ∀ {U : Scheme} (g : U ⟶ Y) [is_open_immersion g],
+      is_open_immersion (pullback.snd : pullback f g ⟶ _),
+    ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤),
+      ∀ i, is_open_immersion (f ∣_ (U i))] :=
+is_open_immersion_is_local_at_target.open_cover_tfae f
+
+lemma is_open_immersion.open_cover_iff {X Y : Scheme.{u}}
+  (𝒰 : Scheme.open_cover.{u} Y) (f : X ⟶ Y) :
+  is_open_immersion f ↔ ∀ i, is_open_immersion (pullback.snd : pullback f (𝒰.map i) ⟶ _) :=
+is_open_immersion_is_local_at_target.open_cover_iff f 𝒰
+
+lemma is_open_immersion_stable_under_base_change :
+  morphism_property.stable_under_base_change @is_open_immersion :=
+morphism_property.stable_under_base_change.mk is_open_immersion_respects_iso $
+  by { introsI X Y Z f g H, apply_instance }
+
+end algebraic_geometry
diff --git a/src/algebraic_geometry/open_immersion.lean b/src/algebraic_geometry/open_immersion.lean
index eb639a052a509..92f56540532a7 100644
--- a/src/algebraic_geometry/open_immersion.lean
+++ b/src/algebraic_geometry/open_immersion.lean
@@ -11,6 +11,7 @@ import algebraic_geometry.Scheme
 import category_theory.limits.shapes.strict_initial
 import category_theory.limits.shapes.comm_sq
 import algebra.category.Ring.instances
+import topology.local_at_target
 
 /-!
 # Open immersions of structured spaces
@@ -1951,6 +1952,10 @@ lemma morphism_restrict_base_coe {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carri
   @coe U Y.carrier _ ((f ∣_ U).1.base x) = f.1.base x.1 :=
 congr_arg (λ f, PresheafedSpace.hom.base (LocallyRingedSpace.hom.val f) x) (morphism_restrict_ι f U)
 
+lemma morphism_restrict_val_base {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) :
+  ⇑(f ∣_ U).1.base = U.1.restrict_preimage f.1.base :=
+funext (λ x, subtype.ext (morphism_restrict_base_coe f U x))
+
 lemma image_morphism_restrict_preimage {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier)
   (V : opens U) :
   ((opens.map f.val.base).obj U).open_embedding.is_open_map.functor.obj
@@ -2067,6 +2072,31 @@ begin
   exact Y.basic_open_le r
 end
 
+/--
+The stalk map of a restriction of a morphism is isomorphic to the stalk map of the original map.
+-/
+def morphism_restrict_stalk_map {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) (x) :
+  arrow.mk (PresheafedSpace.stalk_map (f ∣_ U).1 x) ≅
+    arrow.mk (PresheafedSpace.stalk_map f.1 x.1) :=
+begin
+  fapply arrow.iso_mk',
+  { refine Y.restrict_stalk_iso U.open_embedding ((f ∣_ U).1 x) ≪≫ Top.presheaf.stalk_congr _ _,
+    apply inseparable.of_eq,
+    exact morphism_restrict_base_coe f U x },
+  { exact X.restrict_stalk_iso _ _ },
+  { apply Top.presheaf.stalk_hom_ext,
+    intros V hxV,
+    simp only [Top.presheaf.stalk_congr_hom, category_theory.category.assoc,
+      category_theory.iso.trans_hom],
+    erw PresheafedSpace.restrict_stalk_iso_hom_eq_germ_assoc,
+    erw PresheafedSpace.stalk_map_germ_assoc _ _ ⟨_, _⟩,
+    rw [Top.presheaf.germ_stalk_specializes'_assoc],
+    erw PresheafedSpace.stalk_map_germ _ _ ⟨_, _⟩,
+    erw PresheafedSpace.restrict_stalk_iso_hom_eq_germ,
+    rw [morphism_restrict_c_app, category.assoc, Top.presheaf.germ_res],
+    refl }
+end
+
 instance {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) [is_open_immersion f] :
   is_open_immersion (f ∣_ U) :=
 by { delta morphism_restrict, apply_instance }
diff --git a/src/algebraic_geometry/prime_spectrum/basic.lean b/src/algebraic_geometry/prime_spectrum/basic.lean
index 19489e8ab4019..ba43a6c38d108 100644
--- a/src/algebraic_geometry/prime_spectrum/basic.lean
+++ b/src/algebraic_geometry/prime_spectrum/basic.lean
@@ -260,9 +260,8 @@ begin
   split,
   { contrapose!,
     intro h,
-    apply set.ne_empty_iff_nonempty.mpr,
     rcases ideal.exists_le_maximal I h with ⟨M, hM, hIM⟩,
-    exact ⟨⟨M, hM.is_prime⟩, hIM⟩ },
+    exact set.nonempty.ne_empty ⟨⟨M, hM.is_prime⟩, hIM⟩ },
   { rintro rfl, apply zero_locus_empty_of_one_mem, trivial }
 end
 
@@ -458,7 +457,7 @@ lemma is_irreducible_zero_locus_iff_of_radical (I : ideal R) (hI : I.is_radical)
 begin
   rw [ideal.is_prime_iff, is_irreducible],
   apply and_congr,
-  { rw [← set.ne_empty_iff_nonempty, ne.def, zero_locus_empty_iff_eq_top] },
+  { rw [set.nonempty_iff_ne_empty, ne.def, zero_locus_empty_iff_eq_top] },
   { transitivity ∀ (x y : ideal R), Z(I) ⊆ Z(x) ∪ Z(y) → Z(I) ⊆ Z(x) ∨ Z(I) ⊆ Z(y),
     { simp_rw [is_preirreducible_iff_closed_union_closed, is_closed_iff_zero_locus_ideal],
       split,
diff --git a/src/algebraic_geometry/projective_spectrum/topology.lean b/src/algebraic_geometry/projective_spectrum/topology.lean
index f215ce5fce059..dfd2ee4a7847e 100644
--- a/src/algebraic_geometry/projective_spectrum/topology.lean
+++ b/src/algebraic_geometry/projective_spectrum/topology.lean
@@ -32,8 +32,7 @@ It is naturally endowed with a topology: the Zariski topology.
   `projective_spectrum 𝒜` is the intersection of points in `t` (viewed as relevant homogeneous prime
   ideals).
 * `projective_spectrum.Top`: the topological space of `projective_spectrum 𝒜` endowed with the
-  Zariski topology
-
+  Zariski topology.
 -/
 
 noncomputable theory
@@ -44,41 +43,24 @@ variables {R A: Type*}
 variables [comm_semiring R] [comm_ring A] [algebra R A]
 variables (𝒜 : ℕ → submodule R A) [graded_algebra 𝒜]
 
-/--
-The projective spectrum of a graded commutative ring is the subtype of all homogenous ideals that
-are prime and do not contain the irrelevant ideal.
--/
-@[nolint has_nonempty_instance]
-def projective_spectrum :=
-{I : homogeneous_ideal 𝒜 // I.to_ideal.is_prime ∧ ¬(homogeneous_ideal.irrelevant 𝒜 ≤ I)}
-
-namespace projective_spectrum
+/-- The projective spectrum of a graded commutative ring is the subtype of all homogenous ideals
+that are prime and do not contain the irrelevant ideal. -/
+@[ext, nolint has_nonempty_instance] structure projective_spectrum :=
+(as_homogeneous_ideal : homogeneous_ideal 𝒜)
+(is_prime : as_homogeneous_ideal.to_ideal.is_prime)
+(not_irrelevant_le : ¬(homogeneous_ideal.irrelevant 𝒜 ≤ as_homogeneous_ideal))
 
+attribute [instance] projective_spectrum.is_prime
 
-variable {𝒜}
-/-- A method to view a point in the projective spectrum of a graded ring
-as a homogeneous ideal of that ring. -/
-abbreviation as_homogeneous_ideal (x : projective_spectrum 𝒜) : homogeneous_ideal 𝒜 := x.1
-
-lemma as_homogeneous_ideal_def (x : projective_spectrum 𝒜) :
-  x.as_homogeneous_ideal = x.1 := rfl
-
-instance is_prime (x : projective_spectrum 𝒜) :
-  x.as_homogeneous_ideal.to_ideal.is_prime := x.2.1
-
-@[ext] lemma ext {x y : projective_spectrum 𝒜} :
-  x = y ↔ x.as_homogeneous_ideal = y.as_homogeneous_ideal :=
-subtype.ext_iff_val
+namespace projective_spectrum
 
-variable (𝒜)
-/-- The zero locus of a set `s` of elements of a commutative ring `A`
-is the set of all relevant homogeneous prime ideals of the ring that contain the set `s`.
+/-- The zero locus of a set `s` of elements of a commutative ring `A` is the set of all relevant
+homogeneous prime ideals of the ring that contain the set `s`.
 
 An element `f` of `A` can be thought of as a dependent function on the projective spectrum of `𝒜`.
-At a point `x` (a homogeneous prime ideal)
-the function (i.e., element) `f` takes values in the quotient ring `A` modulo the prime ideal `x`.
-In this manner, `zero_locus s` is exactly the subset of `projective_spectrum 𝒜`
-where all "functions" in `s` vanish simultaneously. -/
+At a point `x` (a homogeneous prime ideal) the function (i.e., element) `f` takes values in the
+quotient ring `A` modulo the prime ideal `x`. In this manner, `zero_locus s` is exactly the subset
+of `projective_spectrum 𝒜` where all "functions" in `s` vanish simultaneously. -/
 def zero_locus (s : set A) : set (projective_spectrum 𝒜) :=
 {x | s ⊆ x.as_homogeneous_ideal}
 
@@ -90,15 +72,13 @@ def zero_locus (s : set A) : set (projective_spectrum 𝒜) :=
 by { ext x, exact (submodule.gi _ _).gc s x.as_homogeneous_ideal.to_ideal }
 
 variable {𝒜}
-/-- The vanishing ideal of a set `t` of points
-of the prime spectrum of a commutative ring `R`
-is the intersection of all the prime ideals in the set `t`.
+/-- The vanishing ideal of a set `t` of points of the projective spectrum of a commutative ring `R`
+is the intersection of all the relevant homogeneous prime ideals in the set `t`.
 
 An element `f` of `A` can be thought of as a dependent function on the projective spectrum of `𝒜`.
-At a point `x` (a homogeneous prime ideal)
-the function (i.e., element) `f` takes values in the quotient ring `A` modulo the prime ideal `x`.
-In this manner, `vanishing_ideal t` is exactly the ideal of `A`
-consisting of all "functions" that vanish on all of `t`. -/
+At a point `x` (a homogeneous prime ideal) the function (i.e., element) `f` takes values in the
+quotient ring `A` modulo the prime ideal `x`. In this manner, `vanishing_ideal t` is exactly the
+ideal of `A` consisting of all "functions" that vanish on all of `t`. -/
 def vanishing_ideal (t : set (projective_spectrum 𝒜)) : homogeneous_ideal 𝒜 :=
 ⨅ (x : projective_spectrum 𝒜) (h : x ∈ t), x.as_homogeneous_ideal
 
@@ -253,7 +233,7 @@ by convert (gc_ideal 𝒜).u_infi; exact homogeneous_ideal.to_ideal_infi _
 
 lemma zero_locus_inf (I J : ideal A) :
   zero_locus 𝒜 ((I ⊓ J : ideal A) : set A) = zero_locus 𝒜 I ∪ zero_locus 𝒜 J :=
-set.ext $ λ x, x.2.1.inf_le
+set.ext $ λ x, x.is_prime.inf_le
 
 lemma union_zero_locus (s s' : set A) :
   zero_locus 𝒜 s ∪ zero_locus 𝒜 s' = zero_locus 𝒜 ((ideal.span s) ⊓ (ideal.span s'): ideal A) :=
@@ -261,19 +241,19 @@ by { rw zero_locus_inf, simp }
 
 lemma zero_locus_mul_ideal (I J : ideal A) :
   zero_locus 𝒜 ((I * J : ideal A) : set A) = zero_locus 𝒜 I ∪ zero_locus 𝒜 J :=
-set.ext $ λ x, x.2.1.mul_le
+set.ext $ λ x, x.is_prime.mul_le
 
 lemma zero_locus_mul_homogeneous_ideal (I J : homogeneous_ideal 𝒜) :
   zero_locus 𝒜 ((I * J : homogeneous_ideal 𝒜) : set A) = zero_locus 𝒜 I ∪ zero_locus 𝒜 J :=
-set.ext $ λ x, x.2.1.mul_le
+set.ext $ λ x, x.is_prime.mul_le
 
 lemma zero_locus_singleton_mul (f g : A) :
   zero_locus 𝒜 ({f * g} : set A) = zero_locus 𝒜 {f} ∪ zero_locus 𝒜 {g} :=
-set.ext $ λ x, by simpa using x.2.1.mul_mem_iff_mem_or_mem
+set.ext $ λ x, by simpa using x.is_prime.mul_mem_iff_mem_or_mem
 
 @[simp] lemma zero_locus_singleton_pow (f : A) (n : ℕ) (hn : 0 < n) :
   zero_locus 𝒜 ({f ^ n} : set A) = zero_locus 𝒜 {f} :=
-set.ext $ λ x, by simpa using x.2.1.pow_mem_iff_mem n hn
+set.ext $ λ x, by simpa using x.is_prime.pow_mem_iff_mem n hn
 
 lemma sup_vanishing_ideal_le (t t' : set (projective_spectrum 𝒜)) :
   vanishing_ideal t ⊔ vanishing_ideal t' ≤ vanishing_ideal (t ∩ t') :=
@@ -290,9 +270,8 @@ lemma mem_compl_zero_locus_iff_not_mem {f : A} {I : projective_spectrum 𝒜} :
   I ∈ (zero_locus 𝒜 {f} : set (projective_spectrum 𝒜))ᶜ ↔ f ∉ I.as_homogeneous_ideal :=
 by rw [set.mem_compl_iff, mem_zero_locus, set.singleton_subset_iff]; refl
 
-/-- The Zariski topology on the prime spectrum of a commutative ring
-is defined via the closed sets of the topology:
-they are exactly those sets that are the zero locus of a subset of the ring. -/
+/-- The Zariski topology on the prime spectrum of a commutative ring is defined via the closed sets
+of the topology: they are exactly those sets that are the zero locus of a subset of the ring. -/
 instance zariski_topology : topological_space (projective_spectrum 𝒜) :=
 topological_space.of_closed (set.range (projective_spectrum.zero_locus 𝒜))
   (⟨set.univ, by simp⟩)
@@ -306,9 +285,7 @@ topological_space.of_closed (set.range (projective_spectrum.zero_locus 𝒜))
   end
   (by { rintros _ ⟨s, rfl⟩ _ ⟨t, rfl⟩, exact ⟨_, (union_zero_locus 𝒜 s t).symm⟩ })
 
-/--
-The underlying topology of `Proj` is the projective spectrum of graded ring `A`.
--/
+/-- The underlying topology of `Proj` is the projective spectrum of graded ring `A`. -/
 def Top : Top := Top.of (projective_spectrum 𝒜)
 
 lemma is_open_iff (U : set (projective_spectrum 𝒜)) :
@@ -428,15 +405,15 @@ where `x ≤ y` if and only if `y ∈ closure {x}`.
 -/
 
 instance : partial_order (projective_spectrum 𝒜) :=
-subtype.partial_order _
+partial_order.lift as_homogeneous_ideal $ λ ⟨_, _, _⟩ ⟨_, _, _⟩, mk.inj_eq.mpr
 
 @[simp] lemma as_ideal_le_as_ideal (x y : projective_spectrum 𝒜) :
   x.as_homogeneous_ideal ≤ y.as_homogeneous_ideal ↔ x ≤ y :=
-subtype.coe_le_coe
+iff.rfl
 
 @[simp] lemma as_ideal_lt_as_ideal (x y : projective_spectrum 𝒜) :
   x.as_homogeneous_ideal < y.as_homogeneous_ideal ↔ x < y :=
-subtype.coe_lt_coe
+iff.rfl
 
 lemma le_iff_mem_closure (x y : projective_spectrum 𝒜) :
   x ≤ y ↔ y ∈ closure ({x} : set (projective_spectrum 𝒜)) :=
diff --git a/src/algebraic_geometry/properties.lean b/src/algebraic_geometry/properties.lean
index 48bbb2f1e03d3..52d00b6bfb420 100644
--- a/src/algebraic_geometry/properties.lean
+++ b/src/algebraic_geometry/properties.lean
@@ -267,20 +267,23 @@ end
 lemma is_integral_of_is_irreducible_is_reduced [is_reduced X] [H : irreducible_space X.carrier] :
   is_integral X :=
 begin
-  split, refine λ U hU, ⟨λ a b e, _,
-    (@@LocallyRingedSpace.component_nontrivial X.to_LocallyRingedSpace U hU).1⟩,
-  simp_rw [← basic_open_eq_bot_iff, ← opens.not_nonempty_iff_eq_bot],
-  by_contra' h,
-  obtain ⟨_, ⟨x, hx₁, rfl⟩, ⟨x, hx₂, e'⟩⟩ := @@nonempty_preirreducible_inter _ H.1
-    (X.basic_open a).2 (X.basic_open b).2
-    h.1 h.2,
-  replace e' := subtype.eq e',
-  subst e',
-  replace e := congr_arg (X.presheaf.germ x) e,
-  rw [ring_hom.map_mul, ring_hom.map_zero] at e,
-  refine zero_ne_one' (X.presheaf.stalk x.1) (is_unit_zero_iff.1 _),
-  convert hx₁.mul hx₂,
-  exact e.symm
+  split, intros U hU,
+  haveI := (@@LocallyRingedSpace.component_nontrivial X.to_LocallyRingedSpace U hU).1,
+  haveI : no_zero_divisors
+    (X.to_LocallyRingedSpace.to_SheafedSpace.to_PresheafedSpace.presheaf.obj (op U)),
+  { refine ⟨λ a b e, _⟩,
+    simp_rw [← basic_open_eq_bot_iff, ← opens.not_nonempty_iff_eq_bot],
+    by_contra' h,
+    obtain ⟨_, ⟨x, hx₁, rfl⟩, ⟨x, hx₂, e'⟩⟩ := @@nonempty_preirreducible_inter _ H.1
+      (X.basic_open a).2 (X.basic_open b).2 h.1 h.2,
+    replace e' := subtype.eq e',
+    subst e',
+    replace e := congr_arg (X.presheaf.germ x) e,
+    rw [ring_hom.map_mul, ring_hom.map_zero] at e,
+    refine zero_ne_one' (X.presheaf.stalk x.1) (is_unit_zero_iff.1 _),
+    convert hx₁.mul hx₂,
+    exact e.symm },
+  exact no_zero_divisors.to_is_domain _
 end
 
 lemma is_integral_iff_is_irreducible_and_is_reduced :
diff --git a/src/algebraic_geometry/structure_sheaf.lean b/src/algebraic_geometry/structure_sheaf.lean
index edae040d08332..236af107c5bda 100644
--- a/src/algebraic_geometry/structure_sheaf.lean
+++ b/src/algebraic_geometry/structure_sheaf.lean
@@ -876,7 +876,8 @@ begin
 end
 
 /-- The ring isomorphism between the ring `R` and the global sections `Γ(X, 𝒪ₓ)`. -/
-@[simps] def global_sections_iso : CommRing.of R ≅ (structure_sheaf R).1.obj (op ⊤) :=
+@[simps {rhs_md := tactic.transparency.semireducible}]
+def global_sections_iso : CommRing.of R ≅ (structure_sheaf R).1.obj (op ⊤) :=
 as_iso (to_open R ⊤)
 
 @[simp] lemma global_sections_iso_hom (R : CommRing) :
diff --git a/src/algebraic_topology/alternating_face_map_complex.lean b/src/algebraic_topology/alternating_face_map_complex.lean
index 9c05ce8e2a5c8..b2a46b05bfbea 100644
--- a/src/algebraic_topology/alternating_face_map_complex.lean
+++ b/src/algebraic_topology/alternating_face_map_complex.lean
@@ -8,6 +8,7 @@ import algebra.homology.additive
 import algebraic_topology.Moore_complex
 import algebra.big_operators.fin
 import category_theory.preadditive.opposite
+import category_theory.idempotents.functor_categories
 import tactic.equiv_rw
 
 /-!
@@ -34,7 +35,7 @@ when `A` is an abelian category.
 -/
 
 open category_theory category_theory.limits category_theory.subobject
-open category_theory.preadditive category_theory.category
+open category_theory.preadditive category_theory.category category_theory.idempotents
 open opposite
 
 open_locale big_operators
@@ -204,6 +205,15 @@ begin
       refl, }, },
 end
 
+lemma karoubi_alternating_face_map_complex_d (P : karoubi (simplicial_object C)) (n : ℕ) :
+  (((alternating_face_map_complex.obj (karoubi_functor_category_embedding.obj P)).d (n+1) n).f) =
+    P.p.app (op [n+1]) ≫ ((alternating_face_map_complex.obj P.X).d (n+1) n) :=
+begin
+  dsimp,
+  simpa only [alternating_face_map_complex.obj_d_eq, karoubi.sum_hom,
+    preadditive.comp_sum, karoubi.zsmul_hom, preadditive.comp_zsmul],
+end
+
 namespace alternating_face_map_complex
 
 /-- The natural transformation which gives the augmentation of the alternating face map
diff --git a/src/algebraic_topology/dold_kan/functor_gamma.lean b/src/algebraic_topology/dold_kan/functor_gamma.lean
index 6cee23ab0cb25..b35bc252de1e6 100644
--- a/src/algebraic_topology/dold_kan/functor_gamma.lean
+++ b/src/algebraic_topology/dold_kan/functor_gamma.lean
@@ -10,28 +10,27 @@ import algebraic_topology.dold_kan.split_simplicial_object
 
 # Construction of the inverse functor of the Dold-Kan equivalence
 
-@TODO @joelriou: construct the functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`
+
+In this file, we construct the functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`
 which shall be the inverse functor of the Dold-Kan equivalence in the case of abelian categories,
-and more generally pseudoabelian categories. Extend this functor `Γ₀` as a functor
-`Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C)` on the idempotent
-completion, show that this functor shall be an equivalence of categories when `C` is any additive
-category.
-
-Currently, this file contains the definition of `Γ₀.obj.obj₂ K Δ` for
-`K : chain_complex C ℕ` and `Δ : simplex_categoryᵒᵖ`. By definition, `Γ₀.obj.obj₂ K Δ`
-is a certain coproduct indexed by the set `splitting.index_set Δ` whose elements
-consists of epimorphisms `e : Δ.unop ⟶ Δ'.unop` (with `Δ' : simplex_categoryᵒᵖ`).
-Some morphisms between the summands of these coproducts are also studied.
-When the simplicial operations are defined using the epi-mono factorisations in
-`simplex_category`, the simplicial object `Γ₀.obj K` we get will be a split simplicial object.
+and more generally pseudoabelian categories.
+
+By definition, when `K` is a chain_complex, `Γ₀.obj K` is a simplicial object which
+sends `Δ : simplex_categoryᵒᵖ` to a certain coproduct indexed by the set
+`splitting.index_set Δ` whose elements consists of epimorphisms `e : Δ.unop ⟶ Δ'.unop`
+(with `Δ' : simplex_categoryᵒᵖ`); the summand attached to such an `e` is `K.X Δ'.unop.len`.
+By construction, `Γ₀.obj K` is a split simplicial object whose splitting is `Γ₀.splitting K`.
+
+We also construct `Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C)`
+which shall be an equivalence for any additive category `C`.
 
 -/
 
 noncomputable theory
 
 open category_theory category_theory.category category_theory.limits
-  simplex_category simplicial_object
-open_locale simplicial
+  simplex_category simplicial_object opposite category_theory.idempotents
+open_locale simplicial dold_kan
 
 namespace algebraic_topology
 
@@ -168,10 +167,196 @@ end
 
 end termwise
 
+variable [has_finite_coproducts C]
+
+/-- The simplicial morphism on the simplicial object `Γ₀.obj K` induced by
+a morphism `Δ' → Δ` in `simplex_category` is defined on each summand
+associated to an `A : Γ_index_set Δ` in terms of the epi-mono factorisation
+of `θ ≫ A.e`. -/
+def map (K : chain_complex C ℕ) {Δ' Δ : simplex_categoryᵒᵖ} (θ : Δ ⟶ Δ') :
+  obj₂ K Δ ⟶ obj₂ K Δ' :=
+sigma.desc (λ A, termwise.map_mono K (image.ι (θ.unop ≫ A.e)) ≫
+  (sigma.ι (summand K Δ') (A.pull θ)))
+
+@[reassoc]
+lemma map_on_summand₀ {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) {θ : Δ ⟶ Δ'}
+  {Δ'' : simplex_category} {e : Δ'.unop ⟶ Δ''} {i : Δ'' ⟶ A.1.unop} [epi e] [mono i]
+  (fac : e ≫ i = θ.unop ≫ A.e) :
+  (sigma.ι (summand K Δ) A) ≫ map K θ =
+    termwise.map_mono K i ≫ sigma.ι (summand K Δ') (splitting.index_set.mk e) :=
+begin
+  simp only [map, colimit.ι_desc, cofan.mk_ι_app],
+  have h := simplex_category.image_eq fac,
+  unfreezingI { subst h, },
+  congr,
+  { exact simplex_category.image_ι_eq fac, },
+  { dsimp only [simplicial_object.splitting.index_set.pull],
+    congr,
+    exact simplex_category.factor_thru_image_eq fac, },
+end
+
+@[reassoc]
+lemma map_on_summand₀' {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) (θ : Δ ⟶ Δ') :
+  (sigma.ι (summand K Δ) A) ≫ map K θ =
+    termwise.map_mono K (image.ι (θ.unop ≫ A.e)) ≫ sigma.ι (summand K _) (A.pull θ) :=
+map_on_summand₀ K A (A.fac_pull θ)
+
 end obj
 
+variable [has_finite_coproducts C]
+
+/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, on objects. -/
+@[simps]
+def obj (K : chain_complex C ℕ) : simplicial_object C :=
+{ obj := λ Δ, obj.obj₂ K Δ,
+  map := λ Δ Δ' θ, obj.map K θ,
+  map_id' := λ Δ, begin
+    ext A,
+    cases A,
+    have fac : A.e ≫ 𝟙 A.1.unop = (𝟙 Δ).unop ≫ A.e := by rw [unop_id, comp_id, id_comp],
+    erw [obj.map_on_summand₀ K A fac, obj.termwise.map_mono_id, id_comp, comp_id],
+    unfreezingI { rcases A with ⟨Δ', ⟨e, he⟩⟩, },
+    refl,
+  end,
+  map_comp' := λ Δ'' Δ' Δ θ' θ, begin
+    ext A,
+    cases A,
+    have fac : θ.unop ≫ θ'.unop ≫ A.e = (θ' ≫ θ).unop ≫ A.e := by rw [unop_comp, assoc],
+    rw [← image.fac (θ'.unop ≫ A.e), ← assoc,
+      ← image.fac (θ.unop ≫ factor_thru_image (θ'.unop ≫ A.e)), assoc] at fac,
+    simpa only [obj.map_on_summand₀'_assoc K A θ', obj.map_on_summand₀' K _ θ,
+      obj.termwise.map_mono_comp_assoc, obj.map_on_summand₀ K A fac],
+  end }
+
+lemma splitting_map_eq_id (Δ : simplex_categoryᵒᵖ) :
+  (simplicial_object.splitting.map (Γ₀.obj K)
+    (λ (n : ℕ), sigma.ι (Γ₀.obj.summand K (op [n])) (splitting.index_set.id (op [n]))) Δ)
+    = 𝟙 _ :=
+begin
+  ext A,
+  discrete_cases,
+  induction Δ using opposite.rec,
+  induction Δ with n,
+  dsimp,
+  simp only [colimit.ι_desc, cofan.mk_ι_app, comp_id, Γ₀.obj_map],
+  rw [Γ₀.obj.map_on_summand₀ K
+    (simplicial_object.splitting.index_set.id A.1) (show A.e ≫ 𝟙 _ = A.e.op.unop ≫ 𝟙 _, by refl),
+    Γ₀.obj.termwise.map_mono_id, A.ext'],
+  apply id_comp,
+end
+
+/-- By construction, the simplicial `Γ₀.obj K` is equipped with a splitting. -/
+def splitting (K : chain_complex C ℕ) : simplicial_object.splitting (Γ₀.obj K) :=
+{ N := λ n, K.X n,
+  ι := λ n, sigma.ι (Γ₀.obj.summand K (op [n])) (splitting.index_set.id (op [n])),
+  map_is_iso' := λ Δ, begin
+    rw Γ₀.splitting_map_eq_id,
+    apply is_iso.id,
+  end, }
+
+@[simp]
+lemma splitting_iso_hom_eq_id (Δ : simplex_categoryᵒᵖ) : ((splitting K).iso Δ).hom = 𝟙 _ :=
+splitting_map_eq_id K Δ
+
+@[reassoc]
+lemma obj.map_on_summand {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) (θ : Δ ⟶ Δ')
+  {Δ'' : simplex_category}
+  {e : Δ'.unop ⟶ Δ''} {i : Δ'' ⟶ A.1.unop} [epi e] [mono i]
+  (fac : e ≫ i = θ.unop ≫ A.e) : (Γ₀.splitting K).ι_summand A ≫ (Γ₀.obj K).map θ =
+  Γ₀.obj.termwise.map_mono K i ≫ (Γ₀.splitting K).ι_summand (splitting.index_set.mk e) :=
+begin
+  dsimp only [simplicial_object.splitting.ι_summand,
+    simplicial_object.splitting.ι_coprod],
+  simp only [assoc, Γ₀.splitting_iso_hom_eq_id, id_comp, comp_id],
+  exact Γ₀.obj.map_on_summand₀ K A fac,
+end
+
+@[reassoc]
+lemma obj.map_on_summand' {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) (θ : Δ ⟶ Δ') :
+  (splitting K).ι_summand A ≫ (obj K).map θ =
+    obj.termwise.map_mono K (image.ι (θ.unop ≫ A.e)) ≫ (splitting K).ι_summand (A.pull θ) :=
+by { apply obj.map_on_summand, apply image.fac, }
+
+@[reassoc]
+lemma obj.map_mono_on_summand_id {Δ Δ' : simplex_category} (i : Δ' ⟶ Δ) [mono i] :
+  (splitting K).ι_summand (splitting.index_set.id (op Δ)) ≫ (obj K).map i.op =
+  obj.termwise.map_mono K i ≫ (splitting K).ι_summand (splitting.index_set.id (op Δ')) :=
+obj.map_on_summand K (splitting.index_set.id (op Δ)) i.op (rfl : 𝟙 _ ≫ i = i ≫ 𝟙 _)
+
+@[reassoc]
+lemma obj.map_epi_on_summand_id {Δ Δ' : simplex_category } (e : Δ' ⟶ Δ) [epi e] :
+  (Γ₀.splitting K).ι_summand (splitting.index_set.id (op Δ)) ≫ (Γ₀.obj K).map e.op =
+    (Γ₀.splitting K).ι_summand (splitting.index_set.mk e) :=
+by simpa only [Γ₀.obj.map_on_summand K (splitting.index_set.id (op Δ)) e.op
+    (rfl : e ≫ 𝟙 Δ = e ≫ 𝟙 Δ), Γ₀.obj.termwise.map_mono_id] using id_comp _
+
+/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, on morphisms. -/
+@[simps]
+def map {K K' : chain_complex C ℕ} (f : K ⟶ K') : obj K ⟶ obj K' :=
+{ app := λ Δ, (Γ₀.splitting K).desc Δ (λ A, f.f A.1.unop.len ≫ (Γ₀.splitting K').ι_summand A),
+  naturality' := λ Δ' Δ θ, begin
+    apply (Γ₀.splitting K).hom_ext',
+    intro A,
+    simp only [(splitting K).ι_desc_assoc, obj.map_on_summand'_assoc K _ θ,
+      (splitting K).ι_desc, assoc, obj.map_on_summand' K' _ θ],
+    apply obj.termwise.map_mono_naturality_assoc,
+  end, }
+
 end Γ₀
 
+variable [has_finite_coproducts C]
+
+/-- The functor `Γ₀' : chain_complex C ℕ ⥤ simplicial_object.split C`
+that induces `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, which
+shall be the inverse functor of the Dold-Kan equivalence for
+abelian or pseudo-abelian categories. -/
+@[simps]
+def Γ₀' : chain_complex C ℕ ⥤ simplicial_object.split C :=
+{ obj := λ K, simplicial_object.split.mk' (Γ₀.splitting K),
+  map := λ K K' f,
+  { F := Γ₀.map f,
+    f := f.f,
+    comm' := λ n, by { dsimp, simpa only [← splitting.ι_summand_id,
+      (Γ₀.splitting K).ι_desc], }, }, }
+
+/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, which is
+the inverse functor of the Dold-Kan equivalence when `C` is an abelian
+category, or more generally a pseudoabelian category. -/
+@[simps]
+def Γ₀ : chain_complex C ℕ ⥤ simplicial_object C := Γ₀' ⋙ split.forget _
+
+
+/-- The extension of `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`
+on the idempotent completions. It shall be an equivalence of categories
+for any additive category `C`. -/
+@[simps]
+def Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C) :=
+(category_theory.idempotents.functor_extension₂ _ _).obj Γ₀
+
+lemma higher_faces_vanish.on_Γ₀_summand_id (K : chain_complex C ℕ) (n : ℕ) :
+  higher_faces_vanish (n+1) ((Γ₀.splitting K).ι_summand (splitting.index_set.id (op [n+1]))) :=
+begin
+  intros j hj,
+  have eq := Γ₀.obj.map_mono_on_summand_id K (simplex_category.δ j.succ),
+  rw [Γ₀.obj.termwise.map_mono_eq_zero K, zero_comp] at eq, rotate,
+  { intro h,
+    exact (nat.succ_ne_self n) (congr_arg simplex_category.len h), },
+  { exact λ h, fin.succ_ne_zero j (by simpa only [is_δ₀.iff] using h), },
+  exact eq,
+end
+
+@[simp, reassoc]
+lemma P_infty_on_Γ₀_splitting_summand_eq_self
+  (K : chain_complex C ℕ) {n : ℕ} :
+  (Γ₀.splitting K).ι_summand (splitting.index_set.id (op [n])) ≫ (P_infty : K[Γ₀.obj K] ⟶ _).f n =
+    (Γ₀.splitting K).ι_summand (splitting.index_set.id (op [n])) :=
+begin
+  rw P_infty_f,
+  cases n,
+  { simpa only [P_f_0_eq] using comp_id _, },
+  { exact (higher_faces_vanish.on_Γ₀_summand_id K n).comp_P_eq_self, },
+end
+
 end dold_kan
 
 end algebraic_topology
diff --git a/src/algebraic_topology/dold_kan/gamma_comp_n.lean b/src/algebraic_topology/dold_kan/gamma_comp_n.lean
new file mode 100644
index 0000000000000..8d4a813f03d44
--- /dev/null
+++ b/src/algebraic_topology/dold_kan/gamma_comp_n.lean
@@ -0,0 +1,146 @@
+/-
+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 algebraic_topology.dold_kan.functor_gamma
+import category_theory.idempotents.homological_complex
+
+/-! The counit isomorphism of the Dold-Kan equivalence
+
+The purpose of this file is to construct natural isomorphisms
+`N₁Γ₀ : Γ₀ ⋙ N₁ ≅ to_karoubi (chain_complex C ℕ)`
+and `N₂Γ₂ : Γ₂ ⋙ N₂ ≅ 𝟭 (karoubi (chain_complex C ℕ))`.
+
+-/
+
+noncomputable theory
+
+open category_theory category_theory.category category_theory.limits category_theory.idempotents
+  opposite simplicial_object
+open_locale simplicial
+
+namespace algebraic_topology
+
+namespace dold_kan
+
+variables {C : Type*} [category C] [preadditive C] [has_finite_coproducts C]
+
+/-- The isomorphism  `(Γ₀.splitting K).nondeg_complex ≅ K` for all `K : chain_complex C ℕ`. -/
+@[simps]
+def Γ₀_nondeg_complex_iso (K : chain_complex C ℕ) : (Γ₀.splitting K).nondeg_complex ≅ K :=
+homological_complex.hom.iso_of_components (λ n, iso.refl _)
+begin
+  rintros _ n (rfl : n+1=_),
+  dsimp,
+  simp only [id_comp, comp_id, alternating_face_map_complex.obj_d_eq,
+    preadditive.sum_comp, preadditive.comp_sum],
+  rw fintype.sum_eq_single (0 : fin (n+2)),
+  { simp only [fin.coe_zero, pow_zero, one_zsmul],
+    erw [Γ₀.obj.map_mono_on_summand_id_assoc, Γ₀.obj.termwise.map_mono_δ₀,
+      splitting.ι_π_summand_eq_id, comp_id], },
+  { intros i hi,
+    dsimp,
+    simp only [preadditive.zsmul_comp, preadditive.comp_zsmul, assoc],
+    erw [Γ₀.obj.map_mono_on_summand_id_assoc, Γ₀.obj.termwise.map_mono_eq_zero,
+      zero_comp, zsmul_zero],
+    { intro h,
+      replace h := congr_arg simplex_category.len h,
+      change n+1 = n at h,
+      linarith, },
+    { simpa only [is_δ₀.iff] using hi, }, },
+end
+
+/-- The natural isomorphism `(Γ₀.splitting K).nondeg_complex ≅ K` for `K : chain_complex C ℕ`. -/
+def Γ₀'_comp_nondeg_complex_functor :
+  Γ₀' ⋙ split.nondeg_complex_functor ≅ 𝟭 (chain_complex C ℕ) :=
+nat_iso.of_components Γ₀_nondeg_complex_iso
+  (λ X Y f, by { ext n, dsimp, simp only [comp_id, id_comp], })
+
+/-- The natural isomorphism `Γ₀ ⋙ N₁ ≅ to_karoubi (chain_complex C ℕ)`. -/
+def N₁Γ₀ : Γ₀ ⋙ N₁ ≅ to_karoubi (chain_complex C ℕ) :=
+calc Γ₀ ⋙ N₁ ≅ Γ₀' ⋙ split.forget C ⋙ N₁ : functor.associator _ _ _
+... ≅ Γ₀' ⋙ split.nondeg_complex_functor ⋙ to_karoubi _ :
+  iso_whisker_left Γ₀' split.to_karoubi_nondeg_complex_functor_iso_N₁.symm
+... ≅ (Γ₀' ⋙ split.nondeg_complex_functor) ⋙ to_karoubi _ : (functor.associator _ _ _).symm
+... ≅ 𝟭 _ ⋙ to_karoubi (chain_complex C ℕ) : iso_whisker_right Γ₀'_comp_nondeg_complex_functor _
+... ≅ to_karoubi (chain_complex C ℕ) : functor.left_unitor _
+
+lemma N₁Γ₀_app (K : chain_complex C ℕ) :
+  N₁Γ₀.app K = (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.symm
+    ≪≫ (to_karoubi _).map_iso (Γ₀_nondeg_complex_iso K) :=
+begin
+  ext1,
+  dsimp [N₁Γ₀],
+  erw [id_comp, comp_id, comp_id],
+  refl,
+end
+
+lemma N₁Γ₀_hom_app (K : chain_complex C ℕ) :
+  N₁Γ₀.hom.app K = (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.inv
+    ≫ (to_karoubi _).map (Γ₀_nondeg_complex_iso K).hom :=
+by { change (N₁Γ₀.app K).hom = _, simpa only [N₁Γ₀_app], }
+
+lemma N₁Γ₀_inv_app (K : chain_complex C ℕ) :
+  N₁Γ₀.inv.app K = (to_karoubi _).map (Γ₀_nondeg_complex_iso K).inv ≫
+   (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.hom :=
+by { change (N₁Γ₀.app K).inv = _, simpa only [N₁Γ₀_app], }
+
+@[simp]
+lemma N₁Γ₀_hom_app_f_f (K : chain_complex C ℕ) (n : ℕ) :
+  (N₁Γ₀.hom.app K).f.f n = (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.inv.f.f n :=
+by { rw N₁Γ₀_hom_app, apply comp_id, }
+
+@[simp]
+lemma N₁Γ₀_inv_app_f_f (K : chain_complex C ℕ) (n : ℕ) :
+  (N₁Γ₀.inv.app K).f.f n = (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.hom.f.f n :=
+by { rw N₁Γ₀_inv_app, apply id_comp, }
+
+lemma N₂Γ₂_to_karoubi : to_karoubi (chain_complex C ℕ) ⋙ Γ₂ ⋙ N₂ = Γ₀ ⋙ N₁ :=
+begin
+  have h := functor.congr_obj (functor_extension₂_comp_whiskering_left_to_karoubi
+    (chain_complex C ℕ) (simplicial_object C)) Γ₀,
+  have h' := functor.congr_obj (functor_extension₁_comp_whiskering_left_to_karoubi
+    (simplicial_object C) (chain_complex C ℕ)) N₁,
+  dsimp [N₂, Γ₂, functor_extension₁] at h h' ⊢,
+  rw [← functor.assoc, h, functor.assoc, h'],
+end
+
+/-- Compatibility isomorphism between `to_karoubi _ ⋙ Γ₂ ⋙ N₂` and `Γ₀ ⋙ N₁` which
+are functors `chain_complex C ℕ ⥤ karoubi (chain_complex C ℕ)`. -/
+@[simps]
+def N₂Γ₂_to_karoubi_iso : to_karoubi (chain_complex C ℕ) ⋙ Γ₂ ⋙ N₂ ≅ Γ₀ ⋙ N₁ :=
+eq_to_iso (N₂Γ₂_to_karoubi)
+
+/-- The counit isomorphism of the Dold-Kan equivalence for additive categories. -/
+def N₂Γ₂ : Γ₂ ⋙ N₂ ≅ 𝟭 (karoubi (chain_complex C ℕ)) :=
+((whiskering_left _ _ _).obj (to_karoubi (chain_complex C ℕ))).preimage_iso
+  (N₂Γ₂_to_karoubi_iso ≪≫ N₁Γ₀)
+
+lemma N₂Γ₂_compatible_with_N₁Γ₀ (K : chain_complex C ℕ) :
+  N₂Γ₂.hom.app ((to_karoubi _).obj K) = N₂Γ₂_to_karoubi_iso.hom.app K ≫ N₁Γ₀.hom.app K :=
+congr_app (((whiskering_left _ _ (karoubi (chain_complex C ℕ ))).obj
+  (to_karoubi (chain_complex C ℕ))).image_preimage
+  (N₂Γ₂_to_karoubi_iso.hom ≫ N₁Γ₀.hom : _ ⟶ to_karoubi _ ⋙ 𝟭 _)) K
+
+@[simp]
+lemma N₂Γ₂_inv_app_f_f (X : karoubi (chain_complex C ℕ)) (n : ℕ) :
+  (N₂Γ₂.inv.app X).f.f n =
+    X.p.f n ≫ (Γ₀.splitting X.X).ι_summand (splitting.index_set.id (op [n])) :=
+begin
+  dsimp only [N₂Γ₂, functor.preimage_iso, iso.trans],
+  simp only [whiskering_left_obj_preimage_app, N₂Γ₂_to_karoubi_iso_inv, functor.id_map,
+    nat_trans.comp_app, eq_to_hom_app, functor.comp_map, assoc, karoubi.comp_f,
+    karoubi.eq_to_hom_f, eq_to_hom_refl, comp_id, karoubi.comp_p_assoc, N₂_map_f_f,
+    homological_complex.comp_f, N₁Γ₀_inv_app_f_f, P_infty_on_Γ₀_splitting_summand_eq_self_assoc,
+    splitting.to_karoubi_nondeg_complex_iso_N₁_hom_f_f, Γ₂_map_f_app, karoubi.decomp_id_p_f],
+  dsimp [to_karoubi],
+  rw [splitting.ι_desc],
+  dsimp [splitting.index_set.id],
+  rw karoubi.homological_complex.p_idem_assoc,
+end
+
+end dold_kan
+
+end algebraic_topology
diff --git a/src/algebraic_topology/dold_kan/n_comp_gamma.lean b/src/algebraic_topology/dold_kan/n_comp_gamma.lean
new file mode 100644
index 0000000000000..816749fc7e191
--- /dev/null
+++ b/src/algebraic_topology/dold_kan/n_comp_gamma.lean
@@ -0,0 +1,163 @@
+/-
+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 algebraic_topology.dold_kan.gamma_comp_n
+import algebraic_topology.dold_kan.n_reflects_iso
+
+/-! The unit isomorphism of the Dold-Kan equivalence
+
+In order to construct the unit isomorphism of the Dold-Kan equivalence,
+we first construct natural transformations
+`Γ₂N₁.nat_trans : N₁ ⋙ Γ₂ ⟶ to_karoubi (simplicial_object C)` and
+`Γ₂N₂.nat_trans : N₂ ⋙ Γ₂ ⟶ 𝟭 (simplicial_object C)` (TODO).
+It is then shown that `Γ₂N₂.nat_trans` is an isomorphism by using
+that it becomes an isomorphism after the application of the functor
+`N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)`
+which reflects isomorphisms.
+
+-/
+
+noncomputable theory
+
+open category_theory category_theory.category category_theory.limits
+  category_theory.idempotents simplex_category opposite simplicial_object
+open_locale simplicial dold_kan
+
+namespace algebraic_topology
+
+namespace dold_kan
+
+variables {C : Type*} [category C] [preadditive C]
+
+lemma P_infty_comp_map_mono_eq_zero (X : simplicial_object C) {n : ℕ}
+  {Δ' : simplex_category} (i : Δ' ⟶ [n]) [hi : mono i] (h₁ : Δ'.len ≠ n) (h₂ : ¬is_δ₀ i) :
+  P_infty.f n ≫ X.map i.op = 0 :=
+begin
+  unfreezingI { induction Δ' using simplex_category.rec with m, },
+  obtain ⟨k, hk⟩ := nat.exists_eq_add_of_lt (len_lt_of_mono i
+    (λ h, by { rw ← h at h₁,  exact h₁ rfl, })),
+  simp only [len_mk] at hk,
+  cases k,
+  { change n = m + 1 at hk,
+    unfreezingI { subst hk, obtain ⟨j, rfl⟩ := eq_δ_of_mono i, },
+    rw is_δ₀.iff at h₂,
+    have h₃ : 1 ≤ (j : ℕ),
+    { by_contra,
+      exact h₂ (by simpa only [fin.ext_iff, not_le, nat.lt_one_iff] using h), },
+    exact (higher_faces_vanish.of_P (m+1) m).comp_δ_eq_zero j h₂ (by linarith), },
+  { simp only [nat.succ_eq_add_one, ← add_assoc] at hk,
+    clear h₂ hi,
+    subst hk,
+    obtain ⟨j₁, i, rfl⟩ := eq_comp_δ_of_not_surjective i (λ h, begin
+      have h' := len_le_of_epi (simplex_category.epi_iff_surjective.2 h),
+      dsimp at h',
+      linarith,
+    end),
+    obtain ⟨j₂, i, rfl⟩ := eq_comp_δ_of_not_surjective i (λ h, begin
+      have h' := len_le_of_epi (simplex_category.epi_iff_surjective.2 h),
+      dsimp at h',
+      linarith,
+    end),
+    by_cases hj₁ : j₁ = 0,
+    { unfreezingI { subst hj₁, },
+      rw [assoc, ← simplex_category.δ_comp_δ'' (fin.zero_le _)],
+      simp only [op_comp, X.map_comp, assoc, P_infty_f],
+      erw [(higher_faces_vanish.of_P _ _).comp_δ_eq_zero_assoc _ j₂.succ_ne_zero, zero_comp],
+      rw fin.coe_succ,
+      linarith, },
+    { simp only [op_comp, X.map_comp, assoc, P_infty_f],
+      erw [(higher_faces_vanish.of_P _ _).comp_δ_eq_zero_assoc _ hj₁, zero_comp],
+      by_contra,
+      exact hj₁ (by { simp only [fin.ext_iff, fin.coe_zero], linarith, }), }, },
+end
+
+@[reassoc]
+lemma Γ₀_obj_termwise_map_mono_comp_P_infty (X : simplicial_object C) {Δ Δ' : simplex_category}
+  (i : Δ ⟶ Δ') [mono i] :
+  Γ₀.obj.termwise.map_mono (alternating_face_map_complex.obj X) i ≫ P_infty.f (Δ.len) =
+    P_infty.f (Δ'.len) ≫ X.map i.op :=
+begin
+  unfreezingI
+  { induction Δ using simplex_category.rec with n,
+    induction Δ' using simplex_category.rec with n', },
+  dsimp,
+  /- We start with the case `i` is an identity -/
+  by_cases n = n',
+  { unfreezingI { subst h, },
+    simp only [simplex_category.eq_id_of_mono i, Γ₀.obj.termwise.map_mono_id, op_id, X.map_id],
+    dsimp,
+    simp only [id_comp, comp_id], },
+  by_cases hi : is_δ₀ i,
+  /- The case `i = δ 0` -/
+  { have h' : n' = n + 1 := hi.left,
+    unfreezingI { subst h', },
+    simp only [Γ₀.obj.termwise.map_mono_δ₀' _ i hi],
+    dsimp,
+    rw [← P_infty.comm' _ n rfl, alternating_face_map_complex.obj_d_eq],
+    simp only [eq_self_iff_true, id_comp, if_true, preadditive.comp_sum],
+    rw finset.sum_eq_single (0 : fin (n+2)), rotate,
+    { intros b hb hb',
+      rw preadditive.comp_zsmul,
+      erw [P_infty_comp_map_mono_eq_zero X (simplex_category.δ b) h
+        (by { rw is_δ₀.iff, exact hb', }), zsmul_zero], },
+    { simp only [finset.mem_univ, not_true, is_empty.forall_iff], },
+    { simpa only [hi.eq_δ₀, fin.coe_zero, pow_zero, one_zsmul], }, },
+  /- The case `i ≠ δ 0` -/
+  { rw [Γ₀.obj.termwise.map_mono_eq_zero _ i _ hi, zero_comp], swap,
+    { by_contradiction h',
+      exact h (congr_arg simplex_category.len h'.symm), },
+    rw P_infty_comp_map_mono_eq_zero,
+    { exact h, },
+    { by_contradiction h',
+      exact hi h', }, },
+end
+
+variable [has_finite_coproducts C]
+
+namespace Γ₂N₁
+
+/-- The natural transformation `N₁ ⋙ Γ₂ ⟶ to_karoubi (simplicial_object C)`. -/
+@[simps]
+def nat_trans : (N₁ : simplicial_object C ⥤ _) ⋙ Γ₂ ⟶ to_karoubi _ :=
+{ app := λ X,
+  { f :=
+    { app := λ Δ, (Γ₀.splitting K[X]).desc Δ (λ A, P_infty.f A.1.unop.len ≫ X.map (A.e.op)),
+      naturality' := λ Δ Δ' θ, begin
+        apply (Γ₀.splitting K[X]).hom_ext',
+        intro A,
+        change _ ≫ (Γ₀.obj K[X]).map θ  ≫ _ = _,
+        simp only [splitting.ι_desc_assoc, assoc,
+          Γ₀.obj.map_on_summand'_assoc, splitting.ι_desc],
+        erw Γ₀_obj_termwise_map_mono_comp_P_infty_assoc X (image.ι (θ.unop ≫ A.e)),
+        dsimp only [to_karoubi],
+        simp only [← X.map_comp],
+        congr' 2,
+        simp only [eq_to_hom_refl, id_comp, comp_id, ← op_comp],
+        exact quiver.hom.unop_inj (A.fac_pull θ),
+      end, },
+    comm := begin
+      apply (Γ₀.splitting K[X]).hom_ext,
+      intro n,
+      dsimp [N₁],
+      simp only [← splitting.ι_summand_id, splitting.ι_desc,
+        comp_id, splitting.ι_desc_assoc, assoc, P_infty_f_idem_assoc],
+    end, },
+  naturality' := λ X Y f, begin
+    ext1,
+    apply (Γ₀.splitting K[X]).hom_ext,
+    intro n,
+    dsimp [N₁, to_karoubi],
+    simpa only [←splitting.ι_summand_id, splitting.ι_desc, splitting.ι_desc_assoc,
+      assoc, P_infty_f_idem_assoc, karoubi.comp_f, nat_trans.comp_app, Γ₂_map_f_app,
+      homological_complex.comp_f, alternating_face_map_complex.map_f,
+      P_infty_f_naturality_assoc, nat_trans.naturality],
+  end, }
+
+end Γ₂N₁
+
+end dold_kan
+
+end algebraic_topology
diff --git a/src/algebraic_topology/dold_kan/n_reflects_iso.lean b/src/algebraic_topology/dold_kan/n_reflects_iso.lean
index 48fc279d6716e..1dedf74b1765c 100644
--- a/src/algebraic_topology/dold_kan/n_reflects_iso.lean
+++ b/src/algebraic_topology/dold_kan/n_reflects_iso.lean
@@ -7,17 +7,16 @@ Authors: Joël Riou
 import algebraic_topology.dold_kan.functor_n
 import algebraic_topology.dold_kan.decomposition
 import category_theory.idempotents.homological_complex
+import category_theory.idempotents.karoubi_karoubi
 
 /-!
 
 # N₁ and N₂ reflects isomorphisms
 
-In this file, it is shown that the functor
-`N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)`
-reflects isomorphisms for any preadditive category `C`.
-
-TODO @joelriou: deduce that `N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)`
-also reflects isomorphisms.
+In this file, it is shown that the functors
+`N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)` and
+`N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ))`
+reflect isomorphisms for any preadditive category `C`.
 
 -/
 
@@ -46,7 +45,7 @@ instance : reflects_isomorphisms (N₁ : simplicial_object C ⥤ karoubi (chain_
   have h₁ := homological_complex.congr_hom (karoubi.hom_ext.mp (is_iso.hom_inv_id (N₁.map f))),
   have h₂ := homological_complex.congr_hom (karoubi.hom_ext.mp (is_iso.inv_hom_id (N₁.map f))),
   have h₃ := λ n, karoubi.homological_complex.p_comm_f_assoc (inv (N₁.map f)) (n) (f.app (op [n])),
-  simp only [N₁_map_f, karoubi.comp, homological_complex.comp_f,
+  simp only [N₁_map_f, karoubi.comp_f, homological_complex.comp_f,
     alternating_face_map_complex.map_f, N₁_obj_p, karoubi.id_eq, assoc] at h₁ h₂ h₃,
   /- we have to construct an inverse to f in degree n, by induction on n -/
   intro n,
@@ -69,6 +68,56 @@ instance : reflects_isomorphisms (N₁ : simplicial_object C ⥤ karoubi (chain_
     tauto, },
 end⟩
 
+lemma compatibility_N₂_N₁_karoubi :
+  N₂ ⋙ (karoubi_chain_complex_equivalence C ℕ).functor =
+  karoubi_functor_category_embedding simplex_categoryᵒᵖ C ⋙ N₁ ⋙
+  (karoubi_chain_complex_equivalence (karoubi C) ℕ).functor ⋙
+  functor.map_homological_complex (karoubi_karoubi.equivalence C).inverse _ :=
+begin
+  refine category_theory.functor.ext (λ P, _) (λ P Q f, _),
+  { refine homological_complex.ext _ _,
+    { ext n,
+      { dsimp,
+        simp only [karoubi_P_infty_f, comp_id, P_infty_f_naturality, id_comp], },
+      { refl, }, },
+    { rintros _ n (rfl : n+1 = _),
+      ext,
+      have h := (alternating_face_map_complex.map P.p).comm (n+1) n,
+      dsimp [N₂, karoubi_chain_complex_equivalence, karoubi_karoubi.inverse,
+        karoubi_homological_complex_equivalence.functor.obj] at ⊢ h,
+      simp only [karoubi.comp_f, assoc, karoubi.eq_to_hom_f, eq_to_hom_refl, id_comp, comp_id,
+        karoubi_alternating_face_map_complex_d, karoubi_P_infty_f,
+        ← homological_complex.hom.comm_assoc, ← h, app_idem_assoc], }, },
+  { ext n,
+    dsimp [karoubi_karoubi.inverse, karoubi_functor_category_embedding,
+      karoubi_functor_category_embedding.map],
+    simp only [karoubi.comp_f, karoubi_P_infty_f, homological_complex.eq_to_hom_f,
+      karoubi.eq_to_hom_f, assoc, comp_id, P_infty_f_naturality, app_p_comp,
+      karoubi_chain_complex_equivalence_functor_obj_X_p, N₂_obj_p_f, eq_to_hom_refl,
+      P_infty_f_naturality_assoc, app_comp_p, P_infty_f_idem_assoc], },
+end
+
+/-- We deduce that `N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ))`
+reflects isomorphisms from the fact that
+`N₁ : simplicial_object (karoubi C) ⥤ karoubi (chain_complex (karoubi C) ℕ)` does. -/
+instance : reflects_isomorphisms
+  (N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)) := ⟨λ X Y f,
+begin
+  introI,
+  -- The following functor `F` reflects isomorphism because it is
+  -- a composition of four functors which reflects isomorphisms.
+  -- Then, it suffices to show that `F.map f` is an isomorphism.
+  let F := karoubi_functor_category_embedding simplex_categoryᵒᵖ C ⋙ N₁ ⋙
+    (karoubi_chain_complex_equivalence (karoubi C) ℕ).functor ⋙
+    functor.map_homological_complex (karoubi_karoubi.equivalence C).inverse
+      (complex_shape.down ℕ),
+  haveI : is_iso (F.map f),
+  { dsimp only [F],
+    rw [← compatibility_N₂_N₁_karoubi, functor.comp_map],
+    apply functor.map_is_iso, },
+  exact is_iso_of_reflects_iso f F,
+end⟩
+
 end dold_kan
 
 end algebraic_topology
diff --git a/src/algebraic_topology/dold_kan/normalized.lean b/src/algebraic_topology/dold_kan/normalized.lean
index e6e55b3f70a4d..d7d0db4ea424c 100644
--- a/src/algebraic_topology/dold_kan/normalized.lean
+++ b/src/algebraic_topology/dold_kan/normalized.lean
@@ -128,12 +128,12 @@ def N₁_iso_normalized_Moore_complex_comp_to_karoubi :
   hom_inv_id' := begin
     ext X : 3,
     simp only [P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map,
-      nat_trans.comp_app, karoubi.comp, N₁_obj_p, nat_trans.id_app, karoubi.id_eq],
+      nat_trans.comp_app, karoubi.comp_f, N₁_obj_p, nat_trans.id_app, karoubi.id_eq],
   end,
   inv_hom_id' := begin
     ext X : 3,
     simp only [← cancel_mono (inclusion_of_Moore_complex_map X),
-      nat_trans.comp_app, karoubi.comp, assoc, nat_trans.id_app, karoubi.id_eq,
+      nat_trans.comp_app, karoubi.comp_f, assoc, nat_trans.id_app, karoubi.id_eq,
       P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map,
       inclusion_of_Moore_complex_map_comp_P_infty],
     dsimp only [functor.comp_obj, to_karoubi],
diff --git a/src/algebraic_topology/dold_kan/p_infty.lean b/src/algebraic_topology/dold_kan/p_infty.lean
index eef218719baea..9cd1e7881ba99 100644
--- a/src/algebraic_topology/dold_kan/p_infty.lean
+++ b/src/algebraic_topology/dold_kan/p_infty.lean
@@ -197,10 +197,10 @@ begin
   /- We use the three equalities h₃₂, h₄₃, h₁₄. -/
   rw [← h₃₂, ← h₄₃, h₁₄],
   simp only [karoubi_functor_category_embedding.map_app_f, karoubi.decomp_id_p_f,
-    karoubi.decomp_id_i_f, karoubi.comp],
+    karoubi.decomp_id_i_f, karoubi.comp_f],
   let π : Y₄ ⟶ Y₄ := (to_karoubi _ ⋙ karoubi_functor_category_embedding _ _).map Y.p,
   have eq := karoubi.hom_ext.mp (P_infty_f_naturality n π),
-  simp only [karoubi.comp] at eq,
+  simp only [karoubi.comp_f] at eq,
   dsimp [π] at eq,
   rw [← eq, reassoc_of (app_idem Y (op [n]))],
 end
diff --git a/src/algebraic_topology/dold_kan/split_simplicial_object.lean b/src/algebraic_topology/dold_kan/split_simplicial_object.lean
index b942f116b0260..bbb6ac4e24967 100644
--- a/src/algebraic_topology/dold_kan/split_simplicial_object.lean
+++ b/src/algebraic_topology/dold_kan/split_simplicial_object.lean
@@ -224,13 +224,13 @@ def to_karoubi_nondeg_complex_iso_N₁ : (to_karoubi _).obj s.nondeg_complex ≅
     comm := by { ext n, dsimp, simp only [comp_id, P_infty_comp_π_summand_id], }, },
   hom_inv_id' := begin
     ext n,
-    simpa only [assoc, P_infty_comp_π_summand_id, karoubi.comp, homological_complex.comp_f,
-      ι_π_summand_eq_id],
+    simpa only [assoc, P_infty_comp_π_summand_id, karoubi.comp_f,
+      homological_complex.comp_f, ι_π_summand_eq_id],
   end,
   inv_hom_id' := begin
     ext n,
-    simp only [karoubi.comp, homological_complex.comp_f,
-      π_summand_comp_ι_summand_comp_P_infty_eq_P_infty, karoubi.id_eq, N₁_obj_p],
+    simp only [π_summand_comp_ι_summand_comp_P_infty_eq_P_infty, karoubi.comp_f,
+      homological_complex.comp_f, N₁_obj_p, karoubi.id_eq],
   end, }
 
 end splitting
@@ -275,9 +275,9 @@ nat_iso.of_components (λ S, S.s.to_karoubi_nondeg_complex_iso_N₁)
   (λ S₁ S₂ Φ, begin
     ext n,
     dsimp,
-    simp only [to_karoubi_map_f, karoubi.comp, homological_complex.comp_f,
-      splitting.to_karoubi_nondeg_complex_iso_N₁_hom_f_f, N₁_map_f, nondeg_complex_functor_map_f,
-      alternating_face_map_complex.map_f, assoc, P_infty_f_idem_assoc],
+    simp only [karoubi.comp_f, to_karoubi_map_f, homological_complex.comp_f,
+      nondeg_complex_functor_map_f, splitting.to_karoubi_nondeg_complex_iso_N₁_hom_f_f,
+      N₁_map_f, alternating_face_map_complex.map_f, assoc, P_infty_f_idem_assoc],
     erw ← split.ι_summand_naturality_symm_assoc Φ (splitting.index_set.id (op [n])),
     rw P_infty_f_naturality,
   end)
diff --git a/src/algebraic_topology/simplex_category.lean b/src/algebraic_topology/simplex_category.lean
index 2c724131c40fa..e8c9922574dc3 100644
--- a/src/algebraic_topology/simplex_category.lean
+++ b/src/algebraic_topology/simplex_category.lean
@@ -775,6 +775,11 @@ instance : has_strong_epi_mono_factorisations simplex_category :=
 functor.has_strong_epi_mono_factorisations_imp_of_is_equivalence
   simplex_category.skeletal_equivalence.{0}.inverse
 
+instance : has_strong_epi_images simplex_category :=
+  limits.has_strong_epi_images_of_has_strong_epi_mono_factorisations
+
+instance (Δ Δ' : simplex_category) (θ : Δ ⟶ Δ') : epi (factor_thru_image θ) := strong_epi.epi
+
 lemma image_eq {Δ Δ' Δ'' : simplex_category } {φ : Δ ⟶ Δ''}
   {e : Δ ⟶ Δ'} [epi e] {i : Δ' ⟶ Δ''} [mono i] (fac : e ≫ i = φ) :
   image φ = Δ' :=
diff --git a/src/algebraic_topology/split_simplicial_object.lean b/src/algebraic_topology/split_simplicial_object.lean
index 718739e71a906..d82c9fbb11d2d 100644
--- a/src/algebraic_topology/split_simplicial_object.lean
+++ b/src/algebraic_topology/split_simplicial_object.lean
@@ -57,7 +57,7 @@ namespace index_set
 def mk {Δ Δ' : simplex_category} (f : Δ ⟶ Δ') [epi f] : index_set (op Δ) :=
 ⟨op Δ', f, infer_instance⟩
 
-variables {Δ' Δ : simplex_categoryᵒᵖ} (A : index_set Δ)
+variables {Δ' Δ : simplex_categoryᵒᵖ} (A : index_set Δ) (θ : Δ ⟶ Δ')
 
 /-- The epimorphism in `simplex_category` associated to `A : splitting.index_set Δ` -/
 def e := A.2.1
@@ -167,6 +167,15 @@ of epimorphisms `p.unop ≫ A.e`. -/
 def epi_comp {Δ₁ Δ₂ : simplex_categoryᵒᵖ} (A : index_set Δ₁) (p : Δ₁ ⟶ Δ₂) [epi p.unop] :
   index_set Δ₂ := ⟨A.1, ⟨p.unop ≫ A.e, epi_comp _ _⟩⟩
 
+/--
+When `A : index_set Δ` and `θ : Δ → Δ'` is a morphism in `simplex_categoryᵒᵖ`,
+an element in `index_set Δ'` can be defined by using the epi-mono factorisation
+of `θ.unop ≫ A.e`. -/
+def pull : index_set Δ' := mk (factor_thru_image (θ.unop ≫ A.e))
+
+@[reassoc]
+lemma fac_pull : (A.pull θ).e ≫ image.ι (θ.unop ≫ A.e) = θ.unop ≫ A.e := image.fac _
+
 end index_set
 
 variables (N : ℕ → C) (Δ : simplex_categoryᵒᵖ)
diff --git a/src/analysis/bounded_variation.lean b/src/analysis/bounded_variation.lean
index 3deb1eb619731..f26499b3ab483 100644
--- a/src/analysis/bounded_variation.lean
+++ b/src/analysis/bounded_variation.lean
@@ -393,11 +393,11 @@ begin
   by_cases hs : s = ∅,
   { simp [hs] },
   haveI : nonempty {u // monotone u ∧ ∀ (i : ℕ), u i ∈ s},
-    from nonempty_monotone_mem (ne_empty_iff_nonempty.1 hs),
+    from nonempty_monotone_mem (nonempty_iff_ne_empty.2 hs),
   by_cases ht : t = ∅,
   { simp [ht] },
   haveI : nonempty {u // monotone u ∧ ∀ (i : ℕ), u i ∈ t},
-    from nonempty_monotone_mem (ne_empty_iff_nonempty.1 ht),
+    from nonempty_monotone_mem (nonempty_iff_ne_empty.2 ht),
   refine ennreal.supr_add_supr_le _,
   /- We start from two sequences `u` and `v` along `s` and `t` respectively, and we build a new
   sequence `w` along `s ∪ t` by juxtaposing them. Its variation is larger than the sum of the
diff --git a/src/analysis/box_integral/box/subbox_induction.lean b/src/analysis/box_integral/box/subbox_induction.lean
index 2dd294e19f74f..a5f63b8179bdc 100644
--- a/src/analysis/box_integral/box/subbox_induction.lean
+++ b/src/analysis/box_integral/box/subbox_induction.lean
@@ -147,7 +147,7 @@ begin
   { suffices : tendsto (λ m, (J m).upper - (J m).lower) at_top (𝓝 0), by simpa using hJlz.add this,
     refine tendsto_pi_nhds.2 (λ i, _),
     simpa [hJsub] using tendsto_const_nhds.div_at_top
-      (tendsto_pow_at_top_at_top_of_one_lt $ @one_lt_two ℝ _) },
+      (tendsto_pow_at_top_at_top_of_one_lt one_lt_two) },
   replace hJlz : tendsto (λ m, (J m).lower) at_top (𝓝[Icc I.lower I.upper] z),
     from tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ hJlz
       (eventually_of_forall hJl_mem),
diff --git a/src/analysis/box_integral/partition/filter.lean b/src/analysis/box_integral/partition/filter.lean
index 8954ff270d186..72e36eae9ec13 100644
--- a/src/analysis/box_integral/partition/filter.lean
+++ b/src/analysis/box_integral/partition/filter.lean
@@ -419,7 +419,7 @@ has_basis_binfi_principal'
   (λ r₁ hr₁ r₂ hr₂, ⟨_, hr₁.min hr₂,
     λ _, mem_base_set.mono _ le_rfl le_rfl (λ x hx, min_le_left _ _),
     λ _, mem_base_set.mono _ le_rfl le_rfl (λ x hx, min_le_right _ _)⟩)
-  ⟨λ _, ⟨1, @zero_lt_one ℝ _ _⟩, λ _ _, rfl⟩
+  ⟨λ _, ⟨1, zero_lt_one⟩, λ _ _, rfl⟩
 
 lemma has_basis_to_filter_distortion_Union (l : integration_params) (I : box ι) (c : ℝ≥0)
   (π₀ : prepartition I) :
diff --git a/src/analysis/calculus/bump_function_findim.lean b/src/analysis/calculus/bump_function_findim.lean
new file mode 100644
index 0000000000000..dc35767b374ca
--- /dev/null
+++ b/src/analysis/calculus/bump_function_findim.lean
@@ -0,0 +1,196 @@
+/-
+Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import analysis.calculus.specific_functions
+import analysis.calculus.series
+import analysis.convolution
+import data.set.pointwise.support
+
+/-!
+# Bump functions in finite-dimensional vector spaces
+
+Let `E` be a finite-dimensional real normed vector space. We show that any open set `s` in `E` is
+exactly the support of a smooth function taking values in `[0, 1]`,
+in `is_open.exists_smooth_support_eq`.
+
+TODO: use this construction to construct bump functions with nice behavior in any finite-dimensional
+real normed vector space, by convolving the indicator function of `closed_ball 0 1` with a
+function as above with `s = ball 0 D`.
+-/
+
+noncomputable theory
+
+open set metric topological_space function asymptotics measure_theory finite_dimensional
+continuous_linear_map filter measure_theory.measure
+open_locale pointwise topological_space nnreal big_operators convolution
+
+variables {E : Type*} [normed_add_comm_group E]
+
+section
+
+variables [normed_space ℝ E] [finite_dimensional ℝ E]
+
+/-- If a set `s` is a neighborhood of `x`, then there exists a smooth function `f` taking
+values in `[0, 1]`, supported in `s` and with `f x = 1`. -/
+theorem exists_smooth_tsupport_subset {s : set E} {x : E} (hs : s ∈ 𝓝 x) :
+  ∃ (f : E → ℝ), tsupport f ⊆ s ∧ has_compact_support f ∧ cont_diff ℝ ⊤ f ∧
+    range f ⊆ Icc 0 1 ∧ f x = 1 :=
+begin
+  obtain ⟨d, d_pos, hd⟩ : ∃ (d : ℝ) (hr : 0 < d), euclidean.closed_ball x d ⊆ s,
+    from euclidean.nhds_basis_closed_ball.mem_iff.1 hs,
+  let c : cont_diff_bump_of_inner (to_euclidean x) :=
+  { r := d/2,
+    R := d,
+    r_pos := half_pos d_pos,
+    r_lt_R := half_lt_self d_pos },
+  let f : E → ℝ := c ∘ to_euclidean,
+  have f_supp : f.support ⊆ euclidean.ball x d,
+  { assume y hy,
+    have : to_euclidean y ∈ function.support c,
+      by simpa only [f, function.mem_support, function.comp_app, ne.def] using hy,
+    rwa c.support_eq at this },
+  have f_tsupp : tsupport f ⊆ euclidean.closed_ball x d,
+  { rw [tsupport, ← euclidean.closure_ball _ d_pos.ne'],
+    exact closure_mono f_supp },
+  refine ⟨f, f_tsupp.trans hd, _, _, _, _⟩,
+  { refine is_compact_of_is_closed_bounded is_closed_closure _,
+    have : bounded (euclidean.closed_ball x d), from euclidean.is_compact_closed_ball.bounded,
+    apply this.mono _,
+    refine (is_closed.closure_subset_iff euclidean.is_closed_closed_ball).2 _,
+    exact f_supp.trans euclidean.ball_subset_closed_ball },
+  { apply c.cont_diff.comp,
+    exact continuous_linear_equiv.cont_diff _ },
+  { rintros t ⟨y, rfl⟩,
+    exact ⟨c.nonneg, c.le_one⟩ },
+  { apply c.one_of_mem_closed_ball,
+    apply mem_closed_ball_self,
+    exact (half_pos d_pos).le }
+end
+
+/-- Given an open set `s` in a finite-dimensional real normed vector space, there exists a smooth
+function with values in `[0, 1]` whose support is exactly `s`. -/
+theorem is_open.exists_smooth_support_eq {s : set E} (hs : is_open s) :
+  ∃ (f : E → ℝ), f.support = s ∧ cont_diff ℝ ⊤ f ∧ set.range f ⊆ set.Icc 0 1 :=
+begin
+  /- For any given point `x` in `s`, one can construct a smooth function with support in `s` and
+  nonzero at `x`. By second-countability, it follows that we may cover `s` with the supports of
+  countably many such functions, say `g i`.
+  Then `∑ i, r i • g i` will be the desired function if `r i` is a sequence of positive numbers
+  tending quickly enough to zero. Indeed, this ensures that, for any `k ≤ i`, the `k`-th derivative
+  of `r i • g i` is bounded by a prescribed (summable) sequence `u i`. From this, the summability
+  of the series and of its successive derivatives follows. -/
+  rcases eq_empty_or_nonempty s with rfl|h's,
+  { exact ⟨(λ x, 0), function.support_zero, cont_diff_const,
+      by simp only [range_const, singleton_subset_iff, left_mem_Icc, zero_le_one]⟩ },
+  let ι := {f : E → ℝ // f.support ⊆ s ∧ has_compact_support f ∧ cont_diff ℝ ⊤ f ∧
+    range f ⊆ Icc 0 1},
+  obtain ⟨T, T_count, hT⟩ : ∃ T : set ι, T.countable ∧ (⋃ f ∈ T, support (f : E → ℝ)) = s,
+  { have : (⋃ (f : ι), (f : E → ℝ).support) = s,
+    { refine subset.antisymm (Union_subset (λ f, f.2.1)) _,
+      assume x hx,
+      rcases exists_smooth_tsupport_subset (hs.mem_nhds hx) with ⟨f, hf⟩,
+      let g : ι := ⟨f, (subset_tsupport f).trans hf.1, hf.2.1, hf.2.2.1, hf.2.2.2.1⟩,
+      have : x ∈ support (g : E → ℝ),
+        by simp only [hf.2.2.2.2, subtype.coe_mk, mem_support, ne.def, one_ne_zero, not_false_iff],
+      exact mem_Union_of_mem _ this },
+    simp_rw ← this,
+    apply is_open_Union_countable,
+    rintros ⟨f, hf⟩,
+    exact hf.2.2.1.continuous.is_open_support },
+  obtain ⟨g0, hg⟩ : ∃ (g0 : ℕ → ι), T = range g0,
+  { apply countable.exists_eq_range T_count,
+    rcases eq_empty_or_nonempty T with rfl|hT,
+    { simp only [Union_false, Union_empty] at hT,
+      simp only [←hT, not_nonempty_empty] at h's,
+      exact h's.elim },
+    { exact hT } },
+  let g : ℕ → E → ℝ := λ n, (g0 n).1,
+  have g_s : ∀ n, support (g n) ⊆ s := λ n, (g0 n).2.1,
+  have s_g : ∀ x ∈ s, ∃ n, x ∈ support (g n),
+  { assume x hx,
+    rw ← hT at hx,
+    obtain ⟨i, iT, hi⟩ : ∃ (i : ι) (hi : i ∈ T), x ∈ support (i : E → ℝ),
+      by simpa only [mem_Union] using hx,
+    rw [hg, mem_range] at iT,
+    rcases iT with ⟨n, hn⟩,
+    rw ← hn at hi,
+    exact ⟨n, hi⟩ },
+  have g_smooth : ∀ n, cont_diff ℝ ⊤ (g n) := λ n, (g0 n).2.2.2.1,
+  have g_comp_supp : ∀ n, has_compact_support (g n) := λ n, (g0 n).2.2.1,
+  have g_nonneg : ∀ n x, 0 ≤ g n x,
+    from λ n x, ((g0 n).2.2.2.2 (mem_range_self x)).1,
+  obtain ⟨δ, δpos, c, δc, c_lt⟩ :
+    ∃ (δ : ℕ → ℝ≥0), (∀ (i : ℕ), 0 < δ i) ∧ ∃ (c : nnreal), has_sum δ c ∧ c < 1,
+    from nnreal.exists_pos_sum_of_countable one_ne_zero ℕ,
+  have : ∀ (n : ℕ), ∃ (r : ℝ),
+    0 < r ∧ ∀ i ≤ n, ∀ x, ‖iterated_fderiv ℝ i (r • g n) x‖ ≤ δ n,
+  { assume n,
+    have : ∀ i, ∃ R, ∀ x, ‖iterated_fderiv ℝ i (λ x, g n x) x‖ ≤ R,
+    { assume i,
+      have : bdd_above (range (λ x, ‖iterated_fderiv ℝ i (λ (x : E), g n x) x‖)),
+      { apply ((g_smooth n).continuous_iterated_fderiv le_top).norm
+          .bdd_above_range_of_has_compact_support,
+        apply has_compact_support.comp_left _ norm_zero,
+        apply (g_comp_supp n).iterated_fderiv },
+      rcases this with ⟨R, hR⟩,
+      exact ⟨R, λ x, hR (mem_range_self _)⟩ },
+    choose R hR using this,
+    let M := max (((finset.range (n+1)).image R).max' (by simp)) 1,
+    have M_pos : 0 < M := zero_lt_one.trans_le (le_max_right _ _),
+    have δnpos : 0 < δ n := δpos n,
+    have IR : ∀ i ≤ n, R i ≤ M,
+    { assume i hi,
+      refine le_trans _ (le_max_left _ _),
+      apply finset.le_max',
+      apply finset.mem_image_of_mem,
+      simp only [finset.mem_range],
+      linarith },
+    refine ⟨M⁻¹ * δ n, by positivity, λ i hi x, _⟩,
+    calc ‖iterated_fderiv ℝ i ((M⁻¹ * δ n) • g n) x‖
+        = ‖(M⁻¹ * δ n) • iterated_fderiv ℝ i (g n) x‖ :
+      by { rw iterated_fderiv_const_smul_apply, exact (g_smooth n).of_le le_top }
+    ... = M⁻¹ * δ n * ‖iterated_fderiv ℝ i (g n) x‖ :
+      by { rw [norm_smul, real.norm_of_nonneg], positivity }
+    ... ≤ M⁻¹ * δ n * M :
+      mul_le_mul_of_nonneg_left ((hR i x).trans (IR i hi)) (by positivity)
+    ... = δ n : by field_simp [M_pos.ne'] },
+  choose r rpos hr using this,
+  have S : ∀ x, summable (λ n, (r n • g n) x),
+  { assume x,
+    refine summable_of_nnnorm_bounded _ δc.summable (λ n, _),
+    rw [← nnreal.coe_le_coe, coe_nnnorm],
+    simpa only [norm_iterated_fderiv_zero] using hr n 0 (zero_le n) x },
+  refine ⟨λ x, (∑' n, (r n • g n) x), _, _, _⟩,
+  { apply subset.antisymm,
+    { assume x hx,
+      simp only [pi.smul_apply, algebra.id.smul_eq_mul, mem_support, ne.def] at hx,
+      contrapose! hx,
+      have : ∀ n, g n x = 0,
+      { assume n,
+        contrapose! hx,
+        exact g_s n hx },
+      simp only [this, mul_zero, tsum_zero] },
+    { assume x hx,
+      obtain ⟨n, hn⟩ : ∃ n, x ∈ support (g n), from s_g x hx,
+      have I : 0 < r n * g n x,
+        from mul_pos (rpos n) (lt_of_le_of_ne (g_nonneg n x) (ne.symm hn)),
+      exact ne_of_gt (tsum_pos (S x) (λ i, mul_nonneg (rpos i).le (g_nonneg i x)) n I) } },
+  { refine cont_diff_tsum_of_eventually (λ n, (g_smooth n).const_smul _)
+      (λ k hk, (nnreal.has_sum_coe.2 δc).summable) _,
+    assume i hi,
+    simp only [nat.cofinite_eq_at_top, pi.smul_apply, algebra.id.smul_eq_mul,
+      filter.eventually_at_top, ge_iff_le],
+    exact ⟨i, λ n hn x, hr _ _ hn _⟩ },
+  { rintros - ⟨y, rfl⟩,
+    refine ⟨tsum_nonneg (λ n, mul_nonneg (rpos n).le (g_nonneg n y)), le_trans _ c_lt.le⟩,
+    have A : has_sum (λ n, (δ n : ℝ)) c, from nnreal.has_sum_coe.2 δc,
+    rw ← A.tsum_eq,
+    apply tsum_le_tsum _ (S y) A.summable,
+    assume n,
+    apply (le_abs_self _).trans,
+    simpa only [norm_iterated_fderiv_zero] using hr n 0 (zero_le n) y }
+end
+
+end
diff --git a/src/analysis/calculus/specific_functions.lean b/src/analysis/calculus/specific_functions.lean
index 3c7f8b6b8822f..b75744a009566 100644
--- a/src/analysis/calculus/specific_functions.lean
+++ b/src/analysis/calculus/specific_functions.lean
@@ -229,7 +229,7 @@ variables {x : ℝ}
 open exp_neg_inv_glue
 
 lemma pos_denom (x) : 0 < exp_neg_inv_glue x + exp_neg_inv_glue (1 - x) :=
-((@zero_lt_one ℝ _ _).lt_or_lt x).elim
+(zero_lt_one.lt_or_lt x).elim
   (λ hx, add_pos_of_pos_of_nonneg (pos_of_pos hx) (nonneg _))
   (λ hx, add_pos_of_nonneg_of_pos (nonneg _) (pos_of_pos $ sub_pos.2 hx))
 
diff --git a/src/analysis/complex/basic.lean b/src/analysis/complex/basic.lean
index 2ae3893108310..2282d4c0ef867 100644
--- a/src/analysis/complex/basic.lean
+++ b/src/analysis/complex/basic.lean
@@ -100,7 +100,7 @@ by rw [edist_nndist, edist_nndist, nndist_of_im_eq h]
 
 lemma dist_conj_self (z : ℂ) : dist (conj z) z = 2 * |z.im| :=
 by rw [dist_of_re_eq (conj_re z), conj_im, dist_comm, real.dist_eq, sub_neg_eq_add, ← two_mul,
-  _root_.abs_mul, abs_of_pos (@two_pos ℝ _ _)]
+  _root_.abs_mul, abs_of_pos (zero_lt_two' ℝ)]
 
 lemma nndist_conj_self (z : ℂ) : nndist (conj z) z = 2 * real.nnabs z.im :=
 nnreal.eq $ by rw [← dist_nndist, nnreal.coe_mul, nnreal.coe_two, real.coe_nnabs, dist_conj_self]
diff --git a/src/analysis/complex/upper_half_plane/metric.lean b/src/analysis/complex/upper_half_plane/metric.lean
index b075eb15bee7a..efb5f7f75c981 100644
--- a/src/analysis/complex/upper_half_plane/metric.lean
+++ b/src/analysis/complex/upper_half_plane/metric.lean
@@ -59,7 +59,7 @@ lemma tanh_half_dist (z w : ℍ) :
   tanh (dist z w / 2) = dist (z : ℂ) w / dist (z : ℂ) (conj ↑w) :=
 begin
   rw [tanh_eq_sinh_div_cosh, sinh_half_dist, cosh_half_dist, div_div_div_comm, div_self, div_one],
-  exact (mul_pos two_pos (sqrt_pos.2 $ mul_pos z.im_pos w.im_pos)).ne'
+  exact (mul_pos (zero_lt_two' ℝ) (sqrt_pos.2 $ mul_pos z.im_pos w.im_pos)).ne'
 end
 
 lemma exp_half_dist (z w : ℍ) :
@@ -89,7 +89,7 @@ by simp only [dist_eq, dist_comm (z : ℂ), mul_comm]
 
 lemma dist_le_iff_le_sinh :
   dist z w ≤ r ↔ dist (z : ℂ) w / (2 * sqrt (z.im * w.im)) ≤ sinh (r / 2) :=
-by rw [← div_le_div_right (@two_pos ℝ _ _), ← sinh_le_sinh, sinh_half_dist]
+by rw [← div_le_div_right (zero_lt_two' ℝ), ← sinh_le_sinh, sinh_half_dist]
 
 lemma dist_eq_iff_eq_sinh :
   dist z w = r ↔ dist (z : ℂ) w / (2 * sqrt (z.im * w.im)) = sinh (r / 2) :=
diff --git a/src/analysis/convex/between.lean b/src/analysis/convex/between.lean
index c93700712f53e..3e0f9fc5e657a 100644
--- a/src/analysis/convex/between.lean
+++ b/src/analysis/convex/between.lean
@@ -209,6 +209,12 @@ begin
   { exact ⟨t, ho, rfl⟩ }
 end
 
+lemma wbtw.mem_affine_span {x y z : P} (h : wbtw R x y z) : y ∈ line[R, x, z] :=
+begin
+  rcases h with ⟨r, ⟨-, rfl⟩⟩,
+  exact line_map_mem_affine_span_pair _ _ _
+end
+
 lemma wbtw_comm {x y z : P} : wbtw R x y z ↔ wbtw R z y x :=
 by rw [wbtw, wbtw, affine_segment_comm]
 
@@ -355,6 +361,37 @@ begin
   rw (line_map_injective R hxy).mem_set_image
 end
 
+omit V
+
+@[simp] lemma wbtw_mul_sub_add_iff [no_zero_divisors R] {x y r : R} :
+  wbtw R x (r * (y - x) + x) y ↔ x = y ∨ r ∈ set.Icc (0 : R) 1 :=
+wbtw_line_map_iff
+
+@[simp] lemma sbtw_mul_sub_add_iff [no_zero_divisors R] {x y r : R} :
+  sbtw R x (r * (y - x) + x) y ↔ x ≠ y ∧ r ∈ set.Ioo (0 : R) 1 :=
+sbtw_line_map_iff
+
+@[simp] lemma wbtw_zero_one_iff {x : R} : wbtw R 0 x 1 ↔ x ∈ set.Icc (0 : R) 1 :=
+begin
+  simp_rw [wbtw, affine_segment, set.mem_image, line_map_apply_ring],
+  simp
+end
+
+@[simp] lemma wbtw_one_zero_iff {x : R} : wbtw R 1 x 0 ↔ x ∈ set.Icc (0 : R) 1 :=
+by rw [wbtw_comm, wbtw_zero_one_iff]
+
+@[simp] lemma sbtw_zero_one_iff {x : R} : sbtw R 0 x 1 ↔ x ∈ set.Ioo (0 : R) 1 :=
+begin
+  rw [sbtw, wbtw_zero_one_iff, set.mem_Icc, set.mem_Ioo],
+  exact ⟨λ h, ⟨h.1.1.lt_of_ne (ne.symm h.2.1), h.1.2.lt_of_ne h.2.2⟩,
+         λ h, ⟨⟨h.1.le, h.2.le⟩, h.1.ne', h.2.ne⟩⟩
+end
+
+@[simp] lemma sbtw_one_zero_iff {x : R} : sbtw R 1 x 0 ↔ x ∈ set.Ioo (0 : R) 1 :=
+by rw [sbtw_comm, sbtw_zero_one_iff]
+
+include V
+
 lemma wbtw.trans_left {w x y z : P} (h₁ : wbtw R w y z) (h₂ : wbtw R w x y) : wbtw R w x z :=
 begin
   rcases h₁ with ⟨t₁, ht₁, rfl⟩,
@@ -393,6 +430,28 @@ lemma sbtw.trans_right [no_zero_smul_divisors R V] {w x y z : P} (h₁ : sbtw R
   (h₂ : sbtw R x y z) : sbtw R w y z :=
 h₁.wbtw.trans_sbtw_right h₂
 
+lemma wbtw.trans_left_ne [no_zero_smul_divisors R V] {w x y z : P} (h₁ : wbtw R w y z)
+  (h₂ : wbtw R w x y) (h : y ≠ z) : x ≠ z :=
+begin
+  rintro rfl,
+  exact h (h₁.swap_right_iff.1 h₂)
+end
+
+lemma wbtw.trans_right_ne [no_zero_smul_divisors R V] {w x y z : P} (h₁ : wbtw R w x z)
+  (h₂ : wbtw R x y z) (h : w ≠ x) : w ≠ y :=
+begin
+  rintro rfl,
+  exact h (h₁.swap_left_iff.1 h₂)
+end
+
+lemma sbtw.trans_wbtw_left_ne [no_zero_smul_divisors R V] {w x y z : P} (h₁ : sbtw R w y z)
+  (h₂ : wbtw R w x y) : x ≠ z :=
+h₁.wbtw.trans_left_ne h₂ h₁.ne_right
+
+lemma sbtw.trans_wbtw_right_ne [no_zero_smul_divisors R V] {w x y z : P} (h₁ : sbtw R w x z)
+  (h₂ : wbtw R x y z) : w ≠ y :=
+h₁.wbtw.trans_right_ne h₂ h₁.left_ne
+
 end ordered_ring
 
 section strict_ordered_comm_ring
@@ -436,6 +495,85 @@ include V
 
 variables {R}
 
+lemma wbtw_iff_left_eq_or_right_mem_image_Ici {x y z : P} :
+  wbtw R x y z ↔ x = y ∨ z ∈ line_map x y '' (set.Ici (1 : R)) :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { rcases h with ⟨r, ⟨hr0, hr1⟩, rfl⟩,
+    rcases hr0.lt_or_eq with hr0' | rfl,
+    { rw set.mem_image,
+      refine or.inr ⟨r⁻¹, one_le_inv hr0' hr1, _⟩,
+      simp only [line_map_apply, smul_smul, vadd_vsub],
+      rw [inv_mul_cancel hr0'.ne', one_smul, vsub_vadd] },
+    { simp } },
+  { rcases h with rfl | ⟨r, ⟨hr, rfl⟩⟩,
+    { exact wbtw_self_left _ _ _ },
+    { rw set.mem_Ici at hr,
+      refine ⟨r⁻¹, ⟨inv_nonneg.2 (zero_le_one.trans hr), inv_le_one hr⟩, _⟩,
+      simp only [line_map_apply, smul_smul, vadd_vsub],
+      rw [inv_mul_cancel (one_pos.trans_le hr).ne', one_smul, vsub_vadd] } }
+end
+
+lemma wbtw.right_mem_image_Ici_of_left_ne {x y z : P} (h : wbtw R x y z) (hne : x ≠ y) :
+  z ∈ line_map x y '' (set.Ici (1 : R)) :=
+(wbtw_iff_left_eq_or_right_mem_image_Ici.1 h).resolve_left hne
+
+lemma wbtw.right_mem_affine_span_of_left_ne {x y z : P} (h : wbtw R x y z) (hne : x ≠ y) :
+  z ∈ line[R, x, y] :=
+begin
+  rcases h.right_mem_image_Ici_of_left_ne hne with ⟨r, ⟨-, rfl⟩⟩,
+  exact line_map_mem_affine_span_pair _ _ _
+end
+
+lemma sbtw_iff_left_ne_and_right_mem_image_IoI {x y z : P} :
+  sbtw R x y z ↔ x ≠ y ∧ z ∈ line_map x y '' (set.Ioi (1 : R)) :=
+begin
+  refine ⟨λ h, ⟨h.left_ne, _⟩, λ h, _⟩,
+  { obtain ⟨r, ⟨hr, rfl⟩⟩ := h.wbtw.right_mem_image_Ici_of_left_ne h.left_ne,
+    rw [set.mem_Ici] at hr,
+    rcases hr.lt_or_eq with hrlt | rfl,
+    { exact set.mem_image_of_mem _ hrlt },
+    { exfalso, simpa using h } },
+  { rcases h with ⟨hne, r, hr, rfl⟩,
+    rw set.mem_Ioi at hr,
+    refine ⟨wbtw_iff_left_eq_or_right_mem_image_Ici.2 (or.inr (set.mem_image_of_mem _
+      (set.mem_of_mem_of_subset hr set.Ioi_subset_Ici_self))), hne.symm, _⟩,
+    rw [line_map_apply, ←@vsub_ne_zero V, vsub_vadd_eq_vsub_sub],
+    nth_rewrite 0 ←one_smul R (y -ᵥ x),
+    rw [←sub_smul, smul_ne_zero_iff, vsub_ne_zero, sub_ne_zero],
+    exact ⟨hr.ne, hne.symm⟩ }
+end
+
+lemma sbtw.right_mem_image_Ioi {x y z : P} (h : sbtw R x y z) :
+  z ∈ line_map x y '' (set.Ioi (1 : R)) :=
+(sbtw_iff_left_ne_and_right_mem_image_IoI.1 h).2
+
+lemma sbtw.right_mem_affine_span {x y z : P} (h : sbtw R x y z) : z ∈ line[R, x, y] :=
+h.wbtw.right_mem_affine_span_of_left_ne h.left_ne
+
+lemma wbtw_iff_right_eq_or_left_mem_image_Ici {x y z : P} :
+  wbtw R x y z ↔ z = y ∨ x ∈ line_map z y '' (set.Ici (1 : R)) :=
+by rw [wbtw_comm, wbtw_iff_left_eq_or_right_mem_image_Ici]
+
+lemma wbtw.left_mem_image_Ici_of_right_ne {x y z : P} (h : wbtw R x y z) (hne : z ≠ y) :
+  x ∈ line_map z y '' (set.Ici (1 : R)) :=
+h.symm.right_mem_image_Ici_of_left_ne hne
+
+lemma wbtw.left_mem_affine_span_of_right_ne {x y z : P} (h : wbtw R x y z) (hne : z ≠ y) :
+  x ∈ line[R, z, y] :=
+h.symm.right_mem_affine_span_of_left_ne hne
+
+lemma sbtw_iff_right_ne_and_left_mem_image_IoI {x y z : P} :
+  sbtw R x y z ↔ z ≠ y ∧ x ∈ line_map z y '' (set.Ioi (1 : R)) :=
+by rw [sbtw_comm, sbtw_iff_left_ne_and_right_mem_image_IoI]
+
+lemma sbtw.left_mem_image_Ioi {x y z : P} (h : sbtw R x y z) :
+  x ∈ line_map z y '' (set.Ioi (1 : R)) :=
+h.symm.right_mem_image_Ioi
+
+lemma sbtw.left_mem_affine_span {x y z : P} (h : sbtw R x y z) : x ∈ line[R, z, y] :=
+h.symm.right_mem_affine_span
+
 lemma wbtw_smul_vadd_smul_vadd_of_nonneg_of_le (x : P) (v : V) {r₁ r₂ : R} (hr₁ : 0 ≤ r₁)
   (hr₂ : r₁ ≤ r₂) : wbtw R x (r₁ • v +ᵥ x) (r₂ • v +ᵥ x) :=
 begin
diff --git a/src/analysis/convex/hull.lean b/src/analysis/convex/hull.lean
index ca0b97df501d8..e31a5497a8504 100644
--- a/src/analysis/convex/hull.lean
+++ b/src/analysis/convex/hull.lean
@@ -84,7 +84,7 @@ end
 
 @[simp] lemma convex_hull_nonempty_iff : (convex_hull 𝕜 s).nonempty ↔ s.nonempty :=
 begin
-  rw [←ne_empty_iff_nonempty, ←ne_empty_iff_nonempty, ne.def, ne.def],
+  rw [nonempty_iff_ne_empty, nonempty_iff_ne_empty, ne.def, ne.def],
   exact not_congr convex_hull_empty_iff,
 end
 
diff --git a/src/analysis/convex/quasiconvex.lean b/src/analysis/convex/quasiconvex.lean
index a38845b99c915..78e8c890699a9 100644
--- a/src/analysis/convex/quasiconvex.lean
+++ b/src/analysis/convex/quasiconvex.lean
@@ -21,11 +21,6 @@ quasiconcavity, and monotonicity implies quasilinearity.
 * `quasilinear_on 𝕜 s f`: Quasilinearity of the function `f` on the set `s` with scalars `𝕜`. This
   means that `f` is both quasiconvex and quasiconcave.
 
-## TODO
-
-Prove that a quasilinear function between two linear orders is either monotone or antitone. This is
-not hard but quite a pain to go about as there are many cases to consider.
-
 ## References
 
 * https://en.wikipedia.org/wiki/Quasiconvex_function
@@ -196,3 +191,21 @@ lemma antitone.quasilinear_on (hf : antitone f) : quasilinear_on 𝕜 univ f :=
 
 end linear_ordered_add_comm_monoid
 end ordered_semiring
+
+section linear_ordered_field
+variables [linear_ordered_field 𝕜] [linear_ordered_add_comm_monoid β] {s : set 𝕜} {f : 𝕜 → β}
+
+lemma quasilinear_on.monotone_on_or_antitone_on (hf : quasilinear_on 𝕜 s f) :
+  monotone_on f s ∨ antitone_on f s :=
+begin
+  simp_rw [monotone_on_or_antitone_on_iff_interval, ←segment_eq_interval],
+  rintro a ha b hb c hc h,
+  refine ⟨((hf.2 _).segment_subset _ _ h).2, ((hf.1 _).segment_subset _ _ h).2⟩; simp [*],
+end
+
+lemma quasilinear_on_iff_monotone_on_or_antitone_on (hs : convex 𝕜 s) :
+  quasilinear_on 𝕜 s f ↔ monotone_on f s ∨ antitone_on f s :=
+⟨λ h, h.monotone_on_or_antitone_on,
+  λ h, h.elim (λ h, h.quasilinear_on hs) (λ h, h.quasilinear_on hs)⟩
+
+end linear_ordered_field
diff --git a/src/analysis/convex/strict.lean b/src/analysis/convex/strict.lean
index 566223b0689d8..d2a226136a097 100644
--- a/src/analysis/convex/strict.lean
+++ b/src/analysis/convex/strict.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
 import analysis.convex.basic
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Strictly convex sets
diff --git a/src/analysis/convex/strict_convex_between.lean b/src/analysis/convex/strict_convex_between.lean
new file mode 100644
index 0000000000000..2e32dcbc204d5
--- /dev/null
+++ b/src/analysis/convex/strict_convex_between.lean
@@ -0,0 +1,76 @@
+/-
+Copyright (c) 2022 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers
+-/
+import analysis.convex.between
+import analysis.convex.strict_convex_space
+
+/-!
+# Betweenness in affine spaces for strictly convex spaces
+
+This file proves results about betweenness for points in an affine space for a strictly convex
+space.
+
+-/
+
+variables {V P : Type*} [normed_add_comm_group V] [normed_space ℝ V] [pseudo_metric_space P]
+variables [normed_add_torsor V P] [strict_convex_space ℝ V]
+
+include V
+
+lemma sbtw.dist_lt_max_dist (p : P) {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) :
+  dist p₂ p < max (dist p₁ p) (dist p₃ p) :=
+begin
+  have hp₁p₃ : p₁ -ᵥ p ≠ p₃ -ᵥ p, { by simpa using h.left_ne_right },
+  rw [sbtw, ←wbtw_vsub_const_iff p, wbtw, affine_segment_eq_segment,
+      ←insert_endpoints_open_segment, set.mem_insert_iff, set.mem_insert_iff] at h,
+  rcases h with ⟨h | h | h, hp₂p₁, hp₂p₃⟩,
+  { rw vsub_left_cancel_iff at h, exact false.elim (hp₂p₁ h) },
+  { rw vsub_left_cancel_iff at h, exact false.elim (hp₂p₃ h) },
+  { rw [open_segment_eq_image, set.mem_image] at h,
+    rcases h with ⟨r, ⟨hr0, hr1⟩, hr⟩,
+    simp_rw [@dist_eq_norm_vsub V, ←hr],
+    exact norm_combo_lt_of_ne (le_max_left _ _) (le_max_right _ _) hp₁p₃ (sub_pos.2 hr1) hr0
+      (by abel) }
+end
+
+lemma wbtw.dist_le_max_dist (p : P) {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) :
+  dist p₂ p ≤ max (dist p₁ p) (dist p₃ p) :=
+begin
+  by_cases hp₁ : p₂ = p₁, { simp [hp₁] },
+  by_cases hp₃ : p₂ = p₃, { simp [hp₃] },
+  have hs : sbtw ℝ p₁ p₂ p₃ := ⟨h, hp₁, hp₃⟩,
+  exact (hs.dist_lt_max_dist _).le
+end
+
+/-- Given three collinear points, two (not equal) with distance `r` from `p` and one with
+distance at most `r` from `p`, the third point is weakly between the other two points. -/
+lemma collinear.wbtw_of_dist_eq_of_dist_le {p p₁ p₂ p₃ : P} {r : ℝ}
+  (h : collinear ℝ ({p₁, p₂, p₃} : set P)) (hp₁ : dist p₁ p = r) (hp₂ : dist p₂ p ≤ r)
+  (hp₃ : dist p₃ p = r) (hp₁p₃ : p₁ ≠ p₃) : wbtw ℝ p₁ p₂ p₃ :=
+begin
+  rcases h.wbtw_or_wbtw_or_wbtw with hw | hw | hw,
+  { exact hw },
+  { by_cases hp₃p₂ : p₃ = p₂, { simp [hp₃p₂] },
+    have hs : sbtw ℝ p₂ p₃ p₁ := ⟨hw, hp₃p₂, hp₁p₃.symm⟩,
+    have hs' := hs.dist_lt_max_dist p,
+    rw [hp₁, hp₃, lt_max_iff, lt_self_iff_false, or_false] at hs',
+    exact false.elim (hp₂.not_lt hs') },
+  { by_cases hp₁p₂ : p₁ = p₂, { simp [hp₁p₂] },
+    have hs : sbtw ℝ p₃ p₁ p₂ := ⟨hw, hp₁p₃, hp₁p₂⟩,
+    have hs' := hs.dist_lt_max_dist p,
+    rw [hp₁, hp₃, lt_max_iff, lt_self_iff_false, false_or] at hs',
+    exact false.elim (hp₂.not_lt hs') }
+end
+
+/-- Given three collinear points, two (not equal) with distance `r` from `p` and one with
+distance less than `r` from `p`, the third point is strictly between the other two points. -/
+lemma collinear.sbtw_of_dist_eq_of_dist_lt {p p₁ p₂ p₃ : P} {r : ℝ}
+  (h : collinear ℝ ({p₁, p₂, p₃} : set P)) (hp₁ : dist p₁ p = r) (hp₂ : dist p₂ p < r)
+  (hp₃ : dist p₃ p = r) (hp₁p₃ : p₁ ≠ p₃) : sbtw ℝ p₁ p₂ p₃ :=
+begin
+  refine ⟨h.wbtw_of_dist_eq_of_dist_le hp₁ hp₂.le hp₃ hp₁p₃, _, _⟩,
+  { rintro rfl, exact hp₂.ne hp₁ },
+  { rintro rfl, exact hp₂.ne hp₃ }
+end
diff --git a/src/analysis/convex/strict_convex_space.lean b/src/analysis/convex/strict_convex_space.lean
index 8abf23959c21e..39d0309c9d23d 100644
--- a/src/analysis/convex/strict_convex_space.lean
+++ b/src/analysis/convex/strict_convex_space.lean
@@ -234,7 +234,7 @@ by simp only [mem_segment_iff_same_ray, same_ray_iff_norm_add, dist_eq_norm',
 
 lemma norm_midpoint_lt_iff (h : ‖x‖ = ‖y‖) : ‖(1/2 : ℝ) • (x + y)‖ < ‖x‖ ↔ x ≠ y :=
 by rw [norm_smul, real.norm_of_nonneg (one_div_nonneg.2 zero_le_two), ←inv_eq_one_div,
-    ←div_eq_inv_mul, div_lt_iff (@zero_lt_two ℝ _ _), mul_two, ←not_same_ray_iff_of_norm_eq h,
+    ←div_eq_inv_mul, div_lt_iff (zero_lt_two' ℝ), mul_two, ←not_same_ray_iff_of_norm_eq h,
     not_same_ray_iff_norm_add_lt, h]
 
 variables {F : Type*} [normed_add_comm_group F] [normed_space ℝ F]
diff --git a/src/analysis/convex/topology.lean b/src/analysis/convex/topology.lean
index c5a430c021e32..078d9b74569c5 100644
--- a/src/analysis/convex/topology.lean
+++ b/src/analysis/convex/topology.lean
@@ -274,7 +274,7 @@ begin
   have hne : t ≠ 0, from (one_pos.trans ht).ne',
   refine ⟨homothety x t⁻¹ y, hs.open_segment_interior_closure_subset_interior hx hy _,
     (affine_equiv.homothety_units_mul_hom x (units.mk0 t hne)).apply_symm_apply y⟩,
-  rw [open_segment_eq_image_line_map, ← inv_one, ← inv_Ioi (@one_pos ℝ _ _), ← image_inv,
+  rw [open_segment_eq_image_line_map, ← inv_one, ← inv_Ioi (zero_lt_one' ℝ), ← image_inv,
     image_image, homothety_eq_line_map],
   exact mem_image_of_mem _ ht
 end
diff --git a/src/analysis/inner_product_space/basic.lean b/src/analysis/inner_product_space/basic.lean
index 251be997c4c7c..147a76d74b76f 100644
--- a/src/analysis/inner_product_space/basic.lean
+++ b/src/analysis/inner_product_space/basic.lean
@@ -2226,26 +2226,19 @@ lemma submodule.inner_right_of_mem_orthogonal {u v : E} (hu : u ∈ K) (hv : v 
 lemma submodule.inner_left_of_mem_orthogonal {u v : E} (hu : u ∈ K) (hv : v ∈ Kᗮ) : ⟪v, u⟫ = 0 :=
 by rw [inner_eq_zero_sym]; exact submodule.inner_right_of_mem_orthogonal hu hv
 
-/-- A vector in `(𝕜 ∙ u)ᗮ` is orthogonal to `u`. -/
-lemma inner_right_of_mem_orthogonal_singleton (u : E) {v : E} (hv : v ∈ (𝕜 ∙ u)ᗮ) : ⟪u, v⟫ = 0 :=
-submodule.inner_right_of_mem_orthogonal (submodule.mem_span_singleton_self u) hv
-
-/-- A vector in `(𝕜 ∙ u)ᗮ` is orthogonal to `u`. -/
-lemma inner_left_of_mem_orthogonal_singleton (u : E) {v : E} (hv : v ∈ (𝕜 ∙ u)ᗮ) : ⟪v, u⟫ = 0 :=
-submodule.inner_left_of_mem_orthogonal (submodule.mem_span_singleton_self u) hv
-
-/-- A vector orthogonal to `u` lies in `(𝕜 ∙ u)ᗮ`. -/
-lemma mem_orthogonal_singleton_of_inner_right (u : E) {v : E} (hv : ⟪u, v⟫ = 0) : v ∈ (𝕜 ∙ u)ᗮ :=
+/-- A vector is in `(𝕜 ∙ u)ᗮ` iff it is orthogonal to `u`. -/
+lemma submodule.mem_orthogonal_singleton_iff_inner_right {u v : E} : v ∈ (𝕜 ∙ u)ᗮ ↔ ⟪u, v⟫ = 0 :=
 begin
-  intros w hw,
+  refine ⟨submodule.inner_right_of_mem_orthogonal (submodule.mem_span_singleton_self u), _⟩,
+  intros hv w hw,
   rw submodule.mem_span_singleton at hw,
   obtain ⟨c, rfl⟩ := hw,
   simp [inner_smul_left, hv],
 end
 
-/-- A vector orthogonal to `u` lies in `(𝕜 ∙ u)ᗮ`. -/
-lemma mem_orthogonal_singleton_of_inner_left (u : E) {v : E} (hv : ⟪v, u⟫ = 0) : v ∈ (𝕜 ∙ u)ᗮ :=
-mem_orthogonal_singleton_of_inner_right u $ inner_eq_zero_sym.2 hv
+/-- A vector in `(𝕜 ∙ u)ᗮ` is orthogonal to `u`. -/
+lemma submodule.mem_orthogonal_singleton_iff_inner_left {u v : E} : v ∈ (𝕜 ∙ u)ᗮ ↔ ⟪v, u⟫ = 0 :=
+by rw [submodule.mem_orthogonal_singleton_iff_inner_right, inner_eq_zero_sym]
 
 lemma submodule.sub_mem_orthogonal_of_inner_left {x y : E}
   (h : ∀ (v : K), ⟪x, v⟫ = ⟪y, v⟫) : x - y ∈ Kᗮ :=
diff --git a/src/analysis/inner_product_space/gram_schmidt_ortho.lean b/src/analysis/inner_product_space/gram_schmidt_ortho.lean
index 1b546aeab8cec..495227a7c37d0 100644
--- a/src/analysis/inner_product_space/gram_schmidt_ortho.lean
+++ b/src/analysis/inner_product_space/gram_schmidt_ortho.lean
@@ -183,12 +183,12 @@ begin
     rw coe_eq_zero,
     suffices : span 𝕜 (f '' set.Iic j) ≤ (𝕜 ∙ f i)ᗮ,
     { apply orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero,
-      apply mem_orthogonal_singleton_of_inner_left,
-      apply inner_right_of_mem_orthogonal_singleton,
+      rw mem_orthogonal_singleton_iff_inner_left,
+      rw ←mem_orthogonal_singleton_iff_inner_right,
       exact this (gram_schmidt_mem_span 𝕜 f (le_refl j)) },
     rw span_le,
     rintros - ⟨k, hk, rfl⟩,
-    apply mem_orthogonal_singleton_of_inner_left,
+    rw [set_like.mem_coe, mem_orthogonal_singleton_iff_inner_left],
     apply hf,
     refine (lt_of_le_of_lt hk _).ne,
     simpa using hj },
@@ -357,7 +357,7 @@ lemma inner_gram_schmidt_orthonormal_basis_eq_zero {f : ι → E} {i : ι}
   (hi : gram_schmidt_normed 𝕜 f i = 0) (j : ι) :
   ⟪gram_schmidt_orthonormal_basis h f i, f j⟫ = 0 :=
 begin
-  apply inner_right_of_mem_orthogonal_singleton,
+  rw ←mem_orthogonal_singleton_iff_inner_right,
   suffices : span 𝕜 (gram_schmidt_normed 𝕜 f '' Iic j)
     ≤ (𝕜 ∙ gram_schmidt_orthonormal_basis h f i)ᗮ,
   { apply this,
@@ -365,7 +365,7 @@ begin
     simpa using mem_span_gram_schmidt 𝕜 f (le_refl j) },
   rw span_le,
   rintros - ⟨k, -, rfl⟩,
-  apply mem_orthogonal_singleton_of_inner_left,
+  rw [set_like.mem_coe, mem_orthogonal_singleton_iff_inner_left],
   by_cases hk : gram_schmidt_normed 𝕜 f k = 0,
   { simp [hk] },
   rw ← gram_schmidt_orthonormal_basis_apply h hk,
diff --git a/src/analysis/inner_product_space/projection.lean b/src/analysis/inner_product_space/projection.lean
index defc6a6a1fa51..65841d853e12d 100644
--- a/src/analysis/inner_product_space/projection.lean
+++ b/src/analysis/inner_product_space/projection.lean
@@ -915,7 +915,7 @@ begin
   have h₁ : R (v - w) = -(v - w) := reflection_orthogonal_complement_singleton_eq_neg (v - w),
   have h₂ : R (v + w) = v + w,
   { apply reflection_mem_subspace_eq_self,
-    apply mem_orthogonal_singleton_of_inner_left,
+    rw submodule.mem_orthogonal_singleton_iff_inner_left,
     rw real_inner_add_sub_eq_zero_iff,
     exact h },
   convert congr_arg2 (+) h₂ h₁ using 1,
@@ -1096,7 +1096,7 @@ begin
       apply hV,
       rw hW w hw,
       refine reflection_mem_subspace_eq_self _,
-      apply mem_orthogonal_singleton_of_inner_left,
+      rw submodule.mem_orthogonal_singleton_iff_inner_left,
       exact submodule.sub_mem _ v.prop hφv _ hw },
     -- `v` is also fixed by `φ.trans ρ`
     have H₁V : (v : F) ∈ V,
diff --git a/src/analysis/inner_product_space/rayleigh.lean b/src/analysis/inner_product_space/rayleigh.lean
index 57359dd8d9072..95fe87c85c53c 100644
--- a/src/analysis/inner_product_space/rayleigh.lean
+++ b/src/analysis/inner_product_space/rayleigh.lean
@@ -97,7 +97,9 @@ lemma _root_.linear_map.is_symmetric.has_strict_fderiv_at_re_apply_inner_self
 begin
   convert T.has_strict_fderiv_at.inner (has_strict_fderiv_at_id x₀),
   ext y,
-  simp [_root_.bit0, hT.apply_clm x₀ y, real_inner_comm x₀]
+  simp_rw [_root_.bit0, continuous_linear_map.comp_apply, continuous_linear_map.add_apply,
+    innerSL_apply, fderiv_inner_clm_apply, id.def, continuous_linear_map.prod_apply,
+    continuous_linear_map.id_apply, hT.apply_clm x₀ y, real_inner_comm _ x₀],
 end
 
 variables [complete_space F] {T : F →L[ℝ] F}
diff --git a/src/analysis/inner_product_space/two_dim.lean b/src/analysis/inner_product_space/two_dim.lean
index 4dc3137d08582..40b94ce098482 100644
--- a/src/analysis/inner_product_space/two_dim.lean
+++ b/src/analysis/inner_product_space/two_dim.lean
@@ -215,7 +215,7 @@ def right_angle_rotation_aux₂ : E →ₗᵢ[ℝ] E :=
         have : finrank ℝ E = 2 := fact.out _,
         linarith },
       obtain ⟨w, hw₀⟩ : ∃ w : Kᗮ, w ≠ 0 := exists_ne 0,
-      have hw' : ⟪x, (w:E)⟫ = 0 := inner_right_of_mem_orthogonal_singleton x w.2, -- hw'₀,
+      have hw' : ⟪x, (w:E)⟫ = 0 := submodule.mem_orthogonal_singleton_iff_inner_right.mp w.2,
       have hw : (w:E) ≠ 0 := λ h, hw₀ (submodule.coe_eq_zero.mp h),
       refine le_of_mul_le_mul_right _ (by rwa norm_pos_iff : 0 < ‖(w:E)‖),
       rw ← o.abs_area_form_of_orthogonal hw',
diff --git a/src/analysis/locally_convex/balanced_core_hull.lean b/src/analysis/locally_convex/balanced_core_hull.lean
index 7d363ef2594ed..f7c65b6274326 100644
--- a/src/analysis/locally_convex/balanced_core_hull.lean
+++ b/src/analysis/locally_convex/balanced_core_hull.lean
@@ -211,7 +211,7 @@ begin
     refine is_closed_map_smul_of_ne_zero ha' U hU },
   convert is_closed_empty,
   contrapose! h,
-  exact balanced_core_nonempty_iff.mp (set.ne_empty_iff_nonempty.mp h),
+  exact balanced_core_nonempty_iff.mp (set.nonempty_iff_ne_empty.2 h),
 end
 
 lemma balanced_core_mem_nhds_zero (hU : U ∈ 𝓝 (0 : E)) : balanced_core 𝕜 U ∈ 𝓝 (0 : E) :=
diff --git a/src/analysis/normed/group/basic.lean b/src/analysis/normed/group/basic.lean
index 53654d2e0850f..88fc629764a1c 100644
--- a/src/analysis/normed/group/basic.lean
+++ b/src/analysis/normed/group/basic.lean
@@ -1193,7 +1193,7 @@ lemma le_norm_self (r : ℝ) : r ≤ ‖r‖ := le_abs_self r
 @[simp] lemma norm_coe_nat (n : ℕ) : ‖(n : ℝ)‖ = n := abs_of_nonneg n.cast_nonneg
 @[simp] lemma nnnorm_coe_nat (n : ℕ) : ‖(n : ℝ)‖₊ = n := nnreal.eq $ norm_coe_nat _
 
-@[simp] lemma norm_two : ‖(2 : ℝ)‖ = 2 := abs_of_pos (@zero_lt_two ℝ _ _)
+@[simp] lemma norm_two : ‖(2 : ℝ)‖ = 2 := abs_of_pos zero_lt_two
 
 @[simp] lemma nnnorm_two : ‖(2 : ℝ)‖₊ = 2 := nnreal.eq $ by simp
 
diff --git a/src/analysis/normed_space/basic.lean b/src/analysis/normed_space/basic.lean
index 315c0d6d6a289..598b8af33e5a5 100644
--- a/src/analysis/normed_space/basic.lean
+++ b/src/analysis/normed_space/basic.lean
@@ -3,6 +3,7 @@ Copyright (c) 2018 Patrick Massot. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot, Johannes Hölzl
 -/
+import algebra.algebra.pi
 import algebra.algebra.restrict_scalars
 import analysis.normed.field.basic
 import data.real.sqrt
diff --git a/src/analysis/normed_space/mazur_ulam.lean b/src/analysis/normed_space/mazur_ulam.lean
index b693a3234c559..07c94350d1be1 100644
--- a/src/analysis/normed_space/mazur_ulam.lean
+++ b/src/analysis/normed_space/mazur_ulam.lean
@@ -76,7 +76,7 @@ begin
   have : c ≤ c / 2,
   { apply csupr_le,
     rintros ⟨e, he⟩,
-    simp only [subtype.coe_mk, le_div_iff' (@zero_lt_two ℝ _ _), ← hf_dist],
+    simp only [subtype.coe_mk, le_div_iff' (zero_lt_two' ℝ), ← hf_dist],
     exact le_csupr h_bdd ⟨f e, hf_maps_to he⟩ },
   replace : c ≤ 0, { linarith },
   refine λ e hx hy, dist_le_zero.1 (le_trans _ this),
diff --git a/src/analysis/normed_space/operator_norm.lean b/src/analysis/normed_space/operator_norm.lean
index cdc5fddc547ac..364d681e6c05b 100644
--- a/src/analysis/normed_space/operator_norm.lean
+++ b/src/analysis/normed_space/operator_norm.lean
@@ -750,8 +750,18 @@ def mk_continuous₂ (f : E →ₛₗ[σ₁₃] F →ₛₗ[σ₂₃] G) (C : 
   E →SL[σ₁₃] F →SL[σ₂₃] G :=
 linear_map.mk_continuous
   { to_fun := λ x, (f x).mk_continuous (C * ‖x‖) (hC x),
-    map_add' := λ x y, by { ext z, simp },
-    map_smul' := λ c x, by { ext z, simp } }
+    map_add' := λ x y,
+    begin
+      ext z,
+      rw [continuous_linear_map.add_apply, mk_continuous_apply, mk_continuous_apply,
+          mk_continuous_apply, map_add, add_apply]
+    end,
+    map_smul' := λ c x,
+    begin
+      ext z,
+      rw [continuous_linear_map.smul_apply, mk_continuous_apply, mk_continuous_apply, map_smulₛₗ,
+          smul_apply]
+    end, }
   (max C 0) $ λ x, (mk_continuous_norm_le' _ _).trans_eq $
     by rw [max_mul_of_nonneg _ _ (norm_nonneg x), zero_mul]
 
diff --git a/src/analysis/normed_space/spectrum.lean b/src/analysis/normed_space/spectrum.lean
index 220d6649b36d5..96c73416faba3 100644
--- a/src/analysis/normed_space/spectrum.lean
+++ b/src/analysis/normed_space/spectrum.lean
@@ -375,7 +375,7 @@ protected theorem nonempty : (spectrum ℂ a).nonempty :=
 begin
   /- Suppose `σ a = ∅`, then resolvent set is `ℂ`, any `(z • 1 - a)` is a unit, and `resolvent`
   is differentiable on `ℂ`. -/
-  rw ←set.ne_empty_iff_nonempty,
+  rw set.nonempty_iff_ne_empty,
   by_contra h,
   have H₀ : resolvent_set ℂ a = set.univ, by rwa [spectrum, set.compl_empty_iff] at h,
   have H₁ : differentiable ℂ (λ z : ℂ, resolvent a z), from λ z,
diff --git a/src/analysis/special_functions/complex/arg.lean b/src/analysis/special_functions/complex/arg.lean
index a0df095158ea4..59b2e80c434ae 100644
--- a/src/analysis/special_functions/complex/arg.lean
+++ b/src/analysis/special_functions/complex/arg.lean
@@ -169,7 +169,7 @@ end
 by simp [arg, zero_le_one]
 
 @[simp] lemma arg_neg_one : arg (-1) = π :=
-by simp [arg, le_refl, not_le.2 (@zero_lt_one ℝ _ _)]
+by simp [arg, le_refl, not_le.2 (zero_lt_one' ℝ)]
 
 @[simp] lemma arg_I : arg I = π / 2 :=
 by simp [arg, le_refl]
diff --git a/src/analysis/special_functions/integrals.lean b/src/analysis/special_functions/integrals.lean
index 392fffb9c7455..9ec2348c984e2 100644
--- a/src/analysis/special_functions/integrals.lean
+++ b/src/analysis/special_functions/integrals.lean
@@ -409,7 +409,7 @@ lemma integral_sin_pow_aux :
     + (n + 1) * (∫ x in a..b, sin x ^ n) - (n + 1) * ∫ x in a..b, sin x ^ (n + 2) :=
 begin
   let C := sin a ^ (n + 1) * cos a - sin b ^ (n + 1) * cos b,
-  have h : ∀ α β γ : ℝ, α * (β * α * γ) = β * (α * α * γ) := λ α β γ, by ring,
+  have h : ∀ α β γ : ℝ, (β * α * γ) * α = β * (α * α * γ) := λ α β γ, by ring,
   have hu : ∀ x ∈ _, has_deriv_at (λ y, sin y ^ (n + 1)) ((n + 1 : ℕ) * cos x * sin x ^ n) x :=
     λ x hx, by simpa only [mul_right_comm] using (has_deriv_at_sin x).pow (n+1),
   have hv : ∀ x ∈ [a, b], has_deriv_at (-cos) (sin x) x :=
@@ -481,7 +481,7 @@ lemma integral_cos_pow_aux :
     + (n + 1) * (∫ x in a..b, cos x ^ n) - (n + 1) * ∫ x in a..b, cos x ^ (n + 2) :=
 begin
   let C := cos b ^ (n + 1) * sin b - cos a ^ (n + 1) * sin a,
-  have h : ∀ α β γ : ℝ, α * (β * α * γ) = β * (α * α * γ) := λ α β γ, by ring,
+  have h : ∀ α β γ : ℝ, (β * α * γ) * α = β * (α * α * γ) := λ α β γ, by ring,
   have hu : ∀ x ∈ _, has_deriv_at (λ y, cos y ^ (n + 1)) (-(n + 1 : ℕ) * sin x * cos x ^ n) x :=
     λ x hx, by simpa only [mul_right_comm, neg_mul, mul_neg]
       using (has_deriv_at_cos x).pow (n+1),
diff --git a/src/analysis/special_functions/pow.lean b/src/analysis/special_functions/pow.lean
index 489d8aacbd799..448127aefa8fa 100644
--- a/src/analysis/special_functions/pow.lean
+++ b/src/analysis/special_functions/pow.lean
@@ -775,7 +775,7 @@ by rw [rpow_def_of_pos hx, one_lt_exp_iff, mul_pos_iff, log_pos_iff hx, log_neg_
 lemma one_lt_rpow_iff (hx : 0 ≤ x) : 1 < x ^ y ↔ 1 < x ∧ 0 < y ∨ 0 < x ∧ x < 1 ∧ y < 0 :=
 begin
   rcases hx.eq_or_lt with (rfl|hx),
-  { rcases em (y = 0) with (rfl|hy); simp [*, lt_irrefl, (@zero_lt_one ℝ _ _).not_lt] },
+  { rcases em (y = 0) with (rfl|hy); simp [*, lt_irrefl, (zero_lt_one' ℝ).not_lt] },
   { simp [one_lt_rpow_iff_of_pos hx, hx] }
 end
 
diff --git a/src/analysis/special_functions/trigonometric/angle.lean b/src/analysis/special_functions/trigonometric/angle.lean
index 0db6734f7decb..d670c850c3f76 100644
--- a/src/analysis/special_functions/trigonometric/angle.lean
+++ b/src/analysis/special_functions/trigonometric/angle.lean
@@ -71,6 +71,18 @@ begin
   simp [two_mul, sub_eq_add_neg]
 end
 
+@[simp] lemma two_nsmul_coe_div_two (θ : ℝ) : (2 : ℕ) • (↑(θ / 2) : angle) = θ :=
+by rw [←coe_nsmul, two_nsmul, add_halves]
+
+@[simp] lemma two_zsmul_coe_div_two (θ : ℝ) : (2 : ℤ) • (↑(θ / 2) : angle) = θ :=
+by rw [←coe_zsmul, two_zsmul, add_halves]
+
+@[simp] lemma two_nsmul_neg_pi_div_two : (2 : ℕ) • (↑(-π / 2) : angle) = π :=
+by rw [two_nsmul_coe_div_two, coe_neg, neg_coe_pi]
+
+@[simp] lemma two_zsmul_neg_pi_div_two : (2 : ℤ) • (↑(-π / 2) : angle) = π :=
+by rw [two_zsmul, ←two_nsmul, two_nsmul_neg_pi_div_two]
+
 lemma sub_coe_pi_eq_add_coe_pi (θ : angle) : θ - π = θ + π :=
 by rw [sub_eq_add_neg, neg_coe_pi]
 
@@ -536,6 +548,65 @@ lemma abs_to_real_eq_pi_div_two_iff {θ : angle} :
 by rw [abs_eq (div_nonneg real.pi_pos.le two_pos.le), ←neg_div, to_real_eq_pi_div_two_iff,
        to_real_eq_neg_pi_div_two_iff]
 
+lemma nsmul_to_real_eq_mul {n : ℕ} (h : n ≠ 0) {θ : angle} :
+  (n • θ).to_real = n * θ.to_real ↔ θ.to_real ∈ set.Ioc (-π / n) (π / n) :=
+begin
+  nth_rewrite 0 ←coe_to_real θ,
+  have h' : 0 < (n : ℝ), { exact_mod_cast nat.pos_of_ne_zero h },
+  rw [←coe_nsmul, nsmul_eq_mul, to_real_coe_eq_self_iff, set.mem_Ioc, div_lt_iff' h',
+      le_div_iff' h']
+end
+
+lemma two_nsmul_to_real_eq_two_mul {θ : angle} :
+  ((2 : ℕ) • θ).to_real = 2 * θ.to_real ↔ θ.to_real ∈ set.Ioc (-π / 2) (π / 2) :=
+by exact_mod_cast nsmul_to_real_eq_mul two_ne_zero
+
+lemma two_zsmul_to_real_eq_two_mul {θ : angle} :
+  ((2 : ℤ) • θ).to_real = 2 * θ.to_real ↔ θ.to_real ∈ set.Ioc (-π / 2) (π / 2) :=
+by rw [two_zsmul, ←two_nsmul, two_nsmul_to_real_eq_two_mul]
+
+lemma to_real_coe_eq_self_sub_two_mul_int_mul_pi_iff {θ : ℝ} {k : ℤ} :
+  (θ : angle).to_real = θ - 2 * k * π ↔ θ ∈ set.Ioc ((2 * k - 1 : ℝ) * π) ((2 * k + 1) * π) :=
+begin
+  rw [←sub_zero (θ : angle), ←zsmul_zero k, ←coe_two_pi, ←coe_zsmul, ←coe_sub,
+      zsmul_eq_mul, ←mul_assoc, mul_comm (k : ℝ), to_real_coe_eq_self_iff, set.mem_Ioc],
+  exact ⟨λ h, ⟨by linarith, by linarith⟩, λ h, ⟨by linarith, by linarith⟩⟩
+end
+
+lemma to_real_coe_eq_self_sub_two_pi_iff {θ : ℝ} :
+  (θ : angle).to_real = θ - 2 * π ↔ θ ∈ set.Ioc π (3 * π) :=
+by { convert @to_real_coe_eq_self_sub_two_mul_int_mul_pi_iff θ 1; norm_num }
+
+lemma to_real_coe_eq_self_add_two_pi_iff {θ : ℝ} :
+  (θ : angle).to_real = θ + 2 * π ↔ θ ∈ set.Ioc (-3 * π) (-π) :=
+by { convert @to_real_coe_eq_self_sub_two_mul_int_mul_pi_iff θ (-1); norm_num }
+
+lemma two_nsmul_to_real_eq_two_mul_sub_two_pi {θ : angle} :
+  ((2 : ℕ) • θ).to_real = 2 * θ.to_real - 2 * π ↔ π / 2 < θ.to_real :=
+begin
+  nth_rewrite 0 ←coe_to_real θ,
+  rw [←coe_nsmul, two_nsmul, ←two_mul, to_real_coe_eq_self_sub_two_pi_iff, set.mem_Ioc],
+  exact ⟨λ h, by linarith,
+         λ h, ⟨(div_lt_iff' (zero_lt_two' ℝ)).1 h, by linarith [pi_pos, to_real_le_pi θ]⟩⟩
+end
+
+lemma two_zsmul_to_real_eq_two_mul_sub_two_pi {θ : angle} :
+  ((2 : ℤ) • θ).to_real = 2 * θ.to_real - 2 * π ↔ π / 2 < θ.to_real :=
+by rw [two_zsmul, ←two_nsmul, two_nsmul_to_real_eq_two_mul_sub_two_pi]
+
+lemma two_nsmul_to_real_eq_two_mul_add_two_pi {θ : angle} :
+  ((2 : ℕ) • θ).to_real = 2 * θ.to_real + 2 * π ↔ θ.to_real ≤ -π / 2 :=
+begin
+  nth_rewrite 0 ←coe_to_real θ,
+  rw [←coe_nsmul, two_nsmul, ←two_mul, to_real_coe_eq_self_add_two_pi_iff, set.mem_Ioc],
+  refine ⟨λ h, by linarith,
+          λ h, ⟨by linarith [pi_pos, neg_pi_lt_to_real θ], (le_div_iff' (zero_lt_two' ℝ)).1 h⟩⟩
+end
+
+lemma two_zsmul_to_real_eq_two_mul_add_two_pi {θ : angle} :
+  ((2 : ℤ) • θ).to_real = 2 * θ.to_real + 2 * π ↔ θ.to_real ≤ -π / 2 :=
+by rw [two_zsmul, ←two_nsmul, two_nsmul_to_real_eq_two_mul_add_two_pi]
+
 @[simp] lemma sin_to_real (θ : angle) : real.sin θ.to_real = sin θ :=
 by conv_rhs { rw [← coe_to_real θ, sin_coe] }
 
@@ -569,6 +640,21 @@ end
 lemma cos_neg_iff_pi_div_two_lt_abs_to_real {θ : angle} : cos θ < 0 ↔ π / 2 < |θ.to_real| :=
 by rw [←not_le, ←not_le, not_iff_not, cos_nonneg_iff_abs_to_real_le_pi_div_two]
 
+lemma abs_cos_eq_abs_sin_of_two_nsmul_add_two_nsmul_eq_pi {θ ψ : angle}
+  (h : (2 : ℕ) • θ + (2 : ℕ) • ψ = π) : |cos θ| = |sin ψ| :=
+begin
+  rw [←eq_sub_iff_add_eq, ←two_nsmul_coe_div_two, ←nsmul_sub, two_nsmul_eq_iff] at h,
+  rcases h with rfl | rfl;
+    simp [cos_pi_div_two_sub]
+end
+
+lemma abs_cos_eq_abs_sin_of_two_zsmul_add_two_zsmul_eq_pi {θ ψ : angle}
+  (h : (2 : ℤ) • θ + (2 : ℤ) • ψ = π) : |cos θ| = |sin ψ| :=
+begin
+  simp_rw [two_zsmul, ←two_nsmul] at h,
+  exact abs_cos_eq_abs_sin_of_two_nsmul_add_two_nsmul_eq_pi h
+end
+
 /-- The tangent of a `real.angle`. -/
 def tan (θ : angle) : ℝ := sin θ / cos θ
 
@@ -759,6 +845,47 @@ begin
   exact sin_nonneg_of_nonneg_of_le_pi h0 hpi
 end
 
+lemma sign_two_nsmul_eq_sign_iff {θ : angle} :
+  ((2 : ℕ) • θ).sign = θ.sign ↔ (θ = π ∨ |θ.to_real| < π / 2) :=
+begin
+  by_cases hpi : θ = π, { simp [hpi] },
+  rw or_iff_right hpi,
+  refine ⟨λ h, _, λ h, _⟩,
+  { by_contra hle,
+    rw [not_lt, le_abs, le_neg] at hle,
+    have hpi' : θ.to_real ≠ π, { simpa using hpi },
+    rcases hle with hle | hle; rcases hle.eq_or_lt with heq | hlt,
+    { rw [←coe_to_real θ, ←heq] at h, simpa using h },
+    { rw [←sign_to_real hpi, sign_pos (pi_div_two_pos.trans hlt),
+          ←sign_to_real, two_nsmul_to_real_eq_two_mul_sub_two_pi.2 hlt, _root_.sign_neg] at h,
+      { simpa using h },
+      { rw ←mul_sub,
+        exact mul_neg_of_pos_of_neg two_pos (sub_neg.2 ((to_real_le_pi _).lt_of_ne hpi')) },
+      { intro he, simpa [he] using h } },
+    { rw [←coe_to_real θ, heq] at h, simpa using h },
+    { rw [←sign_to_real hpi,
+          _root_.sign_neg (hlt.trans (left.neg_neg_iff.2 pi_div_two_pos)),
+          ←sign_to_real] at h, swap, { intro he, simpa [he] using h },
+      rw ←neg_div at hlt,
+      rw [two_nsmul_to_real_eq_two_mul_add_two_pi.2 hlt.le, sign_pos] at h,
+      { simpa using h },
+      { linarith [neg_pi_lt_to_real θ] } } },
+  { have hpi' : (2 : ℕ) • θ ≠ π,
+    { rw [ne.def, two_nsmul_eq_pi_iff, not_or_distrib],
+      split,
+      { rintro rfl, simpa [pi_pos, div_pos, abs_of_pos] using h },
+      { rintro rfl,
+        rw [to_real_neg_pi_div_two] at h,
+        simpa [pi_pos, div_pos, neg_div, abs_of_pos] using h } },
+    rw [abs_lt, ←neg_div] at h,
+    rw [←sign_to_real hpi, ←sign_to_real hpi', two_nsmul_to_real_eq_two_mul.2 ⟨h.1, h.2.le⟩,
+        sign_mul, sign_pos (zero_lt_two' ℝ), one_mul] }
+end
+
+lemma sign_two_zsmul_eq_sign_iff {θ : angle} :
+  ((2 : ℤ) • θ).sign = θ.sign ↔ (θ = π ∨ |θ.to_real| < π / 2) :=
+by rw [two_zsmul, ←two_nsmul, sign_two_nsmul_eq_sign_iff]
+
 lemma continuous_at_sign {θ : angle} (h0 : θ ≠ 0) (hpi : θ ≠ π) : continuous_at sign θ :=
 (continuous_at_sign_of_ne_zero (sin_ne_zero_iff.2 ⟨h0, hpi⟩)).comp continuous_sin.continuous_at
 
diff --git a/src/analysis/special_functions/trigonometric/inverse_deriv.lean b/src/analysis/special_functions/trigonometric/inverse_deriv.lean
index e56958eabf62c..152623840582c 100644
--- a/src/analysis/special_functions/trigonometric/inverse_deriv.lean
+++ b/src/analysis/special_functions/trigonometric/inverse_deriv.lean
@@ -82,7 +82,7 @@ begin
   refine ⟨_, λ h, (has_deriv_within_at_arcsin_Ici h).differentiable_within_at⟩,
   rintro h rfl,
   have : sin ∘ arcsin =ᶠ[𝓝[≥] (-1 : ℝ)] id,
-  { filter_upwards [Icc_mem_nhds_within_Ici ⟨le_rfl, neg_lt_self (@zero_lt_one ℝ _ _)⟩]
+  { filter_upwards [Icc_mem_nhds_within_Ici ⟨le_rfl, neg_lt_self (zero_lt_one' ℝ)⟩]
       with x using sin_arcsin', },
   have := h.has_deriv_within_at.sin.congr_of_eventually_eq this.symm (by simp),
   simpa using (unique_diff_on_Ici _ _ left_mem_Ici).eq_deriv _ this (has_deriv_within_at_id _ _)
diff --git a/src/analysis/specific_limits/normed.lean b/src/analysis/specific_limits/normed.lean
index f2ea85546c0e6..47c7d7a5d578a 100644
--- a/src/analysis/specific_limits/normed.lean
+++ b/src/analysis/specific_limits/normed.lean
@@ -78,7 +78,7 @@ end
 
 @[simp] lemma continuous_at_inv {𝕜 : Type*} [nontrivially_normed_field 𝕜] {x : 𝕜} :
   continuous_at has_inv.inv x ↔ x ≠ 0 :=
-by simpa [(@zero_lt_one ℤ _ _).not_le] using @continuous_at_zpow _ _ (-1) x
+by simpa [(zero_lt_one' ℤ).not_le] using @continuous_at_zpow _ _ (-1) x
 
 end normed_field
 
diff --git a/src/category_theory/idempotents/biproducts.lean b/src/category_theory/idempotents/biproducts.lean
index d6bf84f8a2544..c91026bedf70b 100644
--- a/src/category_theory/idempotents/biproducts.lean
+++ b/src/category_theory/idempotents/biproducts.lean
@@ -63,11 +63,10 @@ def bicone [has_finite_biproducts C] {J : Type} [fintype J]
   ι_π := λ j j', begin
     split_ifs,
     { subst h,
-      simp only [biproduct.bicone_ι, biproduct.ι_map, biproduct.bicone_π,
-        biproduct.ι_π_self_assoc, comp, category.assoc, eq_to_hom_refl, id_eq,
-        biproduct.map_π, (F j).idem], },
-    { simpa only [hom_ext, biproduct.ι_π_ne_assoc _ h, assoc,
-        biproduct.map_π, biproduct.map_π_assoc, zero_comp, comp], },
+      simp only [assoc, idem, biproduct.map_π, biproduct.map_π_assoc, eq_to_hom_refl,
+        id_eq, hom_ext, comp_f, biproduct.ι_π_self_assoc], },
+    { simp only [biproduct.ι_π_ne_assoc _ h, assoc, biproduct.map_π,
+        biproduct.map_π_assoc, hom_ext, comp_f, zero_comp, quiver.hom.add_comm_group_zero_f], },
   end, }
 
 end biproducts
@@ -83,7 +82,7 @@ lemma karoubi_has_finite_biproducts [has_finite_biproducts C] :
       rw [sum_hom, comp_sum, finset.sum_eq_single j], rotate,
       { intros j' h1 h2,
         simp only [biproduct.ι_map, biproducts.bicone_ι_f, biproducts.bicone_π_f,
-          assoc, comp, biproduct.map_π],
+          assoc, comp_f, biproduct.map_π],
         slice_lhs 1 2 { rw biproduct.ι_π, },
         split_ifs,
         { exfalso, exact h2 h.symm, },
@@ -91,7 +90,7 @@ lemma karoubi_has_finite_biproducts [has_finite_biproducts C] :
       { intro h,
         exfalso,
         simpa only [finset.mem_univ, not_true] using h, },
-      { simp only [biproducts.bicone_π_f, comp,
+      { simp only [biproducts.bicone_π_f, comp_f,
           biproduct.ι_map, assoc, biproducts.bicone_ι_f, biproduct.map_π],
         slice_lhs 1 2 { rw biproduct.ι_π, },
         split_ifs, swap, { exfalso, exact h rfl, },
@@ -119,12 +118,12 @@ has_binary_biproduct_of_total
   inr := P.complement.decomp_id_i,
   inl_fst' := P.decomp_id.symm,
   inl_snd' := begin
-    simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp,
+    simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp_f,
       hom_ext, quiver.hom.add_comm_group_zero_f, P.idem],
     erw [comp_id, sub_self],
   end,
   inr_fst' := begin
-    simp only [decomp_id_i_f, complement_p, decomp_id_p_f, sub_comp, comp,
+    simp only [decomp_id_i_f, complement_p, decomp_id_p_f, sub_comp, comp_f,
       hom_ext, quiver.hom.add_comm_group_zero_f, P.idem],
     erw [id_comp, sub_self],
   end,
@@ -144,14 +143,14 @@ def decomposition (P : karoubi C) : P ⊞ P.complement ≅ (to_karoubi _).obj P.
         ← decomp_id, id_comp, add_right_eq_self],
       convert zero_comp,
       ext,
-      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp,
+      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp_f,
         quiver.hom.add_comm_group_zero_f, P.idem],
       erw [comp_id, sub_self], },
     { simp only [← assoc, biprod.inr_desc, biprod.lift_eq, comp_add,
         ← decomp_id, comp_id, id_comp, add_left_eq_self],
       convert zero_comp,
       ext,
-      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, sub_comp, comp,
+      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, sub_comp, comp_f,
         quiver.hom.add_comm_group_zero_f, P.idem],
       erw [id_comp, sub_self], }
   end,
diff --git a/src/category_theory/idempotents/functor_categories.lean b/src/category_theory/idempotents/functor_categories.lean
index baf4b966076a8..ca71ecfa055a6 100644
--- a/src/category_theory/idempotents/functor_categories.lean
+++ b/src/category_theory/idempotents/functor_categories.lean
@@ -27,7 +27,24 @@ namespace category_theory
 
 namespace idempotents
 
-variables (J C : Type*) [category J] [category C]
+variables {J C : Type*} [category J] [category C] (P Q : karoubi (J ⥤ C)) (f : P ⟶ Q) (X : J)
+
+@[simp, reassoc]
+lemma app_idem :
+  P.p.app X ≫ P.p.app X = P.p.app X := congr_app P.idem X
+
+variables {P Q}
+
+@[simp, reassoc]
+lemma app_p_comp : P.p.app X ≫ f.f.app X = f.f.app X := congr_app (p_comp f) X
+
+@[simp, reassoc]
+lemma app_comp_p : f.f.app X ≫ Q.p.app X = f.f.app X := congr_app (comp_p f) X
+
+@[reassoc]
+lemma app_p_comm : P.p.app X ≫ f.f.app X = f.f.app X ≫ Q.p.app X := congr_app (p_comm f) X
+
+variables (J C)
 
 instance functor_category_is_idempotent_complete [is_idempotent_complete C] :
   is_idempotent_complete (J ⥤ C) :=
@@ -81,32 +98,12 @@ def obj (P : karoubi (J ⥤ C)) : J ⥤ karoubi C :=
       have h := congr_app P.idem j,
       rw [nat_trans.comp_app] at h,
       slice_rhs 1 3 { erw [h, h], },
-    end },
-  map_id' := λ j, by { ext, simp only [functor.map_id, comp_id, id_eq], },
-  map_comp' := λ j j' j'' φ φ', begin
-    ext,
-    have h := congr_app P.idem j,
-    rw [nat_trans.comp_app] at h,
-    simp only [assoc, nat_trans.naturality_assoc, functor.map_comp, comp],
-    slice_rhs 1 2 { rw h, },
-    rw [assoc],
-  end }
+    end }, }
 
 /-- Tautological action on maps of the functor `karoubi (J ⥤ C) ⥤ (J ⥤ karoubi C)`. -/
 @[simps]
 def map {P Q : karoubi (J ⥤ C)} (f : P ⟶ Q) : obj P ⟶ obj Q :=
-{ app := λ j, ⟨f.f.app j, congr_app f.comm j⟩,
-  naturality' := λ j j' φ, begin
-    ext,
-    simp only [comp],
-    have h := congr_app (comp_p f) j,
-    have h' := congr_app (p_comp f) j',
-    dsimp at h h' ⊢,
-    slice_rhs 1 2 { erw h, },
-    rw ← P.p.naturality,
-    slice_lhs 2 3 { erw h', },
-    rw f.f.naturality,
-  end }
+{ app := λ j, ⟨f.f.app j, congr_app f.comm j⟩, }
 
 end karoubi_functor_category_embedding
 
@@ -117,20 +114,18 @@ variables (J C)
 def karoubi_functor_category_embedding :
   karoubi (J ⥤ C) ⥤ (J ⥤ karoubi C) :=
 { obj := karoubi_functor_category_embedding.obj,
-  map := λ P Q, karoubi_functor_category_embedding.map,
-  map_id' := λ P, rfl,
-  map_comp' := λ P Q R f g, rfl, }
+  map := λ P Q, karoubi_functor_category_embedding.map, }
 
 instance : full (karoubi_functor_category_embedding J C) :=
 { preimage := λ P Q f,
   { f :=
     { app := λ j, (f.app j).f,
       naturality' := λ j j' φ, begin
-        slice_rhs 1 1 { rw ← karoubi.comp_p, },
+        rw ← karoubi.comp_p_assoc,
         have h := hom_ext.mp (f.naturality φ),
-        simp only [comp] at h,
-        dsimp [karoubi_functor_category_embedding] at h ⊢,
-        erw [assoc, ← h, ← P.p.naturality φ, assoc, p_comp (f.app j')],
+        simp only [comp_f] at h,
+        dsimp [karoubi_functor_category_embedding] at h,
+        erw [← h, assoc, ← P.p.naturality_assoc φ, p_comp (f.app j')],
       end },
     comm := by { ext j, exact (f.app j).comm, } },
   witness' := λ P Q f, by { ext j, refl, }, }
@@ -161,24 +156,6 @@ begin
       refl, }, }
 end
 
-variables {J C} (P Q : karoubi (J ⥤ C)) (f : P ⟶ Q) (X : J)
-
-
-@[simp, reassoc]
-lemma app_idem (X : J) :
-  P.p.app X ≫ P.p.app X = P.p.app X := congr_app P.idem X
-
-variables {P Q}
-
-@[simp, reassoc]
-lemma app_p_comp : P.p.app X ≫ f.f.app X = f.f.app X := congr_app (p_comp f) X
-
-@[simp, reassoc]
-lemma app_comp_p : f.f.app X ≫ Q.p.app X = f.f.app X := congr_app (comp_p f) X
-
-@[reassoc]
-lemma app_p_comm : P.p.app X ≫ f.f.app X = f.f.app X ≫ Q.p.app X := congr_app (p_comm f) X
-
 end idempotents
 
 end category_theory
diff --git a/src/category_theory/idempotents/functor_extension.lean b/src/category_theory/idempotents/functor_extension.lean
index 671ba27b7abec..2178e4be73b4c 100644
--- a/src/category_theory/idempotents/functor_extension.lean
+++ b/src/category_theory/idempotents/functor_extension.lean
@@ -10,13 +10,21 @@ import category_theory.idempotents.karoubi
 # Extension of functors to the idempotent completion
 
 In this file, we construct an extension `functor_extension₁`
-of functors `C ⥤ karoubi D` to functors `karoubi C ⥤ karoubi D`.
+of functors `C ⥤ karoubi D` to functors `karoubi C ⥤ karoubi D`. This results in an
+equivalence `karoubi_universal₁ C D : (C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)`.
+
+We also construct an extension `functor_extension₂` of functors
+`(C ⥤ D) ⥤ (karoubi C ⥤ karoubi D)`. Moreover,
+when `D` is idempotent complete, we get equivalences
+`karoubi_universal₂ C D : C ⥤ D ≌ karoubi C ⥤ karoubi D`
+and `karoubi_universal C D : C ⥤ D ≌ karoubi C ⥤ D`.
+
+We occasionally state and use equalities of functors because it is
+sometimes convenient to use rewrites when proving properties of
+functors obtained using the constructions in this file. Users are
+encouraged to use the corresponding natural isomorphism
+whenever possible.
 
-TODO : Obtain the equivalences
-`karoubi_universal₁ C D : C ⥤ karoubi D ≌ karoubi C ⥤ karoubi D`
-for all categories, and
-`karoubi_universal C D : C ⥤ D ≌ karoubi C ⥤ D`.
-when `D` is idempotent complete
 -/
 
 open category_theory.category
@@ -60,7 +68,7 @@ def map {F G : C ⥤ karoubi D} (φ : F ⟶ G) : obj F ⟶ obj G :=
     comm := begin
       have h := φ.naturality P.p,
       have h' := F.congr_map P.idem,
-      simp only [hom_ext, karoubi.comp, F.map_comp] at h h',
+      simp only [hom_ext, karoubi.comp_f, F.map_comp] at h h',
       simp only [obj_obj_p, assoc, ← h],
       slice_rhs 1 3 { rw [h', h'], },
     end, },
@@ -70,7 +78,7 @@ def map {F G : C ⥤ karoubi D} (φ : F ⟶ G) : obj F ⟶ obj G :=
     have h := φ.naturality f.f,
     have h' := F.congr_map (comp_p f),
     have h'' := F.congr_map (p_comp f),
-    simp only [hom_ext, functor.map_comp, comp] at ⊢ h h' h'',
+    simp only [hom_ext, functor.map_comp, comp_f] at ⊢ h h' h'',
     slice_rhs 2 3 { rw ← h, },
     slice_lhs 1 2 { rw h', },
     slice_rhs 1 2 { rw h'', },
@@ -88,10 +96,10 @@ def functor_extension₁ : (C ⥤ karoubi D) ⥤ (karoubi C ⥤ karoubi D) :=
   map_id' := λ F, by { ext P, exact comp_p (F.map P.p), },
   map_comp' := λ F G H φ φ', begin
     ext P,
-    simp only [comp, functor_extension₁.map_app_f, nat_trans.comp_app, assoc],
+    simp only [comp_f, functor_extension₁.map_app_f, nat_trans.comp_app, assoc],
     have h := φ.naturality P.p,
     have h' := F.congr_map P.idem,
-    simp only [hom_ext, comp, F.map_comp] at h h',
+    simp only [hom_ext, comp_f, F.map_comp] at h h',
     slice_rhs 2 3 { rw ← h, },
     slice_rhs 1 2 { rw h', },
     simp only [assoc],
@@ -113,17 +121,156 @@ begin
       ext,
       dsimp,
       simp only [comp_id, eq_to_hom_f, eq_to_hom_refl, comp_p, functor_extension₁.obj_obj_p,
-        to_karoubi_obj_p, comp],
+        to_karoubi_obj_p, comp_f],
       dsimp,
       simp only [functor.map_id, id_eq, p_comp], }, },
   { intros F G φ,
     ext X,
     dsimp,
-    simp only [eq_to_hom_app, F.map_id, karoubi.comp, eq_to_hom_f, id_eq, p_comp,
+    simp only [eq_to_hom_app, F.map_id, comp_f, eq_to_hom_f, id_eq, p_comp,
       eq_to_hom_refl, comp_id, comp_p, functor_extension₁.obj_obj_p,
       to_karoubi_obj_p, F.map_id X], },
 end
 
+/-- The natural isomorphism expressing that functors `karoubi C ⥤ karoubi D` obtained
+using `functor_extension₁` actually extends the original functors `C ⥤ karoubi D`. -/
+@[simps]
+def functor_extension₁_comp_whiskering_left_to_karoubi_iso :
+  functor_extension₁ C D ⋙
+    (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) ≅ 𝟭 _ :=
+eq_to_iso (functor_extension₁_comp_whiskering_left_to_karoubi C D)
+
+/-- The counit isomorphism of the equivalence `(C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)`. -/
+@[simps]
+def karoubi_universal₁.counit_iso :
+  (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) ⋙
+    functor_extension₁ C D ≅ 𝟭 _ :=
+nat_iso.of_components (λ G,
+  { hom :=
+    { app := λ P,
+      { f := (G.map (decomp_id_p P)).f,
+        comm := by simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map
+          (show P.decomp_id_p = (to_karoubi C).map P.p ≫ P.decomp_id_p ≫ 𝟙 _, by simp), },
+      naturality' := λ P Q f,
+        by simpa only [hom_ext, G.map_comp] using (G.congr_map (decomp_id_p_naturality f)).symm, },
+    inv :=
+    { app := λ P,
+      { f := (G.map (decomp_id_i P)).f,
+        comm := by simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map
+          (show P.decomp_id_i = 𝟙 _ ≫ P.decomp_id_i ≫ (to_karoubi C).map P.p, by simp), },
+      naturality' := λ P Q f,
+        by simpa only [hom_ext, G.map_comp] using G.congr_map (decomp_id_i_naturality f), },
+    hom_inv_id' := begin
+      ext P,
+      simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map P.decomp_p.symm,
+    end,
+    inv_hom_id' := begin
+      ext P,
+      simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map P.decomp_id.symm,
+    end, })
+(λ G₁ G₂ φ, begin
+  ext P,
+  dsimp,
+  simpa only [nat_trans_eq φ P, comp_f, functor_extension₁.map_app_f,
+    functor.comp_map, whisker_left_app, assoc, P.decomp_p, G₁.map_comp],
+end)
+
+/-- The equivalence of categories `(C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)`. -/
+@[simps]
+def karoubi_universal₁ : (C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D) :=
+{ functor := functor_extension₁ C D,
+  inverse := (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C),
+  unit_iso := (functor_extension₁_comp_whiskering_left_to_karoubi_iso C D).symm,
+  counit_iso := karoubi_universal₁.counit_iso C D,
+  functor_unit_iso_comp' := λ F, begin
+    ext P,
+    dsimp [functor_extension₁.map, karoubi_universal₁.counit_iso],
+    simpa only [comp_f, eq_to_hom_app, eq_to_hom_f, eq_to_hom_refl, comp_id,
+      hom_ext, F.map_comp, comp_p] using F.congr_map P.idem,
+  end, }
+
+lemma functor_extension₁_comp (F : C ⥤ karoubi D) (G : D ⥤ karoubi E) :
+  (functor_extension₁ C E).obj (F ⋙ (functor_extension₁ D E).obj G) =
+    (functor_extension₁ C D).obj F ⋙ (functor_extension₁ D E).obj G :=
+functor.ext (by tidy) (λ X Y f, by { dsimp, simpa only [id_comp, comp_id], })
+
+/-- The canonical functor `(C ⥤ D) ⥤ (karoubi C ⥤ karoubi D)` -/
+@[simps]
+def functor_extension₂ : (C ⥤ D) ⥤ (karoubi C ⥤ karoubi D) :=
+(whiskering_right C D (karoubi D)).obj (to_karoubi D) ⋙ functor_extension₁ C D
+
+lemma functor_extension₂_comp_whiskering_left_to_karoubi :
+  functor_extension₂ C D ⋙ (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) =
+  (whiskering_right C D (karoubi D)).obj (to_karoubi D) :=
+by simp only [functor_extension₂, functor.assoc,
+  functor_extension₁_comp_whiskering_left_to_karoubi, functor.comp_id]
+
+/-- The natural isomorphism expressing that functors `karoubi C ⥤ karoubi D` obtained
+using `functor_extension₂` actually extends the original functors `C ⥤ D`. -/
+@[simps]
+def functor_extension₂_comp_whiskering_left_to_karoubi_iso :
+  functor_extension₂ C D ⋙ (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) ≅
+  (whiskering_right C D (karoubi D)).obj (to_karoubi D) :=
+eq_to_iso (functor_extension₂_comp_whiskering_left_to_karoubi C D)
+
+section is_idempotent_complete
+
+variable [is_idempotent_complete D]
+
+noncomputable instance : is_equivalence (to_karoubi D) := to_karoubi_is_equivalence D
+
+/-- The equivalence of categories `(C ⥤ D) ≌ (karoubi C ⥤ karoubi D)` when `D`
+is idempotent complete. -/
+@[simps]
+noncomputable def karoubi_universal₂ : (C ⥤ D) ≌ (karoubi C ⥤ karoubi D) :=
+(equivalence.congr_right (to_karoubi D).as_equivalence).trans
+    (karoubi_universal₁ C D)
+
+lemma karoubi_universal₂_functor_eq :
+  (karoubi_universal₂ C D).functor = functor_extension₂ C D := rfl
+
+noncomputable instance : is_equivalence (functor_extension₂ C D) :=
+by { rw ← karoubi_universal₂_functor_eq, apply_instance, }
+
+/-- The extension of functors functor `(C ⥤ D) ⥤ (karoubi C ⥤ D)`
+when `D` is idempotent compltete. -/
+@[simps]
+noncomputable def functor_extension : (C ⥤ D) ⥤ (karoubi C ⥤ D) :=
+functor_extension₂ C D ⋙ (whiskering_right (karoubi C) (karoubi D) D).obj
+    (to_karoubi_is_equivalence D).inverse
+
+/-- The equivalence `(C ⥤ D) ≌ (karoubi C ⥤ D)` when `D` is idempotent complete. -/
+@[simps]
+noncomputable def karoubi_universal : (C ⥤ D) ≌ (karoubi C ⥤ D) :=
+(karoubi_universal₂ C D).trans (equivalence.congr_right (to_karoubi D).as_equivalence.symm)
+
+lemma karoubi_universal_functor_eq :
+  (karoubi_universal C D).functor = functor_extension C D := rfl
+
+noncomputable instance : is_equivalence (functor_extension C D) :=
+by { rw ← karoubi_universal_functor_eq, apply_instance, }
+
+noncomputable instance : is_equivalence ((whiskering_left C (karoubi C) D).obj (to_karoubi C)) :=
+is_equivalence.cancel_comp_right _ ((whiskering_right C _ _).obj (to_karoubi D) ⋙
+    (whiskering_right C _ _).obj (to_karoubi D).inv)
+  (is_equivalence.of_equivalence (@equivalence.congr_right _ _ _ _ C _
+      ((to_karoubi D).as_equivalence.trans (to_karoubi D).as_equivalence.symm)))
+  (by { change is_equivalence (karoubi_universal C D).inverse, apply_instance, })
+
+variables {C D}
+
+lemma whiskering_left_obj_preimage_app {F G : karoubi C ⥤ D}
+  (τ : to_karoubi _ ⋙ F ⟶ to_karoubi _ ⋙ G) (P : karoubi C) :
+  (((whiskering_left _ _ _).obj (to_karoubi _)).preimage τ).app P =
+    F.map P.decomp_id_i ≫ τ.app P.X ≫ G.map P.decomp_id_p :=
+begin
+  rw nat_trans_eq,
+  congr' 2,
+  exact congr_app (((whiskering_left _ _ _).obj (to_karoubi _)).image_preimage τ) P.X,
+end
+
+end is_idempotent_complete
+
 end idempotents
 
 end category_theory
diff --git a/src/category_theory/idempotents/homological_complex.lean b/src/category_theory/idempotents/homological_complex.lean
index 9f1409bbc5c68..5db952eacb7aa 100644
--- a/src/category_theory/idempotents/homological_complex.lean
+++ b/src/category_theory/idempotents/homological_complex.lean
@@ -11,16 +11,15 @@ import category_theory.idempotents.karoubi
 # Idempotent completeness and homological complexes
 
 This file contains simplifications lemmas for categories
-`karoubi (homological_complex C c)`.
-
-TODO @joelriou : Get an equivalence of categories
-`karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c`
-for all preadditive categories `C` and complex shape `c`.
+`karoubi (homological_complex C c)` and the construction of an equivalence
+of categories `karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c`.
 
 -/
 
 namespace category_theory
 
+open category
+
 variables {C : Type*} [category C] [preadditive C] {ι : Type*} {c : complex_shape ι}
 
 namespace idempotents
@@ -43,10 +42,167 @@ homological_complex.congr_hom (comp_p f) n
 lemma p_comm_f : P.p.f n ≫ f.f.f n = f.f.f n ≫ Q.p.f n :=
 homological_complex.congr_hom (p_comm f) n
 
+variable (P)
+
+@[simp, reassoc]
+lemma p_idem : P.p.f n ≫ P.p.f n = P.p.f n :=
+homological_complex.congr_hom P.idem n
+
 end homological_complex
 
 end karoubi
 
+open karoubi
+
+namespace karoubi_homological_complex_equivalence
+
+namespace functor
+
+/-- The functor `karoubi (homological_complex C c) ⥤ homological_complex (karoubi C) c`,
+on objects. -/
+@[simps]
+def obj (P : karoubi (homological_complex C c)) : homological_complex (karoubi C) c :=
+{ X := λ n, ⟨P.X.X n, P.p.f n, by simpa only [homological_complex.comp_f]
+    using homological_complex.congr_hom P.idem n⟩,
+  d := λ i j,
+    { f := P.p.f i ≫ P.X.d i j,
+      comm := by tidy, },
+  shape' := λ i j hij, by simp only [hom_eq_zero_iff,
+    P.X.shape i j hij, limits.comp_zero], }
+
+/-- The functor `karoubi (homological_complex C c) ⥤ homological_complex (karoubi C) c`,
+on morphisms. -/
+@[simps]
+def map {P Q : karoubi (homological_complex C c)} (f : P ⟶ Q) : obj P ⟶ obj Q :=
+{ f:= λ n,
+  { f:= f.f.f n,
+    comm := by simp, }, }
+
+end functor
+
+/-- The functor `karoubi (homological_complex C c) ⥤ homological_complex (karoubi C) c`. -/
+@[simps]
+def functor : karoubi (homological_complex C c) ⥤ homological_complex (karoubi C) c :=
+{ obj := functor.obj,
+  map := λ P Q f, functor.map f, }
+
+namespace inverse
+
+/-- The functor `homological_complex (karoubi C) c ⥤ karoubi (homological_complex C c)`,
+on objects -/
+@[simps]
+def obj (K : homological_complex (karoubi C) c) : karoubi (homological_complex C c) :=
+{ X :=
+  { X := λ n, (K.X n).X,
+    d := λ i j, (K.d i j).f,
+    shape' := λ i j hij, hom_eq_zero_iff.mp (K.shape i j hij),
+    d_comp_d' := λ i j k hij hjk, by { simpa only [comp_f]
+      using hom_eq_zero_iff.mp (K.d_comp_d i j k), }, },
+  p :=
+    { f := λ n, (K.X n).p,
+      comm' := by simp, },
+  idem := by tidy, }
+
+/-- The functor `homological_complex (karoubi C) c ⥤ karoubi (homological_complex C c)`,
+on morphisms -/
+@[simps]
+def map {K L : homological_complex (karoubi C) c} (f : K ⟶ L) : obj K ⟶ obj L :=
+{ f:=
+  { f := λ n, (f.f n).f,
+    comm' := λ i j hij, by simpa only [comp_f]
+      using hom_ext.mp (f.comm' i j hij), },
+  comm := by tidy, }
+
+end inverse
+
+/-- The functor `homological_complex (karoubi C) c ⥤ karoubi (homological_complex C c)`. -/
+@[simps]
+def inverse :
+  homological_complex (karoubi C) c ⥤ karoubi (homological_complex C c) :=
+{ obj := inverse.obj,
+  map := λ K L f, inverse.map f, }
+
+
+/-- The counit isomorphism of the equivalence
+`karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c`. -/
+@[simps]
+def counit_iso : inverse ⋙ functor ≅ 𝟭 (homological_complex (karoubi C) c) :=
+eq_to_iso (functor.ext (λ P, homological_complex.ext (by tidy) (by tidy)) (by tidy))
+
+/-- The unit isomorphism of the equivalence
+`karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c`. -/
+@[simps]
+def unit_iso : 𝟭 (karoubi (homological_complex C c)) ≅ functor ⋙ inverse :=
+{ hom :=
+  { app := λ P,
+    { f :=
+      { f := λ n, P.p.f n,
+        comm' := λ i j hij, begin
+          dsimp,
+          simp only [homological_complex.hom.comm, homological_complex.hom.comm_assoc,
+            homological_complex.p_idem],
+        end },
+      comm := by { ext n, dsimp, simp only [homological_complex.p_idem], }, },
+    naturality' := λ P Q φ, begin
+      ext,
+      dsimp,
+      simp only [comp_f, homological_complex.comp_f, homological_complex.comp_p_d,
+        inverse.map_f_f, functor.map_f_f, homological_complex.p_comp_d],
+    end, },
+  inv :=
+  { app := λ P,
+    { f :=
+      { f := λ n, P.p.f n,
+        comm' := λ i j hij, begin
+          dsimp,
+          simp only [homological_complex.hom.comm, assoc, homological_complex.p_idem],
+        end },
+      comm := by { ext n, dsimp, simp only [homological_complex.p_idem], }, },
+    naturality' := λ P Q φ, begin
+      ext,
+      dsimp,
+      simp only [comp_f, homological_complex.comp_f, inverse.map_f_f, functor.map_f_f,
+        homological_complex.comp_p_d, homological_complex.p_comp_d],
+    end, },
+  hom_inv_id' := begin
+    ext,
+    dsimp,
+    simp only [homological_complex.p_idem, comp_f, homological_complex.comp_f, id_eq],
+  end,
+  inv_hom_id' := begin
+    ext,
+    dsimp,
+    simp only [homological_complex.p_idem, comp_f, homological_complex.comp_f, id_eq,
+      inverse.obj_p_f, functor.obj_X_p],
+  end, }
+
+end karoubi_homological_complex_equivalence
+
+variables (C) (c)
+
+/-- The equivalence `karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c`. -/
+@[simps]
+def karoubi_homological_complex_equivalence :
+  karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c :=
+{ functor    := karoubi_homological_complex_equivalence.functor,
+  inverse    := karoubi_homological_complex_equivalence.inverse,
+  unit_iso   := karoubi_homological_complex_equivalence.unit_iso,
+  counit_iso := karoubi_homological_complex_equivalence.counit_iso, }
+
+variables (α : Type*) [add_right_cancel_semigroup α] [has_one α]
+
+/-- The equivalence `karoubi (chain_complex C α) ≌ chain_complex (karoubi C) α`. -/
+@[simps]
+def karoubi_chain_complex_equivalence :
+  karoubi (chain_complex C α) ≌ chain_complex (karoubi C) α :=
+karoubi_homological_complex_equivalence C (complex_shape.down α)
+
+/-- The equivalence `karoubi (cochain_complex C α) ≌ cochain_complex (karoubi C) α`. -/
+@[simps]
+def karoubi_cochain_complex_equivalence :
+  karoubi (cochain_complex C α) ≌ cochain_complex (karoubi C) α :=
+karoubi_homological_complex_equivalence C (complex_shape.up α)
+
 end idempotents
 
 end category_theory
diff --git a/src/category_theory/idempotents/karoubi.lean b/src/category_theory/idempotents/karoubi.lean
index 45d790af537da..ec19521b7a1b3 100644
--- a/src/category_theory/idempotents/karoubi.lean
+++ b/src/category_theory/idempotents/karoubi.lean
@@ -48,6 +48,8 @@ namespace karoubi
 
 variables {C}
 
+attribute [simp, reassoc] idem
+
 @[ext]
 lemma ext {P Q : karoubi C} (h_X : P.X = Q.X)
   (h_p : P.p ≫ eq_to_hom h_X = eq_to_hom h_X ≫ Q.p) : P = Q :=
@@ -100,8 +102,8 @@ instance : category (karoubi C) :=
   comp     := λ P Q R f g, ⟨f.f ≫ g.f, karoubi.comp_proof g f⟩, }
 
 @[simp]
-lemma comp {P Q R : karoubi C} (f : P ⟶ Q) (g : Q ⟶ R) :
-  f ≫ g = ⟨f.f ≫ g.f, comp_proof g f⟩ := by refl
+lemma comp_f {P Q R : karoubi C} (f : P ⟶ Q) (g : Q ⟶ R) :
+  (f ≫ g).f = f.f ≫ g.f := by refl
 
 @[simp]
 lemma id_eq {P : karoubi C} : 𝟙 P = ⟨P.p, by repeat { rw P.idem, }⟩ := by refl
@@ -172,11 +174,7 @@ end karoubi
 
 /-- The category `karoubi C` is preadditive if `C` is. -/
 instance [preadditive C] : preadditive (karoubi C) :=
-{ hom_group := λ P Q, by apply_instance,
-  add_comp' := λ P Q R f g h,
-    by { ext, simp only [add_comp, quiver.hom.add_comm_group_add_f, karoubi.comp], },
-  comp_add' := λ P Q R f g h,
-    by { ext, simp only [comp_add, quiver.hom.add_comm_group_add_f, karoubi.comp], }, }
+{ hom_group := λ P Q, by apply_instance, }
 
 instance [preadditive C] : functor.additive (to_karoubi C) := { }
 
@@ -189,7 +187,7 @@ begin
   refine ⟨_⟩,
   intros P p hp,
   have hp' := hom_ext.mp hp,
-  simp only [comp] at hp',
+  simp only [comp_f] at hp',
   use ⟨P.X, p.f, hp'⟩,
   use ⟨p.f, by rw [comp_p p, hp']⟩,
   use ⟨p.f, by rw [hp', p_comp p]⟩,
@@ -228,11 +226,11 @@ def decomp_id_p (P : karoubi C) : (P.X : karoubi C) ⟶ P :=
 is actually a direct factor in the category `karoubi C`. -/
 lemma decomp_id (P : karoubi C) :
   𝟙 P = (decomp_id_i P) ≫ (decomp_id_p P) :=
-by { ext, simp only [comp, id_eq, P.idem, decomp_id_i, decomp_id_p], }
+by { ext, simp only [comp_f, id_eq, P.idem, decomp_id_i, decomp_id_p], }
 
 lemma decomp_p (P : karoubi C) :
   (to_karoubi C).map P.p = (decomp_id_p P) ≫ (decomp_id_i P) :=
-by { ext, simp only [comp, decomp_id_p_f, decomp_id_i_f, P.idem, to_karoubi_map_f], }
+by { ext, simp only [comp_f, decomp_id_p_f, decomp_id_i_f, P.idem, to_karoubi_map_f], }
 
 lemma decomp_id_i_to_karoubi (X : C) : decomp_id_i ((to_karoubi C).obj X) = 𝟙 _ :=
 by { ext, refl, }
@@ -242,11 +240,16 @@ by { ext, refl, }
 
 lemma decomp_id_i_naturality {P Q : karoubi C} (f : P ⟶ Q) : f ≫ decomp_id_i _ =
   decomp_id_i _ ≫ ⟨f.f, by erw [comp_id, id_comp]⟩ :=
-by { ext, simp only [comp, decomp_id_i_f, karoubi.comp_p, karoubi.p_comp], }
+by { ext, simp only [comp_f, decomp_id_i_f, karoubi.comp_p, karoubi.p_comp], }
 
 lemma decomp_id_p_naturality {P Q : karoubi C} (f : P ⟶ Q) : decomp_id_p P ≫ f =
   (⟨f.f, by erw [comp_id, id_comp]⟩ : (P.X : karoubi C) ⟶ Q.X) ≫ decomp_id_p Q :=
-by { ext, simp only [comp, decomp_id_p_f, karoubi.comp_p, karoubi.p_comp], }
+by { ext, simp only [comp_f, decomp_id_p_f, karoubi.comp_p, karoubi.p_comp], }
+
+@[simp]
+lemma zsmul_hom [preadditive C] {P Q : karoubi C} (n : ℤ) (f : P ⟶ Q) :
+  (n • f).f = n • f.f :=
+map_zsmul (inclusion_hom P Q) n f
 
 end karoubi
 
diff --git a/src/category_theory/idempotents/karoubi_karoubi.lean b/src/category_theory/idempotents/karoubi_karoubi.lean
index 983eb2ac4b9e7..12d9e69c2588b 100644
--- a/src/category_theory/idempotents/karoubi_karoubi.lean
+++ b/src/category_theory/idempotents/karoubi_karoubi.lean
@@ -35,19 +35,8 @@ instance [preadditive C] : functor.additive (inverse C) := { }
 
 /-- The unit isomorphism of the equivalence -/
 @[simps]
-def unit_iso : 𝟭 (karoubi C) ≅ to_karoubi (karoubi C) ⋙ inverse C := eq_to_iso begin
-  apply functor.ext,
-  { intros P Q f,
-    ext,
-    simp only [functor.id_map, inverse_map_f, to_karoubi_map_f, eq_to_hom_f,
-      eq_to_hom_refl, comp_id, p_comp_assoc, functor.comp_map, comp],
-    dsimp,
-    simp only [id_eq, comp_p], },
-  { intro P,
-    ext,
-    { simpa only [eq_to_hom_refl, comp_id, id_comp], },
-    { refl, }, }
-end
+def unit_iso : 𝟭 (karoubi C) ≅ to_karoubi (karoubi C) ⋙ inverse C :=
+eq_to_iso (functor.ext (by tidy) (by tidy))
 
 /-- The counit isomorphism of the equivalence -/
 @[simps]
@@ -58,12 +47,12 @@ def counit_iso : inverse C ⋙ to_karoubi (karoubi C) ≅ 𝟭 (karoubi (karoubi
       { f := P.p.1,
         comm := begin
           have h := P.idem,
-          simp only [hom_ext, comp] at h,
+          simp only [hom_ext, comp_f] at h,
           erw [← assoc, h, comp_p],
         end, },
       comm := begin
         have h := P.idem,
-        simp only [hom_ext, comp] at h ⊢,
+        simp only [hom_ext, comp_f] at h ⊢,
         erw [h, h],
       end, },
     naturality' := λ P Q f, by simpa only [hom_ext] using (p_comm f).symm, },
@@ -73,15 +62,15 @@ def counit_iso : inverse C ⋙ to_karoubi (karoubi C) ≅ 𝟭 (karoubi (karoubi
       { f := P.p.1,
         comm := begin
           have h := P.idem,
-          simp only [hom_ext, comp] at h,
+          simp only [hom_ext, comp_f] at h,
           erw [h, p_comp],
         end, },
       comm := begin
         have h := P.idem,
-        simp only [hom_ext, comp] at h ⊢,
+        simp only [hom_ext, comp_f] at h ⊢,
         erw [h, h],
       end, },
-    naturality' := λ P Q f, by simpa [hom_ext] using (p_comm f).symm, },
+    naturality' := λ P Q f, by simpa only [hom_ext] using (p_comm f).symm, },
   hom_inv_id' := by { ext P, simpa only [hom_ext, id_eq] using P.idem, },
   inv_hom_id' := by { ext P, simpa only [hom_ext, id_eq] using P.idem, }, }
 
@@ -91,13 +80,7 @@ def equivalence : karoubi C ≌ karoubi (karoubi C) :=
 { functor := to_karoubi (karoubi C),
   inverse := karoubi_karoubi.inverse C,
   unit_iso := karoubi_karoubi.unit_iso C,
-  counit_iso := karoubi_karoubi.counit_iso C,
-  functor_unit_iso_comp' := λ P, begin
-    ext,
-    simp only [eq_to_hom_f, eq_to_hom_refl, comp_id, counit_iso_hom_app_f_f,
-      to_karoubi_obj_p, id_eq, assoc, comp, unit_iso_hom, eq_to_hom_app, eq_to_hom_map],
-    erw [P.idem, P.idem],
-  end, }
+  counit_iso := karoubi_karoubi.counit_iso C, }
 
 instance equivalence.additive_functor [preadditive C] :
   functor.additive (equivalence C).functor := by { dsimp, apply_instance, }
diff --git a/src/category_theory/natural_isomorphism.lean b/src/category_theory/natural_isomorphism.lean
index c3f7d795d6663..d49a836724102 100644
--- a/src/category_theory/natural_isomorphism.lean
+++ b/src/category_theory/natural_isomorphism.lean
@@ -9,6 +9,10 @@ import category_theory.isomorphism
 /-!
 # Natural isomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/820
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For the most part, natural isomorphisms are just another sort of isomorphism.
 
 We provide some special support for extracting components:
diff --git a/src/category_theory/simple.lean b/src/category_theory/simple.lean
index c7f2433aeaccd..55e1e1d62b5b7 100644
--- a/src/category_theory/simple.lean
+++ b/src/category_theory/simple.lean
@@ -71,6 +71,9 @@ lemma simple.of_iso {X Y : C} [simple Y] (i : X ≅ Y) : simple X :=
       apply_instance, },
   end }
 
+lemma simple.iff_of_iso {X Y : C} (i : X ≅ Y) : simple X ↔ simple Y :=
+⟨λ h, by exactI simple.of_iso i.symm, λ h, by exactI simple.of_iso i⟩
+
 lemma kernel_zero_of_nonzero_from_simple
   {X Y : C} [simple X] {f : X ⟶ Y} [has_kernel f] (w : f ≠ 0) :
   kernel.ι f = 0 :=
diff --git a/src/combinatorics/additive/salem_spencer.lean b/src/combinatorics/additive/salem_spencer.lean
index ed7ef2febd22b..e7b8bfc1f8836 100644
--- a/src/combinatorics/additive/salem_spencer.lean
+++ b/src/combinatorics/additive/salem_spencer.lean
@@ -302,7 +302,7 @@ lemma mul_roth_number_le : mul_roth_number s ≤ s.card := by convert nat.find_g
 
 @[to_additive]
 lemma mul_roth_number_spec : ∃ t ⊆ s, t.card = mul_roth_number s ∧ mul_salem_spencer (t : set α) :=
-@nat.find_greatest_spec _ (λ m, ∃ t ⊆ s, t.card = m ∧ mul_salem_spencer (t : set α)) _ _
+@nat.find_greatest_spec _ _ (λ m, ∃ t ⊆ s, t.card = m ∧ mul_salem_spencer (t : set α)) _
   (nat.zero_le _) ⟨∅, empty_subset _, card_empty, mul_salem_spencer_empty⟩
 
 variables {s t} {n : ℕ}
diff --git a/src/combinatorics/quiver/basic.lean b/src/combinatorics/quiver/basic.lean
index e87b1adad0616..797af55d2b432 100644
--- a/src/combinatorics/quiver/basic.lean
+++ b/src/combinatorics/quiver/basic.lean
@@ -90,6 +90,12 @@ def comp {U : Type*} [quiver U] {V : Type*} [quiver V] {W : Type*} [quiver W]
 { obj := λ X, G.obj (F.obj X),
   map := λ X Y f, G.map (F.map f), }
 
+@[simp] lemma comp_id {U : Type*} [quiver U] {V : Type*} [quiver V] (F : prefunctor U V) :
+  F.comp (id _) = F := by { cases F, refl, }
+
+@[simp] lemma id_comp {U : Type*} [quiver U] {V : Type*} [quiver V] (F : prefunctor U V) :
+  (id _).comp F = F := by { cases F, refl, }
+
 @[simp]
 lemma comp_assoc
   {U V W Z : Type*} [quiver U] [quiver V] [quiver W] [quiver Z]
@@ -129,7 +135,6 @@ instance empty_quiver (V : Type u) : quiver.{u} (empty V) := ⟨λ a b, pempty
 
 @[simp] lemma empty_arrow {V : Type u} (a b : empty V) : (a ⟶ b) = pempty := rfl
 
-
 /-- A quiver is thin if it has no parallel arrows. -/
 @[reducible] def is_thin (V : Type u) [quiver V] := ∀ (a b : V), subsingleton (a ⟶ b)
 
diff --git a/src/combinatorics/quiver/cast.lean b/src/combinatorics/quiver/cast.lean
new file mode 100644
index 0000000000000..3687801c5617e
--- /dev/null
+++ b/src/combinatorics/quiver/cast.lean
@@ -0,0 +1,113 @@
+/-
+Copyright (c) 2022 Antoine Labelle, Rémi Bottinelli. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Antoine Labelle, Rémi Bottinelli
+-/
+import combinatorics.quiver.basic
+import combinatorics.quiver.path
+
+/-!
+
+# Rewriting arrows and paths along vertex equalities
+
+This files defines `hom.cast` and `path.cast` (and associated lemmas) in order to allow
+rewriting arrows and paths along equalities of their endpoints.
+
+-/
+
+universes v v₁ v₂ u u₁ u₂
+
+variables {U : Type*} [quiver.{u+1} U]
+
+namespace quiver
+
+/-!
+### Rewriting arrows along equalities of vertices
+-/
+
+/-- Change the endpoints of an arrow using equalities. -/
+def hom.cast {u v u' v' : U} (hu : u = u') (hv : v = v') (e : u ⟶ v) : u' ⟶ v' :=
+eq.rec (eq.rec e hv) hu
+
+lemma hom.cast_eq_cast {u v u' v' : U} (hu : u = u') (hv : v = v') (e : u ⟶ v) :
+  e.cast hu hv = cast (by rw [hu, hv]) e :=
+by { subst_vars, refl }
+
+@[simp] lemma hom.cast_rfl_rfl {u v : U} (e : u ⟶ v) :
+  e.cast rfl rfl = e := rfl
+
+@[simp] lemma hom.cast_cast {u v u' v' u'' v'' : U} (e : u ⟶ v)
+  (hu : u = u') (hv : v = v') (hu' : u' = u'') (hv' : v' = v'') :
+  (e.cast hu hv).cast hu' hv' = e.cast (hu.trans hu') (hv.trans hv') :=
+by { subst_vars, refl }
+
+lemma hom.cast_heq {u v u' v' : U} (hu : u = u') (hv : v = v') (e : u ⟶ v) :
+  e.cast hu hv == e :=
+by { subst_vars, refl }
+
+lemma hom.cast_eq_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v')
+  (e : u ⟶ v) (e' : u' ⟶ v') : e.cast hu hv = e' ↔ e == e' :=
+by { rw hom.cast_eq_cast, exact cast_eq_iff_heq }
+
+lemma hom.eq_cast_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v')
+  (e : u ⟶ v) (e' : u' ⟶ v') : e' = e.cast hu hv ↔ e' == e :=
+by { rw [eq_comm, hom.cast_eq_iff_heq], exact ⟨heq.symm, heq.symm⟩ }
+
+/-!
+### Rewriting paths along equalities of vertices
+-/
+
+open path
+
+/-- Change the endpoints of a path using equalities. -/
+def path.cast {u v u' v' : U} (hu : u = u') (hv : v = v') (p : path u v) : path u' v' :=
+eq.rec (eq.rec p hv) hu
+
+lemma path.cast_eq_cast {u v u' v' : U} (hu : u = u') (hv : v = v') (p : path u v) :
+  p.cast hu hv = cast (by rw [hu, hv]) p:=
+eq.drec (eq.drec (eq.refl (path.cast (eq.refl u) (eq.refl v) p)) hu) hv
+
+@[simp] lemma path.cast_rfl_rfl {u v : U} (p : path u v) :
+  p.cast rfl rfl = p := rfl
+
+@[simp] lemma path.cast_cast {u v u' v' u'' v'' : U} (p : path u v)
+  (hu : u = u') (hv : v = v') (hu' : u' = u'') (hv' : v' = v'') :
+  (p.cast hu hv).cast hu' hv' = p.cast (hu.trans hu') (hv.trans hv') :=
+by { subst_vars, refl }
+
+@[simp] lemma path.cast_nil {u u' : U} (hu : u = u') :
+  (path.nil : path u u).cast hu hu = path.nil :=
+by { subst_vars, refl }
+
+lemma path.cast_heq {u v u' v' : U} (hu : u = u') (hv : v = v') (p : path u v) :
+  p.cast hu hv == p :=
+by { rw path.cast_eq_cast, exact cast_heq _ _ }
+
+lemma path.cast_eq_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v')
+  (p : path u v) (p' : path u' v') : p.cast hu hv = p' ↔ p == p' :=
+by { rw path.cast_eq_cast, exact cast_eq_iff_heq }
+
+lemma path.eq_cast_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v')
+  (p : path u v) (p' : path u' v') : p' = p.cast hu hv ↔ p' == p :=
+⟨λ h, ((p.cast_eq_iff_heq hu hv p').1 h.symm).symm,
+ λ h, ((p.cast_eq_iff_heq hu hv p').2 h.symm).symm⟩
+
+lemma path.cast_cons {u v w u' w' : U} (p : path u v) (e : v ⟶ w) (hu : u = u') (hw : w = w') :
+  (p.cons e).cast hu hw = (p.cast hu rfl).cons (e.cast rfl hw) :=
+by { subst_vars, refl }
+
+lemma cast_eq_of_cons_eq_cons {u v v' w : U} {p : path u v} {p' : path u v'}
+  {e : v ⟶ w} {e' : v' ⟶ w} (h : p.cons e = p'.cons e') :
+  p.cast rfl (obj_eq_of_cons_eq_cons h) = p' :=
+by { rw path.cast_eq_iff_heq, exact heq_of_cons_eq_cons h }
+
+lemma hom_cast_eq_of_cons_eq_cons {u v v' w : U} {p : path u v} {p' : path u v'}
+  {e : v ⟶ w} {e' : v' ⟶ w} (h : p.cons e = p'.cons e') :
+  e.cast (obj_eq_of_cons_eq_cons h) rfl = e' :=
+by { rw hom.cast_eq_iff_heq, exact hom_heq_of_cons_eq_cons h }
+
+lemma eq_nil_of_length_zero {u v : U} (p : path u v) (hzero : p.length = 0) :
+  p.cast (eq_of_length_zero p hzero) rfl = path.nil :=
+by { cases p; simpa only [nat.succ_ne_zero, length_cons] using hzero, }
+
+end quiver
diff --git a/src/combinatorics/quiver/connected_component.lean b/src/combinatorics/quiver/connected_component.lean
index 7fe9512473a69..303b8dcee109b 100644
--- a/src/combinatorics/quiver/connected_component.lean
+++ b/src/combinatorics/quiver/connected_component.lean
@@ -10,6 +10,10 @@ import data.sum.basic
 /-!
 ## Weakly connected components
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/836
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For a quiver `V`, we build a quiver `symmetrify V` by adding a reversal of every edge.
 Informally, a path in `symmetrify V` corresponds to a 'zigzag' in `V`. This lets us
 define the type `weakly_connected_component V` as the quotient of `V` by the relation which
diff --git a/src/combinatorics/quiver/path.lean b/src/combinatorics/quiver/path.lean
index bbfec5111694a..85c2f3ea2ae94 100644
--- a/src/combinatorics/quiver/path.lean
+++ b/src/combinatorics/quiver/path.lean
@@ -34,7 +34,20 @@ path.nil.cons e
 
 namespace path
 
-variables {V : Type u} [quiver V] {a b c : V}
+variables {V : Type u} [quiver V] {a b c d : V}
+
+lemma nil_ne_cons (p : path a b) (e : b ⟶ a) : path.nil ≠ p.cons e.
+
+lemma cons_ne_nil (p : path a b) (e : b ⟶ a) : p.cons e ≠ path.nil.
+
+lemma obj_eq_of_cons_eq_cons {p : path a b} {p' : path a c}
+  {e : b ⟶ d} {e' : c ⟶ d} (h : p.cons e = p'.cons e') : b = c := by injection h
+
+lemma heq_of_cons_eq_cons {p : path a b} {p' : path a c}
+  {e : b ⟶ d} {e' : c ⟶ d} (h : p.cons e = p'.cons e') : p == p' := by injection h
+
+lemma hom_heq_of_cons_eq_cons {p : path a b} {p' : path a c}
+  {e : b ⟶ d} {e' : c ⟶ d} (h : p.cons e = p'.cons e') : e == e' := by injection h
 
 /-- The length of a path is the number of arrows it uses. -/
 def length {a : V} : Π {b : V}, path a b → ℕ
@@ -59,10 +72,13 @@ def comp {a b : V} : Π {c}, path a b → path b c → path a c
 
 @[simp] lemma comp_cons {a b c d : V} (p : path a b) (q : path b c) (e : c ⟶ d) :
   p.comp (q.cons e) = (p.comp q).cons e := rfl
+
 @[simp] lemma comp_nil {a b : V} (p : path a b) : p.comp path.nil = p := rfl
+
 @[simp] lemma nil_comp {a : V} : ∀ {b} (p : path a b), path.nil.comp p = p
 | a path.nil := rfl
 | b (path.cons p e) := by rw [comp_cons, nil_comp]
+
 @[simp] lemma comp_assoc {a b c : V} : ∀ {d}
   (p : path a b) (q : path b c) (r : path c d),
     (p.comp q).comp r = p.comp (q.comp r)
diff --git a/src/combinatorics/quiver/push.lean b/src/combinatorics/quiver/push.lean
new file mode 100644
index 0000000000000..0a373bd18b602
--- /dev/null
+++ b/src/combinatorics/quiver/push.lean
@@ -0,0 +1,82 @@
+/-
+Copyright (c) 2022 Rémi Bottinelli. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémi Bottinelli
+-/
+import combinatorics.quiver.basic
+/-!
+
+# Pushing a quiver structure along a map
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/868
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given a map `σ : V → W` and a `quiver` instance on `V`, this files defines a `quiver` instance
+on `W` by associating to each arrow `v ⟶ v'` in `V` an arrow `σ v ⟶ σ v'` in `W`.
+
+-/
+
+universes v v₁ v₂ u u₁ u₂
+
+variables {V : Type*} [quiver V] {W : Type*} (σ : V → W)
+
+/-- The `quiver` instance obtained by pushing arrows of `V` along the map `σ : V → W` -/
+@[nolint unused_arguments]
+def push (σ : V → W) := W
+
+instance [h : nonempty W] : nonempty (push σ) := h
+
+/-- The quiver structure obtained by pushing arrows of `V` along the map `σ : V → W` -/
+@[nolint has_nonempty_instance]
+inductive push_quiver {V : Type u} [quiver.{v} V] {W : Type u₂} (σ : V → W) :
+  W → W → Type (max u u₂ v)
+| arrow {X Y : V} (f : X ⟶ Y) : push_quiver (σ X) (σ Y)
+
+instance : quiver (push σ) := ⟨push_quiver σ⟩
+
+namespace push
+
+/-- The prefunctor induced by pushing arrows via `σ` -/
+def of : V ⥤q push σ :=
+{ obj := σ,
+  map := λ X Y f, push_quiver.arrow f }
+
+@[simp] lemma of_obj : (of σ).obj = σ := rfl
+
+variables {W' : Type*} [quiver W'] (φ : V ⥤q W') (τ : W → W') (h : ∀ x, φ.obj x = τ (σ x) )
+
+include φ h
+/-- Given a function `τ : W → W'` and a prefunctor `φ : V ⥤q W'`, one can extend `τ` to be
+a prefunctor `W ⥤q W'` if `τ` and `σ` factorize `φ` at the level of objects, where `W` is given
+the pushforward quiver structure `push σ`. -/
+def lift : push σ ⥤q W' :=
+{ obj := τ,
+  map := @push_quiver.rec V _ W σ
+    (λ X Y f, τ X ⟶ τ Y)
+    (λ X Y f, by { rw [←h X, ←h Y], exact φ.map f, }) }
+
+lemma lift_obj : (lift σ φ τ h).obj = τ := rfl
+
+lemma lift_comp : of σ ⋙q lift σ φ τ h = φ :=
+begin
+  fapply prefunctor.ext,
+  { rintros, simp only [prefunctor.comp_obj], symmetry, exact h X, },
+  { rintros _ _ f, simp only [prefunctor.comp_map],
+    apply eq_of_heq,
+    iterate 2 { apply (cast_heq _ _).trans },
+    symmetry,
+    iterate 2 { apply (eq_rec_heq _ _).trans },
+    refl, },
+end
+
+lemma lift_unique (Φ : push σ ⥤q W') (Φ₀ : Φ.obj = τ) (Φcomp : of σ ⋙q Φ = φ) :
+  Φ = lift σ φ τ h :=
+begin
+  dsimp only [of,lift],
+  fapply prefunctor.ext,
+  { rintros, simp_rw [←Φ₀], },
+  { rintros _ _ ⟨⟩, subst_vars, simp only [prefunctor.comp_map, cast_eq], refl, }
+end
+
+end push
diff --git a/src/combinatorics/quiver/subquiver.lean b/src/combinatorics/quiver/subquiver.lean
index 55a4aaea26b28..28065caed1892 100644
--- a/src/combinatorics/quiver/subquiver.lean
+++ b/src/combinatorics/quiver/subquiver.lean
@@ -9,6 +9,10 @@ import combinatorics.quiver.basic
 /-!
 ## Wide subquivers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/828
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A wide subquiver `H` of a quiver `H` consists of a subset of the edge set `a ⟶ b` for
 every pair of vertices `a b : V`. We include 'wide' in the name to emphasize that these
 subquivers by definition contain all vertices.
diff --git a/src/combinatorics/set_family/intersecting.lean b/src/combinatorics/set_family/intersecting.lean
index 63fb5939370ae..ce2503b935cd1 100644
--- a/src/combinatorics/set_family/intersecting.lean
+++ b/src/combinatorics/set_family/intersecting.lean
@@ -83,7 +83,7 @@ lemma intersecting_iff_eq_empty_of_subsingleton [subsingleton α] (s : set α) :
 begin
   refine subsingleton_of_subsingleton.intersecting.trans
     ⟨not_imp_comm.2 $ λ h, subsingleton_of_subsingleton.eq_singleton_of_mem _, _⟩,
-  { obtain ⟨a, ha⟩ := ne_empty_iff_nonempty.1 h,
+  { obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 h,
     rwa subsingleton.elim ⊥ a },
   { rintro rfl,
     exact (set.singleton_nonempty _).ne_empty.symm }
@@ -175,7 +175,7 @@ begin
   have := h {⊤} (by { rw coe_singleton, exact intersecting_singleton.2 top_ne_bot }),
   rw compl_bot at ha,
   rw coe_eq_empty.1 ((hs.is_upper_set' h).not_top_mem.1 ha.2) at this,
-  exact singleton_ne_empty _ (this $ empty_subset _).symm,
+  exact finset.singleton_ne_empty _ (this $ empty_subset _).symm,
 end
 
 lemma intersecting.exists_card_eq (hs : (s : set α).intersecting) :
diff --git a/src/combinatorics/set_family/kleitman.lean b/src/combinatorics/set_family/kleitman.lean
index 9c8e39d497dcf..3fe9a533bc0c8 100644
--- a/src/combinatorics/set_family/kleitman.lean
+++ b/src/combinatorics/set_family/kleitman.lean
@@ -72,6 +72,6 @@ begin
   refine mul_le_mul_left' _ _,
   refine (add_le_add_left (ih ((card_le_of_subset $ subset_cons _).trans hs) _ $ λ i hi,
     (hf₁ _ $ subset_cons _ hi).2.2) _).trans _,
-  rw [mul_tsub, two_mul, ←pow_succ, ←add_tsub_assoc_of_le (pow_le_pow' (@one_le_two ℕ _ _ _ _ _)
+  rw [mul_tsub, two_mul, ←pow_succ, ←add_tsub_assoc_of_le (pow_le_pow' (one_le_two : (1 : ℕ) ≤ 2)
     tsub_le_self), tsub_add_eq_add_tsub hs, card_cons, add_tsub_add_eq_tsub_right],
 end
diff --git a/src/computability/ackermann.lean b/src/computability/ackermann.lean
index 8d0a08c72a306..8556260af6365 100644
--- a/src/computability/ackermann.lean
+++ b/src/computability/ackermann.lean
@@ -222,7 +222,7 @@ begin
       { apply add_le_add hk,
         norm_num,
         apply succ_le_of_lt,
-        rw [pow_succ, mul_lt_mul_left (@zero_lt_two ℕ _ _)],
+        rw [pow_succ, mul_lt_mul_left (zero_lt_two' ℕ)],
         apply lt_two_pow },
       { rw [pow_succ, pow_succ],
         linarith [one_le_pow k 2 zero_lt_two] } } }
diff --git a/src/computability/halting.lean b/src/computability/halting.lean
index d53b1ea727d88..81357e4f27011 100644
--- a/src/computability/halting.lean
+++ b/src/computability/halting.lean
@@ -203,7 +203,7 @@ have hC : ∀ f, f ∈ C ↔ eval f ∈ eval '' C,
 from λ f, ⟨set.mem_image_of_mem _, λ ⟨g, hg, e⟩, (H _ _ e).1 hg⟩,
 ⟨λ h, or_iff_not_imp_left.2 $ λ C0,
   set.eq_univ_of_forall $ λ cg,
-  let ⟨cf, fC⟩ := set.ne_empty_iff_nonempty.1 C0 in
+  let ⟨cf, fC⟩ := set.nonempty_iff_ne_empty.2 C0 in
   (hC _).2 $ rice (eval '' C) (h.of_eq hC)
     (partrec.nat_iff.1 $ eval_part.comp (const cf) computable.id)
     (partrec.nat_iff.1 $ eval_part.comp (const cg) computable.id)
diff --git a/src/control/traversable/basic.lean b/src/control/traversable/basic.lean
index a5c1ba44d6837..bdc3ed837a7a4 100644
--- a/src/control/traversable/basic.lean
+++ b/src/control/traversable/basic.lean
@@ -9,6 +9,10 @@ import tactic.ext
 /-!
 # Traversable type class
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/788
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Type classes for traversing collections. The concepts and laws are taken from
 <http://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Traversable.html>
 
diff --git a/src/data/bool/count.lean b/src/data/bool/count.lean
new file mode 100644
index 0000000000000..a1d3d07f72ddd
--- /dev/null
+++ b/src/data/bool/count.lean
@@ -0,0 +1,111 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import data.nat.parity
+
+/-!
+# List of booleans
+
+In this file we prove lemmas about the number of `ff`s and `tt`s in a list of booleans. First we
+prove that the number of `ff`s plus the number of `tt` equals the length of the list. Then we prove
+that in a list with alternating `tt`s and `ff`s, the number of `tt`s differs from the number of
+`ff`s by at most one. We provide several versions of these statements.
+-/
+
+namespace list
+
+@[simp]
+theorem count_bnot_add_count (l : list bool) (b : bool) : count (!b) l + count b l = length l :=
+by simp only [length_eq_countp_add_countp (eq (!b)), bool.bnot_not_eq, count]
+
+@[simp]
+theorem count_add_count_bnot (l : list bool) (b : bool) : count b l + count (!b) l = length l :=
+by rw [add_comm, count_bnot_add_count]
+
+@[simp] theorem count_ff_add_count_tt (l : list bool) : count ff l + count tt l = length l :=
+count_bnot_add_count l tt
+
+@[simp] theorem count_tt_add_count_ff (l : list bool) : count tt l + count ff l = length l :=
+count_bnot_add_count l ff
+
+lemma chain.count_bnot :
+  ∀ {b : bool} {l : list bool}, chain (≠) b l → count (!b) l = count b l + length l % 2
+| b [] h := rfl
+| b (x :: l) h :=
+  begin
+    obtain rfl : b = !x := bool.eq_bnot_iff.2 (rel_of_chain_cons h),
+    rw [bnot_bnot, count_cons_self, count_cons_of_ne x.bnot_ne_self,
+      chain.count_bnot (chain_of_chain_cons h), length, add_assoc, nat.mod_two_add_succ_mod_two]
+  end
+
+namespace chain'
+
+variables {l : list bool}
+
+theorem count_bnot_eq_count (hl : chain' (≠) l) (h2 : even (length l)) (b : bool) :
+  count (!b) l = count b l :=
+begin
+  cases l with x l, { refl },
+  rw [length_cons, nat.even_add_one, nat.not_even_iff] at h2,
+  suffices : count (!x) (x :: l) = count x (x :: l),
+  { cases b; cases x; try { exact this }; exact this.symm },
+  rw [count_cons_of_ne x.bnot_ne_self, hl.count_bnot, h2, count_cons_self]
+end
+
+theorem count_ff_eq_count_tt (hl : chain' (≠) l) (h2 : even (length l)) : count ff l = count tt l :=
+hl.count_bnot_eq_count h2 tt
+
+lemma count_bnot_le_count_add_one (hl : chain' (≠) l) (b : bool) :
+  count (!b) l ≤ count b l + 1 :=
+begin
+  cases l with x l, { exact zero_le _ },
+  obtain rfl | rfl : b = x ∨ b = !x, by simp only [bool.eq_bnot_iff, em],
+  { rw [count_cons_of_ne b.bnot_ne_self, count_cons_self, hl.count_bnot, add_assoc],
+    exact add_le_add_left (nat.mod_lt _ two_pos).le _ },
+  { rw [bnot_bnot, count_cons_self, count_cons_of_ne x.bnot_ne_self, hl.count_bnot],
+    exact add_le_add_right (le_add_right le_rfl) _ }
+end
+
+lemma count_ff_le_count_tt_add_one (hl : chain' (≠) l) : count ff l ≤ count tt l + 1 :=
+hl.count_bnot_le_count_add_one tt
+
+lemma count_tt_le_count_ff_add_one (hl : chain' (≠) l) : count tt l ≤ count ff l + 1 :=
+hl.count_bnot_le_count_add_one ff
+
+theorem two_mul_count_bool_of_even (hl : chain' (≠) l) (h2 : even (length l)) (b : bool) :
+  2 * count b l = length l :=
+by rw [← count_bnot_add_count l b, hl.count_bnot_eq_count h2, two_mul]
+
+theorem two_mul_count_bool_eq_ite (hl : chain' (≠) l) (b : bool) :
+  2 * count b l = if even (length l) then length l else
+    if b ∈ l.head' then length l + 1 else length l - 1 :=
+begin
+  by_cases h2 : even (length l),
+  { rw [if_pos h2, hl.two_mul_count_bool_of_even h2] },
+  { cases l with x l, { exact (h2 even_zero).elim },
+    simp only [if_neg h2, count_cons', mul_add, head', option.mem_some_iff, @eq_comm _ x],
+    rw [length_cons, nat.even_add_one, not_not] at h2,
+    replace hl : l.chain' (≠) := hl.tail,
+    rw [hl.two_mul_count_bool_of_even h2],
+    split_ifs; simp }
+end
+
+theorem length_sub_one_le_two_mul_count_bool (hl : chain' (≠) l) (b : bool) :
+  length l - 1 ≤ 2 * count b l :=
+by { rw [hl.two_mul_count_bool_eq_ite], split_ifs; simp [le_tsub_add, nat.le_succ_of_le] }
+
+theorem length_div_two_le_count_bool (hl : chain' (≠) l) (b : bool) : length l / 2 ≤ count b l :=
+begin
+  rw [nat.div_le_iff_le_mul_add_pred two_pos, ← tsub_le_iff_right],
+  exact length_sub_one_le_two_mul_count_bool hl b
+end
+
+lemma two_mul_count_bool_le_length_add_one (hl : chain' (≠) l) (b : bool) :
+  2 * count b l ≤ length l + 1 :=
+by { rw [hl.two_mul_count_bool_eq_ite], split_ifs; simp [nat.le_succ_of_le] }
+
+end chain'
+
+end list
diff --git a/src/data/bool/set.lean b/src/data/bool/set.lean
index b911c3d8711dd..bf4558a70864b 100644
--- a/src/data/bool/set.lean
+++ b/src/data/bool/set.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
 import data.bool.basic
-import data.set.basic
+import data.set.image
 
 /-!
 # Booleans and set operations
diff --git a/src/data/complex/basic.lean b/src/data/complex/basic.lean
index 9121bb54b7369..b096ec98f6e83 100644
--- a/src/data/complex/basic.lean
+++ b/src/data/complex/basic.lean
@@ -493,7 +493,7 @@ private lemma abs_add (z w : ℂ) : (abs (z + w)) ≤ (abs z) + abs w :=
   (add_nonneg (abs_nonneg' z) (abs_nonneg' w))).2 $
 begin
   rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs, add_right_comm, norm_sq_add,
-      add_le_add_iff_left, mul_assoc, mul_le_mul_left (@zero_lt_two ℝ _ _),
+      add_le_add_iff_left, mul_assoc, mul_le_mul_left (zero_lt_two' ℝ),
       ←real.sqrt_mul $ norm_sq_nonneg z, ←norm_sq_conj w, ←map_mul],
   exact re_le_abs (z * conj w)
 end
diff --git a/src/data/complex/is_R_or_C.lean b/src/data/complex/is_R_or_C.lean
index f188aef992065..b9a613eb44f78 100644
--- a/src/data/complex/is_R_or_C.lean
+++ b/src/data/complex/is_R_or_C.lean
@@ -559,7 +559,7 @@ lemma abs_add (z w : K) : abs (z + w) ≤ abs z + abs w :=
 begin
   rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs,
       add_right_comm, norm_sq_add, add_le_add_iff_left,
-      mul_assoc, mul_le_mul_left (@zero_lt_two ℝ _ _)],
+      mul_assoc, mul_le_mul_left (zero_lt_two' ℝ)],
   simpa [-mul_re] with is_R_or_C_simps using re_le_abs (z * conj w)
 end
 
diff --git a/src/data/enat/basic.lean b/src/data/enat/basic.lean
index 8c2a1a9271b13..c3200de999f2a 100644
--- a/src/data/enat/basic.lean
+++ b/src/data/enat/basic.lean
@@ -3,7 +3,6 @@ Copyright (c) 2022 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
-import data.nat.lattice
 import data.nat.succ_pred
 import algebra.char_zero.lemmas
 import algebra.order.sub.with_top
@@ -19,8 +18,8 @@ about this type.
 /-- Extended natural numbers `ℕ∞ = with_top ℕ`. -/
 @[derive [has_zero, add_comm_monoid_with_one, canonically_ordered_comm_semiring, nontrivial,
   linear_order, order_bot, order_top, has_bot, has_top, canonically_linear_ordered_add_monoid,
-  has_sub, has_ordered_sub, complete_linear_order, linear_ordered_add_comm_monoid_with_top,
-  succ_order, well_founded_lt, has_well_founded, char_zero, has_coe_t ℕ]]
+  has_sub, has_ordered_sub, linear_ordered_add_comm_monoid_with_top, succ_order, well_founded_lt,
+  has_well_founded, char_zero, has_coe_t ℕ]]
 def enat : Type := with_top ℕ
 
 notation `ℕ∞` := enat
diff --git a/src/data/enat/lattice.lean b/src/data/enat/lattice.lean
new file mode 100644
index 0000000000000..73da7e8364477
--- /dev/null
+++ b/src/data/enat/lattice.lean
@@ -0,0 +1,15 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import data.nat.lattice
+import data.enat.basic
+
+/-!
+# Extended natural numbers form a complete linear order
+
+This instance is not in `data.enat.basic` to avoid dependency on `finset`s.
+-/
+
+attribute [derive complete_linear_order] enat
diff --git a/src/data/fin/tuple/basic.lean b/src/data/fin/tuple/basic.lean
index 8deaf3f06fa08..63dbee10e3c9d 100644
--- a/src/data/fin/tuple/basic.lean
+++ b/src/data/fin/tuple/basic.lean
@@ -120,19 +120,58 @@ end
 
 /-- Recurse on an `n+1`-tuple by splitting it into a single element and an `n`-tuple. -/
 @[elab_as_eliminator]
-def cons_induction {P : (Π i : fin n.succ, α i) → Sort v}
+def cons_cases {P : (Π i : fin n.succ, α i) → Sort v}
   (h : ∀ x₀ x, P (fin.cons x₀ x)) (x : (Π i : fin n.succ, α i)) : P x :=
 _root_.cast (by rw cons_self_tail) $ h (x 0) (tail x)
 
-@[simp] lemma cons_induction_cons {P : (Π i : fin n.succ, α i) → Sort v}
+@[simp] lemma cons_cases_cons {P : (Π i : fin n.succ, α i) → Sort v}
   (h : Π x₀ x, P (fin.cons x₀ x)) (x₀ : α 0) (x : Π i : fin n, α i.succ) :
-  @cons_induction _ _ _ h (cons x₀ x) = h x₀ x :=
+  @cons_cases _ _ _ h (cons x₀ x) = h x₀ x :=
 begin
-  rw [cons_induction, cast_eq],
+  rw [cons_cases, cast_eq],
   congr',
   exact tail_cons _ _
 end
 
+/-- Recurse on an tuple by splitting into `fin.elim0` and `fin.cons`. -/
+@[elab_as_eliminator]
+def cons_induction {α : Type*} {P : Π {n : ℕ}, (fin n → α) → Sort v}
+  (h0 : P fin.elim0)
+  (h : ∀ {n} x₀ (x : fin n → α), P x → P (fin.cons x₀ x)) : Π {n : ℕ} (x : fin n → α), P x
+| 0 x := by convert h0
+| (n + 1) x := cons_cases (λ x₀ x, h _ _ $ cons_induction _) x
+
+lemma cons_injective_of_injective {α} {x₀ : α} {x : fin n → α} (hx₀ : x₀ ∉ set.range x)
+  (hx : function.injective x) :
+  function.injective (cons x₀ x : fin n.succ → α) :=
+begin
+  refine fin.cases _ _,
+  { refine fin.cases _ _,
+    { intro _,
+      refl },
+    { intros j h,
+      rw [cons_zero, cons_succ] at h,
+      exact hx₀.elim ⟨_, h.symm⟩ } },
+  { intro i,
+    refine fin.cases _ _,
+    { intro h,
+      rw [cons_zero, cons_succ] at h,
+      exact hx₀.elim ⟨_, h⟩ },
+    { intros j h,
+      rw [cons_succ, cons_succ] at h,
+      exact congr_arg _ (hx h), } },
+end
+
+lemma cons_injective_iff {α} {x₀ : α} {x : fin n → α} :
+  function.injective (cons x₀ x : fin n.succ → α) ↔ x₀ ∉ set.range x ∧ function.injective x  :=
+begin
+  refine ⟨λ h, ⟨_, _⟩, and.rec cons_injective_of_injective⟩,
+  { rintros ⟨i, hi⟩,
+    replace h := @h i.succ 0,
+    simpa [hi, succ_ne_zero] using h, },
+  { simpa [function.comp] using h.comp (fin.succ_injective _) },
+end
+
 @[simp] lemma forall_fin_zero_pi {α : fin 0 → Sort*} {P : (Π i, α i) → Prop} :
   (∀ x, P x) ↔ P fin_zero_elim :=
 ⟨λ h, h _, λ h x, subsingleton.elim fin_zero_elim x ▸ h⟩
@@ -143,7 +182,7 @@ end
 
 lemma forall_fin_succ_pi {P : (Π i, α i) → Prop} :
   (∀ x, P x) ↔ (∀ a v, P (fin.cons a v)) :=
-⟨λ h a v, h (fin.cons a v), cons_induction⟩
+⟨λ h a v, h (fin.cons a v), cons_cases⟩
 
 lemma exists_fin_succ_pi {P : (Π i, α i) → Prop} :
   (∃ x, P x) ↔ (∃ a v, P (fin.cons a v)) :=
diff --git a/src/data/fin/tuple/nat_antidiagonal.lean b/src/data/fin/tuple/nat_antidiagonal.lean
index dadbc86d134b8..a6cf499a743a3 100644
--- a/src/data/fin/tuple/nat_antidiagonal.lean
+++ b/src/data/fin/tuple/nat_antidiagonal.lean
@@ -68,16 +68,17 @@ def antidiagonal_tuple : Π k, ℕ → list (fin k → ℕ)
 lemma mem_antidiagonal_tuple {n : ℕ} {k : ℕ} {x : fin k → ℕ} :
   x ∈ antidiagonal_tuple k n ↔ ∑ i, x i = n :=
 begin
-  induction k with k ih generalizing n,
-  { cases n,
+  revert n,
+  refine fin.cons_induction _ _ x,
+  { intro n,
+    cases n,
     { simp },
-    { simp [eq_comm] }, },
-  { refine fin.cons_induction (λ x₀ x, _) x,
+    { simp [eq_comm] } },
+  { intros k x₀ x ih n,
     simp_rw [fin.sum_cons, antidiagonal_tuple, list.mem_bind, list.mem_map,
-      list.nat.mem_antidiagonal, fin.cons_eq_cons, exists_eq_right_right, ih, prod.exists],
-    split,
-    { rintros ⟨a, b, rfl, rfl, rfl⟩, refl },
-    { rintro rfl, exact ⟨_, _, rfl, rfl, rfl⟩, } },
+      list.nat.mem_antidiagonal, fin.cons_eq_cons, exists_eq_right_right, ih,
+      @eq_comm _ _ (prod.snd _), and_comm (prod.snd _ = _), ←prod.mk.inj_iff, prod.mk.eta,
+      exists_prop, exists_eq_right] },
 end
 
 /-- The antidiagonal of `n` does not contain duplicate entries. -/
diff --git a/src/data/finset/basic.lean b/src/data/finset/basic.lean
index 327ac7c504fc4..75bba419c8e3b 100644
--- a/src/data/finset/basic.lean
+++ b/src/data/finset/basic.lean
@@ -70,8 +70,6 @@ and the empty finset otherwise. See `data.fintype.basic`.
 
 ### Finsets from functions
 
-* `finset.image`: Given a function `f : α → β`, `s.image f` is the image finset in `β`.
-* `finset.map`: Given an embedding `f : α ↪ β`, `s.map f` is the image finset in `β`.
 * `finset.filter`: Given a predicate `p : α → Prop`, `s.filter p` is
   the finset consisting of those elements in `s` satisfying the predicate `p`.
 
@@ -350,8 +348,14 @@ set.nonempty.mono hst hs
 lemma nonempty.forall_const {s : finset α} (h : s.nonempty) {p : Prop} : (∀ x ∈ s, p) ↔ p :=
 let ⟨x, hx⟩ := h in ⟨λ h, h x hx, λ h x hx, h⟩
 
+lemma nonempty.to_subtype {s : finset α} : s.nonempty → nonempty s := nonempty_coe_sort.2
+lemma nonempty.to_type {s : finset α} : s.nonempty → nonempty α := λ ⟨x, hx⟩, ⟨x⟩
+
 /-! ### empty -/
 
+section empty
+variables {s : finset α}
+
 /-- The empty finset -/
 protected def empty : finset α := ⟨0, nodup_zero⟩
 
@@ -420,8 +424,18 @@ instance : order_bot (finset α) :=
 
 @[simp] lemma bot_eq_empty : (⊥ : finset α) = ∅ := rfl
 
+@[simp] lemma empty_ssubset : ∅ ⊂ s ↔ s.nonempty :=
+(@bot_lt_iff_ne_bot (finset α) _ _ _).trans nonempty_iff_ne_empty.symm
+
+alias empty_ssubset ↔ _ nonempty.empty_ssubset
+
+end empty
+
 /-! ### singleton -/
 
+section singleton
+variables {a : α}
+
 /--
 `{a} : finset a` is the set `{a}` containing `a` and nothing else.
 
@@ -449,6 +463,8 @@ singleton_injective.eq_iff
 
 @[simp] theorem singleton_ne_empty (a : α) : ({a} : finset α) ≠ ∅ := (singleton_nonempty a).ne_empty
 
+lemma empty_ssubset_singleton : (∅ : finset α) ⊂ {a} := (singleton_nonempty _).empty_ssubset
+
 @[simp, norm_cast] lemma coe_singleton (a : α) : (({a} : finset α) : set α) = {a} :=
 by { ext, simp }
 
@@ -513,6 +529,8 @@ instance [is_empty α] : unique (finset α) :=
 { default := ∅,
   uniq := λ s, eq_empty_of_forall_not_mem is_empty_elim }
 
+end singleton
+
 /-! ### cons -/
 
 section cons
@@ -1940,6 +1958,14 @@ by rw [← not_nonempty_iff_eq_empty, nonempty_range_iff, not_not]
 lemma nonempty_range_succ : (range $ n + 1).nonempty :=
 nonempty_range_iff.2 n.succ_ne_zero
 
+@[simp]
+lemma range_filter_eq {n m : ℕ} : (range n).filter (= m) = if m < n then {m} else ∅ :=
+begin
+  convert filter_eq (range n) m,
+  { ext, exact comm },
+  { simp }
+end
+
 end range
 
 /- useful rules for calculations with quantifiers -/
@@ -2116,517 +2142,6 @@ end list
 
 namespace finset
 
-/-! ### map -/
-section map
-open function
-
-/-- When `f` is an embedding of `α` in `β` and `s` is a finset in `α`, then `s.map f` is the image
-finset in `β`. The embedding condition guarantees that there are no duplicates in the image. -/
-def map (f : α ↪ β) (s : finset α) : finset β := ⟨s.1.map f, s.2.map f.2⟩
-
-@[simp] theorem map_val (f : α ↪ β) (s : finset α) : (map f s).1 = s.1.map f := rfl
-
-@[simp] theorem map_empty (f : α ↪ β) : (∅ : finset α).map f = ∅ := rfl
-
-variables {f : α ↪ β} {s : finset α}
-
-@[simp] theorem mem_map {b : β} : b ∈ s.map f ↔ ∃ a ∈ s, f a = b :=
-mem_map.trans $ by simp only [exists_prop]; refl
-
-@[simp] lemma mem_map_equiv {f : α ≃ β} {b : β} : b ∈ s.map f.to_embedding ↔ f.symm b ∈ s :=
-by { rw mem_map, exact ⟨by { rintro ⟨a, H, rfl⟩, simpa }, λ h, ⟨_, h, by simp⟩⟩ }
-
-lemma mem_map' (f : α ↪ β) {a} {s : finset α} : f a ∈ s.map f ↔ a ∈ s := mem_map_of_injective f.2
-
-lemma mem_map_of_mem (f : α ↪ β) {a} {s : finset α} : a ∈ s → f a ∈ s.map f := (mem_map' _).2
-
-lemma forall_mem_map {f : α ↪ β} {s : finset α} {p : Π a, a ∈ s.map f → Prop} :
-  (∀ y ∈ s.map f, p y H) ↔ ∀ x ∈ s, p (f x) (mem_map_of_mem _ H) :=
-⟨λ h y hy, h (f y) (mem_map_of_mem _ hy), λ h x hx,
-  by { obtain ⟨y, hy, rfl⟩ := mem_map.1 hx, exact h _ hy }⟩
-
-lemma apply_coe_mem_map (f : α ↪ β) (s : finset α) (x : s) : f x ∈ s.map f :=
-mem_map_of_mem f x.prop
-
-@[simp, norm_cast] theorem coe_map (f : α ↪ β) (s : finset α) : (s.map f : set β) = f '' s :=
-set.ext $ λ x, mem_map.trans set.mem_image_iff_bex.symm
-
-theorem coe_map_subset_range (f : α ↪ β) (s : finset α) : (s.map f : set β) ⊆ set.range f :=
-calc ↑(s.map f) = f '' s      : coe_map f s
-            ... ⊆ set.range f : set.image_subset_range f ↑s
-
-/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect.
--/
-lemma map_perm {σ : equiv.perm α} (hs : {a | σ a ≠ a} ⊆ s) : s.map (σ : α ↪ α) = s :=
-coe_injective $ (coe_map _ _).trans $ set.image_perm hs
-
-theorem map_to_finset [decidable_eq α] [decidable_eq β] {s : multiset α} :
-  s.to_finset.map f = (s.map f).to_finset :=
-ext $ λ _, by simp only [mem_map, multiset.mem_map, exists_prop, multiset.mem_to_finset]
-
-@[simp] theorem map_refl : s.map (embedding.refl _) = s :=
-ext $ λ _, by simpa only [mem_map, exists_prop] using exists_eq_right
-
-@[simp] theorem map_cast_heq {α β} (h : α = β) (s : finset α) :
-  s.map (equiv.cast h).to_embedding == s :=
-by { subst h, simp }
-
-theorem map_map (f : α ↪ β) (g : β ↪ γ) (s : finset α) : (s.map f).map g = s.map (f.trans g) :=
-eq_of_veq $ by simp only [map_val, multiset.map_map]; refl
-
-lemma map_comm {β'} {f : β ↪ γ} {g : α ↪ β} {f' : α ↪ β'} {g' : β' ↪ γ}
-  (h_comm : ∀ a, f (g a) = g' (f' a)) :
-  (s.map g).map f = (s.map f').map g' :=
-by simp_rw [map_map, embedding.trans, function.comp, h_comm]
-
-lemma _root_.function.semiconj.finset_map {f : α ↪ β} {ga : α ↪ α} {gb : β ↪ β}
-  (h : function.semiconj f ga gb) :
-  function.semiconj (map f) (map ga) (map gb) :=
-λ s, map_comm h
-
-lemma _root_.function.commute.finset_map {f g : α ↪ α} (h : function.commute f g) :
-  function.commute (map f) (map g) :=
-h.finset_map
-
-@[simp] theorem map_subset_map {s₁ s₂ : finset α} : s₁.map f ⊆ s₂.map f ↔ s₁ ⊆ s₂ :=
-⟨λ h x xs, (mem_map' _).1 $ h $ (mem_map' f).2 xs,
- λ h, by simp [subset_def, map_subset_map h]⟩
-
-/-- Associate to an embedding `f` from `α` to `β` the order embedding that maps a finset to its
-image under `f`. -/
-def map_embedding (f : α ↪ β) : finset α ↪o finset β :=
-order_embedding.of_map_le_iff (map f) (λ _ _, map_subset_map)
-
-@[simp] theorem map_inj {s₁ s₂ : finset α} : s₁.map f = s₂.map f ↔ s₁ = s₂ :=
-(map_embedding f).injective.eq_iff
-
-lemma map_injective (f : α ↪ β) : injective (map f) := (map_embedding f).injective
-
-@[simp] theorem map_embedding_apply : map_embedding f s = map f s := rfl
-
-lemma filter_map {p : β → Prop} [decidable_pred p] :
-  (s.map f).filter p = (s.filter (p ∘ f)).map f :=
-eq_of_veq (map_filter _ _ _)
-
-lemma map_filter {f : α ≃ β} {p : α → Prop} [decidable_pred p] :
-  (s.filter p).map f.to_embedding = (s.map f.to_embedding).filter (p ∘ f.symm) :=
-by simp only [filter_map, function.comp, equiv.to_embedding_apply, equiv.symm_apply_apply]
-
-@[simp] lemma disjoint_map {s t : finset α} (f : α ↪ β) :
-  disjoint (s.map f) (t.map f) ↔ disjoint s t :=
-begin
-  simp only [disjoint_iff_ne, mem_map, exists_prop, exists_imp_distrib, and_imp],
-  refine ⟨λ h a ha b hb hab, h _ _ ha rfl _ _ hb rfl $ congr_arg _ hab, _⟩,
-  rintro h _ a ha rfl _ b hb rfl,
-  exact f.injective.ne (h _ ha _ hb),
-end
-
-theorem map_disj_union {f : α ↪ β} (s₁ s₂ : finset α) (h) (h' := (disjoint_map _).mpr h) :
-  (s₁.disj_union s₂ h).map f = (s₁.map f).disj_union (s₂.map f) h' :=
-eq_of_veq $ multiset.map_add _ _ _
-
-/-- A version of `finset.map_disj_union` for writing in the other direction. -/
-theorem map_disj_union' {f : α ↪ β} (s₁ s₂ : finset α) (h') (h := (disjoint_map _).mp h') :
-  (s₁.disj_union s₂ h).map f = (s₁.map f).disj_union (s₂.map f) h' :=
-map_disj_union _ _ _
-
-theorem map_union [decidable_eq α] [decidable_eq β]
-  {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∪ s₂).map f = s₁.map f ∪ s₂.map f :=
-coe_injective $ by simp only [coe_map, coe_union, set.image_union]
-
-theorem map_inter [decidable_eq α] [decidable_eq β]
-  {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∩ s₂).map f = s₁.map f ∩ s₂.map f :=
-coe_injective $ by simp only [coe_map, coe_inter, set.image_inter f.injective]
-
-@[simp] theorem map_singleton (f : α ↪ β) (a : α) : map f {a} = {f a} :=
-coe_injective $ by simp only [coe_map, coe_singleton, set.image_singleton]
-
-@[simp] lemma map_insert [decidable_eq α] [decidable_eq β] (f : α ↪ β) (a : α) (s : finset α) :
-  (insert a s).map f = insert (f a) (s.map f) :=
-by simp only [insert_eq, map_union, map_singleton]
-
-@[simp] lemma map_cons (f : α ↪ β) (a : α) (s : finset α) (ha : a ∉ s) :
-  (cons a s ha).map f = cons (f a) (s.map f) (by simpa using ha) :=
-eq_of_veq $ multiset.map_cons f a s.val
-
-@[simp] theorem map_eq_empty : s.map f = ∅ ↔ s = ∅ :=
-⟨λ h, eq_empty_of_forall_not_mem $
- λ a m, ne_empty_of_mem (mem_map_of_mem _ m) h, λ e, e.symm ▸ rfl⟩
-
-@[simp] lemma map_nonempty : (s.map f).nonempty ↔ s.nonempty :=
-by rw [nonempty_iff_ne_empty, nonempty_iff_ne_empty, ne.def, map_eq_empty]
-
-alias map_nonempty ↔ _ nonempty.map
-
-lemma attach_map_val {s : finset α} : s.attach.map (embedding.subtype _) = s :=
-eq_of_veq $ by rw [map_val, attach_val]; exact attach_map_val _
-
-lemma disjoint_range_add_left_embedding (a b : ℕ) :
-  disjoint (range a) (map (add_left_embedding a) (range b)) :=
-begin
-  refine disjoint_iff_inf_le.mpr _,
-  intros k hk,
-  simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply,
-    mem_inter] at hk,
-  obtain ⟨a, haQ, ha⟩ := hk.2,
-  simpa [← ha] using hk.1,
-end
-
-lemma disjoint_range_add_right_embedding (a b : ℕ) :
-  disjoint (range a) (map (add_right_embedding a) (range b)) :=
-begin
-  refine disjoint_iff_inf_le.mpr _,
-  intros k hk,
-  simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply,
-    mem_inter] at hk,
-  obtain ⟨a, haQ, ha⟩ := hk.2,
-  simpa [← ha] using hk.1,
-end
-
-end map
-
-lemma range_add_one' (n : ℕ) :
-  range (n + 1) = insert 0 ((range n).map ⟨λi, i + 1, assume i j, nat.succ.inj⟩) :=
-by ext (⟨⟩ | ⟨n⟩); simp [nat.succ_eq_add_one, nat.zero_lt_succ n]
-
-/-! ### image -/
-
-section image
-variables [decidable_eq β]
-
-/-- `image f s` is the forward image of `s` under `f`. -/
-def image (f : α → β) (s : finset α) : finset β := (s.1.map f).to_finset
-
-@[simp] theorem image_val (f : α → β) (s : finset α) : (image f s).1 = (s.1.map f).dedup := rfl
-
-@[simp] theorem image_empty (f : α → β) : (∅ : finset α).image f = ∅ := rfl
-
-variables {f g : α → β} {s : finset α} {t : finset β} {a : α} {b c : β}
-
-@[simp] lemma mem_image : b ∈ s.image f ↔ ∃ a ∈ s, f a = b :=
-by simp only [mem_def, image_val, mem_dedup, multiset.mem_map, exists_prop]
-
-lemma mem_image_of_mem (f : α → β) {a} (h : a ∈ s) : f a ∈ s.image f := mem_image.2 ⟨_, h, rfl⟩
-
-@[simp] lemma mem_image_const : c ∈ s.image (const α b) ↔ s.nonempty ∧ b = c :=
-by { rw mem_image, simp only [exists_prop, const_apply, exists_and_distrib_right], refl }
-
-lemma mem_image_const_self : b ∈ s.image (const α b) ↔ s.nonempty :=
-mem_image_const.trans $ and_iff_left rfl
-
-instance can_lift (c) (p) [can_lift β α c p] :
-  can_lift (finset β) (finset α) (image c) (λ s, ∀ x ∈ s, p x) :=
-{ prf :=
-    begin
-      rintro ⟨⟨l⟩, hd : l.nodup⟩ hl,
-      lift l to list α using hl,
-      exact ⟨⟨l, hd.of_map _⟩, ext $ λ a, by simp⟩,
-    end }
-
-lemma image_congr (h : (s : set α).eq_on f g) : finset.image f s = finset.image g s :=
-by { ext, simp_rw mem_image, exact bex_congr (λ x hx, by rw h hx) }
-
-lemma _root_.function.injective.mem_finset_image (hf : injective f) : f a ∈ s.image f ↔ a ∈ s :=
-begin
-  refine ⟨λ h, _, finset.mem_image_of_mem f⟩,
-  obtain ⟨y, hy, heq⟩ := mem_image.1 h,
-  exact hf heq ▸ hy,
-end
-
-lemma filter_mem_image_eq_image (f : α → β) (s : finset α) (t : finset β) (h : ∀ x ∈ s, f x ∈ t) :
-  t.filter (λ y, y ∈ s.image f) = s.image f :=
-by { ext, rw [mem_filter, mem_image],
-     simp only [and_imp, exists_prop, and_iff_right_iff_imp, exists_imp_distrib],
-     rintros x xel rfl, exact h _ xel }
-
-lemma fiber_nonempty_iff_mem_image (f : α → β) (s : finset α) (y : β) :
-  (s.filter (λ x, f x = y)).nonempty ↔ y ∈ s.image f :=
-by simp [finset.nonempty]
-
-@[simp, norm_cast] lemma coe_image {f : α → β} : ↑(s.image f) = f '' ↑s :=
-set.ext $ λ _, mem_image.trans set.mem_image_iff_bex.symm
-
-protected lemma nonempty.image (h : s.nonempty) (f : α → β) : (s.image f).nonempty :=
-let ⟨a, ha⟩ := h in ⟨f a, mem_image_of_mem f ha⟩
-
-@[simp] lemma nonempty.image_iff (f : α → β) : (s.image f).nonempty ↔ s.nonempty :=
-⟨λ ⟨y, hy⟩, let ⟨x, hx, _⟩ := mem_image.mp hy in ⟨x, hx⟩, λ h, h.image f⟩
-
-theorem image_to_finset [decidable_eq α] {s : multiset α} :
-  s.to_finset.image f = (s.map f).to_finset :=
-ext $ λ _, by simp only [mem_image, multiset.mem_to_finset, exists_prop, multiset.mem_map]
-
-lemma image_val_of_inj_on (H : set.inj_on f s) : (image f s).1 = s.1.map f := (s.2.map_on H).dedup
-
-@[simp] lemma image_id [decidable_eq α] : s.image id = s :=
-ext $ λ _, by simp only [mem_image, exists_prop, id, exists_eq_right]
-
-@[simp] theorem image_id' [decidable_eq α] : s.image (λ x, x) = s := image_id
-
-theorem image_image [decidable_eq γ] {g : β → γ} : (s.image f).image g = s.image (g ∘ f) :=
-eq_of_veq $ by simp only [image_val, dedup_map_dedup_eq, multiset.map_map]
-
-lemma image_comm {β'} [decidable_eq β'] [decidable_eq γ] {f : β → γ} {g : α → β}
-  {f' : α → β'} {g' : β' → γ} (h_comm : ∀ a, f (g a) = g' (f' a)) :
-  (s.image g).image f = (s.image f').image g' :=
-by simp_rw [image_image, comp, h_comm]
-
-lemma _root_.function.semiconj.finset_image [decidable_eq α] {f : α → β} {ga : α → α} {gb : β → β}
-  (h : function.semiconj f ga gb) :
-  function.semiconj (image f) (image ga) (image gb) :=
-λ s, image_comm h
-
-lemma _root_.function.commute.finset_image [decidable_eq α] {f g : α → α}
-  (h : function.commute f g) :
-  function.commute (image f) (image g) :=
-h.finset_image
-
-theorem image_subset_image {s₁ s₂ : finset α} (h : s₁ ⊆ s₂) : s₁.image f ⊆ s₂.image f :=
-by simp only [subset_def, image_val, subset_dedup', dedup_subset',
-  multiset.map_subset_map h]
-
-lemma image_subset_iff : s.image f ⊆ t ↔ ∀ x ∈ s, f x ∈ t :=
-calc s.image f ⊆ t ↔ f '' ↑s ⊆ ↑t : by norm_cast
-               ... ↔ _ : set.image_subset_iff
-
-theorem image_mono (f : α → β) : monotone (finset.image f) := λ _ _, image_subset_image
-
-lemma image_subset_image_iff {t : finset α} (hf : injective f) : s.image f ⊆ t.image f ↔ s ⊆ t :=
-by { simp_rw ←coe_subset, push_cast, exact set.image_subset_image_iff hf }
-
-theorem coe_image_subset_range : ↑(s.image f) ⊆ set.range f :=
-calc ↑(s.image f) = f '' ↑s     : coe_image
-              ... ⊆ set.range f : set.image_subset_range f ↑s
-
-theorem image_filter {p : β → Prop} [decidable_pred p] :
-  (s.image f).filter p = (s.filter (p ∘ f)).image f :=
-ext $ λ b, by simp only [mem_filter, mem_image, exists_prop]; exact
-⟨by rintro ⟨⟨x, h1, rfl⟩, h2⟩; exact ⟨x, ⟨h1, h2⟩, rfl⟩,
- by rintro ⟨x, ⟨h1, h2⟩, rfl⟩; exact ⟨⟨x, h1, rfl⟩, h2⟩⟩
-
-theorem image_union [decidable_eq α] {f : α → β} (s₁ s₂ : finset α) :
-  (s₁ ∪ s₂).image f = s₁.image f ∪ s₂.image f :=
-ext $ λ _, by simp only [mem_image, mem_union, exists_prop, or_and_distrib_right,
-  exists_or_distrib]
-
-lemma image_inter_subset [decidable_eq α] (f : α → β) (s t : finset α) :
-  (s ∩ t).image f ⊆ s.image f ∩ t.image f :=
-subset_inter (image_subset_image $ inter_subset_left _ _) $
-  image_subset_image $ inter_subset_right _ _
-
-lemma image_inter_of_inj_on [decidable_eq α] {f : α → β} (s t : finset α)
-  (hf : set.inj_on f (s ∪ t)) :
-  (s ∩ t).image f = s.image f ∩ t.image f :=
-(image_inter_subset _ _ _).antisymm $ λ x, begin
-  simp only [mem_inter, mem_image],
-  rintro ⟨⟨a, ha, rfl⟩, b, hb, h⟩,
-  exact ⟨a, ⟨ha, by rwa ←hf (or.inr hb) (or.inl ha) h⟩, rfl⟩,
-end
-
-lemma image_inter [decidable_eq α] (s₁ s₂ : finset α) (hf : injective f) :
-  (s₁ ∩ s₂).image f = s₁.image f ∩ s₂.image f :=
-image_inter_of_inj_on _ _ $ hf.inj_on _
-
-@[simp] theorem image_singleton (f : α → β) (a : α) : image f {a} = {f a} :=
-ext $ λ x, by simpa only [mem_image, exists_prop, mem_singleton, exists_eq_left] using eq_comm
-
-@[simp] theorem image_insert [decidable_eq α] (f : α → β) (a : α) (s : finset α) :
-  (insert a s).image f = insert (f a) (s.image f) :=
-by simp only [insert_eq, image_singleton, image_union]
-
-lemma erase_image_subset_image_erase [decidable_eq α] (f : α → β) (s : finset α) (a : α) :
-  (s.image f).erase (f a) ⊆ (s.erase a).image f :=
-begin
-  simp only [subset_iff, and_imp, exists_prop, mem_image, exists_imp_distrib, mem_erase],
-  rintro b hb x hx rfl,
-  exact ⟨_, ⟨ne_of_apply_ne f hb, hx⟩, rfl⟩,
-end
-
-@[simp] lemma image_erase [decidable_eq α] {f : α → β} (hf : injective f) (s : finset α) (a : α) :
-  (s.erase a).image f = (s.image f).erase (f a) :=
-begin
-  refine (erase_image_subset_image_erase _ _ _).antisymm' (λ b, _),
-  simp only [mem_image, exists_prop, mem_erase],
-  rintro ⟨a', ⟨haa', ha'⟩, rfl⟩,
-  exact ⟨hf.ne haa', a', ha', rfl⟩,
-end
-
-@[simp] theorem image_eq_empty : s.image f = ∅ ↔ s = ∅ :=
-⟨λ h, eq_empty_of_forall_not_mem $
- λ a m, ne_empty_of_mem (mem_image_of_mem _ m) h, λ e, e.symm ▸ rfl⟩
-
-@[simp] lemma _root_.disjoint.of_image_finset
-  {s t : finset α} {f : α → β} (h : disjoint (s.image f) (t.image f)) :
-  disjoint s t :=
-disjoint_iff_ne.2 $ λ a ha b hb, ne_of_apply_ne f $ h.forall_ne_finset
-  (mem_image_of_mem _ ha) (mem_image_of_mem _ hb)
-
-lemma mem_range_iff_mem_finset_range_of_mod_eq' [decidable_eq α] {f : ℕ → α} {a : α} {n : ℕ}
-  (hn : 0 < n) (h : ∀ i, f (i % n) = f i) :
-  a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) :=
-begin
-  split,
-  { rintros ⟨i, hi⟩,
-    simp only [mem_image, exists_prop, mem_range],
-    exact ⟨i % n, nat.mod_lt i hn, (rfl.congr hi).mp (h i)⟩ },
-  { rintro h,
-    simp only [mem_image, exists_prop, set.mem_range, mem_range] at *,
-    rcases h with ⟨i, hi, ha⟩,
-    exact ⟨i, ha⟩ }
-end
-
-lemma mem_range_iff_mem_finset_range_of_mod_eq [decidable_eq α] {f : ℤ → α} {a : α} {n : ℕ}
-  (hn : 0 < n) (h : ∀ i, f (i % n) = f i) :
-  a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) :=
-suffices (∃ i, f (i % n) = a) ↔ ∃ i, i < n ∧ f ↑i = a, by simpa [h],
-have hn' : 0 < (n : ℤ), from int.coe_nat_lt.mpr hn,
-iff.intro
-  (assume ⟨i, hi⟩,
-    have 0 ≤ i % ↑n, from int.mod_nonneg _ (ne_of_gt hn'),
-    ⟨int.to_nat (i % n),
-      by rw [←int.coe_nat_lt, int.to_nat_of_nonneg this]; exact ⟨int.mod_lt_of_pos i hn', hi⟩⟩)
-  (assume ⟨i, hi, ha⟩,
-    ⟨i, by rw [int.mod_eq_of_lt (int.coe_zero_le _) (int.coe_nat_lt_coe_nat_of_lt hi), ha]⟩)
-
-lemma range_add (a b : ℕ) : range (a + b) = range a ∪ (range b).map (add_left_embedding a) :=
-by { rw [←val_inj, union_val], exact multiset.range_add_eq_union a b }
-
-@[simp] lemma attach_image_val [decidable_eq α] {s : finset α} : s.attach.image subtype.val = s :=
-eq_of_veq $ by rw [image_val, attach_val, multiset.attach_map_val, dedup_eq_self]
-
-@[simp] lemma attach_image_coe [decidable_eq α] {s : finset α} : s.attach.image coe = s :=
-finset.attach_image_val
-
-@[simp] lemma attach_insert [decidable_eq α] {a : α} {s : finset α} :
-  attach (insert a s) = insert (⟨a, mem_insert_self a s⟩ : {x // x ∈ insert a s})
-    ((attach s).image (λx, ⟨x.1, mem_insert_of_mem x.2⟩)) :=
-ext $ λ ⟨x, hx⟩, ⟨or.cases_on (mem_insert.1 hx)
-  (λ h : x = a, λ _, mem_insert.2 $ or.inl $ subtype.eq h)
-  (λ h : x ∈ s, λ _, mem_insert_of_mem $ mem_image.2 $ ⟨⟨x, h⟩, mem_attach _ _, subtype.eq rfl⟩),
-λ _, finset.mem_attach _ _⟩
-
-theorem map_eq_image (f : α ↪ β) (s : finset α) : s.map f = s.image f :=
-eq_of_veq (s.map f).2.dedup.symm
-
-@[simp] lemma disjoint_image
-  {s t : finset α} {f : α → β} (hf : injective f) :
-  disjoint (s.image f) (t.image f) ↔ disjoint s t :=
-by convert disjoint_map ⟨_, hf⟩; simp [map_eq_image]
-
-lemma image_const {s : finset α} (h : s.nonempty) (b : β) : s.image (λa, b) = singleton b :=
-ext $ assume b', by simp only [mem_image, exists_prop, exists_and_distrib_right,
-  h.bex, true_and, mem_singleton, eq_comm]
-
-@[simp] lemma map_erase [decidable_eq α] (f : α ↪ β) (s : finset α) (a : α) :
-  (s.erase a).map f = (s.map f).erase (f a) :=
-by { simp_rw map_eq_image, exact s.image_erase f.2 a }
-
-/-! ### Subtype -/
-
-/-- Given a finset `s` and a predicate `p`, `s.subtype p` is the finset of `subtype p` whose
-elements belong to `s`. -/
-protected def subtype {α} (p : α → Prop) [decidable_pred p] (s : finset α) : finset (subtype p) :=
-(s.filter p).attach.map ⟨λ x, ⟨x.1, (finset.mem_filter.1 x.2).2⟩,
-λ x y H, subtype.eq $ subtype.mk.inj H⟩
-
-@[simp] lemma mem_subtype {p : α → Prop} [decidable_pred p] {s : finset α} :
-  ∀ {a : subtype p}, a ∈ s.subtype p ↔ (a : α) ∈ s
-| ⟨a, ha⟩ := by simp [finset.subtype, ha]
-
-lemma subtype_eq_empty {p : α → Prop} [decidable_pred p] {s : finset α} :
-  s.subtype p = ∅ ↔ ∀ x, p x → x ∉ s :=
-by simp [ext_iff, subtype.forall, subtype.coe_mk]; refl
-
-@[mono] lemma subtype_mono {p : α → Prop} [decidable_pred p] : monotone (finset.subtype p) :=
-λ s t h x hx, mem_subtype.2 $ h $ mem_subtype.1 hx
-
-/-- `s.subtype p` converts back to `s.filter p` with
-`embedding.subtype`. -/
-@[simp] lemma subtype_map (p : α → Prop) [decidable_pred p] :
-  (s.subtype p).map (embedding.subtype _) = s.filter p :=
-begin
-  ext x,
-  simp [and_comm _ (_ = _), @and.left_comm _ (_ = _), and_comm (p x) (x ∈ s)]
-end
-
-/-- If all elements of a `finset` satisfy the predicate `p`,
-`s.subtype p` converts back to `s` with `embedding.subtype`. -/
-lemma subtype_map_of_mem {p : α → Prop} [decidable_pred p] (h : ∀ x ∈ s, p x) :
-  (s.subtype p).map (embedding.subtype _) = s :=
-by rw [subtype_map, filter_true_of_mem h]
-
-/-- If a `finset` of a subtype is converted to the main type with
-`embedding.subtype`, all elements of the result have the property of
-the subtype. -/
-lemma property_of_mem_map_subtype {p : α → Prop} (s : finset {x // p x}) {a : α}
-  (h : a ∈ s.map (embedding.subtype _)) : p a :=
-begin
-  rcases mem_map.1 h with ⟨x, hx, rfl⟩,
-  exact x.2
-end
-
-/-- If a `finset` of a subtype is converted to the main type with
-`embedding.subtype`, the result does not contain any value that does
-not satisfy the property of the subtype. -/
-lemma not_mem_map_subtype_of_not_property {p : α → Prop} (s : finset {x // p x})
-  {a : α} (h : ¬ p a) : a ∉ (s.map (embedding.subtype _)) :=
-mt s.property_of_mem_map_subtype h
-
-/-- If a `finset` of a subtype is converted to the main type with
-`embedding.subtype`, the result is a subset of the set giving the
-subtype. -/
-lemma map_subtype_subset {t : set α} (s : finset t) : ↑(s.map (embedding.subtype _)) ⊆ t :=
-begin
-  intros a ha,
-  rw mem_coe at ha,
-  convert property_of_mem_map_subtype s ha
-end
-
-/-! ### Fin -/
-
-/--
-Given a finset `s` of natural numbers and a bound `n`,
-`s.fin n` is the finset of all elements of `s` less than `n`.
--/
-protected def fin (n : ℕ) (s : finset ℕ) : finset (fin n) :=
-(s.subtype _).map fin.equiv_subtype.symm.to_embedding
-
-@[simp] lemma mem_fin {n} {s : finset ℕ} :
-  ∀ a : fin n, a ∈ s.fin n ↔ (a : ℕ) ∈ s
-| ⟨a, ha⟩ := by simp [finset.fin]
-
-@[mono] lemma fin_mono {n} : monotone (finset.fin n) :=
-λ s t h x, by simpa using @h x
-
-@[simp] lemma fin_map {n} {s : finset ℕ} : (s.fin n).map fin.coe_embedding = s.filter (< n) :=
-by simp [finset.fin, finset.map_map]
-
-lemma subset_image_iff {s : set α} : ↑t ⊆ f '' s ↔ ∃ s' : finset α, ↑s' ⊆ s ∧ s'.image f = t :=
-begin
-  split, swap,
-  { rintro ⟨t, ht, rfl⟩, rw [coe_image], exact set.image_subset f ht },
-  intro h,
-  letI : can_lift β s (f ∘ coe) (λ y, y ∈ f '' s) := ⟨λ y ⟨x, hxt, hy⟩, ⟨⟨x, hxt⟩, hy⟩⟩,
-  lift t to finset s using h,
-  refine ⟨t.map (embedding.subtype _), map_subtype_subset _, _⟩,
-  ext y, simp
-end
-
-lemma range_sdiff_zero {n : ℕ} : range (n + 1) \ {0} = (range n).image nat.succ :=
-begin
-  induction n with k hk,
-  { simp },
-  nth_rewrite 1 range_succ,
-  rw [range_succ, image_insert, ←hk, insert_sdiff_of_not_mem],
-  simp
-end
-
-end image
-
-lemma _root_.multiset.to_finset_map [decidable_eq α] [decidable_eq β] (f : α → β) (m : multiset α) :
-  (m.map f).to_finset = m.to_finset.image f :=
-finset.val_inj.1 (multiset.dedup_map_dedup_eq _ _).symm
-
 section to_list
 
 /-- Produce a list of the elements in the finite set using choice. -/
@@ -2714,20 +2229,6 @@ eq_of_veq $ multiset.cons_bind _ _ _
 @[simp] lemma singleton_disj_Union (a : α) {h} : finset.disj_Union {a} t h = t a :=
 eq_of_veq $ multiset.singleton_bind _ _
 
-theorem map_disj_Union {f : α ↪ β} {s : finset α} {t : β → finset γ} {h} :
-  (s.map f).disj_Union t h = s.disj_Union (λa, t (f a))
-    (λ a ha b hb hab, h (mem_map_of_mem _ ha) (mem_map_of_mem _ hb) (f.injective.ne hab)) :=
-eq_of_veq $ multiset.bind_map _ _ _
-
-theorem disj_Union_map {s : finset α} {t : α → finset β} {f : β ↪ γ} {h} :
-  (s.disj_Union t h).map f = s.disj_Union (λa, (t a).map f)
-    (λ a ha b hb hab, disjoint_left.mpr $ λ x hxa hxb, begin
-      obtain ⟨xa, hfa, rfl⟩ := mem_map.mp hxa,
-      obtain ⟨xb, hfb, hfab⟩ := mem_map.mp hxb,
-      obtain rfl := f.injective hfab,
-      exact disjoint_left.mp (h ha hb hab) hfa hfb,
-    end) :=
-eq_of_veq $ multiset.map_bind _ _ _
 
 lemma disj_Union_disj_Union (s : finset α) (f : α → finset β) (g : β → finset γ) (h1 h2) :
   (s.disj_Union f h1).disj_Union g h2 =
@@ -2743,6 +2244,16 @@ lemma disj_Union_disj_Union (s : finset α) (f : α → finset β) (g : β → f
       end) :=
 eq_of_veq $ multiset.bind_assoc.trans (multiset.attach_bind_coe _ _).symm
 
+lemma disj_Union_filter_eq_of_maps_to [decidable_eq β] {s : finset α} {t : finset β} {f : α → β}
+  (h : ∀ x ∈ s, f x ∈ t) :
+  t.disj_Union (λ a, s.filter $ (λ c, f c = a))
+    (λ x' hx y' hy hne, disjoint_filter_filter' _ _ begin
+      simp_rw [pi.disjoint_iff, Prop.disjoint_iff],
+      rintros i ⟨rfl, rfl⟩,
+      exact hne rfl,
+    end) = s :=
+ext $ λ b, by simpa using h b
+
 end disj_Union
 
 section bUnion
@@ -2806,18 +2317,6 @@ theorem inter_bUnion (t : finset β) (s : finset α) (f : α → finset β) :
   t ∩ s.bUnion f = s.bUnion (λ x, t ∩ f x) :=
 by rw [inter_comm, bUnion_inter]; simp [inter_comm]
 
-theorem image_bUnion [decidable_eq γ] {f : α → β} {s : finset α} {t : β → finset γ} :
-  (s.image f).bUnion t = s.bUnion (λa, t (f a)) :=
-by haveI := classical.dec_eq α; exact
-finset.induction_on s rfl (λ a s has ih,
-  by simp only [image_insert, bUnion_insert, ih])
-
-theorem bUnion_image [decidable_eq γ] {s : finset α} {t : α → finset β} {f : β → γ} :
-  (s.bUnion t).image f = s.bUnion (λa, (t a).image f) :=
-by haveI := classical.dec_eq α; exact
-finset.induction_on s rfl (λ a s has ih,
-  by simp only [bUnion_insert, image_union, ih])
-
 lemma bUnion_bUnion [decidable_eq γ] (s : finset α) (f : α → finset β) (g : β → finset γ) :
   (s.bUnion f).bUnion g = s.bUnion (λ a, (f a).bUnion g) :=
 begin
@@ -2852,11 +2351,8 @@ singleton_bUnion.superset.trans $ bUnion_subset_bUnion_of_subset_left u $ single
 ⟨λ h x hx, (subset_bUnion_of_mem f hx).trans h,
  λ h x hx, let ⟨a, ha₁, ha₂⟩ := mem_bUnion.mp hx in h _ ha₁ ha₂⟩
 
-lemma bUnion_singleton {f : α → β} : s.bUnion (λa, {f a}) = s.image f :=
-ext $ λ x, by simp only [mem_bUnion, mem_image, mem_singleton, eq_comm]
-
 @[simp] lemma bUnion_singleton_eq_self [decidable_eq α] : s.bUnion (singleton : α → finset α) = s :=
-by { rw bUnion_singleton, exact image_id }
+ext $ λ x, by simp only [mem_bUnion, mem_singleton, exists_prop, exists_eq_right']
 
 lemma filter_bUnion (s : finset α) (f : α → finset β) (p : β → Prop) [decidable_pred p] :
   (s.bUnion f).filter p = s.bUnion (λ a, (f a).filter p) :=
@@ -2872,12 +2368,8 @@ end
 
 lemma bUnion_filter_eq_of_maps_to [decidable_eq α] {s : finset α} {t : finset β} {f : α → β}
   (h : ∀ x ∈ s, f x ∈ t) :
-  t.bUnion (λa, s.filter $ (λc, f c = a)) = s :=
-ext $ λ b, by simpa using h b
-
-lemma image_bUnion_filter_eq [decidable_eq α] (s : finset β) (g : β → α) :
-  (s.image g).bUnion (λa, s.filter $ (λc, g c = a)) = s :=
-bUnion_filter_eq_of_maps_to (λ x, mem_image_of_mem g)
+  t.bUnion (λ a, s.filter $ (λ c, f c = a)) = s :=
+by simpa only [disj_Union_eq_bUnion] using disj_Union_filter_eq_of_maps_to h
 
 lemma erase_bUnion (f : α → finset β) (s : finset α) (b : β) :
   (s.bUnion f).erase b = s.bUnion (λ x, (f x).erase b) :=
@@ -2956,27 +2448,6 @@ end finset
 
 namespace equiv
 
-/-- Given an equivalence `α` to `β`, produce an equivalence between `finset α` and `finset β`. -/
-protected def finset_congr (e : α ≃ β) : finset α ≃ finset β :=
-{ to_fun := λ s, s.map e.to_embedding,
-  inv_fun := λ s, s.map e.symm.to_embedding,
-  left_inv := λ s, by simp [finset.map_map],
-  right_inv := λ s, by simp [finset.map_map] }
-
-@[simp] lemma finset_congr_apply (e : α ≃ β) (s : finset α) :
-  e.finset_congr s = s.map e.to_embedding :=
-rfl
-
-@[simp] lemma finset_congr_refl : (equiv.refl α).finset_congr = equiv.refl _ := by { ext, simp }
-@[simp] lemma finset_congr_symm (e : α ≃ β) : e.finset_congr.symm = e.symm.finset_congr := rfl
-
-@[simp] lemma finset_congr_trans (e : α ≃ β) (e' : β ≃ γ) :
-  e.finset_congr.trans (e'.finset_congr) = (e.trans e').finset_congr :=
-by { ext, simp [-finset.mem_map, -equiv.trans_to_embedding] }
-
-lemma finset_congr_to_embedding (e : α ≃ β) :
-  e.finset_congr.to_embedding = (finset.map_embedding e.to_embedding).to_embedding := rfl
-
 /--
 Inhabited types are equivalent to `option β` for some `β` by identifying `default α` with `none`.
 -/
diff --git a/src/data/finset/card.lean b/src/data/finset/card.lean
index 201d264b54d1b..c608b4cd382bf 100644
--- a/src/data/finset/card.lean
+++ b/src/data/finset/card.lean
@@ -3,7 +3,7 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura, Jeremy Avigad
 -/
-import data.finset.basic
+import data.finset.image
 import tactic.by_contra
 
 /-!
diff --git a/src/data/finset/default.lean b/src/data/finset/default.lean
index fb51ca936bb36..b8d3d55dabbaf 100644
--- a/src/data/finset/default.lean
+++ b/src/data/finset/default.lean
@@ -1,5 +1,6 @@
 import data.finset.basic
 import data.finset.fold
+import data.finset.image
 import data.finset.lattice
 import data.finset.locally_finite
 import data.finset.nat_antidiagonal
diff --git a/src/data/finset/fold.lean b/src/data/finset/fold.lean
index 1f728224a9520..b42a0a14e09a4 100644
--- a/src/data/finset/fold.lean
+++ b/src/data/finset/fold.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
 import algebra.order.monoid.with_top
-import data.finset.basic
+import data.finset.image
 import data.multiset.fold
 
 /-!
diff --git a/src/data/finset/image.lean b/src/data/finset/image.lean
new file mode 100644
index 0000000000000..35b72e8a79da7
--- /dev/null
+++ b/src/data/finset/image.lean
@@ -0,0 +1,607 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Jeremy Avigad, Minchao Wu, Mario Carneiro
+-/
+import data.finset.basic
+
+/-! # Image and map operations on finite sets
+
+Thie file provides the finite analog of `set.image`, along with some other similar functions.
+
+Note there are two ways to take the image over a finset; via `finset.image` which applies the
+function then removes duplicates (requiring `decidable_eq`), or via `finset.map` which exploits
+injectivity of the function to avoid needing to deduplicate. Choosing between these is similar to
+choosing between `insert` and `finset.cons`, or between `finset.union` and `finset.disj_union`.
+
+## Main definitions
+
+* `finset.image`: Given a function `f : α → β`, `s.image f` is the image finset in `β`.
+* `finset.map`: Given an embedding `f : α ↪ β`, `s.map f` is the image finset in `β`.
+* `finset.subtype`: `s.subtype p` is the the finset of `subtype p` whose elements belong to `s`.
+* `finset.fin`:`s.fin n` is the finset of all elements of `s` less than `n`.
+
+-/
+
+variables {α β γ : Type*}
+open multiset
+open function
+
+namespace finset
+
+/-! ### map -/
+section map
+open function
+
+/-- When `f` is an embedding of `α` in `β` and `s` is a finset in `α`, then `s.map f` is the image
+finset in `β`. The embedding condition guarantees that there are no duplicates in the image. -/
+def map (f : α ↪ β) (s : finset α) : finset β := ⟨s.1.map f, s.2.map f.2⟩
+
+@[simp] theorem map_val (f : α ↪ β) (s : finset α) : (map f s).1 = s.1.map f := rfl
+
+@[simp] theorem map_empty (f : α ↪ β) : (∅ : finset α).map f = ∅ := rfl
+
+variables {f : α ↪ β} {s : finset α}
+
+@[simp] theorem mem_map {b : β} : b ∈ s.map f ↔ ∃ a ∈ s, f a = b :=
+mem_map.trans $ by simp only [exists_prop]; refl
+
+@[simp] lemma mem_map_equiv {f : α ≃ β} {b : β} : b ∈ s.map f.to_embedding ↔ f.symm b ∈ s :=
+by { rw mem_map, exact ⟨by { rintro ⟨a, H, rfl⟩, simpa }, λ h, ⟨_, h, by simp⟩⟩ }
+
+lemma mem_map' (f : α ↪ β) {a} {s : finset α} : f a ∈ s.map f ↔ a ∈ s := mem_map_of_injective f.2
+
+lemma mem_map_of_mem (f : α ↪ β) {a} {s : finset α} : a ∈ s → f a ∈ s.map f := (mem_map' _).2
+
+lemma forall_mem_map {f : α ↪ β} {s : finset α} {p : Π a, a ∈ s.map f → Prop} :
+  (∀ y ∈ s.map f, p y H) ↔ ∀ x ∈ s, p (f x) (mem_map_of_mem _ H) :=
+⟨λ h y hy, h (f y) (mem_map_of_mem _ hy), λ h x hx,
+  by { obtain ⟨y, hy, rfl⟩ := mem_map.1 hx, exact h _ hy }⟩
+
+lemma apply_coe_mem_map (f : α ↪ β) (s : finset α) (x : s) : f x ∈ s.map f :=
+mem_map_of_mem f x.prop
+
+@[simp, norm_cast] theorem coe_map (f : α ↪ β) (s : finset α) : (s.map f : set β) = f '' s :=
+set.ext $ λ x, mem_map.trans set.mem_image_iff_bex.symm
+
+theorem coe_map_subset_range (f : α ↪ β) (s : finset α) : (s.map f : set β) ⊆ set.range f :=
+calc ↑(s.map f) = f '' s      : coe_map f s
+            ... ⊆ set.range f : set.image_subset_range f ↑s
+
+/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect.
+-/
+lemma map_perm {σ : equiv.perm α} (hs : {a | σ a ≠ a} ⊆ s) : s.map (σ : α ↪ α) = s :=
+coe_injective $ (coe_map _ _).trans $ set.image_perm hs
+
+theorem map_to_finset [decidable_eq α] [decidable_eq β] {s : multiset α} :
+  s.to_finset.map f = (s.map f).to_finset :=
+ext $ λ _, by simp only [mem_map, multiset.mem_map, exists_prop, multiset.mem_to_finset]
+
+@[simp] theorem map_refl : s.map (embedding.refl _) = s :=
+ext $ λ _, by simpa only [mem_map, exists_prop] using exists_eq_right
+
+@[simp] theorem map_cast_heq {α β} (h : α = β) (s : finset α) :
+  s.map (equiv.cast h).to_embedding == s :=
+by { subst h, simp }
+
+theorem map_map (f : α ↪ β) (g : β ↪ γ) (s : finset α) : (s.map f).map g = s.map (f.trans g) :=
+eq_of_veq $ by simp only [map_val, multiset.map_map]; refl
+
+lemma map_comm {β'} {f : β ↪ γ} {g : α ↪ β} {f' : α ↪ β'} {g' : β' ↪ γ}
+  (h_comm : ∀ a, f (g a) = g' (f' a)) :
+  (s.map g).map f = (s.map f').map g' :=
+by simp_rw [map_map, embedding.trans, function.comp, h_comm]
+
+lemma _root_.function.semiconj.finset_map {f : α ↪ β} {ga : α ↪ α} {gb : β ↪ β}
+  (h : function.semiconj f ga gb) :
+  function.semiconj (map f) (map ga) (map gb) :=
+λ s, map_comm h
+
+lemma _root_.function.commute.finset_map {f g : α ↪ α} (h : function.commute f g) :
+  function.commute (map f) (map g) :=
+h.finset_map
+
+@[simp] theorem map_subset_map {s₁ s₂ : finset α} : s₁.map f ⊆ s₂.map f ↔ s₁ ⊆ s₂ :=
+⟨λ h x xs, (mem_map' _).1 $ h $ (mem_map' f).2 xs,
+ λ h, by simp [subset_def, map_subset_map h]⟩
+
+/-- Associate to an embedding `f` from `α` to `β` the order embedding that maps a finset to its
+image under `f`. -/
+def map_embedding (f : α ↪ β) : finset α ↪o finset β :=
+order_embedding.of_map_le_iff (map f) (λ _ _, map_subset_map)
+
+@[simp] theorem map_inj {s₁ s₂ : finset α} : s₁.map f = s₂.map f ↔ s₁ = s₂ :=
+(map_embedding f).injective.eq_iff
+
+lemma map_injective (f : α ↪ β) : injective (map f) := (map_embedding f).injective
+
+@[simp] theorem map_embedding_apply : map_embedding f s = map f s := rfl
+
+lemma filter_map {p : β → Prop} [decidable_pred p] :
+  (s.map f).filter p = (s.filter (p ∘ f)).map f :=
+eq_of_veq (map_filter _ _ _)
+
+lemma map_filter {f : α ≃ β} {p : α → Prop} [decidable_pred p] :
+  (s.filter p).map f.to_embedding = (s.map f.to_embedding).filter (p ∘ f.symm) :=
+by simp only [filter_map, function.comp, equiv.to_embedding_apply, equiv.symm_apply_apply]
+
+@[simp] lemma disjoint_map {s t : finset α} (f : α ↪ β) :
+  disjoint (s.map f) (t.map f) ↔ disjoint s t :=
+begin
+  simp only [disjoint_iff_ne, mem_map, exists_prop, exists_imp_distrib, and_imp],
+  refine ⟨λ h a ha b hb hab, h _ _ ha rfl _ _ hb rfl $ congr_arg _ hab, _⟩,
+  rintro h _ a ha rfl _ b hb rfl,
+  exact f.injective.ne (h _ ha _ hb),
+end
+
+theorem map_disj_union {f : α ↪ β} (s₁ s₂ : finset α) (h) (h' := (disjoint_map _).mpr h) :
+  (s₁.disj_union s₂ h).map f = (s₁.map f).disj_union (s₂.map f) h' :=
+eq_of_veq $ multiset.map_add _ _ _
+
+/-- A version of `finset.map_disj_union` for writing in the other direction. -/
+theorem map_disj_union' {f : α ↪ β} (s₁ s₂ : finset α) (h') (h := (disjoint_map _).mp h') :
+  (s₁.disj_union s₂ h).map f = (s₁.map f).disj_union (s₂.map f) h' :=
+map_disj_union _ _ _
+
+theorem map_union [decidable_eq α] [decidable_eq β]
+  {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∪ s₂).map f = s₁.map f ∪ s₂.map f :=
+coe_injective $ by simp only [coe_map, coe_union, set.image_union]
+
+theorem map_inter [decidable_eq α] [decidable_eq β]
+  {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∩ s₂).map f = s₁.map f ∩ s₂.map f :=
+coe_injective $ by simp only [coe_map, coe_inter, set.image_inter f.injective]
+
+@[simp] theorem map_singleton (f : α ↪ β) (a : α) : map f {a} = {f a} :=
+coe_injective $ by simp only [coe_map, coe_singleton, set.image_singleton]
+
+@[simp] lemma map_insert [decidable_eq α] [decidable_eq β] (f : α ↪ β) (a : α) (s : finset α) :
+  (insert a s).map f = insert (f a) (s.map f) :=
+by simp only [insert_eq, map_union, map_singleton]
+
+@[simp] lemma map_cons (f : α ↪ β) (a : α) (s : finset α) (ha : a ∉ s) :
+  (cons a s ha).map f = cons (f a) (s.map f) (by simpa using ha) :=
+eq_of_veq $ multiset.map_cons f a s.val
+
+@[simp] theorem map_eq_empty : s.map f = ∅ ↔ s = ∅ :=
+⟨λ h, eq_empty_of_forall_not_mem $
+ λ a m, ne_empty_of_mem (mem_map_of_mem _ m) h, λ e, e.symm ▸ rfl⟩
+
+@[simp] lemma map_nonempty : (s.map f).nonempty ↔ s.nonempty :=
+by rw [nonempty_iff_ne_empty, nonempty_iff_ne_empty, ne.def, map_eq_empty]
+
+alias map_nonempty ↔ _ nonempty.map
+
+lemma attach_map_val {s : finset α} : s.attach.map (embedding.subtype _) = s :=
+eq_of_veq $ by rw [map_val, attach_val]; exact attach_map_val _
+
+lemma disjoint_range_add_left_embedding (a b : ℕ) :
+  disjoint (range a) (map (add_left_embedding a) (range b)) :=
+begin
+  refine disjoint_iff_inf_le.mpr _,
+  intros k hk,
+  simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply,
+    mem_inter] at hk,
+  obtain ⟨a, haQ, ha⟩ := hk.2,
+  simpa [← ha] using hk.1,
+end
+
+lemma disjoint_range_add_right_embedding (a b : ℕ) :
+  disjoint (range a) (map (add_right_embedding a) (range b)) :=
+begin
+  refine disjoint_iff_inf_le.mpr _,
+  intros k hk,
+  simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply,
+    mem_inter] at hk,
+  obtain ⟨a, haQ, ha⟩ := hk.2,
+  simpa [← ha] using hk.1,
+end
+
+theorem map_disj_Union {f : α ↪ β} {s : finset α} {t : β → finset γ} {h} :
+  (s.map f).disj_Union t h = s.disj_Union (λa, t (f a))
+    (λ a ha b hb hab, h (mem_map_of_mem _ ha) (mem_map_of_mem _ hb) (f.injective.ne hab)) :=
+eq_of_veq $ multiset.bind_map _ _ _
+
+theorem disj_Union_map {s : finset α} {t : α → finset β} {f : β ↪ γ} {h} :
+  (s.disj_Union t h).map f = s.disj_Union (λa, (t a).map f)
+    (λ a ha b hb hab, disjoint_left.mpr $ λ x hxa hxb, begin
+      obtain ⟨xa, hfa, rfl⟩ := mem_map.mp hxa,
+      obtain ⟨xb, hfb, hfab⟩ := mem_map.mp hxb,
+      obtain rfl := f.injective hfab,
+      exact disjoint_left.mp (h ha hb hab) hfa hfb,
+    end) :=
+eq_of_veq $ multiset.map_bind _ _ _
+
+end map
+
+lemma range_add_one' (n : ℕ) :
+  range (n + 1) = insert 0 ((range n).map ⟨λi, i + 1, assume i j, nat.succ.inj⟩) :=
+by ext (⟨⟩ | ⟨n⟩); simp [nat.succ_eq_add_one, nat.zero_lt_succ n]
+
+/-! ### image -/
+
+section image
+variables [decidable_eq β]
+
+/-- `image f s` is the forward image of `s` under `f`. -/
+def image (f : α → β) (s : finset α) : finset β := (s.1.map f).to_finset
+
+@[simp] theorem image_val (f : α → β) (s : finset α) : (image f s).1 = (s.1.map f).dedup := rfl
+
+@[simp] theorem image_empty (f : α → β) : (∅ : finset α).image f = ∅ := rfl
+
+variables {f g : α → β} {s : finset α} {t : finset β} {a : α} {b c : β}
+
+@[simp] lemma mem_image : b ∈ s.image f ↔ ∃ a ∈ s, f a = b :=
+by simp only [mem_def, image_val, mem_dedup, multiset.mem_map, exists_prop]
+
+lemma mem_image_of_mem (f : α → β) {a} (h : a ∈ s) : f a ∈ s.image f := mem_image.2 ⟨_, h, rfl⟩
+
+@[simp] lemma mem_image_const : c ∈ s.image (const α b) ↔ s.nonempty ∧ b = c :=
+by { rw mem_image, simp only [exists_prop, const_apply, exists_and_distrib_right], refl }
+
+lemma mem_image_const_self : b ∈ s.image (const α b) ↔ s.nonempty :=
+mem_image_const.trans $ and_iff_left rfl
+
+instance can_lift (c) (p) [can_lift β α c p] :
+  can_lift (finset β) (finset α) (image c) (λ s, ∀ x ∈ s, p x) :=
+{ prf :=
+    begin
+      rintro ⟨⟨l⟩, hd : l.nodup⟩ hl,
+      lift l to list α using hl,
+      exact ⟨⟨l, hd.of_map _⟩, ext $ λ a, by simp⟩,
+    end }
+
+lemma image_congr (h : (s : set α).eq_on f g) : finset.image f s = finset.image g s :=
+by { ext, simp_rw mem_image, exact bex_congr (λ x hx, by rw h hx) }
+
+lemma _root_.function.injective.mem_finset_image (hf : injective f) : f a ∈ s.image f ↔ a ∈ s :=
+begin
+  refine ⟨λ h, _, finset.mem_image_of_mem f⟩,
+  obtain ⟨y, hy, heq⟩ := mem_image.1 h,
+  exact hf heq ▸ hy,
+end
+
+lemma filter_mem_image_eq_image (f : α → β) (s : finset α) (t : finset β) (h : ∀ x ∈ s, f x ∈ t) :
+  t.filter (λ y, y ∈ s.image f) = s.image f :=
+by { ext, rw [mem_filter, mem_image],
+     simp only [and_imp, exists_prop, and_iff_right_iff_imp, exists_imp_distrib],
+     rintros x xel rfl, exact h _ xel }
+
+lemma fiber_nonempty_iff_mem_image (f : α → β) (s : finset α) (y : β) :
+  (s.filter (λ x, f x = y)).nonempty ↔ y ∈ s.image f :=
+by simp [finset.nonempty]
+
+@[simp, norm_cast] lemma coe_image {f : α → β} : ↑(s.image f) = f '' ↑s :=
+set.ext $ λ _, mem_image.trans set.mem_image_iff_bex.symm
+
+protected lemma nonempty.image (h : s.nonempty) (f : α → β) : (s.image f).nonempty :=
+let ⟨a, ha⟩ := h in ⟨f a, mem_image_of_mem f ha⟩
+
+@[simp] lemma nonempty.image_iff (f : α → β) : (s.image f).nonempty ↔ s.nonempty :=
+⟨λ ⟨y, hy⟩, let ⟨x, hx, _⟩ := mem_image.mp hy in ⟨x, hx⟩, λ h, h.image f⟩
+
+theorem image_to_finset [decidable_eq α] {s : multiset α} :
+  s.to_finset.image f = (s.map f).to_finset :=
+ext $ λ _, by simp only [mem_image, multiset.mem_to_finset, exists_prop, multiset.mem_map]
+
+lemma image_val_of_inj_on (H : set.inj_on f s) : (image f s).1 = s.1.map f := (s.2.map_on H).dedup
+
+@[simp] lemma image_id [decidable_eq α] : s.image id = s :=
+ext $ λ _, by simp only [mem_image, exists_prop, id, exists_eq_right]
+
+@[simp] theorem image_id' [decidable_eq α] : s.image (λ x, x) = s := image_id
+
+theorem image_image [decidable_eq γ] {g : β → γ} : (s.image f).image g = s.image (g ∘ f) :=
+eq_of_veq $ by simp only [image_val, dedup_map_dedup_eq, multiset.map_map]
+
+lemma image_comm {β'} [decidable_eq β'] [decidable_eq γ] {f : β → γ} {g : α → β}
+  {f' : α → β'} {g' : β' → γ} (h_comm : ∀ a, f (g a) = g' (f' a)) :
+  (s.image g).image f = (s.image f').image g' :=
+by simp_rw [image_image, comp, h_comm]
+
+lemma _root_.function.semiconj.finset_image [decidable_eq α] {f : α → β} {ga : α → α} {gb : β → β}
+  (h : function.semiconj f ga gb) :
+  function.semiconj (image f) (image ga) (image gb) :=
+λ s, image_comm h
+
+lemma _root_.function.commute.finset_image [decidable_eq α] {f g : α → α}
+  (h : function.commute f g) :
+  function.commute (image f) (image g) :=
+h.finset_image
+
+theorem image_subset_image {s₁ s₂ : finset α} (h : s₁ ⊆ s₂) : s₁.image f ⊆ s₂.image f :=
+by simp only [subset_def, image_val, subset_dedup', dedup_subset',
+  multiset.map_subset_map h]
+
+lemma image_subset_iff : s.image f ⊆ t ↔ ∀ x ∈ s, f x ∈ t :=
+calc s.image f ⊆ t ↔ f '' ↑s ⊆ ↑t : by norm_cast
+               ... ↔ _ : set.image_subset_iff
+
+theorem image_mono (f : α → β) : monotone (finset.image f) := λ _ _, image_subset_image
+
+lemma image_subset_image_iff {t : finset α} (hf : injective f) : s.image f ⊆ t.image f ↔ s ⊆ t :=
+by { simp_rw ←coe_subset, push_cast, exact set.image_subset_image_iff hf }
+
+theorem coe_image_subset_range : ↑(s.image f) ⊆ set.range f :=
+calc ↑(s.image f) = f '' ↑s     : coe_image
+              ... ⊆ set.range f : set.image_subset_range f ↑s
+
+theorem image_filter {p : β → Prop} [decidable_pred p] :
+  (s.image f).filter p = (s.filter (p ∘ f)).image f :=
+ext $ λ b, by simp only [mem_filter, mem_image, exists_prop]; exact
+⟨by rintro ⟨⟨x, h1, rfl⟩, h2⟩; exact ⟨x, ⟨h1, h2⟩, rfl⟩,
+ by rintro ⟨x, ⟨h1, h2⟩, rfl⟩; exact ⟨⟨x, h1, rfl⟩, h2⟩⟩
+
+theorem image_union [decidable_eq α] {f : α → β} (s₁ s₂ : finset α) :
+  (s₁ ∪ s₂).image f = s₁.image f ∪ s₂.image f :=
+ext $ λ _, by simp only [mem_image, mem_union, exists_prop, or_and_distrib_right,
+  exists_or_distrib]
+
+lemma image_inter_subset [decidable_eq α] (f : α → β) (s t : finset α) :
+  (s ∩ t).image f ⊆ s.image f ∩ t.image f :=
+subset_inter (image_subset_image $ inter_subset_left _ _) $
+  image_subset_image $ inter_subset_right _ _
+
+lemma image_inter_of_inj_on [decidable_eq α] {f : α → β} (s t : finset α)
+  (hf : set.inj_on f (s ∪ t)) :
+  (s ∩ t).image f = s.image f ∩ t.image f :=
+(image_inter_subset _ _ _).antisymm $ λ x, begin
+  simp only [mem_inter, mem_image],
+  rintro ⟨⟨a, ha, rfl⟩, b, hb, h⟩,
+  exact ⟨a, ⟨ha, by rwa ←hf (or.inr hb) (or.inl ha) h⟩, rfl⟩,
+end
+
+lemma image_inter [decidable_eq α] (s₁ s₂ : finset α) (hf : injective f) :
+  (s₁ ∩ s₂).image f = s₁.image f ∩ s₂.image f :=
+image_inter_of_inj_on _ _ $ hf.inj_on _
+
+@[simp] theorem image_singleton (f : α → β) (a : α) : image f {a} = {f a} :=
+ext $ λ x, by simpa only [mem_image, exists_prop, mem_singleton, exists_eq_left] using eq_comm
+
+@[simp] theorem image_insert [decidable_eq α] (f : α → β) (a : α) (s : finset α) :
+  (insert a s).image f = insert (f a) (s.image f) :=
+by simp only [insert_eq, image_singleton, image_union]
+
+lemma erase_image_subset_image_erase [decidable_eq α] (f : α → β) (s : finset α) (a : α) :
+  (s.image f).erase (f a) ⊆ (s.erase a).image f :=
+begin
+  simp only [subset_iff, and_imp, exists_prop, mem_image, exists_imp_distrib, mem_erase],
+  rintro b hb x hx rfl,
+  exact ⟨_, ⟨ne_of_apply_ne f hb, hx⟩, rfl⟩,
+end
+
+@[simp] lemma image_erase [decidable_eq α] {f : α → β} (hf : injective f) (s : finset α) (a : α) :
+  (s.erase a).image f = (s.image f).erase (f a) :=
+begin
+  refine (erase_image_subset_image_erase _ _ _).antisymm' (λ b, _),
+  simp only [mem_image, exists_prop, mem_erase],
+  rintro ⟨a', ⟨haa', ha'⟩, rfl⟩,
+  exact ⟨hf.ne haa', a', ha', rfl⟩,
+end
+
+@[simp] theorem image_eq_empty : s.image f = ∅ ↔ s = ∅ :=
+⟨λ h, eq_empty_of_forall_not_mem $
+ λ a m, ne_empty_of_mem (mem_image_of_mem _ m) h, λ e, e.symm ▸ rfl⟩
+
+@[simp] lemma _root_.disjoint.of_image_finset
+  {s t : finset α} {f : α → β} (h : disjoint (s.image f) (t.image f)) :
+  disjoint s t :=
+disjoint_iff_ne.2 $ λ a ha b hb, ne_of_apply_ne f $ h.forall_ne_finset
+  (mem_image_of_mem _ ha) (mem_image_of_mem _ hb)
+
+lemma mem_range_iff_mem_finset_range_of_mod_eq' [decidable_eq α] {f : ℕ → α} {a : α} {n : ℕ}
+  (hn : 0 < n) (h : ∀ i, f (i % n) = f i) :
+  a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) :=
+begin
+  split,
+  { rintros ⟨i, hi⟩,
+    simp only [mem_image, exists_prop, mem_range],
+    exact ⟨i % n, nat.mod_lt i hn, (rfl.congr hi).mp (h i)⟩ },
+  { rintro h,
+    simp only [mem_image, exists_prop, set.mem_range, mem_range] at *,
+    rcases h with ⟨i, hi, ha⟩,
+    exact ⟨i, ha⟩ }
+end
+
+lemma mem_range_iff_mem_finset_range_of_mod_eq [decidable_eq α] {f : ℤ → α} {a : α} {n : ℕ}
+  (hn : 0 < n) (h : ∀ i, f (i % n) = f i) :
+  a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) :=
+suffices (∃ i, f (i % n) = a) ↔ ∃ i, i < n ∧ f ↑i = a, by simpa [h],
+have hn' : 0 < (n : ℤ), from int.coe_nat_lt.mpr hn,
+iff.intro
+  (assume ⟨i, hi⟩,
+    have 0 ≤ i % ↑n, from int.mod_nonneg _ (ne_of_gt hn'),
+    ⟨int.to_nat (i % n),
+      by rw [←int.coe_nat_lt, int.to_nat_of_nonneg this]; exact ⟨int.mod_lt_of_pos i hn', hi⟩⟩)
+  (assume ⟨i, hi, ha⟩,
+    ⟨i, by rw [int.mod_eq_of_lt (int.coe_zero_le _) (int.coe_nat_lt_coe_nat_of_lt hi), ha]⟩)
+
+lemma range_add (a b : ℕ) : range (a + b) = range a ∪ (range b).map (add_left_embedding a) :=
+by { rw [←val_inj, union_val], exact multiset.range_add_eq_union a b }
+
+@[simp] lemma attach_image_val [decidable_eq α] {s : finset α} : s.attach.image subtype.val = s :=
+eq_of_veq $ by rw [image_val, attach_val, multiset.attach_map_val, dedup_eq_self]
+
+@[simp] lemma attach_image_coe [decidable_eq α] {s : finset α} : s.attach.image coe = s :=
+finset.attach_image_val
+
+@[simp] lemma attach_insert [decidable_eq α] {a : α} {s : finset α} :
+  attach (insert a s) = insert (⟨a, mem_insert_self a s⟩ : {x // x ∈ insert a s})
+    ((attach s).image (λx, ⟨x.1, mem_insert_of_mem x.2⟩)) :=
+ext $ λ ⟨x, hx⟩, ⟨or.cases_on (mem_insert.1 hx)
+  (λ h : x = a, λ _, mem_insert.2 $ or.inl $ subtype.eq h)
+  (λ h : x ∈ s, λ _, mem_insert_of_mem $ mem_image.2 $ ⟨⟨x, h⟩, mem_attach _ _, subtype.eq rfl⟩),
+λ _, finset.mem_attach _ _⟩
+
+theorem map_eq_image (f : α ↪ β) (s : finset α) : s.map f = s.image f :=
+eq_of_veq (s.map f).2.dedup.symm
+
+@[simp] lemma disjoint_image
+  {s t : finset α} {f : α → β} (hf : injective f) :
+  disjoint (s.image f) (t.image f) ↔ disjoint s t :=
+by convert disjoint_map ⟨_, hf⟩; simp [map_eq_image]
+
+lemma image_const {s : finset α} (h : s.nonempty) (b : β) : s.image (λa, b) = singleton b :=
+ext $ assume b', by simp only [mem_image, exists_prop, exists_and_distrib_right,
+  h.bex, true_and, mem_singleton, eq_comm]
+
+@[simp] lemma map_erase [decidable_eq α] (f : α ↪ β) (s : finset α) (a : α) :
+  (s.erase a).map f = (s.map f).erase (f a) :=
+by { simp_rw map_eq_image, exact s.image_erase f.2 a }
+
+theorem image_bUnion [decidable_eq γ] {f : α → β} {s : finset α} {t : β → finset γ} :
+  (s.image f).bUnion t = s.bUnion (λa, t (f a)) :=
+by haveI := classical.dec_eq α; exact
+finset.induction_on s rfl (λ a s has ih,
+  by simp only [image_insert, bUnion_insert, ih])
+
+theorem bUnion_image [decidable_eq γ] {s : finset α} {t : α → finset β} {f : β → γ} :
+  (s.bUnion t).image f = s.bUnion (λa, (t a).image f) :=
+by haveI := classical.dec_eq α; exact
+finset.induction_on s rfl (λ a s has ih,
+  by simp only [bUnion_insert, image_union, ih])
+
+lemma image_bUnion_filter_eq [decidable_eq α] (s : finset β) (g : β → α) :
+  (s.image g).bUnion (λa, s.filter $ (λc, g c = a)) = s :=
+bUnion_filter_eq_of_maps_to (λ x, mem_image_of_mem g)
+
+lemma bUnion_singleton {f : α → β} : s.bUnion (λa, {f a}) = s.image f :=
+ext $ λ x, by simp only [mem_bUnion, mem_image, mem_singleton, eq_comm]
+
+end image
+
+/-! ### Subtype -/
+section subtype
+
+/-- Given a finset `s` and a predicate `p`, `s.subtype p` is the finset of `subtype p` whose
+elements belong to `s`. -/
+protected def subtype {α} (p : α → Prop) [decidable_pred p] (s : finset α) : finset (subtype p) :=
+(s.filter p).attach.map ⟨λ x, ⟨x.1, (finset.mem_filter.1 x.2).2⟩,
+λ x y H, subtype.eq $ subtype.mk.inj H⟩
+
+@[simp] lemma mem_subtype {p : α → Prop} [decidable_pred p] {s : finset α} :
+  ∀ {a : subtype p}, a ∈ s.subtype p ↔ (a : α) ∈ s
+| ⟨a, ha⟩ := by simp [finset.subtype, ha]
+
+lemma subtype_eq_empty {p : α → Prop} [decidable_pred p] {s : finset α} :
+  s.subtype p = ∅ ↔ ∀ x, p x → x ∉ s :=
+by simp [ext_iff, subtype.forall, subtype.coe_mk]; refl
+
+@[mono] lemma subtype_mono {p : α → Prop} [decidable_pred p] : monotone (finset.subtype p) :=
+λ s t h x hx, mem_subtype.2 $ h $ mem_subtype.1 hx
+
+/-- `s.subtype p` converts back to `s.filter p` with
+`embedding.subtype`. -/
+@[simp] lemma subtype_map (p : α → Prop) [decidable_pred p] {s : finset α} :
+  (s.subtype p).map (embedding.subtype _) = s.filter p :=
+begin
+  ext x,
+  simp [and_comm _ (_ = _), @and.left_comm _ (_ = _), and_comm (p x) (x ∈ s)]
+end
+
+/-- If all elements of a `finset` satisfy the predicate `p`,
+`s.subtype p` converts back to `s` with `embedding.subtype`. -/
+lemma subtype_map_of_mem {p : α → Prop} [decidable_pred p] {s : finset α} (h : ∀ x ∈ s, p x) :
+  (s.subtype p).map (embedding.subtype _) = s :=
+by rw [subtype_map, filter_true_of_mem h]
+
+/-- If a `finset` of a subtype is converted to the main type with
+`embedding.subtype`, all elements of the result have the property of
+the subtype. -/
+lemma property_of_mem_map_subtype {p : α → Prop} (s : finset {x // p x}) {a : α}
+  (h : a ∈ s.map (embedding.subtype _)) : p a :=
+begin
+  rcases mem_map.1 h with ⟨x, hx, rfl⟩,
+  exact x.2
+end
+
+/-- If a `finset` of a subtype is converted to the main type with
+`embedding.subtype`, the result does not contain any value that does
+not satisfy the property of the subtype. -/
+lemma not_mem_map_subtype_of_not_property {p : α → Prop} (s : finset {x // p x})
+  {a : α} (h : ¬ p a) : a ∉ (s.map (embedding.subtype _)) :=
+mt s.property_of_mem_map_subtype h
+
+/-- If a `finset` of a subtype is converted to the main type with
+`embedding.subtype`, the result is a subset of the set giving the
+subtype. -/
+lemma map_subtype_subset {t : set α} (s : finset t) : ↑(s.map (embedding.subtype _)) ⊆ t :=
+begin
+  intros a ha,
+  rw mem_coe at ha,
+  convert property_of_mem_map_subtype s ha
+end
+
+end subtype
+
+/-! ### Fin -/
+
+/--
+Given a finset `s` of natural numbers and a bound `n`,
+`s.fin n` is the finset of all elements of `s` less than `n`.
+-/
+protected def fin (n : ℕ) (s : finset ℕ) : finset (fin n) :=
+(s.subtype _).map fin.equiv_subtype.symm.to_embedding
+
+@[simp] lemma mem_fin {n} {s : finset ℕ} :
+  ∀ a : fin n, a ∈ s.fin n ↔ (a : ℕ) ∈ s
+| ⟨a, ha⟩ := by simp [finset.fin]
+
+@[mono] lemma fin_mono {n} : monotone (finset.fin n) :=
+λ s t h x, by simpa using @h x
+
+@[simp] lemma fin_map {n} {s : finset ℕ} : (s.fin n).map fin.coe_embedding = s.filter (< n) :=
+by simp [finset.fin, finset.map_map]
+
+lemma subset_image_iff [decidable_eq β] {s : set α} {t : finset β} {f : α → β}:
+  ↑t ⊆ f '' s ↔ ∃ s' : finset α, ↑s' ⊆ s ∧ s'.image f = t :=
+begin
+  split, swap,
+  { rintro ⟨t, ht, rfl⟩, rw [coe_image], exact set.image_subset f ht },
+  intro h,
+  letI : can_lift β s (f ∘ coe) (λ y, y ∈ f '' s) := ⟨λ y ⟨x, hxt, hy⟩, ⟨⟨x, hxt⟩, hy⟩⟩,
+  lift t to finset s using h,
+  refine ⟨t.map (embedding.subtype _), map_subtype_subset _, _⟩,
+  ext y, simp
+end
+
+lemma range_sdiff_zero {n : ℕ} : range (n + 1) \ {0} = (range n).image nat.succ :=
+begin
+  induction n with k hk,
+  { simp },
+  nth_rewrite 1 range_succ,
+  rw [range_succ, image_insert, ←hk, insert_sdiff_of_not_mem],
+  simp
+end
+
+end finset
+
+lemma _root_.multiset.to_finset_map [decidable_eq α] [decidable_eq β] (f : α → β) (m : multiset α) :
+  (m.map f).to_finset = m.to_finset.image f :=
+finset.val_inj.1 (multiset.dedup_map_dedup_eq _ _).symm
+
+
+namespace equiv
+
+/-- Given an equivalence `α` to `β`, produce an equivalence between `finset α` and `finset β`. -/
+protected def finset_congr (e : α ≃ β) : finset α ≃ finset β :=
+{ to_fun := λ s, s.map e.to_embedding,
+  inv_fun := λ s, s.map e.symm.to_embedding,
+  left_inv := λ s, by simp [finset.map_map],
+  right_inv := λ s, by simp [finset.map_map] }
+
+@[simp] lemma finset_congr_apply (e : α ≃ β) (s : finset α) :
+  e.finset_congr s = s.map e.to_embedding :=
+rfl
+
+@[simp] lemma finset_congr_refl : (equiv.refl α).finset_congr = equiv.refl _ := by { ext, simp }
+@[simp] lemma finset_congr_symm (e : α ≃ β) : e.finset_congr.symm = e.symm.finset_congr := rfl
+
+@[simp] lemma finset_congr_trans (e : α ≃ β) (e' : β ≃ γ) :
+  e.finset_congr.trans (e'.finset_congr) = (e.trans e').finset_congr :=
+by { ext, simp [-finset.mem_map, -equiv.trans_to_embedding] }
+
+lemma finset_congr_to_embedding (e : α ≃ β) :
+  e.finset_congr.to_embedding = (finset.map_embedding e.to_embedding).to_embedding := rfl
+
+end equiv
diff --git a/src/data/finset/locally_finite.lean b/src/data/finset/locally_finite.lean
index beac80359c465..5e12342c85f88 100644
--- a/src/data/finset/locally_finite.lean
+++ b/src/data/finset/locally_finite.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison, Yaël Dillies
 -/
 import order.locally_finite
+import data.set.intervals.monoid
 
 /-!
 # Intervals as finsets
@@ -498,78 +499,65 @@ by { ext, simp [eq_comm] }
 end linear_order
 
 section ordered_cancel_add_comm_monoid
-variables [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] [decidable_eq α]
-  [locally_finite_order α]
+variables [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] [locally_finite_order α]
 
-lemma image_add_left_Icc (a b c : α) : (Icc a b).image ((+) c) = Icc (c + a) (c + b) :=
-begin
-  ext x,
-  rw [mem_image, mem_Icc],
-  split,
-  { rintro ⟨y, hy, rfl⟩,
-    rw mem_Icc at hy,
-    exact ⟨add_le_add_left hy.1 c, add_le_add_left hy.2 c⟩ },
-  { intro hx,
-    obtain ⟨y, hy⟩ := exists_add_of_le hx.1,
-    rw add_assoc at hy,
-    rw hy at hx,
-    exact ⟨a + y, mem_Icc.2 ⟨le_of_add_le_add_left hx.1, le_of_add_le_add_left hx.2⟩, hy.symm⟩ }
-end
+@[simp] lemma map_add_left_Icc (a b c : α) :
+  (Icc a b).map (add_left_embedding c) = Icc (c + a) (c + b) :=
+by { rw [← coe_inj, coe_map, coe_Icc, coe_Icc], exact set.image_const_add_Icc _ _ _ }
 
-lemma image_add_left_Ico (a b c : α) : (Ico a b).image ((+) c) = Ico (c + a) (c + b) :=
-begin
-  ext x,
-  rw [mem_image, mem_Ico],
-  split,
-  { rintro ⟨y, hy, rfl⟩,
-    rw mem_Ico at hy,
-    exact ⟨add_le_add_left hy.1 c, add_lt_add_left hy.2 c⟩ },
-  { intro hx,
-    obtain ⟨y, hy⟩ := exists_add_of_le hx.1,
-    rw add_assoc at hy,
-    rw hy at hx,
-    exact ⟨a + y, mem_Ico.2 ⟨le_of_add_le_add_left hx.1, lt_of_add_lt_add_left hx.2⟩, hy.symm⟩ }
-end
+@[simp] lemma map_add_right_Icc (a b c : α) :
+  (Icc a b).map (add_right_embedding c) = Icc (a + c) (b + c) :=
+by { rw [← coe_inj, coe_map, coe_Icc, coe_Icc], exact set.image_add_const_Icc _ _ _ }
 
-lemma image_add_left_Ioc (a b c : α) : (Ioc a b).image ((+) c) = Ioc (c + a) (c + b) :=
-begin
-  ext x,
-  rw [mem_image, mem_Ioc],
-  refine ⟨_, λ hx, _⟩,
-  { rintro ⟨y, hy, rfl⟩,
-    rw mem_Ioc at hy,
-    exact ⟨add_lt_add_left hy.1 c, add_le_add_left hy.2 c⟩ },
-  { obtain ⟨y, hy⟩ := exists_add_of_le hx.1.le,
-    rw add_assoc at hy,
-    rw hy at hx,
-    exact ⟨a + y, mem_Ioc.2 ⟨lt_of_add_lt_add_left hx.1, le_of_add_le_add_left hx.2⟩, hy.symm⟩ }
-end
+@[simp] lemma map_add_left_Ico (a b c : α) :
+  (Ico a b).map (add_left_embedding c) = Ico (c + a) (c + b) :=
+by { rw [← coe_inj, coe_map, coe_Ico, coe_Ico], exact set.image_const_add_Ico _ _ _ }
 
-lemma image_add_left_Ioo (a b c : α) : (Ioo a b).image ((+) c) = Ioo (c + a) (c + b) :=
-begin
-  ext x,
-  rw [mem_image, mem_Ioo],
-  refine ⟨_, λ hx, _⟩,
-  { rintro ⟨y, hy, rfl⟩,
-    rw mem_Ioo at hy,
-    exact ⟨add_lt_add_left hy.1 c, add_lt_add_left hy.2 c⟩ },
-  { obtain ⟨y, hy⟩ := exists_add_of_le hx.1.le,
-    rw add_assoc at hy,
-    rw hy at hx,
-    exact ⟨a + y, mem_Ioo.2 ⟨lt_of_add_lt_add_left hx.1, lt_of_add_lt_add_left hx.2⟩, hy.symm⟩ }
-end
+@[simp] lemma map_add_right_Ico (a b c : α) :
+  (Ico a b).map (add_right_embedding c) = Ico (a + c) (b + c) :=
+by { rw [← coe_inj, coe_map, coe_Ico, coe_Ico], exact set.image_add_const_Ico _ _ _ }
+
+@[simp] lemma map_add_left_Ioc (a b c : α) :
+  (Ioc a b).map (add_left_embedding c) = Ioc (c + a) (c + b) :=
+by { rw [← coe_inj, coe_map, coe_Ioc, coe_Ioc], exact set.image_const_add_Ioc _ _ _ }
+
+@[simp] lemma map_add_right_Ioc (a b c : α) :
+  (Ioc a b).map (add_right_embedding c) = Ioc (a + c) (b + c) :=
+by { rw [← coe_inj, coe_map, coe_Ioc, coe_Ioc], exact set.image_add_const_Ioc _ _ _ }
+
+@[simp] lemma map_add_left_Ioo (a b c : α) :
+  (Ioo a b).map (add_left_embedding c) = Ioo (c + a) (c + b) :=
+by { rw [← coe_inj, coe_map, coe_Ioo, coe_Ioo], exact set.image_const_add_Ioo _ _ _ }
+
+@[simp] lemma map_add_right_Ioo (a b c : α) :
+  (Ioo a b).map (add_right_embedding c) = Ioo (a + c) (b + c) :=
+by { rw [← coe_inj, coe_map, coe_Ioo, coe_Ioo], exact set.image_add_const_Ioo _ _ _ }
+
+variables [decidable_eq α]
+
+@[simp] lemma image_add_left_Icc (a b c : α) : (Icc a b).image ((+) c) = Icc (c + a) (c + b) :=
+by { rw [← map_add_left_Icc, map_eq_image], refl }
+
+@[simp] lemma image_add_left_Ico (a b c : α) : (Ico a b).image ((+) c) = Ico (c + a) (c + b) :=
+by { rw [← map_add_left_Ico, map_eq_image], refl }
+
+@[simp] lemma image_add_left_Ioc (a b c : α) : (Ioc a b).image ((+) c) = Ioc (c + a) (c + b) :=
+by { rw [← map_add_left_Ioc, map_eq_image], refl }
+
+@[simp] lemma image_add_left_Ioo (a b c : α) : (Ioo a b).image ((+) c) = Ioo (c + a) (c + b) :=
+by { rw [← map_add_left_Ioo, map_eq_image], refl }
 
-lemma image_add_right_Icc (a b c : α) : (Icc a b).image (+ c) = Icc (a + c) (b + c) :=
-by { simp_rw add_comm _ c, exact image_add_left_Icc a b c }
+@[simp] lemma image_add_right_Icc (a b c : α) : (Icc a b).image (+ c) = Icc (a + c) (b + c) :=
+by { rw [← map_add_right_Icc, map_eq_image], refl }
 
 lemma image_add_right_Ico (a b c : α) : (Ico a b).image (+ c) = Ico (a + c) (b + c) :=
-by { simp_rw add_comm _ c, exact image_add_left_Ico a b c }
+by { rw [← map_add_right_Ico, map_eq_image], refl }
 
 lemma image_add_right_Ioc (a b c : α) : (Ioc a b).image (+ c) = Ioc (a + c) (b + c) :=
-by { simp_rw add_comm _ c, exact image_add_left_Ioc a b c }
+by { rw [← map_add_right_Ioc, map_eq_image], refl }
 
 lemma image_add_right_Ioo (a b c : α) : (Ioo a b).image (+ c) = Ioo (a + c) (b + c) :=
-by { simp_rw add_comm _ c, exact image_add_left_Ioo a b c }
+by { rw [← map_add_right_Ioo, map_eq_image], refl }
 
 end ordered_cancel_add_comm_monoid
 
diff --git a/src/data/finset/n_ary.lean b/src/data/finset/n_ary.lean
index f33d4ec74c784..f960ff37feea1 100644
--- a/src/data/finset/n_ary.lean
+++ b/src/data/finset/n_ary.lean
@@ -13,8 +13,8 @@ This file defines `finset.image₂`, the binary image of finsets. This is the fi
 
 ## Notes
 
-This file is very similar to the n-ary section of `data.set.basic`, to `order.filter.n_ary` and to
-`data.option.n_ary`. Please keep them in sync.
+This file is very similar to `data.set.n_ary`, `order.filter.n_ary` and `data.option.n_ary`. Please
+keep them in sync.
 
 We do not define `finset.image₃` as its only purpose would be to prove properties of `finset.image₂`
 and `set.image2` already fulfills this task.
diff --git a/src/data/finset/pi.lean b/src/data/finset/pi.lean
index 84c7a174884e3..aad4696c2c647 100644
--- a/src/data/finset/pi.lean
+++ b/src/data/finset/pi.lean
@@ -3,7 +3,7 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
-import data.finset.basic
+import data.finset.image
 import data.multiset.pi
 
 /-!
diff --git a/src/data/finset/pointwise.lean b/src/data/finset/pointwise.lean
index c9990d6a98ac5..39742d7c1d47d 100644
--- a/src/data/finset/pointwise.lean
+++ b/src/data/finset/pointwise.lean
@@ -5,7 +5,7 @@ Authors: Floris van Doorn, Yaël Dillies
 -/
 import data.finset.n_ary
 import data.finset.preimage
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 
 /-!
 # Pointwise operations of finsets
diff --git a/src/data/finset/powerset.lean b/src/data/finset/powerset.lean
index fc7401ccb03fc..f200fb029a76b 100644
--- a/src/data/finset/powerset.lean
+++ b/src/data/finset/powerset.lean
@@ -222,17 +222,28 @@ begin
     simp }
 end
 
-lemma powerset_card_bUnion [decidable_eq (finset α)] (s : finset α) :
-  finset.powerset s = (range (s.card + 1)).bUnion (λ i, powerset_len i s) :=
+lemma pairwise_disjoint_powerset_len (s : finset α) :
+  _root_.pairwise (λ i j, disjoint (s.powerset_len i) (s.powerset_len j)) :=
+λ i j hij, finset.disjoint_left.mpr $ λ x hi hj, hij $
+  (mem_powerset_len.mp hi).2.symm.trans (mem_powerset_len.mp hj).2
+
+lemma powerset_card_disj_Union (s : finset α) :
+  finset.powerset s =
+    (range (s.card + 1)).disj_Union (λ i, powerset_len i s)
+      (s.pairwise_disjoint_powerset_len.set_pairwise _) :=
 begin
   refine ext (λ a, ⟨λ ha, _, λ ha, _ ⟩),
-  { rw mem_bUnion,
+  { rw mem_disj_Union,
     exact ⟨a.card, mem_range.mpr (nat.lt_succ_of_le (card_le_of_subset (mem_powerset.mp ha))),
       mem_powerset_len.mpr ⟨mem_powerset.mp ha, rfl⟩⟩ },
-  { rcases mem_bUnion.mp ha with ⟨i, hi, ha⟩,
+  { rcases mem_disj_Union.mp ha with ⟨i, hi, ha⟩,
     exact mem_powerset.mpr (mem_powerset_len.mp ha).1, }
 end
 
+lemma powerset_card_bUnion [decidable_eq (finset α)] (s : finset α) :
+  finset.powerset s = (range (s.card + 1)).bUnion (λ i, powerset_len i s) :=
+by simpa only [disj_Union_eq_bUnion] using powerset_card_disj_Union s
+
 lemma powerset_len_sup [decidable_eq α] (u : finset α) (n : ℕ) (hn : n < u.card) :
   (powerset_len n.succ u).sup id = u :=
 begin
diff --git a/src/data/finset/sigma.lean b/src/data/finset/sigma.lean
index 6b24cf5fc1a91..6be4714fa13d1 100644
--- a/src/data/finset/sigma.lean
+++ b/src/data/finset/sigma.lean
@@ -53,6 +53,21 @@ by simp only [← not_nonempty_iff_eq_empty, sigma_nonempty, not_exists]
 @[mono] lemma sigma_mono (hs : s₁ ⊆ s₂) (ht : ∀ i, t₁ i ⊆ t₂ i) : s₁.sigma t₁ ⊆ s₂.sigma t₂ :=
 λ ⟨i, a⟩ h, let ⟨hi, ha⟩ := mem_sigma.1 h in mem_sigma.2 ⟨hs hi, ht i ha⟩
 
+lemma pairwise_disjoint_map_sigma_mk :
+  (s : set ι).pairwise_disjoint (λ i, (t i).map (embedding.sigma_mk i)) :=
+begin
+  intros i hi j hj hij,
+  rw [function.on_fun, disjoint_left],
+  simp_rw [mem_map, function.embedding.sigma_mk_apply],
+  rintros _ ⟨y, hy, rfl⟩ ⟨z, hz, hz'⟩,
+  exact hij (congr_arg sigma.fst hz'.symm)
+end
+
+@[simp]
+lemma disj_Union_map_sigma_mk :
+  s.disj_Union (λ i, (t i).map (embedding.sigma_mk i))
+    pairwise_disjoint_map_sigma_mk = s.sigma t := rfl
+
 lemma sigma_eq_bUnion [decidable_eq (Σ i, α i)] (s : finset ι) (t : Π i, finset (α i)) :
   s.sigma t = s.bUnion (λ i, (t i).map $ embedding.sigma_mk i) :=
 by { ext ⟨x, y⟩, simp [and.left_comm] }
diff --git a/src/data/fintype/basic.lean b/src/data/fintype/basic.lean
index 4a7a19d7188f5..ab0c192c6ade2 100644
--- a/src/data/fintype/basic.lean
+++ b/src/data/fintype/basic.lean
@@ -3,7 +3,7 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
-import data.finset.basic
+import data.finset.image
 
 /-!
 # Finite types
diff --git a/src/data/fintype/card.lean b/src/data/fintype/card.lean
index 81345e7f233c9..66f2c9edb8a8a 100644
--- a/src/data/fintype/card.lean
+++ b/src/data/fintype/card.lean
@@ -35,6 +35,11 @@ Some more pigeonhole-like statements can be found in `data.fintype.card_embeddin
 Types which have an injection from/a surjection to an `infinite` type are themselves `infinite`.
 See `infinite.of_injective` and `infinite.of_surjective`.
 
+## Instances
+
+We provide `infinite` instances for
+* specific types: `ℕ`, `ℤ`
+* type constructors: `multiset α`, `list α`
 
 -/
 
@@ -808,8 +813,21 @@ lemma of_surjective {α β} [infinite β] (f : α → β) (hf : surjective f) :
 
 end infinite
 
+instance : infinite ℕ :=
+infinite.of_not_fintype $ by { introI h,
+  exact (finset.range _).card_le_univ.not_lt ((nat.lt_succ_self _).trans_eq (card_range _).symm) }
+
+instance : infinite ℤ :=
+infinite.of_injective int.of_nat (λ _ _, int.of_nat.inj)
+
+instance [nonempty α] : infinite (multiset α) :=
+let ⟨x⟩ := ‹nonempty α› in infinite.of_injective (multiset.repeat x) (multiset.repeat_injective _)
+
+instance [nonempty α] : infinite (list α) :=
+infinite.of_surjective (coe : list α → multiset α) (surjective_quot_mk _)
+
 instance infinite.set [infinite α] : infinite (set α) :=
-infinite.of_injective singleton (λ a b, set.singleton_eq_singleton_iff.1)
+infinite.of_injective singleton set.singleton_injective
 
 instance [infinite α] : infinite (finset α) :=
 infinite.of_injective singleton finset.singleton_injective
@@ -829,7 +847,6 @@ infinite.of_surjective prod.snd prod.snd_surjective
 instance prod.infinite_of_left [infinite α] [nonempty β] : infinite (α × β) :=
 infinite.of_surjective prod.fst prod.fst_surjective
 
-
 namespace infinite
 
 private noncomputable def nat_embedding_aux (α : Type*) [infinite α] : ℕ → α
diff --git a/src/data/fintype/lattice.lean b/src/data/fintype/lattice.lean
index 0602a1bd7b736..05e0c778330cf 100644
--- a/src/data/fintype/lattice.lean
+++ b/src/data/fintype/lattice.lean
@@ -8,13 +8,6 @@ import data.finset.lattice
 
 /-!
 # Lemmas relating fintypes and order/lattice structure.
-
-## Instances
-
-We provide `infinite` instances for
-* specific types: `ℕ`, `ℤ`
-* type constructors: `multiset α`, `list α`
-
 -/
 
 open function
@@ -55,23 +48,3 @@ by { casesI nonempty_fintype α, simpa using exists_max_image univ f univ_nonemp
 lemma finite.exists_min [finite α] [nonempty α] [linear_order β] (f : α → β) :
   ∃ x₀ : α, ∀ x, f x₀ ≤ f x :=
 by { casesI nonempty_fintype α, simpa using exists_min_image univ f univ_nonempty }
-
-section
-open_locale classical
-
-instance : infinite ℕ :=
-infinite.of_not_fintype $ λ ⟨s, hs⟩, finset.not_mem_range_self $ s.subset_range_sup_succ (hs _)
-
-instance : infinite ℤ :=
-infinite.of_injective int.of_nat (λ _ _, int.of_nat.inj)
-
-instance [nonempty α] : infinite (multiset α) :=
-begin
-  inhabit α,
-  exact infinite.of_injective (multiset.repeat default) (multiset.repeat_injective _),
-end
-
-instance [nonempty α] : infinite (list α) :=
-infinite.of_surjective (coe : list α → multiset α) (surjective_quot_mk _)
-
-end
diff --git a/src/data/int/log.lean b/src/data/int/log.lean
index 2db29221f739c..9beea3d18ed73 100644
--- a/src/data/int/log.lean
+++ b/src/data/int/log.lean
@@ -92,13 +92,10 @@ lemma zpow_log_le_self {b : ℕ} {r : R} (hb : 1 < b) (hr : 0 < r) :
 begin
   cases le_total 1 r with hr1 hr1,
   { rw log_of_one_le_right _ hr1,
-    refine le_trans _ (nat.floor_le hr.le),
-    rw [zpow_coe_nat, ←nat.cast_pow, nat.cast_le],
-    exact nat.pow_log_le_self hb (nat.floor_pos.mpr hr1) },
+    rw [zpow_coe_nat, ← nat.cast_pow, ← nat.le_floor_iff hr.le],
+    exact nat.pow_log_le_self b (nat.floor_pos.mpr hr1).ne' },
   { rw [log_of_right_le_one _ hr1, zpow_neg, zpow_coe_nat, ← nat.cast_pow],
-    apply inv_le_of_inv_le hr,
-    refine (nat.le_ceil _).trans (nat.cast_le.2 _),
-    exact nat.le_pow_clog hb _ },
+    exact inv_le_of_inv_le hr (nat.ceil_le.1 $ nat.le_pow_clog hb _) },
 end
 
 lemma lt_zpow_succ_log_self {b : ℕ} (hb : 1 < b) (r : R) :
diff --git a/src/data/int/range.lean b/src/data/int/range.lean
index e0b60dd231060..2bc2fa5cc67fa 100644
--- a/src/data/int/range.lean
+++ b/src/data/int/range.lean
@@ -19,15 +19,13 @@ This could be unified with `data.list.intervals`. See the TODOs there.
 
 namespace int
 
-local attribute [semireducible] int.nonneg
-
 /-- List enumerating `[m, n)`. This is the ℤ variant of `list.Ico`. -/
 def range (m n : ℤ) : list ℤ :=
 (list.range (to_nat (n-m))).map $ λ r, m+r
 
 theorem mem_range_iff {m n r : ℤ} : r ∈ range m n ↔ m ≤ r ∧ r < n :=
 ⟨λ H, let ⟨s, h1, h2⟩ := list.mem_map.1 H in h2 ▸
-  ⟨le_add_of_nonneg_right trivial,
+  ⟨le_add_of_nonneg_right (coe_zero_le s),
   add_lt_of_lt_sub_left $ match n-m, h1 with
     | (k:ℕ), h1 := by rwa [list.mem_range, to_nat_coe_nat, ← coe_nat_lt] at h1
     end⟩,
diff --git a/src/data/list/defs.lean b/src/data/list/defs.lean
index cd55b14e59892..bb582f4881f88 100644
--- a/src/data/list/defs.lean
+++ b/src/data/list/defs.lean
@@ -10,6 +10,10 @@ import data.rbtree.default_lt
 /-!
 ## Definitions on lists
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/803
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains various definitions on lists. It does not contain
 proofs about these definitions, those are contained in other files in `data/list`
 -/
diff --git a/src/data/list/range.lean b/src/data/list/range.lean
index db50721f434e1..2f48e9c6f5e2f 100644
--- a/src/data/list/range.lean
+++ b/src/data/list/range.lean
@@ -301,8 +301,21 @@ theorem of_fn_eq_map {α n} {f : fin n → α} :
   of_fn f = (fin_range n).map f :=
 by rw [← of_fn_id, map_of_fn, function.right_id]
 
-theorem nodup_of_fn {α n} {f : fin n → α} (hf : function.injective f) :
+theorem nodup_of_fn_of_injective {α n} {f : fin n → α} (hf : function.injective f) :
   nodup (of_fn f) :=
 by { rw of_fn_eq_pmap, exact (nodup_range n).pmap (λ _ _ _ _ H, fin.veq_of_eq $ hf H) }
 
+theorem nodup_of_fn {α n} {f : fin n → α} :
+  nodup (of_fn f) ↔ function.injective f :=
+begin
+  refine ⟨_, nodup_of_fn_of_injective⟩,
+  refine fin.cons_induction _ (λ n x₀ xs ih, _) f,
+  { intro h,
+    exact function.injective_of_subsingleton _ },
+  { intro h,
+    rw fin.cons_injective_iff,
+    simp_rw [of_fn_succ, fin.cons_succ, nodup_cons, fin.cons_zero, mem_of_fn] at h,
+    exact h.imp_right ih }
+end
+
 end list
diff --git a/src/data/matrix/basic.lean b/src/data/matrix/basic.lean
index e75a25426f29e..a8a613b1e9c1a 100644
--- a/src/data/matrix/basic.lean
+++ b/src/data/matrix/basic.lean
@@ -4,12 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Ellen Arlt, Blair Shi, Sean Leather, Mario Carneiro, Johan Commelin, Lu-Ming Zhang
 -/
 
-import algebra.algebra.basic
+import algebra.algebra.pi
 import algebra.big_operators.pi
 import algebra.big_operators.ring
 import algebra.big_operators.ring_equiv
 import algebra.module.linear_map
 import algebra.module.pi
+import algebra.star.big_operators
 import algebra.star.module
 import algebra.star.pi
 import data.fintype.big_operators
diff --git a/src/data/multiset/powerset.lean b/src/data/multiset/powerset.lean
index e9c3468620256..f5ce620045db5 100644
--- a/src/data/multiset/powerset.lean
+++ b/src/data/multiset/powerset.lean
@@ -256,9 +256,9 @@ begin
   { cases n; simp [ih, map_comp_cons], },
 end
 
-lemma disjoint_powerset_len (s : multiset α) {i j : ℕ} (h : i ≠ j) :
-  multiset.disjoint (s.powerset_len i) (s.powerset_len j) :=
-λ x hi hj, h (eq.trans (multiset.mem_powerset_len.mp hi).right.symm
+lemma pairwise_disjoint_powerset_len (s : multiset α) :
+  _root_.pairwise (λ i j, multiset.disjoint (s.powerset_len i) (s.powerset_len j)) :=
+λ i j h x hi hj, h (eq.trans (multiset.mem_powerset_len.mp hi).right.symm
   (multiset.mem_powerset_len.mp hj).right)
 
 lemma bind_powerset_len {α : Type*} (S : multiset α) :
diff --git a/src/data/nat/choose/factorization.lean b/src/data/nat/choose/factorization.lean
index f856c8de6eb62..23075edf1b6e7 100644
--- a/src/data/nat/choose/factorization.lean
+++ b/src/data/nat/choose/factorization.lean
@@ -49,11 +49,7 @@ end
 A `pow` form of `nat.factorization_choose_le`
 -/
 lemma pow_factorization_choose_le (hn : 0 < n) : p ^ (choose n k).factorization p ≤ n :=
-begin
-  cases le_or_lt p 1,
-  { exact (pow_le_pow_of_le_left' h _).trans ((le_of_eq (one_pow _)).trans hn) },
-  { exact (pow_le_iff_le_log h hn).mpr factorization_choose_le_log },
-end
+pow_le_of_le_log hn.ne' factorization_choose_le_log
 
 /--
 Primes greater than about `sqrt n` appear only to multiplicity 0 or 1 in the binomial coefficient.
@@ -61,10 +57,8 @@ Primes greater than about `sqrt n` appear only to multiplicity 0 or 1 in the bin
 lemma factorization_choose_le_one (p_large : n < p ^ 2) : (choose n k).factorization p ≤ 1 :=
 begin
   apply factorization_choose_le_log.trans,
-  rcases n.eq_zero_or_pos with rfl | hn0, { simp },
-  refine lt_succ_iff.1 ((lt_pow_iff_log_lt _ hn0).1 p_large),
-  contrapose! hn0,
-  exact lt_succ_iff.1 (lt_of_lt_of_le p_large (pow_le_one' hn0 2)),
+  rcases eq_or_ne n 0 with rfl | hn0, { simp },
+  exact lt_succ_iff.1 (log_lt_of_lt_pow hn0 p_large),
 end
 
 lemma factorization_choose_of_lt_three_mul
diff --git a/src/data/nat/factorization/basic.lean b/src/data/nat/factorization/basic.lean
index ca5f59e2c4e80..6c4a33df60166 100644
--- a/src/data/nat/factorization/basic.lean
+++ b/src/data/nat/factorization/basic.lean
@@ -5,7 +5,7 @@ Authors: Stuart Presnell
 -/
 import algebra.big_operators.finsupp
 import data.finsupp.multiset
-import data.nat.prime
+import data.nat.prime_fin
 import number_theory.padics.padic_val
 import data.nat.interval
 import tactic.interval_cases
diff --git a/src/data/nat/factors.lean b/src/data/nat/factors.lean
new file mode 100644
index 0000000000000..b06dac80eaf84
--- /dev/null
+++ b/src/data/nat/factors.lean
@@ -0,0 +1,286 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro
+-/
+import data.nat.prime
+import data.list.prime
+import data.list.sort
+import tactic.nth_rewrite
+
+/-!
+# Prime numbers
+
+This file deals with the factors of natural numbers.
+
+## Important declarations
+
+- `nat.factors n`: the prime factorization of `n`
+- `nat.factors_unique`: uniqueness of the prime factorisation
+
+-/
+
+open bool subtype
+open_locale nat
+
+namespace nat
+
+/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/
+def factors : ℕ → list ℕ
+| 0 := []
+| 1 := []
+| n@(k+2) :=
+  let m := min_fac n in have n / m < n := factors_lemma,
+  m :: factors (n / m)
+
+@[simp] lemma factors_zero : factors 0 = [] := by rw factors
+@[simp] lemma factors_one : factors 1 = [] := by rw factors
+
+lemma prime_of_mem_factors : ∀ {n p}, p ∈ factors n → prime p
+| 0       := by simp
+| 1       := by simp
+| n@(k+2) := λ p h,
+  let m := min_fac n in have n / m < n := factors_lemma,
+  have h₁ : p = m ∨ p ∈ (factors (n / m)) :=
+    (list.mem_cons_iff _ _ _).1 (by rwa [factors] at h),
+  or.cases_on h₁ (λ h₂, h₂.symm ▸ min_fac_prime dec_trivial)
+    prime_of_mem_factors
+
+lemma pos_of_mem_factors {n p : ℕ} (h : p ∈ factors n) : 0 < p :=
+prime.pos (prime_of_mem_factors h)
+
+lemma prod_factors : ∀ {n}, n ≠ 0 → list.prod (factors n) = n
+| 0       := by simp
+| 1       := by simp
+| n@(k+2) := λ h,
+  let m := min_fac n in have n / m < n := factors_lemma,
+  show (factors n).prod = n, from
+  have h₁ : n / m ≠ 0 := λ h,
+    have n = 0 * m := (nat.div_eq_iff_eq_mul_left (min_fac_pos _) (min_fac_dvd _)).1 h,
+    by rw zero_mul at this; exact (show k + 2 ≠ 0, from dec_trivial) this,
+  by rw [factors, list.prod_cons, prod_factors h₁, nat.mul_div_cancel' (min_fac_dvd _)]
+
+lemma factors_prime {p : ℕ} (hp : nat.prime p) : p.factors = [p] :=
+begin
+  have : p = (p - 2) + 2 := (tsub_eq_iff_eq_add_of_le hp.two_le).mp rfl,
+  rw [this, nat.factors],
+  simp only [eq.symm this],
+  have : nat.min_fac p = p := (nat.prime_def_min_fac.mp hp).2,
+  split,
+  { exact this, },
+  { simp only [this, nat.factors, nat.div_self (nat.prime.pos hp)], },
+end
+
+lemma factors_chain : ∀ {n a}, (∀ p, prime p → p ∣ n → a ≤ p) → list.chain (≤) a (factors n)
+| 0       := λ a h, by simp
+| 1       := λ a h, by simp
+| n@(k+2) := λ a h,
+  let m := min_fac n in have n / m < n := factors_lemma,
+  begin
+    rw factors,
+    refine list.chain.cons ((le_min_fac.2 h).resolve_left dec_trivial) (factors_chain _),
+    exact λ p pp d, min_fac_le_of_dvd pp.two_le (d.trans $ div_dvd_of_dvd $ min_fac_dvd _),
+  end
+
+lemma factors_chain_2 (n) : list.chain (≤) 2 (factors n) := factors_chain $ λ p pp _, pp.two_le
+
+lemma factors_chain' (n) : list.chain' (≤) (factors n) :=
+@list.chain'.tail _ _ (_::_) (factors_chain_2 _)
+
+lemma factors_sorted (n : ℕ) : list.sorted (≤) (factors n) :=
+list.chain'_iff_pairwise.1 (factors_chain' _)
+
+/-- `factors` can be constructed inductively by extracting `min_fac`, for sufficiently large `n`. -/
+lemma factors_add_two (n : ℕ) :
+  factors (n+2) = min_fac (n+2) :: factors ((n+2) / min_fac (n+2)) :=
+by rw factors
+
+@[simp]
+lemma factors_eq_nil (n : ℕ) : n.factors = [] ↔ n = 0 ∨ n = 1 :=
+begin
+  split; intro h,
+  { rcases n with (_ | _ | n),
+    { exact or.inl rfl },
+    { exact or.inr rfl },
+    { rw factors at h, injection h }, },
+  { rcases h with (rfl | rfl),
+    { exact factors_zero },
+    { exact factors_one }, }
+end
+
+lemma eq_of_perm_factors {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) (h : a.factors ~ b.factors) : a = b :=
+by simpa [prod_factors ha, prod_factors hb] using list.perm.prod_eq h
+
+section
+open list
+
+lemma mem_factors_iff_dvd {n p : ℕ} (hn : n ≠ 0) (hp : prime p) : p ∈ factors n ↔ p ∣ n :=
+⟨λ h, prod_factors hn ▸ list.dvd_prod h,
+  λ h, mem_list_primes_of_dvd_prod
+    (prime_iff.mp hp)
+    (λ p h, prime_iff.mp (prime_of_mem_factors h))
+    ((prod_factors hn).symm ▸ h)⟩
+
+lemma dvd_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ∣ n :=
+begin
+  rcases n.eq_zero_or_pos with rfl | hn,
+  { exact dvd_zero p },
+  { rwa ←mem_factors_iff_dvd hn.ne' (prime_of_mem_factors h) }
+end
+
+lemma mem_factors {n p} (hn : n ≠ 0) : p ∈ factors n ↔ prime p ∧ p ∣ n :=
+⟨λ h, ⟨prime_of_mem_factors h, dvd_of_mem_factors h⟩,
+ λ ⟨hprime, hdvd⟩, (mem_factors_iff_dvd hn hprime).mpr hdvd⟩
+
+lemma le_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ≤ n :=
+begin
+  rcases n.eq_zero_or_pos with rfl | hn,
+  { rw factors_zero at h, cases h },
+  { exact le_of_dvd hn (dvd_of_mem_factors h) },
+end
+
+/-- **Fundamental theorem of arithmetic**-/
+lemma factors_unique {n : ℕ} {l : list ℕ} (h₁ : prod l = n) (h₂ : ∀ p ∈ l, prime p) :
+  l ~ factors n :=
+begin
+  refine perm_of_prod_eq_prod _ _ _,
+  { rw h₁,
+    refine (prod_factors _).symm,
+    rintro rfl,
+    rw prod_eq_zero_iff at h₁,
+    exact prime.ne_zero (h₂ 0 h₁) rfl },
+  { simp_rw ←prime_iff, exact h₂ },
+  { simp_rw ←prime_iff, exact (λ p, prime_of_mem_factors) },
+end
+
+lemma prime.factors_pow {p : ℕ} (hp : p.prime) (n : ℕ) :
+  (p ^ n).factors = list.repeat p n :=
+begin
+  symmetry,
+  rw ← list.repeat_perm,
+  apply nat.factors_unique (list.prod_repeat p n),
+  intros q hq,
+  rwa eq_of_mem_repeat hq,
+end
+
+lemma eq_prime_pow_of_unique_prime_dvd {n p : ℕ} (hpos : n ≠ 0)
+  (h : ∀ {d}, nat.prime d → d ∣ n → d = p) :
+  n = p ^ n.factors.length :=
+begin
+  set k := n.factors.length,
+  rw [←prod_factors hpos, ←prod_repeat p k,
+    eq_repeat_of_mem (λ d hd, h (prime_of_mem_factors hd) (dvd_of_mem_factors hd))],
+end
+
+/-- For positive `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
+lemma perm_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
+  (a * b).factors ~ a.factors ++ b.factors :=
+begin
+  refine (factors_unique _ _).symm,
+  { rw [list.prod_append, prod_factors ha, prod_factors hb] },
+  { intros p hp,
+    rw list.mem_append at hp,
+    cases hp;
+    exact prime_of_mem_factors hp },
+end
+
+/-- For coprime `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
+lemma perm_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) :
+  (a * b).factors ~ a.factors ++ b.factors :=
+begin
+  rcases a.eq_zero_or_pos with rfl | ha,
+  { simp [(coprime_zero_left _).mp hab] },
+  rcases b.eq_zero_or_pos with rfl | hb,
+  { simp [(coprime_zero_right _).mp hab] },
+  exact perm_factors_mul ha.ne' hb.ne',
+end
+
+lemma factors_sublist_right {n k : ℕ} (h : k ≠ 0) : n.factors <+ (n * k).factors :=
+begin
+  cases n,
+  { rw zero_mul },
+  apply sublist_of_subperm_of_sorted _ (factors_sorted _) (factors_sorted _),
+  rw (perm_factors_mul n.succ_ne_zero h).subperm_left,
+  exact (sublist_append_left _ _).subperm,
+end
+
+lemma factors_sublist_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors <+ k.factors :=
+begin
+  obtain ⟨a, rfl⟩ := h,
+  exact factors_sublist_right (right_ne_zero_of_mul h'),
+end
+
+lemma factors_subset_right {n k : ℕ} (h : k ≠ 0) : n.factors ⊆ (n * k).factors :=
+(factors_sublist_right h).subset
+
+lemma factors_subset_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors ⊆ k.factors :=
+(factors_sublist_of_dvd h h').subset
+
+lemma dvd_of_factors_subperm {a b : ℕ} (ha : a ≠ 0) (h : a.factors <+~ b.factors) : a ∣ b :=
+begin
+  rcases b.eq_zero_or_pos with rfl | hb,
+  { exact dvd_zero _ },
+  rcases a with (_|_|a),
+  { exact (ha rfl).elim },
+  { exact one_dvd _ },
+  use (b.factors.diff a.succ.succ.factors).prod,
+  nth_rewrite 0 ←nat.prod_factors ha,
+  rw [←list.prod_append,
+      list.perm.prod_eq $ list.subperm_append_diff_self_of_count_le $ list.subperm_ext_iff.mp h,
+      nat.prod_factors hb.ne']
+end
+
+end
+
+lemma mem_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) {p : ℕ} :
+  p ∈ (a * b).factors ↔ p ∈ a.factors ∨ p ∈ b.factors :=
+begin
+  rw [mem_factors (mul_ne_zero ha hb), mem_factors ha, mem_factors hb, ←and_or_distrib_left],
+  simpa only [and.congr_right_iff] using prime.dvd_mul
+end
+
+/-- The sets of factors of coprime `a` and `b` are disjoint -/
+lemma coprime_factors_disjoint {a b : ℕ} (hab : a.coprime b) : list.disjoint a.factors b.factors :=
+begin
+  intros q hqa hqb,
+  apply not_prime_one,
+  rw ←(eq_one_of_dvd_coprimes hab (dvd_of_mem_factors hqa) (dvd_of_mem_factors hqb)),
+  exact prime_of_mem_factors hqa
+end
+
+lemma mem_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) (p : ℕ):
+  p ∈ (a * b).factors ↔ p ∈ a.factors ∪ b.factors :=
+begin
+  rcases a.eq_zero_or_pos with rfl | ha,
+  { simp [(coprime_zero_left _).mp hab] },
+  rcases b.eq_zero_or_pos with rfl | hb,
+  { simp [(coprime_zero_right _).mp hab] },
+  rw [mem_factors_mul ha.ne' hb.ne', list.mem_union]
+end
+
+open list
+
+/-- If `p` is a prime factor of `a` then `p` is also a prime factor of `a * b` for any `b > 0` -/
+lemma mem_factors_mul_left {p a b : ℕ} (hpa : p ∈ a.factors) (hb : b ≠ 0) : p ∈ (a*b).factors :=
+begin
+  rcases eq_or_ne a 0 with rfl | ha,
+  { simpa using hpa },
+  apply (mem_factors_mul ha hb).2 (or.inl hpa),
+end
+
+/-- If `p` is a prime factor of `b` then `p` is also a prime factor of `a * b` for any `a > 0` -/
+lemma mem_factors_mul_right {p a b : ℕ} (hpb : p ∈ b.factors) (ha : a ≠ 0) : p ∈ (a*b).factors :=
+by { rw mul_comm, exact mem_factors_mul_left hpb ha }
+
+lemma eq_two_pow_or_exists_odd_prime_and_dvd (n : ℕ) :
+  (∃ k : ℕ, n = 2 ^ k) ∨ ∃ p, nat.prime p ∧ p ∣ n ∧ odd p :=
+(eq_or_ne n 0).elim
+  (λ hn, (or.inr ⟨3, prime_three, hn.symm ▸ dvd_zero 3, ⟨1, rfl⟩⟩))
+  (λ hn, or_iff_not_imp_right.mpr
+    (λ H, ⟨n.factors.length, eq_prime_pow_of_unique_prime_dvd hn
+      (λ p hprime hdvd, hprime.eq_two_or_odd'.resolve_right
+        (λ hodd, H ⟨p, hprime, hdvd, hodd⟩))⟩))
+
+end nat
+
+assert_not_exists multiset
diff --git a/src/data/nat/lattice.lean b/src/data/nat/lattice.lean
index 2a94c2d21397d..ff6bbe04e750d 100644
--- a/src/data/nat/lattice.lean
+++ b/src/data/nat/lattice.lean
@@ -41,8 +41,7 @@ begin
   cases eq_empty_or_nonempty s,
   { subst h, simp only [or_true, eq_self_iff_true, iff_true, Inf, has_Inf.Inf,
       mem_empty_iff_false, exists_false, dif_neg, not_false_iff] },
-  { have := ne_empty_iff_nonempty.mpr h,
-    simp only [this, or_false, nat.Inf_def, h, nat.find_eq_zero] }
+  { simp only [h.ne_empty, or_false, nat.Inf_def, h, nat.find_eq_zero] }
 end
 
 @[simp] lemma Inf_empty : Inf ∅ = 0 :=
diff --git a/src/data/nat/log.lean b/src/data/nat/log.lean
index 654dddd1c3b06..b0b69c3f9e0c9 100644
--- a/src/data/nat/log.lean
+++ b/src/data/nat/log.lean
@@ -31,170 +31,157 @@ such that `b^k ≤ n`, so if `b^k = n`, it returns exactly `k`. -/
     log (n / b) + 1
   else 0
 
-private lemma log_eq_zero_aux {b n : ℕ} (hnb : n < b ∨ b ≤ 1) : log b n = 0 :=
+@[simp] lemma log_eq_zero_iff {b n : ℕ} : log b n = 0 ↔ n < b ∨ b ≤ 1 :=
 begin
-  rw [or_iff_not_and_not, not_lt, not_le] at hnb,
-  rw [log, ←ite_not, if_pos hnb]
+  rw [log, ite_eq_right_iff],
+  simp only [nat.succ_ne_zero, imp_false, decidable.not_and_distrib, not_le, not_lt]
 end
 
 lemma log_of_lt {b n : ℕ} (hb : n < b) : log b n = 0 :=
-log_eq_zero_aux (or.inl hb)
+log_eq_zero_iff.2 (or.inl hb)
 
 lemma log_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n) : log b n = 0 :=
-log_eq_zero_aux (or.inr hb)
+log_eq_zero_iff.2 (or.inr hb)
 
-lemma log_of_one_lt_of_le {b n : ℕ} (h : 1 < b) (hn : b ≤ n) : log b n = log b (n / b) + 1 :=
-by { rw log, exact if_pos ⟨hn, h⟩ }
-
-lemma log_eq_zero_iff {b n : ℕ} : log b n = 0 ↔ n < b ∨ b ≤ 1 :=
-⟨λ h_log, begin
-  by_contra' h,
-  have := log_of_one_lt_of_le h.2 h.1,
-  rw h_log at this,
-  exact succ_ne_zero _ this.symm
-end, log_eq_zero_aux⟩
+@[simp] lemma log_pos_iff {b n : ℕ} : 0 < log b n ↔ b ≤ n ∧ 1 < b :=
+by rw [pos_iff_ne_zero, ne.def, log_eq_zero_iff, not_or_distrib, not_lt, not_le]
 
-lemma log_eq_one_iff {b n : ℕ} : log b n = 1 ↔ n < b * b ∧ 1 < b ∧ b ≤ n :=
--- This is best possible: if b = 2, n = 5, then 1 < b and b ≤ n but n > b * b.
-begin
-  refine ⟨λ h_log, _, _⟩,
-  { have bound : 1 < b ∧ b ≤ n,
-    { contrapose h_log,
-      rw [not_and_distrib, not_lt, not_le, or_comm, ←log_eq_zero_iff] at h_log,
-      rw h_log,
-      exact nat.zero_ne_one, },
-    cases bound with one_lt_b b_le_n,
-    refine ⟨_, one_lt_b, b_le_n⟩,
-    rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj',
-        log_eq_zero_iff, nat.div_lt_iff_lt_mul (lt_trans zero_lt_one one_lt_b)] at h_log,
-    exact h_log.resolve_right (λ b_small, lt_irrefl _ (lt_of_lt_of_le one_lt_b b_small)), },
-  { rintros ⟨h, one_lt_b, b_le_n⟩,
-    rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj',
-        log_eq_zero_iff, nat.div_lt_iff_lt_mul (lt_trans zero_lt_one one_lt_b)],
-    exact or.inl h, },
-end
+lemma log_pos {b n : ℕ} (hb : 1 < b) (hbn : b ≤ n) : 0 < log b n := log_pos_iff.2 ⟨hbn, hb⟩
 
-@[simp] lemma log_zero_left : ∀ n, log 0 n = 0 :=
-log_of_left_le_one zero_le_one
-
-@[simp] lemma log_zero_right (b : ℕ) : log b 0 = 0 :=
-by { rw log, cases b; refl }
-
-@[simp] lemma log_one_left : ∀ n, log 1 n = 0 :=
-log_of_left_le_one le_rfl
+lemma log_of_one_lt_of_le {b n : ℕ} (h : 1 < b) (hn : b ≤ n) : log b n = log b (n / b) + 1 :=
+by { rw log, exact if_pos ⟨hn, h⟩ }
 
-@[simp] lemma log_one_right (b : ℕ) : log b 1 = 0 :=
-if h : b ≤ 1 then
-  log_of_left_le_one h 1
-else
-  log_of_lt (not_le.mp h)
+@[simp] lemma log_zero_left : ∀ n, log 0 n = 0 := log_of_left_le_one zero_le_one
+@[simp] lemma log_zero_right (b : ℕ) : log b 0 = 0 := log_eq_zero_iff.2 (le_total 1 b)
+@[simp] lemma log_one_left : ∀ n, log 1 n = 0 := log_of_left_le_one le_rfl
+@[simp] lemma log_one_right (b : ℕ) : log b 1 = 0 := log_eq_zero_iff.2 (lt_or_le _ _)
 
-/-- `pow b` and `log b` (almost) form a Galois connection. -/
-lemma pow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : 0 < y) : b ^ x ≤ y ↔ x ≤ log b y :=
+/-- `pow b` and `log b` (almost) form a Galois connection. See also `nat.pow_le_of_le_log` and
+`nat.le_log_of_pow_le` for individual implications under weaker assumptions. -/
+lemma pow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : y ≠ 0) : b ^ x ≤ y ↔ x ≤ log b y :=
 begin
   induction y using nat.strong_induction_on with y ih generalizing x,
   cases x,
-  { exact iff_of_true hy (zero_le _) },
+  { exact iff_of_true hy.bot_lt (zero_le _) },
   rw log, split_ifs,
   { have b_pos : 0 < b := zero_le_one.trans_lt hb,
-    rw [succ_eq_add_one, add_le_add_iff_right, ←ih (y / b) (div_lt_self hy hb)
-      (nat.div_pos h.1 b_pos), le_div_iff_mul_le b_pos, pow_succ'] },
-  { refine iff_of_false (λ hby, h ⟨le_trans _ hby, hb⟩) (not_succ_le_zero _),
-    convert pow_mono hb.le (zero_lt_succ x),
-    exact (pow_one b).symm }
+    rw [succ_eq_add_one, add_le_add_iff_right, ←ih (y / b) (div_lt_self hy.bot_lt hb)
+      (nat.div_pos h.1 b_pos).ne', le_div_iff_mul_le b_pos, pow_succ'] },
+  { exact iff_of_false (λ hby, h ⟨(le_self_pow hb.le x.succ_ne_zero).trans hby, hb⟩)
+      (not_succ_le_zero _) }
 end
 
-lemma lt_pow_iff_log_lt {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : 0 < y) : y < b ^ x ↔ log b y < x :=
+lemma lt_pow_iff_log_lt {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : y ≠ 0) : y < b ^ x ↔ log b y < x :=
 lt_iff_lt_of_le_iff_le (pow_le_iff_le_log hb hy)
 
-lemma log_pow {b : ℕ} (hb : 1 < b) (x : ℕ) : log b (b ^ x) = x :=
-eq_of_forall_le_iff $ λ z,
-by { rw ←pow_le_iff_le_log hb (pow_pos (zero_lt_one.trans hb) _),
-    exact (pow_right_strict_mono hb).le_iff_le }
-
-lemma log_pos {b n : ℕ} (hb : 1 < b) (hn : b ≤ n) : 0 < log b n :=
-by { rwa [←succ_le_iff, ←pow_le_iff_le_log hb (hb.le.trans hn), pow_one] }
+lemma pow_le_of_le_log {b x y : ℕ} (hy : y ≠ 0) (h : x ≤ log b y) : b ^ x ≤ y :=
+begin
+  refine (le_or_lt b 1).elim (λ hb, _) (λ hb, (pow_le_iff_le_log hb hy).2 h),
+  rw [log_of_left_le_one hb, nonpos_iff_eq_zero] at h,
+  rwa [h, pow_zero, one_le_iff_ne_zero]
+end
 
-lemma log_mul_base (b n : ℕ) (hb : 1 < b) (hn : 0 < n) : log b (n * b) = log b n + 1 :=
-eq_of_forall_le_iff $ λ z,
+lemma le_log_of_pow_le {b x y : ℕ} (hb : 1 < b) (h : b ^ x ≤ y) : x ≤ log b y :=
 begin
-  cases z,
-  { simp },
-  have : 0 < b := zero_lt_one.trans hb,
-  rw [←pow_le_iff_le_log hb, pow_succ', (strict_mono_mul_right_of_pos this).le_iff_le,
-      pow_le_iff_le_log hb hn, nat.succ_le_succ_iff],
-  simp [hn, this]
+  rcases ne_or_eq y 0 with hy | rfl,
+  exacts [(pow_le_iff_le_log hb hy).1 h, (h.not_lt (pow_pos (zero_lt_one.trans hb) _)).elim]
 end
 
+lemma pow_log_le_self (b : ℕ) {x : ℕ} (hx : x ≠ 0) : b ^ log b x ≤ x :=
+pow_le_of_le_log hx le_rfl
+
+lemma log_lt_of_lt_pow {b x y : ℕ} (hy : y ≠ 0) : y < b ^ x → log b y < x :=
+lt_imp_lt_of_le_imp_le (pow_le_of_le_log hy)
+
+lemma lt_pow_of_log_lt {b x y : ℕ} (hb : 1 < b) : log b y < x → y < b ^ x :=
+lt_imp_lt_of_le_imp_le (le_log_of_pow_le hb)
+
 lemma lt_pow_succ_log_self {b : ℕ} (hb : 1 < b) (x : ℕ) :
   x < b ^ (log b x).succ :=
+lt_pow_of_log_lt hb (lt_succ_self _)
+
+lemma log_eq_iff {b m n : ℕ} (h : m ≠ 0 ∨ 1 < b ∧ n ≠ 0) :
+  log b n = m ↔ b ^ m ≤ n ∧ n < b ^ (m + 1) :=
 begin
-  cases x.eq_zero_or_pos with hx hx,
-  { simp only [hx, log_zero_right, pow_one],
-    exact pos_of_gt hb },
-  rw [←not_le, pow_le_iff_le_log hb hx, not_le],
-  exact lt_succ_self _,
+  rcases em (1 < b ∧ n ≠ 0) with ⟨hb, hn⟩|hbn,
+  { rw [le_antisymm_iff, ← lt_succ_iff, ← pow_le_iff_le_log, ← lt_pow_iff_log_lt, and.comm];
+      assumption },
+  { have hm : m ≠ 0, from h.resolve_right hbn,
+    rw [not_and_distrib, not_lt, ne.def, not_not] at hbn,
+    rcases hbn with hb|rfl,
+    { simpa only [log_of_left_le_one hb, hm.symm, false_iff, not_and, not_lt]
+        using le_trans (pow_le_pow_of_le_one' hb m.le_succ) },
+    { simpa only [log_zero_right, hm.symm, false_iff, not_and, not_lt, le_zero_iff, pow_succ]
+        using mul_eq_zero_of_right _ } }
 end
 
-lemma pow_log_le_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 0 < x) : b ^ log b x ≤ x :=
-(pow_le_iff_le_log hb hx).2 le_rfl
+lemma log_eq_of_pow_le_of_lt_pow {b m n : ℕ} (h₁ : b ^ m ≤ n) (h₂ : n < b ^ (m + 1)) :
+  log b n = m :=
+begin
+  rcases eq_or_ne m 0 with rfl | hm,
+  { rw [pow_one] at h₂, exact log_of_lt h₂ },
+  { exact (log_eq_iff (or.inl hm)).2 ⟨h₁, h₂⟩ }
+end
 
-@[mono] lemma log_mono_right {b n m : ℕ} (h : n ≤ m) : log b n ≤ log b m :=
+lemma log_pow {b : ℕ} (hb : 1 < b) (x : ℕ) : log b (b ^ x) = x :=
+log_eq_of_pow_le_of_lt_pow le_rfl (pow_lt_pow hb x.lt_succ_self)
+
+lemma log_eq_one_iff' {b n : ℕ} : log b n = 1 ↔ b ≤ n ∧ n < b * b:=
+by rw [log_eq_iff (or.inl one_ne_zero), pow_add, pow_one]
+
+lemma log_eq_one_iff {b n : ℕ} : log b n = 1 ↔ n < b * b ∧ 1 < b ∧ b ≤ n :=
+log_eq_one_iff'.trans ⟨λ h, ⟨h.2, lt_mul_self_iff.1 (h.1.trans_lt h.2), h.1⟩, λ h, ⟨h.2.2, h.1⟩⟩
+
+lemma log_mul_base {b n : ℕ} (hb : 1 < b) (hn : n ≠ 0) : log b (n * b) = log b n + 1 :=
 begin
+  apply log_eq_of_pow_le_of_lt_pow; rw [pow_succ'],
+  exacts [mul_le_mul_right' (pow_log_le_self _ hn) _,
+    (mul_lt_mul_right (zero_lt_one.trans hb)).2 (lt_pow_succ_log_self hb _)]
+end
+
+lemma pow_log_le_add_one (b : ℕ) : ∀ x, b ^ log b x ≤ x + 1
+| 0 := by rw [log_zero_right, pow_zero]
+| (x + 1) := (pow_log_le_self b x.succ_ne_zero).trans (x + 1).le_succ
+
+lemma log_monotone {b : ℕ} : monotone (log b) :=
+begin
+  refine monotone_nat_of_le_succ (λ n, _),
   cases le_or_lt b 1 with hb hb,
   { rw log_of_left_le_one hb, exact zero_le _ },
-  { cases nat.eq_zero_or_pos n with hn hn,
-    { rw [hn, log_zero_right], exact zero_le _ },
-    { rw ←pow_le_iff_le_log hb (hn.trans_le h),
-      exact (pow_log_le_self hb hn).trans h } }
+  { exact le_log_of_pow_le hb (pow_log_le_add_one _ _) }
 end
 
+@[mono] lemma log_mono_right {b n m : ℕ} (h : n ≤ m) : log b n ≤ log b m :=
+log_monotone h
+
 @[mono] lemma log_anti_left {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : log b n ≤ log c n :=
 begin
-  cases n, { rw [log_zero_right, log_zero_right] },
-  rw ←pow_le_iff_le_log hc (zero_lt_succ n),
-  calc c ^ log b n.succ ≤ b ^ log b n.succ : pow_le_pow_of_le_left
-                                              (zero_lt_one.trans hc).le hb _
-                    ... ≤ n.succ           : pow_log_le_self (hc.trans_le hb)
-                                              (zero_lt_succ n)
+  rcases eq_or_ne n 0 with rfl | hn, { rw [log_zero_right, log_zero_right] },
+  apply le_log_of_pow_le hc,
+  calc c ^ log b n ≤ b ^ log b n : pow_le_pow_of_le_left' hb _
+               ... ≤ n           : pow_log_le_self _ hn
 end
 
-lemma log_monotone {b : ℕ} : monotone (log b) :=
-λ x y, log_mono_right
-
 lemma log_antitone_left {n : ℕ} : antitone_on (λ b, log b n) (set.Ioi 1) :=
 λ _ hc _ _ hb, log_anti_left (set.mem_Iio.1 hc) hb
 
-@[simp] lemma log_div_mul_self (b n : ℕ) : log b (n / b * b) = log b n :=
-eq_of_forall_le_iff (λ z, ⟨λ h, h.trans (log_monotone (div_mul_le_self _ _)), λ h, begin
-  rcases b with _|_|b,
-  { rwa log_zero_left at * },
-  { rwa log_one_left at * },
-  rcases n.zero_le.eq_or_lt with rfl|hn,
-  { rwa [nat.zero_div, zero_mul] },
-  cases le_or_lt b.succ.succ n with hb hb,
-  { cases z,
-    { apply zero_le },
-    rw [←pow_le_iff_le_log, pow_succ'] at h ⊢,
-    { rwa [(strict_mono_mul_right_of_pos nat.succ_pos').le_iff_le,
-            nat.le_div_iff_mul_le nat.succ_pos'] },
-    all_goals { simp [hn, nat.div_pos hb nat.succ_pos'] } },
-  { simpa [div_eq_of_lt, hb, log_of_lt] using h }
-end⟩)
-
 @[simp] lemma log_div_base (b n : ℕ) : log b (n / b) = log b n - 1 :=
 begin
+  cases le_or_lt b 1 with hb hb,
+  { rw [log_of_left_le_one hb, log_of_left_le_one hb, nat.zero_sub] },
   cases lt_or_le n b with h h,
   { rw [div_eq_of_lt h, log_of_lt h, log_zero_right] },
-  rcases n.zero_le.eq_or_lt with rfl|hn,
-  { rw [nat.zero_div, log_zero_right] },
-  rcases b with _|_|b,
-  { rw [log_zero_left, log_zero_left] },
-  { rw [log_one_left, log_one_left] },
-  rw [←succ_inj', ←succ_inj'],
-  simp_rw succ_eq_add_one,
-  rw [nat.sub_add_cancel, ←log_mul_base];
-  { simp [succ_le_iff, log_pos, h, nat.div_pos] },
+  rw [log_of_one_lt_of_le hb h, add_tsub_cancel_right]
+end
+
+@[simp] lemma log_div_mul_self (b n : ℕ) : log b (n / b * b) = log b n :=
+begin
+  cases le_or_lt b 1 with hb hb,
+  { rw [log_of_left_le_one hb, log_of_left_le_one hb] },
+  cases lt_or_le n b with h h,
+  { rw [div_eq_of_lt h, zero_mul, log_zero_right, log_of_lt h] },
+  rw [log_mul_base hb (nat.div_pos h (zero_le_one.trans_lt hb)).ne', log_div_base,
+    tsub_add_cancel_of_le (succ_le_iff.2 $ log_pos hb h)]
 end
 
 private lemma add_pred_div_lt {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : (n + b - 1) / b < n :=
@@ -315,7 +302,7 @@ begin
   cases n,
   { rw log_zero_right,
     exact zero_le _},
-  exact (pow_right_strict_mono hb).le_iff_le.1 ((pow_log_le_self hb $ succ_pos _).trans $
+  exact (pow_right_strict_mono hb).le_iff_le.1 ((pow_log_le_self b n.succ_ne_zero).trans $
     le_pow_clog hb _),
 end
 
diff --git a/src/data/nat/modeq.lean b/src/data/nat/modeq.lean
index 8edb26e35638d..a31f6c9aaf642 100644
--- a/src/data/nat/modeq.lean
+++ b/src/data/nat/modeq.lean
@@ -247,8 +247,6 @@ by { apply modeq_cancel_left_of_coprime hmc, simpa [mul_comm] using h }
 
 end modeq
 
-local attribute [semireducible] int.nonneg
-
 /-- The natural number less than `lcm n m` congruent to `a` mod `n` and `b` mod `m` -/
 def chinese_remainder' (h : a ≡ b [MOD gcd n m]) : {k // k ≡ a [MOD n] ∧ k ≡ b [MOD m]} :=
 if hn : n = 0 then ⟨a, begin rw [hn, gcd_zero_left] at h, split, refl, exact h end⟩ else
diff --git a/src/data/nat/multiplicity.lean b/src/data/nat/multiplicity.lean
index 3ce9cdb4c7be1..4d40db0694f4a 100644
--- a/src/data/nat/multiplicity.lean
+++ b/src/data/nat/multiplicity.lean
@@ -58,13 +58,12 @@ calc
       begin
         rw [mem_filter, mem_Ico, mem_Ico, lt_succ_iff, ←@part_enat.coe_le_coe i, part_enat.coe_get,
           ←pow_dvd_iff_le_multiplicity, and.right_comm],
-        refine (and_iff_left_of_imp (λ h, _)).symm,
+        refine (and_iff_left_of_imp (λ h, lt_of_le_of_lt _ hb)).symm,
         cases m,
         { rw [zero_pow, zero_dvd_iff] at h,
-          exact (hn.ne' h.2).elim,
-          { exact h.1 } },
-        exact ((pow_le_iff_le_log (succ_lt_succ $ nat.pos_of_ne_zero $ succ_ne_succ.1 hm) hn).1 $
-          le_of_dvd hn h.2).trans_lt hb,
+          exacts [(hn.ne' h.2).elim, h.1] },
+        exact le_log_of_pow_le (one_lt_iff_ne_zero_and_ne_one.2 ⟨m.succ_ne_zero, hm⟩)
+          (le_of_dvd hn h.2)
       end
 
 namespace prime
@@ -119,8 +118,8 @@ begin
     exact ⟨hp.ne_one, factorial_pos _⟩ },
   revert hm,
   have h4 : ∀ m ∈ Ico (p * n + 1) (p * (n + 1)), multiplicity p m = 0,
-  { intros m hm, apply multiplicity_eq_zero_of_not_dvd,
-    rw [← not_dvd_iff_between_consec_multiples _ (pos_iff_ne_zero.mpr hp.ne_zero)],
+  { intros m hm,
+    rw [multiplicity_eq_zero, ← not_dvd_iff_between_consec_multiples _ hp.pos],
     rw [mem_Ico] at hm,
     exact ⟨n, lt_of_succ_le hm.1, hm.2⟩ },
   simp_rw [← prod_Ico_id_eq_factorial, multiplicity.finset.prod hp', ← sum_Ico_consecutive _ h1 h3,
@@ -233,7 +232,7 @@ begin
   { contradiction },
   { intros b n ih h,
     by_cases hn : n = 0,
-    { subst hn, simp at h, simp [h, one_right h2.not_unit, part_enat.zero_lt_one] },
+    { subst hn, simp at h, simp [h, one_right h2.not_unit] },
     have : multiplicity 2 (2 * n)! < (2 * n : ℕ),
     { rw [prime_two.multiplicity_factorial_mul],
       refine (part_enat.add_lt_add_right (ih hn) (part_enat.coe_ne_top _)).trans_le _,
@@ -243,7 +242,7 @@ begin
     { suffices : multiplicity 2 (2 * n + 1) + multiplicity 2 (2 * n)! < ↑(2 * n) + 1,
       { simpa [succ_eq_add_one, multiplicity.mul, h2, prime_two, nat.bit1_eq_succ_bit0,
           bit0_eq_two_mul n] },
-      rw [multiplicity_eq_zero_of_not_dvd (two_not_dvd_two_mul_add_one n), zero_add],
+      rw [multiplicity_eq_zero.2 (two_not_dvd_two_mul_add_one n), zero_add],
       refine this.trans _, exact_mod_cast lt_succ_self _ }}
 end
 
diff --git a/src/data/nat/order/basic.lean b/src/data/nat/order/basic.lean
index 6e8da23e6b403..dea794afb9224 100644
--- a/src/data/nat/order/basic.lean
+++ b/src/data/nat/order/basic.lean
@@ -23,14 +23,14 @@ instance nat.order_bot : order_bot ℕ :=
 { bot := 0, bot_le := nat.zero_le }
 
 instance : linear_ordered_comm_semiring ℕ :=
-{ lt                         := nat.lt,
-  add_le_add_left            := @nat.add_le_add_left,
-  le_of_add_le_add_left      := @nat.le_of_add_le_add_left,
-  zero_le_one                := nat.le_of_lt (nat.zero_lt_succ 0),
-  mul_lt_mul_of_pos_left     := @nat.mul_lt_mul_of_pos_left,
-  mul_lt_mul_of_pos_right    := @nat.mul_lt_mul_of_pos_right,
-  decidable_eq               := nat.decidable_eq,
-  exists_pair_ne             := ⟨0, 1, ne_of_lt nat.zero_lt_one⟩,
+{ lt                      := nat.lt,
+  add_le_add_left         := @nat.add_le_add_left,
+  le_of_add_le_add_left   := @nat.le_of_add_le_add_left,
+  zero_le_one             := nat.le_of_lt (nat.zero_lt_succ 0),
+  mul_lt_mul_of_pos_left  := @nat.mul_lt_mul_of_pos_left,
+  mul_lt_mul_of_pos_right := @nat.mul_lt_mul_of_pos_right,
+  decidable_eq            := nat.decidable_eq,
+  exists_pair_ne          := ⟨0, 1, ne_of_lt nat.zero_lt_one⟩,
   ..nat.comm_semiring, ..nat.linear_order }
 
 instance : linear_ordered_comm_monoid_with_zero ℕ :=
@@ -49,9 +49,9 @@ instance : ordered_comm_semiring ℕ        := strict_ordered_comm_semiring.to_o
 instance : linear_ordered_cancel_add_comm_monoid ℕ := infer_instance
 
 instance : canonically_ordered_comm_semiring ℕ :=
-{ exists_add_of_le := λ a b h, (nat.le.dest h).imp $ λ _, eq.symm,
-  le_self_add := nat.le_add_right,
-  eq_zero_or_eq_zero_of_mul_eq_zero   := λ a b, nat.eq_zero_of_mul_eq_zero,
+{ exists_add_of_le                  := λ a b h, (nat.le.dest h).imp $ λ _, eq.symm,
+  le_self_add                       := nat.le_add_right,
+  eq_zero_or_eq_zero_of_mul_eq_zero := λ a b, nat.eq_zero_of_mul_eq_zero,
   .. nat.nontrivial,
   .. nat.order_bot,
   .. (infer_instance : ordered_add_comm_monoid ℕ),
@@ -62,12 +62,12 @@ instance : canonically_linear_ordered_add_monoid ℕ :=
 { .. (infer_instance : canonically_ordered_add_monoid ℕ),
   .. nat.linear_order }
 
-variables {m n k : ℕ}
+variables {m n k l : ℕ}
 namespace nat
 
 /-! ### Equalities and inequalities involving zero and one -/
 
-lemma one_le_iff_ne_zero {n : ℕ} : 1 ≤ n ↔ n ≠ 0 :=
+lemma one_le_iff_ne_zero : 1 ≤ n ↔ n ≠ 0 :=
 (show 1 ≤ n ↔ 0 < n, from iff.rfl).trans pos_iff_ne_zero
 
 lemma one_lt_iff_ne_zero_and_ne_one : ∀ {n : ℕ}, 1 < n ↔ n ≠ 0 ∧ n ≠ 1
@@ -75,78 +75,73 @@ lemma one_lt_iff_ne_zero_and_ne_one : ∀ {n : ℕ}, 1 < n ↔ n ≠ 0 ∧ n ≠
 | 1     := dec_trivial
 | (n+2) := dec_trivial
 
-protected theorem mul_ne_zero {n m : ℕ} (n0 : n ≠ 0) (m0 : m ≠ 0) : n * m ≠ 0
+protected theorem mul_ne_zero (n0 : n ≠ 0) (m0 : m ≠ 0) : n * m ≠ 0
 | nm := (eq_zero_of_mul_eq_zero nm).elim n0 m0
 
-@[simp] protected theorem mul_eq_zero {a b : ℕ} : a * b = 0 ↔ a = 0 ∨ b = 0 :=
+@[simp] protected theorem mul_eq_zero : m * n = 0 ↔ m = 0 ∨ n = 0 :=
 iff.intro eq_zero_of_mul_eq_zero (by simp [or_imp_distrib] {contextual := tt})
 
-@[simp] protected theorem zero_eq_mul {a b : ℕ} : 0 = a * b ↔ a = 0 ∨ b = 0 :=
+@[simp] protected theorem zero_eq_mul : 0 = m * n ↔ m = 0 ∨ n = 0 :=
 by rw [eq_comm, nat.mul_eq_zero]
 
-lemma eq_zero_of_double_le {a : ℕ} (h : 2 * a ≤ a) : a = 0 :=
-add_right_eq_self.mp $ le_antisymm ((two_mul a).symm.trans_le h) le_add_self
+lemma eq_zero_of_double_le (h : 2 * n ≤ n) : n = 0 :=
+add_right_eq_self.mp $ le_antisymm ((two_mul n).symm.trans_le h) le_add_self
 
-lemma eq_zero_of_mul_le {a b : ℕ} (hb : 2 ≤ b) (h : b * a ≤ a) : a = 0 :=
+lemma eq_zero_of_mul_le (hb : 2 ≤ n) (h : n * m ≤ m) : m = 0 :=
 eq_zero_of_double_le $ le_trans (nat.mul_le_mul_right _ hb) h
 
-lemma zero_max {m : ℕ} : max 0 m = m :=
-max_eq_right (zero_le _)
+lemma zero_max : max 0 n = n := max_eq_right (zero_le _)
 
-@[simp] lemma min_eq_zero_iff {m n : ℕ} : min m n = 0 ↔ m = 0 ∨ n = 0 :=
+@[simp] lemma min_eq_zero_iff : min m n = 0 ↔ m = 0 ∨ n = 0 :=
 begin
   split,
   { intro h,
-    cases le_total n m with H H,
-    { simpa [H] using or.inr h },
-    { simpa [H] using or.inl h } },
+    cases le_total m n with H H,
+    { simpa [H] using or.inl h },
+    { simpa [H] using or.inr h } },
   { rintro (rfl|rfl);
     simp }
 end
 
-@[simp] lemma max_eq_zero_iff {m n : ℕ} : max m n = 0 ↔ m = 0 ∧ n = 0 :=
+@[simp] lemma max_eq_zero_iff : max m n = 0 ↔ m = 0 ∧ n = 0 :=
 begin
   split,
   { intro h,
-    cases le_total n m with H H,
-    { simp only [H, max_eq_left] at h,
-      exact ⟨h, le_antisymm (H.trans h.le) (zero_le _)⟩ },
+    cases le_total m n with H H,
     { simp only [H, max_eq_right] at h,
-      exact ⟨le_antisymm (H.trans h.le) (zero_le _), h⟩ } },
+      exact ⟨le_antisymm (H.trans h.le) (zero_le _), h⟩ },
+    { simp only [H, max_eq_left] at h,
+      exact ⟨h, le_antisymm (H.trans h.le) (zero_le _)⟩ } },
   { rintro ⟨rfl, rfl⟩,
     simp }
 end
 
-lemma add_eq_max_iff {n m : ℕ} :
-  n + m = max n m ↔ n = 0 ∨ m = 0 :=
+lemma add_eq_max_iff : m + n = max m n ↔ m = 0 ∨ n = 0 :=
 begin
   rw ←min_eq_zero_iff,
-  cases le_total n m with H H;
+  cases le_total m n with H H;
   simp [H]
 end
 
-lemma add_eq_min_iff {n m : ℕ} :
-  n + m = min n m ↔ n = 0 ∧ m = 0 :=
+lemma add_eq_min_iff : m + n = min m n ↔ m = 0 ∧ n = 0 :=
 begin
   rw ←max_eq_zero_iff,
-  cases le_total n m with H H;
+  cases le_total m n with H H;
   simp [H]
 end
 
-lemma one_le_of_lt {n m : ℕ} (h : n < m) : 1 ≤ m :=
-lt_of_le_of_lt (nat.zero_le _) h
+lemma one_le_of_lt (h : n < m) : 1 ≤ m := lt_of_le_of_lt (nat.zero_le _) h
 
-theorem eq_one_of_mul_eq_one_right {m n : ℕ} (H : m * n = 1) : m = 1 :=
-eq_one_of_dvd_one ⟨n, H.symm⟩
+theorem eq_one_of_mul_eq_one_right (H : m * n = 1) : m = 1 := eq_one_of_dvd_one ⟨n, H.symm⟩
 
-theorem eq_one_of_mul_eq_one_left {m n : ℕ} (H : m * n = 1) : n = 1 :=
+theorem eq_one_of_mul_eq_one_left (H : m * n = 1) : n = 1 :=
 eq_one_of_mul_eq_one_right (by rwa mul_comm)
 
 /-! ### `succ` -/
 
 lemma two_le_iff : ∀ n, 2 ≤ n ↔ n ≠ 0 ∧ n ≠ 1
-| 0 := by simp
-| 1 := by simp
+| 0     := by simp
+| 1     := by simp
 | (n+2) := by simp
 
 @[simp] lemma lt_one_iff {n : ℕ} : n < 1 ↔ n = 0 :=
@@ -187,7 +182,7 @@ lemma add_eq_three_iff :
   m + n = 3 ↔ m = 0 ∧ n = 3 ∨ m = 1 ∧ n = 2 ∨ m = 2 ∧ n = 1 ∨ m = 3 ∧ n = 0 :=
 by cases n; simp [(succ_ne_zero 1).symm, succ_eq_add_one, ← add_assoc, succ_inj', add_eq_two_iff]
 
-theorem le_add_one_iff {i j : ℕ} : i ≤ j + 1 ↔ (i ≤ j ∨ i = j + 1) :=
+theorem le_add_one_iff : m ≤ n + 1 ↔ m ≤ n ∨ m = n + 1 :=
 ⟨λ h,
   match nat.eq_or_lt_of_le h with
   | or.inl h := or.inr h
@@ -195,15 +190,14 @@ theorem le_add_one_iff {i j : ℕ} : i ≤ j + 1 ↔ (i ≤ j ∨ i = j + 1) :=
   end,
   or.rec (λ h, le_trans h $ nat.le_add_right _ _) le_of_eq⟩
 
-lemma le_and_le_add_one_iff {x a : ℕ} :
-  a ≤ x ∧ x ≤ a + 1 ↔ x = a ∨ x = a + 1 :=
+lemma le_and_le_add_one_iff : n ≤ m ∧ m ≤ n + 1 ↔ m = n ∨ m = n + 1 :=
 begin
   rw [le_add_one_iff, and_or_distrib_left, ←le_antisymm_iff, eq_comm, and_iff_right_of_imp],
   rintro rfl,
-  exact a.le_succ,
+  exact n.le_succ
 end
 
-lemma add_succ_lt_add {a b c d : ℕ} (hab : a < b) (hcd : c < d) : a + c + 1 < b + d :=
+lemma add_succ_lt_add (hab : m < n) (hcd : k < l) : m + k + 1 < n + l :=
 begin
   rw add_assoc,
   exact add_lt_add_of_lt_of_le hab (nat.succ_le_iff.2 hcd)
@@ -211,8 +205,8 @@ end
 
 /-! ### `pred` -/
 
-lemma pred_le_iff {n m : ℕ} : pred n ≤ m ↔ n ≤ succ m :=
-⟨le_succ_of_pred_le, by { cases n, { exact λ h, zero_le m }, exact le_of_succ_le_succ }⟩
+lemma pred_le_iff : pred m ≤ n ↔ m ≤ succ n :=
+⟨le_succ_of_pred_le, by { cases m, { exact λ _, zero_le n }, exact le_of_succ_le_succ }⟩
 
 /-! ### `sub`
 
@@ -227,71 +221,67 @@ begin
   { simp only [sub_succ, add_succ, succ_add, ih, pred_le_iff] }
 end
 
-lemma lt_pred_iff {n m : ℕ} : n < pred m ↔ succ n < m :=
-show n < m - 1 ↔ n + 1 < m, from lt_tsub_iff_right
+lemma lt_pred_iff : n < pred m ↔ succ n < m := show n < m - 1 ↔ n + 1 < m, from lt_tsub_iff_right
 
-lemma lt_of_lt_pred {a b : ℕ} (h : a < b - 1) : a < b :=
-lt_of_succ_lt (lt_pred_iff.1 h)
+lemma lt_of_lt_pred (h : m < n - 1) : m < n := lt_of_succ_lt (lt_pred_iff.1 h)
 
-lemma le_or_le_of_add_eq_add_pred {a b c d : ℕ} (h : c + d = a + b - 1) : a ≤ c ∨ b ≤ d :=
+lemma le_or_le_of_add_eq_add_pred (h : k + l = m + n - 1) : m ≤ k ∨ n ≤ l :=
 begin
-  cases le_or_lt a c with h' h'; [left, right],
-  { exact h', },
-  { replace h' := add_lt_add_right h' d, rw h at h',
-    cases b.eq_zero_or_pos with hb hb, { rw hb, exact zero_le d, },
-    rw [a.add_sub_assoc hb, add_lt_add_iff_left] at h',
-    exact nat.le_of_pred_lt h', },
+  cases le_or_lt m k with h' h'; [left, right],
+  { exact h' },
+  { replace h' := add_lt_add_right h' l, rw h at h',
+    cases n.eq_zero_or_pos with hn hn, { rw hn, exact zero_le l },
+    rw [m.add_sub_assoc hn, add_lt_add_iff_left] at h',
+    exact nat.le_of_pred_lt h' },
 end
 
 /-- A version of `nat.sub_succ` in the form `_ - 1` instead of `nat.pred _`. -/
-lemma sub_succ' (a b : ℕ) : a - b.succ = a - b - 1 := rfl
+lemma sub_succ' (m n : ℕ) : m - n.succ = m - n - 1 := rfl
 
 /-! ### `mul` -/
 
-lemma mul_eq_one_iff : ∀ {a b : ℕ}, a * b = 1 ↔ a = 1 ∧ b = 1
+lemma mul_eq_one_iff : ∀ {m n : ℕ}, m * n = 1 ↔ m = 1 ∧ n = 1
 | 0     0     := dec_trivial
 | 0     1     := dec_trivial
 | 1     0     := dec_trivial
-| (a+2) 0     := by simp
-| 0     (b+2) := by simp
-| (a+1) (b+1) := ⟨
+| (m+2) 0     := by simp
+| 0     (n+2) := by simp
+| (m+1) (n+1) := ⟨
   λ h, by simp only [add_mul, mul_add, mul_add, one_mul, mul_one,
     (add_assoc _ _ _).symm, nat.succ_inj', add_eq_zero_iff] at h; simp [h.1.2, h.2],
   λ h, by simp only [h, mul_one]⟩
 
-lemma succ_mul_pos (m : ℕ) (hn : 0 < n) : 0 < (succ m) * n :=
-mul_pos (succ_pos m) hn
+lemma succ_mul_pos (m : ℕ) (hn : 0 < n) : 0 < (succ m) * n := mul_pos (succ_pos m) hn
 
-theorem mul_self_le_mul_self {n m : ℕ} (h : n ≤ m) : n * n ≤ m * m :=
-mul_le_mul h h (zero_le _) (zero_le _)
+theorem mul_self_le_mul_self (h : m ≤ n) : m * m ≤ n * n := mul_le_mul h h (zero_le _) (zero_le _)
 
-theorem mul_self_lt_mul_self : Π {n m : ℕ}, n < m → n * n < m * m
-| 0        m h := mul_pos h h
-| (succ n) m h := mul_lt_mul h (le_of_lt h) (succ_pos _) (zero_le _)
+theorem mul_self_lt_mul_self : Π {m n : ℕ}, m < n → m * m < n * n
+| 0        n h := mul_pos h h
+| (succ m) n h := mul_lt_mul h (le_of_lt h) (succ_pos _) (zero_le _)
 
-theorem mul_self_le_mul_self_iff {n m : ℕ} : n ≤ m ↔ n * n ≤ m * m :=
+theorem mul_self_le_mul_self_iff : m ≤ n ↔ m * m ≤ n * n :=
 ⟨mul_self_le_mul_self, le_imp_le_of_lt_imp_lt mul_self_lt_mul_self⟩
 
-theorem mul_self_lt_mul_self_iff {n m : ℕ} : n < m ↔ n * n < m * m :=
+theorem mul_self_lt_mul_self_iff : m < n ↔ m * m < n * n :=
 le_iff_le_iff_lt_iff_lt.1 mul_self_le_mul_self_iff
 
 theorem le_mul_self : Π (n : ℕ), n ≤ n * n
 | 0     := le_rfl
 | (n+1) := by simp
 
-lemma le_mul_of_pos_left {m n : ℕ} (h : 0 < n) : m ≤ n * m :=
+lemma le_mul_of_pos_left (h : 0 < n) : m ≤ n * m :=
 begin
   conv {to_lhs, rw [← one_mul(m)]},
   exact mul_le_mul_of_nonneg_right h.nat_succ_le dec_trivial,
 end
 
-lemma le_mul_of_pos_right {m n : ℕ} (h : 0 < n) : m ≤ m * n :=
+lemma le_mul_of_pos_right (h : 0 < n) : m ≤ m * n :=
 begin
   conv {to_lhs, rw [← mul_one(m)]},
   exact mul_le_mul_of_nonneg_left h.nat_succ_le dec_trivial,
 end
 
-theorem mul_self_inj {n m : ℕ} : n * n = m * m ↔ n = m :=
+theorem mul_self_inj : m * m = n * n ↔ m = n :=
 le_antisymm_iff.trans (le_antisymm_iff.trans
   (and_congr mul_self_le_mul_self_iff mul_self_le_mul_self_iff)).symm
 
@@ -301,6 +291,10 @@ begin
   simp [add_comm, nat.add_sub_assoc, one_le_iff_ne_zero.2 hi]
 end
 
+@[simp] theorem lt_mul_self_iff : ∀ {n : ℕ}, n < n * n ↔ 1 < n
+| 0 := iff_of_false (lt_irrefl _) zero_le_one.not_lt
+| (n + 1) := lt_mul_iff_one_lt_left n.succ_pos
+
 /-!
 ### Recursion and induction principles
 
@@ -315,7 +309,7 @@ proved above, and some of the results in later sections depend on the definition
 lemma diag_induction (P : ℕ → ℕ → Prop) (ha : ∀ a, P (a + 1) (a + 1)) (hb : ∀ b, P 0 (b + 1))
   (hd : ∀ a b, a < b → P (a + 1) b → P a (b + 1) → P (a + 1) (b + 1)) :
   ∀ a b, a < b → P a b
-| 0 (b + 1) h := hb _
+| 0 (b + 1) h       := hb _
 | (a + 1) (b + 1) h :=
 begin
   apply hd _ _ ((add_lt_add_iff_right _).1 h),
@@ -329,10 +323,10 @@ begin
 end
 using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ p, p.1 + p.2.1)⟩] }
 
-/-- A subset of `ℕ` containing `b : ℕ` and closed under `nat.succ` contains every `n ≥ b`. -/
-lemma set_induction_bounded {b : ℕ} {S : set ℕ} (hb : b ∈ S) (h_ind: ∀ k : ℕ, k ∈ S → k + 1 ∈ S)
-  {n : ℕ} (hbn : b ≤ n) : n ∈ S :=
-@le_rec_on (λ n, n ∈ S) b n hbn h_ind hb
+/-- A subset of `ℕ` containing `k : ℕ` and closed under `nat.succ` contains every `n ≥ k`. -/
+lemma set_induction_bounded {S : set ℕ} (hk : k ∈ S) (h_ind: ∀ k : ℕ, k ∈ S → k + 1 ∈ S)
+  (hnk : k ≤ n) : n ∈ S :=
+@le_rec_on (λ n, n ∈ S) k n hnk h_ind hk
 
 /-- A subset of `ℕ` containing zero and closed under `nat.succ` contains all of `ℕ`. -/
 lemma set_induction {S : set ℕ} (hb : 0 ∈ S) (h_ind: ∀ k : ℕ, k ∈ S → k + 1 ∈ S) (n : ℕ) : n ∈ S :=
@@ -340,7 +334,7 @@ set_induction_bounded hb h_ind (zero_le n)
 
 /-! ### `div` -/
 
-protected lemma div_le_of_le_mul' {m n : ℕ} {k} (h : m ≤ k * n) : m / k ≤ n :=
+protected lemma div_le_of_le_mul' (h : m ≤ k * n) : m / k ≤ n :=
 (nat.eq_zero_or_pos k).elim
   (λ k0, by rw [k0, nat.div_zero]; apply zero_le)
   (λ k0, (mul_le_mul_left k0).1 $
@@ -356,78 +350,90 @@ protected lemma div_le_self' (m n : ℕ) : m / n ≤ m :=
       m = 1 * m : (one_mul _).symm
     ... ≤ n * m : nat.mul_le_mul_right _ n0)
 
-protected lemma div_lt_of_lt_mul {m n k : ℕ} (h : m < n * k) : m / n < k :=
+protected lemma div_lt_of_lt_mul (h : m < n * k) : m / n < k :=
 lt_of_mul_lt_mul_left
   (calc n * (m / n) ≤ m % n + n * (m / n) : nat.le_add_left _ _
     ... = m : mod_add_div _ _
     ... < n * k : h)
   (nat.zero_le n)
 
-lemma eq_zero_of_le_div {a b : ℕ} (hb : 2 ≤ b) (h : a ≤ a / b) : a = 0 :=
-eq_zero_of_mul_le hb $
-  by rw mul_comm; exact (nat.le_div_iff_mul_le' (lt_of_lt_of_le dec_trivial hb)).1 h
+lemma eq_zero_of_le_div (hn : 2 ≤ n) (h : m ≤ m / n) : m = 0 :=
+eq_zero_of_mul_le hn $
+  by rw mul_comm; exact (nat.le_div_iff_mul_le' (lt_of_lt_of_le dec_trivial hn)).1 h
 
-lemma div_mul_div_le_div (a b c : ℕ) : ((a / c) * b) / a ≤ b / c :=
-if ha0 : a = 0 then by simp [ha0]
-else calc a / c * b / a ≤ b * a / c / a :
+lemma div_mul_div_le_div (m n k : ℕ) : ((m / k) * n) / m ≤ n / k :=
+if hm0 : m = 0 then by simp [hm0]
+else calc m / k * n / m ≤ n * m / k / m :
     nat.div_le_div_right (by rw [mul_comm];
         exact mul_div_le_mul_div_assoc _ _ _)
-  ... = b / c : by rw [nat.div_div_eq_div_mul, mul_comm b, mul_comm c,
-      nat.mul_div_mul _ _ (nat.pos_of_ne_zero ha0)]
+  ... = n / k : by rw [nat.div_div_eq_div_mul, mul_comm n, mul_comm k,
+      nat.mul_div_mul _ _ (nat.pos_of_ne_zero hm0)]
 
-lemma eq_zero_of_le_half {a : ℕ} (h : a ≤ a / 2) : a = 0 :=
-eq_zero_of_le_div le_rfl h
+lemma eq_zero_of_le_half (h : n ≤ n / 2) : n = 0 := eq_zero_of_le_div le_rfl h
 
-lemma mul_div_mul_comm_of_dvd_dvd {a b c d : ℕ} (hac : c ∣ a) (hbd : d ∣ b) :
-  a * b / (c * d) = a / c * (b / d) :=
+lemma mul_div_mul_comm_of_dvd_dvd (hmk : k ∣ m) (hnl : l ∣ n) : m * n / (k * l) = m / k * (n / l) :=
 begin
-  rcases c.eq_zero_or_pos with rfl | hc0, { simp },
-  rcases d.eq_zero_or_pos with rfl | hd0, { simp },
-  obtain ⟨k1, rfl⟩ := hac,
-  obtain ⟨k2, rfl⟩ := hbd,
-  rw [mul_mul_mul_comm, nat.mul_div_cancel_left _ hc0, nat.mul_div_cancel_left _ hd0,
-      nat.mul_div_cancel_left _ (mul_pos hc0 hd0)],
+  rcases k.eq_zero_or_pos with rfl | hk0, { simp },
+  rcases l.eq_zero_or_pos with rfl | hl0, { simp },
+  obtain ⟨_, rfl⟩ := hmk,
+  obtain ⟨_, rfl⟩ := hnl,
+  rw [mul_mul_mul_comm, nat.mul_div_cancel_left _ hk0, nat.mul_div_cancel_left _ hl0,
+      nat.mul_div_cancel_left _ (mul_pos hk0 hl0)]
 end
 
+lemma le_half_of_half_lt_sub {a b : ℕ} (h : a / 2 < a - b) : b ≤ a / 2 :=
+begin
+  rw nat.le_div_iff_mul_le two_pos,
+  rw [nat.div_lt_iff_lt_mul two_pos, nat.mul_sub_right_distrib, lt_tsub_iff_right,
+    mul_two a] at h,
+  exact le_of_lt (nat.lt_of_add_lt_add_left h)
+end
+
+lemma half_le_of_sub_le_half {a b : ℕ} (h : a - b ≤ a / 2) : a / 2 ≤ b :=
+begin
+  rw [nat.le_div_iff_mul_le two_pos, nat.mul_sub_right_distrib, tsub_le_iff_right,
+    mul_two, add_le_add_iff_left] at h,
+  rw [← nat.mul_div_left b two_pos],
+  exact nat.div_le_div_right h,
+end
 
 /-! ### `mod`, `dvd` -/
 
-lemma two_mul_odd_div_two {n : ℕ} (hn : n % 2 = 1) : 2 * (n / 2) = n - 1 :=
+lemma two_mul_odd_div_two (hn : n % 2 = 1) : 2 * (n / 2) = n - 1 :=
 by conv {to_rhs, rw [← nat.mod_add_div n 2, hn, add_tsub_cancel_left]}
 
-lemma div_dvd_of_dvd {a b : ℕ} (h : b ∣ a) : (a / b) ∣ a :=
-⟨b, (nat.div_mul_cancel h).symm⟩
+lemma div_dvd_of_dvd (h : n ∣ m) : (m / n) ∣ m := ⟨n, (nat.div_mul_cancel h).symm⟩
 
-protected lemma div_div_self {a b : ℕ} (h : b ∣ a) (ha : a ≠ 0) : a / (a / b) = b :=
+protected lemma div_div_self (h : n ∣ m) (hm : m ≠ 0) : m / (m / n) = n :=
 begin
-  rcases h with ⟨a, rfl⟩,
-  rw mul_ne_zero_iff at ha,
-  rw [nat.mul_div_right _ (nat.pos_of_ne_zero ha.1), nat.mul_div_left _ (nat.pos_of_ne_zero ha.2)]
+  rcases h with ⟨_, rfl⟩,
+  rw mul_ne_zero_iff at hm,
+  rw [mul_div_right _ (nat.pos_of_ne_zero hm.1), mul_div_left _ (nat.pos_of_ne_zero hm.2)]
 end
 
-lemma mod_mul_right_div_self (a b c : ℕ) : a % (b * c) / b = (a / b) % c :=
+lemma mod_mul_right_div_self (m n k : ℕ) : m % (n * k) / n = (m / n) % k :=
 begin
-  rcases nat.eq_zero_or_pos b with rfl|hb, { simp },
-  rcases nat.eq_zero_or_pos c with rfl|hc, { simp },
-  conv_rhs { rw ← mod_add_div a (b * c) },
-  rw [mul_assoc, nat.add_mul_div_left _ _ hb, add_mul_mod_self_left,
-    mod_eq_of_lt (nat.div_lt_of_lt_mul (mod_lt _ (mul_pos hb hc)))]
+  rcases nat.eq_zero_or_pos n with rfl|hn, { simp },
+  rcases nat.eq_zero_or_pos k with rfl|hk, { simp },
+  conv_rhs { rw ← mod_add_div m (n * k) },
+  rw [mul_assoc, add_mul_div_left _ _ hn, add_mul_mod_self_left,
+    mod_eq_of_lt (nat.div_lt_of_lt_mul (mod_lt _ (mul_pos hn hk)))]
 end
 
-lemma mod_mul_left_div_self (a b c : ℕ) : a % (c * b) / b = (a / b) % c :=
-by rw [mul_comm c, mod_mul_right_div_self]
+lemma mod_mul_left_div_self (m n k : ℕ) : m % (k * n) / n = (m / n) % k :=
+by rw [mul_comm k, mod_mul_right_div_self]
 
-lemma not_dvd_of_pos_of_lt {a b : ℕ} (h1 : 0 < b) (h2 : b < a) : ¬ a ∣ b :=
+lemma not_dvd_of_pos_of_lt (h1 : 0 < n) (h2 : n < m) : ¬ m ∣ n :=
 begin
-  rintros ⟨c, rfl⟩,
-  rcases nat.eq_zero_or_pos c with (rfl | hc),
+  rintros ⟨k, rfl⟩,
+  rcases nat.eq_zero_or_pos k with (rfl | hk),
   { exact lt_irrefl 0 h1 },
-  { exact not_lt.2 (le_mul_of_pos_right hc) h2 },
+  { exact not_lt.2 (le_mul_of_pos_right hk) h2 },
 end
 
-/--  If `a` and `b` are equal mod `c`, `a - b` is zero mod `c`. -/
-lemma sub_mod_eq_zero_of_mod_eq {a b c : ℕ} (h : a % c = b % c) : (a - b) % c = 0 :=
-by rw [←nat.mod_add_div a c, ←nat.mod_add_div b c, ←h, tsub_add_eq_tsub_tsub, add_tsub_cancel_left,
+/--  If `m` and `n` are equal mod `k`, `m - n` is zero mod `k`. -/
+lemma sub_mod_eq_zero_of_mod_eq (h : m % k = n % k) : (m - n) % k = 0 :=
+by rw [←nat.mod_add_div m k, ←nat.mod_add_div n k, ←h, tsub_add_eq_tsub_tsub, add_tsub_cancel_left,
        ←mul_tsub, nat.mul_mod_right]
 
 @[simp] lemma one_mod (n : ℕ) : 1 % (n + 2) = 1 := nat.mod_eq_of_lt (add_lt_add_right n.succ_pos 1)
@@ -435,26 +441,25 @@ by rw [←nat.mod_add_div a c, ←nat.mod_add_div b c, ←h, tsub_add_eq_tsub_ts
 lemma dvd_sub_mod (k : ℕ) : n ∣ (k - (k % n)) :=
 ⟨k / n, tsub_eq_of_eq_add_rev (nat.mod_add_div k n).symm⟩
 
-lemma add_mod_eq_ite {a b n : ℕ} :
-  (a + b) % n = if n ≤ a % n + b % n then a % n + b % n - n else a % n + b % n :=
+lemma add_mod_eq_ite :
+  (m + n) % k = if k ≤ m % k + n % k then m % k + n % k - k else m % k + n % k :=
 begin
-  cases n, { simp },
+  cases k, { simp },
   rw nat.add_mod,
   split_ifs with h,
   { rw [nat.mod_eq_sub_mod h, nat.mod_eq_of_lt],
     exact (tsub_lt_iff_right h).mpr
-        (nat.add_lt_add (a.mod_lt n.zero_lt_succ) (b.mod_lt n.zero_lt_succ)) },
+        (nat.add_lt_add (m.mod_lt k.zero_lt_succ) (n.mod_lt k.zero_lt_succ)) },
   { exact nat.mod_eq_of_lt (lt_of_not_ge h) }
 end
 
-lemma div_mul_div_comm {a b c d : ℕ} (hab : b ∣ a) (hcd : d ∣ c) :
-      (a / b) * (c / d) = (a * c) / (b * d) :=
-have exi1 : ∃ x, a = b * x, from hab,
-have exi2 : ∃ y, c = d * y, from hcd,
-if hb : b = 0 then by simp [hb]
-else have 0 < b, from nat.pos_of_ne_zero hb,
-if hd : d = 0 then by simp [hd]
-else have 0 < d, from nat.pos_of_ne_zero hd,
+lemma div_mul_div_comm (hmn : n ∣ m) (hkl : l ∣ k) : (m / n) * (k / l) = (m * k) / (n * l) :=
+have exi1 : ∃ x, m = n * x, from hmn,
+have exi2 : ∃ y, k = l * y, from hkl,
+if hn : n = 0 then by simp [hn]
+else have 0 < n, from nat.pos_of_ne_zero hn,
+if hl : l = 0 then by simp [hl]
+else have 0 < l, from nat.pos_of_ne_zero hl,
 begin
   cases exi1 with x hx, cases exi2 with y hy,
   rw [hx, hy, nat.mul_div_cancel_left, nat.mul_div_cancel_left],
@@ -465,22 +470,22 @@ begin
   cc
 end
 
-lemma div_eq_self {a b : ℕ} : a / b = a ↔ a = 0 ∨ b = 1 :=
+lemma div_eq_self : m / n = m ↔ m = 0 ∨ n = 1 :=
 begin
   split,
   { intro,
-    cases b,
+    cases n,
     { simp * at * },
-    { cases b,
+    { cases n,
       { right, refl },
       { left,
-        have : a / (b + 2) ≤ a / 2 := div_le_div_left (by simp) dec_trivial,
+        have : m / (n + 2) ≤ m / 2 := div_le_div_left (by simp) dec_trivial,
         refine eq_zero_of_le_half _,
         simp * at * } } },
   { rintros (rfl|rfl); simp }
 end
 
-lemma div_eq_sub_mod_div {m n : ℕ} : m / n = (m - m % n) / n :=
+lemma div_eq_sub_mod_div : m / n = (m - m % n) / n :=
 begin
   by_cases n0 : n = 0,
   { rw [n0, nat.div_zero, nat.div_zero] },
@@ -488,12 +493,11 @@ begin
     rw [add_tsub_cancel_left, mul_div_right _ (nat.pos_of_ne_zero n0)] }
 end
 
-/-- `n` is not divisible by `a` if it is between `a * k` and `a * (k + 1)` for some `k`. -/
-lemma not_dvd_of_between_consec_multiples {n a k : ℕ} (h1 : a * k < n) (h2 : n < a * (k + 1)) :
-  ¬ a ∣ n :=
+/-- `m` is not divisible by `n` if it is between `n * k` and `n * (k + 1)` for some `k`. -/
+lemma not_dvd_of_between_consec_multiples (h1 : n * k < m) (h2 : m < n * (k + 1)) : ¬ n ∣ m :=
 begin
   rintro ⟨d, rfl⟩,
-  exact monotone.ne_of_lt_of_lt_nat (covariant.monotone_of_const a) k h1 h2 d rfl,
+  exact monotone.ne_of_lt_of_lt_nat (covariant.monotone_of_const n) k h1 h2 d rfl
 end
 
 /-! ### `find` -/
@@ -504,8 +508,6 @@ variables {p q : ℕ → Prop} [decidable_pred p] [decidable_pred q]
 @[simp] lemma find_pos (h : ∃ n : ℕ, p n) : 0 < nat.find h ↔ ¬ p 0 :=
 by rw [pos_iff_ne_zero, ne, nat.find_eq_zero]
 
-
-
 lemma find_add {hₘ : ∃ m, p (m + n)} {hₙ : ∃ n, p n} (hn : n ≤ nat.find hₙ) :
   nat.find hₘ + n = nat.find hₙ :=
 begin
@@ -519,47 +521,47 @@ begin
     exact find_le hpm }
 end
 
-
 end find
 
 /-! ### `find_greatest` -/
+
 section find_greatest
 
-variables {P Q : ℕ → Prop} [decidable_pred P] {b : ℕ}
+variables {P Q : ℕ → Prop} [decidable_pred P]
 
 lemma find_greatest_eq_iff :
-  nat.find_greatest P b = m ↔ m ≤ b ∧ (m ≠ 0 → P m) ∧ (∀ ⦃n⦄, m < n → n ≤ b → ¬P n) :=
+  nat.find_greatest P k = m ↔ m ≤ k ∧ (m ≠ 0 → P m) ∧ (∀ ⦃n⦄, m < n → n ≤ k → ¬P n) :=
 begin
-  induction b with b ihb generalizing m,
+  induction k with k ihk generalizing m,
   { rw [eq_comm, iff.comm],
     simp only [nonpos_iff_eq_zero, ne.def, and_iff_left_iff_imp, find_greatest_zero],
     rintro rfl,
     exact ⟨λ h, (h rfl).elim, λ n hlt heq, (hlt.ne heq.symm).elim⟩ },
-  { by_cases hb : P (b + 1),
-    { rw [find_greatest_eq hb], split,
+  { by_cases hk : P (k + 1),
+    { rw [find_greatest_eq hk], split,
       { rintro rfl,
-        exact ⟨le_rfl, λ _, hb, λ n hlt hle, (hlt.not_le hle).elim⟩ },
+        exact ⟨le_rfl, λ _, hk, λ n hlt hle, (hlt.not_le hle).elim⟩ },
       { rintros ⟨hle, h0, hm⟩,
         rcases decidable.eq_or_lt_of_le hle with rfl|hlt,
-        exacts [rfl, (hm hlt le_rfl hb).elim] } },
-    { rw [find_greatest_of_not hb, ihb],
+        exacts [rfl, (hm hlt le_rfl hk).elim] } },
+    { rw [find_greatest_of_not hk, ihk],
       split,
       { rintros ⟨hle, hP, hm⟩,
-        refine ⟨hle.trans b.le_succ, hP, λ n hlt hle, _⟩,
+        refine ⟨hle.trans k.le_succ, hP, λ n hlt hle, _⟩,
         rcases decidable.eq_or_lt_of_le hle with rfl|hlt',
-        exacts [hb, hm hlt $ lt_succ_iff.1 hlt'] },
+        exacts [hk, hm hlt $ lt_succ_iff.1 hlt'] },
       { rintros ⟨hle, hP, hm⟩,
-        refine ⟨lt_succ_iff.1 (hle.lt_of_ne _), hP, λ n hlt hle, hm hlt (hle.trans b.le_succ)⟩,
+        refine ⟨lt_succ_iff.1 (hle.lt_of_ne _), hP, λ n hlt hle, hm hlt (hle.trans k.le_succ)⟩,
         rintro rfl,
-        exact hb (hP b.succ_ne_zero) } } }
+        exact hk (hP k.succ_ne_zero) } } }
 end
 
-lemma find_greatest_eq_zero_iff : nat.find_greatest P b = 0 ↔ ∀ ⦃n⦄, 0 < n → n ≤ b → ¬P n :=
+lemma find_greatest_eq_zero_iff : nat.find_greatest P k = 0 ↔ ∀ ⦃n⦄, 0 < n → n ≤ k → ¬P n :=
 by simp [find_greatest_eq_iff]
 
-lemma find_greatest_spec (hmb : m ≤ b) (hm : P m) : P (nat.find_greatest P b) :=
+lemma find_greatest_spec (hmb : m ≤ n) (hm : P m) : P (nat.find_greatest P n) :=
 begin
-  by_cases h : nat.find_greatest P b = 0,
+  by_cases h : nat.find_greatest P n = 0,
   { cases m, { rwa h },
     exact ((find_greatest_eq_zero_iff.1 h) m.zero_lt_succ hmb hm).elim },
   { exact (find_greatest_eq_iff.1 rfl).2.1 h }
@@ -567,7 +569,7 @@ end
 
 lemma find_greatest_le (n : ℕ) : nat.find_greatest P n ≤ n := (find_greatest_eq_iff.1 rfl).1
 
-lemma le_find_greatest (hmb : m ≤ b) (hm : P m) : m ≤ nat.find_greatest P b :=
+lemma le_find_greatest (hmb : m ≤ n) (hm : P m) : m ≤ nat.find_greatest P n :=
 le_of_not_lt $ λ hlt, (find_greatest_eq_iff.1 rfl).2.2 hlt hmb hm
 
 lemma find_greatest_mono_right (P : ℕ → Prop) [decidable_pred P] : monotone (nat.find_greatest P) :=
@@ -591,58 +593,55 @@ begin
     exact hn.trans (nat.find_greatest_mono_right _ $ le_succ _) }
 end
 
-lemma find_greatest_mono {a b : ℕ} [decidable_pred Q] (hPQ : P ≤ Q) (hab : a ≤ b) :
-  nat.find_greatest P a ≤ nat.find_greatest Q b :=
-(nat.find_greatest_mono_right _ hab).trans $ find_greatest_mono_left hPQ _
+lemma find_greatest_mono [decidable_pred Q] (hPQ : P ≤ Q) (hmn : m ≤ n) :
+  nat.find_greatest P m ≤ nat.find_greatest Q n :=
+(nat.find_greatest_mono_right _ hmn).trans $ find_greatest_mono_left hPQ _
 
-lemma find_greatest_is_greatest (hk : nat.find_greatest P b < k) (hkb : k ≤ b) : ¬ P k :=
+lemma find_greatest_is_greatest (hk : nat.find_greatest P n < k) (hkb : k ≤ n) : ¬ P k :=
 (find_greatest_eq_iff.1 rfl).2.2 hk hkb
 
-lemma find_greatest_of_ne_zero (h : nat.find_greatest P b = m) (h0 : m ≠ 0) : P m :=
+lemma find_greatest_of_ne_zero (h : nat.find_greatest P n = m) (h0 : m ≠ 0) : P m :=
 (find_greatest_eq_iff.1 h).2.1 h0
 
 end find_greatest
 
 /-! ### `bit0` and `bit1` -/
 
+protected theorem bit0_le {n m : ℕ} (h : n ≤ m) : bit0 n ≤ bit0 m := add_le_add h h
 
-protected theorem bit0_le {n m : ℕ} (h : n ≤ m) : bit0 n ≤ bit0 m :=
-add_le_add h h
-
-protected theorem bit1_le {n m : ℕ} (h : n ≤ m) : bit1 n ≤ bit1 m :=
-succ_le_succ (add_le_add h h)
+protected theorem bit1_le {n m : ℕ} (h : n ≤ m) : bit1 n ≤ bit1 m := succ_le_succ (add_le_add h h)
 
-theorem bit_le : ∀ (b : bool) {n m : ℕ}, n ≤ m → bit b n ≤ bit b m
-| tt n m h := nat.bit1_le h
-| ff n m h := nat.bit0_le h
+theorem bit_le : ∀ (b : bool) {m n : ℕ}, m ≤ n → bit b m ≤ bit b n
+| tt _ _ h := nat.bit1_le h
+| ff _ _ h := nat.bit0_le h
 
 theorem bit0_le_bit : ∀ (b) {m n : ℕ}, m ≤ n → bit0 m ≤ bit b n
-| tt m n h := le_of_lt $ nat.bit0_lt_bit1 h
-| ff m n h := nat.bit0_le h
+| tt _ _ h := le_of_lt $ nat.bit0_lt_bit1 h
+| ff _ _ h := nat.bit0_le h
 
 theorem bit_le_bit1 : ∀ (b) {m n : ℕ}, m ≤ n → bit b m ≤ bit1 n
-| ff m n h := le_of_lt $ nat.bit0_lt_bit1 h
-| tt m n h := nat.bit1_le h
+| ff _ _ h := le_of_lt $ nat.bit0_lt_bit1 h
+| tt _ _ h := nat.bit1_le h
 
-theorem bit_lt_bit0 : ∀ (b) {n m : ℕ}, n < m → bit b n < bit0 m
-| tt n m h := nat.bit1_lt_bit0 h
-| ff n m h := nat.bit0_lt h
+theorem bit_lt_bit0 : ∀ (b) {m n : ℕ}, m < n → bit b m < bit0 n
+| tt _ _ h := nat.bit1_lt_bit0 h
+| ff _ _ h := nat.bit0_lt h
 
-theorem bit_lt_bit (a b) {n m : ℕ} (h : n < m) : bit a n < bit b m :=
+theorem bit_lt_bit (a b) (h : m < n) : bit a m < bit b n :=
 lt_of_lt_of_le (bit_lt_bit0 _ h) (bit0_le_bit _ le_rfl)
 
-@[simp] lemma bit0_le_bit1_iff : bit0 k ≤ bit1 n ↔ k ≤ n :=
+@[simp] lemma bit0_le_bit1_iff : bit0 m ≤ bit1 n ↔ m ≤ n :=
 ⟨λ h, by rwa [← nat.lt_succ_iff, n.bit1_eq_succ_bit0, ← n.bit0_succ_eq,
   bit0_lt_bit0, nat.lt_succ_iff] at h, λ h, le_of_lt (nat.bit0_lt_bit1 h)⟩
 
-@[simp] lemma bit0_lt_bit1_iff : bit0 k < bit1 n ↔ k ≤ n :=
+@[simp] lemma bit0_lt_bit1_iff : bit0 m < bit1 n ↔ m ≤ n :=
 ⟨λ h, bit0_le_bit1_iff.1 (le_of_lt h), nat.bit0_lt_bit1⟩
 
-@[simp] lemma bit1_le_bit0_iff : bit1 k ≤ bit0 n ↔ k < n :=
-⟨λ h, by rwa [k.bit1_eq_succ_bit0, succ_le_iff, bit0_lt_bit0] at h,
+@[simp] lemma bit1_le_bit0_iff : bit1 m ≤ bit0 n ↔ m < n :=
+⟨λ h, by rwa [m.bit1_eq_succ_bit0, succ_le_iff, bit0_lt_bit0] at h,
   λ h, le_of_lt (nat.bit1_lt_bit0 h)⟩
 
-@[simp] lemma bit1_lt_bit0_iff : bit1 k < bit0 n ↔ k < n :=
+@[simp] lemma bit1_lt_bit0_iff : bit1 m < bit0 n ↔ m < n :=
 ⟨λ h, bit1_le_bit0_iff.1 (le_of_lt h), nat.bit1_lt_bit0⟩
 
 @[simp] lemma one_le_bit0_iff : 1 ≤ bit0 n ↔ 0 < n :=
@@ -651,15 +650,15 @@ by { convert bit1_le_bit0_iff, refl, }
 @[simp] lemma one_lt_bit0_iff : 1 < bit0 n ↔ 1 ≤ n :=
 by { convert bit1_lt_bit0_iff, refl, }
 
-@[simp] lemma bit_le_bit_iff : ∀ {b : bool}, bit b k ≤ bit b n ↔ k ≤ n
+@[simp] lemma bit_le_bit_iff : ∀ {b : bool}, bit b m ≤ bit b n ↔ m ≤ n
 | ff := bit0_le_bit0
 | tt := bit1_le_bit1
 
-@[simp] lemma bit_lt_bit_iff : ∀ {b : bool}, bit b k < bit b n ↔ k < n
+@[simp] lemma bit_lt_bit_iff : ∀ {b : bool}, bit b m < bit b n ↔ m < n
 | ff := bit0_lt_bit0
 | tt := bit1_lt_bit1
 
-@[simp] lemma bit_le_bit1_iff : ∀ {b : bool}, bit b k ≤ bit1 n ↔ k ≤ n
+@[simp] lemma bit_le_bit1_iff : ∀ {b : bool}, bit b m ≤ bit1 n ↔ m ≤ n
 | ff := bit0_le_bit1_iff
 | tt := bit1_le_bit1
 
diff --git a/src/data/nat/parity.lean b/src/data/nat/parity.lean
index 02800e885ca39..88b1ee8dcdd8e 100644
--- a/src/data/nat/parity.lean
+++ b/src/data/nat/parity.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Benjamin Davidson
 -/
 import data.nat.modeq
-import data.nat.prime
+import data.nat.factors
 import algebra.parity
 
 /-!
@@ -79,6 +79,16 @@ even_iff_two_dvd.symm.not.trans not_even_iff
 instance : decidable_pred (even : ℕ → Prop) := λ n, decidable_of_iff _ even_iff.symm
 instance : decidable_pred (odd : ℕ → Prop) := λ n, decidable_of_iff _ odd_iff_not_even.symm
 
+theorem mod_two_add_add_odd_mod_two (m : ℕ) {n : ℕ} (hn : odd n) : m % 2 + (m + n) % 2 = 1 :=
+(even_or_odd m).elim (λ hm, by rw [even_iff.1 hm, odd_iff.1 (hm.add_odd hn)]) $
+  λ hm, by rw [odd_iff.1 hm, even_iff.1 (hm.add_odd hn)]
+
+@[simp] theorem mod_two_add_succ_mod_two (m : ℕ) : m % 2 + (m + 1) % 2 = 1 :=
+mod_two_add_add_odd_mod_two m odd_one
+
+@[simp] theorem succ_mod_two_add_mod_two (m : ℕ) : (m + 1) % 2 + m % 2 = 1 :=
+by rw [add_comm, mod_two_add_succ_mod_two]
+
 mk_simp_attribute parity_simps "Simp attribute for lemmas about `even`"
 
 @[simp] theorem not_even_one : ¬ even 1 :=
diff --git a/src/data/nat/part_enat.lean b/src/data/nat/part_enat.lean
index 0cad062606f38..e0407a6320836 100644
--- a/src/data/nat/part_enat.lean
+++ b/src/data/nat/part_enat.lean
@@ -5,7 +5,7 @@ Authors: Chris Hughes
 -/
 import algebra.hom.equiv.basic
 import data.part
-import data.enat.basic
+import data.enat.lattice
 import tactic.norm_num
 
 /-!
@@ -219,8 +219,7 @@ begin
   refl,
 end
 
-protected lemma zero_lt_one : (0 : part_enat) < 1 :=
-by { norm_cast, norm_num }
+instance ne_zero.one : ne_zero (1 : part_enat) := ⟨coe_inj.not.mpr dec_trivial⟩
 
 instance semilattice_sup : semilattice_sup part_enat :=
 { sup := (⊔),
diff --git a/src/data/nat/prime.lean b/src/data/nat/prime.lean
index 7a0f317319883..de9e265131102 100644
--- a/src/data/nat/prime.lean
+++ b/src/data/nat/prime.lean
@@ -3,15 +3,16 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro
 -/
-import data.list.prime
-import data.list.sort
-import data.nat.gcd.basic
-import data.nat.order.lemmas
-import data.int.units
-import data.set.finite
+
+import algebra.associated
 import algebra.parity
+import data.int.dvd.basic
+import data.int.units
+import data.nat.factorial.basic
+import data.nat.gcd.basic
 import data.nat.sqrt
-import tactic.norm_num
+import order.bounds.basic
+import tactic.by_contra
 
 /-!
 # Prime numbers
@@ -24,9 +25,8 @@ This file deals with prime numbers: natural numbers `p ≥ 2` whose only divisor
 - `nat.primes`: the subtype of natural numbers that are prime
 - `nat.min_fac n`: the minimal prime factor of a natural number `n ≠ 1`
 - `nat.exists_infinite_primes`: Euclid's theorem that there exist infinitely many prime numbers.
-  This also appears as `nat.not_bdd_above_set_of_prime` and `nat.infinite_set_of_prime`.
-- `nat.factors n`: the prime factorization of `n`
-- `nat.factors_unique`: uniqueness of the prime factorisation
+  This also appears as `nat.not_bdd_above_set_of_prime` and `nat.infinite_set_of_prime` (the latter
+  in `data.nat.prime_fin`).
 - `nat.prime_iff`: `nat.prime` coincides with the general definition of `prime`
 - `nat.irreducible_iff_prime`: a non-unit natural number is only divisible by `1` iff it is prime
 
@@ -145,6 +145,7 @@ def decidable_prime_1 (p : ℕ) : decidable (prime p) :=
 decidable_of_iff' _ prime_def_lt'
 
 theorem prime_two : prime 2 := dec_trivial
+theorem prime_three : prime 3 := dec_trivial
 
 lemma prime.five_le_of_ne_two_of_ne_three {p : ℕ} (hp : p.prime) (h_two : p ≠ 2) (h_three : p ≠ 3) :
   5 ≤ p :=
@@ -422,10 +423,6 @@ begin
   exact ⟨p, hp, hi⟩,
 end
 
-/-- A version of `nat.exists_infinite_primes` using the `set.infinite` predicate. -/
-lemma infinite_set_of_prime : {p | prime p}.infinite :=
-set.infinite_of_not_bdd_above not_bdd_above_set_of_prime
-
 lemma prime.eq_two_or_odd {p : ℕ} (hp : prime p) : p = 2 ∨ p % 2 = 1 :=
 p.mod_two_eq_zero_or_one.imp_left
   (λ h, ((hp.eq_one_or_self_of_dvd 2 (dvd_of_mod_eq_zero h)).resolve_left dec_trivial).symm)
@@ -463,92 +460,6 @@ coprime_of_dvd $ λk kp km kn, not_le_of_gt kp.one_lt $ le_of_dvd zero_lt_one $
 theorem factors_lemma {k} : (k+2) / min_fac (k+2) < k+2 :=
 div_lt_self dec_trivial (min_fac_prime dec_trivial).one_lt
 
-/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/
-def factors : ℕ → list ℕ
-| 0 := []
-| 1 := []
-| n@(k+2) :=
-  let m := min_fac n in have n / m < n := factors_lemma,
-  m :: factors (n / m)
-
-@[simp] lemma factors_zero : factors 0 = [] := by rw factors
-@[simp] lemma factors_one : factors 1 = [] := by rw factors
-
-lemma prime_of_mem_factors : ∀ {n p}, p ∈ factors n → prime p
-| 0       := by simp
-| 1       := by simp
-| n@(k+2) := λ p h,
-  let m := min_fac n in have n / m < n := factors_lemma,
-  have h₁ : p = m ∨ p ∈ (factors (n / m)) :=
-    (list.mem_cons_iff _ _ _).1 (by rwa [factors] at h),
-  or.cases_on h₁ (λ h₂, h₂.symm ▸ min_fac_prime dec_trivial)
-    prime_of_mem_factors
-
-lemma pos_of_mem_factors {n p : ℕ} (h : p ∈ factors n) : 0 < p :=
-prime.pos (prime_of_mem_factors h)
-
-lemma prod_factors : ∀ {n}, n ≠ 0 → list.prod (factors n) = n
-| 0       := by simp
-| 1       := by simp
-| n@(k+2) := λ h,
-  let m := min_fac n in have n / m < n := factors_lemma,
-  show (factors n).prod = n, from
-  have h₁ : n / m ≠ 0 := λ h,
-    have n = 0 * m := (nat.div_eq_iff_eq_mul_left (min_fac_pos _) (min_fac_dvd _)).1 h,
-    by rw zero_mul at this; exact (show k + 2 ≠ 0, from dec_trivial) this,
-  by rw [factors, list.prod_cons, prod_factors h₁, nat.mul_div_cancel' (min_fac_dvd _)]
-
-lemma factors_prime {p : ℕ} (hp : nat.prime p) : p.factors = [p] :=
-begin
-  have : p = (p - 2) + 2 := (tsub_eq_iff_eq_add_of_le hp.two_le).mp rfl,
-  rw [this, nat.factors],
-  simp only [eq.symm this],
-  have : nat.min_fac p = p := (nat.prime_def_min_fac.mp hp).2,
-  split,
-  { exact this, },
-  { simp only [this, nat.factors, nat.div_self (nat.prime.pos hp)], },
-end
-
-lemma factors_chain : ∀ {n a}, (∀ p, prime p → p ∣ n → a ≤ p) → list.chain (≤) a (factors n)
-| 0       := λ a h, by simp
-| 1       := λ a h, by simp
-| n@(k+2) := λ a h,
-  let m := min_fac n in have n / m < n := factors_lemma,
-  begin
-    rw factors,
-    refine list.chain.cons ((le_min_fac.2 h).resolve_left dec_trivial) (factors_chain _),
-    exact λ p pp d, min_fac_le_of_dvd pp.two_le (d.trans $ div_dvd_of_dvd $ min_fac_dvd _),
-  end
-
-lemma factors_chain_2 (n) : list.chain (≤) 2 (factors n) := factors_chain $ λ p pp _, pp.two_le
-
-lemma factors_chain' (n) : list.chain' (≤) (factors n) :=
-@list.chain'.tail _ _ (_::_) (factors_chain_2 _)
-
-lemma factors_sorted (n : ℕ) : list.sorted (≤) (factors n) :=
-list.chain'_iff_pairwise.1 (factors_chain' _)
-
-/-- `factors` can be constructed inductively by extracting `min_fac`, for sufficiently large `n`. -/
-lemma factors_add_two (n : ℕ) :
-  factors (n+2) = min_fac (n+2) :: factors ((n+2) / min_fac (n+2)) :=
-by rw factors
-
-@[simp]
-lemma factors_eq_nil (n : ℕ) : n.factors = [] ↔ n = 0 ∨ n = 1 :=
-begin
-  split; intro h,
-  { rcases n with (_ | _ | n),
-    { exact or.inl rfl },
-    { exact or.inr rfl },
-    { rw factors at h, injection h }, },
-  { rcases h with (rfl | rfl),
-    { exact factors_zero },
-    { exact factors_one }, }
-end
-
-lemma eq_of_perm_factors {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) (h : a.factors ~ b.factors) : a = b :=
-by simpa [prod_factors ha, prod_factors hb] using list.perm.prod_eq h
-
 theorem prime.coprime_iff_not_dvd {p n : ℕ} (pp : prime p) : coprime p n ↔ ¬ p ∣ n :=
 ⟨λ co d, pp.not_dvd_one $ co.dvd_of_dvd_mul_left (by simp [d]),
  λ nd, coprime_of_dvd $ λ m m2 mp, ((prime_dvd_prime_iff_eq m2 pp).1 mp).symm ▸ nd⟩
@@ -632,8 +543,15 @@ lemma prime.mul_eq_prime_sq_iff {x y p : ℕ} (hp : p.prime) (hx : x ≠ 1) (hy
   x * y = p ^ 2 ↔ x = p ∧ y = p :=
 ⟨λ h, have pdvdxy : p ∣ x * y, by rw h; simp [sq],
 begin
-  wlog := hp.dvd_mul.1 pdvdxy using x y,
-  cases case with a ha,
+  -- Could be `wlog := hp.dvd_mul.1 pdvdxy using x y`, but that imports more than we want.
+  suffices : ∀ (x' y' : ℕ), x' ≠ 1 → y' ≠ 1 → x' * y' = p ^ 2 → p ∣ x' → x' = p ∧ y' = p,
+  { obtain hx|hy := hp.dvd_mul.1 pdvdxy;
+      [skip, rw and_comm];
+      [skip, rw mul_comm at h pdvdxy];
+      apply this;
+      assumption },
+  clear_dependent x y,
+  rintros x y hx hy h ⟨a, ha⟩,
   have hap : a ∣ p, from ⟨y, by rwa [ha, sq,
         mul_assoc, mul_right_inj' hp.ne_zero, eq_comm] at h⟩,
   exact ((nat.dvd_prime hp).1 hap).elim
@@ -710,127 +628,6 @@ end
 lemma eq_one_iff_not_exists_prime_dvd {n : ℕ} : n = 1 ↔ ∀ p : ℕ, p.prime → ¬p ∣ n :=
 by simpa using not_iff_not.mpr ne_one_iff_exists_prime_dvd
 
-section
-open list
-
-lemma mem_factors_iff_dvd {n p : ℕ} (hn : n ≠ 0) (hp : prime p) : p ∈ factors n ↔ p ∣ n :=
-⟨λ h, prod_factors hn ▸ list.dvd_prod h,
-  λ h, mem_list_primes_of_dvd_prod
-    (prime_iff.mp hp)
-    (λ p h, prime_iff.mp (prime_of_mem_factors h))
-    ((prod_factors hn).symm ▸ h)⟩
-
-lemma dvd_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ∣ n :=
-begin
-  rcases n.eq_zero_or_pos with rfl | hn,
-  { exact dvd_zero p },
-  { rwa ←mem_factors_iff_dvd hn.ne' (prime_of_mem_factors h) }
-end
-
-lemma mem_factors {n p} (hn : n ≠ 0) : p ∈ factors n ↔ prime p ∧ p ∣ n :=
-⟨λ h, ⟨prime_of_mem_factors h, dvd_of_mem_factors h⟩,
- λ ⟨hprime, hdvd⟩, (mem_factors_iff_dvd hn hprime).mpr hdvd⟩
-
-lemma le_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ≤ n :=
-begin
-  rcases n.eq_zero_or_pos with rfl | hn,
-  { rw factors_zero at h, cases h },
-  { exact le_of_dvd hn (dvd_of_mem_factors h) },
-end
-
-/-- **Fundamental theorem of arithmetic**-/
-lemma factors_unique {n : ℕ} {l : list ℕ} (h₁ : prod l = n) (h₂ : ∀ p ∈ l, prime p) :
-  l ~ factors n :=
-begin
-  refine perm_of_prod_eq_prod _ _ _,
-  { rw h₁,
-    refine (prod_factors _).symm,
-    rintro rfl,
-    rw prod_eq_zero_iff at h₁,
-    exact prime.ne_zero (h₂ 0 h₁) rfl },
-  { simp_rw ←prime_iff, exact h₂ },
-  { simp_rw ←prime_iff, exact (λ p, prime_of_mem_factors) },
-end
-
-lemma prime.factors_pow {p : ℕ} (hp : p.prime) (n : ℕ) :
-  (p ^ n).factors = list.repeat p n :=
-begin
-  symmetry,
-  rw ← list.repeat_perm,
-  apply nat.factors_unique (list.prod_repeat p n),
-  intros q hq,
-  rwa eq_of_mem_repeat hq,
-end
-
-lemma eq_prime_pow_of_unique_prime_dvd {n p : ℕ} (hpos : n ≠ 0)
-  (h : ∀ {d}, nat.prime d → d ∣ n → d = p) :
-  n = p ^ n.factors.length :=
-begin
-  set k := n.factors.length,
-  rw [←prod_factors hpos, ←prod_repeat p k,
-    eq_repeat_of_mem (λ d hd, h (prime_of_mem_factors hd) (dvd_of_mem_factors hd))],
-end
-
-/-- For positive `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
-lemma perm_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
-  (a * b).factors ~ a.factors ++ b.factors :=
-begin
-  refine (factors_unique _ _).symm,
-  { rw [list.prod_append, prod_factors ha, prod_factors hb] },
-  { intros p hp,
-    rw list.mem_append at hp,
-    cases hp;
-    exact prime_of_mem_factors hp },
-end
-
-/-- For coprime `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
-lemma perm_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) :
-  (a * b).factors ~ a.factors ++ b.factors :=
-begin
-  rcases a.eq_zero_or_pos with rfl | ha,
-  { simp [(coprime_zero_left _).mp hab] },
-  rcases b.eq_zero_or_pos with rfl | hb,
-  { simp [(coprime_zero_right _).mp hab] },
-  exact perm_factors_mul ha.ne' hb.ne',
-end
-
-lemma factors_sublist_right {n k : ℕ} (h : k ≠ 0) : n.factors <+ (n * k).factors :=
-begin
-  cases n,
-  { rw zero_mul },
-  apply sublist_of_subperm_of_sorted _ (factors_sorted _) (factors_sorted _),
-  rw (perm_factors_mul n.succ_ne_zero h).subperm_left,
-  exact (sublist_append_left _ _).subperm,
-end
-
-lemma factors_sublist_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors <+ k.factors :=
-begin
-  obtain ⟨a, rfl⟩ := h,
-  exact factors_sublist_right (right_ne_zero_of_mul h'),
-end
-
-lemma factors_subset_right {n k : ℕ} (h : k ≠ 0) : n.factors ⊆ (n * k).factors :=
-(factors_sublist_right h).subset
-
-lemma factors_subset_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors ⊆ k.factors :=
-(factors_sublist_of_dvd h h').subset
-
-lemma dvd_of_factors_subperm {a b : ℕ} (ha : a ≠ 0) (h : a.factors <+~ b.factors) : a ∣ b :=
-begin
-  rcases b.eq_zero_or_pos with rfl | hb,
-  { exact dvd_zero _ },
-  rcases a with (_|_|a),
-  { exact (ha rfl).elim },
-  { exact one_dvd _ },
-  use (b.factors.diff a.succ.succ.factors).prod,
-  nth_rewrite 0 ←nat.prod_factors ha,
-  rw [←list.prod_append,
-      list.perm.prod_eq $ list.subperm_append_diff_self_of_count_le $ list.subperm_ext_iff.mp h,
-      nat.prod_factors hb.ne']
-end
-
-end
-
 lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : prime p) {m n k l : ℕ}
       (hpm : p ^ k ∣ m) (hpn : p ^ l ∣ n) (hpmn : p ^ (k+l+1) ∣ m*n) :
       p ^ (k+1) ∣ m ∨ p ^ (l+1) ∣ n :=
@@ -874,342 +671,17 @@ instance monoid.prime_pow {α : Type*} [monoid α] : has_pow α primes := ⟨λ
 
 end nat
 
-/-! ### Primality prover -/
-
-namespace tactic
-namespace norm_num
-
-lemma is_prime_helper (n : ℕ)
-  (h₁ : 1 < n) (h₂ : nat.min_fac n = n) : nat.prime n :=
-nat.prime_def_min_fac.2 ⟨h₁, h₂⟩
-
-lemma min_fac_bit0 (n : ℕ) : nat.min_fac (bit0 n) = 2 :=
-by simp [nat.min_fac_eq, show 2 ∣ bit0 n, by simp [bit0_eq_two_mul n]]
-
-/-- A predicate representing partial progress in a proof of `min_fac`. -/
-def min_fac_helper (n k : ℕ) : Prop :=
-0 < k ∧ bit1 k ≤ nat.min_fac (bit1 n)
-
-theorem min_fac_helper.n_pos {n k : ℕ} (h : min_fac_helper n k) : 0 < n :=
-pos_iff_ne_zero.2 $ λ e,
-by rw e at h; exact not_le_of_lt (nat.bit1_lt h.1) h.2
-
-lemma min_fac_ne_bit0 {n k : ℕ} : nat.min_fac (bit1 n) ≠ bit0 k :=
-begin
-  rw bit0_eq_two_mul,
-  refine (λ e, absurd ((nat.dvd_add_iff_right _).2
-    (dvd_trans ⟨_, e⟩ (nat.min_fac_dvd _))) _); simp
-end
-
-lemma min_fac_helper_0 (n : ℕ) (h : 0 < n) : min_fac_helper n 1 :=
-begin
-  refine ⟨zero_lt_one, lt_of_le_of_ne _ min_fac_ne_bit0.symm⟩,
-  rw nat.succ_le_iff,
-  refine lt_of_le_of_ne (nat.min_fac_pos _) (λ e, nat.not_prime_one _),
-  rw e,
-  exact nat.min_fac_prime (nat.bit1_lt h).ne',
-end
-
-lemma min_fac_helper_1 {n k k' : ℕ} (e : k + 1 = k')
-  (np : nat.min_fac (bit1 n) ≠ bit1 k)
-  (h : min_fac_helper n k) : min_fac_helper n k' :=
-begin
-  rw ← e,
-  refine ⟨nat.succ_pos _,
-    (lt_of_le_of_ne (lt_of_le_of_ne _ _ : k+1+k < _)
-      min_fac_ne_bit0.symm : bit0 (k+1) < _)⟩,
-  { rw add_right_comm, exact h.2 },
-  { rw add_right_comm, exact np.symm }
-end
-
-lemma min_fac_helper_2 (n k k' : ℕ) (e : k + 1 = k')
-  (np : ¬ nat.prime (bit1 k)) (h : min_fac_helper n k) : min_fac_helper n k' :=
-begin
-  refine min_fac_helper_1 e _ h,
-  intro e₁, rw ← e₁ at np,
-  exact np (nat.min_fac_prime $ ne_of_gt $ nat.bit1_lt h.n_pos)
-end
-
-lemma min_fac_helper_3 (n k k' c : ℕ) (e : k + 1 = k')
-  (nc : bit1 n % bit1 k = c) (c0 : 0 < c)
-  (h : min_fac_helper n k) : min_fac_helper n k' :=
-begin
-  refine min_fac_helper_1 e _ h,
-  refine mt _ (ne_of_gt c0), intro e₁,
-  rw [← nc, ← nat.dvd_iff_mod_eq_zero, ← e₁],
-  apply nat.min_fac_dvd
-end
-
-lemma min_fac_helper_4 (n k : ℕ) (hd : bit1 n % bit1 k = 0)
-  (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 k :=
-by { rw ← nat.dvd_iff_mod_eq_zero at hd,
-  exact le_antisymm (nat.min_fac_le_of_dvd (nat.bit1_lt h.1) hd) h.2 }
-
-lemma min_fac_helper_5 (n k k' : ℕ) (e : bit1 k * bit1 k = k')
-  (hd : bit1 n < k') (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 n :=
-begin
-  refine (nat.prime_def_min_fac.1 (nat.prime_def_le_sqrt.2
-    ⟨nat.bit1_lt h.n_pos, _⟩)).2,
-  rw ← e at hd,
-  intros m m2 hm md,
-  have := le_trans h.2 (le_trans (nat.min_fac_le_of_dvd m2 md) hm),
-  rw nat.le_sqrt at this,
-  exact not_le_of_lt hd this
-end
-
-open _root_.norm_num
-
-/-- Given `e` a natural numeral and `d : nat` a factor of it, return `⊢ ¬ prime e`. -/
-meta def prove_non_prime (e : expr) (n d₁ : ℕ) : tactic expr :=
-do let e₁ := reflect d₁,
-  c ← mk_instance_cache `(nat),
-  (c, p₁) ← prove_lt_nat c `(1) e₁,
-  let d₂ := n / d₁, let e₂ := reflect d₂,
-  (c, e', p) ← prove_mul_nat c e₁ e₂,
-  guard (e' =ₐ e),
-  (c, p₂) ← prove_lt_nat c `(1) e₂,
-  return $ `(@nat.not_prime_mul').mk_app [e₁, e₂, e, p, p₁, p₂]
-
-/-- Given `a`,`a1 := bit1 a`, `n1` the value of `a1`, `b` and `p : min_fac_helper a b`,
-  returns `(c, ⊢ min_fac a1 = c)`. -/
-meta def prove_min_fac_aux (a a1 : expr) (n1 : ℕ) :
-  instance_cache → expr → expr → tactic (instance_cache × expr × expr)
-| ic b p := do
-  k ← b.to_nat,
-  let k1 := bit1 k,
-  let b1 := `(bit1:ℕ→ℕ).mk_app [b],
-  if n1 < k1*k1 then do
-    (ic, e', p₁) ← prove_mul_nat ic b1 b1,
-    (ic, p₂) ← prove_lt_nat ic a1 e',
-    return (ic, a1, `(min_fac_helper_5).mk_app [a, b, e', p₁, p₂, p])
-  else let d := k1.min_fac in
-  if to_bool (d < k1) then do
-    let k' := k+1, let e' := reflect k',
-    (ic, p₁) ← prove_succ ic b e',
-    p₂ ← prove_non_prime b1 k1 d,
-    prove_min_fac_aux ic e' $ `(min_fac_helper_2).mk_app [a, b, e', p₁, p₂, p]
-  else do
-    let nc := n1 % k1,
-    (ic, c, pc) ← prove_div_mod ic a1 b1 tt,
-    if nc = 0 then
-      return (ic, b1, `(min_fac_helper_4).mk_app [a, b, pc, p])
-    else do
-      (ic, p₀) ← prove_pos ic c,
-      let k' := k+1, let e' := reflect k',
-      (ic, p₁) ← prove_succ ic b e',
-      prove_min_fac_aux ic e' $ `(min_fac_helper_3).mk_app [a, b, e', c, p₁, pc, p₀, p]
-
-/-- Given `a` a natural numeral, returns `(b, ⊢ min_fac a = b)`. -/
-meta def prove_min_fac (ic : instance_cache) (e : expr) : tactic (instance_cache × expr × expr) :=
-match match_numeral e with
-| match_numeral_result.zero := return (ic, `(2:ℕ), `(nat.min_fac_zero))
-| match_numeral_result.one := return (ic, `(1:ℕ), `(nat.min_fac_one))
-| match_numeral_result.bit0 e := return (ic, `(2), `(min_fac_bit0).mk_app [e])
-| match_numeral_result.bit1 e := do
-  n ← e.to_nat,
-  c ← mk_instance_cache `(nat),
-  (c, p) ← prove_pos c e,
-  let a1 := `(bit1:ℕ→ℕ).mk_app [e],
-  prove_min_fac_aux e a1 (bit1 n) c `(1) (`(min_fac_helper_0).mk_app [e, p])
-| _ := failed
-end
-
-/-- A partial proof of `factors`. Asserts that `l` is a sorted list of primes, lower bounded by a
-prime `p`, which multiplies to `n`. -/
-def factors_helper (n p : ℕ) (l : list ℕ) : Prop :=
-p.prime → list.chain (≤) p l ∧ (∀ a ∈ l, nat.prime a) ∧ list.prod l = n
-
-lemma factors_helper_nil (a : ℕ) : factors_helper 1 a [] :=
-λ pa, ⟨list.chain.nil, by rintro _ ⟨⟩, list.prod_nil⟩
-
-lemma factors_helper_cons' (n m a b : ℕ) (l : list ℕ)
-  (h₁ : b * m = n) (h₂ : a ≤ b) (h₃ : nat.min_fac b = b)
-  (H : factors_helper m b l) : factors_helper n a (b :: l) :=
-λ pa,
-  have pb : b.prime, from nat.prime_def_min_fac.2 ⟨le_trans pa.two_le h₂, h₃⟩,
-  let ⟨f₁, f₂, f₃⟩ := H pb in
-  ⟨list.chain.cons h₂ f₁, λ c h, h.elim (λ e, e.symm ▸ pb) (f₂ _),
-   by rw [list.prod_cons, f₃, h₁]⟩
-
-lemma factors_helper_cons (n m a b : ℕ) (l : list ℕ)
-  (h₁ : b * m = n) (h₂ : a < b) (h₃ : nat.min_fac b = b)
-  (H : factors_helper m b l) : factors_helper n a (b :: l) :=
-factors_helper_cons' _ _ _ _ _ h₁ h₂.le h₃ H
-
-lemma factors_helper_sn (n a : ℕ) (h₁ : a < n) (h₂ : nat.min_fac n = n) : factors_helper n a [n] :=
-factors_helper_cons _ _ _ _ _ (mul_one _) h₁ h₂ (factors_helper_nil _)
-
-lemma factors_helper_same (n m a : ℕ) (l : list ℕ) (h : a * m = n)
-  (H : factors_helper m a l) : factors_helper n a (a :: l) :=
-λ pa, factors_helper_cons' _ _ _ _ _ h le_rfl (nat.prime_def_min_fac.1 pa).2 H pa
-
-lemma factors_helper_same_sn (a : ℕ) : factors_helper a a [a] :=
-factors_helper_same _ _ _ _ (mul_one _) (factors_helper_nil _)
-
-lemma factors_helper_end (n : ℕ) (l : list ℕ) (H : factors_helper n 2 l) : nat.factors n = l :=
-let ⟨h₁, h₂, h₃⟩ := H nat.prime_two in
-have _, from list.chain'_iff_pairwise.1 (@list.chain'.tail _ _ (_::_) h₁),
-(list.eq_of_perm_of_sorted (nat.factors_unique h₃ h₂) this (nat.factors_sorted _)).symm
-
-/-- Given `n` and `a` natural numerals, returns `(l, ⊢ factors_helper n a l)`. -/
-meta def prove_factors_aux :
-  instance_cache → expr → expr → ℕ → ℕ → tactic (instance_cache × expr × expr)
-| c en ea n a :=
-  let b := n.min_fac in
-  if b < n then do
-    let m := n / b,
-    (c, em) ← c.of_nat m,
-    if b = a then do
-      (c, _, p₁) ← prove_mul_nat c ea em,
-      (c, l, p₂) ← prove_factors_aux c em ea m a,
-      pure (c, `(%%ea::%%l:list ℕ), `(factors_helper_same).mk_app [en, em, ea, l, p₁, p₂])
-    else do
-      (c, eb) ← c.of_nat b,
-      (c, _, p₁) ← prove_mul_nat c eb em,
-      (c, p₂) ← prove_lt_nat c ea eb,
-      (c, _, p₃) ← prove_min_fac c eb,
-      (c, l, p₄) ← prove_factors_aux c em eb m b,
-      pure (c, `(%%eb::%%l : list ℕ),
-        `(factors_helper_cons).mk_app [en, em, ea, eb, l, p₁, p₂, p₃, p₄])
-  else if b = a then
-    pure (c, `([%%ea] : list ℕ), `(factors_helper_same_sn).mk_app [ea])
-  else do
-    (c, p₁) ← prove_lt_nat c ea en,
-    (c, _, p₂) ← prove_min_fac c en,
-    pure (c, `([%%en] : list ℕ), `(factors_helper_sn).mk_app [en, ea, p₁, p₂])
-
-/-- Evaluates the `prime` and `min_fac` functions. -/
-@[norm_num] meta def eval_prime : expr → tactic (expr × expr)
-| `(nat.prime %%e) := do
-  n ← e.to_nat,
-  match n with
-  | 0 := false_intro `(nat.not_prime_zero)
-  | 1 := false_intro `(nat.not_prime_one)
-  | _ := let d₁ := n.min_fac in
-    if d₁ < n then prove_non_prime e n d₁ >>= false_intro
-    else do
-      let e₁ := reflect d₁,
-      c ← mk_instance_cache `(ℕ),
-      (c, p₁) ← prove_lt_nat c `(1) e₁,
-      (c, e₁, p) ← prove_min_fac c e,
-      true_intro $ `(is_prime_helper).mk_app [e, p₁, p]
-  end
-| `(nat.min_fac %%e) := do
-  ic ← mk_instance_cache `(ℕ),
-  prod.snd <$> prove_min_fac ic e
-| `(nat.factors %%e) := do
-  n ← e.to_nat,
-  match n with
-  | 0 := pure (`(@list.nil ℕ), `(nat.factors_zero))
-  | 1 := pure (`(@list.nil ℕ), `(nat.factors_one))
-  | _ := do
-    c ← mk_instance_cache `(ℕ),
-    (c, l, p) ← prove_factors_aux c e `(2) n 2,
-    pure (l, `(factors_helper_end).mk_app [e, l, p])
-  end
-| _ := failed
-
-end norm_num
-end tactic
-
 namespace nat
 
-theorem prime_three : prime 3 := by norm_num
-
 instance fact_prime_two : fact (prime 2) := ⟨prime_two⟩
 
 instance fact_prime_three : fact (prime 3) := ⟨prime_three⟩
 
 end nat
 
-
-namespace nat
-
-lemma mem_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) {p : ℕ} :
-  p ∈ (a * b).factors ↔ p ∈ a.factors ∨ p ∈ b.factors :=
-begin
-  rw [mem_factors (mul_ne_zero ha hb), mem_factors ha, mem_factors hb, ←and_or_distrib_left],
-  simpa only [and.congr_right_iff] using prime.dvd_mul
-end
-
-/-- If `a`, `b` are positive, the prime divisors of `a * b` are the union of those of `a` and `b` -/
-lemma factors_mul_to_finset {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
-  (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset :=
-(list.to_finset.ext $ λ x, (mem_factors_mul ha hb).trans list.mem_union.symm).trans $
-  list.to_finset_union _ _
-
-lemma pow_succ_factors_to_finset (n k : ℕ) :
-  (n^(k+1)).factors.to_finset = n.factors.to_finset :=
-begin
-  rcases eq_or_ne n 0 with rfl | hn,
-  { simp },
-  induction k with k ih,
-  { simp },
-  rw [pow_succ, factors_mul_to_finset hn (pow_ne_zero _ hn), ih, finset.union_idempotent]
-end
-
-lemma pow_factors_to_finset (n : ℕ) {k : ℕ} (hk : k ≠ 0) :
-  (n^k).factors.to_finset = n.factors.to_finset :=
-begin
-  cases k,
-  { simpa using hk },
-  rw pow_succ_factors_to_finset
-end
-
-/-- The only prime divisor of positive prime power `p^k` is `p` itself -/
-lemma prime_pow_prime_divisor {p k : ℕ} (hk : k ≠ 0) (hp : prime p) :
-  (p^k).factors.to_finset = {p} :=
-by simp [pow_factors_to_finset p hk, factors_prime hp]
-
-/-- The sets of factors of coprime `a` and `b` are disjoint -/
-lemma coprime_factors_disjoint {a b : ℕ} (hab : a.coprime b) : list.disjoint a.factors b.factors :=
-begin
-  intros q hqa hqb,
-  apply not_prime_one,
-  rw ←(eq_one_of_dvd_coprimes hab (dvd_of_mem_factors hqa) (dvd_of_mem_factors hqb)),
-  exact prime_of_mem_factors hqa
-end
-
-lemma mem_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) (p : ℕ):
-  p ∈ (a * b).factors ↔ p ∈ a.factors ∪ b.factors :=
-begin
-  rcases a.eq_zero_or_pos with rfl | ha,
-  { simp [(coprime_zero_left _).mp hab] },
-  rcases b.eq_zero_or_pos with rfl | hb,
-  { simp [(coprime_zero_right _).mp hab] },
-  rw [mem_factors_mul ha.ne' hb.ne', list.mem_union]
-end
-
-lemma factors_mul_to_finset_of_coprime {a b : ℕ} (hab : coprime a b) :
-  (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset :=
-(list.to_finset.ext $ mem_factors_mul_of_coprime hab).trans $ list.to_finset_union _ _
-
-open list
-
-/-- If `p` is a prime factor of `a` then `p` is also a prime factor of `a * b` for any `b > 0` -/
-lemma mem_factors_mul_left {p a b : ℕ} (hpa : p ∈ a.factors) (hb : b ≠ 0) : p ∈ (a*b).factors :=
-begin
-  rcases eq_or_ne a 0 with rfl | ha,
-  { simpa using hpa },
-  apply (mem_factors_mul ha hb).2 (or.inl hpa),
-end
-
-/-- If `p` is a prime factor of `b` then `p` is also a prime factor of `a * b` for any `a > 0` -/
-lemma mem_factors_mul_right {p a b : ℕ} (hpb : p ∈ b.factors) (ha : a ≠ 0) : p ∈ (a*b).factors :=
-by { rw mul_comm, exact mem_factors_mul_left hpb ha }
-
-lemma eq_two_pow_or_exists_odd_prime_and_dvd (n : ℕ) :
-  (∃ k : ℕ, n = 2 ^ k) ∨ ∃ p, nat.prime p ∧ p ∣ n ∧ odd p :=
-(eq_or_ne n 0).elim
-  (λ hn, (or.inr ⟨3, prime_three, hn.symm ▸ dvd_zero 3, ⟨1, rfl⟩⟩))
-  (λ hn, or_iff_not_imp_right.mpr
-    (λ H, ⟨n.factors.length, eq_prime_pow_of_unique_prime_dvd hn
-      (λ p hprime hdvd, hprime.eq_two_or_odd'.resolve_right
-        (λ hodd, H ⟨p, hprime, hdvd, hodd⟩))⟩))
-
-end nat
-
 namespace int
 lemma prime_two : prime (2 : ℤ) := nat.prime_iff_prime_int.mp nat.prime_two
 lemma prime_three : prime (3 : ℤ) := nat.prime_iff_prime_int.mp nat.prime_three
 end int
+
+assert_not_exists multiset
diff --git a/src/data/nat/prime_fin.lean b/src/data/nat/prime_fin.lean
new file mode 100644
index 0000000000000..85d8fedbc6a69
--- /dev/null
+++ b/src/data/nat/prime_fin.lean
@@ -0,0 +1,55 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro
+-/
+
+import data.nat.factors
+import data.set.finite
+
+/-!
+# Prime numbers
+
+This file contains some results about prime numbers which depend on finiteness of sets.
+-/
+
+namespace nat
+
+/-- A version of `nat.exists_infinite_primes` using the `set.infinite` predicate. -/
+lemma infinite_set_of_prime : {p | prime p}.infinite :=
+set.infinite_of_not_bdd_above not_bdd_above_set_of_prime
+
+/-- If `a`, `b` are positive, the prime divisors of `a * b` are the union of those of `a` and `b` -/
+lemma factors_mul_to_finset {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
+  (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset :=
+(list.to_finset.ext $ λ x, (mem_factors_mul ha hb).trans list.mem_union.symm).trans $
+  list.to_finset_union _ _
+
+lemma pow_succ_factors_to_finset (n k : ℕ) :
+  (n^(k+1)).factors.to_finset = n.factors.to_finset :=
+begin
+  rcases eq_or_ne n 0 with rfl | hn,
+  { simp },
+  induction k with k ih,
+  { simp },
+  rw [pow_succ, factors_mul_to_finset hn (pow_ne_zero _ hn), ih, finset.union_idempotent]
+end
+
+lemma pow_factors_to_finset (n : ℕ) {k : ℕ} (hk : k ≠ 0) :
+  (n^k).factors.to_finset = n.factors.to_finset :=
+begin
+  cases k,
+  { simpa using hk },
+  rw pow_succ_factors_to_finset
+end
+
+/-- The only prime divisor of positive prime power `p^k` is `p` itself -/
+lemma prime_pow_prime_divisor {p k : ℕ} (hk : k ≠ 0) (hp : prime p) :
+  (p^k).factors.to_finset = {p} :=
+by simp [pow_factors_to_finset p hk, factors_prime hp]
+
+lemma factors_mul_to_finset_of_coprime {a b : ℕ} (hab : coprime a b) :
+  (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset :=
+(list.to_finset.ext $ mem_factors_mul_of_coprime hab).trans $ list.to_finset_union _ _
+
+end nat
diff --git a/src/data/nat/prime_norm_num.lean b/src/data/nat/prime_norm_num.lean
new file mode 100644
index 0000000000000..a5768ccb6f6ce
--- /dev/null
+++ b/src/data/nat/prime_norm_num.lean
@@ -0,0 +1,251 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro
+-/
+import data.nat.factors
+import data.nat.prime
+import tactic.norm_num
+
+/-!
+# Primality prover
+
+This file provides a `norm_num` extention to prove that natural numbers are prime.
+
+-/
+
+namespace tactic
+namespace norm_num
+
+lemma is_prime_helper (n : ℕ)
+  (h₁ : 1 < n) (h₂ : nat.min_fac n = n) : nat.prime n :=
+nat.prime_def_min_fac.2 ⟨h₁, h₂⟩
+
+lemma min_fac_bit0 (n : ℕ) : nat.min_fac (bit0 n) = 2 :=
+by simp [nat.min_fac_eq, show 2 ∣ bit0 n, by simp [bit0_eq_two_mul n]]
+
+/-- A predicate representing partial progress in a proof of `min_fac`. -/
+def min_fac_helper (n k : ℕ) : Prop :=
+0 < k ∧ bit1 k ≤ nat.min_fac (bit1 n)
+
+theorem min_fac_helper.n_pos {n k : ℕ} (h : min_fac_helper n k) : 0 < n :=
+pos_iff_ne_zero.2 $ λ e,
+by rw e at h; exact not_le_of_lt (nat.bit1_lt h.1) h.2
+
+lemma min_fac_ne_bit0 {n k : ℕ} : nat.min_fac (bit1 n) ≠ bit0 k :=
+begin
+  rw bit0_eq_two_mul,
+  refine (λ e, absurd ((nat.dvd_add_iff_right _).2
+    (dvd_trans ⟨_, e⟩ (nat.min_fac_dvd _))) _); simp
+end
+
+lemma min_fac_helper_0 (n : ℕ) (h : 0 < n) : min_fac_helper n 1 :=
+begin
+  refine ⟨zero_lt_one, lt_of_le_of_ne _ min_fac_ne_bit0.symm⟩,
+  rw nat.succ_le_iff,
+  refine lt_of_le_of_ne (nat.min_fac_pos _) (λ e, nat.not_prime_one _),
+  rw e,
+  exact nat.min_fac_prime (nat.bit1_lt h).ne',
+end
+
+lemma min_fac_helper_1 {n k k' : ℕ} (e : k + 1 = k')
+  (np : nat.min_fac (bit1 n) ≠ bit1 k)
+  (h : min_fac_helper n k) : min_fac_helper n k' :=
+begin
+  rw ← e,
+  refine ⟨nat.succ_pos _,
+    (lt_of_le_of_ne (lt_of_le_of_ne _ _ : k+1+k < _)
+      min_fac_ne_bit0.symm : bit0 (k+1) < _)⟩,
+  { rw add_right_comm, exact h.2 },
+  { rw add_right_comm, exact np.symm }
+end
+
+lemma min_fac_helper_2 (n k k' : ℕ) (e : k + 1 = k')
+  (np : ¬ nat.prime (bit1 k)) (h : min_fac_helper n k) : min_fac_helper n k' :=
+begin
+  refine min_fac_helper_1 e _ h,
+  intro e₁, rw ← e₁ at np,
+  exact np (nat.min_fac_prime $ ne_of_gt $ nat.bit1_lt h.n_pos)
+end
+
+lemma min_fac_helper_3 (n k k' c : ℕ) (e : k + 1 = k')
+  (nc : bit1 n % bit1 k = c) (c0 : 0 < c)
+  (h : min_fac_helper n k) : min_fac_helper n k' :=
+begin
+  refine min_fac_helper_1 e _ h,
+  refine mt _ (ne_of_gt c0), intro e₁,
+  rw [← nc, ← nat.dvd_iff_mod_eq_zero, ← e₁],
+  apply nat.min_fac_dvd
+end
+
+lemma min_fac_helper_4 (n k : ℕ) (hd : bit1 n % bit1 k = 0)
+  (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 k :=
+by { rw ← nat.dvd_iff_mod_eq_zero at hd,
+  exact le_antisymm (nat.min_fac_le_of_dvd (nat.bit1_lt h.1) hd) h.2 }
+
+lemma min_fac_helper_5 (n k k' : ℕ) (e : bit1 k * bit1 k = k')
+  (hd : bit1 n < k') (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 n :=
+begin
+  refine (nat.prime_def_min_fac.1 (nat.prime_def_le_sqrt.2
+    ⟨nat.bit1_lt h.n_pos, _⟩)).2,
+  rw ← e at hd,
+  intros m m2 hm md,
+  have := le_trans h.2 (le_trans (nat.min_fac_le_of_dvd m2 md) hm),
+  rw nat.le_sqrt at this,
+  exact not_le_of_lt hd this
+end
+
+open _root_.norm_num
+
+/-- Given `e` a natural numeral and `d : nat` a factor of it, return `⊢ ¬ prime e`. -/
+meta def prove_non_prime (e : expr) (n d₁ : ℕ) : tactic expr :=
+do let e₁ := reflect d₁,
+  c ← mk_instance_cache `(nat),
+  (c, p₁) ← prove_lt_nat c `(1) e₁,
+  let d₂ := n / d₁, let e₂ := reflect d₂,
+  (c, e', p) ← prove_mul_nat c e₁ e₂,
+  guard (e' =ₐ e),
+  (c, p₂) ← prove_lt_nat c `(1) e₂,
+  return $ `(@nat.not_prime_mul').mk_app [e₁, e₂, e, p, p₁, p₂]
+
+/-- Given `a`,`a1 := bit1 a`, `n1` the value of `a1`, `b` and `p : min_fac_helper a b`,
+  returns `(c, ⊢ min_fac a1 = c)`. -/
+meta def prove_min_fac_aux (a a1 : expr) (n1 : ℕ) :
+  instance_cache → expr → expr → tactic (instance_cache × expr × expr)
+| ic b p := do
+  k ← b.to_nat,
+  let k1 := bit1 k,
+  let b1 := `(bit1:ℕ→ℕ).mk_app [b],
+  if n1 < k1*k1 then do
+    (ic, e', p₁) ← prove_mul_nat ic b1 b1,
+    (ic, p₂) ← prove_lt_nat ic a1 e',
+    return (ic, a1, `(min_fac_helper_5).mk_app [a, b, e', p₁, p₂, p])
+  else let d := k1.min_fac in
+  if to_bool (d < k1) then do
+    let k' := k+1, let e' := reflect k',
+    (ic, p₁) ← prove_succ ic b e',
+    p₂ ← prove_non_prime b1 k1 d,
+    prove_min_fac_aux ic e' $ `(min_fac_helper_2).mk_app [a, b, e', p₁, p₂, p]
+  else do
+    let nc := n1 % k1,
+    (ic, c, pc) ← prove_div_mod ic a1 b1 tt,
+    if nc = 0 then
+      return (ic, b1, `(min_fac_helper_4).mk_app [a, b, pc, p])
+    else do
+      (ic, p₀) ← prove_pos ic c,
+      let k' := k+1, let e' := reflect k',
+      (ic, p₁) ← prove_succ ic b e',
+      prove_min_fac_aux ic e' $ `(min_fac_helper_3).mk_app [a, b, e', c, p₁, pc, p₀, p]
+
+/-- Given `a` a natural numeral, returns `(b, ⊢ min_fac a = b)`. -/
+meta def prove_min_fac (ic : instance_cache) (e : expr) : tactic (instance_cache × expr × expr) :=
+match match_numeral e with
+| match_numeral_result.zero := return (ic, `(2:ℕ), `(nat.min_fac_zero))
+| match_numeral_result.one := return (ic, `(1:ℕ), `(nat.min_fac_one))
+| match_numeral_result.bit0 e := return (ic, `(2), `(min_fac_bit0).mk_app [e])
+| match_numeral_result.bit1 e := do
+  n ← e.to_nat,
+  c ← mk_instance_cache `(nat),
+  (c, p) ← prove_pos c e,
+  let a1 := `(bit1:ℕ→ℕ).mk_app [e],
+  prove_min_fac_aux e a1 (bit1 n) c `(1) (`(min_fac_helper_0).mk_app [e, p])
+| _ := failed
+end
+
+/-- A partial proof of `factors`. Asserts that `l` is a sorted list of primes, lower bounded by a
+prime `p`, which multiplies to `n`. -/
+def factors_helper (n p : ℕ) (l : list ℕ) : Prop :=
+p.prime → list.chain (≤) p l ∧ (∀ a ∈ l, nat.prime a) ∧ list.prod l = n
+
+lemma factors_helper_nil (a : ℕ) : factors_helper 1 a [] :=
+λ pa, ⟨list.chain.nil, by rintro _ ⟨⟩, list.prod_nil⟩
+
+lemma factors_helper_cons' (n m a b : ℕ) (l : list ℕ)
+  (h₁ : b * m = n) (h₂ : a ≤ b) (h₃ : nat.min_fac b = b)
+  (H : factors_helper m b l) : factors_helper n a (b :: l) :=
+λ pa,
+  have pb : b.prime, from nat.prime_def_min_fac.2 ⟨le_trans pa.two_le h₂, h₃⟩,
+  let ⟨f₁, f₂, f₃⟩ := H pb in
+  ⟨list.chain.cons h₂ f₁, λ c h, h.elim (λ e, e.symm ▸ pb) (f₂ _),
+   by rw [list.prod_cons, f₃, h₁]⟩
+
+lemma factors_helper_cons (n m a b : ℕ) (l : list ℕ)
+  (h₁ : b * m = n) (h₂ : a < b) (h₃ : nat.min_fac b = b)
+  (H : factors_helper m b l) : factors_helper n a (b :: l) :=
+factors_helper_cons' _ _ _ _ _ h₁ h₂.le h₃ H
+
+lemma factors_helper_sn (n a : ℕ) (h₁ : a < n) (h₂ : nat.min_fac n = n) : factors_helper n a [n] :=
+factors_helper_cons _ _ _ _ _ (mul_one _) h₁ h₂ (factors_helper_nil _)
+
+lemma factors_helper_same (n m a : ℕ) (l : list ℕ) (h : a * m = n)
+  (H : factors_helper m a l) : factors_helper n a (a :: l) :=
+λ pa, factors_helper_cons' _ _ _ _ _ h le_rfl (nat.prime_def_min_fac.1 pa).2 H pa
+
+lemma factors_helper_same_sn (a : ℕ) : factors_helper a a [a] :=
+factors_helper_same _ _ _ _ (mul_one _) (factors_helper_nil _)
+
+lemma factors_helper_end (n : ℕ) (l : list ℕ) (H : factors_helper n 2 l) : nat.factors n = l :=
+let ⟨h₁, h₂, h₃⟩ := H nat.prime_two in
+have _, from list.chain'_iff_pairwise.1 (@list.chain'.tail _ _ (_::_) h₁),
+(list.eq_of_perm_of_sorted (nat.factors_unique h₃ h₂) this (nat.factors_sorted _)).symm
+
+/-- Given `n` and `a` natural numerals, returns `(l, ⊢ factors_helper n a l)`. -/
+meta def prove_factors_aux :
+  instance_cache → expr → expr → ℕ → ℕ → tactic (instance_cache × expr × expr)
+| c en ea n a :=
+  let b := n.min_fac in
+  if b < n then do
+    let m := n / b,
+    (c, em) ← c.of_nat m,
+    if b = a then do
+      (c, _, p₁) ← prove_mul_nat c ea em,
+      (c, l, p₂) ← prove_factors_aux c em ea m a,
+      pure (c, `(%%ea::%%l:list ℕ), `(factors_helper_same).mk_app [en, em, ea, l, p₁, p₂])
+    else do
+      (c, eb) ← c.of_nat b,
+      (c, _, p₁) ← prove_mul_nat c eb em,
+      (c, p₂) ← prove_lt_nat c ea eb,
+      (c, _, p₃) ← prove_min_fac c eb,
+      (c, l, p₄) ← prove_factors_aux c em eb m b,
+      pure (c, `(%%eb::%%l : list ℕ),
+        `(factors_helper_cons).mk_app [en, em, ea, eb, l, p₁, p₂, p₃, p₄])
+  else if b = a then
+    pure (c, `([%%ea] : list ℕ), `(factors_helper_same_sn).mk_app [ea])
+  else do
+    (c, p₁) ← prove_lt_nat c ea en,
+    (c, _, p₂) ← prove_min_fac c en,
+    pure (c, `([%%en] : list ℕ), `(factors_helper_sn).mk_app [en, ea, p₁, p₂])
+
+/-- Evaluates the `prime` and `min_fac` functions. -/
+@[norm_num] meta def eval_prime : expr → tactic (expr × expr)
+| `(nat.prime %%e) := do
+  n ← e.to_nat,
+  match n with
+  | 0 := false_intro `(nat.not_prime_zero)
+  | 1 := false_intro `(nat.not_prime_one)
+  | _ := let d₁ := n.min_fac in
+    if d₁ < n then prove_non_prime e n d₁ >>= false_intro
+    else do
+      let e₁ := reflect d₁,
+      c ← mk_instance_cache `(ℕ),
+      (c, p₁) ← prove_lt_nat c `(1) e₁,
+      (c, e₁, p) ← prove_min_fac c e,
+      true_intro $ `(is_prime_helper).mk_app [e, p₁, p]
+  end
+| `(nat.min_fac %%e) := do
+  ic ← mk_instance_cache `(ℕ),
+  prod.snd <$> prove_min_fac ic e
+| `(nat.factors %%e) := do
+  n ← e.to_nat,
+  match n with
+  | 0 := pure (`(@list.nil ℕ), `(nat.factors_zero))
+  | 1 := pure (`(@list.nil ℕ), `(nat.factors_one))
+  | _ := do
+    c ← mk_instance_cache `(ℕ),
+    (c, l, p) ← prove_factors_aux c e `(2) n 2,
+    pure (l, `(factors_helper_end).mk_app [e, l, p])
+  end
+| _ := failed
+
+end norm_num
+end tactic
diff --git a/src/data/nat/set.lean b/src/data/nat/set.lean
index 3d64d83810525..6d372cb3be719 100644
--- a/src/data/nat/set.lean
+++ b/src/data/nat/set.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
 
-import data.set.basic
+import data.set.image
 
 /-!
 ### Recursion on the natural numbers and `set.range`
diff --git a/src/data/nat/squarefree.lean b/src/data/nat/squarefree.lean
index 0674ab65285c2..f0ab22e538b91 100644
--- a/src/data/nat/squarefree.lean
+++ b/src/data/nat/squarefree.lean
@@ -3,9 +3,10 @@ Copyright (c) 2020 Aaron Anderson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
-import ring_theory.int.basic
-import data.nat.factorization.prime_pow
 import algebra.squarefree
+import data.nat.factorization.prime_pow
+import data.nat.prime_norm_num
+import ring_theory.int.basic
 
 /-!
 # Lemmas about squarefreeness of natural numbers
diff --git a/src/data/option/n_ary.lean b/src/data/option/n_ary.lean
index 154c3832cd793..041a0f0df5a8d 100644
--- a/src/data/option/n_ary.lean
+++ b/src/data/option/n_ary.lean
@@ -21,8 +21,8 @@ on intervals.
 
 ## Notes
 
-This file is very similar to the n-ary section of `data.set.basic`, to `data.finset.n_ary` and to
-`order.filter.n_ary`. Please keep them in sync.
+This file is very similar to `data.set.n_ary`, `data.finset.n_ary` and `order.filter.n_ary`. Please
+keep them in sync.
 
 We do not define `option.map₃` as its only purpose so far would be to prove properties of
 `option.map₂` and casing already fulfills this task.
diff --git a/src/data/pnat/factors.lean b/src/data/pnat/factors.lean
index d8c054723ae71..40fd6f53fc58c 100644
--- a/src/data/pnat/factors.lean
+++ b/src/data/pnat/factors.lean
@@ -3,7 +3,10 @@ Copyright (c) 2019 Neil Strickland. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Neil Strickland
 -/
+
+import algebra.big_operators.multiset.basic
 import data.pnat.prime
+import data.nat.factors
 import data.multiset.sort
 
 /-!
diff --git a/src/data/polynomial/algebra_map.lean b/src/data/polynomial/algebra_map.lean
index 2649f23060fb9..cd83ab6081dc1 100644
--- a/src/data/polynomial/algebra_map.lean
+++ b/src/data/polynomial/algebra_map.lean
@@ -3,6 +3,7 @@ Copyright (c) 2018 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
 -/
+import algebra.algebra.pi
 import ring_theory.adjoin.basic
 import data.polynomial.eval
 
diff --git a/src/data/polynomial/coeff.lean b/src/data/polynomial/coeff.lean
index 4b0e61c61642a..d08b4e42cd584 100644
--- a/src/data/polynomial/coeff.lean
+++ b/src/data/polynomial/coeff.lean
@@ -96,11 +96,17 @@ end
 @[simp] lemma mul_coeff_zero (p q : R[X]) : coeff (p * q) 0 = coeff p 0 * coeff q 0 :=
 by simp [coeff_mul]
 
--- TODO: golf using `constant_coeff` once #17664 is merged
+/-- `constant_coeff p` returns the constant term of the polynomial `p`,
+  defined as `coeff p 0`. This is a ring homomorphism. -/
+@[simps] def constant_coeff : R[X] →+* R :=
+{ to_fun := λ p, coeff p 0,
+  map_one' := coeff_one_zero,
+  map_mul' := mul_coeff_zero,
+  map_zero' := coeff_zero 0,
+  map_add' :=  λ p q, coeff_add p q 0 }
+
 lemma is_unit_C {x : R} : is_unit (C x) ↔ is_unit x :=
-⟨by { rintros ⟨⟨q, p, hqp, hpq⟩, rfl : q = C x⟩,
-  exact ⟨⟨(C x).coeff 0, p.coeff 0, by rw [←mul_coeff_zero, hqp, coeff_one_zero],
-    by rw [←mul_coeff_zero, hpq, coeff_one_zero]⟩, coeff_C_zero⟩ }, is_unit.map C⟩
+⟨λ h, (congr_arg is_unit coeff_C_zero).mp (h.map $ @constant_coeff R _), λ h, h.map C⟩
 
 lemma coeff_mul_X_zero (p : R[X]) : coeff (p * X) 0 = 0 := by simp
 
diff --git a/src/data/polynomial/degree/definitions.lean b/src/data/polynomial/degree/definitions.lean
index 7bc648e34ead0..41c44adb355f5 100644
--- a/src/data/polynomial/degree/definitions.lean
+++ b/src/data/polynomial/degree/definitions.lean
@@ -347,12 +347,15 @@ ext (λ n, nat.cases_on n (by simp)
 lemma eq_X_add_C_of_degree_eq_one (h : degree p = 1) :
   p = C (p.leading_coeff) * X + C (p.coeff 0) :=
 (eq_X_add_C_of_degree_le_one (show degree p ≤ 1, from h ▸ le_rfl)).trans
-  (by simp [leading_coeff, nat_degree_eq_of_degree_eq_some h])
+  (by simp only [leading_coeff, nat_degree_eq_of_degree_eq_some h])
 
 lemma eq_X_add_C_of_nat_degree_le_one (h : nat_degree p ≤ 1) :
   p = C (p.coeff 1) * X + C (p.coeff 0) :=
 eq_X_add_C_of_degree_le_one $ degree_le_of_nat_degree_le h
 
+lemma monic.eq_X_add_C (hm : p.monic) (hnd : p.nat_degree = 1) : p = X + C (p.coeff 0) :=
+by rw [←one_mul X, ←C_1, ←hm.coeff_nat_degree, hnd, ←eq_X_add_C_of_nat_degree_le_one hnd.le]
+
 lemma exists_eq_X_add_C_of_nat_degree_le_one (h : nat_degree p ≤ 1) :
   ∃ a b, p = C a * X + C b :=
 ⟨p.coeff 1, p.coeff 0, eq_X_add_C_of_nat_degree_le_one h⟩
@@ -1116,6 +1119,12 @@ begin
   { exact nat_degree_eq_of_degree_eq_some (degree_X_pow_add_C (pos_iff_ne_zero.mpr hn) r) },
 end
 
+lemma X_pow_add_C_ne_one {n : ℕ} (hn : 0 < n) (a : R) : (X : R[X]) ^ n + C a ≠ 1 :=
+λ h, hn.ne' $ by simpa only [nat_degree_X_pow_add_C, nat_degree_one] using congr_arg nat_degree h
+
+theorem X_add_C_ne_one (r : R) : X + C r ≠ 1 :=
+pow_one (X : R[X]) ▸ X_pow_add_C_ne_one zero_lt_one r
+
 end semiring
 end nonzero_ring
 
diff --git a/src/data/polynomial/derivative.lean b/src/data/polynomial/derivative.lean
index 53a5ef1b144d8..d159946d9c3c8 100644
--- a/src/data/polynomial/derivative.lean
+++ b/src/data/polynomial/derivative.lean
@@ -81,10 +81,10 @@ by rw [C_mul_X_pow_eq_monomial, C_mul_X_pow_eq_monomial, derivative_monomial]
 lemma derivative_C_mul_X_sq (a : R) : derivative (C a * X ^ 2) = C (a * 2) * X :=
 by rw [derivative_C_mul_X_pow, nat.cast_two, pow_one]
 
-@[simp] lemma derivative_X_pow (n : ℕ) : derivative (X ^ n : R[X]) = (n : R[X]) * X ^ (n - 1) :=
+@[simp] lemma derivative_X_pow (n : ℕ) : derivative (X ^ n : R[X]) = C ↑n * X ^ (n - 1) :=
 by convert derivative_C_mul_X_pow (1 : R) n; simp
 
-@[simp] lemma derivative_X_sq : derivative (X ^ 2 : R[X]) = (2 : R[X]) * X :=
+@[simp] lemma derivative_X_sq : derivative (X ^ 2 : R[X]) = C 2 * X :=
 by rw [derivative_X_pow, nat.cast_two, pow_one]
 
 @[simp] lemma derivative_C {a : R} : derivative (C a) = 0 :=
@@ -105,8 +105,7 @@ by simp [bit0]
 @[simp] lemma derivative_bit1 {a : R[X]} : derivative (bit1 a) = bit0 (derivative a) :=
 by simp [bit1]
 
-@[simp] lemma derivative_add {f g : R[X]} :
-  derivative (f + g) = derivative f + derivative g :=
+@[simp] lemma derivative_add {f g : R[X]} : derivative (f + g) = derivative f + derivative g :=
 derivative.map_add f g
 
 @[simp] lemma iterate_derivative_add {f g : R[X]} {k : ℕ} :
@@ -416,17 +415,17 @@ lemma iterate_derivative_X_pow_eq_nat_cast_mul (n k : ℕ) :
 begin
   induction k with k ih,
   { rw [function.iterate_zero_apply, tsub_zero, nat.desc_factorial_zero, nat.cast_one, one_mul] },
-  { rw [function.iterate_succ_apply', ih, derivative_nat_cast_mul, derivative_X_pow,
+  { rw [function.iterate_succ_apply', ih, derivative_nat_cast_mul, derivative_X_pow, C_eq_nat_cast,
       nat.succ_eq_add_one, nat.desc_factorial_succ, nat.sub_sub, nat.cast_mul, ←mul_assoc,
       mul_comm ↑(nat.desc_factorial _ _)] },
 end
 
 lemma iterate_derivative_X_pow_eq_C_mul (n k : ℕ) :
-  (derivative^[k] (X^n : R[X])) = C ↑(nat.desc_factorial n k) * X ^ (n - k) :=
+  (derivative^[k] (X ^ n : R[X])) = C ↑(nat.desc_factorial n k) * X ^ (n - k) :=
 by rw [iterate_derivative_X_pow_eq_nat_cast_mul n k, C_eq_nat_cast]
 
 lemma iterate_derivative_X_pow_eq_smul (n : ℕ) (k : ℕ) :
-  (derivative^[k] (X^n : R[X])) = (nat.desc_factorial n k : R) • X ^ (n - k) :=
+  (derivative^[k] (X ^ n : R[X])) = (nat.desc_factorial n k : R) • X ^ (n - k) :=
 by rw [iterate_derivative_X_pow_eq_C_mul n k, smul_eq_C_mul]
 
 lemma derivative_X_add_pow (c : R) (m : ℕ) : ((X + C c) ^ m).derivative = m * (X + C c) ^ (m - 1) :=
diff --git a/src/data/polynomial/div.lean b/src/data/polynomial/div.lean
index 247bf23634e7a..f221f4fe4bf94 100644
--- a/src/data/polynomial/div.lean
+++ b/src/data/polynomial/div.lean
@@ -465,31 +465,25 @@ by simp [multiplicity, root_multiplicity, part.dom];
 
 @[simp] lemma root_multiplicity_zero {x : R} : root_multiplicity x 0 = 0 := dif_pos rfl
 
+@[simp] lemma root_multiplicity_eq_zero_iff {p : R[X]} {x : R} :
+  root_multiplicity x p = 0 ↔ (is_root p x → p = 0) :=
+by simp only [root_multiplicity_eq_multiplicity, dite_eq_left_iff, part_enat.get_eq_iff_eq_coe,
+  nat.cast_zero, multiplicity.multiplicity_eq_zero, dvd_iff_is_root, not_imp_not]
+
 lemma root_multiplicity_eq_zero {p : R[X]} {x : R} (h : ¬ is_root p x) :
   root_multiplicity x p = 0 :=
-begin
-  rw root_multiplicity_eq_multiplicity,
-  split_ifs, { refl },
-  rw [← part_enat.coe_inj, part_enat.coe_get, multiplicity.multiplicity_eq_zero_of_not_dvd,
-    nat.cast_zero],
-  intro hdvd,
-  exact h (dvd_iff_is_root.mp hdvd)
-end
+root_multiplicity_eq_zero_iff.2 (λ h', (h h').elim)
+
+@[simp] lemma root_multiplicity_pos' {p : R[X]} {x : R} :
+  0 < root_multiplicity x p ↔ p ≠ 0 ∧ is_root p x :=
+by rw [pos_iff_ne_zero, ne.def, root_multiplicity_eq_zero_iff, not_imp, and.comm]
 
 lemma root_multiplicity_pos {p : R[X]} (hp : p ≠ 0) {x : R} :
   0 < root_multiplicity x p ↔ is_root p x :=
-begin
-  rw [← dvd_iff_is_root, root_multiplicity_eq_multiplicity, dif_neg hp,
-      ← part_enat.coe_lt_coe, part_enat.coe_get],
-  exact multiplicity.dvd_iff_multiplicity_pos
-end
+root_multiplicity_pos'.trans (and_iff_right hp)
 
 @[simp] lemma root_multiplicity_C (r a : R) : root_multiplicity a (C r) = 0 :=
-begin
-  rcases eq_or_ne r 0 with rfl|hr,
-  { simp },
-  { exact root_multiplicity_eq_zero (not_is_root_C _ _ hr) }
-end
+by simp only [root_multiplicity_eq_zero_iff, is_root, eval_C, C_eq_zero, imp_self]
 
 lemma pow_root_multiplicity_dvd (p : R[X]) (a : R) :
   (X - C a) ^ root_multiplicity a p ∣ p :=
diff --git a/src/data/polynomial/erase_lead.lean b/src/data/polynomial/erase_lead.lean
index add88b5fe686c..df4431851b68b 100644
--- a/src/data/polynomial/erase_lead.lean
+++ b/src/data/polynomial/erase_lead.lean
@@ -54,13 +54,7 @@ by simp only [erase_lead, erase_zero]
 
 @[simp] lemma erase_lead_add_monomial_nat_degree_leading_coeff (f : R[X]) :
   f.erase_lead + monomial f.nat_degree f.leading_coeff = f :=
-begin
-  ext i,
-  simp only [erase_lead_coeff, coeff_monomial, coeff_add, @eq_comm _ _ i],
-  split_ifs with h,
-  { subst i, simp only [leading_coeff, zero_add] },
-  { exact add_zero _ }
-end
+(add_comm _ _).trans (f.monomial_add_erase _)
 
 @[simp] lemma erase_lead_add_C_mul_X_pow (f : R[X]) :
   f.erase_lead + (C f.leading_coeff) * X ^ f.nat_degree = f :=
@@ -76,7 +70,7 @@ by rw [C_mul_X_pow_eq_monomial, self_sub_monomial_nat_degree_leading_coeff]
 
 lemma erase_lead_ne_zero (f0 : 2 ≤ f.support.card) : erase_lead f ≠ 0 :=
 begin
-  rw [ne.def, ← card_support_eq_zero, erase_lead_support],
+  rw [ne, ← card_support_eq_zero, erase_lead_support],
   exact (zero_lt_one.trans_le $ (tsub_le_tsub_right f0 1).trans
     finset.pred_card_le_card_erase).ne.symm
 end
@@ -85,7 +79,7 @@ lemma lt_nat_degree_of_mem_erase_lead_support {a : ℕ} (h : a ∈ (erase_lead f
   a < f.nat_degree :=
 begin
   rw [erase_lead_support, mem_erase] at h,
-  exact lt_of_le_of_ne (le_nat_degree_of_mem_supp a h.2) h.1,
+  exact (le_nat_degree_of_mem_supp a h.2).lt_of_ne h.1,
 end
 
 lemma ne_nat_degree_of_mem_erase_lead_support {a : ℕ} (h : a ∈ (erase_lead f).support) :
@@ -157,14 +151,7 @@ begin
     exact nd (nat_degree_add_eq_right_of_nat_degree_lt pq) }
 end
 
-lemma erase_lead_degree_le : (erase_lead f).degree ≤ f.degree :=
-begin
-  rw degree_le_iff_coeff_zero,
-  intros i hi,
-  rw erase_lead_coeff,
-  split_ifs with h, { refl },
-  apply coeff_eq_zero_of_degree_lt hi
-end
+lemma erase_lead_degree_le : (erase_lead f).degree ≤ f.degree := f.degree_erase_le _
 
 lemma erase_lead_nat_degree_le_aux : (erase_lead f).nat_degree ≤ f.nat_degree :=
 nat_degree_le_nat_degree erase_lead_degree_le
diff --git a/src/data/polynomial/eval.lean b/src/data/polynomial/eval.lean
index 8bf9287b64e39..fb9fe1b2ed7eb 100644
--- a/src/data/polynomial/eval.lean
+++ b/src/data/polynomial/eval.lean
@@ -786,6 +786,9 @@ def eval_ring_hom : R → R[X] →+* R := eval₂_ring_hom (ring_hom.id _)
 
 @[simp] lemma coe_eval_ring_hom (r : R) : ((eval_ring_hom r) : R[X] → R) = eval r := rfl
 
+lemma eval_ring_hom_zero : eval_ring_hom 0 = constant_coeff :=
+fun_like.ext _ _ $ λ p, p.coeff_zero_eq_eval_zero.symm
+
 @[simp] lemma eval_pow (n : ℕ) : (p ^ n).eval x = p.eval x ^ n := eval₂_pow _ _ _
 
 @[simp]
diff --git a/src/data/polynomial/field_division.lean b/src/data/polynomial/field_division.lean
index 0ccf6d01b6bd0..9fc76e6814d0b 100644
--- a/src/data/polynomial/field_division.lean
+++ b/src/data/polynomial/field_division.lean
@@ -314,10 +314,6 @@ lemma mem_roots_map [comm_ring k] [is_domain k] {f : R →+* k} {x : k} (hp : p
   x ∈ (p.map f).roots ↔ p.eval₂ f x = 0 :=
 by rw [mem_roots (map_ne_zero hp), is_root, polynomial.eval_map]; apply_instance
 
-lemma mem_root_set [comm_ring k] [is_domain k] [algebra R k] {x : k} (hp : p ≠ 0) :
-  x ∈ p.root_set k ↔ aeval x p = 0 :=
-iff.trans multiset.mem_to_finset (mem_roots_map hp)
-
 lemma root_set_monomial [comm_ring S] [is_domain S] [algebra R S]
   {n : ℕ} (hn : n ≠ 0) {a : R} (ha : a ≠ 0) : (monomial n a).root_set S = {0} :=
 by rw [root_set, map_monomial, roots_monomial ((_root_.map_ne_zero (algebra_map R S)).2 ha),
diff --git a/src/data/polynomial/monic.lean b/src/data/polynomial/monic.lean
index ef120b0243466..da99d33616e88 100644
--- a/src/data/polynomial/monic.lean
+++ b/src/data/polynomial/monic.lean
@@ -222,6 +222,9 @@ begin
   exact hm.nat_degree_eq_zero_iff_eq_one.mp this.1,
 end
 
+lemma monic.is_unit_iff (hm : p.monic) : is_unit p ↔ p = 1 :=
+⟨hm.eq_one_of_is_unit, λ h, h.symm ▸ is_unit_one⟩
+
 end semiring
 
 section comm_semiring
diff --git a/src/data/polynomial/ring_division.lean b/src/data/polynomial/ring_division.lean
index ebe34e911d82a..bd861c1787f46 100644
--- a/src/data/polynomial/ring_division.lean
+++ b/src/data/polynomial/ring_division.lean
@@ -183,9 +183,12 @@ begin
 end
 
 lemma degree_eq_zero_of_is_unit [nontrivial R] (h : is_unit p) : degree p = 0 :=
-le_antisymm (nat_degree_eq_zero_iff_degree_le_zero.mp (nat_degree_eq_zero_of_is_unit h))
+(nat_degree_eq_zero_iff_degree_le_zero.mp $ nat_degree_eq_zero_of_is_unit h).antisymm
   (zero_le_degree_iff.mpr h.ne_zero)
 
+@[simp] lemma degree_coe_units [nontrivial R] (u : R[X]ˣ) : degree (u : R[X]) = 0 :=
+degree_eq_zero_of_is_unit ⟨u, rfl⟩
+
 theorem is_unit_iff : is_unit p ↔ ∃ r : R, is_unit r ∧ C r = p :=
 ⟨λ hp, ⟨p.coeff 0, let h := eq_C_of_nat_degree_eq_zero (nat_degree_eq_zero_of_is_unit hp) in
   ⟨is_unit_C.1 (h ▸ hp), h.symm⟩⟩, λ ⟨r, hr, hrp⟩, hrp ▸ is_unit_C.2 hr⟩
@@ -228,16 +231,58 @@ variables [comm_semiring R] [no_zero_divisors R] {p q : R[X]}
 lemma irreducible_of_monic (hp : p.monic) (hp1 : p ≠ 1) :
   irreducible p ↔ ∀ f g : R[X], f.monic → g.monic → f * g = p → f = 1 ∨ g = 1 :=
 begin
-  refine ⟨λ h f g hf hg hp, (h.2 f g hp.symm).elim (or.inl ∘ hf.eq_one_of_is_unit)
-    (or.inr ∘ hg.eq_one_of_is_unit), λ h, ⟨hp1 ∘ hp.eq_one_of_is_unit, λ f g hfg,
-      (h (g * C f.leading_coeff) (f * C g.leading_coeff) _ _ _).elim
-        (or.inr ∘ is_unit_of_mul_eq_one g _) (or.inl ∘ is_unit_of_mul_eq_one f _)⟩⟩,
+  refine ⟨λ h f g hf hg hp, (h.2 f g hp.symm).imp hf.eq_one_of_is_unit hg.eq_one_of_is_unit,
+    λ h, ⟨hp1 ∘ hp.eq_one_of_is_unit, λ f g hfg, (h (g * C f.leading_coeff) (f * C g.leading_coeff)
+      _ _ _).symm.imp (is_unit_of_mul_eq_one f _) (is_unit_of_mul_eq_one g _)⟩⟩,
   { rwa [monic, leading_coeff_mul, leading_coeff_C, ←leading_coeff_mul, mul_comm, ←hfg, ←monic] },
   { rwa [monic, leading_coeff_mul, leading_coeff_C, ←leading_coeff_mul, ←hfg, ←monic] },
   { rw [mul_mul_mul_comm, ←C_mul, ←leading_coeff_mul, ←hfg, hp.leading_coeff, C_1, mul_one,
         mul_comm, ←hfg] },
 end
 
+lemma monic.irreducible_iff_nat_degree (hp : p.monic) : irreducible p ↔
+  p ≠ 1 ∧ ∀ f g : R[X], f.monic → g.monic → f * g = p → f.nat_degree = 0 ∨ g.nat_degree = 0 :=
+begin
+  by_cases hp1 : p = 1, { simp [hp1] },
+  rw [irreducible_of_monic hp hp1, and_iff_right hp1],
+  refine forall₄_congr (λ a b ha hb, _),
+  rw [ha.nat_degree_eq_zero_iff_eq_one, hb.nat_degree_eq_zero_iff_eq_one],
+end
+
+lemma monic.irreducible_iff_nat_degree' (hp : p.monic) : irreducible p ↔ p ≠ 1 ∧
+  ∀ f g : R[X], f.monic → g.monic → f * g = p → g.nat_degree ∉ Ioc 0 (p.nat_degree / 2) :=
+begin
+  simp_rw [hp.irreducible_iff_nat_degree, mem_Ioc, nat.le_div_iff_mul_le zero_lt_two, mul_two],
+  apply and_congr_right',
+  split; intros h f g hf hg he; subst he,
+  { rw [hf.nat_degree_mul hg, add_le_add_iff_right],
+    exact λ ha, (h f g hf hg rfl).elim (ha.1.trans_le ha.2).ne' ha.1.ne' },
+  { simp_rw [hf.nat_degree_mul hg, pos_iff_ne_zero] at h,
+    contrapose! h,
+    obtain hl|hl := le_total f.nat_degree g.nat_degree,
+    { exact ⟨g, f, hg, hf, mul_comm g f, h.1, add_le_add_left hl _⟩ },
+    { exact ⟨f, g, hf, hg, rfl, h.2, add_le_add_right hl _⟩ } },
+end
+
+lemma monic.not_irreducible_iff_exists_add_mul_eq_coeff (hm : p.monic) (hnd : p.nat_degree = 2) :
+  ¬ irreducible p ↔ ∃ c₁ c₂, p.coeff 0 = c₁ * c₂ ∧ p.coeff 1 = c₁ + c₂ :=
+begin
+  casesI subsingleton_or_nontrivial R,
+  { simpa only [nat_degree_of_subsingleton] using hnd },
+  rw [hm.irreducible_iff_nat_degree', and_iff_right, hnd],
+  push_neg, split,
+  { rintros ⟨a, b, ha, hb, rfl, hdb|⟨⟨⟩⟩⟩,
+    have hda := hnd, rw [ha.nat_degree_mul hb, hdb] at hda,
+    use [a.coeff 0, b.coeff 0, mul_coeff_zero a b],
+    simpa only [next_coeff, hnd, add_right_cancel hda, hdb] using ha.next_coeff_mul hb },
+  { rintros ⟨c₁, c₂, hmul, hadd⟩,
+    refine ⟨X + C c₁, X + C c₂, monic_X_add_C _, monic_X_add_C _, _, or.inl $ nat_degree_X_add_C _⟩,
+    rw [p.as_sum_range_C_mul_X_pow, hnd, finset.sum_range_succ, finset.sum_range_succ,
+      finset.sum_range_one, ← hnd, hm.coeff_nat_degree, hnd, hmul, hadd, C_mul, C_add, C_1],
+    ring },
+  { rintro rfl, simpa only [nat_degree_one] using hnd },
+end
+
 lemma root_mul : is_root (p * q) a ↔ is_root p a ∨ is_root q a :=
 by simp_rw [is_root, eval_mul, mul_eq_zero]
 
@@ -250,8 +295,7 @@ section ring
 variables [ring R] [is_domain R] {p q : R[X]}
 
 instance : is_domain R[X] :=
-{ ..polynomial.no_zero_divisors,
-  ..polynomial.nontrivial, }
+no_zero_divisors.to_is_domain _
 
 end ring
 
@@ -292,10 +336,6 @@ section roots
 
 open multiset
 
-@[simp] lemma degree_coe_units (u : R[X]ˣ) :
-  degree (u : R[X]) = 0 :=
-degree_eq_zero_of_is_unit ⟨u, rfl⟩
-
 theorem prime_X_sub_C (r : R) : prime (X - C r) :=
 ⟨X_sub_C_ne_zero r, not_is_unit_X_sub_C r,
  λ _ _, by { simp_rw [dvd_iff_is_root, is_root.def, eval_mul, mul_eq_zero], exact id }⟩
@@ -323,10 +363,10 @@ theorem eq_of_monic_of_associated (hp : p.monic) (hq : q.monic) (hpq : associate
 begin
   obtain ⟨u, hu⟩ := hpq,
   unfold monic at hp hq,
-  rw eq_C_of_degree_le_zero (le_of_eq $ degree_coe_units _) at hu,
+  rw eq_C_of_degree_le_zero (degree_coe_units _).le at hu,
   rw [← hu, leading_coeff_mul, hp, one_mul, leading_coeff_C] at hq,
   rwa [hq, C_1, mul_one] at hu,
-  apply_instance,
+  all_goals { apply_instance },
 end
 
 lemma root_multiplicity_mul {p q : R[X]} {x : R} (hpq : p * q ≠ 0) :
@@ -446,14 +486,14 @@ begin
   exact (classical.some_spec (exists_multiset_roots hp)).2 a
 end
 
-@[simp] lemma mem_roots (hp : p ≠ 0) : a ∈ p.roots ↔ is_root p a :=
-by rw [← count_pos, count_roots p, root_multiplicity_pos hp]
+@[simp] lemma mem_roots' : a ∈ p.roots ↔ p ≠ 0 ∧ is_root p a :=
+by rw [← count_pos, count_roots p, root_multiplicity_pos']
+
+lemma mem_roots (hp : p ≠ 0) : a ∈ p.roots ↔ is_root p a := mem_roots'.trans $ and_iff_right hp
 
-lemma ne_zero_of_mem_roots (h : a ∈ p.roots) : p ≠ 0 :=
-λ hp, by rwa [hp, roots_zero] at h
+lemma ne_zero_of_mem_roots (h : a ∈ p.roots) : p ≠ 0 := (mem_roots'.1 h).1
 
-lemma is_root_of_mem_roots (h : a ∈ p.roots) : is_root p a :=
-(mem_roots $ ne_zero_of_mem_roots h).mp h
+lemma is_root_of_mem_roots (h : a ∈ p.roots) : is_root p a := (mem_roots'.1 h).2
 
 theorem card_le_degree_of_subset_roots {p : R[X]} {Z : finset R} (h : Z.val ⊆ p.roots) :
   Z.card ≤ p.nat_degree :=
@@ -492,11 +532,13 @@ begin
   exact multiset.le_iff_exists_add.mpr ⟨k.roots, roots_mul h⟩
 end
 
-@[simp] lemma mem_roots_sub_C {p : R[X]} {a x : R} (hp0 : 0 < degree p) :
+lemma mem_roots_sub_C' {p : R[X]} {a x : R} :
+  x ∈ (p - C a).roots ↔ p ≠ C a ∧ p.eval x = a :=
+by rw [mem_roots', is_root.def, sub_ne_zero, eval_sub, sub_eq_zero, eval_C]
+
+lemma mem_roots_sub_C {p : R[X]} {a x : R} (hp0 : 0 < degree p) :
   x ∈ (p - C a).roots ↔ p.eval x = a :=
-(mem_roots (show p - C a ≠ 0, from mt sub_eq_zero.1 $ λ h,
-    not_le_of_gt hp0 $ h.symm ▸ degree_C_le)).trans
-  (by rw [is_root.def, eval_sub, eval_C, sub_eq_zero])
+mem_roots_sub_C'.trans $ and_iff_right $ λ hp, hp0.not_le $ hp.symm ▸ degree_C_le
 
 @[simp] lemma roots_X_sub_C (r : R) : roots (X - C r) = {r} :=
 begin
@@ -723,28 +765,28 @@ set.finite.bUnion begin
     exact id congr_fun hxy ⟨i, nat.lt_succ_of_le hi⟩ },
 end $ λ i hi, finset.finite_to_set _
 
-theorem mem_root_set_iff' {p : T[X]} {S : Type*} [comm_ring S] [is_domain S]
-  [algebra T S] (hp : p.map (algebra_map T S) ≠ 0) (a : S) :
-  a ∈ p.root_set S ↔ (p.map (algebra_map T S)).eval a = 0 :=
-by { change a ∈ multiset.to_finset _ ↔ _, rw [mem_to_finset, mem_roots hp], refl }
+theorem mem_root_set' {p : T[X]} {S : Type*} [comm_ring S] [is_domain S] [algebra T S] {a : S} :
+  a ∈ p.root_set S ↔ p.map (algebra_map T S) ≠ 0 ∧ aeval a p = 0 :=
+by rw [root_set, finset.mem_coe, mem_to_finset, mem_roots', is_root.def, ← eval₂_eq_eval_map,
+  aeval_def]
 
-theorem mem_root_set_iff {p : T[X]} (hp : p ≠ 0) {S : Type*} [comm_ring S] [is_domain S]
-  [algebra T S] [no_zero_smul_divisors T S] (a : S) : a ∈ p.root_set S ↔ aeval a p = 0 :=
-begin
-  rw [mem_root_set_iff', ←eval₂_eq_eval_map],
-  { refl },
-  intro h,
-  rw ←polynomial.map_zero (algebra_map T S) at h,
-  exact hp (map_injective _ (no_zero_smul_divisors.algebra_map_injective T S) h)
-end
+theorem mem_root_set {p : T[X]} {S : Type*} [comm_ring S] [is_domain S] [algebra T S]
+  [no_zero_smul_divisors T S] {a : S} : a ∈ p.root_set S ↔ p ≠ 0 ∧ aeval a p = 0 :=
+by rw [mem_root_set', (map_injective _
+  (no_zero_smul_divisors.algebra_map_injective T S)).ne_iff' (polynomial.map_zero _)]
 
-lemma root_set_maps_to {p : T[X]} {S S'} [comm_ring S] [is_domain S] [algebra T S]
-  [comm_ring S'] [is_domain S'] [algebra T S'] (hp : p.map (algebra_map T S') ≠ 0)
+theorem mem_root_set_of_ne {p : T[X]} {S : Type*} [comm_ring S] [is_domain S] [algebra T S]
+  [no_zero_smul_divisors T S] (hp : p ≠ 0) {a : S} : a ∈ p.root_set S ↔ aeval a p = 0 :=
+mem_root_set.trans $ and_iff_right hp
+
+lemma root_set_maps_to' {p : T[X]} {S S'} [comm_ring S] [is_domain S] [algebra T S]
+  [comm_ring S'] [is_domain S'] [algebra T S']
+  (hp : p.map (algebra_map T S') = 0 → p.map (algebra_map T S) = 0)
   (f : S →ₐ[T] S') : (p.root_set S).maps_to f (p.root_set S') :=
 λ x hx, begin
-  rw [mem_root_set_iff' hp, ← f.comp_algebra_map, ← map_map, eval_map],
-  erw [eval₂_hom, (mem_root_set_iff' (mt (λ h, _) hp) x).1 hx, _root_.map_zero],
-  rw [← f.comp_algebra_map, ← map_map, h, polynomial.map_zero],
+  rw [mem_root_set'] at hx ⊢,
+  rw [aeval_alg_hom, alg_hom.comp_apply, hx.2, _root_.map_zero],
+  exact ⟨mt hp hx.1, rfl⟩
 end
 
 lemma ne_zero_of_mem_root_set {p : T[X]} [comm_ring S] [is_domain S] [algebra T S] {a : S}
@@ -752,8 +794,18 @@ lemma ne_zero_of_mem_root_set {p : T[X]} [comm_ring S] [is_domain S] [algebra T
 λ hf, by rwa [hf, root_set_zero] at h
 
 lemma aeval_eq_zero_of_mem_root_set {p : T[X]} [comm_ring S] [is_domain S] [algebra T S]
-  [no_zero_smul_divisors T S] {a : S} (hx : a ∈ p.root_set S) : aeval a p = 0 :=
-(mem_root_set_iff (ne_zero_of_mem_root_set hx) a).mp hx
+  {a : S} (hx : a ∈ p.root_set S) : aeval a p = 0 :=
+(mem_root_set'.1 hx).2
+
+lemma root_set_maps_to {p : T[X]} {S S'} [comm_ring S] [is_domain S] [algebra T S]
+  [comm_ring S'] [is_domain S'] [algebra T S'] [no_zero_smul_divisors T S'] (f : S →ₐ[T] S') :
+  (p.root_set S).maps_to f (p.root_set S') :=
+begin
+  refine root_set_maps_to' (λ h₀, _) f,
+  obtain rfl : p = 0 := map_injective _
+    (no_zero_smul_divisors.algebra_map_injective T S') (by rwa [polynomial.map_zero]),
+  exact polynomial.map_zero _
+end
 
 end roots
 
diff --git a/src/data/rat/defs.lean b/src/data/rat/defs.lean
index cb303b9cfffe0..b3059d00bf39e 100644
--- a/src/data/rat/defs.lean
+++ b/src/data/rat/defs.lean
@@ -436,8 +436,7 @@ instance : comm_group_with_zero ℚ :=
   .. rat.comm_ring }
 
 instance : is_domain ℚ :=
-{ .. rat.comm_group_with_zero,
-  .. (infer_instance : no_zero_divisors ℚ) }
+no_zero_divisors.to_is_domain _
 
 /- Extra instances to short-circuit type class resolution -/
 -- TODO(Mario): this instance slows down data.real.basic
diff --git a/src/data/real/basic.lean b/src/data/real/basic.lean
index bf3dd05384825..e6365462ab871 100644
--- a/src/data/real/basic.lean
+++ b/src/data/real/basic.lean
@@ -3,12 +3,10 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Floris van Doorn
 -/
-import algebra.module.basic
 import algebra.bounds
 import algebra.order.archimedean
 import algebra.star.basic
 import data.real.cau_seq_completion
-import order.conditionally_complete_lattice.basic
 
 /-!
 # Real numbers from Cauchy sequences
@@ -18,6 +16,10 @@ This choice is motivated by how easy it is to prove that `ℝ` is a commutative
 lifting everything to `ℚ`.
 -/
 
+assert_not_exists finset
+assert_not_exists module
+assert_not_exists submonoid
+
 open_locale pointwise
 
 /-- The type `ℝ` of real numbers constructed as equivalence classes of Cauchy sequences of rational
@@ -148,7 +150,6 @@ instance : monoid ℝ             := by apply_instance
 instance : comm_semigroup ℝ     := by apply_instance
 instance : semigroup ℝ          := by apply_instance
 instance : has_sub ℝ            := by apply_instance
-instance : module ℝ ℝ           := by apply_instance
 instance : inhabited ℝ          := ⟨0⟩
 
 /-- The real numbers are a `*`-ring, with the trivial `*`-structure. -/
diff --git a/src/data/real/ennreal.lean b/src/data/real/ennreal.lean
index 7a58fdc39a84c..1f1eacdba696b 100644
--- a/src/data/real/ennreal.lean
+++ b/src/data/real/ennreal.lean
@@ -258,10 +258,10 @@ by simp only [ennreal.to_real, nnreal.coe_eq, to_nnreal_eq_to_nnreal_iff' hx hy]
 protected lemma zero_lt_one : 0 < (1 : ℝ≥0∞) := zero_lt_one
 
 @[simp] lemma one_lt_two : (1 : ℝ≥0∞) < 2 :=
-coe_one ▸ coe_two ▸ by exact_mod_cast (@one_lt_two ℕ _)
-@[simp] lemma zero_lt_two : (0:ℝ≥0∞) < 2 := lt_trans zero_lt_one one_lt_two
-lemma two_ne_zero : (2:ℝ≥0∞) ≠ 0 := (ne_of_lt zero_lt_two).symm
-lemma two_ne_top : (2:ℝ≥0∞) ≠ ∞ := coe_two ▸ coe_ne_top
+coe_one ▸ coe_two ▸ by exact_mod_cast (one_lt_two : 1 < 2)
+@[simp] lemma zero_lt_two : (0 : ℝ≥0∞) < 2 := lt_trans zero_lt_one one_lt_two
+lemma two_ne_zero : (2 : ℝ≥0∞) ≠ 0 := (ne_of_lt zero_lt_two).symm
+lemma two_ne_top : (2 : ℝ≥0∞) ≠ ∞ := coe_two ▸ coe_ne_top
 
 /-- `(1 : ℝ≥0∞) ≤ 1`, recorded as a `fact` for use with `Lp` spaces. -/
 instance _root_.fact_one_le_one_ennreal : fact ((1 : ℝ≥0∞) ≤ 1) := ⟨le_rfl⟩
@@ -1285,6 +1285,9 @@ begin
   rw [← eq_div_iff hb hb', mul_div_assoc, eq_comm],
 end
 
+lemma div_eq_one_iff {a b : ℝ≥0∞} (hb₀ : b ≠ 0) (hb₁ : b ≠ ∞) : a / b = 1 ↔ a = b :=
+⟨λ h, by rw [← (eq_div_iff hb₀ hb₁).mp h.symm, mul_one], λ h, h.symm ▸ div_self hb₀ hb₁⟩
+
 lemma inv_two_add_inv_two : (2:ℝ≥0∞)⁻¹ + 2⁻¹ = 1 :=
 by rw [← two_mul, ← div_eq_mul_inv, div_self two_ne_zero two_ne_top]
 
diff --git a/src/data/real/golden_ratio.lean b/src/data/real/golden_ratio.lean
index d7e76281ff9e3..8e9c3be8a18df 100644
--- a/src/data/real/golden_ratio.lean
+++ b/src/data/real/golden_ratio.lean
@@ -5,6 +5,7 @@ Authors: Anatole Dedecker, Alexey Soloyev, Junyan Xu
 -/
 import data.real.irrational
 import data.nat.fib
+import data.nat.prime_norm_num
 import data.fin.vec_notation
 import tactic.ring_exp
 import algebra.linear_recurrence
diff --git a/src/data/set/basic.lean b/src/data/set/basic.lean
index fbc848343a423..6dbbb57a6e255 100644
--- a/src/data/set/basic.lean
+++ b/src/data/set/basic.lean
@@ -37,23 +37,14 @@ Definitions in the file:
 * `nonempty s : Prop` : the predicate `s ≠ ∅`. Note that this is the preferred way to express the
   fact that `s` has an element (see the Implementation Notes).
 
-* `preimage f t : set α` : the preimage f⁻¹(t) (written `f ⁻¹' t` in Lean) of a subset of β.
-
 * `subsingleton s : Prop` : the predicate saying that `s` has at most one element.
 
 * `nontrivial s : Prop` : the predicate saying that `s` has at least two distinct elements.
 
-* `range f : set β` : the image of `univ` under `f`.
-  Also works for `{p : Prop} (f : p → α)` (unlike `image`)
-
 * `inclusion s₁ s₂ : ↥s₁ → ↥s₂` : the map `↥s₁ → ↥s₂` induced by an inclusion `s₁ ⊆ s₂`.
 
 ## Notation
 
-* `f ⁻¹' t` for `preimage f t`
-
-* `f '' s` for `image f s`
-
 * `sᶜ` for the complement of `s`
 
 ## Implementation notes
@@ -65,8 +56,7 @@ the `s.nonempty` dot notation can be used.
 
 ## Tags
 
-set, sets, subset, subsets, image, preimage, pre-image, range, union, intersection, insert,
-singleton, complement, powerset
+set, sets, subset, subsets, union, intersection, insert, singleton, complement, powerset
 
 -/
 
@@ -340,8 +330,8 @@ lemma nonempty_iff_univ_nonempty : nonempty α ↔ (univ : set α).nonempty :=
 @[simp] lemma univ_nonempty : ∀ [h : nonempty α], (univ : set α).nonempty
 | ⟨x⟩ := ⟨x, trivial⟩
 
-lemma nonempty.to_subtype (h : s.nonempty) : nonempty s :=
-nonempty_subtype.2 h
+lemma nonempty.to_subtype : s.nonempty → nonempty s := nonempty_subtype.2
+lemma nonempty.to_type : s.nonempty → nonempty α := λ ⟨x, hx⟩, ⟨x⟩
 
 instance [nonempty α] : nonempty (set.univ : set α) := set.univ_nonempty.to_subtype
 
@@ -374,22 +364,22 @@ eq_empty_of_subset_empty $ λ x hx, is_empty_elim x
 instance unique_empty [is_empty α] : unique (set α) :=
 { default := ∅, uniq := eq_empty_of_is_empty }
 
-/-- See also `set.ne_empty_iff_nonempty`. -/
+/-- See also `set.nonempty_iff_ne_empty`. -/
 lemma not_nonempty_iff_eq_empty {s : set α} : ¬s.nonempty ↔ s = ∅ :=
 by simp only [set.nonempty, eq_empty_iff_forall_not_mem, not_exists]
 
 /-- See also `set.not_nonempty_iff_eq_empty`. -/
-theorem ne_empty_iff_nonempty : s ≠ ∅ ↔ s.nonempty := not_iff_comm.1 not_nonempty_iff_eq_empty
+lemma nonempty_iff_ne_empty : s.nonempty ↔ s ≠ ∅ := not_nonempty_iff_eq_empty.not_right
 
-alias ne_empty_iff_nonempty ↔ _ nonempty.ne_empty
+alias nonempty_iff_ne_empty ↔ nonempty.ne_empty _
 
 @[simp] lemma not_nonempty_empty : ¬(∅ : set α).nonempty := λ ⟨x, hx⟩, hx
 
 @[simp] lemma is_empty_coe_sort {s : set α} : is_empty ↥s ↔ s = ∅ :=
-not_iff_not.1 $ by simpa using ne_empty_iff_nonempty.symm
+not_iff_not.1 $ by simpa using nonempty_iff_ne_empty
 
 lemma eq_empty_or_nonempty (s : set α) : s = ∅ ∨ s.nonempty :=
-or_iff_not_imp_left.2 ne_empty_iff_nonempty.1
+or_iff_not_imp_left.2 nonempty_iff_ne_empty.2
 
 theorem subset_eq_empty {s t : set α} (h : t ⊆ s) (e : s = ∅) : t = ∅ :=
 subset_empty_iff.1 $ e ▸ h
@@ -401,7 +391,9 @@ instance (α : Type u) : is_empty.{u+1} (∅ : set α) :=
 ⟨λ x, x.2⟩
 
 @[simp] lemma empty_ssubset : ∅ ⊂ s ↔ s.nonempty :=
-(@bot_lt_iff_ne_bot (set α) _ _ _).trans ne_empty_iff_nonempty
+(@bot_lt_iff_ne_bot (set α) _ _ _).trans nonempty_iff_ne_empty.symm
+
+alias empty_ssubset ↔ _ nonempty.empty_ssubset
 
 /-!
 
@@ -779,6 +771,10 @@ theorem insert_eq (x : α) (s : set α) : insert x s = ({x} : set α) ∪ s := r
 @[simp] theorem singleton_nonempty (a : α) : ({a} : set α).nonempty :=
 ⟨a, rfl⟩
 
+@[simp] lemma singleton_ne_empty (a : α) : ({a} : set α) ≠ ∅ := (singleton_nonempty _).ne_empty
+
+@[simp] lemma empty_ssubset_singleton : (∅ : set α) ⊂ {a} := (singleton_nonempty _).empty_ssubset
+
 @[simp] theorem singleton_subset_iff {a : α} {s : set α} : {a} ⊆ s ↔ a ∈ s := forall_eq
 
 theorem set_compr_eq_eq_singleton {a : α} : {b | b = a} = {a} := rfl
@@ -800,7 +796,7 @@ not_nonempty_iff_eq_empty.symm.trans singleton_inter_nonempty.not
 by rw [inter_comm, singleton_inter_eq_empty]
 
 lemma nmem_singleton_empty {s : set α} : s ∉ ({∅} : set (set α)) ↔ s.nonempty :=
-ne_empty_iff_nonempty
+nonempty_iff_ne_empty.symm
 
 instance unique_singleton (a : α) : unique ↥({a} : set α) :=
 ⟨⟨⟨a, mem_singleton a⟩⟩, λ ⟨x, h⟩, subtype.eq h⟩
@@ -886,7 +882,7 @@ lemma subset_singleton_iff_eq {s : set α} {x : α} : s ⊆ {x} ↔ s = ∅ ∨
 begin
   obtain (rfl | hs) := s.eq_empty_or_nonempty,
   use ⟨λ _, or.inl rfl, λ _, empty_subset _⟩,
-  simp [eq_singleton_iff_nonempty_unique_mem, hs, ne_empty_iff_nonempty.2 hs],
+  simp [eq_singleton_iff_nonempty_unique_mem, hs, hs.ne_empty],
 end
 
 lemma nonempty.subset_singleton_iff (h : s.nonempty) : s ⊆ {a} ↔ s = {a} :=
@@ -896,8 +892,7 @@ lemma ssubset_singleton_iff {s : set α} {x : α} : s ⊂ {x} ↔ s = ∅ :=
 begin
   rw [ssubset_iff_subset_ne, subset_singleton_iff_eq, or_and_distrib_right, and_not_self, or_false,
     and_iff_left_iff_imp],
-  rintro rfl,
-  refine ne_comm.1 (ne_empty_iff_nonempty.2 (singleton_nonempty _)),
+  exact λ h, ne_of_eq_of_ne h (singleton_ne_empty _).symm,
 end
 
 lemma eq_empty_of_ssubset_singleton {s : set α} {x : α} (hs : s ⊂ {x}) : s = ∅ :=
@@ -946,10 +941,8 @@ theorem compl_inter (s t : set α) : (s ∩ t)ᶜ = sᶜ ∪ tᶜ := compl_inf
 
 @[simp] lemma compl_univ_iff {s : set α} : sᶜ = univ ↔ s = ∅ := compl_eq_top
 
-lemma compl_ne_univ : sᶜ ≠ univ ↔ s.nonempty :=
-compl_univ_iff.not.trans ne_empty_iff_nonempty
-
-lemma nonempty_compl {s : set α} : sᶜ.nonempty ↔ s ≠ univ := (ne_univ_iff_exists_not_mem s).symm
+lemma compl_ne_univ : sᶜ ≠ univ ↔ s.nonempty := compl_univ_iff.not.trans nonempty_iff_ne_empty.symm
+lemma nonempty_compl : sᶜ.nonempty ↔ s ≠ univ := (ne_univ_iff_exists_not_mem s).symm
 
 lemma mem_compl_singleton_iff {a x : α} : x ∈ ({a} : set α)ᶜ ↔ x ≠ a := iff.rfl
 
@@ -1197,9 +1190,8 @@ sdiff_sdiff_eq_self h
 lemma mem_diff_singleton {x y : α} {s : set α} : x ∈ s \ {y} ↔ (x ∈ s ∧ x ≠ y) :=
 iff.rfl
 
-lemma mem_diff_singleton_empty {s : set α} {t : set (set α)} :
-  s ∈ t \ {∅} ↔ (s ∈ t ∧ s.nonempty) :=
-mem_diff_singleton.trans $ iff.rfl.and ne_empty_iff_nonempty
+lemma mem_diff_singleton_empty {t : set (set α)} : s ∈ t \ {∅} ↔ s ∈ t ∧ s.nonempty :=
+mem_diff_singleton.trans $ and_congr_right' nonempty_iff_ne_empty.symm
 
 lemma union_eq_diff_union_diff_union_inter (s t : set α) :
   s ∪ t = (s \ t) ∪ (t \ s) ∪ (s ∩ t) :=
@@ -1216,7 +1208,7 @@ lemma symm_diff_subset_union : s ∆ t ⊆ s ∪ t := @symm_diff_le_sup (set α)
 @[simp] lemma symm_diff_eq_empty : s ∆ t = ∅ ↔ s = t := symm_diff_eq_bot
 
 @[simp] lemma symm_diff_nonempty : (s ∆ t).nonempty ↔ s ≠ t :=
-ne_empty_iff_nonempty.symm.trans symm_diff_eq_empty.not
+nonempty_iff_ne_empty.trans symm_diff_eq_empty.not
 
 lemma inter_symm_diff_distrib_left (s t u : set α) : s ∩ t ∆ u = (s ∩ t) ∆ (s ∩ u) :=
 inf_symm_diff_distrib_left _ _ _
@@ -1360,436 +1352,6 @@ begin
   by_cases hx : x ∈ t; simp [*, set.ite]
 end
 
-/-! ### Inverse image -/
-
-/-- The preimage of `s : set β` by `f : α → β`, written `f ⁻¹' s`,
-  is the set of `x : α` such that `f x ∈ s`. -/
-def preimage {α : Type u} {β : Type v} (f : α → β) (s : set β) : set α := {x | f x ∈ s}
-
-infix ` ⁻¹' `:80 := preimage
-
-section preimage
-variables {f : α → β} {g : β → γ}
-
-@[simp] theorem preimage_empty : f ⁻¹' ∅ = ∅ := rfl
-
-@[simp] theorem mem_preimage {s : set β} {a : α} : (a ∈ f ⁻¹' s) ↔ (f a ∈ s) := iff.rfl
-
-lemma preimage_congr {f g : α → β} {s : set β} (h : ∀ (x : α), f x = g x) : f ⁻¹' s = g ⁻¹' s :=
-by { congr' with x, apply_assumption }
-
-theorem preimage_mono {s t : set β} (h : s ⊆ t) : f ⁻¹' s ⊆ f ⁻¹' t :=
-assume x hx, h hx
-
-@[simp] theorem preimage_univ : f ⁻¹' univ = univ := rfl
-
-theorem subset_preimage_univ {s : set α} : s ⊆ f ⁻¹' univ := subset_univ _
-
-@[simp] theorem preimage_inter {s t : set β} : f ⁻¹' (s ∩ t) = f ⁻¹' s ∩ f ⁻¹' t := rfl
-
-@[simp] theorem preimage_union {s t : set β} : f ⁻¹' (s ∪ t) = f ⁻¹' s ∪ f ⁻¹' t := rfl
-
-@[simp] theorem preimage_compl {s : set β} : f ⁻¹' sᶜ = (f ⁻¹' s)ᶜ := rfl
-
-@[simp] theorem preimage_diff (f : α → β) (s t : set β) :
-  f ⁻¹' (s \ t) = f ⁻¹' s \ f ⁻¹' t := rfl
-
-@[simp] theorem preimage_ite (f : α → β) (s t₁ t₂ : set β) :
-  f ⁻¹' (s.ite t₁ t₂) = (f ⁻¹' s).ite (f ⁻¹' t₁) (f ⁻¹' t₂) :=
-rfl
-
-@[simp] theorem preimage_set_of_eq {p : α → Prop} {f : β → α} : f ⁻¹' {a | p a} = {a | p (f a)} :=
-rfl
-
-@[simp] lemma preimage_id_eq : preimage (id : α → α) = id := rfl
-
-theorem preimage_id {s : set α} : id ⁻¹' s = s := rfl
-
-@[simp] theorem preimage_id' {s : set α} : (λ x, x) ⁻¹' s = s := rfl
-
-@[simp] theorem preimage_const_of_mem {b : β} {s : set β} (h : b ∈ s) :
-  (λ (x : α), b) ⁻¹' s = univ :=
-eq_univ_of_forall $ λ x, h
-
-@[simp] theorem preimage_const_of_not_mem {b : β} {s : set β} (h : b ∉ s) :
-  (λ (x : α), b) ⁻¹' s = ∅ :=
-eq_empty_of_subset_empty $ λ x hx, h hx
-
-theorem preimage_const (b : β) (s : set β) [decidable (b ∈ s)] :
-  (λ (x : α), b) ⁻¹' s = if b ∈ s then univ else ∅ :=
-by { split_ifs with hb hb, exacts [preimage_const_of_mem hb, preimage_const_of_not_mem hb] }
-
-theorem preimage_comp {s : set γ} : (g ∘ f) ⁻¹' s = f ⁻¹' (g ⁻¹' s) := rfl
-
-lemma preimage_comp_eq : preimage (g ∘ f) = preimage f ∘ preimage g := rfl
-
-@[simp] lemma preimage_iterate_eq {f : α → α} {n : ℕ} :
-  set.preimage (f^[n]) = ((set.preimage f)^[n]) :=
-begin
-  induction n with n ih, { simp, },
-  rw [iterate_succ, iterate_succ', set.preimage_comp_eq, ih],
-end
-
-lemma preimage_preimage {g : β → γ} {f : α → β} {s : set γ} :
-  f ⁻¹' (g ⁻¹' s) = (λ x, g (f x)) ⁻¹' s :=
-preimage_comp.symm
-
-theorem eq_preimage_subtype_val_iff {p : α → Prop} {s : set (subtype p)} {t : set α} :
-  s = subtype.val ⁻¹' t ↔ (∀x (h : p x), (⟨x, h⟩ : subtype p) ∈ s ↔ x ∈ t) :=
-⟨assume s_eq x h, by { rw [s_eq], simp },
- assume h, ext $ λ ⟨x, hx⟩, by simp [h]⟩
-
-lemma nonempty_of_nonempty_preimage {s : set β} {f : α → β} (hf : (f ⁻¹' s).nonempty) :
-  s.nonempty :=
-let ⟨x, hx⟩ := hf in ⟨f x, hx⟩
-
-lemma preimage_subtype_coe_eq_compl {α : Type*} {s u v : set α} (hsuv : s ⊆ u ∪ v)
-  (H : s ∩ (u ∩ v) = ∅) : (coe : s → α) ⁻¹' u = (coe ⁻¹' v)ᶜ :=
-begin
-  ext ⟨x, x_in_s⟩,
-  split,
-  { intros x_in_u x_in_v,
-    exact eq_empty_iff_forall_not_mem.mp H x ⟨x_in_s, ⟨x_in_u, x_in_v⟩⟩ },
-  { intro hx,
-    exact or.elim (hsuv x_in_s) id (λ hx', hx.elim hx') }
-end
-
-end preimage
-
-/-! ### Image of a set under a function -/
-
-section image
-variables {f : α → β}
-
-/-- The image of `s : set α` by `f : α → β`, written `f '' s`,
-  is the set of `y : β` such that `f x = y` for some `x ∈ s`. -/
-def image (f : α → β) (s : set α) : set β := {y | ∃ x, x ∈ s ∧ f x = y}
-
-infix ` '' `:80 := image
-
-theorem mem_image_iff_bex {f : α → β} {s : set α} {y : β} :
-  y ∈ f '' s ↔ ∃ x (_ : x ∈ s), f x = y := bex_def.symm
-
-@[simp] theorem mem_image (f : α → β) (s : set α) (y : β) :
-  y ∈ f '' s ↔ ∃ x, x ∈ s ∧ f x = y := iff.rfl
-
-lemma image_eta (f : α → β) : f '' s = (λ x, f x) '' s := rfl
-
-theorem mem_image_of_mem (f : α → β) {x : α} {a : set α} (h : x ∈ a) : f x ∈ f '' a :=
-⟨_, h, rfl⟩
-
-theorem _root_.function.injective.mem_set_image {f : α → β} (hf : injective f) {s : set α} {a : α} :
-  f a ∈ f '' s ↔ a ∈ s :=
-⟨λ ⟨b, hb, eq⟩, (hf eq) ▸ hb, mem_image_of_mem f⟩
-
-theorem ball_image_iff {f : α → β} {s : set α} {p : β → Prop} :
-  (∀ y ∈ f '' s, p y) ↔ (∀ x ∈ s, p (f x)) :=
-by simp
-
-theorem ball_image_of_ball {f : α → β} {s : set α} {p : β → Prop}
-  (h : ∀ x ∈ s, p (f x)) : ∀ y ∈ f '' s, p y :=
-ball_image_iff.2 h
-
-theorem bex_image_iff {f : α → β} {s : set α} {p : β → Prop} :
-  (∃ y ∈ f '' s, p y) ↔ (∃ x ∈ s, p (f x)) :=
-by simp
-
-theorem mem_image_elim {f : α → β} {s : set α} {C : β → Prop} (h : ∀ (x : α), x ∈ s → C (f x)) :
- ∀{y : β}, y ∈ f '' s → C y
-| ._ ⟨a, a_in, rfl⟩ := h a a_in
-
-theorem mem_image_elim_on {f : α → β} {s : set α} {C : β → Prop} {y : β} (h_y : y ∈ f '' s)
-  (h : ∀ (x : α), x ∈ s → C (f x)) : C y :=
-mem_image_elim h h_y
-
-@[congr] lemma image_congr {f g : α → β} {s : set α}
-  (h : ∀a∈s, f a = g a) : f '' s = g '' s :=
-by safe [ext_iff, iff_def]
-
-/-- A common special case of `image_congr` -/
-lemma image_congr' {f g : α → β} {s : set α} (h : ∀ (x : α), f x = g x) : f '' s = g '' s :=
-image_congr (λx _, h x)
-
-theorem image_comp (f : β → γ) (g : α → β) (a : set α) : (f ∘ g) '' a = f '' (g '' a) :=
-subset.antisymm
-  (ball_image_of_ball $ assume a ha, mem_image_of_mem _ $ mem_image_of_mem _ ha)
-  (ball_image_of_ball $ ball_image_of_ball $ assume a ha, mem_image_of_mem _ ha)
-
-/-- A variant of `image_comp`, useful for rewriting -/
-lemma image_image (g : β → γ) (f : α → β) (s : set α) : g '' (f '' s) = (λ x, g (f x)) '' s :=
-(image_comp g f s).symm
-
-lemma image_comm {β'} {f : β → γ} {g : α → β} {f' : α → β'} {g' : β' → γ}
-  (h_comm : ∀ a, f (g a) = g' (f' a)) :
-  (s.image g).image f = (s.image f').image g' :=
-by simp_rw [image_image, h_comm]
-
-lemma _root_.function.semiconj.set_image {f : α → β} {ga : α → α} {gb : β → β}
-  (h : function.semiconj f ga gb) :
-  function.semiconj (image f) (image ga) (image gb) :=
-λ s, image_comm h
-
-lemma _root_.function.commute.set_image {f g : α → α} (h : function.commute f g) :
-  function.commute (image f) (image g) :=
-h.set_image
-
-/-- Image is monotone with respect to `⊆`. See `set.monotone_image` for the statement in
-terms of `≤`. -/
-theorem image_subset {a b : set α} (f : α → β) (h : a ⊆ b) : f '' a ⊆ f '' b :=
-by { simp only [subset_def, mem_image], exact λ x, λ ⟨w, h1, h2⟩, ⟨w, h h1, h2⟩ }
-
-theorem image_union (f : α → β) (s t : set α) :
-  f '' (s ∪ t) = f '' s ∪ f '' t :=
-ext $ λ x, ⟨by rintro ⟨a, h|h, rfl⟩; [left, right]; exact ⟨_, h, rfl⟩,
-  by rintro (⟨a, h, rfl⟩ | ⟨a, h, rfl⟩); refine ⟨_, _, rfl⟩; [left, right]; exact h⟩
-
-@[simp] theorem image_empty (f : α → β) : f '' ∅ = ∅ := by { ext, simp }
-
-lemma image_inter_subset (f : α → β) (s t : set α) :
-  f '' (s ∩ t) ⊆ f '' s ∩ f '' t :=
-subset_inter (image_subset _ $ inter_subset_left _ _) (image_subset _ $ inter_subset_right _ _)
-
-theorem image_inter_on {f : α → β} {s t : set α} (h : ∀x∈t, ∀y∈s, f x = f y → x = y) :
-  f '' s ∩ f '' t = f '' (s ∩ t) :=
-subset.antisymm
-  (assume b ⟨⟨a₁, ha₁, h₁⟩, ⟨a₂, ha₂, h₂⟩⟩,
-    have a₂ = a₁, from h _ ha₂ _ ha₁ (by simp *),
-    ⟨a₁, ⟨ha₁, this ▸ ha₂⟩, h₁⟩)
-  (image_inter_subset _ _ _)
-
-theorem image_inter {f : α → β} {s t : set α} (H : injective f) :
-  f '' s ∩ f '' t = f '' (s ∩ t) :=
-image_inter_on (assume x _ y _ h, H h)
-
-theorem image_univ_of_surjective {ι : Type*} {f : ι → β} (H : surjective f) : f '' univ = univ :=
-eq_univ_of_forall $ by { simpa [image] }
-
-@[simp] theorem image_singleton {f : α → β} {a : α} : f '' {a} = {f a} :=
-by { ext, simp [image, eq_comm] }
-
-@[simp] theorem nonempty.image_const {s : set α} (hs : s.nonempty) (a : β) : (λ _, a) '' s = {a} :=
-ext $ λ x, ⟨λ ⟨y, _, h⟩, h ▸ mem_singleton _,
-  λ h, (eq_of_mem_singleton h).symm ▸ hs.imp (λ y hy, ⟨hy, rfl⟩)⟩
-
-@[simp] lemma image_eq_empty {α β} {f : α → β} {s : set α} : f '' s = ∅ ↔ s = ∅ :=
-by { simp only [eq_empty_iff_forall_not_mem],
-     exact ⟨λ H a ha, H _ ⟨_, ha, rfl⟩, λ H b ⟨_, ha, _⟩, H _ ha⟩ }
-
-lemma preimage_compl_eq_image_compl [boolean_algebra α] (S : set α) :
-  compl ⁻¹' S = compl '' S :=
-set.ext (λ x, ⟨λ h, ⟨xᶜ,h, compl_compl x⟩,
-  λ h, exists.elim h (λ y hy, (compl_eq_comm.mp hy.2).symm.subst hy.1)⟩)
-
-theorem mem_compl_image [boolean_algebra α] (t : α) (S : set α) :
-  t ∈ compl '' S ↔ tᶜ ∈ S :=
-by simp [←preimage_compl_eq_image_compl]
-
-/-- A variant of `image_id` -/
-@[simp] lemma image_id' (s : set α) : (λx, x) '' s = s := by { ext, simp }
-
-theorem image_id (s : set α) : id '' s = s := by simp
-
-theorem compl_compl_image [boolean_algebra α] (S : set α) :
-  compl '' (compl '' S) = S :=
-by rw [←image_comp, compl_comp_compl, image_id]
-
-theorem image_insert_eq {f : α → β} {a : α} {s : set α} :
-  f '' (insert a s) = insert (f a) (f '' s) :=
-by { ext, simp [and_or_distrib_left, exists_or_distrib, eq_comm, or_comm, and_comm] }
-
-theorem image_pair (f : α → β) (a b : α) : f '' {a, b} = {f a, f b} :=
-by simp only [image_insert_eq, image_singleton]
-
-theorem image_subset_preimage_of_inverse {f : α → β} {g : β → α}
-  (I : left_inverse g f) (s : set α) : f '' s ⊆ g ⁻¹' s :=
-λ b ⟨a, h, e⟩, e ▸ ((I a).symm ▸ h : g (f a) ∈ s)
-
-theorem preimage_subset_image_of_inverse {f : α → β} {g : β → α}
-  (I : left_inverse g f) (s : set β) : f ⁻¹' s ⊆ g '' s :=
-λ b h, ⟨f b, h, I b⟩
-
-theorem image_eq_preimage_of_inverse {f : α → β} {g : β → α}
-  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
-  image f = preimage g :=
-funext $ λ s, subset.antisymm
-  (image_subset_preimage_of_inverse h₁ s)
-  (preimage_subset_image_of_inverse h₂ s)
-
-theorem mem_image_iff_of_inverse {f : α → β} {g : β → α} {b : β} {s : set α}
-  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
-  b ∈ f '' s ↔ g b ∈ s :=
-by rw image_eq_preimage_of_inverse h₁ h₂; refl
-
-theorem image_compl_subset {f : α → β} {s : set α} (H : injective f) : f '' sᶜ ⊆ (f '' s)ᶜ :=
-disjoint.subset_compl_left $ by simp [disjoint_iff_inf_le, image_inter H]
-
-theorem subset_image_compl {f : α → β} {s : set α} (H : surjective f) : (f '' s)ᶜ ⊆ f '' sᶜ :=
-compl_subset_iff_union.2 $
-by { rw ← image_union, simp [image_univ_of_surjective H] }
-
-theorem image_compl_eq {f : α → β} {s : set α} (H : bijective f) : f '' sᶜ = (f '' s)ᶜ :=
-subset.antisymm (image_compl_subset H.1) (subset_image_compl H.2)
-
-theorem subset_image_diff (f : α → β) (s t : set α) :
-  f '' s \ f '' t ⊆ f '' (s \ t) :=
-begin
-  rw [diff_subset_iff, ← image_union, union_diff_self],
-  exact image_subset f (subset_union_right t s)
-end
-
-lemma subset_image_symm_diff : (f '' s) ∆ (f '' t) ⊆ f '' s ∆ t :=
-(union_subset_union (subset_image_diff _ _ _) $ subset_image_diff _ _ _).trans
-  (image_union _ _ _).superset
-
-theorem image_diff {f : α → β} (hf : injective f) (s t : set α) :
-  f '' (s \ t) = f '' s \ f '' t :=
-subset.antisymm
-  (subset.trans (image_inter_subset _ _ _) $ inter_subset_inter_right _ $ image_compl_subset hf)
-  (subset_image_diff f s t)
-
-lemma image_symm_diff (hf : injective f) (s t : set α) : f '' (s ∆ t) = (f '' s) ∆ (f '' t) :=
-by simp_rw [set.symm_diff_def, image_union, image_diff hf]
-
-lemma nonempty.image (f : α → β) {s : set α} : s.nonempty → (f '' s).nonempty
-| ⟨x, hx⟩ := ⟨f x, mem_image_of_mem f hx⟩
-
-lemma nonempty.of_image {f : α → β} {s : set α} : (f '' s).nonempty → s.nonempty
-| ⟨y, x, hx, _⟩ := ⟨x, hx⟩
-
-@[simp] lemma nonempty_image_iff {f : α → β} {s : set α} :
-  (f '' s).nonempty ↔ s.nonempty :=
-⟨nonempty.of_image, λ h, h.image f⟩
-
-lemma nonempty.preimage {s : set β} (hs : s.nonempty) {f : α → β} (hf : surjective f) :
-  (f ⁻¹' s).nonempty :=
-let ⟨y, hy⟩ := hs, ⟨x, hx⟩ := hf y in ⟨x, mem_preimage.2 $ hx.symm ▸ hy⟩
-
-instance (f : α → β) (s : set α) [nonempty s] : nonempty (f '' s) :=
-(set.nonempty.image f nonempty_of_nonempty_subtype).to_subtype
-
-/-- image and preimage are a Galois connection -/
-@[simp] theorem image_subset_iff {s : set α} {t : set β} {f : α → β} :
-  f '' s ⊆ t ↔ s ⊆ f ⁻¹' t :=
-ball_image_iff
-
-theorem image_preimage_subset (f : α → β) (s : set β) : f '' (f ⁻¹' s) ⊆ s :=
-image_subset_iff.2 subset.rfl
-
-theorem subset_preimage_image (f : α → β) (s : set α) :
-  s ⊆ f ⁻¹' (f '' s) :=
-λ x, mem_image_of_mem f
-
-theorem preimage_image_eq {f : α → β} (s : set α) (h : injective f) : f ⁻¹' (f '' s) = s :=
-subset.antisymm
-  (λ x ⟨y, hy, e⟩, h e ▸ hy)
-  (subset_preimage_image f s)
-
-theorem image_preimage_eq {f : α → β} (s : set β) (h : surjective f) : f '' (f ⁻¹' s) = s :=
-subset.antisymm
-  (image_preimage_subset f s)
-  (λ x hx, let ⟨y, e⟩ := h x in ⟨y, (e.symm ▸ hx : f y ∈ s), e⟩)
-
-lemma preimage_eq_preimage {f : β → α} (hf : surjective f) : f ⁻¹' s = f ⁻¹' t ↔ s = t :=
-iff.intro
-  (assume eq, by rw [← image_preimage_eq s hf, ← image_preimage_eq t hf, eq])
-  (assume eq, eq ▸ rfl)
-
-lemma image_inter_preimage (f : α → β) (s : set α) (t : set β) :
-  f '' (s ∩ f ⁻¹' t) = f '' s ∩ t :=
-begin
-  apply subset.antisymm,
-  { calc f '' (s ∩ f ⁻¹' t) ⊆ f '' s ∩ (f '' (f⁻¹' t)) : image_inter_subset _ _ _
-  ... ⊆ f '' s ∩ t : inter_subset_inter_right _ (image_preimage_subset f t) },
-  { rintros _ ⟨⟨x, h', rfl⟩, h⟩,
-    exact ⟨x, ⟨h', h⟩, rfl⟩ }
-end
-
-lemma image_preimage_inter (f : α → β) (s : set α) (t : set β) :
-  f '' (f ⁻¹' t ∩ s) = t ∩ f '' s :=
-by simp only [inter_comm, image_inter_preimage]
-
-@[simp] lemma image_inter_nonempty_iff {f : α → β} {s : set α} {t : set β} :
-  (f '' s ∩ t).nonempty ↔ (s ∩ f ⁻¹' t).nonempty :=
-by rw [←image_inter_preimage, nonempty_image_iff]
-
-lemma image_diff_preimage {f : α → β} {s : set α} {t : set β} : f '' (s \ f ⁻¹' t) = f '' s \ t :=
-by simp_rw [diff_eq, ← preimage_compl, image_inter_preimage]
-
-theorem compl_image : image (compl : set α → set α) = preimage compl :=
-image_eq_preimage_of_inverse compl_compl compl_compl
-
-theorem compl_image_set_of {p : set α → Prop} :
-  compl '' {s | p s} = {s | p sᶜ} :=
-congr_fun compl_image p
-
-theorem inter_preimage_subset (s : set α) (t : set β) (f : α → β) :
-  s ∩ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∩ t) :=
-λ x h, ⟨mem_image_of_mem _ h.left, h.right⟩
-
-theorem union_preimage_subset (s : set α) (t : set β) (f : α → β) :
-  s ∪ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∪ t) :=
-λ x h, or.elim h (λ l, or.inl $ mem_image_of_mem _ l) (λ r, or.inr r)
-
-theorem subset_image_union (f : α → β) (s : set α) (t : set β) :
-  f '' (s ∪ f ⁻¹' t) ⊆ f '' s ∪ t :=
-image_subset_iff.2 (union_preimage_subset _ _ _)
-
-lemma preimage_subset_iff {A : set α} {B : set β} {f : α → β} :
-  f⁻¹' B ⊆ A ↔ (∀ a : α, f a ∈ B → a ∈ A) := iff.rfl
-
-lemma image_eq_image {f : α → β} (hf : injective f) : f '' s = f '' t ↔ s = t :=
-iff.symm $ iff.intro (assume eq, eq ▸ rfl) $ assume eq,
-  by rw [← preimage_image_eq s hf, ← preimage_image_eq t hf, eq]
-
-lemma image_subset_image_iff {f : α → β} (hf : injective f) : f '' s ⊆ f '' t ↔ s ⊆ t :=
-begin
-  refine (iff.symm $ iff.intro (image_subset f) $ assume h, _),
-  rw [← preimage_image_eq s hf, ← preimage_image_eq t hf],
-  exact preimage_mono h
-end
-
-lemma prod_quotient_preimage_eq_image [s : setoid α] (g : quotient s → β) {h : α → β}
-  (Hh : h = g ∘ quotient.mk) (r : set (β × β)) :
-  {x : quotient s × quotient s | (g x.1, g x.2) ∈ r} =
-  (λ a : α × α, (⟦a.1⟧, ⟦a.2⟧)) '' ((λ a : α × α, (h a.1, h a.2)) ⁻¹' r) :=
-Hh.symm ▸ set.ext (λ ⟨a₁, a₂⟩, ⟨quotient.induction_on₂ a₁ a₂
-  (λ a₁ a₂ h, ⟨(a₁, a₂), h, rfl⟩),
-  λ ⟨⟨b₁, b₂⟩, h₁, h₂⟩, show (g a₁, g a₂) ∈ r, from
-  have h₃ : ⟦b₁⟧ = a₁ ∧ ⟦b₂⟧ = a₂ := prod.ext_iff.1 h₂,
-    h₃.1 ▸ h₃.2 ▸ h₁⟩)
-
-lemma exists_image_iff (f : α → β) (x : set α) (P : β → Prop) :
-  (∃ (a : f '' x), P a) ↔ ∃ (a : x), P (f a) :=
-⟨λ ⟨a, h⟩, ⟨⟨_, a.prop.some_spec.1⟩, a.prop.some_spec.2.symm ▸ h⟩,
-  λ ⟨a, h⟩, ⟨⟨_, _, a.prop, rfl⟩, h⟩⟩
-
-/-- Restriction of `f` to `s` factors through `s.image_factorization f : s → f '' s`. -/
-def image_factorization (f : α → β) (s : set α) : s → f '' s :=
-λ p, ⟨f p.1, mem_image_of_mem f p.2⟩
-
-lemma image_factorization_eq {f : α → β} {s : set α} :
-  subtype.val ∘ image_factorization f s = f ∘ subtype.val :=
-funext $ λ p, rfl
-
-lemma surjective_onto_image {f : α → β} {s : set α} :
-  surjective (image_factorization f s) :=
-λ ⟨_, ⟨a, ha, rfl⟩⟩, ⟨⟨a, ha⟩, rfl⟩
-
-/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect.
--/
-lemma image_perm {s : set α} {σ : equiv.perm α} (hs : {a : α | σ a ≠ a} ⊆ s) : σ '' s = s :=
-begin
-  ext i,
-  obtain hi | hi := eq_or_ne (σ i) i,
-  { refine ⟨_, λ h, ⟨i, h, hi⟩⟩,
-    rintro ⟨j, hj, h⟩,
-    rwa σ.injective (hi.trans h.symm) },
-  { refine iff_of_true ⟨σ.symm i, hs $ λ h, hi _, σ.apply_symm_apply _⟩ (hs hi),
-    convert congr_arg σ h; exact (σ.apply_symm_apply _).symm }
-end
-
-end image
-
 /-! ### Subsingleton -/
 
 /-- A set `s` is a `subsingleton` if it has at most one element. -/
@@ -1867,25 +1429,6 @@ For the corresponding result for `subtype`, see `subtype.subsingleton`. -/
 instance subsingleton_coe_of_subsingleton [subsingleton α] {s : set α} : subsingleton s :=
 by { rw [s.subsingleton_coe], exact subsingleton_of_subsingleton }
 
-/-- The image of a subsingleton is a subsingleton. -/
-lemma subsingleton.image (hs : s.subsingleton) (f : α → β) : (f '' s).subsingleton :=
-λ _ ⟨x, hx, Hx⟩ _ ⟨y, hy, Hy⟩, Hx ▸ Hy ▸ congr_arg f (hs hx hy)
-
-/-- The preimage of a subsingleton under an injective map is a subsingleton. -/
-theorem subsingleton.preimage {s : set β} (hs : s.subsingleton) {f : α → β}
-  (hf : function.injective f) : (f ⁻¹' s).subsingleton := λ a ha b hb, hf $ hs ha hb
-
-/-- If the image of a set under an injective map is a subsingleton, the set is a subsingleton. -/
-theorem subsingleton_of_image {α β : Type*} {f : α → β} (hf : function.injective f)
-  (s : set α) (hs : (f '' s).subsingleton) : s.subsingleton :=
-(hs.preimage hf).anti $ subset_preimage_image _ _
-
-/-- If the preimage of a set under an surjective map is a subsingleton,
-the set is a subsingleton. -/
-theorem subsingleton_of_preimage {α β : Type*} {f : α → β} (hf : function.surjective f)
-  (s : set β) (hs : (f ⁻¹' s).subsingleton) : s.subsingleton :=
-λ fx hx fy hy, by { rcases ⟨hf fx, hf fy⟩ with ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩, exact congr_arg f (hs hx hy) }
-
 /-! ### Nontrivial -/
 
 /-- A set `s` is `nontrivial` if it has at least two distinct elements. -/
@@ -1997,29 +1540,6 @@ nontrivial_of_nontrivial $ nontrivial_coe_sort.1 hs
 theorem nontrivial_mono {α : Type*} {s t : set α} (hst : s ⊆ t) (hs : nontrivial s) :
   nontrivial t := nontrivial.coe_sort $ (nontrivial_coe_sort.1 hs).mono hst
 
-/-- The preimage of a nontrivial set under a surjective map is nontrivial. -/
-theorem nontrivial.preimage {s : set β} (hs : s.nontrivial) {f : α → β}
-  (hf : function.surjective f) : (f ⁻¹' s).nontrivial :=
-begin
-  rcases hs with ⟨fx, hx, fy, hy, hxy⟩,
-  rcases ⟨hf fx, hf fy⟩ with ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩,
-  exact ⟨x, hx, y, hy, mt (congr_arg f) hxy⟩
-end
-
-/-- The image of a nontrivial set under an injective map is nontrivial. -/
-theorem nontrivial.image (hs : s.nontrivial)
-  {f : α → β} (hf : function.injective f) : (f '' s).nontrivial :=
-let ⟨x, hx, y, hy, hxy⟩ := hs in ⟨f x, mem_image_of_mem f hx, f y, mem_image_of_mem f hy, hf.ne hxy⟩
-
-/-- If the image of a set is nontrivial, the set is nontrivial. -/
-lemma nontrivial_of_image (f : α → β) (s : set α) (hs : (f '' s).nontrivial) : s.nontrivial :=
-let ⟨_, ⟨x, hx, rfl⟩, _, ⟨y, hy, rfl⟩, hxy⟩ := hs in ⟨x, hx, y, hy, mt (congr_arg f) hxy⟩
-
-/-- If the preimage of a set under an injective map is nontrivial, the set is nontrivial. -/
-lemma nontrivial_of_preimage {f : α → β} (hf : function.injective f) (s : set β)
-  (hs : (f ⁻¹' s).nontrivial) : s.nontrivial :=
-(hs.image hf).mono $ image_preimage_subset _ _
-
 @[simp] lemma not_subsingleton_iff : ¬ s.subsingleton ↔ s.nontrivial :=
 by simp_rw [set.subsingleton, set.nontrivial, not_forall]
 
@@ -2033,8 +1553,21 @@ theorem univ_eq_true_false : univ = ({true, false} : set Prop) :=
 eq.symm $ eq_univ_of_forall $ classical.cases (by simp) (by simp)
 
 section preorder
+variables [preorder α] [preorder β] {f : α → β}
 
-variables [preorder α] [preorder β] (f : α → β)
+lemma monotone_on_iff_monotone : monotone_on f s ↔ monotone (λ a : s, f a) :=
+by simp [monotone, monotone_on]
+
+lemma antitone_on_iff_antitone : antitone_on f s ↔ antitone (λ a : s, f a) :=
+by simp [antitone, antitone_on]
+
+lemma strict_mono_on_iff_strict_mono : strict_mono_on f s ↔ strict_mono (λ a : s, f a) :=
+by simp [strict_mono, strict_mono_on]
+
+lemma strict_anti_on_iff_strict_anti : strict_anti_on f s ↔ strict_anti (λ a : s, f a) :=
+by simp [strict_anti, strict_anti_on]
+
+variables (f)
 
 /-! ### Monotonicity on singletons -/
 
@@ -2068,392 +1601,27 @@ subsingleton_singleton.strict_anti_on f
 
 end preorder
 
-/-! ### Lemmas about range of a function. -/
-section range
-variables {f : ι → α}
-open function
-
-/-- Range of a function.
-
-This function is more flexible than `f '' univ`, as the image requires that the domain is in Type
-and not an arbitrary Sort. -/
-def range (f : ι → α) : set α := {x | ∃y, f y = x}
-
-@[simp] theorem mem_range {x : α} : x ∈ range f ↔ ∃ y, f y = x := iff.rfl
-
-@[simp] theorem mem_range_self (i : ι) : f i ∈ range f := ⟨i, rfl⟩
-
-theorem forall_range_iff {p : α → Prop} : (∀ a ∈ range f, p a) ↔ (∀ i, p (f i)) :=
-by simp
-
-theorem forall_subtype_range_iff {p : range f → Prop} :
-  (∀ a : range f, p a) ↔ ∀ i, p ⟨f i, mem_range_self _⟩ :=
-⟨λ H i, H _, λ H ⟨y, i, hi⟩, by { subst hi, apply H }⟩
-
-lemma subsingleton_range {α : Sort*} [subsingleton α] (f : α → β) : (range f).subsingleton :=
-forall_range_iff.2 $ λ x, forall_range_iff.2 $ λ y, congr_arg f (subsingleton.elim x y)
-
-theorem exists_range_iff {p : α → Prop} : (∃ a ∈ range f, p a) ↔ (∃ i, p (f i)) :=
-by simp
-
-lemma exists_range_iff' {p : α → Prop} :
-  (∃ a, a ∈ range f ∧ p a) ↔ ∃ i, p (f i) :=
-by simpa only [exists_prop] using exists_range_iff
-
-lemma exists_subtype_range_iff {p : range f → Prop} :
-  (∃ a : range f, p a) ↔ ∃ i, p ⟨f i, mem_range_self _⟩ :=
-⟨λ ⟨⟨a, i, hi⟩, ha⟩, by { subst a, exact ⟨i, ha⟩}, λ ⟨i, hi⟩, ⟨_, hi⟩⟩
-
-theorem range_iff_surjective : range f = univ ↔ surjective f :=
-eq_univ_iff_forall
-
-alias range_iff_surjective ↔ _ _root_.function.surjective.range_eq
-
-@[simp] theorem image_univ {f : α → β} : f '' univ = range f :=
-by { ext, simp [image, range] }
-
-theorem image_subset_range (f : α → β) (s) : f '' s ⊆ range f :=
-by rw ← image_univ; exact image_subset _ (subset_univ _)
-
-theorem mem_range_of_mem_image (f : α → β) (s) {x : β} (h : x ∈ f '' s) : x ∈ range f :=
-image_subset_range f s h
-
-lemma _root_.nat.mem_range_succ (i : ℕ) : i ∈ range nat.succ ↔ 0 < i :=
-⟨by { rintros ⟨n, rfl⟩, exact nat.succ_pos n, }, λ h, ⟨_, nat.succ_pred_eq_of_pos h⟩⟩
-
-lemma nonempty.preimage' {s : set β} (hs : s.nonempty) {f : α → β} (hf : s ⊆ set.range f) :
-  (f ⁻¹' s).nonempty :=
-let ⟨y, hy⟩ := hs, ⟨x, hx⟩ := hf hy in ⟨x, set.mem_preimage.2 $ hx.symm ▸ hy⟩
-
-theorem range_comp (g : α → β) (f : ι → α) : range (g ∘ f) = g '' range f :=
-subset.antisymm
-  (forall_range_iff.mpr $ assume i, mem_image_of_mem g (mem_range_self _))
-  (ball_image_iff.mpr $ forall_range_iff.mpr mem_range_self)
-
-theorem range_subset_iff : range f ⊆ s ↔ ∀ y, f y ∈ s :=
-forall_range_iff
-
-theorem range_eq_iff (f : α → β) (s : set β) :
-  range f = s ↔ (∀ a, f a ∈ s) ∧ ∀ b ∈ s, ∃ a, f a = b :=
-by { rw ←range_subset_iff, exact le_antisymm_iff }
-
-lemma range_comp_subset_range (f : α → β) (g : β → γ) : range (g ∘ f) ⊆ range g :=
-by rw range_comp; apply image_subset_range
-
-lemma range_nonempty_iff_nonempty : (range f).nonempty ↔ nonempty ι :=
-⟨λ ⟨y, x, hxy⟩, ⟨x⟩, λ ⟨x⟩, ⟨f x, mem_range_self x⟩⟩
-
-lemma range_nonempty [h : nonempty ι] (f : ι → α) : (range f).nonempty :=
-range_nonempty_iff_nonempty.2 h
-
-@[simp] lemma range_eq_empty_iff {f : ι → α} : range f = ∅ ↔ is_empty ι :=
-by rw [← not_nonempty_iff, ← range_nonempty_iff_nonempty, not_nonempty_iff_eq_empty]
-
-lemma range_eq_empty [is_empty ι] (f : ι → α) : range f = ∅ := range_eq_empty_iff.2 ‹_›
-
-instance [nonempty ι] (f : ι → α) : nonempty (range f) := (range_nonempty f).to_subtype
-
-@[simp] lemma image_union_image_compl_eq_range (f : α → β) :
-  (f '' s) ∪ (f '' sᶜ) = range f :=
-by rw [← image_union, ← image_univ, ← union_compl_self]
-
-lemma insert_image_compl_eq_range (f : α → β) (x : α) :
-  insert (f x) (f '' {x}ᶜ) = range f :=
-begin
-  ext y, rw [mem_range, mem_insert_iff, mem_image],
-  split,
-  { rintro (h | ⟨x', hx', h⟩),
-    { exact ⟨x, h.symm⟩ },
-    { exact ⟨x', h⟩ } },
-  { rintro ⟨x', h⟩,
-    by_cases hx : x' = x,
-    { left, rw [← h, hx] },
-    { right, refine ⟨_, _, h⟩, rw mem_compl_singleton_iff, exact hx } }
-end
-
-theorem image_preimage_eq_inter_range {f : α → β} {t : set β} :
-  f '' (f ⁻¹' t) = t ∩ range f :=
-ext $ assume x, ⟨assume ⟨x, hx, heq⟩, heq ▸ ⟨hx, mem_range_self _⟩,
-  assume ⟨hx, ⟨y, h_eq⟩⟩, h_eq ▸ mem_image_of_mem f $
-    show y ∈ f ⁻¹' t, by simp [preimage, h_eq, hx]⟩
-
-lemma image_preimage_eq_of_subset {f : α → β} {s : set β} (hs : s ⊆ range f) :
-  f '' (f ⁻¹' s) = s :=
-by rw [image_preimage_eq_inter_range, inter_eq_self_of_subset_left hs]
-
-lemma image_preimage_eq_iff {f : α → β} {s : set β} : f '' (f ⁻¹' s) = s ↔ s ⊆ range f :=
-⟨by { intro h, rw [← h], apply image_subset_range }, image_preimage_eq_of_subset⟩
-
-lemma subset_range_iff_exists_image_eq {f : α → β} {s : set β} :
-  s ⊆ range f ↔ ∃ t, f '' t = s :=
-⟨λ h, ⟨_, image_preimage_eq_iff.2 h⟩, λ ⟨t, ht⟩, ht ▸ image_subset_range _ _⟩
-
-@[simp] lemma exists_subset_range_and_iff {f : α → β} {p : set β → Prop} :
-  (∃ s, s ⊆ range f ∧ p s) ↔ ∃ s, p (f '' s) :=
-⟨λ ⟨s, hsf, hps⟩, ⟨f ⁻¹' s, (image_preimage_eq_of_subset hsf).symm ▸ hps⟩,
-  λ ⟨s, hs⟩, ⟨f '' s, image_subset_range _ _, hs⟩⟩
-
-lemma exists_subset_range_iff {f : α → β} {p : set β → Prop} :
-  (∃ s ⊆ range f, p s) ↔ ∃ s, p (f '' s) :=
-by simp only [exists_prop, exists_subset_range_and_iff]
-
-lemma range_image (f : α → β) : range (image f) = 𝒫 (range f) :=
-ext $ λ s, subset_range_iff_exists_image_eq.symm
-
-lemma preimage_subset_preimage_iff {s t : set α} {f : β → α} (hs : s ⊆ range f) :
-  f ⁻¹' s ⊆ f ⁻¹' t ↔ s ⊆ t :=
-begin
-  split,
-  { intros h x hx, rcases hs hx with ⟨y, rfl⟩, exact h hx },
-  intros h x, apply h
-end
-
-lemma preimage_eq_preimage' {s t : set α} {f : β → α} (hs : s ⊆ range f) (ht : t ⊆ range f) :
-  f ⁻¹' s = f ⁻¹' t ↔ s = t :=
-begin
-  split,
-  { intro h, apply subset.antisymm, rw [←preimage_subset_preimage_iff hs, h],
-    rw [←preimage_subset_preimage_iff ht, h] },
-  rintro rfl, refl
-end
-
-@[simp] theorem preimage_inter_range {f : α → β} {s : set β} : f ⁻¹' (s ∩ range f) = f ⁻¹' s :=
-set.ext $ λ x, and_iff_left ⟨x, rfl⟩
-
-@[simp] theorem preimage_range_inter {f : α → β} {s : set β} : f ⁻¹' (range f ∩ s) = f ⁻¹' s :=
-by rw [inter_comm, preimage_inter_range]
-
-theorem preimage_image_preimage {f : α → β} {s : set β} :
-  f ⁻¹' (f '' (f ⁻¹' s)) = f ⁻¹' s :=
-by rw [image_preimage_eq_inter_range, preimage_inter_range]
-
-@[simp] theorem range_id : range (@id α) = univ := range_iff_surjective.2 surjective_id
-
-@[simp] theorem range_id' : range (λ (x : α), x) = univ := range_id
-
-@[simp] theorem _root_.prod.range_fst [nonempty β] : range (prod.fst : α × β → α) = univ :=
-prod.fst_surjective.range_eq
-
-@[simp] theorem _root_.prod.range_snd [nonempty α] : range (prod.snd : α × β → β) = univ :=
-prod.snd_surjective.range_eq
-
-@[simp] theorem range_eval {ι : Type*} {α : ι → Sort*} [Π i, nonempty (α i)] (i : ι) :
-  range (eval i : (Π i, α i) → α i) = univ :=
-(surjective_eval i).range_eq
-
-theorem is_compl_range_inl_range_inr : is_compl (range $ @sum.inl α β) (range sum.inr) :=
-is_compl.of_le
-  (by { rintro y ⟨⟨x₁, rfl⟩, ⟨x₂, _⟩⟩, cc })
-  (by { rintro (x|y) -; [left, right]; exact mem_range_self _ })
-
-@[simp] theorem range_inl_union_range_inr : range (sum.inl : α → α ⊕ β) ∪ range sum.inr = univ :=
-is_compl_range_inl_range_inr.sup_eq_top
-
-@[simp] theorem range_inl_inter_range_inr : range (sum.inl : α → α ⊕ β) ∩ range sum.inr = ∅ :=
-is_compl_range_inl_range_inr.inf_eq_bot
-
-@[simp] theorem range_inr_union_range_inl : range (sum.inr : β → α ⊕ β) ∪ range sum.inl = univ :=
-is_compl_range_inl_range_inr.symm.sup_eq_top
-
-@[simp] theorem range_inr_inter_range_inl : range (sum.inr : β → α ⊕ β) ∩ range sum.inl = ∅ :=
-is_compl_range_inl_range_inr.symm.inf_eq_bot
-
-@[simp] theorem preimage_inl_image_inr (s : set β) : sum.inl ⁻¹' (@sum.inr α β '' s) = ∅ :=
-by { ext, simp }
-
-@[simp] theorem preimage_inr_image_inl (s : set α) : sum.inr ⁻¹' (@sum.inl α β '' s) = ∅ :=
-by { ext, simp }
-
-@[simp] theorem preimage_inl_range_inr : sum.inl ⁻¹' range (sum.inr : β → α ⊕ β) = ∅ :=
-by rw [← image_univ, preimage_inl_image_inr]
-
-@[simp] theorem preimage_inr_range_inl : sum.inr ⁻¹' range (sum.inl : α → α ⊕ β) = ∅ :=
-by rw [← image_univ, preimage_inr_image_inl]
-
-@[simp] lemma compl_range_inl : (range (sum.inl : α → α ⊕ β))ᶜ = range (sum.inr : β → α ⊕ β) :=
-is_compl.compl_eq is_compl_range_inl_range_inr
-
-@[simp] lemma compl_range_inr : (range (sum.inr : β → α ⊕ β))ᶜ = range (sum.inl : α → α ⊕ β) :=
-is_compl.compl_eq is_compl_range_inl_range_inr.symm
-
-theorem image_preimage_inl_union_image_preimage_inr (s : set (α ⊕ β)) :
-  sum.inl '' (sum.inl ⁻¹' s) ∪ sum.inr '' (sum.inr ⁻¹' s) = s :=
-by rw [image_preimage_eq_inter_range, image_preimage_eq_inter_range, ← inter_distrib_left,
-  range_inl_union_range_inr, inter_univ]
-
-@[simp] theorem range_quot_mk (r : α → α → Prop) : range (quot.mk r) = univ :=
-(surjective_quot_mk r).range_eq
-
-@[simp] theorem range_quot_lift {r : ι → ι → Prop} (hf : ∀ x y, r x y → f x = f y) :
-  range (quot.lift f hf) = range f :=
-ext $ λ y, (surjective_quot_mk _).exists
-
-@[simp] theorem range_quotient_mk [setoid α] : range (λx : α, ⟦x⟧) = univ :=
-range_quot_mk _
-
-@[simp] theorem range_quotient_lift [s : setoid ι] (hf) :
-  range (quotient.lift f hf : quotient s → α) = range f :=
-range_quot_lift _
+section linear_order
+variables [linear_order α] [linear_order β] {f : α → β}
 
-@[simp] theorem range_quotient_mk' {s : setoid α} : range (quotient.mk' : α → quotient s) = univ :=
-range_quot_mk _
+/-- A function between linear orders which is neither monotone nor antitone makes a dent upright or
+downright. -/
+lemma not_monotone_on_not_antitone_on_iff_exists_le_le :
+  ¬ monotone_on f s ∧ ¬ antitone_on f s ↔ ∃ a b c ∈ s, a ≤ b ∧ b ≤ c ∧
+    (f a < f b ∧ f c < f b ∨ f b < f a ∧ f b < f c) :=
+by simp [monotone_on_iff_monotone, antitone_on_iff_antitone, and_assoc, exists_and_distrib_left,
+  not_monotone_not_antitone_iff_exists_le_le, @and.left_comm (_ ∈ s)]
 
-@[simp] theorem range_quotient_lift_on' {s : setoid ι} (hf) :
-  range (λ x : quotient s, quotient.lift_on' x f hf) = range f :=
-range_quot_lift _
+/-- A function between linear orders which is neither monotone nor antitone makes a dent upright or
+downright. -/
+lemma not_monotone_on_not_antitone_on_iff_exists_lt_lt :
+  ¬ monotone_on f s ∧ ¬ antitone_on f s ↔ ∃ a b c ∈ s, a < b ∧ b < c ∧
+    (f a < f b ∧ f c < f b ∨ f b < f a ∧ f b < f c) :=
+by simp [monotone_on_iff_monotone, antitone_on_iff_antitone, and_assoc, exists_and_distrib_left,
+  not_monotone_not_antitone_iff_exists_lt_lt, @and.left_comm (_ ∈ s)]
 
-instance can_lift (c) (p) [can_lift α β c p] :
-  can_lift (set α) (set β) (('') c) (λ s, ∀ x ∈ s, p x) :=
-{ prf := λ s hs, subset_range_iff_exists_image_eq.mp (λ x hx, can_lift.prf _ (hs x hx)) }
+end linear_order
 
-lemma range_const_subset {c : α} : range (λ x : ι, c) ⊆ {c} :=
-range_subset_iff.2 $ λ x, rfl
-
-@[simp] lemma range_const : ∀ [nonempty ι] {c : α}, range (λx:ι, c) = {c}
-| ⟨x⟩ c := subset.antisymm range_const_subset $
-  assume y hy, (mem_singleton_iff.1 hy).symm ▸ mem_range_self x
-
-lemma range_subtype_map {p : α → Prop} {q : β → Prop} (f : α → β) (h : ∀ x, p x → q (f x)) :
-  range (subtype.map f h) = coe ⁻¹' (f '' {x | p x}) :=
-begin
-  ext ⟨x, hx⟩,
-  simp_rw [mem_preimage, mem_range, mem_image, subtype.exists, subtype.map, subtype.coe_mk,
-    mem_set_of, exists_prop]
-end
-
-lemma image_swap_eq_preimage_swap : image (@prod.swap α β) = preimage prod.swap :=
-image_eq_preimage_of_inverse prod.swap_left_inverse prod.swap_right_inverse
-
-theorem preimage_singleton_nonempty {f : α → β} {y : β} :
-  (f ⁻¹' {y}).nonempty ↔ y ∈ range f :=
-iff.rfl
-
-theorem preimage_singleton_eq_empty {f : α → β} {y : β} :
-  f ⁻¹' {y} = ∅ ↔ y ∉ range f :=
-not_nonempty_iff_eq_empty.symm.trans preimage_singleton_nonempty.not
-
-lemma range_subset_singleton {f : ι → α} {x : α} : range f ⊆ {x} ↔ f = const ι x :=
-by simp [range_subset_iff, funext_iff, mem_singleton]
-
-lemma image_compl_preimage {f : α → β} {s : set β} : f '' ((f ⁻¹' s)ᶜ) = range f \ s :=
-by rw [compl_eq_univ_diff, image_diff_preimage, image_univ]
-
-/-- Any map `f : ι → β` factors through a map `range_factorization f : ι → range f`. -/
-def range_factorization (f : ι → β) : ι → range f :=
-λ i, ⟨f i, mem_range_self i⟩
-
-lemma range_factorization_eq {f : ι → β} :
-  subtype.val ∘ range_factorization f = f :=
-funext $ λ i, rfl
-
-@[simp] lemma range_factorization_coe (f : ι → β) (a : ι) :
-  (range_factorization f a : β) = f a := rfl
-
-@[simp] lemma coe_comp_range_factorization (f : ι → β) : coe ∘ range_factorization f = f := rfl
-
-lemma surjective_onto_range : surjective (range_factorization f) :=
-λ ⟨_, ⟨i, rfl⟩⟩, ⟨i, rfl⟩
-
-lemma image_eq_range (f : α → β) (s : set α) : f '' s = range (λ(x : s), f x) :=
-by { ext, split, rintro ⟨x, h1, h2⟩, exact ⟨⟨x, h1⟩, h2⟩, rintro ⟨⟨x, h1⟩, h2⟩, exact ⟨x, h1, h2⟩ }
-
-lemma _root_.sum.range_eq (f : α ⊕ β → γ) : range f = range (f ∘ sum.inl) ∪ range (f ∘ sum.inr) :=
-ext $ λ x, sum.exists
-
-@[simp] lemma sum.elim_range (f : α → γ) (g : β → γ) : range (sum.elim f g) = range f ∪ range g :=
-sum.range_eq _
-
-lemma range_ite_subset' {p : Prop} [decidable p] {f g : α → β} :
-  range (if p then f else g) ⊆ range f ∪ range g :=
-begin
-  by_cases h : p, {rw if_pos h, exact subset_union_left _ _},
-  {rw if_neg h, exact subset_union_right _ _}
-end
-
-lemma range_ite_subset {p : α → Prop} [decidable_pred p] {f g : α → β} :
-  range (λ x, if p x then f x else g x) ⊆ range f ∪ range g :=
-begin
-  rw range_subset_iff, intro x, by_cases h : p x,
-  simp [if_pos h, mem_union, mem_range_self],
-  simp [if_neg h, mem_union, mem_range_self]
-end
-
-@[simp] lemma preimage_range (f : α → β) : f ⁻¹' (range f) = univ :=
-eq_univ_of_forall mem_range_self
-
-/-- The range of a function from a `unique` type contains just the
-function applied to its single value. -/
-lemma range_unique [h : unique ι] : range f = {f default} :=
-begin
-  ext x,
-  rw mem_range,
-  split,
-  { rintros ⟨i, hi⟩,
-    rw h.uniq i at hi,
-    exact hi ▸ mem_singleton _ },
-  { exact λ h, ⟨default, h.symm⟩ }
-end
-
-lemma range_diff_image_subset (f : α → β) (s : set α) :
-  range f \ f '' s ⊆ f '' sᶜ :=
-λ y ⟨⟨x, h₁⟩, h₂⟩, ⟨x, λ h, h₂ ⟨x, h, h₁⟩, h₁⟩
-
-lemma range_diff_image {f : α → β} (H : injective f) (s : set α) :
-  range f \ f '' s = f '' sᶜ :=
-subset.antisymm (range_diff_image_subset f s) $ λ y ⟨x, hx, hy⟩, hy ▸
-  ⟨mem_range_self _, λ ⟨x', hx', eq⟩, hx $ H eq ▸ hx'⟩
-
-/-- We can use the axiom of choice to pick a preimage for every element of `range f`. -/
-noncomputable def range_splitting (f : α → β) : range f → α := λ x, x.2.some
-
--- This can not be a `@[simp]` lemma because the head of the left hand side is a variable.
-lemma apply_range_splitting (f : α → β) (x : range f) : f (range_splitting f x) = x :=
-x.2.some_spec
-
-attribute [irreducible] range_splitting
-
-@[simp] lemma comp_range_splitting (f : α → β) : f ∘ range_splitting f = coe :=
-by { ext, simp only [function.comp_app], apply apply_range_splitting, }
-
--- When `f` is injective, see also `equiv.of_injective`.
-lemma left_inverse_range_splitting (f : α → β) :
-  left_inverse (range_factorization f) (range_splitting f) :=
-λ x, by { ext, simp only [range_factorization_coe], apply apply_range_splitting, }
-
-lemma range_splitting_injective (f : α → β) : injective (range_splitting f) :=
-(left_inverse_range_splitting f).injective
-
-lemma right_inverse_range_splitting {f : α → β} (h : injective f) :
-  right_inverse (range_factorization f) (range_splitting f) :=
-(left_inverse_range_splitting f).right_inverse_of_injective $
-  λ x y hxy, h $ subtype.ext_iff.1 hxy
-
-lemma preimage_range_splitting {f : α → β} (hf : injective f) :
-  preimage (range_splitting f) = image (range_factorization f) :=
-(image_eq_preimage_of_inverse (right_inverse_range_splitting hf)
-  (left_inverse_range_splitting f)).symm
-
-lemma is_compl_range_some_none (α : Type*) :
-  is_compl (range (some : α → option α)) {none} :=
-is_compl.of_le
-  (λ x ⟨⟨a, ha⟩, (hn : x = none)⟩, option.some_ne_none _ (ha.trans hn))
-  (λ x hx, option.cases_on x (or.inr rfl) (λ x, or.inl $ mem_range_self _))
-
-@[simp] lemma compl_range_some (α : Type*) :
-  (range (some : α → option α))ᶜ = {none} :=
-(is_compl_range_some_none α).compl_eq
-
-@[simp] lemma range_some_inter_none (α : Type*) : range (some : α → option α) ∩ {none} = ∅ :=
-(is_compl_range_some_none α).inf_eq_bot
-
-@[simp] lemma range_some_union_none (α : Type*) : range (some : α → option α) ∪ {none} = univ :=
-(is_compl_range_some_none α).sup_eq_top
-
-@[simp] lemma insert_none_range_some (α : Type*) :
-  insert none (range (some : α → option α)) = univ :=
-(is_compl_range_some_none α).symm.sup_eq_top
-
-end range
 end set
 
 open set
@@ -2462,191 +1630,13 @@ namespace function
 
 variables {ι : Sort*} {α : Type*} {β : Type*} {f : α → β}
 
-lemma surjective.preimage_injective (hf : surjective f) : injective (preimage f) :=
-assume s t, (preimage_eq_preimage hf).1
-
-lemma injective.preimage_image (hf : injective f) (s : set α) : f ⁻¹' (f '' s) = s :=
-preimage_image_eq s hf
-
-lemma injective.preimage_surjective (hf : injective f) : surjective (preimage f) :=
-by { intro s, use f '' s, rw hf.preimage_image }
-
-lemma injective.subsingleton_image_iff (hf : injective f) {s : set α} :
-  (f '' s).subsingleton ↔ s.subsingleton :=
-⟨subsingleton_of_image hf s, λ h, h.image f⟩
-
-lemma surjective.image_preimage (hf : surjective f) (s : set β) : f '' (f ⁻¹' s) = s :=
-image_preimage_eq s hf
-
-lemma surjective.image_surjective (hf : surjective f) : surjective (image f) :=
-by { intro s, use f ⁻¹' s, rw hf.image_preimage }
-
-lemma surjective.nonempty_preimage (hf : surjective f) {s : set β} :
-  (f ⁻¹' s).nonempty ↔ s.nonempty :=
-by rw [← nonempty_image_iff, hf.image_preimage]
-
-lemma injective.image_injective (hf : injective f) : injective (image f) :=
-by { intros s t h, rw [←preimage_image_eq s hf, ←preimage_image_eq t hf, h] }
-
-lemma surjective.preimage_subset_preimage_iff {s t : set β} (hf : surjective f) :
-  f ⁻¹' s ⊆ f ⁻¹' t ↔ s ⊆ t :=
-by { apply preimage_subset_preimage_iff, rw [hf.range_eq], apply subset_univ }
-
-lemma surjective.range_comp {ι' : Sort*} {f : ι → ι'} (hf : surjective f) (g : ι' → α) :
-  range (g ∘ f) = range g :=
-ext $ λ y, (@surjective.exists _ _ _ hf (λ x, g x = y)).symm
-
 lemma injective.nonempty_apply_iff {f : set α → set β} (hf : injective f)
   (h2 : f ∅ = ∅) {s : set α} : (f s).nonempty ↔ s.nonempty :=
-by rw [← ne_empty_iff_nonempty, ← h2, ← ne_empty_iff_nonempty, hf.ne_iff]
-
-lemma injective.mem_range_iff_exists_unique (hf : injective f) {b : β} :
-  b ∈ range f ↔ ∃! a, f a = b :=
-⟨λ ⟨a, h⟩, ⟨a, h, λ a' ha, hf (ha.trans h.symm)⟩, exists_unique.exists⟩
-
-lemma injective.exists_unique_of_mem_range (hf : injective f) {b : β} (hb : b ∈ range f) :
-  ∃! a, f a = b :=
-hf.mem_range_iff_exists_unique.mp hb
-
-theorem injective.compl_image_eq (hf : injective f) (s : set α) :
-  (f '' s)ᶜ = f '' sᶜ ∪ (range f)ᶜ :=
-begin
-  ext y,
-  rcases em (y ∈ range f) with ⟨x, rfl⟩|hx,
-  { simp [hf.eq_iff] },
-  { rw [mem_range, not_exists] at hx,
-    simp [hx] }
-end
-
-lemma left_inverse.image_image {g : β → α} (h : left_inverse g f) (s : set α) :
-  g '' (f '' s) = s :=
-by rw [← image_comp, h.comp_eq_id, image_id]
-
-lemma left_inverse.preimage_preimage {g : β → α} (h : left_inverse g f) (s : set α) :
-  f ⁻¹' (g ⁻¹' s) = s :=
-by rw [← preimage_comp, h.comp_eq_id, preimage_id]
+by rw [nonempty_iff_ne_empty, ← h2, nonempty_iff_ne_empty, hf.ne_iff]
 
 end function
 open function
 
-namespace option
-
-lemma injective_iff {α β} {f : option α → β} :
-  injective f ↔ injective (f ∘ some) ∧ f none ∉ range (f ∘ some) :=
-begin
-  simp only [mem_range, not_exists, (∘)],
-  refine ⟨λ hf, ⟨hf.comp (option.some_injective _), λ x, hf.ne $ option.some_ne_none _⟩, _⟩,
-  rintro ⟨h_some, h_none⟩ (_|a) (_|b) hab,
-  exacts [rfl, (h_none _ hab.symm).elim, (h_none _ hab).elim, congr_arg some (h_some hab)]
-end
-
-lemma range_eq {α β} (f : option α → β) : range f = insert (f none) (range (f ∘ some)) :=
-set.ext $ λ y, option.exists.trans $ eq_comm.or iff.rfl
-
-end option
-
-lemma with_bot.range_eq {α β} (f : with_bot α → β) :
-  range f = insert (f ⊥) (range (f ∘ coe : α → β)) :=
-option.range_eq f
-
-lemma with_top.range_eq {α β} (f : with_top α → β) :
-  range f = insert (f ⊤) (range (f ∘ coe : α → β)) :=
-option.range_eq f
-
-/-! ### Image and preimage on subtypes -/
-
-namespace subtype
-
-variable {α : Type*}
-
-lemma coe_image {p : α → Prop} {s : set (subtype p)} :
-  coe '' s = {x | ∃h : p x, (⟨x, h⟩ : subtype p) ∈ s} :=
-set.ext $ assume a,
-⟨assume ⟨⟨a', ha'⟩, in_s, h_eq⟩, h_eq ▸ ⟨ha', in_s⟩,
-  assume ⟨ha, in_s⟩, ⟨⟨a, ha⟩, in_s, rfl⟩⟩
-
-@[simp] lemma coe_image_of_subset {s t : set α} (h : t ⊆ s) : coe '' {x : ↥s | ↑x ∈ t} = t :=
-begin
-  ext x,
-  rw set.mem_image,
-  exact ⟨λ ⟨x', hx', hx⟩, hx ▸ hx', λ hx, ⟨⟨x, h hx⟩, hx, rfl⟩⟩,
-end
-
-lemma range_coe {s : set α} :
-  range (coe : s → α) = s :=
-by { rw ← set.image_univ, simp [-set.image_univ, coe_image] }
-
-/-- A variant of `range_coe`. Try to use `range_coe` if possible.
-  This version is useful when defining a new type that is defined as the subtype of something.
-  In that case, the coercion doesn't fire anymore. -/
-lemma range_val {s : set α} :
-  range (subtype.val : s → α) = s :=
-range_coe
-
-/-- We make this the simp lemma instead of `range_coe`. The reason is that if we write
-  for `s : set α` the function `coe : s → α`, then the inferred implicit arguments of `coe` are
-  `coe α (λ x, x ∈ s)`. -/
-@[simp] lemma range_coe_subtype {p : α → Prop} :
-  range (coe : subtype p → α) = {x | p x} :=
-range_coe
-
-@[simp] lemma coe_preimage_self (s : set α) : (coe : s → α) ⁻¹' s = univ :=
-by rw [← preimage_range (coe : s → α), range_coe]
-
-lemma range_val_subtype {p : α → Prop} :
-  range (subtype.val : subtype p → α) = {x | p x} :=
-range_coe
-
-theorem coe_image_subset (s : set α) (t : set s) : coe '' t ⊆ s :=
-λ x ⟨y, yt, yvaleq⟩, by rw ←yvaleq; exact y.property
-
-theorem coe_image_univ (s : set α) : (coe : s → α) '' set.univ = s :=
-image_univ.trans range_coe
-
-@[simp] theorem image_preimage_coe (s t : set α) :
-  (coe : s → α) '' (coe ⁻¹' t) = t ∩ s :=
-image_preimage_eq_inter_range.trans $ congr_arg _ range_coe
-
-theorem image_preimage_val (s t : set α) :
-  (subtype.val : s → α) '' (subtype.val ⁻¹' t) = t ∩ s :=
-image_preimage_coe s t
-
-theorem preimage_coe_eq_preimage_coe_iff {s t u : set α} :
-  ((coe : s → α) ⁻¹' t = coe ⁻¹' u) ↔ t ∩ s = u ∩ s :=
-by rw [← image_preimage_coe, ← image_preimage_coe, coe_injective.image_injective.eq_iff]
-
-@[simp] theorem preimage_coe_inter_self (s t : set α) :
-  (coe : s → α) ⁻¹' (t ∩ s) = coe ⁻¹' t :=
-by rw [preimage_coe_eq_preimage_coe_iff, inter_assoc, inter_self]
-
-theorem preimage_val_eq_preimage_val_iff (s t u : set α) :
-  ((subtype.val : s → α) ⁻¹' t = subtype.val ⁻¹' u) ↔ (t ∩ s = u ∩ s) :=
-preimage_coe_eq_preimage_coe_iff
-
-lemma exists_set_subtype {t : set α} (p : set α → Prop) :
-  (∃(s : set t), p (coe '' s)) ↔ ∃(s : set α), s ⊆ t ∧ p s :=
-begin
-  split,
-  { rintro ⟨s, hs⟩, refine ⟨coe '' s, _, hs⟩,
-    convert image_subset_range _ _, rw [range_coe] },
-  rintro ⟨s, hs₁, hs₂⟩, refine ⟨coe ⁻¹' s, _⟩,
-  rw [image_preimage_eq_of_subset], exact hs₂, rw [range_coe], exact hs₁
-end
-
-lemma preimage_coe_nonempty {s t : set α} : ((coe : s → α) ⁻¹' t).nonempty ↔ (s ∩ t).nonempty :=
-by rw [inter_comm, ← image_preimage_coe, nonempty_image_iff]
-
-lemma preimage_coe_eq_empty {s t : set α} : (coe : s → α) ⁻¹' t = ∅ ↔ s ∩ t = ∅ :=
-by simp only [← not_nonempty_iff_eq_empty, preimage_coe_nonempty]
-
-@[simp] lemma preimage_coe_compl (s : set α) : (coe : s → α) ⁻¹' sᶜ = ∅ :=
-preimage_coe_eq_empty.2 (inter_compl_self s)
-
-@[simp] lemma preimage_coe_compl' (s : set α) : (coe : sᶜ → α) ⁻¹' s = ∅ :=
-preimage_coe_eq_empty.2 (compl_inter_self s)
-
-end subtype
-
 namespace set
 
 /-! ### Lemmas about `inclusion`, the injection of subtypes induced by `⊆` -/
@@ -2680,340 +1670,16 @@ funext (inclusion_inclusion hst htu)
 lemma inclusion_injective (h : s ⊆ t) : injective (inclusion h)
 | ⟨_, _⟩ ⟨_, _⟩ := subtype.ext_iff_val.2 ∘ subtype.ext_iff_val.1
 
-@[simp] lemma range_inclusion (h : s ⊆ t) : range (inclusion h) = {x : t | (x:α) ∈ s} :=
-by { ext ⟨x, hx⟩, simp [inclusion] }
-
 lemma eq_of_inclusion_surjective {s t : set α} {h : s ⊆ t}
   (h_surj : function.surjective (inclusion h)) : s = t :=
 begin
-  rw [← range_iff_surjective, range_inclusion, eq_univ_iff_forall] at h_surj,
-  exact set.subset.antisymm h (λ x hx, h_surj ⟨x, hx⟩)
+  refine set.subset.antisymm h (λ x hx, _),
+  obtain ⟨y, hy⟩ := h_surj ⟨x, hx⟩,
+  exact mem_of_eq_of_mem (congr_arg coe hy).symm y.prop,
 end
 
 end inclusion
 
-/-! ### Injectivity and surjectivity lemmas for image and preimage -/
-section image_preimage
-variables {α : Type u} {β : Type v} {f : α → β}
-@[simp]
-lemma preimage_injective : injective (preimage f) ↔ surjective f :=
-begin
-  refine ⟨λ h y, _, surjective.preimage_injective⟩,
-  obtain ⟨x, hx⟩ : (f ⁻¹' {y}).nonempty,
-  { rw [h.nonempty_apply_iff preimage_empty], apply singleton_nonempty },
-  exact ⟨x, hx⟩
-end
-
-@[simp]
-lemma preimage_surjective : surjective (preimage f) ↔ injective f :=
-begin
-  refine ⟨λ h x x' hx, _, injective.preimage_surjective⟩,
-  cases h {x} with s hs, have := mem_singleton x,
-  rwa [← hs, mem_preimage, hx, ← mem_preimage, hs, mem_singleton_iff, eq_comm] at this
-end
-
-@[simp] lemma image_surjective : surjective (image f) ↔ surjective f :=
-begin
-  refine ⟨λ h y, _, surjective.image_surjective⟩,
-  cases h {y} with s hs,
-  have := mem_singleton y, rw [← hs] at this, rcases this with ⟨x, h1x, h2x⟩,
-  exact ⟨x, h2x⟩
-end
-
-@[simp] lemma image_injective : injective (image f) ↔ injective f :=
-begin
-  refine ⟨λ h x x' hx, _, injective.image_injective⟩,
-  rw [← singleton_eq_singleton_iff], apply h,
-  rw [image_singleton, image_singleton, hx]
-end
-
-lemma preimage_eq_iff_eq_image {f : α → β} (hf : bijective f) {s t} :
-  f ⁻¹' s = t ↔ s = f '' t :=
-by rw [← image_eq_image hf.1, hf.2.image_preimage]
-
-lemma eq_preimage_iff_image_eq {f : α → β} (hf : bijective f) {s t} :
-  s = f ⁻¹' t ↔ f '' s = t :=
-by rw [← image_eq_image hf.1, hf.2.image_preimage]
-
-end image_preimage
-
-/-!
-### Images of binary and ternary functions
-
-This section is very similar to `order.filter.n_ary`, `data.finset.n_ary`, `data.option.n_ary`.
-Please keep them in sync.
--/
-
-section n_ary_image
-
-variables {α α' β β' γ γ' δ δ' ε ε' : Type*} {f f' : α → β → γ} {g g' : α → β → γ → δ}
-variables {s s' : set α} {t t' : set β} {u u' : set γ} {a a' : α} {b b' : β} {c c' : γ} {d d' : δ}
-
-
-/-- The image of a binary function `f : α → β → γ` as a function `set α → set β → set γ`.
-  Mathematically this should be thought of as the image of the corresponding function `α × β → γ`.
--/
-def image2 (f : α → β → γ) (s : set α) (t : set β) : set γ :=
-{c | ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c }
-
-@[simp] lemma mem_image2 : c ∈ image2 f s t ↔ ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c := iff.rfl
-
-lemma mem_image2_of_mem (h1 : a ∈ s) (h2 : b ∈ t) : f a b ∈ image2 f s t :=
-⟨a, b, h1, h2, rfl⟩
-
-lemma mem_image2_iff (hf : injective2 f) : f a b ∈ image2 f s t ↔ a ∈ s ∧ b ∈ t :=
-⟨ by { rintro ⟨a', b', ha', hb', h⟩, rcases hf h with ⟨rfl, rfl⟩, exact ⟨ha', hb'⟩ },
-  λ ⟨ha, hb⟩, mem_image2_of_mem ha hb⟩
-
-/-- image2 is monotone with respect to `⊆`. -/
-lemma image2_subset (hs : s ⊆ s') (ht : t ⊆ t') : image2 f s t ⊆ image2 f s' t' :=
-by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_image2_of_mem (hs ha) (ht hb) }
-
-lemma image2_subset_left (ht : t ⊆ t') : image2 f s t ⊆ image2 f s t' := image2_subset subset.rfl ht
-
-lemma image2_subset_right (hs : s ⊆ s') : image2 f s t ⊆ image2 f s' t :=
-image2_subset hs subset.rfl
-
-lemma image_subset_image2_left (hb : b ∈ t) : (λ a, f a b) '' s ⊆ image2 f s t :=
-ball_image_of_ball $ λ a ha, mem_image2_of_mem ha hb
-
-lemma image_subset_image2_right (ha : a ∈ s) : f a '' t ⊆ image2 f s t :=
-ball_image_of_ball $ λ b, mem_image2_of_mem ha
-
-lemma forall_image2_iff {p : γ → Prop} :
-  (∀ z ∈ image2 f s t, p z) ↔ ∀ (x ∈ s) (y ∈ t), p (f x y) :=
-⟨λ h x hx y hy, h _ ⟨x, y, hx, hy, rfl⟩, λ h z ⟨x, y, hx, hy, hz⟩, hz ▸ h x hx y hy⟩
-
-@[simp] lemma image2_subset_iff {u : set γ} :
-  image2 f s t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), f x y ∈ u :=
-forall_image2_iff
-
-lemma image2_union_left : image2 f (s ∪ s') t = image2 f s t ∪ image2 f s' t :=
-begin
-  ext c, split,
-  { rintros ⟨a, b, h1a|h2a, hb, rfl⟩;[left, right]; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ },
-  { rintro (⟨_, _, _, _, rfl⟩|⟨_, _, _, _, rfl⟩); refine ⟨_, _, _, ‹_›, rfl⟩;
-    simp [mem_union, *] }
-end
-
-lemma image2_union_right : image2 f s (t ∪ t') = image2 f s t ∪ image2 f s t' :=
-begin
-  ext c, split,
-  { rintros ⟨a, b, ha, h1b|h2b, rfl⟩;[left, right]; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ },
-  { rintro (⟨_, _, _, _, rfl⟩|⟨_, _, _, _, rfl⟩); refine ⟨_, _, ‹_›, _, rfl⟩;
-    simp [mem_union, *] }
-end
-
-@[simp] lemma image2_empty_left : image2 f ∅ t = ∅ := ext $ by simp
-@[simp] lemma image2_empty_right : image2 f s ∅ = ∅ := ext $ by simp
-
-lemma nonempty.image2 : s.nonempty → t.nonempty → (image2 f s t).nonempty :=
-λ ⟨a, ha⟩ ⟨b, hb⟩, ⟨_, mem_image2_of_mem ha hb⟩
-
-@[simp] lemma image2_nonempty_iff : (image2 f s t).nonempty ↔ s.nonempty ∧ t.nonempty :=
-⟨λ ⟨_, a, b, ha, hb, _⟩, ⟨⟨a, ha⟩, b, hb⟩, λ h, h.1.image2 h.2⟩
-
-lemma nonempty.of_image2_left (h : (image2 f s t).nonempty) : s.nonempty :=
-(image2_nonempty_iff.1 h).1
-
-lemma nonempty.of_image2_right (h : (image2 f s t).nonempty) : t.nonempty :=
-(image2_nonempty_iff.1 h).2
-
-@[simp] lemma image2_eq_empty_iff : image2 f s t = ∅ ↔ s = ∅ ∨ t = ∅ :=
-by simp_rw [←not_nonempty_iff_eq_empty, image2_nonempty_iff, not_and_distrib]
-
-lemma image2_inter_subset_left : image2 f (s ∩ s') t ⊆ image2 f s t ∩ image2 f s' t :=
-by { rintro _ ⟨a, b, ⟨h1a, h2a⟩, hb, rfl⟩, split; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ }
-
-lemma image2_inter_subset_right : image2 f s (t ∩ t') ⊆ image2 f s t ∩ image2 f s t' :=
-by { rintro _ ⟨a, b, ha, ⟨h1b, h2b⟩, rfl⟩, split; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ }
-
-@[simp] lemma image2_singleton_left : image2 f {a} t = f a '' t :=
-ext $ λ x, by simp
-
-@[simp] lemma image2_singleton_right : image2 f s {b} = (λ a, f a b) '' s :=
-ext $ λ x, by simp
-
-lemma image2_singleton : image2 f {a} {b} = {f a b} := by simp
-
-@[congr] lemma image2_congr (h : ∀ (a ∈ s) (b ∈ t), f a b = f' a b) :
-  image2 f s t = image2 f' s t :=
-by { ext, split; rintro ⟨a, b, ha, hb, rfl⟩; refine ⟨a, b, ha, hb, by rw h a ha b hb⟩ }
-
-/-- A common special case of `image2_congr` -/
-lemma image2_congr' (h : ∀ a b, f a b = f' a b) : image2 f s t = image2 f' s t :=
-image2_congr (λ a _ b _, h a b)
-
-/-- The image of a ternary function `f : α → β → γ → δ` as a function
-  `set α → set β → set γ → set δ`. Mathematically this should be thought of as the image of the
-  corresponding function `α × β × γ → δ`.
--/
-def image3 (g : α → β → γ → δ) (s : set α) (t : set β) (u : set γ) : set δ :=
-{d | ∃ a b c, a ∈ s ∧ b ∈ t ∧ c ∈ u ∧ g a b c = d }
-
-@[simp] lemma mem_image3 : d ∈ image3 g s t u ↔ ∃ a b c, a ∈ s ∧ b ∈ t ∧ c ∈ u ∧ g a b c = d :=
-iff.rfl
-
-lemma image3_mono (hs : s ⊆ s') (ht : t ⊆ t') (hu : u ⊆ u') : image3 g s t u ⊆ image3 g s' t' u' :=
-λ x, Exists₃.imp $ λ a b c ⟨ha, hb, hc, hx⟩, ⟨hs ha, ht hb, hu hc, hx⟩
-
-@[congr] lemma image3_congr (h : ∀ (a ∈ s) (b ∈ t) (c ∈ u), g a b c = g' a b c) :
-  image3 g s t u = image3 g' s t u :=
-by { ext x,
-     split; rintro ⟨a, b, c, ha, hb, hc, rfl⟩; exact ⟨a, b, c, ha, hb, hc, by rw h a ha b hb c hc⟩ }
-
-/-- A common special case of `image3_congr` -/
-lemma image3_congr' (h : ∀ a b c, g a b c = g' a b c) : image3 g s t u = image3 g' s t u :=
-image3_congr (λ a _ b _ c _, h a b c)
-
-lemma image2_image2_left (f : δ → γ → ε) (g : α → β → δ) :
-  image2 f (image2 g s t) u = image3 (λ a b c, f (g a b) c) s t u :=
-begin
-  ext, split,
-  { rintro ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩, refine ⟨a, b, c, ha, hb, hc, rfl⟩ },
-  { rintro ⟨a, b, c, ha, hb, hc, rfl⟩, refine ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩ }
-end
-
-lemma image2_image2_right (f : α → δ → ε) (g : β → γ → δ) :
-  image2 f s (image2 g t u) = image3 (λ a b c, f a (g b c)) s t u :=
-begin
-  ext, split,
-  { rintro ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩, refine ⟨a, b, c, ha, hb, hc, rfl⟩ },
-  { rintro ⟨a, b, c, ha, hb, hc, rfl⟩, refine ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩ }
-end
-
-lemma image_image2 (f : α → β → γ) (g : γ → δ) :
-  g '' image2 f s t = image2 (λ a b, g (f a b)) s t :=
-begin
-  ext, split,
-  { rintro ⟨_, ⟨a, b, ha, hb, rfl⟩, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
-  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨_, ⟨a, b, ha, hb, rfl⟩, rfl⟩ }
-end
-
-lemma image2_image_left (f : γ → β → δ) (g : α → γ) :
-  image2 f (g '' s) t = image2 (λ a b, f (g a) b) s t :=
-begin
-  ext, split,
-  { rintro ⟨_, b, ⟨a, ha, rfl⟩, hb, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
-  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨_, b, ⟨a, ha, rfl⟩, hb, rfl⟩ }
-end
-
-lemma image2_image_right (f : α → γ → δ) (g : β → γ) :
-  image2 f s (g '' t) = image2 (λ a b, f a (g b)) s t :=
-begin
-  ext, split,
-  { rintro ⟨a, _, ha, ⟨b, hb, rfl⟩, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
-  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨a, _, ha, ⟨b, hb, rfl⟩, rfl⟩ }
-end
-
-lemma image2_swap (f : α → β → γ) (s : set α) (t : set β) :
-  image2 f s t = image2 (λ a b, f b a) t s :=
-by { ext, split; rintro ⟨a, b, ha, hb, rfl⟩; refine ⟨b, a, hb, ha, rfl⟩ }
-
-@[simp] lemma image2_left (h : t.nonempty) : image2 (λ x y, x) s t = s :=
-by simp [nonempty_def.mp h, ext_iff]
-
-@[simp] lemma image2_right (h : s.nonempty) : image2 (λ x y, y) s t = t :=
-by simp [nonempty_def.mp h, ext_iff]
-
-lemma image2_assoc {f : δ → γ → ε} {g : α → β → δ} {f' : α → ε' → ε} {g' : β → γ → ε'}
-  (h_assoc : ∀ a b c, f (g a b) c = f' a (g' b c)) :
-  image2 f (image2 g s t) u = image2 f' s (image2 g' t u) :=
-by simp only [image2_image2_left, image2_image2_right, h_assoc]
-
-lemma image2_comm {g : β → α → γ} (h_comm : ∀ a b, f a b = g b a) : image2 f s t = image2 g t s :=
-(image2_swap _ _ _).trans $ by simp_rw h_comm
-
-lemma image2_left_comm {f : α → δ → ε} {g : β → γ → δ} {f' : α → γ → δ'} {g' : β → δ' → ε}
-  (h_left_comm : ∀ a b c, f a (g b c) = g' b (f' a c)) :
-  image2 f s (image2 g t u) = image2 g' t (image2 f' s u) :=
-by { rw [image2_swap f', image2_swap f], exact image2_assoc (λ _ _ _, h_left_comm _ _ _) }
-
-lemma image2_right_comm {f : δ → γ → ε} {g : α → β → δ} {f' : α → γ → δ'} {g' : δ' → β → ε}
-  (h_right_comm : ∀ a b c, f (g a b) c = g' (f' a c) b) :
-  image2 f (image2 g s t) u = image2 g' (image2 f' s u) t :=
-by { rw [image2_swap g, image2_swap g'], exact image2_assoc (λ _ _ _, h_right_comm _ _ _) }
-
-lemma image_image2_distrib {g : γ → δ} {f' : α' → β' → δ} {g₁ : α → α'} {g₂ : β → β'}
-  (h_distrib : ∀ a b, g (f a b) = f' (g₁ a) (g₂ b)) :
-  (image2 f s t).image g = image2 f' (s.image g₁) (t.image g₂) :=
-by simp_rw [image_image2, image2_image_left, image2_image_right, h_distrib]
-
-/-- Symmetric statement to `set.image2_image_left_comm`. -/
-lemma image_image2_distrib_left {g : γ → δ} {f' : α' → β → δ} {g' : α → α'}
-  (h_distrib : ∀ a b, g (f a b) = f' (g' a) b) :
-  (image2 f s t).image g = image2 f' (s.image g') t :=
-(image_image2_distrib h_distrib).trans $ by rw image_id'
-
-/-- Symmetric statement to `set.image_image2_right_comm`. -/
-lemma image_image2_distrib_right {g : γ → δ} {f' : α → β' → δ} {g' : β → β'}
-  (h_distrib : ∀ a b, g (f a b) = f' a (g' b)) :
-  (image2 f s t).image g = image2 f' s (t.image g') :=
-(image_image2_distrib h_distrib).trans $ by rw image_id'
-
-/-- Symmetric statement to `set.image_image2_distrib_left`. -/
-lemma image2_image_left_comm {f : α' → β → γ} {g : α → α'} {f' : α → β → δ} {g' : δ → γ}
-  (h_left_comm : ∀ a b, f (g a) b = g' (f' a b)) :
-  image2 f (s.image g) t = (image2 f' s t).image g' :=
-(image_image2_distrib_left $ λ a b, (h_left_comm a b).symm).symm
-
-/-- Symmetric statement to `set.image_image2_distrib_right`. -/
-lemma image_image2_right_comm {f : α → β' → γ} {g : β → β'} {f' : α → β → δ} {g' : δ → γ}
-  (h_right_comm : ∀ a b, f a (g b) = g' (f' a b)) :
-  image2 f s (t.image g) = (image2 f' s t).image g' :=
-(image_image2_distrib_right $ λ a b, (h_right_comm a b).symm).symm
-
-/-- The other direction does not hold because of the `s`-`s` cross terms on the RHS. -/
-lemma image2_distrib_subset_left {f : α → δ → ε} {g : β → γ → δ} {f₁ : α → β → β'} {f₂ : α → γ → γ'}
-  {g' : β' → γ' → ε} (h_distrib : ∀ a b c, f a (g b c) = g' (f₁ a b) (f₂ a c)) :
-  image2 f s (image2 g t u) ⊆ image2 g' (image2 f₁ s t) (image2 f₂ s u) :=
-begin
-  rintro _ ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩,
-  rw h_distrib,
-  exact mem_image2_of_mem (mem_image2_of_mem ha hb) (mem_image2_of_mem ha hc),
-end
-
-/-- The other direction does not hold because of the `u`-`u` cross terms on the RHS. -/
-lemma image2_distrib_subset_right {f : δ → γ → ε} {g : α → β → δ} {f₁ : α → γ → α'}
-  {f₂ : β → γ → β'} {g' : α' → β' → ε} (h_distrib : ∀ a b c, f (g a b) c = g' (f₁ a c) (f₂ b c)) :
-  image2 f (image2 g s t) u ⊆ image2 g' (image2 f₁ s u) (image2 f₂ t u) :=
-begin
-  rintro _ ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩,
-  rw h_distrib,
-  exact mem_image2_of_mem (mem_image2_of_mem ha hc) (mem_image2_of_mem hb hc),
-end
-
-lemma image_image2_antidistrib {g : γ → δ} {f' : β' → α' → δ} {g₁ : β → β'} {g₂ : α → α'}
-  (h_antidistrib : ∀ a b, g (f a b) = f' (g₁ b) (g₂ a)) :
-  (image2 f s t).image g = image2 f' (t.image g₁) (s.image g₂) :=
-by { rw image2_swap f, exact image_image2_distrib (λ _ _, h_antidistrib _ _) }
-
-/-- Symmetric statement to `set.image2_image_left_anticomm`. -/
-lemma image_image2_antidistrib_left {g : γ → δ} {f' : β' → α → δ} {g' : β → β'}
-  (h_antidistrib : ∀ a b, g (f a b) = f' (g' b) a) :
-  (image2 f s t).image g = image2 f' (t.image g') s :=
-(image_image2_antidistrib h_antidistrib).trans $ by rw image_id'
-
-/-- Symmetric statement to `set.image_image2_right_anticomm`. -/
-lemma image_image2_antidistrib_right {g : γ → δ} {f' : β → α' → δ} {g' : α → α'}
-  (h_antidistrib : ∀ a b, g (f a b) = f' b (g' a)) :
-  (image2 f s t).image g = image2 f' t (s.image g') :=
-(image_image2_antidistrib h_antidistrib).trans $ by rw image_id'
-
-/-- Symmetric statement to `set.image_image2_antidistrib_left`. -/
-lemma image2_image_left_anticomm {f : α' → β → γ} {g : α → α'} {f' : β → α → δ} {g' : δ → γ}
-  (h_left_anticomm : ∀ a b, f (g a) b = g' (f' b a)) :
-  image2 f (s.image g) t = (image2 f' t s).image g' :=
-(image_image2_antidistrib_left $ λ a b, (h_left_anticomm b a).symm).symm
-
-/-- Symmetric statement to `set.image_image2_antidistrib_right`. -/
-lemma image_image2_right_anticomm {f : α → β' → γ} {g : β → β'} {f' : β → α → δ} {g' : δ → γ}
-  (h_right_anticomm : ∀ a b, f a (g b) = g' (f' b a)) :
-  image2 f s (t.image g) = (image2 f' t s).image g' :=
-(image_image2_antidistrib_right $ λ a b, (h_right_anticomm b a).symm).symm
-
-end n_ary_image
-
 end set
 
 namespace subsingleton
@@ -3060,46 +1726,3 @@ instance decidable_set_of (p : α → Prop) [decidable (p a)] : decidable (a ∈
 by assumption
 
 end set
-
-/-! ### Indicator function valued in bool -/
-
-open bool
-
-namespace set
-variables {α : Type*} (s : set α)
-
-/-- `bool_indicator` maps `x` to `tt` if `x ∈ s`, else to `ff` -/
-noncomputable def bool_indicator (x : α) :=
-@ite _ (x ∈ s) (classical.prop_decidable _) tt ff
-
-lemma mem_iff_bool_indicator (x : α) : x ∈ s ↔ s.bool_indicator x = tt :=
-by { unfold bool_indicator, split_ifs ; tauto }
-
-lemma not_mem_iff_bool_indicator (x : α) : x ∉ s ↔ s.bool_indicator x = ff :=
-by { unfold bool_indicator, split_ifs ; tauto }
-
-lemma preimage_bool_indicator_tt : s.bool_indicator ⁻¹' {tt} = s :=
-ext (λ x, (s.mem_iff_bool_indicator x).symm)
-
-lemma preimage_bool_indicator_ff : s.bool_indicator ⁻¹' {ff} = sᶜ :=
-ext (λ x, (s.not_mem_iff_bool_indicator x).symm)
-
-open_locale classical
-
-lemma preimage_bool_indicator_eq_union (t : set bool) :
-  s.bool_indicator ⁻¹' t = (if tt ∈ t then s else ∅) ∪ (if ff ∈ t then sᶜ else ∅) :=
-begin
-  ext x,
-  dsimp [bool_indicator],
-  split_ifs ; tauto
-end
-
-lemma preimage_bool_indicator (t : set bool) :
-  s.bool_indicator ⁻¹' t = univ ∨ s.bool_indicator ⁻¹' t = s ∨
-  s.bool_indicator ⁻¹' t = sᶜ ∨ s.bool_indicator ⁻¹' t = ∅ :=
-begin
-  simp only [preimage_bool_indicator_eq_union],
-  split_ifs ; simp [s.union_compl_self]
-end
-
-end set
diff --git a/src/data/set/bool_indicator.lean b/src/data/set/bool_indicator.lean
new file mode 100644
index 0000000000000..afbd45eadb363
--- /dev/null
+++ b/src/data/set/bool_indicator.lean
@@ -0,0 +1,54 @@
+/-
+Copyright (c) 2022 Dagur Tómas Ásgeirsson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Dagur Tómas Ásgeirsson, Leonardo de Moura
+-/
+
+import data.set.image
+
+/-!
+# Indicator function valued in bool
+
+See also `set.indicator` and `set.piecewise`.
+-/
+
+open bool
+
+namespace set
+variables {α : Type*} (s : set α)
+
+/-- `bool_indicator` maps `x` to `tt` if `x ∈ s`, else to `ff` -/
+noncomputable def bool_indicator (x : α) :=
+@ite _ (x ∈ s) (classical.prop_decidable _) tt ff
+
+lemma mem_iff_bool_indicator (x : α) : x ∈ s ↔ s.bool_indicator x = tt :=
+by { unfold bool_indicator, split_ifs ; tauto }
+
+lemma not_mem_iff_bool_indicator (x : α) : x ∉ s ↔ s.bool_indicator x = ff :=
+by { unfold bool_indicator, split_ifs ; tauto }
+
+lemma preimage_bool_indicator_tt : s.bool_indicator ⁻¹' {tt} = s :=
+ext (λ x, (s.mem_iff_bool_indicator x).symm)
+
+lemma preimage_bool_indicator_ff : s.bool_indicator ⁻¹' {ff} = sᶜ :=
+ext (λ x, (s.not_mem_iff_bool_indicator x).symm)
+
+open_locale classical
+
+lemma preimage_bool_indicator_eq_union (t : set bool) :
+  s.bool_indicator ⁻¹' t = (if tt ∈ t then s else ∅) ∪ (if ff ∈ t then sᶜ else ∅) :=
+begin
+  ext x,
+  dsimp [bool_indicator],
+  split_ifs ; tauto
+end
+
+lemma preimage_bool_indicator (t : set bool) :
+  s.bool_indicator ⁻¹' t = univ ∨ s.bool_indicator ⁻¹' t = s ∨
+  s.bool_indicator ⁻¹' t = sᶜ ∨ s.bool_indicator ⁻¹' t = ∅ :=
+begin
+  simp only [preimage_bool_indicator_eq_union],
+  split_ifs ; simp [s.union_compl_self]
+end
+
+end set
diff --git a/src/data/set/constructions.lean b/src/data/set/constructions.lean
index 541baeea6c11a..cc49bc5c308b5 100644
--- a/src/data/set/constructions.lean
+++ b/src/data/set/constructions.lean
@@ -24,24 +24,19 @@ set of subsets of `α` which is closed under finite intersections.
 variables {α : Type*} (S : set (set α))
 
 /-- A structure encapsulating the fact that a set of sets is closed under finite intersection. -/
-structure has_finite_inter :=
+structure has_finite_inter : Prop :=
 (univ_mem : set.univ ∈ S)
 (inter_mem : ∀ ⦃s⦄, s ∈ S → ∀ ⦃t⦄, t ∈ S → s ∩ t ∈ S)
 
 namespace has_finite_inter
 
--- Satisfying the inhabited linter...
-instance : inhabited (has_finite_inter ({set.univ} : set (set α))) :=
-⟨⟨by tauto, λ _ h1 _ h2, by simp [set.mem_singleton_iff.1 h1, set.mem_singleton_iff.1 h2]⟩⟩
-
 /-- The smallest set of sets containing `S` which is closed under finite intersections. -/
 inductive finite_inter_closure : set (set α)
 | basic {s} : s ∈ S → finite_inter_closure s
 | univ : finite_inter_closure set.univ
 | inter {s t} : finite_inter_closure s → finite_inter_closure t → finite_inter_closure (s ∩ t)
 
-/-- Defines `has_finite_inter` for `finite_inter_closure S`. -/
-def finite_inter_closure_has_finite_inter : has_finite_inter (finite_inter_closure S) :=
+lemma finite_inter_closure_has_finite_inter : has_finite_inter (finite_inter_closure S) :=
 { univ_mem := finite_inter_closure.univ,
   inter_mem := λ _ h _, finite_inter_closure.inter h }
 
diff --git a/src/data/set/function.lean b/src/data/set/function.lean
index 759411e070691..60e82ebc9c11b 100644
--- a/src/data/set/function.lean
+++ b/src/data/set/function.lean
@@ -630,6 +630,16 @@ lemma bij_on.mk (h₁ : maps_to f s t) (h₂ : inj_on f s) (h₃ : surj_on f s t
 lemma bij_on_empty (f : α → β) : bij_on f ∅ ∅ :=
 ⟨maps_to_empty f ∅, inj_on_empty f, surj_on_empty f ∅⟩
 
+lemma bij_on.inter_maps_to (h₁ : bij_on f s₁ t₁) (h₂ : maps_to f s₂ t₂) (h₃ : s₁ ∩ f ⁻¹' t₂ ⊆ s₂) :
+  bij_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
+⟨h₁.maps_to.inter_inter h₂, h₁.inj_on.mono $ inter_subset_left _ _,
+  λ y hy, let ⟨x, hx, hxy⟩ := h₁.surj_on hy.1 in ⟨x, ⟨hx, h₃ ⟨hx, hxy.symm.rec_on hy.2⟩⟩, hxy⟩⟩
+
+lemma maps_to.inter_bij_on (h₁ : maps_to f s₁ t₁) (h₂ : bij_on f s₂ t₂)
+  (h₃ : s₂ ∩ f ⁻¹' t₁ ⊆ s₁) :
+  bij_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
+inter_comm s₂ s₁ ▸ inter_comm t₂ t₁ ▸ h₂.inter_maps_to h₁ h₃
+
 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 _ _,
@@ -660,8 +670,7 @@ theorem bij_on.comp (hg : bij_on g t p) (hf : bij_on f s t) : bij_on (g ∘ f) s
 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) :=
+theorem bij_on.bijective (h : bij_on f s t) : bijective (h.maps_to.restrict f s t) :=
 ⟨λ 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⟩⟩
 
diff --git a/src/data/set/image.lean b/src/data/set/image.lean
new file mode 100644
index 0000000000000..c89fcc1f6ec0a
--- /dev/null
+++ b/src/data/set/image.lean
@@ -0,0 +1,1145 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Leonardo de Moura
+-/
+import data.set.basic
+
+/-!
+# Images and preimages of sets
+
+## Main definitions
+
+* `preimage f t : set α` : the preimage f⁻¹(t) (written `f ⁻¹' t` in Lean) of a subset of β.
+
+* `range f : set β` : the image of `univ` under `f`.
+  Also works for `{p : Prop} (f : p → α)` (unlike `image`)
+
+## Notation
+
+* `f ⁻¹' t` for `set.preimage f t`
+
+* `f '' s` for `set.image f s`
+
+## Tags
+
+set, sets, image, preimage, pre-image, range
+
+-/
+universes u v
+
+open function
+
+namespace set
+
+variables {α β γ : Type*} {ι : Sort*}
+
+/-! ### Inverse image -/
+
+/-- The preimage of `s : set β` by `f : α → β`, written `f ⁻¹' s`,
+  is the set of `x : α` such that `f x ∈ s`. -/
+def preimage {α : Type u} {β : Type v} (f : α → β) (s : set β) : set α := {x | f x ∈ s}
+
+infix ` ⁻¹' `:80 := preimage
+
+section preimage
+variables {f : α → β} {g : β → γ}
+
+@[simp] theorem preimage_empty : f ⁻¹' ∅ = ∅ := rfl
+
+@[simp] theorem mem_preimage {s : set β} {a : α} : (a ∈ f ⁻¹' s) ↔ (f a ∈ s) := iff.rfl
+
+lemma preimage_congr {f g : α → β} {s : set β} (h : ∀ (x : α), f x = g x) : f ⁻¹' s = g ⁻¹' s :=
+by { congr' with x, apply_assumption }
+
+theorem preimage_mono {s t : set β} (h : s ⊆ t) : f ⁻¹' s ⊆ f ⁻¹' t :=
+assume x hx, h hx
+
+@[simp] theorem preimage_univ : f ⁻¹' univ = univ := rfl
+
+theorem subset_preimage_univ {s : set α} : s ⊆ f ⁻¹' univ := subset_univ _
+
+@[simp] theorem preimage_inter {s t : set β} : f ⁻¹' (s ∩ t) = f ⁻¹' s ∩ f ⁻¹' t := rfl
+
+@[simp] theorem preimage_union {s t : set β} : f ⁻¹' (s ∪ t) = f ⁻¹' s ∪ f ⁻¹' t := rfl
+
+@[simp] theorem preimage_compl {s : set β} : f ⁻¹' sᶜ = (f ⁻¹' s)ᶜ := rfl
+
+@[simp] theorem preimage_diff (f : α → β) (s t : set β) :
+  f ⁻¹' (s \ t) = f ⁻¹' s \ f ⁻¹' t := rfl
+
+@[simp] theorem preimage_ite (f : α → β) (s t₁ t₂ : set β) :
+  f ⁻¹' (s.ite t₁ t₂) = (f ⁻¹' s).ite (f ⁻¹' t₁) (f ⁻¹' t₂) :=
+rfl
+
+@[simp] theorem preimage_set_of_eq {p : α → Prop} {f : β → α} : f ⁻¹' {a | p a} = {a | p (f a)} :=
+rfl
+
+@[simp] lemma preimage_id_eq : preimage (id : α → α) = id := rfl
+
+theorem preimage_id {s : set α} : id ⁻¹' s = s := rfl
+
+@[simp] theorem preimage_id' {s : set α} : (λ x, x) ⁻¹' s = s := rfl
+
+@[simp] theorem preimage_const_of_mem {b : β} {s : set β} (h : b ∈ s) :
+  (λ (x : α), b) ⁻¹' s = univ :=
+eq_univ_of_forall $ λ x, h
+
+@[simp] theorem preimage_const_of_not_mem {b : β} {s : set β} (h : b ∉ s) :
+  (λ (x : α), b) ⁻¹' s = ∅ :=
+eq_empty_of_subset_empty $ λ x hx, h hx
+
+theorem preimage_const (b : β) (s : set β) [decidable (b ∈ s)] :
+  (λ (x : α), b) ⁻¹' s = if b ∈ s then univ else ∅ :=
+by { split_ifs with hb hb, exacts [preimage_const_of_mem hb, preimage_const_of_not_mem hb] }
+
+theorem preimage_comp {s : set γ} : (g ∘ f) ⁻¹' s = f ⁻¹' (g ⁻¹' s) := rfl
+
+lemma preimage_comp_eq : preimage (g ∘ f) = preimage f ∘ preimage g := rfl
+
+@[simp] lemma preimage_iterate_eq {f : α → α} {n : ℕ} :
+  set.preimage (f^[n]) = ((set.preimage f)^[n]) :=
+begin
+  induction n with n ih, { simp, },
+  rw [iterate_succ, iterate_succ', set.preimage_comp_eq, ih],
+end
+
+lemma preimage_preimage {g : β → γ} {f : α → β} {s : set γ} :
+  f ⁻¹' (g ⁻¹' s) = (λ x, g (f x)) ⁻¹' s :=
+preimage_comp.symm
+
+theorem eq_preimage_subtype_val_iff {p : α → Prop} {s : set (subtype p)} {t : set α} :
+  s = subtype.val ⁻¹' t ↔ (∀x (h : p x), (⟨x, h⟩ : subtype p) ∈ s ↔ x ∈ t) :=
+⟨assume s_eq x h, by { rw [s_eq], simp },
+ assume h, ext $ λ ⟨x, hx⟩, by simp [h]⟩
+
+lemma nonempty_of_nonempty_preimage {s : set β} {f : α → β} (hf : (f ⁻¹' s).nonempty) :
+  s.nonempty :=
+let ⟨x, hx⟩ := hf in ⟨f x, hx⟩
+
+lemma preimage_subtype_coe_eq_compl {α : Type*} {s u v : set α} (hsuv : s ⊆ u ∪ v)
+  (H : s ∩ (u ∩ v) = ∅) : (coe : s → α) ⁻¹' u = (coe ⁻¹' v)ᶜ :=
+begin
+  ext ⟨x, x_in_s⟩,
+  split,
+  { intros x_in_u x_in_v,
+    exact eq_empty_iff_forall_not_mem.mp H x ⟨x_in_s, ⟨x_in_u, x_in_v⟩⟩ },
+  { intro hx,
+    exact or.elim (hsuv x_in_s) id (λ hx', hx.elim hx') }
+end
+
+end preimage
+
+
+/-! ### Image of a set under a function -/
+
+section image
+variables {f : α → β} {s t : set α}
+
+/-- The image of `s : set α` by `f : α → β`, written `f '' s`,
+  is the set of `y : β` such that `f x = y` for some `x ∈ s`. -/
+def image (f : α → β) (s : set α) : set β := {y | ∃ x, x ∈ s ∧ f x = y}
+
+infix ` '' `:80 := image
+
+theorem mem_image_iff_bex {f : α → β} {s : set α} {y : β} :
+  y ∈ f '' s ↔ ∃ x (_ : x ∈ s), f x = y := bex_def.symm
+
+@[simp] theorem mem_image (f : α → β) (s : set α) (y : β) :
+  y ∈ f '' s ↔ ∃ x, x ∈ s ∧ f x = y := iff.rfl
+
+lemma image_eta (f : α → β) : f '' s = (λ x, f x) '' s := rfl
+
+theorem mem_image_of_mem (f : α → β) {x : α} {a : set α} (h : x ∈ a) : f x ∈ f '' a :=
+⟨_, h, rfl⟩
+
+theorem _root_.function.injective.mem_set_image {f : α → β} (hf : injective f) {s : set α} {a : α} :
+  f a ∈ f '' s ↔ a ∈ s :=
+⟨λ ⟨b, hb, eq⟩, (hf eq) ▸ hb, mem_image_of_mem f⟩
+
+theorem ball_image_iff {f : α → β} {s : set α} {p : β → Prop} :
+  (∀ y ∈ f '' s, p y) ↔ (∀ x ∈ s, p (f x)) :=
+by simp
+
+theorem ball_image_of_ball {f : α → β} {s : set α} {p : β → Prop}
+  (h : ∀ x ∈ s, p (f x)) : ∀ y ∈ f '' s, p y :=
+ball_image_iff.2 h
+
+theorem bex_image_iff {f : α → β} {s : set α} {p : β → Prop} :
+  (∃ y ∈ f '' s, p y) ↔ (∃ x ∈ s, p (f x)) :=
+by simp
+
+theorem mem_image_elim {f : α → β} {s : set α} {C : β → Prop} (h : ∀ (x : α), x ∈ s → C (f x)) :
+ ∀{y : β}, y ∈ f '' s → C y
+| ._ ⟨a, a_in, rfl⟩ := h a a_in
+
+theorem mem_image_elim_on {f : α → β} {s : set α} {C : β → Prop} {y : β} (h_y : y ∈ f '' s)
+  (h : ∀ (x : α), x ∈ s → C (f x)) : C y :=
+mem_image_elim h h_y
+
+@[congr] lemma image_congr {f g : α → β} {s : set α}
+  (h : ∀a∈s, f a = g a) : f '' s = g '' s :=
+by safe [ext_iff, iff_def]
+
+/-- A common special case of `image_congr` -/
+lemma image_congr' {f g : α → β} {s : set α} (h : ∀ (x : α), f x = g x) : f '' s = g '' s :=
+image_congr (λx _, h x)
+
+theorem image_comp (f : β → γ) (g : α → β) (a : set α) : (f ∘ g) '' a = f '' (g '' a) :=
+subset.antisymm
+  (ball_image_of_ball $ assume a ha, mem_image_of_mem _ $ mem_image_of_mem _ ha)
+  (ball_image_of_ball $ ball_image_of_ball $ assume a ha, mem_image_of_mem _ ha)
+
+/-- A variant of `image_comp`, useful for rewriting -/
+lemma image_image (g : β → γ) (f : α → β) (s : set α) : g '' (f '' s) = (λ x, g (f x)) '' s :=
+(image_comp g f s).symm
+
+lemma image_comm {β'} {f : β → γ} {g : α → β} {f' : α → β'} {g' : β' → γ}
+  (h_comm : ∀ a, f (g a) = g' (f' a)) :
+  (s.image g).image f = (s.image f').image g' :=
+by simp_rw [image_image, h_comm]
+
+lemma _root_.function.semiconj.set_image {f : α → β} {ga : α → α} {gb : β → β}
+  (h : function.semiconj f ga gb) :
+  function.semiconj (image f) (image ga) (image gb) :=
+λ s, image_comm h
+
+lemma _root_.function.commute.set_image {f g : α → α} (h : function.commute f g) :
+  function.commute (image f) (image g) :=
+h.set_image
+
+/-- Image is monotone with respect to `⊆`. See `set.monotone_image` for the statement in
+terms of `≤`. -/
+theorem image_subset {a b : set α} (f : α → β) (h : a ⊆ b) : f '' a ⊆ f '' b :=
+by { simp only [subset_def, mem_image], exact λ x, λ ⟨w, h1, h2⟩, ⟨w, h h1, h2⟩ }
+
+theorem image_union (f : α → β) (s t : set α) :
+  f '' (s ∪ t) = f '' s ∪ f '' t :=
+ext $ λ x, ⟨by rintro ⟨a, h|h, rfl⟩; [left, right]; exact ⟨_, h, rfl⟩,
+  by rintro (⟨a, h, rfl⟩ | ⟨a, h, rfl⟩); refine ⟨_, _, rfl⟩; [left, right]; exact h⟩
+
+@[simp] theorem image_empty (f : α → β) : f '' ∅ = ∅ := by { ext, simp }
+
+lemma image_inter_subset (f : α → β) (s t : set α) :
+  f '' (s ∩ t) ⊆ f '' s ∩ f '' t :=
+subset_inter (image_subset _ $ inter_subset_left _ _) (image_subset _ $ inter_subset_right _ _)
+
+theorem image_inter_on {f : α → β} {s t : set α} (h : ∀x∈t, ∀y∈s, f x = f y → x = y) :
+  f '' s ∩ f '' t = f '' (s ∩ t) :=
+subset.antisymm
+  (assume b ⟨⟨a₁, ha₁, h₁⟩, ⟨a₂, ha₂, h₂⟩⟩,
+    have a₂ = a₁, from h _ ha₂ _ ha₁ (by simp *),
+    ⟨a₁, ⟨ha₁, this ▸ ha₂⟩, h₁⟩)
+  (image_inter_subset _ _ _)
+
+theorem image_inter {f : α → β} {s t : set α} (H : injective f) :
+  f '' s ∩ f '' t = f '' (s ∩ t) :=
+image_inter_on (assume x _ y _ h, H h)
+
+theorem image_univ_of_surjective {ι : Type*} {f : ι → β} (H : surjective f) : f '' univ = univ :=
+eq_univ_of_forall $ by { simpa [image] }
+
+@[simp] theorem image_singleton {f : α → β} {a : α} : f '' {a} = {f a} :=
+by { ext, simp [image, eq_comm] }
+
+@[simp] theorem nonempty.image_const {s : set α} (hs : s.nonempty) (a : β) : (λ _, a) '' s = {a} :=
+ext $ λ x, ⟨λ ⟨y, _, h⟩, h ▸ mem_singleton _,
+  λ h, (eq_of_mem_singleton h).symm ▸ hs.imp (λ y hy, ⟨hy, rfl⟩)⟩
+
+@[simp] lemma image_eq_empty {α β} {f : α → β} {s : set α} : f '' s = ∅ ↔ s = ∅ :=
+by { simp only [eq_empty_iff_forall_not_mem],
+     exact ⟨λ H a ha, H _ ⟨_, ha, rfl⟩, λ H b ⟨_, ha, _⟩, H _ ha⟩ }
+
+lemma preimage_compl_eq_image_compl [boolean_algebra α] (S : set α) :
+  compl ⁻¹' S = compl '' S :=
+set.ext (λ x, ⟨λ h, ⟨xᶜ,h, compl_compl x⟩,
+  λ h, exists.elim h (λ y hy, (compl_eq_comm.mp hy.2).symm.subst hy.1)⟩)
+
+theorem mem_compl_image [boolean_algebra α] (t : α) (S : set α) :
+  t ∈ compl '' S ↔ tᶜ ∈ S :=
+by simp [←preimage_compl_eq_image_compl]
+
+/-- A variant of `image_id` -/
+@[simp] lemma image_id' (s : set α) : (λx, x) '' s = s := by { ext, simp }
+
+theorem image_id (s : set α) : id '' s = s := by simp
+
+theorem compl_compl_image [boolean_algebra α] (S : set α) :
+  compl '' (compl '' S) = S :=
+by rw [←image_comp, compl_comp_compl, image_id]
+
+theorem image_insert_eq {f : α → β} {a : α} {s : set α} :
+  f '' (insert a s) = insert (f a) (f '' s) :=
+by { ext, simp [and_or_distrib_left, exists_or_distrib, eq_comm, or_comm, and_comm] }
+
+theorem image_pair (f : α → β) (a b : α) : f '' {a, b} = {f a, f b} :=
+by simp only [image_insert_eq, image_singleton]
+
+theorem image_subset_preimage_of_inverse {f : α → β} {g : β → α}
+  (I : left_inverse g f) (s : set α) : f '' s ⊆ g ⁻¹' s :=
+λ b ⟨a, h, e⟩, e ▸ ((I a).symm ▸ h : g (f a) ∈ s)
+
+theorem preimage_subset_image_of_inverse {f : α → β} {g : β → α}
+  (I : left_inverse g f) (s : set β) : f ⁻¹' s ⊆ g '' s :=
+λ b h, ⟨f b, h, I b⟩
+
+theorem image_eq_preimage_of_inverse {f : α → β} {g : β → α}
+  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
+  image f = preimage g :=
+funext $ λ s, subset.antisymm
+  (image_subset_preimage_of_inverse h₁ s)
+  (preimage_subset_image_of_inverse h₂ s)
+
+theorem mem_image_iff_of_inverse {f : α → β} {g : β → α} {b : β} {s : set α}
+  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
+  b ∈ f '' s ↔ g b ∈ s :=
+by rw image_eq_preimage_of_inverse h₁ h₂; refl
+
+theorem image_compl_subset {f : α → β} {s : set α} (H : injective f) : f '' sᶜ ⊆ (f '' s)ᶜ :=
+disjoint.subset_compl_left $ by simp [disjoint_iff_inf_le, image_inter H]
+
+theorem subset_image_compl {f : α → β} {s : set α} (H : surjective f) : (f '' s)ᶜ ⊆ f '' sᶜ :=
+compl_subset_iff_union.2 $
+by { rw ← image_union, simp [image_univ_of_surjective H] }
+
+theorem image_compl_eq {f : α → β} {s : set α} (H : bijective f) : f '' sᶜ = (f '' s)ᶜ :=
+subset.antisymm (image_compl_subset H.1) (subset_image_compl H.2)
+
+theorem subset_image_diff (f : α → β) (s t : set α) :
+  f '' s \ f '' t ⊆ f '' (s \ t) :=
+begin
+  rw [diff_subset_iff, ← image_union, union_diff_self],
+  exact image_subset f (subset_union_right t s)
+end
+
+lemma subset_image_symm_diff : (f '' s) ∆ (f '' t) ⊆ f '' s ∆ t :=
+(union_subset_union (subset_image_diff _ _ _) $ subset_image_diff _ _ _).trans
+  (image_union _ _ _).superset
+
+theorem image_diff {f : α → β} (hf : injective f) (s t : set α) :
+  f '' (s \ t) = f '' s \ f '' t :=
+subset.antisymm
+  (subset.trans (image_inter_subset _ _ _) $ inter_subset_inter_right _ $ image_compl_subset hf)
+  (subset_image_diff f s t)
+
+lemma image_symm_diff (hf : injective f) (s t : set α) : f '' (s ∆ t) = (f '' s) ∆ (f '' t) :=
+by simp_rw [set.symm_diff_def, image_union, image_diff hf]
+
+lemma nonempty.image (f : α → β) {s : set α} : s.nonempty → (f '' s).nonempty
+| ⟨x, hx⟩ := ⟨f x, mem_image_of_mem f hx⟩
+
+lemma nonempty.of_image {f : α → β} {s : set α} : (f '' s).nonempty → s.nonempty
+| ⟨y, x, hx, _⟩ := ⟨x, hx⟩
+
+@[simp] lemma nonempty_image_iff {f : α → β} {s : set α} :
+  (f '' s).nonempty ↔ s.nonempty :=
+⟨nonempty.of_image, λ h, h.image f⟩
+
+lemma nonempty.preimage {s : set β} (hs : s.nonempty) {f : α → β} (hf : surjective f) :
+  (f ⁻¹' s).nonempty :=
+let ⟨y, hy⟩ := hs, ⟨x, hx⟩ := hf y in ⟨x, mem_preimage.2 $ hx.symm ▸ hy⟩
+
+instance (f : α → β) (s : set α) [nonempty s] : nonempty (f '' s) :=
+(set.nonempty.image f nonempty_of_nonempty_subtype).to_subtype
+
+/-- image and preimage are a Galois connection -/
+@[simp] theorem image_subset_iff {s : set α} {t : set β} {f : α → β} :
+  f '' s ⊆ t ↔ s ⊆ f ⁻¹' t :=
+ball_image_iff
+
+theorem image_preimage_subset (f : α → β) (s : set β) : f '' (f ⁻¹' s) ⊆ s :=
+image_subset_iff.2 subset.rfl
+
+theorem subset_preimage_image (f : α → β) (s : set α) :
+  s ⊆ f ⁻¹' (f '' s) :=
+λ x, mem_image_of_mem f
+
+theorem preimage_image_eq {f : α → β} (s : set α) (h : injective f) : f ⁻¹' (f '' s) = s :=
+subset.antisymm
+  (λ x ⟨y, hy, e⟩, h e ▸ hy)
+  (subset_preimage_image f s)
+
+theorem image_preimage_eq {f : α → β} (s : set β) (h : surjective f) : f '' (f ⁻¹' s) = s :=
+subset.antisymm
+  (image_preimage_subset f s)
+  (λ x hx, let ⟨y, e⟩ := h x in ⟨y, (e.symm ▸ hx : f y ∈ s), e⟩)
+
+lemma preimage_eq_preimage {f : β → α} (hf : surjective f) : f ⁻¹' s = f ⁻¹' t ↔ s = t :=
+iff.intro
+  (assume eq, by rw [← image_preimage_eq s hf, ← image_preimage_eq t hf, eq])
+  (assume eq, eq ▸ rfl)
+
+lemma image_inter_preimage (f : α → β) (s : set α) (t : set β) :
+  f '' (s ∩ f ⁻¹' t) = f '' s ∩ t :=
+begin
+  apply subset.antisymm,
+  { calc f '' (s ∩ f ⁻¹' t) ⊆ f '' s ∩ (f '' (f⁻¹' t)) : image_inter_subset _ _ _
+  ... ⊆ f '' s ∩ t : inter_subset_inter_right _ (image_preimage_subset f t) },
+  { rintros _ ⟨⟨x, h', rfl⟩, h⟩,
+    exact ⟨x, ⟨h', h⟩, rfl⟩ }
+end
+
+lemma image_preimage_inter (f : α → β) (s : set α) (t : set β) :
+  f '' (f ⁻¹' t ∩ s) = t ∩ f '' s :=
+by simp only [inter_comm, image_inter_preimage]
+
+@[simp] lemma image_inter_nonempty_iff {f : α → β} {s : set α} {t : set β} :
+  (f '' s ∩ t).nonempty ↔ (s ∩ f ⁻¹' t).nonempty :=
+by rw [←image_inter_preimage, nonempty_image_iff]
+
+lemma image_diff_preimage {f : α → β} {s : set α} {t : set β} : f '' (s \ f ⁻¹' t) = f '' s \ t :=
+by simp_rw [diff_eq, ← preimage_compl, image_inter_preimage]
+
+theorem compl_image : image (compl : set α → set α) = preimage compl :=
+image_eq_preimage_of_inverse compl_compl compl_compl
+
+theorem compl_image_set_of {p : set α → Prop} :
+  compl '' {s | p s} = {s | p sᶜ} :=
+congr_fun compl_image p
+
+theorem inter_preimage_subset (s : set α) (t : set β) (f : α → β) :
+  s ∩ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∩ t) :=
+λ x h, ⟨mem_image_of_mem _ h.left, h.right⟩
+
+theorem union_preimage_subset (s : set α) (t : set β) (f : α → β) :
+  s ∪ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∪ t) :=
+λ x h, or.elim h (λ l, or.inl $ mem_image_of_mem _ l) (λ r, or.inr r)
+
+theorem subset_image_union (f : α → β) (s : set α) (t : set β) :
+  f '' (s ∪ f ⁻¹' t) ⊆ f '' s ∪ t :=
+image_subset_iff.2 (union_preimage_subset _ _ _)
+
+lemma preimage_subset_iff {A : set α} {B : set β} {f : α → β} :
+  f⁻¹' B ⊆ A ↔ (∀ a : α, f a ∈ B → a ∈ A) := iff.rfl
+
+lemma image_eq_image {f : α → β} (hf : injective f) : f '' s = f '' t ↔ s = t :=
+iff.symm $ iff.intro (assume eq, eq ▸ rfl) $ assume eq,
+  by rw [← preimage_image_eq s hf, ← preimage_image_eq t hf, eq]
+
+lemma image_subset_image_iff {f : α → β} (hf : injective f) : f '' s ⊆ f '' t ↔ s ⊆ t :=
+begin
+  refine (iff.symm $ iff.intro (image_subset f) $ assume h, _),
+  rw [← preimage_image_eq s hf, ← preimage_image_eq t hf],
+  exact preimage_mono h
+end
+
+lemma prod_quotient_preimage_eq_image [s : setoid α] (g : quotient s → β) {h : α → β}
+  (Hh : h = g ∘ quotient.mk) (r : set (β × β)) :
+  {x : quotient s × quotient s | (g x.1, g x.2) ∈ r} =
+  (λ a : α × α, (⟦a.1⟧, ⟦a.2⟧)) '' ((λ a : α × α, (h a.1, h a.2)) ⁻¹' r) :=
+Hh.symm ▸ set.ext (λ ⟨a₁, a₂⟩, ⟨quotient.induction_on₂ a₁ a₂
+  (λ a₁ a₂ h, ⟨(a₁, a₂), h, rfl⟩),
+  λ ⟨⟨b₁, b₂⟩, h₁, h₂⟩, show (g a₁, g a₂) ∈ r, from
+  have h₃ : ⟦b₁⟧ = a₁ ∧ ⟦b₂⟧ = a₂ := prod.ext_iff.1 h₂,
+    h₃.1 ▸ h₃.2 ▸ h₁⟩)
+
+lemma exists_image_iff (f : α → β) (x : set α) (P : β → Prop) :
+  (∃ (a : f '' x), P a) ↔ ∃ (a : x), P (f a) :=
+⟨λ ⟨a, h⟩, ⟨⟨_, a.prop.some_spec.1⟩, a.prop.some_spec.2.symm ▸ h⟩,
+  λ ⟨a, h⟩, ⟨⟨_, _, a.prop, rfl⟩, h⟩⟩
+
+/-- Restriction of `f` to `s` factors through `s.image_factorization f : s → f '' s`. -/
+def image_factorization (f : α → β) (s : set α) : s → f '' s :=
+λ p, ⟨f p.1, mem_image_of_mem f p.2⟩
+
+lemma image_factorization_eq {f : α → β} {s : set α} :
+  subtype.val ∘ image_factorization f s = f ∘ subtype.val :=
+funext $ λ p, rfl
+
+lemma surjective_onto_image {f : α → β} {s : set α} :
+  surjective (image_factorization f s) :=
+λ ⟨_, ⟨a, ha, rfl⟩⟩, ⟨⟨a, ha⟩, rfl⟩
+
+/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect.
+-/
+lemma image_perm {s : set α} {σ : equiv.perm α} (hs : {a : α | σ a ≠ a} ⊆ s) : σ '' s = s :=
+begin
+  ext i,
+  obtain hi | hi := eq_or_ne (σ i) i,
+  { refine ⟨_, λ h, ⟨i, h, hi⟩⟩,
+    rintro ⟨j, hj, h⟩,
+    rwa σ.injective (hi.trans h.symm) },
+  { refine iff_of_true ⟨σ.symm i, hs $ λ h, hi _, σ.apply_symm_apply _⟩ (hs hi),
+    convert congr_arg σ h; exact (σ.apply_symm_apply _).symm }
+end
+
+end image
+
+/-! ### Lemmas about range of a function. -/
+section range
+variables {f : ι → α} {s t : set α}
+
+/-- Range of a function.
+
+This function is more flexible than `f '' univ`, as the image requires that the domain is in Type
+and not an arbitrary Sort. -/
+def range (f : ι → α) : set α := {x | ∃y, f y = x}
+
+@[simp] theorem mem_range {x : α} : x ∈ range f ↔ ∃ y, f y = x := iff.rfl
+
+@[simp] theorem mem_range_self (i : ι) : f i ∈ range f := ⟨i, rfl⟩
+
+theorem forall_range_iff {p : α → Prop} : (∀ a ∈ range f, p a) ↔ (∀ i, p (f i)) :=
+by simp
+
+theorem forall_subtype_range_iff {p : range f → Prop} :
+  (∀ a : range f, p a) ↔ ∀ i, p ⟨f i, mem_range_self _⟩ :=
+⟨λ H i, H _, λ H ⟨y, i, hi⟩, by { subst hi, apply H }⟩
+
+theorem exists_range_iff {p : α → Prop} : (∃ a ∈ range f, p a) ↔ (∃ i, p (f i)) :=
+by simp
+
+lemma exists_range_iff' {p : α → Prop} :
+  (∃ a, a ∈ range f ∧ p a) ↔ ∃ i, p (f i) :=
+by simpa only [exists_prop] using exists_range_iff
+
+lemma exists_subtype_range_iff {p : range f → Prop} :
+  (∃ a : range f, p a) ↔ ∃ i, p ⟨f i, mem_range_self _⟩ :=
+⟨λ ⟨⟨a, i, hi⟩, ha⟩, by { subst a, exact ⟨i, ha⟩}, λ ⟨i, hi⟩, ⟨_, hi⟩⟩
+
+theorem range_iff_surjective : range f = univ ↔ surjective f :=
+eq_univ_iff_forall
+
+alias range_iff_surjective ↔ _ _root_.function.surjective.range_eq
+
+@[simp] theorem image_univ {f : α → β} : f '' univ = range f :=
+by { ext, simp [image, range] }
+
+theorem image_subset_range (f : α → β) (s) : f '' s ⊆ range f :=
+by rw ← image_univ; exact image_subset _ (subset_univ _)
+
+theorem mem_range_of_mem_image (f : α → β) (s) {x : β} (h : x ∈ f '' s) : x ∈ range f :=
+image_subset_range f s h
+
+lemma _root_.nat.mem_range_succ (i : ℕ) : i ∈ range nat.succ ↔ 0 < i :=
+⟨by { rintros ⟨n, rfl⟩, exact nat.succ_pos n, }, λ h, ⟨_, nat.succ_pred_eq_of_pos h⟩⟩
+
+lemma nonempty.preimage' {s : set β} (hs : s.nonempty) {f : α → β} (hf : s ⊆ set.range f) :
+  (f ⁻¹' s).nonempty :=
+let ⟨y, hy⟩ := hs, ⟨x, hx⟩ := hf hy in ⟨x, set.mem_preimage.2 $ hx.symm ▸ hy⟩
+
+theorem range_comp (g : α → β) (f : ι → α) : range (g ∘ f) = g '' range f :=
+subset.antisymm
+  (forall_range_iff.mpr $ assume i, mem_image_of_mem g (mem_range_self _))
+  (ball_image_iff.mpr $ forall_range_iff.mpr mem_range_self)
+
+theorem range_subset_iff : range f ⊆ s ↔ ∀ y, f y ∈ s :=
+forall_range_iff
+
+theorem range_eq_iff (f : α → β) (s : set β) :
+  range f = s ↔ (∀ a, f a ∈ s) ∧ ∀ b ∈ s, ∃ a, f a = b :=
+by { rw ←range_subset_iff, exact le_antisymm_iff }
+
+lemma range_comp_subset_range (f : α → β) (g : β → γ) : range (g ∘ f) ⊆ range g :=
+by rw range_comp; apply image_subset_range
+
+lemma range_nonempty_iff_nonempty : (range f).nonempty ↔ nonempty ι :=
+⟨λ ⟨y, x, hxy⟩, ⟨x⟩, λ ⟨x⟩, ⟨f x, mem_range_self x⟩⟩
+
+lemma range_nonempty [h : nonempty ι] (f : ι → α) : (range f).nonempty :=
+range_nonempty_iff_nonempty.2 h
+
+@[simp] lemma range_eq_empty_iff {f : ι → α} : range f = ∅ ↔ is_empty ι :=
+by rw [← not_nonempty_iff, ← range_nonempty_iff_nonempty, not_nonempty_iff_eq_empty]
+
+lemma range_eq_empty [is_empty ι] (f : ι → α) : range f = ∅ := range_eq_empty_iff.2 ‹_›
+
+instance [nonempty ι] (f : ι → α) : nonempty (range f) := (range_nonempty f).to_subtype
+
+@[simp] lemma image_union_image_compl_eq_range (f : α → β) :
+  (f '' s) ∪ (f '' sᶜ) = range f :=
+by rw [← image_union, ← image_univ, ← union_compl_self]
+
+lemma insert_image_compl_eq_range (f : α → β) (x : α) :
+  insert (f x) (f '' {x}ᶜ) = range f :=
+begin
+  ext y, rw [mem_range, mem_insert_iff, mem_image],
+  split,
+  { rintro (h | ⟨x', hx', h⟩),
+    { exact ⟨x, h.symm⟩ },
+    { exact ⟨x', h⟩ } },
+  { rintro ⟨x', h⟩,
+    by_cases hx : x' = x,
+    { left, rw [← h, hx] },
+    { right, refine ⟨_, _, h⟩, rw mem_compl_singleton_iff, exact hx } }
+end
+
+theorem image_preimage_eq_inter_range {f : α → β} {t : set β} :
+  f '' (f ⁻¹' t) = t ∩ range f :=
+ext $ assume x, ⟨assume ⟨x, hx, heq⟩, heq ▸ ⟨hx, mem_range_self _⟩,
+  assume ⟨hx, ⟨y, h_eq⟩⟩, h_eq ▸ mem_image_of_mem f $
+    show y ∈ f ⁻¹' t, by simp [preimage, h_eq, hx]⟩
+
+lemma image_preimage_eq_of_subset {f : α → β} {s : set β} (hs : s ⊆ range f) :
+  f '' (f ⁻¹' s) = s :=
+by rw [image_preimage_eq_inter_range, inter_eq_self_of_subset_left hs]
+
+lemma image_preimage_eq_iff {f : α → β} {s : set β} : f '' (f ⁻¹' s) = s ↔ s ⊆ range f :=
+⟨by { intro h, rw [← h], apply image_subset_range }, image_preimage_eq_of_subset⟩
+
+lemma subset_range_iff_exists_image_eq {f : α → β} {s : set β} :
+  s ⊆ range f ↔ ∃ t, f '' t = s :=
+⟨λ h, ⟨_, image_preimage_eq_iff.2 h⟩, λ ⟨t, ht⟩, ht ▸ image_subset_range _ _⟩
+
+@[simp] lemma exists_subset_range_and_iff {f : α → β} {p : set β → Prop} :
+  (∃ s, s ⊆ range f ∧ p s) ↔ ∃ s, p (f '' s) :=
+⟨λ ⟨s, hsf, hps⟩, ⟨f ⁻¹' s, (image_preimage_eq_of_subset hsf).symm ▸ hps⟩,
+  λ ⟨s, hs⟩, ⟨f '' s, image_subset_range _ _, hs⟩⟩
+
+lemma exists_subset_range_iff {f : α → β} {p : set β → Prop} :
+  (∃ s ⊆ range f, p s) ↔ ∃ s, p (f '' s) :=
+by simp only [exists_prop, exists_subset_range_and_iff]
+
+lemma range_image (f : α → β) : range (image f) = 𝒫 (range f) :=
+ext $ λ s, subset_range_iff_exists_image_eq.symm
+
+lemma preimage_subset_preimage_iff {s t : set α} {f : β → α} (hs : s ⊆ range f) :
+  f ⁻¹' s ⊆ f ⁻¹' t ↔ s ⊆ t :=
+begin
+  split,
+  { intros h x hx, rcases hs hx with ⟨y, rfl⟩, exact h hx },
+  intros h x, apply h
+end
+
+lemma preimage_eq_preimage' {s t : set α} {f : β → α} (hs : s ⊆ range f) (ht : t ⊆ range f) :
+  f ⁻¹' s = f ⁻¹' t ↔ s = t :=
+begin
+  split,
+  { intro h, apply subset.antisymm, rw [←preimage_subset_preimage_iff hs, h],
+    rw [←preimage_subset_preimage_iff ht, h] },
+  rintro rfl, refl
+end
+
+@[simp] theorem preimage_inter_range {f : α → β} {s : set β} : f ⁻¹' (s ∩ range f) = f ⁻¹' s :=
+set.ext $ λ x, and_iff_left ⟨x, rfl⟩
+
+@[simp] theorem preimage_range_inter {f : α → β} {s : set β} : f ⁻¹' (range f ∩ s) = f ⁻¹' s :=
+by rw [inter_comm, preimage_inter_range]
+
+theorem preimage_image_preimage {f : α → β} {s : set β} :
+  f ⁻¹' (f '' (f ⁻¹' s)) = f ⁻¹' s :=
+by rw [image_preimage_eq_inter_range, preimage_inter_range]
+
+@[simp] theorem range_id : range (@id α) = univ := range_iff_surjective.2 surjective_id
+
+@[simp] theorem range_id' : range (λ (x : α), x) = univ := range_id
+
+@[simp] theorem _root_.prod.range_fst [nonempty β] : range (prod.fst : α × β → α) = univ :=
+prod.fst_surjective.range_eq
+
+@[simp] theorem _root_.prod.range_snd [nonempty α] : range (prod.snd : α × β → β) = univ :=
+prod.snd_surjective.range_eq
+
+@[simp] theorem range_eval {ι : Type*} {α : ι → Sort*} [Π i, nonempty (α i)] (i : ι) :
+  range (eval i : (Π i, α i) → α i) = univ :=
+(surjective_eval i).range_eq
+
+theorem is_compl_range_inl_range_inr : is_compl (range $ @sum.inl α β) (range sum.inr) :=
+is_compl.of_le
+  (by { rintro y ⟨⟨x₁, rfl⟩, ⟨x₂, _⟩⟩, cc })
+  (by { rintro (x|y) -; [left, right]; exact mem_range_self _ })
+
+@[simp] theorem range_inl_union_range_inr : range (sum.inl : α → α ⊕ β) ∪ range sum.inr = univ :=
+is_compl_range_inl_range_inr.sup_eq_top
+
+@[simp] theorem range_inl_inter_range_inr : range (sum.inl : α → α ⊕ β) ∩ range sum.inr = ∅ :=
+is_compl_range_inl_range_inr.inf_eq_bot
+
+@[simp] theorem range_inr_union_range_inl : range (sum.inr : β → α ⊕ β) ∪ range sum.inl = univ :=
+is_compl_range_inl_range_inr.symm.sup_eq_top
+
+@[simp] theorem range_inr_inter_range_inl : range (sum.inr : β → α ⊕ β) ∩ range sum.inl = ∅ :=
+is_compl_range_inl_range_inr.symm.inf_eq_bot
+
+@[simp] theorem preimage_inl_image_inr (s : set β) : sum.inl ⁻¹' (@sum.inr α β '' s) = ∅ :=
+by { ext, simp }
+
+@[simp] theorem preimage_inr_image_inl (s : set α) : sum.inr ⁻¹' (@sum.inl α β '' s) = ∅ :=
+by { ext, simp }
+
+@[simp] theorem preimage_inl_range_inr : sum.inl ⁻¹' range (sum.inr : β → α ⊕ β) = ∅ :=
+by rw [← image_univ, preimage_inl_image_inr]
+
+@[simp] theorem preimage_inr_range_inl : sum.inr ⁻¹' range (sum.inl : α → α ⊕ β) = ∅ :=
+by rw [← image_univ, preimage_inr_image_inl]
+
+@[simp] lemma compl_range_inl : (range (sum.inl : α → α ⊕ β))ᶜ = range (sum.inr : β → α ⊕ β) :=
+is_compl.compl_eq is_compl_range_inl_range_inr
+
+@[simp] lemma compl_range_inr : (range (sum.inr : β → α ⊕ β))ᶜ = range (sum.inl : α → α ⊕ β) :=
+is_compl.compl_eq is_compl_range_inl_range_inr.symm
+
+theorem image_preimage_inl_union_image_preimage_inr (s : set (α ⊕ β)) :
+  sum.inl '' (sum.inl ⁻¹' s) ∪ sum.inr '' (sum.inr ⁻¹' s) = s :=
+by rw [image_preimage_eq_inter_range, image_preimage_eq_inter_range, ← inter_distrib_left,
+  range_inl_union_range_inr, inter_univ]
+
+@[simp] theorem range_quot_mk (r : α → α → Prop) : range (quot.mk r) = univ :=
+(surjective_quot_mk r).range_eq
+
+@[simp] theorem range_quot_lift {r : ι → ι → Prop} (hf : ∀ x y, r x y → f x = f y) :
+  range (quot.lift f hf) = range f :=
+ext $ λ y, (surjective_quot_mk _).exists
+
+@[simp] theorem range_quotient_mk [setoid α] : range (λx : α, ⟦x⟧) = univ :=
+range_quot_mk _
+
+@[simp] theorem range_quotient_lift [s : setoid ι] (hf) :
+  range (quotient.lift f hf : quotient s → α) = range f :=
+range_quot_lift _
+
+@[simp] theorem range_quotient_mk' {s : setoid α} : range (quotient.mk' : α → quotient s) = univ :=
+range_quot_mk _
+
+@[simp] theorem range_quotient_lift_on' {s : setoid ι} (hf) :
+  range (λ x : quotient s, quotient.lift_on' x f hf) = range f :=
+range_quot_lift _
+
+instance can_lift (c) (p) [can_lift α β c p] :
+  can_lift (set α) (set β) (('') c) (λ s, ∀ x ∈ s, p x) :=
+{ prf := λ s hs, subset_range_iff_exists_image_eq.mp (λ x hx, can_lift.prf _ (hs x hx)) }
+
+lemma range_const_subset {c : α} : range (λ x : ι, c) ⊆ {c} :=
+range_subset_iff.2 $ λ x, rfl
+
+@[simp] lemma range_const : ∀ [nonempty ι] {c : α}, range (λx:ι, c) = {c}
+| ⟨x⟩ c := subset.antisymm range_const_subset $
+  assume y hy, (mem_singleton_iff.1 hy).symm ▸ mem_range_self x
+
+lemma range_subtype_map {p : α → Prop} {q : β → Prop} (f : α → β) (h : ∀ x, p x → q (f x)) :
+  range (subtype.map f h) = coe ⁻¹' (f '' {x | p x}) :=
+begin
+  ext ⟨x, hx⟩,
+  simp_rw [mem_preimage, mem_range, mem_image, subtype.exists, subtype.map, subtype.coe_mk,
+    mem_set_of, exists_prop]
+end
+
+lemma image_swap_eq_preimage_swap : image (@prod.swap α β) = preimage prod.swap :=
+image_eq_preimage_of_inverse prod.swap_left_inverse prod.swap_right_inverse
+
+theorem preimage_singleton_nonempty {f : α → β} {y : β} :
+  (f ⁻¹' {y}).nonempty ↔ y ∈ range f :=
+iff.rfl
+
+theorem preimage_singleton_eq_empty {f : α → β} {y : β} :
+  f ⁻¹' {y} = ∅ ↔ y ∉ range f :=
+not_nonempty_iff_eq_empty.symm.trans preimage_singleton_nonempty.not
+
+lemma range_subset_singleton {f : ι → α} {x : α} : range f ⊆ {x} ↔ f = const ι x :=
+by simp [range_subset_iff, funext_iff, mem_singleton]
+
+lemma image_compl_preimage {f : α → β} {s : set β} : f '' ((f ⁻¹' s)ᶜ) = range f \ s :=
+by rw [compl_eq_univ_diff, image_diff_preimage, image_univ]
+
+/-- Any map `f : ι → β` factors through a map `range_factorization f : ι → range f`. -/
+def range_factorization (f : ι → β) : ι → range f :=
+λ i, ⟨f i, mem_range_self i⟩
+
+lemma range_factorization_eq {f : ι → β} :
+  subtype.val ∘ range_factorization f = f :=
+funext $ λ i, rfl
+
+@[simp] lemma range_factorization_coe (f : ι → β) (a : ι) :
+  (range_factorization f a : β) = f a := rfl
+
+@[simp] lemma coe_comp_range_factorization (f : ι → β) : coe ∘ range_factorization f = f := rfl
+
+lemma surjective_onto_range : surjective (range_factorization f) :=
+λ ⟨_, ⟨i, rfl⟩⟩, ⟨i, rfl⟩
+
+lemma image_eq_range (f : α → β) (s : set α) : f '' s = range (λ(x : s), f x) :=
+by { ext, split, rintro ⟨x, h1, h2⟩, exact ⟨⟨x, h1⟩, h2⟩, rintro ⟨⟨x, h1⟩, h2⟩, exact ⟨x, h1, h2⟩ }
+
+lemma _root_.sum.range_eq (f : α ⊕ β → γ) : range f = range (f ∘ sum.inl) ∪ range (f ∘ sum.inr) :=
+ext $ λ x, sum.exists
+
+@[simp] lemma sum.elim_range (f : α → γ) (g : β → γ) : range (sum.elim f g) = range f ∪ range g :=
+sum.range_eq _
+
+lemma range_ite_subset' {p : Prop} [decidable p] {f g : α → β} :
+  range (if p then f else g) ⊆ range f ∪ range g :=
+begin
+  by_cases h : p, {rw if_pos h, exact subset_union_left _ _},
+  {rw if_neg h, exact subset_union_right _ _}
+end
+
+lemma range_ite_subset {p : α → Prop} [decidable_pred p] {f g : α → β} :
+  range (λ x, if p x then f x else g x) ⊆ range f ∪ range g :=
+begin
+  rw range_subset_iff, intro x, by_cases h : p x,
+  simp [if_pos h, mem_union, mem_range_self],
+  simp [if_neg h, mem_union, mem_range_self]
+end
+
+@[simp] lemma preimage_range (f : α → β) : f ⁻¹' (range f) = univ :=
+eq_univ_of_forall mem_range_self
+
+/-- The range of a function from a `unique` type contains just the
+function applied to its single value. -/
+lemma range_unique [h : unique ι] : range f = {f default} :=
+begin
+  ext x,
+  rw mem_range,
+  split,
+  { rintros ⟨i, hi⟩,
+    rw h.uniq i at hi,
+    exact hi ▸ mem_singleton _ },
+  { exact λ h, ⟨default, h.symm⟩ }
+end
+
+lemma range_diff_image_subset (f : α → β) (s : set α) :
+  range f \ f '' s ⊆ f '' sᶜ :=
+λ y ⟨⟨x, h₁⟩, h₂⟩, ⟨x, λ h, h₂ ⟨x, h, h₁⟩, h₁⟩
+
+lemma range_diff_image {f : α → β} (H : injective f) (s : set α) :
+  range f \ f '' s = f '' sᶜ :=
+subset.antisymm (range_diff_image_subset f s) $ λ y ⟨x, hx, hy⟩, hy ▸
+  ⟨mem_range_self _, λ ⟨x', hx', eq⟩, hx $ H eq ▸ hx'⟩
+
+
+@[simp] lemma range_inclusion (h : s ⊆ t) : range (inclusion h) = {x : t | (x:α) ∈ s} :=
+by { ext ⟨x, hx⟩, simp [inclusion] }
+
+/-- We can use the axiom of choice to pick a preimage for every element of `range f`. -/
+noncomputable def range_splitting (f : α → β) : range f → α := λ x, x.2.some
+
+-- This can not be a `@[simp]` lemma because the head of the left hand side is a variable.
+lemma apply_range_splitting (f : α → β) (x : range f) : f (range_splitting f x) = x :=
+x.2.some_spec
+
+attribute [irreducible] range_splitting
+
+@[simp] lemma comp_range_splitting (f : α → β) : f ∘ range_splitting f = coe :=
+by { ext, simp only [function.comp_app], apply apply_range_splitting, }
+
+-- When `f` is injective, see also `equiv.of_injective`.
+lemma left_inverse_range_splitting (f : α → β) :
+  left_inverse (range_factorization f) (range_splitting f) :=
+λ x, by { ext, simp only [range_factorization_coe], apply apply_range_splitting, }
+
+lemma range_splitting_injective (f : α → β) : injective (range_splitting f) :=
+(left_inverse_range_splitting f).injective
+
+lemma right_inverse_range_splitting {f : α → β} (h : injective f) :
+  right_inverse (range_factorization f) (range_splitting f) :=
+(left_inverse_range_splitting f).right_inverse_of_injective $
+  λ x y hxy, h $ subtype.ext_iff.1 hxy
+
+lemma preimage_range_splitting {f : α → β} (hf : injective f) :
+  preimage (range_splitting f) = image (range_factorization f) :=
+(image_eq_preimage_of_inverse (right_inverse_range_splitting hf)
+  (left_inverse_range_splitting f)).symm
+
+lemma is_compl_range_some_none (α : Type*) :
+  is_compl (range (some : α → option α)) {none} :=
+is_compl.of_le
+  (λ x ⟨⟨a, ha⟩, (hn : x = none)⟩, option.some_ne_none _ (ha.trans hn))
+  (λ x hx, option.cases_on x (or.inr rfl) (λ x, or.inl $ mem_range_self _))
+
+@[simp] lemma compl_range_some (α : Type*) :
+  (range (some : α → option α))ᶜ = {none} :=
+(is_compl_range_some_none α).compl_eq
+
+@[simp] lemma range_some_inter_none (α : Type*) : range (some : α → option α) ∩ {none} = ∅ :=
+(is_compl_range_some_none α).inf_eq_bot
+
+@[simp] lemma range_some_union_none (α : Type*) : range (some : α → option α) ∪ {none} = univ :=
+(is_compl_range_some_none α).sup_eq_top
+
+@[simp] lemma insert_none_range_some (α : Type*) :
+  insert none (range (some : α → option α)) = univ :=
+(is_compl_range_some_none α).symm.sup_eq_top
+
+end range
+
+section subsingleton
+variables {s : set α}
+
+/-- The image of a subsingleton is a subsingleton. -/
+lemma subsingleton.image (hs : s.subsingleton) (f : α → β) : (f '' s).subsingleton :=
+λ _ ⟨x, hx, Hx⟩ _ ⟨y, hy, Hy⟩, Hx ▸ Hy ▸ congr_arg f (hs hx hy)
+
+/-- The preimage of a subsingleton under an injective map is a subsingleton. -/
+theorem subsingleton.preimage {s : set β} (hs : s.subsingleton) {f : α → β}
+  (hf : function.injective f) : (f ⁻¹' s).subsingleton := λ a ha b hb, hf $ hs ha hb
+
+/-- If the image of a set under an injective map is a subsingleton, the set is a subsingleton. -/
+theorem subsingleton_of_image {α β : Type*} {f : α → β} (hf : function.injective f)
+  (s : set α) (hs : (f '' s).subsingleton) : s.subsingleton :=
+(hs.preimage hf).anti $ subset_preimage_image _ _
+
+/-- If the preimage of a set under an surjective map is a subsingleton,
+the set is a subsingleton. -/
+theorem subsingleton_of_preimage {α β : Type*} {f : α → β} (hf : function.surjective f)
+  (s : set β) (hs : (f ⁻¹' s).subsingleton) : s.subsingleton :=
+λ fx hx fy hy, by { rcases ⟨hf fx, hf fy⟩ with ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩, exact congr_arg f (hs hx hy) }
+
+lemma subsingleton_range {α : Sort*} [subsingleton α] (f : α → β) : (range f).subsingleton :=
+forall_range_iff.2 $ λ x, forall_range_iff.2 $ λ y, congr_arg f (subsingleton.elim x y)
+
+/-- The preimage of a nontrivial set under a surjective map is nontrivial. -/
+theorem nontrivial.preimage {s : set β} (hs : s.nontrivial) {f : α → β}
+  (hf : function.surjective f) : (f ⁻¹' s).nontrivial :=
+begin
+  rcases hs with ⟨fx, hx, fy, hy, hxy⟩,
+  rcases ⟨hf fx, hf fy⟩ with ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩,
+  exact ⟨x, hx, y, hy, mt (congr_arg f) hxy⟩
+end
+
+/-- The image of a nontrivial set under an injective map is nontrivial. -/
+theorem nontrivial.image (hs : s.nontrivial)
+  {f : α → β} (hf : function.injective f) : (f '' s).nontrivial :=
+let ⟨x, hx, y, hy, hxy⟩ := hs in ⟨f x, mem_image_of_mem f hx, f y, mem_image_of_mem f hy, hf.ne hxy⟩
+
+/-- If the image of a set is nontrivial, the set is nontrivial. -/
+lemma nontrivial_of_image (f : α → β) (s : set α) (hs : (f '' s).nontrivial) : s.nontrivial :=
+let ⟨_, ⟨x, hx, rfl⟩, _, ⟨y, hy, rfl⟩, hxy⟩ := hs in ⟨x, hx, y, hy, mt (congr_arg f) hxy⟩
+
+/-- If the preimage of a set under an injective map is nontrivial, the set is nontrivial. -/
+lemma nontrivial_of_preimage {f : α → β} (hf : function.injective f) (s : set β)
+  (hs : (f ⁻¹' s).nontrivial) : s.nontrivial :=
+(hs.image hf).mono $ image_preimage_subset _ _
+
+end subsingleton
+
+end set
+
+namespace function
+
+variables {ι : Sort*} {α : Type*} {β : Type*} {f : α → β}
+
+open set
+
+lemma surjective.preimage_injective (hf : surjective f) : injective (preimage f) :=
+assume s t, (preimage_eq_preimage hf).1
+
+lemma injective.preimage_image (hf : injective f) (s : set α) : f ⁻¹' (f '' s) = s :=
+preimage_image_eq s hf
+
+lemma injective.preimage_surjective (hf : injective f) : surjective (preimage f) :=
+by { intro s, use f '' s, rw hf.preimage_image }
+
+lemma injective.subsingleton_image_iff (hf : injective f) {s : set α} :
+  (f '' s).subsingleton ↔ s.subsingleton :=
+⟨subsingleton_of_image hf s, λ h, h.image f⟩
+
+lemma surjective.image_preimage (hf : surjective f) (s : set β) : f '' (f ⁻¹' s) = s :=
+image_preimage_eq s hf
+
+lemma surjective.image_surjective (hf : surjective f) : surjective (image f) :=
+by { intro s, use f ⁻¹' s, rw hf.image_preimage }
+
+lemma surjective.nonempty_preimage (hf : surjective f) {s : set β} :
+  (f ⁻¹' s).nonempty ↔ s.nonempty :=
+by rw [← nonempty_image_iff, hf.image_preimage]
+
+lemma injective.image_injective (hf : injective f) : injective (image f) :=
+by { intros s t h, rw [←preimage_image_eq s hf, ←preimage_image_eq t hf, h] }
+
+lemma surjective.preimage_subset_preimage_iff {s t : set β} (hf : surjective f) :
+  f ⁻¹' s ⊆ f ⁻¹' t ↔ s ⊆ t :=
+by { apply preimage_subset_preimage_iff, rw [hf.range_eq], apply subset_univ }
+
+lemma surjective.range_comp {ι' : Sort*} {f : ι → ι'} (hf : surjective f) (g : ι' → α) :
+  range (g ∘ f) = range g :=
+ext $ λ y, (@surjective.exists _ _ _ hf (λ x, g x = y)).symm
+
+lemma injective.mem_range_iff_exists_unique (hf : injective f) {b : β} :
+  b ∈ range f ↔ ∃! a, f a = b :=
+⟨λ ⟨a, h⟩, ⟨a, h, λ a' ha, hf (ha.trans h.symm)⟩, exists_unique.exists⟩
+
+lemma injective.exists_unique_of_mem_range (hf : injective f) {b : β} (hb : b ∈ range f) :
+  ∃! a, f a = b :=
+hf.mem_range_iff_exists_unique.mp hb
+
+theorem injective.compl_image_eq (hf : injective f) (s : set α) :
+  (f '' s)ᶜ = f '' sᶜ ∪ (range f)ᶜ :=
+begin
+  ext y,
+  rcases em (y ∈ range f) with ⟨x, rfl⟩|hx,
+  { simp [hf.eq_iff] },
+  { rw [mem_range, not_exists] at hx,
+    simp [hx] }
+end
+
+lemma left_inverse.image_image {g : β → α} (h : left_inverse g f) (s : set α) :
+  g '' (f '' s) = s :=
+by rw [← image_comp, h.comp_eq_id, image_id]
+
+lemma left_inverse.preimage_preimage {g : β → α} (h : left_inverse g f) (s : set α) :
+  f ⁻¹' (g ⁻¹' s) = s :=
+by rw [← preimage_comp, h.comp_eq_id, preimage_id]
+
+end function
+
+/-! ### Image and preimage on subtypes -/
+
+namespace subtype
+open set
+
+variable {α : Type*}
+
+lemma coe_image {p : α → Prop} {s : set (subtype p)} :
+  coe '' s = {x | ∃h : p x, (⟨x, h⟩ : subtype p) ∈ s} :=
+set.ext $ assume a,
+⟨assume ⟨⟨a', ha'⟩, in_s, h_eq⟩, h_eq ▸ ⟨ha', in_s⟩,
+  assume ⟨ha, in_s⟩, ⟨⟨a, ha⟩, in_s, rfl⟩⟩
+
+@[simp] lemma coe_image_of_subset {s t : set α} (h : t ⊆ s) : coe '' {x : ↥s | ↑x ∈ t} = t :=
+begin
+  ext x,
+  rw set.mem_image,
+  exact ⟨λ ⟨x', hx', hx⟩, hx ▸ hx', λ hx, ⟨⟨x, h hx⟩, hx, rfl⟩⟩,
+end
+
+lemma range_coe {s : set α} :
+  range (coe : s → α) = s :=
+by { rw ← set.image_univ, simp [-set.image_univ, coe_image] }
+
+/-- A variant of `range_coe`. Try to use `range_coe` if possible.
+  This version is useful when defining a new type that is defined as the subtype of something.
+  In that case, the coercion doesn't fire anymore. -/
+lemma range_val {s : set α} :
+  range (subtype.val : s → α) = s :=
+range_coe
+
+/-- We make this the simp lemma instead of `range_coe`. The reason is that if we write
+  for `s : set α` the function `coe : s → α`, then the inferred implicit arguments of `coe` are
+  `coe α (λ x, x ∈ s)`. -/
+@[simp] lemma range_coe_subtype {p : α → Prop} :
+  range (coe : subtype p → α) = {x | p x} :=
+range_coe
+
+@[simp] lemma coe_preimage_self (s : set α) : (coe : s → α) ⁻¹' s = univ :=
+by rw [← preimage_range (coe : s → α), range_coe]
+
+lemma range_val_subtype {p : α → Prop} :
+  range (subtype.val : subtype p → α) = {x | p x} :=
+range_coe
+
+theorem coe_image_subset (s : set α) (t : set s) : coe '' t ⊆ s :=
+λ x ⟨y, yt, yvaleq⟩, by rw ←yvaleq; exact y.property
+
+theorem coe_image_univ (s : set α) : (coe : s → α) '' set.univ = s :=
+image_univ.trans range_coe
+
+@[simp] theorem image_preimage_coe (s t : set α) :
+  (coe : s → α) '' (coe ⁻¹' t) = t ∩ s :=
+image_preimage_eq_inter_range.trans $ congr_arg _ range_coe
+
+theorem image_preimage_val (s t : set α) :
+  (subtype.val : s → α) '' (subtype.val ⁻¹' t) = t ∩ s :=
+image_preimage_coe s t
+
+theorem preimage_coe_eq_preimage_coe_iff {s t u : set α} :
+  ((coe : s → α) ⁻¹' t = coe ⁻¹' u) ↔ t ∩ s = u ∩ s :=
+by rw [← image_preimage_coe, ← image_preimage_coe, coe_injective.image_injective.eq_iff]
+
+@[simp] theorem preimage_coe_inter_self (s t : set α) :
+  (coe : s → α) ⁻¹' (t ∩ s) = coe ⁻¹' t :=
+by rw [preimage_coe_eq_preimage_coe_iff, inter_assoc, inter_self]
+
+theorem preimage_val_eq_preimage_val_iff (s t u : set α) :
+  ((subtype.val : s → α) ⁻¹' t = subtype.val ⁻¹' u) ↔ (t ∩ s = u ∩ s) :=
+preimage_coe_eq_preimage_coe_iff
+
+lemma exists_set_subtype {t : set α} (p : set α → Prop) :
+  (∃(s : set t), p (coe '' s)) ↔ ∃(s : set α), s ⊆ t ∧ p s :=
+begin
+  split,
+  { rintro ⟨s, hs⟩, refine ⟨coe '' s, _, hs⟩,
+    convert image_subset_range _ _, rw [range_coe] },
+  rintro ⟨s, hs₁, hs₂⟩, refine ⟨coe ⁻¹' s, _⟩,
+  rw [image_preimage_eq_of_subset], exact hs₂, rw [range_coe], exact hs₁
+end
+
+lemma preimage_coe_nonempty {s t : set α} : ((coe : s → α) ⁻¹' t).nonempty ↔ (s ∩ t).nonempty :=
+by rw [inter_comm, ← image_preimage_coe, nonempty_image_iff]
+
+lemma preimage_coe_eq_empty {s t : set α} : (coe : s → α) ⁻¹' t = ∅ ↔ s ∩ t = ∅ :=
+by simp only [← not_nonempty_iff_eq_empty, preimage_coe_nonempty]
+
+@[simp] lemma preimage_coe_compl (s : set α) : (coe : s → α) ⁻¹' sᶜ = ∅ :=
+preimage_coe_eq_empty.2 (inter_compl_self s)
+
+@[simp] lemma preimage_coe_compl' (s : set α) : (coe : sᶜ → α) ⁻¹' s = ∅ :=
+preimage_coe_eq_empty.2 (compl_inter_self s)
+
+end subtype
+
+/-! ### Images and preimages on `option` -/
+open set
+
+namespace option
+
+lemma injective_iff {α β} {f : option α → β} :
+  injective f ↔ injective (f ∘ some) ∧ f none ∉ range (f ∘ some) :=
+begin
+  simp only [mem_range, not_exists, (∘)],
+  refine ⟨λ hf, ⟨hf.comp (option.some_injective _), λ x, hf.ne $ option.some_ne_none _⟩, _⟩,
+  rintro ⟨h_some, h_none⟩ (_|a) (_|b) hab,
+  exacts [rfl, (h_none _ hab.symm).elim, (h_none _ hab).elim, congr_arg some (h_some hab)]
+end
+
+lemma range_eq {α β} (f : option α → β) : range f = insert (f none) (range (f ∘ some)) :=
+set.ext $ λ y, option.exists.trans $ eq_comm.or iff.rfl
+
+end option
+
+lemma with_bot.range_eq {α β} (f : with_bot α → β) :
+  range f = insert (f ⊥) (range (f ∘ coe : α → β)) :=
+option.range_eq f
+
+lemma with_top.range_eq {α β} (f : with_top α → β) :
+  range f = insert (f ⊤) (range (f ∘ coe : α → β)) :=
+option.range_eq f
+
+namespace set
+open function
+
+/-! ### Injectivity and sur<jectivity lemmas for image and preimage -/
+
+section image_preimage
+variables {α : Type u} {β : Type v} {f : α → β}
+@[simp]
+lemma preimage_injective : injective (preimage f) ↔ surjective f :=
+begin
+  refine ⟨λ h y, _, surjective.preimage_injective⟩,
+  obtain ⟨x, hx⟩ : (f ⁻¹' {y}).nonempty,
+  { rw [h.nonempty_apply_iff preimage_empty], apply singleton_nonempty },
+  exact ⟨x, hx⟩
+end
+
+@[simp]
+lemma preimage_surjective : surjective (preimage f) ↔ injective f :=
+begin
+  refine ⟨λ h x x' hx, _, injective.preimage_surjective⟩,
+  cases h {x} with s hs, have := mem_singleton x,
+  rwa [← hs, mem_preimage, hx, ← mem_preimage, hs, mem_singleton_iff, eq_comm] at this
+end
+
+@[simp] lemma image_surjective : surjective (image f) ↔ surjective f :=
+begin
+  refine ⟨λ h y, _, surjective.image_surjective⟩,
+  cases h {y} with s hs,
+  have := mem_singleton y, rw [← hs] at this, rcases this with ⟨x, h1x, h2x⟩,
+  exact ⟨x, h2x⟩
+end
+
+@[simp] lemma image_injective : injective (image f) ↔ injective f :=
+begin
+  refine ⟨λ h x x' hx, _, injective.image_injective⟩,
+  rw [← singleton_eq_singleton_iff], apply h,
+  rw [image_singleton, image_singleton, hx]
+end
+
+lemma preimage_eq_iff_eq_image {f : α → β} (hf : bijective f) {s t} :
+  f ⁻¹' s = t ↔ s = f '' t :=
+by rw [← image_eq_image hf.1, hf.2.image_preimage]
+
+lemma eq_preimage_iff_image_eq {f : α → β} (hf : bijective f) {s t} :
+  s = f ⁻¹' t ↔ f '' s = t :=
+by rw [← image_eq_image hf.1, hf.2.image_preimage]
+
+end image_preimage
+end set
diff --git a/src/data/set/intervals/basic.lean b/src/data/set/intervals/basic.lean
index a8d7f999f8615..1fa228c395e89 100644
--- a/src/data/set/intervals/basic.lean
+++ b/src/data/set/intervals/basic.lean
@@ -1219,7 +1219,7 @@ end both
 end lattice
 
 section linear_order
-variables [linear_order α] {a a₁ a₂ b b₁ b₂ c d : α}
+variables [linear_order α] [linear_order β] {f : α → β} {a a₁ a₂ b b₁ b₂ c d : α}
 
 @[simp] lemma Ioi_inter_Ioi : Ioi a ∩ Ioi b = Ioi (a ⊔ b) := ext $ λ _, sup_lt_iff.symm
 @[simp] lemma Iio_inter_Iio : Iio a ∩ Iio b = Iio (a ⊓ b) := ext $ λ _, lt_inf_iff.symm
diff --git a/src/data/set/intervals/disjoint.lean b/src/data/set/intervals/disjoint.lean
index da1b56fd59039..f1109974c9763 100644
--- a/src/data/set/intervals/disjoint.lean
+++ b/src/data/set/intervals/disjoint.lean
@@ -170,4 +170,26 @@ lemma is_lub.bUnion_Iic_eq_Iic (a_lub : is_lub s a) (a_mem : a ∈ s) :
   (⋃ x ∈ s, Iic x) = Iic a :=
 a_lub.dual.bUnion_Ici_eq_Ici a_mem
 
+lemma Union_Ici_eq_Ioi_infi {R : Type*} [complete_linear_order R]
+  {f : ι → R} (no_least_elem : (⨅ i, f i) ∉ range f) :
+  (⋃ (i : ι), Ici (f i)) = Ioi (⨅ i, f i) :=
+by simp only [← is_glb.bUnion_Ici_eq_Ioi (@is_glb_infi _ _ _ f) no_least_elem,
+              mem_range, Union_exists, Union_Union_eq']
+
+lemma Union_Iic_eq_Iio_supr {R : Type*} [complete_linear_order R]
+  {f : ι → R} (no_greatest_elem : (⨆ i, f i) ∉ range f) :
+  (⋃ (i : ι), Iic (f i)) = Iio (⨆ i, f i) :=
+@Union_Ici_eq_Ioi_infi ι (order_dual R) _ f no_greatest_elem
+
+lemma Union_Ici_eq_Ici_infi {R : Type*} [complete_linear_order R]
+  {f : ι → R} (has_least_elem : (⨅ i, f i) ∈ range f) :
+  (⋃ (i : ι), Ici (f i)) = Ici (⨅ i, f i) :=
+by simp only [← is_glb.bUnion_Ici_eq_Ici (@is_glb_infi _ _ _ f) has_least_elem,
+              mem_range, Union_exists, Union_Union_eq']
+
+lemma Union_Iic_eq_Iic_supr {R : Type*} [complete_linear_order R]
+  {f : ι → R} (has_greatest_elem : (⨆ i, f i) ∈ range f) :
+  (⋃ (i : ι), Iic (f i)) = Iic (⨆ i, f i) :=
+@Union_Ici_eq_Ici_infi ι (order_dual R) _ f has_greatest_elem
+
 end Union_Ixx
diff --git a/src/data/set/intervals/monoid.lean b/src/data/set/intervals/monoid.lean
new file mode 100644
index 0000000000000..27fba10575236
--- /dev/null
+++ b/src/data/set/intervals/monoid.lean
@@ -0,0 +1,113 @@
+/-
+Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury G. Kudryashov, Patrick Massot
+-/
+import data.set.intervals.basic
+import data.set.function
+import algebra.order.monoid.cancel.defs
+import algebra.order.monoid.canonical.defs
+import algebra.group.basic
+
+/-!
+# Images of intervals under `(+ d)`
+
+The lemmas in this file state that addition maps intervals bijectively. The typeclass
+`has_exists_add_of_le` is defined specifically to make them work when combined with
+`ordered_cancel_add_comm_monoid`; the lemmas below therefore apply to all
+`ordered_add_comm_group`, but also to `ℕ` and `ℝ≥0`, which are not groups.
+-/
+
+namespace set
+
+variables {M : Type*} [ordered_cancel_add_comm_monoid M] [has_exists_add_of_le M] (a b c d : M)
+
+lemma Ici_add_bij : bij_on (+d) (Ici a) (Ici (a + d)) :=
+begin
+  refine ⟨λ x h, add_le_add_right (mem_Ici.mp h) _, (add_left_injective d).inj_on _, λ _ h, _⟩,
+  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ici.mp h),
+  rw [mem_Ici, add_right_comm, add_le_add_iff_right] at h,
+  exact ⟨a + c, h, by rw add_right_comm⟩,
+end
+
+lemma Ioi_add_bij : bij_on (+d) (Ioi a) (Ioi (a + d)) :=
+begin
+  refine ⟨λ x h, add_lt_add_right (mem_Ioi.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
+  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ioi.mp h).le,
+  rw [mem_Ioi, add_right_comm, add_lt_add_iff_right] at h,
+  exact ⟨a + c, h, by rw add_right_comm⟩,
+end
+
+lemma Icc_add_bij : bij_on (+d) (Icc a b) (Icc (a + d) (b + d)) :=
+begin
+  rw [← Ici_inter_Iic, ← Ici_inter_Iic],
+  exact (Ici_add_bij a d).inter_maps_to (λ x hx, add_le_add_right hx _)
+    (λ x hx, le_of_add_le_add_right hx.2)
+end
+
+lemma Ioo_add_bij : bij_on (+d) (Ioo a b) (Ioo (a + d) (b + d)) :=
+begin
+  rw [← Ioi_inter_Iio, ← Ioi_inter_Iio],
+  exact (Ioi_add_bij a d).inter_maps_to (λ x hx, add_lt_add_right hx _)
+    (λ x hx, lt_of_add_lt_add_right hx.2)
+end
+
+lemma Ioc_add_bij : bij_on (+d) (Ioc a b) (Ioc (a + d) (b + d)) :=
+begin
+  rw [← Ioi_inter_Iic, ← Ioi_inter_Iic],
+  exact (Ioi_add_bij a d).inter_maps_to (λ x hx, add_le_add_right hx _)
+    (λ x hx, le_of_add_le_add_right hx.2)
+end
+
+lemma Ico_add_bij : bij_on (+d) (Ico a b) (Ico (a + d) (b + d)) :=
+begin
+  rw [← Ici_inter_Iio, ← Ici_inter_Iio],
+  exact (Ici_add_bij a d).inter_maps_to (λ x hx, add_lt_add_right hx _)
+    (λ x hx, lt_of_add_lt_add_right hx.2)
+end
+
+/-!
+### Images under `x ↦ x + a`
+-/
+
+@[simp] lemma image_add_const_Ici : (λ x, x + a) '' Ici b = Ici (b + a) :=
+(Ici_add_bij _ _).image_eq
+
+@[simp] lemma image_add_const_Ioi : (λ x, x + a) '' Ioi b = Ioi (b + a) :=
+(Ioi_add_bij _ _).image_eq
+
+@[simp] lemma image_add_const_Icc : (λ x, x + a) '' Icc b c = Icc (b + a) (c + a) :=
+(Icc_add_bij _ _ _).image_eq
+
+@[simp] lemma image_add_const_Ico : (λ x, x + a) '' Ico b c = Ico (b + a) (c + a) :=
+(Ico_add_bij _ _ _).image_eq
+
+@[simp] lemma image_add_const_Ioc : (λ x, x + a) '' Ioc b c = Ioc (b + a) (c + a) :=
+(Ioc_add_bij _ _ _).image_eq
+
+@[simp] lemma image_add_const_Ioo : (λ x, x + a) '' Ioo b c = Ioo (b + a) (c + a) :=
+(Ioo_add_bij _ _ _).image_eq
+
+/-!
+### Images under `x ↦ a + x`
+-/
+
+@[simp] lemma image_const_add_Ici : (λ x, a + x) '' Ici b = Ici (a + b) :=
+by simp only [add_comm a, image_add_const_Ici]
+
+@[simp] lemma image_const_add_Ioi : (λ x, a + x) '' Ioi b = Ioi (a + b) :=
+by simp only [add_comm a, image_add_const_Ioi]
+
+@[simp] lemma image_const_add_Icc : (λ x, a + x) '' Icc b c = Icc (a + b) (a + c) :=
+by simp only [add_comm a, image_add_const_Icc]
+
+@[simp] lemma image_const_add_Ico : (λ x, a + x) '' Ico b c = Ico (a + b) (a + c) :=
+by simp only [add_comm a, image_add_const_Ico]
+
+@[simp] lemma image_const_add_Ioc : (λ x, a + x) '' Ioc b c = Ioc (a + b) (a + c) :=
+by simp only [add_comm a, image_add_const_Ioc]
+
+@[simp] lemma image_const_add_Ioo : (λ x, a + x) '' Ioo b c = Ioo (a + b) (a + c) :=
+by simp only [add_comm a, image_add_const_Ioo]
+
+end set
diff --git a/src/data/set/intervals/unordered_interval.lean b/src/data/set/intervals/unordered_interval.lean
index 0c8ac7d108ce0..61410b54b796e 100644
--- a/src/data/set/intervals/unordered_interval.lean
+++ b/src/data/set/intervals/unordered_interval.lean
@@ -25,15 +25,13 @@ make the notation available.
 
 -/
 
-universe u
-
 open function order_dual (to_dual of_dual)
 
 namespace set
 
 section linear_order
-
-variables {α : Type u} [linear_order α] {a a₁ a₂ b b₁ b₂ c x : α}
+variables {α β : Type*} [linear_order α] [linear_order β] {f : α → β} {s : set α}
+  {a a₁ a₂ b b₁ b₂ c x : α}
 
 /-- `interval a b` is the set of elements lying between `a` and `b`, with `a` and `b` included. -/
 def interval (a b : α) := Icc (min a b) (max a b)
@@ -140,6 +138,24 @@ begin
   { rintro ⟨a, b, h⟩, exact ⟨min a b, max a b, h⟩ }
 end
 
+lemma monotone_or_antitone_iff_interval :
+  monotone f ∨ antitone f ↔ ∀ a b c, c ∈ [a, b] → f c ∈ [f a, f b] :=
+begin
+  split,
+  { rintro (hf | hf) a b c; simp_rw [interval, ←hf.map_min, ←hf.map_max],
+    exacts [λ hc, ⟨hf hc.1, hf hc.2⟩, λ hc, ⟨hf hc.2, hf hc.1⟩] },
+  contrapose!,
+  rw not_monotone_not_antitone_iff_exists_le_le,
+  rintro ⟨a, b, c, hab, hbc, ⟨hfab, hfcb⟩ | ⟨hfba, hfbc⟩⟩,
+  { exact ⟨a, c, b, Icc_subset_interval ⟨hab, hbc⟩, λ h, h.2.not_lt $ max_lt hfab hfcb⟩ },
+  { exact ⟨a, c, b, Icc_subset_interval ⟨hab, hbc⟩, λ h, h.1.not_lt $ lt_min hfba hfbc⟩ }
+end
+
+lemma monotone_on_or_antitone_on_iff_interval :
+  monotone_on f s ∨ antitone_on f s ↔ ∀ a b c ∈ s, c ∈ [a, b] → f c ∈ [f a, f b] :=
+by simp [monotone_on_iff_monotone, antitone_on_iff_antitone, monotone_or_antitone_iff_interval,
+  mem_interval]
+
 /-- The open-closed interval with unordered bounds. -/
 def interval_oc : α → α → set α := λ a b, Ioc (min a b) (max a b)
 
diff --git a/src/data/set/lattice.lean b/src/data/set/lattice.lean
index a620fca369967..b60b579cc9997 100644
--- a/src/data/set/lattice.lean
+++ b/src/data/set/lattice.lean
@@ -538,11 +538,11 @@ variables {s : ι → set α}
 @[simp] lemma Inter_eq_univ : (⋂ i, s i) = univ ↔ ∀ i, s i = univ := infi_eq_top
 
 @[simp] lemma nonempty_Union : (⋃ i, s i).nonempty ↔ ∃ i, (s i).nonempty :=
-by simp [← ne_empty_iff_nonempty]
+by simp [nonempty_iff_ne_empty]
 
 @[simp] lemma nonempty_bUnion {t : set α} {s : α → set β} :
   (⋃ i ∈ t, s i).nonempty ↔ ∃ i ∈ t, (s i).nonempty :=
-by simp [← ne_empty_iff_nonempty]
+by simp [nonempty_iff_ne_empty]
 
 lemma Union_nonempty_index (s : set α) (t : s.nonempty → set β) :
   (⋃ h, t h) = ⋃ x ∈ s, t ⟨x, ‹_›⟩ :=
@@ -827,7 +827,7 @@ subset_sInter $ λ s hs, sInter_subset_of_mem (h hs)
 @[simp] theorem sInter_eq_univ {S : set (set α)} : (⋂₀ S) = univ ↔ ∀ s ∈ S, s = univ := Inf_eq_top
 
 @[simp] theorem nonempty_sUnion {S : set (set α)} : (⋃₀ S).nonempty ↔ ∃ s ∈ S, set.nonempty s :=
-by simp [← ne_empty_iff_nonempty]
+by simp [nonempty_iff_ne_empty]
 
 lemma nonempty.of_sUnion {s : set (set α)} (h : (⋃₀ s).nonempty) : s.nonempty :=
 let ⟨s, hs, _⟩ := nonempty_sUnion.1 h in ⟨s, hs⟩
@@ -890,17 +890,17 @@ by simp [set.eq_empty_iff_forall_not_mem]
 
 -- classical
 @[simp] theorem nonempty_Inter {f : ι → set α} : (⋂ i, f i).nonempty ↔ ∃ x, ∀ i, x ∈ f i :=
-by simp [← ne_empty_iff_nonempty, Inter_eq_empty_iff]
+by simp [nonempty_iff_ne_empty, Inter_eq_empty_iff]
 
 -- classical
 @[simp] lemma nonempty_Inter₂ {s : Π i, κ i → set α} :
   (⋂ i j, s i j).nonempty ↔ ∃ a, ∀ i j, a ∈ s i j :=
-by simp [← ne_empty_iff_nonempty, Inter_eq_empty_iff]
+by simp [nonempty_iff_ne_empty, Inter_eq_empty_iff]
 
 -- classical
 @[simp] theorem nonempty_sInter {c : set (set α)}:
   (⋂₀ c).nonempty ↔ ∃ a, ∀ b ∈ c, a ∈ b :=
-by simp [← ne_empty_iff_nonempty, sInter_eq_empty_iff]
+by simp [nonempty_iff_ne_empty, sInter_eq_empty_iff]
 
 -- classical
 theorem compl_sUnion (S : set (set α)) :
diff --git a/src/data/set/n_ary.lean b/src/data/set/n_ary.lean
new file mode 100644
index 0000000000000..7ec9424a28b02
--- /dev/null
+++ b/src/data/set/n_ary.lean
@@ -0,0 +1,290 @@
+/-
+Copyright (c) 2020 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn
+-/
+import data.set.basic
+import data.set.image
+
+/-!
+# N-ary images of sets
+
+This file defines `finset.image₂`, the binary image of finsets. This is the finset version of
+`set.image2`. This is mostly useful to define pointwise operations.
+
+## Notes
+
+This file is very similar to the n-ary section of `data.set.basic`, to `order.filter.n_ary` and to
+`data.option.n_ary`. Please keep them in sync.
+
+We do not define `finset.image₃` as its only purpose would be to prove properties of `finset.image₂`
+and `set.image2` already fulfills this task.
+-/
+
+open function
+
+namespace set
+variables {α α' β β' γ γ' δ δ' ε ε' : Type*} {f f' : α → β → γ} {g g' : α → β → γ → δ}
+variables {s s' : set α} {t t' : set β} {u u' : set γ} {a a' : α} {b b' : β} {c c' : γ} {d d' : δ}
+
+
+/-- The image of a binary function `f : α → β → γ` as a function `set α → set β → set γ`.
+Mathematically this should be thought of as the image of the corresponding function `α × β → γ`.-/
+def image2 (f : α → β → γ) (s : set α) (t : set β) : set γ :=
+{c | ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c }
+
+@[simp] lemma mem_image2 : c ∈ image2 f s t ↔ ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c := iff.rfl
+
+lemma mem_image2_of_mem (ha : a ∈ s) (hb : b ∈ t) : f a b ∈ image2 f s t := ⟨a, b, ha, hb, rfl⟩
+
+lemma mem_image2_iff (hf : injective2 f) : f a b ∈ image2 f s t ↔ a ∈ s ∧ b ∈ t :=
+⟨ by { rintro ⟨a', b', ha', hb', h⟩, rcases hf h with ⟨rfl, rfl⟩, exact ⟨ha', hb'⟩ },
+  λ ⟨ha, hb⟩, mem_image2_of_mem ha hb⟩
+
+/-- image2 is monotone with respect to `⊆`. -/
+lemma image2_subset (hs : s ⊆ s') (ht : t ⊆ t') : image2 f s t ⊆ image2 f s' t' :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_image2_of_mem (hs ha) (ht hb) }
+
+lemma image2_subset_left (ht : t ⊆ t') : image2 f s t ⊆ image2 f s t' := image2_subset subset.rfl ht
+
+lemma image2_subset_right (hs : s ⊆ s') : image2 f s t ⊆ image2 f s' t :=
+image2_subset hs subset.rfl
+
+lemma image_subset_image2_left (hb : b ∈ t) : (λ a, f a b) '' s ⊆ image2 f s t :=
+ball_image_of_ball $ λ a ha, mem_image2_of_mem ha hb
+
+lemma image_subset_image2_right (ha : a ∈ s) : f a '' t ⊆ image2 f s t :=
+ball_image_of_ball $ λ b, mem_image2_of_mem ha
+
+lemma forall_image2_iff {p : γ → Prop} :
+  (∀ z ∈ image2 f s t, p z) ↔ ∀ (x ∈ s) (y ∈ t), p (f x y) :=
+⟨λ h x hx y hy, h _ ⟨x, y, hx, hy, rfl⟩, λ h z ⟨x, y, hx, hy, hz⟩, hz ▸ h x hx y hy⟩
+
+@[simp] lemma image2_subset_iff {u : set γ} :
+  image2 f s t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), f x y ∈ u :=
+forall_image2_iff
+
+lemma image2_union_left : image2 f (s ∪ s') t = image2 f s t ∪ image2 f s' t :=
+begin
+  ext c,
+  split,
+  { rintro ⟨a, b, ha | ha, hb, rfl⟩; [left, right]; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ },
+  { rintro (⟨_, _, _, _, rfl⟩|⟨_, _, _, _, rfl⟩); refine ⟨_, _, _, ‹_›, rfl⟩;
+    simp [mem_union, *] }
+end
+
+lemma image2_union_right : image2 f s (t ∪ t') = image2 f s t ∪ image2 f s t' :=
+begin
+  ext c,
+  split,
+  { rintro ⟨a, b, ha, h1b|h2b, rfl⟩;[left, right]; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ },
+  { rintro (⟨_, _, _, _, rfl⟩|⟨_, _, _, _, rfl⟩); refine ⟨_, _, ‹_›, _, rfl⟩;
+    simp [mem_union, *] }
+end
+
+@[simp] lemma image2_empty_left : image2 f ∅ t = ∅ := ext $ by simp
+@[simp] lemma image2_empty_right : image2 f s ∅ = ∅ := ext $ by simp
+
+lemma nonempty.image2 : s.nonempty → t.nonempty → (image2 f s t).nonempty :=
+λ ⟨a, ha⟩ ⟨b, hb⟩, ⟨_, mem_image2_of_mem ha hb⟩
+
+@[simp] lemma image2_nonempty_iff : (image2 f s t).nonempty ↔ s.nonempty ∧ t.nonempty :=
+⟨λ ⟨_, a, b, ha, hb, _⟩, ⟨⟨a, ha⟩, b, hb⟩, λ h, h.1.image2 h.2⟩
+
+lemma nonempty.of_image2_left (h : (image2 f s t).nonempty) : s.nonempty :=
+(image2_nonempty_iff.1 h).1
+
+lemma nonempty.of_image2_right (h : (image2 f s t).nonempty) : t.nonempty :=
+(image2_nonempty_iff.1 h).2
+
+@[simp] lemma image2_eq_empty_iff : image2 f s t = ∅ ↔ s = ∅ ∨ t = ∅ :=
+by simp_rw [←not_nonempty_iff_eq_empty, image2_nonempty_iff, not_and_distrib]
+
+lemma image2_inter_subset_left : image2 f (s ∩ s') t ⊆ image2 f s t ∩ image2 f s' t :=
+by { rintro _ ⟨a, b, ⟨h1a, h2a⟩, hb, rfl⟩, split; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ }
+
+lemma image2_inter_subset_right : image2 f s (t ∩ t') ⊆ image2 f s t ∩ image2 f s t' :=
+by { rintro _ ⟨a, b, ha, ⟨h1b, h2b⟩, rfl⟩, split; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ }
+
+@[simp] lemma image2_singleton_left : image2 f {a} t = f a '' t := ext $ λ x, by simp
+@[simp] lemma image2_singleton_right : image2 f s {b} = (λ a, f a b) '' s := ext $ λ x, by simp
+
+lemma image2_singleton : image2 f {a} {b} = {f a b} := by simp
+
+@[congr] lemma image2_congr (h : ∀ (a ∈ s) (b ∈ t), f a b = f' a b) :
+  image2 f s t = image2 f' s t :=
+by { ext, split; rintro ⟨a, b, ha, hb, rfl⟩; refine ⟨a, b, ha, hb, by rw h a ha b hb⟩ }
+
+/-- A common special case of `image2_congr` -/
+lemma image2_congr' (h : ∀ a b, f a b = f' a b) : image2 f s t = image2 f' s t :=
+image2_congr (λ a _ b _, h a b)
+
+/-- The image of a ternary function `f : α → β → γ → δ` as a function
+  `set α → set β → set γ → set δ`. Mathematically this should be thought of as the image of the
+  corresponding function `α × β × γ → δ`.
+-/
+def image3 (g : α → β → γ → δ) (s : set α) (t : set β) (u : set γ) : set δ :=
+{d | ∃ a b c, a ∈ s ∧ b ∈ t ∧ c ∈ u ∧ g a b c = d }
+
+@[simp] lemma mem_image3 : d ∈ image3 g s t u ↔ ∃ a b c, a ∈ s ∧ b ∈ t ∧ c ∈ u ∧ g a b c = d :=
+iff.rfl
+
+lemma image3_mono (hs : s ⊆ s') (ht : t ⊆ t') (hu : u ⊆ u') : image3 g s t u ⊆ image3 g s' t' u' :=
+λ x, Exists₃.imp $ λ a b c ⟨ha, hb, hc, hx⟩, ⟨hs ha, ht hb, hu hc, hx⟩
+
+@[congr] lemma image3_congr (h : ∀ (a ∈ s) (b ∈ t) (c ∈ u), g a b c = g' a b c) :
+  image3 g s t u = image3 g' s t u :=
+by { ext x,
+     split; rintro ⟨a, b, c, ha, hb, hc, rfl⟩; exact ⟨a, b, c, ha, hb, hc, by rw h a ha b hb c hc⟩ }
+
+/-- A common special case of `image3_congr` -/
+lemma image3_congr' (h : ∀ a b c, g a b c = g' a b c) : image3 g s t u = image3 g' s t u :=
+image3_congr (λ a _ b _ c _, h a b c)
+
+lemma image2_image2_left (f : δ → γ → ε) (g : α → β → δ) :
+  image2 f (image2 g s t) u = image3 (λ a b c, f (g a b) c) s t u :=
+begin
+  ext, split,
+  { rintro ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩, refine ⟨a, b, c, ha, hb, hc, rfl⟩ },
+  { rintro ⟨a, b, c, ha, hb, hc, rfl⟩, refine ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩ }
+end
+
+lemma image2_image2_right (f : α → δ → ε) (g : β → γ → δ) :
+  image2 f s (image2 g t u) = image3 (λ a b c, f a (g b c)) s t u :=
+begin
+  ext, split,
+  { rintro ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩, refine ⟨a, b, c, ha, hb, hc, rfl⟩ },
+  { rintro ⟨a, b, c, ha, hb, hc, rfl⟩, refine ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩ }
+end
+
+lemma image_image2 (f : α → β → γ) (g : γ → δ) :
+  g '' image2 f s t = image2 (λ a b, g (f a b)) s t :=
+begin
+  ext, split,
+  { rintro ⟨_, ⟨a, b, ha, hb, rfl⟩, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
+  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨_, ⟨a, b, ha, hb, rfl⟩, rfl⟩ }
+end
+
+lemma image2_image_left (f : γ → β → δ) (g : α → γ) :
+  image2 f (g '' s) t = image2 (λ a b, f (g a) b) s t :=
+begin
+  ext, split,
+  { rintro ⟨_, b, ⟨a, ha, rfl⟩, hb, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
+  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨_, b, ⟨a, ha, rfl⟩, hb, rfl⟩ }
+end
+
+lemma image2_image_right (f : α → γ → δ) (g : β → γ) :
+  image2 f s (g '' t) = image2 (λ a b, f a (g b)) s t :=
+begin
+  ext, split,
+  { rintro ⟨a, _, ha, ⟨b, hb, rfl⟩, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
+  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨a, _, ha, ⟨b, hb, rfl⟩, rfl⟩ }
+end
+
+lemma image2_swap (f : α → β → γ) (s : set α) (t : set β) :
+  image2 f s t = image2 (λ a b, f b a) t s :=
+by { ext, split; rintro ⟨a, b, ha, hb, rfl⟩; refine ⟨b, a, hb, ha, rfl⟩ }
+
+@[simp] lemma image2_left (h : t.nonempty) : image2 (λ x y, x) s t = s :=
+by simp [nonempty_def.mp h, ext_iff]
+
+@[simp] lemma image2_right (h : s.nonempty) : image2 (λ x y, y) s t = t :=
+by simp [nonempty_def.mp h, ext_iff]
+
+lemma image2_assoc {f : δ → γ → ε} {g : α → β → δ} {f' : α → ε' → ε} {g' : β → γ → ε'}
+  (h_assoc : ∀ a b c, f (g a b) c = f' a (g' b c)) :
+  image2 f (image2 g s t) u = image2 f' s (image2 g' t u) :=
+by simp only [image2_image2_left, image2_image2_right, h_assoc]
+
+lemma image2_comm {g : β → α → γ} (h_comm : ∀ a b, f a b = g b a) : image2 f s t = image2 g t s :=
+(image2_swap _ _ _).trans $ by simp_rw h_comm
+
+lemma image2_left_comm {f : α → δ → ε} {g : β → γ → δ} {f' : α → γ → δ'} {g' : β → δ' → ε}
+  (h_left_comm : ∀ a b c, f a (g b c) = g' b (f' a c)) :
+  image2 f s (image2 g t u) = image2 g' t (image2 f' s u) :=
+by { rw [image2_swap f', image2_swap f], exact image2_assoc (λ _ _ _, h_left_comm _ _ _) }
+
+lemma image2_right_comm {f : δ → γ → ε} {g : α → β → δ} {f' : α → γ → δ'} {g' : δ' → β → ε}
+  (h_right_comm : ∀ a b c, f (g a b) c = g' (f' a c) b) :
+  image2 f (image2 g s t) u = image2 g' (image2 f' s u) t :=
+by { rw [image2_swap g, image2_swap g'], exact image2_assoc (λ _ _ _, h_right_comm _ _ _) }
+
+lemma image_image2_distrib {g : γ → δ} {f' : α' → β' → δ} {g₁ : α → α'} {g₂ : β → β'}
+  (h_distrib : ∀ a b, g (f a b) = f' (g₁ a) (g₂ b)) :
+  (image2 f s t).image g = image2 f' (s.image g₁) (t.image g₂) :=
+by simp_rw [image_image2, image2_image_left, image2_image_right, h_distrib]
+
+/-- Symmetric statement to `set.image2_image_left_comm`. -/
+lemma image_image2_distrib_left {g : γ → δ} {f' : α' → β → δ} {g' : α → α'}
+  (h_distrib : ∀ a b, g (f a b) = f' (g' a) b) :
+  (image2 f s t).image g = image2 f' (s.image g') t :=
+(image_image2_distrib h_distrib).trans $ by rw image_id'
+
+/-- Symmetric statement to `set.image_image2_right_comm`. -/
+lemma image_image2_distrib_right {g : γ → δ} {f' : α → β' → δ} {g' : β → β'}
+  (h_distrib : ∀ a b, g (f a b) = f' a (g' b)) :
+  (image2 f s t).image g = image2 f' s (t.image g') :=
+(image_image2_distrib h_distrib).trans $ by rw image_id'
+
+/-- Symmetric statement to `set.image_image2_distrib_left`. -/
+lemma image2_image_left_comm {f : α' → β → γ} {g : α → α'} {f' : α → β → δ} {g' : δ → γ}
+  (h_left_comm : ∀ a b, f (g a) b = g' (f' a b)) :
+  image2 f (s.image g) t = (image2 f' s t).image g' :=
+(image_image2_distrib_left $ λ a b, (h_left_comm a b).symm).symm
+
+/-- Symmetric statement to `set.image_image2_distrib_right`. -/
+lemma image_image2_right_comm {f : α → β' → γ} {g : β → β'} {f' : α → β → δ} {g' : δ → γ}
+  (h_right_comm : ∀ a b, f a (g b) = g' (f' a b)) :
+  image2 f s (t.image g) = (image2 f' s t).image g' :=
+(image_image2_distrib_right $ λ a b, (h_right_comm a b).symm).symm
+
+/-- The other direction does not hold because of the `s`-`s` cross terms on the RHS. -/
+lemma image2_distrib_subset_left {f : α → δ → ε} {g : β → γ → δ} {f₁ : α → β → β'} {f₂ : α → γ → γ'}
+  {g' : β' → γ' → ε} (h_distrib : ∀ a b c, f a (g b c) = g' (f₁ a b) (f₂ a c)) :
+  image2 f s (image2 g t u) ⊆ image2 g' (image2 f₁ s t) (image2 f₂ s u) :=
+begin
+  rintro _ ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩,
+  rw h_distrib,
+  exact mem_image2_of_mem (mem_image2_of_mem ha hb) (mem_image2_of_mem ha hc),
+end
+
+/-- The other direction does not hold because of the `u`-`u` cross terms on the RHS. -/
+lemma image2_distrib_subset_right {f : δ → γ → ε} {g : α → β → δ} {f₁ : α → γ → α'}
+  {f₂ : β → γ → β'} {g' : α' → β' → ε} (h_distrib : ∀ a b c, f (g a b) c = g' (f₁ a c) (f₂ b c)) :
+  image2 f (image2 g s t) u ⊆ image2 g' (image2 f₁ s u) (image2 f₂ t u) :=
+begin
+  rintro _ ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩,
+  rw h_distrib,
+  exact mem_image2_of_mem (mem_image2_of_mem ha hc) (mem_image2_of_mem hb hc),
+end
+
+lemma image_image2_antidistrib {g : γ → δ} {f' : β' → α' → δ} {g₁ : β → β'} {g₂ : α → α'}
+  (h_antidistrib : ∀ a b, g (f a b) = f' (g₁ b) (g₂ a)) :
+  (image2 f s t).image g = image2 f' (t.image g₁) (s.image g₂) :=
+by { rw image2_swap f, exact image_image2_distrib (λ _ _, h_antidistrib _ _) }
+
+/-- Symmetric statement to `set.image2_image_left_anticomm`. -/
+lemma image_image2_antidistrib_left {g : γ → δ} {f' : β' → α → δ} {g' : β → β'}
+  (h_antidistrib : ∀ a b, g (f a b) = f' (g' b) a) :
+  (image2 f s t).image g = image2 f' (t.image g') s :=
+(image_image2_antidistrib h_antidistrib).trans $ by rw image_id'
+
+/-- Symmetric statement to `set.image_image2_right_anticomm`. -/
+lemma image_image2_antidistrib_right {g : γ → δ} {f' : β → α' → δ} {g' : α → α'}
+  (h_antidistrib : ∀ a b, g (f a b) = f' b (g' a)) :
+  (image2 f s t).image g = image2 f' t (s.image g') :=
+(image_image2_antidistrib h_antidistrib).trans $ by rw image_id'
+
+/-- Symmetric statement to `set.image_image2_antidistrib_left`. -/
+lemma image2_image_left_anticomm {f : α' → β → γ} {g : α → α'} {f' : β → α → δ} {g' : δ → γ}
+  (h_left_anticomm : ∀ a b, f (g a) b = g' (f' b a)) :
+  image2 f (s.image g) t = (image2 f' t s).image g' :=
+(image_image2_antidistrib_left $ λ a b, (h_left_anticomm b a).symm).symm
+
+/-- Symmetric statement to `set.image_image2_antidistrib_right`. -/
+lemma image_image2_right_anticomm {f : α → β' → γ} {g : β → β'} {f' : β → α → δ} {g' : δ → γ}
+  (h_right_anticomm : ∀ a b, f a (g b) = g' (f' b a)) :
+  image2 f s (t.image g) = (image2 f' t s).image g' :=
+(image_image2_antidistrib_right $ λ a b, (h_right_anticomm b a).symm).symm
+
+end set
diff --git a/src/data/set/opposite.lean b/src/data/set/opposite.lean
index 5db33b36caeff..a4f90f3ce7217 100644
--- a/src/data/set/opposite.lean
+++ b/src/data/set/opposite.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Markus Himmel
 -/
 import data.opposite
-import data.set.basic
+import data.set.image
 
 /-!
 # The opposite of a set
diff --git a/src/data/set/pointwise/basic.lean b/src/data/set/pointwise/basic.lean
index 066470e63f6a3..a7391f94aeb54 100644
--- a/src/data/set/pointwise/basic.lean
+++ b/src/data/set/pointwise/basic.lean
@@ -3,9 +3,8 @@ Copyright (c) 2019 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin, Floris van Doorn
 -/
-import data.fin.tuple.basic
-import data.set.finite
-import algebra.module.basic
+import data.set.lattice
+import data.list.of_fn
 
 /-!
 # Pointwise operations of sets
@@ -21,11 +20,6 @@ For sets `s` and `t` and scalar `a`:
 * `-s`: Negation, set of all `-x` where `x ∈ s`.
 * `s / t`: Division, set of all `x / y` where `x ∈ s` and `y ∈ t`.
 * `s - t`: Subtraction, set of all `x - y` where `x ∈ s` and `y ∈ t`.
-* `s • t`: Scalar multiplication, set of all `x • y` where `x ∈ s` and `y ∈ t`.
-* `s +ᵥ t`: Scalar addition, set of all `x +ᵥ y` where `x ∈ s` and `y ∈ t`.
-* `s -ᵥ t`: Scalar subtraction, set of all `x -ᵥ y` where `x ∈ s` and `y ∈ t`.
-* `a • s`: Scaling, set of all `a • x` where `x ∈ s`.
-* `a +ᵥ s`: Translation, set of all `a +ᵥ x` where `x ∈ s`.
 
 For `α` a semigroup/monoid, `set α` is a semigroup/monoid.
 As an unfortunate side effect, this means that `n • s`, where `n : ℕ`, is ambiguous between
@@ -34,13 +28,6 @@ the latter has `(2 : ℕ) • {1, 2} = {2, 3, 4}`. See note [pointwise nat actio
 
 Appropriate definitions and results are also transported to the additive theory via `to_additive`.
 
-### Definitions for Hahn series
-
-* `set.add_antidiagonal s t a`, `set.mul_antidiagonal s t a`: Sets of pairs of elements of `s` and
-  `t` that add/multiply to `a`.
-* `finset.add_antidiagonal`, `finset.mul_antidiagonal`: Finset versions of the above when `s` and
-  `t` are well-founded.
-
 ## Implementation notes
 
 * The following expressions are considered in simp-normal form in a group:
@@ -144,9 +131,6 @@ inv_involutive.surjective.nonempty_preimage
 
 @[to_additive] lemma nonempty.inv (h : s.nonempty) : s⁻¹.nonempty := nonempty_inv.2 h
 
-@[to_additive] lemma finite.inv (hs : s.finite) : s⁻¹.finite :=
-hs.preimage $ inv_injective.inj_on _
-
 @[simp, to_additive]
 lemma image_inv : has_inv.inv '' s = s⁻¹ :=
 congr_fun (image_eq_preimage_of_inverse inv_involutive.left_inverse inv_involutive.right_inverse) _
@@ -268,13 +252,6 @@ lemma mul_Inter₂_subset (s : set α) (t : Π i, κ i → set α) :
   s * (⋂ i j, t i j) ⊆ ⋂ i j, s * t i j :=
 image2_Inter₂_subset_right _ _ _
 
-@[to_additive] lemma finite.mul : s.finite → t.finite → (s * t).finite := finite.image2 _
-
-/-- Multiplication preserves finiteness. -/
-@[to_additive "Addition preserves finiteness."]
-def fintype_mul [decidable_eq α] (s t : set α) [fintype s] [fintype t] : fintype (s * t : set α) :=
-set.fintype_image2 _ _ _
-
 /-- The singleton operation as a `mul_hom`. -/
 @[to_additive "The singleton operation as an `add_hom`."]
 def singleton_mul_hom : α →ₙ* set α := ⟨singleton, λ a b, singleton_mul_singleton.symm⟩
@@ -450,21 +427,6 @@ protected def monoid : monoid (set α) := { ..set.semigroup, ..set.mul_one_class
 
 localized "attribute [instance] set.monoid set.add_monoid" in pointwise
 
-@[to_additive]
-instance decidable_mem_mul [fintype α] [decidable_eq α] [decidable_pred (∈ s)]
-  [decidable_pred (∈ t)] :
-  decidable_pred (∈ s * t) :=
-λ _, decidable_of_iff _ mem_mul.symm
-
-@[to_additive]
-instance decidable_mem_pow [fintype α] [decidable_eq α] [decidable_pred (∈ s)] (n : ℕ) :
-  decidable_pred (∈ (s ^ n)) :=
-begin
-  induction n with n ih,
-  { simp_rw [pow_zero, mem_one], apply_instance },
-  { letI := ih, rw pow_succ, apply_instance }
-end
-
 @[to_additive] lemma pow_mem_pow (ha : a ∈ s) : ∀ n : ℕ, a ^ n ∈ s ^ n
 | 0 := by { rw pow_zero, exact one_mem_one }
 | (n + 1) := by { rw pow_succ, exact mul_mem_mul ha (pow_mem_pow _) }
@@ -735,565 +697,6 @@ begin
   exact mul_le_mul' (hbA hxa) (hbB hxb),
 end
 
-open_locale pointwise
-
-/-! ### Translation/scaling of sets -/
-
-section smul
-
-/-- The dilation of set `x • s` is defined as `{x • y | y ∈ s}` in locale `pointwise`. -/
-@[to_additive "The translation of set `x +ᵥ s` is defined as `{x +ᵥ y | y ∈ s}` in
-locale `pointwise`."]
-protected def has_smul_set [has_smul α β] : has_smul α (set β) :=
-⟨λ a, image (has_smul.smul a)⟩
-
-/-- The pointwise scalar multiplication of sets `s • t` is defined as `{x • y | x ∈ s, y ∈ t}` in
-locale `pointwise`. -/
-@[to_additive "The pointwise scalar addition of sets `s +ᵥ t` is defined as
-`{x +ᵥ y | x ∈ s, y ∈ t}` in locale `pointwise`."]
-protected def has_smul [has_smul α β] : has_smul (set α) (set β) :=
-⟨image2 has_smul.smul⟩
-
-localized "attribute [instance] set.has_smul_set set.has_smul" in pointwise
-localized "attribute [instance] set.has_vadd_set set.has_vadd" in pointwise
-
-section has_smul
-variables {ι : Sort*} {κ : ι → Sort*} [has_smul α β] {s s₁ s₂ : set α} {t t₁ t₂ u : set β} {a : α}
-  {b : β}
-
-@[simp, to_additive]
-lemma image2_smul : image2 has_smul.smul s t = s • t := rfl
-
-@[to_additive add_image_prod]
-lemma image_smul_prod : (λ x : α × β, x.fst • x.snd) '' s ×ˢ t = s • t := image_prod _
-
-@[to_additive]
-lemma mem_smul : b ∈ s • t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x • y = b := iff.rfl
-
-@[to_additive] lemma smul_mem_smul : a ∈ s → b ∈ t → a • b ∈ s • t := mem_image2_of_mem
-
-@[simp, to_additive] lemma empty_smul : (∅ : set α) • t = ∅ := image2_empty_left
-@[simp, to_additive] lemma smul_empty : s • (∅ : set β) = ∅ := image2_empty_right
-@[simp, to_additive] lemma smul_eq_empty : s • t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
-@[simp, to_additive] lemma smul_nonempty : (s • t).nonempty ↔ s.nonempty ∧ t.nonempty :=
-image2_nonempty_iff
-@[to_additive] lemma nonempty.smul : s.nonempty → t.nonempty → (s • t).nonempty := nonempty.image2
-@[to_additive] lemma nonempty.of_smul_left : (s • t).nonempty → s.nonempty :=
-nonempty.of_image2_left
-@[to_additive] lemma nonempty.of_smul_right : (s • t).nonempty → t.nonempty :=
-nonempty.of_image2_right
-@[simp, to_additive] lemma smul_singleton : s • {b} = (• b) '' s := image2_singleton_right
-@[simp, to_additive] lemma singleton_smul : ({a} : set α) • t = a • t := image2_singleton_left
-@[simp, to_additive] lemma singleton_smul_singleton : ({a} : set α) • ({b} : set β) = {a • b} :=
-image2_singleton
-
-@[to_additive, mono] lemma smul_subset_smul : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ • t₁ ⊆ s₂ • t₂ := image2_subset
-@[to_additive] lemma smul_subset_smul_left : t₁ ⊆ t₂ → s • t₁ ⊆ s • t₂ := image2_subset_left
-@[to_additive] lemma smul_subset_smul_right : s₁ ⊆ s₂ → s₁ • t ⊆ s₂ • t := image2_subset_right
-@[to_additive] lemma smul_subset_iff : s • t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a • b ∈ u := image2_subset_iff
-
-attribute [mono] vadd_subset_vadd
-
-@[to_additive] lemma union_smul : (s₁ ∪ s₂) • t = s₁ • t ∪ s₂ • t := image2_union_left
-@[to_additive] lemma smul_union : s • (t₁ ∪ t₂) = s • t₁ ∪ s • t₂ := image2_union_right
-@[to_additive] lemma inter_smul_subset : (s₁ ∩ s₂) • t ⊆ s₁ • t ∩ s₂ • t := image2_inter_subset_left
-@[to_additive] lemma smul_inter_subset : s • (t₁ ∩ t₂) ⊆ s • t₁ ∩ s • t₂ :=
-image2_inter_subset_right
-
-@[to_additive] lemma Union_smul_left_image : (⋃ a ∈ s, a • t) = s • t := Union_image_left _
-@[to_additive] lemma Union_smul_right_image : (⋃ a ∈ t, (• a) '' s) = s • t := Union_image_right _
-
-@[to_additive] lemma Union_smul (s : ι → set α) (t : set β) : (⋃ i, s i) • t = ⋃ i, s i • t :=
-image2_Union_left _ _ _
-@[to_additive] lemma smul_Union (s : set α) (t : ι → set β) : s • (⋃ i, t i) = ⋃ i, s • t i :=
-image2_Union_right _ _ _
-
-@[to_additive]
-lemma Union₂_smul (s : Π i, κ i → set α) (t : set β) : (⋃ i j, s i j) • t = ⋃ i j, s i j • t :=
-image2_Union₂_left _ _ _
-
-@[to_additive]
-lemma smul_Union₂ (s : set α) (t : Π i, κ i → set β) : s • (⋃ i j, t i j) = ⋃ i j, s • t i j :=
-image2_Union₂_right _ _ _
-
-@[to_additive]
-lemma Inter_smul_subset (s : ι → set α) (t : set β) : (⋂ i, s i) • t ⊆ ⋂ i, s i • t :=
-image2_Inter_subset_left _ _ _
-
-@[to_additive]
-lemma smul_Inter_subset (s : set α) (t : ι → set β) : s • (⋂ i, t i) ⊆ ⋂ i, s • t i :=
-image2_Inter_subset_right _ _ _
-
-@[to_additive]
-lemma Inter₂_smul_subset (s : Π i, κ i → set α) (t : set β) :
-  (⋂ i j, s i j) • t ⊆ ⋂ i j, s i j • t :=
-image2_Inter₂_subset_left _ _ _
-
-@[to_additive]
-lemma smul_Inter₂_subset (s : set α) (t : Π i, κ i → set β) :
-  s • (⋂ i j, t i j) ⊆ ⋂ i j, s • t i j :=
-image2_Inter₂_subset_right _ _ _
-
-@[to_additive] lemma finite.smul : s.finite → t.finite → (s • t).finite := finite.image2 _
-
-@[simp, to_additive] lemma bUnion_smul_set (s : set α) (t : set β) :
-  (⋃ a ∈ s, a • t) = s • t :=
-Union_image_left _
-
-end has_smul
-
-section has_smul_set
-variables {ι : Sort*} {κ : ι → Sort*} [has_smul α β] {s t t₁ t₂ : set β} {a : α} {b : β} {x y : β}
-
-@[simp, to_additive] lemma image_smul : (λ x, a • x) '' t = a • t := rfl
-
-@[to_additive] lemma mem_smul_set : x ∈ a • t ↔ ∃ y, y ∈ t ∧ a • y = x := iff.rfl
-
-@[to_additive] lemma smul_mem_smul_set : b ∈ s → a • b ∈ a • s := mem_image_of_mem _
-
-@[simp, to_additive] lemma smul_set_empty : a • (∅ : set β) = ∅ := image_empty _
-@[simp, to_additive] lemma smul_set_eq_empty : a • s = ∅ ↔ s = ∅ := image_eq_empty
-@[simp, to_additive] lemma smul_set_nonempty : (a • s).nonempty ↔ s.nonempty := nonempty_image_iff
-
-@[simp, to_additive] lemma smul_set_singleton : a • ({b} : set β) = {a • b} := image_singleton
-
-@[to_additive] lemma smul_set_mono : s ⊆ t → a • s ⊆ a • t := image_subset _
-@[to_additive] lemma smul_set_subset_iff : a • s ⊆ t ↔ ∀ ⦃b⦄, b ∈ s → a • b ∈ t := image_subset_iff
-
-@[to_additive] lemma smul_set_union : a • (t₁ ∪ t₂) = a • t₁ ∪ a • t₂ := image_union _ _ _
-
-@[to_additive]
-lemma smul_set_inter_subset : a • (t₁ ∩ t₂) ⊆ a • t₁ ∩ (a • t₂) := image_inter_subset _ _ _
-
-@[to_additive]
-lemma smul_set_Union (a : α) (s : ι → set β) : a • (⋃ i, s i) = ⋃ i, a • s i := image_Union
-
-@[to_additive]
-lemma smul_set_Union₂ (a : α) (s : Π i, κ i → set β) : a • (⋃ i j, s i j) = ⋃ i j, a • s i j :=
-image_Union₂ _ _
-
-@[to_additive]
-lemma smul_set_Inter_subset (a : α) (t : ι → set β) : a • (⋂ i, t i) ⊆ ⋂ i, a • t i :=
-image_Inter_subset _ _
-
-@[to_additive]
-lemma smul_set_Inter₂_subset (a : α) (t : Π i, κ i → set β) :
-  a • (⋂ i j, t i j) ⊆ ⋂ i j, a • t i j :=
-image_Inter₂_subset _ _
-
-@[to_additive] lemma nonempty.smul_set : s.nonempty → (a • s).nonempty := nonempty.image _
-@[to_additive] lemma finite.smul_set : s.finite → (a • s).finite := finite.image _
-
-end has_smul_set
-
-variables {s s₁ s₂ : set α} {t t₁ t₂ : set β} {a : α} {b : β}
-
-@[simp, to_additive] lemma bUnion_op_smul_set [has_mul α] (s t : set α) :
-  (⋃ a ∈ t, mul_opposite.op a • s) = s * t :=
-Union_image_right _
-
-@[to_additive]
-lemma smul_set_inter [group α] [mul_action α β] {s t : set β} :
-  a • (s ∩ t) = a • s ∩ a • t :=
-(image_inter $ mul_action.injective a).symm
-
-lemma smul_set_inter₀ [group_with_zero α] [mul_action α β] {s t : set β} (ha : a ≠ 0) :
-  a • (s ∩ t) = a • s ∩ a • t :=
-show units.mk0 a ha • _ = _, from smul_set_inter
-
-@[simp, to_additive]
-lemma smul_set_univ [group α] [mul_action α β] {a : α} : a • (univ : set β) = univ :=
-eq_univ_of_forall $ λ b, ⟨a⁻¹ • b, trivial, smul_inv_smul _ _⟩
-
-@[simp, to_additive]
-lemma smul_univ [group α] [mul_action α β] {s : set α} (hs : s.nonempty) :
-  s • (univ : set β) = univ :=
-let ⟨a, ha⟩ := hs in eq_univ_of_forall $ λ b, ⟨a, a⁻¹ • b, ha, trivial, smul_inv_smul _ _⟩
-
-@[to_additive]
-theorem range_smul_range {ι κ : Type*} [has_smul α β] (b : ι → α) (c : κ → β) :
-  range b • range c = range (λ p : ι × κ, b p.1 • c p.2) :=
-ext $ λ x, ⟨λ hx, let ⟨p, q, ⟨i, hi⟩, ⟨j, hj⟩, hpq⟩ := set.mem_smul.1 hx in
-  ⟨(i, j), hpq ▸ hi ▸ hj ▸ rfl⟩,
-λ ⟨⟨i, j⟩, h⟩, set.mem_smul.2 ⟨b i, c j, ⟨i, rfl⟩, ⟨j, rfl⟩, h⟩⟩
-
-@[to_additive] lemma smul_set_range [has_smul α β] {ι : Sort*} {f : ι → β} :
-  a • range f = range (λ i, a • f i) := (range_comp _ _).symm
-
-@[to_additive]
-instance smul_comm_class_set [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
-  smul_comm_class α β (set γ) :=
-⟨λ _ _, commute.set_image $ smul_comm _ _⟩
-
-@[to_additive]
-instance smul_comm_class_set' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
-  smul_comm_class α (set β) (set γ) :=
-⟨λ _ _ _, image_image2_distrib_right $ smul_comm _⟩
-
-@[to_additive]
-instance smul_comm_class_set'' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
-  smul_comm_class (set α) β (set γ) :=
-by haveI := smul_comm_class.symm α β γ; exact smul_comm_class.symm _ _ _
-
-@[to_additive]
-instance smul_comm_class [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
-  smul_comm_class (set α) (set β) (set γ) :=
-⟨λ _ _ _, image2_left_comm smul_comm⟩
-
-@[to_additive]
-instance is_scalar_tower [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
-  is_scalar_tower α β (set γ) :=
-{ smul_assoc := λ a b T, by simp only [←image_smul, image_image, smul_assoc] }
-
-@[to_additive]
-instance is_scalar_tower' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
-  is_scalar_tower α (set β) (set γ) :=
-⟨λ _ _ _, image2_image_left_comm $ smul_assoc _⟩
-
-@[to_additive]
-instance is_scalar_tower'' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
-  is_scalar_tower (set α) (set β) (set γ) :=
-{ smul_assoc := λ T T' T'', image2_assoc smul_assoc }
-
-instance is_central_scalar [has_smul α β] [has_smul αᵐᵒᵖ β] [is_central_scalar α β] :
-  is_central_scalar α (set β) :=
-⟨λ a S, congr_arg (λ f, f '' S) $ by exact funext (λ _, op_smul_eq_smul _ _)⟩
-
-/-- A multiplicative action of a monoid `α` on a type `β` gives a multiplicative action of `set α`
-on `set β`. -/
-@[to_additive "An additive action of an additive monoid `α` on a type `β` gives an additive action
-of `set α` on `set β`"]
-protected def mul_action [monoid α] [mul_action α β] : mul_action (set α) (set β) :=
-{ mul_smul := λ _ _ _, image2_assoc mul_smul,
-  one_smul := λ s, image2_singleton_left.trans $ by simp_rw [one_smul, image_id'] }
-
-/-- A multiplicative action of a monoid on a type `β` gives a multiplicative action on `set β`. -/
-@[to_additive "An additive action of an additive monoid on a type `β` gives an additive action
-on `set β`."]
-protected def mul_action_set [monoid α] [mul_action α β] : mul_action α (set β) :=
-{ mul_smul := by { intros, simp only [← image_smul, image_image, ← mul_smul] },
-  one_smul := by { intros, simp only [← image_smul, one_smul, image_id'] } }
-
-localized "attribute [instance] set.mul_action_set set.add_action_set
-  set.mul_action set.add_action" in pointwise
-
-/-- A distributive multiplicative action of a monoid on an additive monoid `β` gives a distributive
-multiplicative action on `set β`. -/
-protected def distrib_mul_action_set [monoid α] [add_monoid β] [distrib_mul_action α β] :
-  distrib_mul_action α (set β) :=
-{ smul_add := λ _ _ _, image_image2_distrib $ smul_add _,
-  smul_zero := λ _, image_singleton.trans $ by rw [smul_zero, singleton_zero] }
-
-/-- A multiplicative action of a monoid on a monoid `β` gives a multiplicative action on `set β`. -/
-protected def mul_distrib_mul_action_set [monoid α] [monoid β] [mul_distrib_mul_action α β] :
-  mul_distrib_mul_action α (set β) :=
-{ smul_mul := λ _ _ _, image_image2_distrib $ smul_mul' _,
-  smul_one := λ _, image_singleton.trans $ by rw [smul_one, singleton_one] }
-
-localized "attribute [instance] set.distrib_mul_action_set set.mul_distrib_mul_action_set"
-  in pointwise
-
-instance [has_zero α] [has_zero β] [has_smul α β] [no_zero_smul_divisors α β] :
-  no_zero_smul_divisors (set α) (set β) :=
-⟨λ s t h, begin
-  by_contra' H,
-  have hst : (s • t).nonempty := h.symm.subst zero_nonempty,
-  simp_rw [←hst.of_smul_left.subset_zero_iff, ←hst.of_smul_right.subset_zero_iff, not_subset,
-    mem_zero] at H,
-  obtain ⟨⟨a, hs, ha⟩, b, ht, hb⟩ := H,
-  exact (eq_zero_or_eq_zero_of_smul_eq_zero $ h.subset $ smul_mem_smul hs ht).elim ha hb,
-end⟩
-
-instance no_zero_smul_divisors_set [has_zero α] [has_zero β] [has_smul α β]
-  [no_zero_smul_divisors α β] : no_zero_smul_divisors α (set β) :=
-⟨λ a s h, begin
-  by_contra' H,
-  have hst : (a • s).nonempty := h.symm.subst zero_nonempty,
-  simp_rw [←hst.of_image.subset_zero_iff, not_subset, mem_zero] at H,
-  obtain ⟨ha, b, ht, hb⟩ := H,
-  exact (eq_zero_or_eq_zero_of_smul_eq_zero $ h.subset $ smul_mem_smul_set ht).elim ha hb,
-end⟩
-
-instance [has_zero α] [has_mul α] [no_zero_divisors α] : no_zero_divisors (set α) :=
-⟨λ s t h, eq_zero_or_eq_zero_of_smul_eq_zero h⟩
-
-end smul
-
-section vsub
-variables {ι : Sort*} {κ : ι → Sort*} [has_vsub α β] {s s₁ s₂ t t₁ t₂ : set β} {u : set α} {a : α}
-  {b c : β}
-include α
-
-instance has_vsub : has_vsub (set α) (set β) := ⟨image2 (-ᵥ)⟩
-
-@[simp] lemma image2_vsub : (image2 has_vsub.vsub s t : set α) = s -ᵥ t := rfl
-
-lemma image_vsub_prod : (λ x : β × β, x.fst -ᵥ x.snd) '' s ×ˢ t = s -ᵥ t := image_prod _
-
-lemma mem_vsub : a ∈ s -ᵥ t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x -ᵥ y = a := iff.rfl
-
-lemma vsub_mem_vsub (hb : b ∈ s) (hc : c ∈ t) : b -ᵥ c ∈ s -ᵥ t := mem_image2_of_mem hb hc
-
-@[simp] lemma empty_vsub (t : set β) : ∅ -ᵥ t = ∅ := image2_empty_left
-@[simp] lemma vsub_empty (s : set β) : s -ᵥ ∅ = ∅ := image2_empty_right
-@[simp] lemma vsub_eq_empty : s -ᵥ t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
-@[simp] lemma vsub_nonempty : (s -ᵥ t : set α).nonempty ↔ s.nonempty ∧ t.nonempty :=
-image2_nonempty_iff
-lemma nonempty.vsub : s.nonempty → t.nonempty → (s -ᵥ t : set α).nonempty := nonempty.image2
-lemma nonempty.of_vsub_left : (s -ᵥ t :set α).nonempty → s.nonempty := nonempty.of_image2_left
-lemma nonempty.of_vsub_right : (s -ᵥ t : set α).nonempty → t.nonempty := nonempty.of_image2_right
-@[simp] lemma vsub_singleton (s : set β) (b : β) : s -ᵥ {b} = (-ᵥ b) '' s := image2_singleton_right
-@[simp] lemma singleton_vsub (t : set β) (b : β) : {b} -ᵥ t = ((-ᵥ) b) '' t := image2_singleton_left
-@[simp] lemma singleton_vsub_singleton : ({b} : set β) -ᵥ {c} = {b -ᵥ c} := image2_singleton
-
-@[mono] lemma vsub_subset_vsub : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ -ᵥ t₁ ⊆ s₂ -ᵥ t₂ := image2_subset
-lemma vsub_subset_vsub_left : t₁ ⊆ t₂ → s -ᵥ t₁ ⊆ s -ᵥ t₂ := image2_subset_left
-lemma vsub_subset_vsub_right : s₁ ⊆ s₂ → s₁ -ᵥ t ⊆ s₂ -ᵥ t := image2_subset_right
-lemma vsub_subset_iff : s -ᵥ t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), x -ᵥ y ∈ u := image2_subset_iff
-lemma vsub_self_mono (h : s ⊆ t) : s -ᵥ s ⊆ t -ᵥ t := vsub_subset_vsub h h
-
-lemma union_vsub : (s₁ ∪ s₂) -ᵥ t = s₁ -ᵥ t ∪ (s₂ -ᵥ t) := image2_union_left
-lemma vsub_union : s -ᵥ (t₁ ∪ t₂) = s -ᵥ t₁ ∪ (s -ᵥ t₂) := image2_union_right
-lemma inter_vsub_subset : s₁ ∩ s₂ -ᵥ t ⊆ (s₁ -ᵥ t) ∩ (s₂ -ᵥ t) := image2_inter_subset_left
-lemma vsub_inter_subset : s -ᵥ t₁ ∩ t₂ ⊆ (s -ᵥ t₁) ∩ (s -ᵥ t₂) := image2_inter_subset_right
-
-lemma Union_vsub_left_image : (⋃ a ∈ s, ((-ᵥ) a) '' t) = s -ᵥ t := Union_image_left _
-lemma Union_vsub_right_image : (⋃ a ∈ t, (-ᵥ a) '' s) = s -ᵥ t := Union_image_right _
-
-lemma Union_vsub (s : ι → set β) (t : set β) : (⋃ i, s i) -ᵥ t = ⋃ i, s i -ᵥ t :=
-image2_Union_left _ _ _
-lemma vsub_Union (s : set β) (t : ι → set β) : s -ᵥ (⋃ i, t i) = ⋃ i, s -ᵥ t i :=
-image2_Union_right _ _ _
-
-lemma Union₂_vsub (s : Π i, κ i → set β) (t : set β) : (⋃ i j, s i j) -ᵥ t = ⋃ i j, s i j -ᵥ t :=
-image2_Union₂_left _ _ _
-
-lemma vsub_Union₂ (s : set β) (t : Π i, κ i → set β) : s -ᵥ (⋃ i j, t i j) = ⋃ i j, s -ᵥ t i j :=
-image2_Union₂_right _ _ _
-
-lemma Inter_vsub_subset (s : ι → set β) (t : set β) : (⋂ i, s i) -ᵥ t ⊆ ⋂ i, s i -ᵥ t :=
-image2_Inter_subset_left _ _ _
-
-lemma vsub_Inter_subset (s : set β) (t : ι → set β) : s -ᵥ (⋂ i, t i) ⊆ ⋂ i, s -ᵥ t i :=
-image2_Inter_subset_right _ _ _
-
-lemma Inter₂_vsub_subset (s : Π i, κ i → set β) (t : set β) :
-  (⋂ i j, s i j) -ᵥ t ⊆ ⋂ i j, s i j -ᵥ t :=
-image2_Inter₂_subset_left _ _ _
-
-lemma vsub_Inter₂_subset (s : set β) (t : Π i, κ i → set β) :
-  s -ᵥ (⋂ i j, t i j) ⊆ ⋂ i j, s -ᵥ t i j :=
-image2_Inter₂_subset_right _ _ _
-
-lemma finite.vsub (hs : s.finite) (ht : t.finite) : set.finite (s -ᵥ t) := hs.image2 _ ht
-
-end vsub
-
-open_locale pointwise
-
-section smul_with_zero
-variables [has_zero α] [has_zero β] [smul_with_zero α β] {s : set α} {t : set β}
-
-/-!
-Note that we have neither `smul_with_zero α (set β)` nor `smul_with_zero (set α) (set β)`
-because `0 * ∅ ≠ 0`.
--/
-
-lemma smul_zero_subset (s : set α) : s • (0 : set β) ⊆ 0 := by simp [subset_def, mem_smul]
-lemma zero_smul_subset (t : set β) : (0 : set α) • t ⊆ 0 := by simp [subset_def, mem_smul]
-
-lemma nonempty.smul_zero (hs : s.nonempty) : s • (0 : set β) = 0 :=
-s.smul_zero_subset.antisymm $ by simpa [mem_smul] using hs
-
-lemma nonempty.zero_smul (ht : t.nonempty) : (0 : set α) • t = 0 :=
-t.zero_smul_subset.antisymm $ by simpa [mem_smul] using ht
-
-/-- A nonempty set is scaled by zero to the singleton set containing 0. -/
-lemma zero_smul_set {s : set β} (h : s.nonempty) : (0 : α) • s = (0 : set β) :=
-by simp only [← image_smul, image_eta, zero_smul, h.image_const, singleton_zero]
-
-lemma zero_smul_set_subset (s : set β) : (0 : α) • s ⊆ 0 :=
-image_subset_iff.2 $ λ x _, zero_smul α x
-
-lemma subsingleton_zero_smul_set (s : set β) : ((0 : α) • s).subsingleton :=
-subsingleton_singleton.anti $ zero_smul_set_subset s
-
-lemma zero_mem_smul_set {t : set β} {a : α} (h : (0 : β) ∈ t) : (0 : β) ∈ a • t :=
-⟨0, h, smul_zero _⟩
-
-variables [no_zero_smul_divisors α β] {a : α}
-
-lemma zero_mem_smul_iff : (0 : β) ∈ s • t ↔ (0 : α) ∈ s ∧ t.nonempty ∨ (0 : β) ∈ t ∧ s.nonempty :=
-begin
-  split,
-  { rintro ⟨a, b, ha, hb, h⟩,
-    obtain rfl | rfl := eq_zero_or_eq_zero_of_smul_eq_zero h,
-    { exact or.inl ⟨ha, b, hb⟩ },
-    { exact or.inr ⟨hb, a, ha⟩ } },
-  { rintro (⟨hs, b, hb⟩ | ⟨ht, a, ha⟩),
-    { exact ⟨0, b, hs, hb, zero_smul _ _⟩ },
-    { exact ⟨a, 0, ha, ht, smul_zero _⟩ } }
-end
-
-lemma zero_mem_smul_set_iff (ha : a ≠ 0) : (0 : β) ∈ a • t ↔ (0 : β) ∈ t :=
-begin
-  refine ⟨_, zero_mem_smul_set⟩,
-  rintro ⟨b, hb, h⟩,
-  rwa (eq_zero_or_eq_zero_of_smul_eq_zero h).resolve_left ha at hb,
-end
-
-end smul_with_zero
-
-section left_cancel_semigroup
-variables [left_cancel_semigroup α] {s t : set α}
-
-@[to_additive] lemma pairwise_disjoint_smul_iff :
-  s.pairwise_disjoint (• t) ↔ (s ×ˢ t).inj_on (λ p, p.1 * p.2) :=
-pairwise_disjoint_image_right_iff $ λ _ _, mul_right_injective _
-
-end left_cancel_semigroup
-
-section group
-variables [group α] [mul_action α β] {s t A B : set β} {a : α} {x : β}
-
-@[simp, to_additive]
-lemma smul_mem_smul_set_iff : a • x ∈ a • s ↔ x ∈ s := (mul_action.injective _).mem_set_image
-
-@[to_additive]
-lemma mem_smul_set_iff_inv_smul_mem : x ∈ a • A ↔ a⁻¹ • x ∈ A :=
-show x ∈ mul_action.to_perm a '' A ↔ _, from mem_image_equiv
-
-@[to_additive]
-lemma mem_inv_smul_set_iff : x ∈ a⁻¹ • A ↔ a • x ∈ A :=
-by simp only [← image_smul, mem_image, inv_smul_eq_iff, exists_eq_right]
-
-@[to_additive]
-lemma preimage_smul (a : α) (t : set β) : (λ x, a • x) ⁻¹' t = a⁻¹ • t :=
-((mul_action.to_perm a).symm.image_eq_preimage _).symm
-
-@[to_additive]
-lemma preimage_smul_inv (a : α) (t : set β) : (λ x, a⁻¹ • x) ⁻¹' t = a • t :=
-preimage_smul (to_units a)⁻¹ t
-
-@[simp, to_additive]
-lemma set_smul_subset_set_smul_iff : a • A ⊆ a • B ↔ A ⊆ B :=
-image_subset_image_iff $ mul_action.injective _
-
-@[to_additive]
-lemma set_smul_subset_iff : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
-(image_subset_iff).trans $ iff_of_eq $ congr_arg _ $
-  preimage_equiv_eq_image_symm _ $ mul_action.to_perm _
-
-@[to_additive]
-lemma subset_set_smul_iff : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
-iff.symm $ (image_subset_iff).trans $ iff.symm $ iff_of_eq $ congr_arg _ $
-  image_equiv_eq_preimage_symm _ $ mul_action.to_perm _
-
-@[to_additive]
-lemma smul_inter_ne_empty_iff {s t : set α} {x : α} :
-  x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ t ∧ b ∈ s) ∧ a * b⁻¹ = x :=
-begin
-  rw ne_empty_iff_nonempty,
-  split,
-  { rintros ⟨a, h, ha⟩,
-    obtain ⟨b, hb, rfl⟩ := mem_smul_set.mp h,
-    exact ⟨x • b, b, ⟨ha, hb⟩, by simp⟩, },
-  { rintros ⟨a, b, ⟨ha, hb⟩, rfl⟩,
-    exact ⟨a, mem_inter (mem_smul_set.mpr ⟨b, hb, by simp⟩) ha⟩, },
-end
-
-@[to_additive]
-lemma smul_inter_ne_empty_iff' {s t : set α} {x : α} :
-  x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ t ∧ b ∈ s) ∧ a / b = x :=
-by simp_rw [smul_inter_ne_empty_iff, div_eq_mul_inv]
-
-@[to_additive]
-lemma op_smul_inter_ne_empty_iff {s t : set α} {x : αᵐᵒᵖ} :
-  x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ s ∧ b ∈ t) ∧ a⁻¹ * b = mul_opposite.unop x :=
-begin
-  rw ne_empty_iff_nonempty,
-  split,
-  { rintros ⟨a, h, ha⟩,
-    obtain ⟨b, hb, rfl⟩ := mem_smul_set.mp h,
-    exact ⟨b, x • b, ⟨hb, ha⟩, by simp⟩, },
-  { rintros ⟨a, b, ⟨ha, hb⟩, H⟩,
-    have : mul_opposite.op (a⁻¹ * b) = x := congr_arg mul_opposite.op H,
-    exact ⟨b, mem_inter (mem_smul_set.mpr ⟨a, ha, by simp [← this]⟩) hb⟩, },
-end
-
-@[simp, to_additive] lemma Union_inv_smul :
-  (⋃ (g : α), g⁻¹ • s) = (⋃ (g : α), g • s) :=
-function.surjective.supr_congr _ inv_surjective $ λ g, rfl
-
-@[to_additive]
-lemma Union_smul_eq_set_of_exists {s : set β} :
-  (⋃ (g : α), g • s) = {a | ∃ (g : α), g • a ∈ s} :=
-by simp_rw [← Union_set_of, ← Union_inv_smul, ← preimage_smul, preimage]
-
-end group
-
-section group_with_zero
-variables [group_with_zero α] [mul_action α β] {s : set α} {a : α}
-
-@[simp] lemma smul_mem_smul_set_iff₀ (ha : a ≠ 0) (A : set β)
-  (x : β) : a • x ∈ a • A ↔ x ∈ A :=
-show units.mk0 a ha • _ ∈ _ ↔ _, from smul_mem_smul_set_iff
-
-lemma mem_smul_set_iff_inv_smul_mem₀ (ha : a ≠ 0) (A : set β) (x : β) :
-  x ∈ a • A ↔ a⁻¹ • x ∈ A :=
-show _ ∈ units.mk0 a ha • _ ↔ _, from mem_smul_set_iff_inv_smul_mem
-
-lemma mem_inv_smul_set_iff₀ (ha : a ≠ 0) (A : set β) (x : β) : x ∈ a⁻¹ • A ↔ a • x ∈ A :=
-show _ ∈ (units.mk0 a ha)⁻¹ • _ ↔ _, from mem_inv_smul_set_iff
-
-lemma preimage_smul₀ (ha : a ≠ 0) (t : set β) : (λ x, a • x) ⁻¹' t = a⁻¹ • t :=
-preimage_smul (units.mk0 a ha) t
-
-lemma preimage_smul_inv₀ (ha : a ≠ 0) (t : set β) :
-  (λ x, a⁻¹ • x) ⁻¹' t = a • t :=
-preimage_smul ((units.mk0 a ha)⁻¹) t
-
-@[simp] lemma set_smul_subset_set_smul_iff₀ (ha : a ≠ 0) {A B : set β} :
-  a • A ⊆ a • B ↔ A ⊆ B :=
-show units.mk0 a ha • _ ⊆ _ ↔ _, from set_smul_subset_set_smul_iff
-
-lemma set_smul_subset_iff₀ (ha : a ≠ 0) {A B : set β} : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
-show units.mk0 a ha • _ ⊆ _ ↔ _, from set_smul_subset_iff
-
-lemma subset_set_smul_iff₀ (ha : a ≠ 0) {A B : set β} : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
-show _ ⊆ units.mk0 a ha • _ ↔ _, from subset_set_smul_iff
-
-lemma smul_univ₀ (hs : ¬ s ⊆ 0) : s • (univ : set β) = univ :=
-let ⟨a, ha, ha₀⟩ := not_subset.1 hs in eq_univ_of_forall $ λ b,
-  ⟨a, a⁻¹ • b, ha, trivial, smul_inv_smul₀ ha₀ _⟩
-
-lemma smul_set_univ₀ (ha : a ≠ 0) : a • (univ : set β) = univ :=
-eq_univ_of_forall $ λ b, ⟨a⁻¹ • b, trivial, smul_inv_smul₀ ha _⟩
-
-end group_with_zero
-
-section monoid
-variables [monoid α] [add_group β] [distrib_mul_action α β] (a : α) (s : set α) (t : set β)
-
-@[simp] lemma smul_set_neg : a • -t = -(a • t) :=
-by simp_rw [←image_smul, ←image_neg, image_image, smul_neg]
-
-@[simp] protected lemma smul_neg : s • -t = -(s • t) :=
-by { simp_rw ←image_neg, exact image_image2_right_comm smul_neg }
-
-end monoid
-
-section ring
-variables [ring α] [add_comm_group β] [module α β] (a : α) (s : set α) (t : set β)
-
-@[simp] lemma neg_smul_set : -a • t = -(a • t) :=
-by simp_rw [←image_smul, ←image_neg, image_image, neg_smul]
-
-@[simp] protected lemma neg_smul : -s • t = -(s • t) :=
-by { simp_rw ←image_neg, exact image2_image_left_comm neg_smul }
-
-end ring
-
 end set
 
 /-! ### Miscellaneous -/
@@ -1321,34 +724,4 @@ begin
     exact λ k hk, (key k (hn1.trans hk)).trans (key B hn1).symm },
 end
 
-variables {G : Type*} [group G] [fintype G] (S : set G)
-
-@[to_additive]
-lemma card_pow_eq_card_pow_card_univ [∀ (k : ℕ), decidable_pred (∈ (S ^ k))] :
-  ∀ k, fintype.card G ≤ k → fintype.card ↥(S ^ k) = fintype.card ↥(S ^ (fintype.card G)) :=
-begin
-  have hG : 0 < fintype.card G := fintype.card_pos_iff.mpr ⟨1⟩,
-  by_cases hS : S = ∅,
-  { refine λ k hk, fintype.card_congr _,
-    rw [hS, empty_pow (ne_of_gt (lt_of_lt_of_le hG hk)), empty_pow (ne_of_gt hG)] },
-  obtain ⟨a, ha⟩ := set.ne_empty_iff_nonempty.mp hS,
-  classical!,
-  have key : ∀ a (s t : set G), (∀ b : G, b ∈ s → a * b ∈ t) → fintype.card s ≤ fintype.card t,
-  { refine λ a s t h, fintype.card_le_of_injective (λ ⟨b, hb⟩, ⟨a * b, h b hb⟩) _,
-    rintro ⟨b, hb⟩ ⟨c, hc⟩ hbc,
-    exact subtype.ext (mul_left_cancel (subtype.ext_iff.mp hbc)) },
-  have mono : monotone (λ n, fintype.card ↥(S ^ n) : ℕ → ℕ) :=
-  monotone_nat_of_le_succ (λ n, key a _ _ (λ b hb, set.mul_mem_mul ha hb)),
-  convert card_pow_eq_card_pow_card_univ_aux mono (λ n, set_fintype_card_le_univ (S ^ n))
-    (λ n h, le_antisymm (mono (n + 1).le_succ) (key a⁻¹ _ _ _)),
-  { simp only [finset.filter_congr_decidable, fintype.card_of_finset] },
-  replace h : {a} * S ^ n = S ^ (n + 1),
-  { refine set.eq_of_subset_of_card_le _ (le_trans (ge_of_eq h) _),
-    { exact mul_subset_mul (set.singleton_subset_iff.mpr ha) set.subset.rfl },
-    { convert key a (S ^ n) ({a} * S ^ n) (λ b hb, set.mul_mem_mul (set.mem_singleton a) hb) } },
-  rw [pow_succ', ←h, mul_assoc, ←pow_succ', h],
-  rintro _ ⟨b, c, hb, hc, rfl⟩,
-  rwa [set.mem_singleton_iff.mp hb, inv_mul_cancel_left],
-end
-
 end group
diff --git a/src/data/set/pointwise/finite.lean b/src/data/set/pointwise/finite.lean
new file mode 100644
index 0000000000000..48814b4e7cc3f
--- /dev/null
+++ b/src/data/set/pointwise/finite.lean
@@ -0,0 +1,115 @@
+/-
+Copyright (c) 2019 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin, Floris van Doorn
+-/
+import data.set.finite
+import data.set.pointwise.smul
+
+/-! # Finiteness lemmas for pointwise operations on sets -/
+
+open_locale pointwise
+
+variables {F α β γ : Type*}
+
+namespace set
+
+section has_involutive_inv
+variables [has_involutive_inv α] {s : set α}
+
+@[to_additive] lemma finite.inv (hs : s.finite) : s⁻¹.finite :=
+hs.preimage $ inv_injective.inj_on _
+
+end has_involutive_inv
+
+section has_mul
+variables [has_mul α] {s t : set α}
+
+@[to_additive] lemma finite.mul : s.finite → t.finite → (s * t).finite := finite.image2 _
+
+/-- Multiplication preserves finiteness. -/
+@[to_additive "Addition preserves finiteness."]
+def fintype_mul [decidable_eq α] (s t : set α) [fintype s] [fintype t] : fintype (s * t : set α) :=
+set.fintype_image2 _ _ _
+
+end has_mul
+
+section monoid
+variables [monoid α] {s t : set α}
+
+@[to_additive]
+instance decidable_mem_mul [fintype α] [decidable_eq α] [decidable_pred (∈ s)]
+  [decidable_pred (∈ t)] :
+  decidable_pred (∈ s * t) :=
+λ _, decidable_of_iff _ mem_mul.symm
+
+@[to_additive]
+instance decidable_mem_pow [fintype α] [decidable_eq α] [decidable_pred (∈ s)] (n : ℕ) :
+  decidable_pred (∈ (s ^ n)) :=
+begin
+  induction n with n ih,
+  { simp_rw [pow_zero, mem_one], apply_instance },
+  { letI := ih, rw pow_succ, apply_instance }
+end
+
+end monoid
+
+section has_smul
+variables [has_smul α β] {s : set α} {t : set β}
+
+@[to_additive] lemma finite.smul : s.finite → t.finite → (s • t).finite := finite.image2 _
+
+end has_smul
+
+section has_smul_set
+variables [has_smul α β] {s : set β} {a : α}
+
+@[to_additive] lemma finite.smul_set : s.finite → (a • s).finite := finite.image _
+
+end has_smul_set
+
+section vsub
+variables [has_vsub α β] {s t : set β}
+include α
+
+lemma finite.vsub (hs : s.finite) (ht : t.finite) : set.finite (s -ᵥ t) := hs.image2 _ ht
+
+end vsub
+
+end set
+
+open set
+
+namespace group
+
+variables {G : Type*} [group G] [fintype G] (S : set G)
+
+@[to_additive]
+lemma card_pow_eq_card_pow_card_univ [∀ (k : ℕ), decidable_pred (∈ (S ^ k))] :
+  ∀ k, fintype.card G ≤ k → fintype.card ↥(S ^ k) = fintype.card ↥(S ^ (fintype.card G)) :=
+begin
+  have hG : 0 < fintype.card G := fintype.card_pos_iff.mpr ⟨1⟩,
+  by_cases hS : S = ∅,
+  { refine λ k hk, fintype.card_congr _,
+    rw [hS, empty_pow (ne_of_gt (lt_of_lt_of_le hG hk)), empty_pow (ne_of_gt hG)] },
+  obtain ⟨a, ha⟩ := set.nonempty_iff_ne_empty.2 hS,
+  classical!,
+  have key : ∀ a (s t : set G), (∀ b : G, b ∈ s → a * b ∈ t) → fintype.card s ≤ fintype.card t,
+  { refine λ a s t h, fintype.card_le_of_injective (λ ⟨b, hb⟩, ⟨a * b, h b hb⟩) _,
+    rintro ⟨b, hb⟩ ⟨c, hc⟩ hbc,
+    exact subtype.ext (mul_left_cancel (subtype.ext_iff.mp hbc)) },
+  have mono : monotone (λ n, fintype.card ↥(S ^ n) : ℕ → ℕ) :=
+  monotone_nat_of_le_succ (λ n, key a _ _ (λ b hb, set.mul_mem_mul ha hb)),
+  convert card_pow_eq_card_pow_card_univ_aux mono (λ n, set_fintype_card_le_univ (S ^ n))
+    (λ n h, le_antisymm (mono (n + 1).le_succ) (key a⁻¹ _ _ _)),
+  { simp only [finset.filter_congr_decidable, fintype.card_of_finset] },
+  replace h : {a} * S ^ n = S ^ (n + 1),
+  { refine set.eq_of_subset_of_card_le _ (le_trans (ge_of_eq h) _),
+    { exact mul_subset_mul (set.singleton_subset_iff.mpr ha) set.subset.rfl },
+    { convert key a (S ^ n) ({a} * S ^ n) (λ b hb, set.mul_mem_mul (set.mem_singleton a) hb) } },
+  rw [pow_succ', ←h, mul_assoc, ←pow_succ', h],
+  rintro _ ⟨b, c, hb, hc, rfl⟩,
+  rwa [set.mem_singleton_iff.mp hb, inv_mul_cancel_left],
+end
+
+end group
diff --git a/src/data/set/pointwise/interval.lean b/src/data/set/pointwise/interval.lean
index c52cc345c25f3..d61a6ba39e525 100644
--- a/src/data/set/pointwise/interval.lean
+++ b/src/data/set/pointwise/interval.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov, Patrick Massot
 -/
 import data.set.intervals.unordered_interval
+import data.set.intervals.monoid
 import data.set.pointwise.basic
 import algebra.order.field.basic
 import algebra.order.group.min_max
@@ -23,76 +24,6 @@ variables {α : Type*}
 
 namespace set
 
-section has_exists_add_of_le
-/-!
-The lemmas in this section state that addition maps intervals bijectively. The typeclass
-`has_exists_add_of_le` is defined specifically to make them work when combined with
-`ordered_cancel_add_comm_monoid`; the lemmas below therefore apply to all
-`ordered_add_comm_group`, but also to `ℕ` and `ℝ≥0`, which are not groups.
-
-TODO : move as much as possible in this file to the setting of this weaker typeclass.
--/
-
-variables [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] (a b d : α)
-
-lemma Icc_add_bij : bij_on (+d) (Icc a b) (Icc (a + d) (b + d)) :=
-begin
-  refine ⟨λ _ h, ⟨add_le_add_right h.1 _, add_le_add_right h.2 _⟩,
-          λ _ _ _ _ h, add_right_cancel h,
-          λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le h.1,
-  rw [mem_Icc, add_right_comm, add_le_add_iff_right, add_le_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ioo_add_bij : bij_on (+d) (Ioo a b) (Ioo (a + d) (b + d)) :=
-begin
-  refine ⟨λ _ h, ⟨add_lt_add_right h.1 _, add_lt_add_right h.2 _⟩,
-          λ _ _ _ _ h, add_right_cancel h,
-          λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le h.1.le,
-  rw [mem_Ioo, add_right_comm, add_lt_add_iff_right, add_lt_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ioc_add_bij : bij_on (+d) (Ioc a b) (Ioc (a + d) (b + d)) :=
-begin
-  refine ⟨λ _ h, ⟨add_lt_add_right h.1 _, add_le_add_right h.2 _⟩,
-          λ _ _ _ _ h, add_right_cancel h,
-          λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le h.1.le,
-  rw [mem_Ioc, add_right_comm, add_lt_add_iff_right, add_le_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ico_add_bij : bij_on (+d) (Ico a b) (Ico (a + d) (b + d)) :=
-begin
-  refine ⟨λ _ h, ⟨add_le_add_right h.1 _, add_lt_add_right h.2 _⟩,
-          λ _ _ _ _ h, add_right_cancel h,
-          λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le h.1,
-  rw [mem_Ico, add_right_comm, add_le_add_iff_right, add_lt_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ici_add_bij : bij_on (+d) (Ici a) (Ici (a + d)) :=
-begin
-  refine ⟨λ x h, add_le_add_right (mem_Ici.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ici.mp h),
-  rw [mem_Ici, add_right_comm, add_le_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ioi_add_bij : bij_on (+d) (Ioi a) (Ioi (a + d)) :=
-begin
-  refine ⟨λ x h, add_lt_add_right (mem_Ioi.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ioi.mp h).le,
-  rw [mem_Ioi, add_right_comm, add_lt_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-end has_exists_add_of_le
-
 section ordered_add_comm_group
 variables [ordered_add_comm_group α] (a b c : α)
 
@@ -233,50 +164,18 @@ by simp [← Ioi_inter_Iio, inter_comm]
 ### Images under `x ↦ a + x`
 -/
 
-@[simp] lemma image_const_add_Ici : (λ x, a + x) '' Ici b = Ici (a + b) :=
-by simp [add_comm]
-
 @[simp] lemma image_const_add_Iic : (λ x, a + x) '' Iic b = Iic (a + b) :=
 by simp [add_comm]
 
 @[simp] lemma image_const_add_Iio : (λ x, a + x) '' Iio b = Iio (a + b) :=
 by simp [add_comm]
 
-@[simp] lemma image_const_add_Ioi : (λ x, a + x) '' Ioi b = Ioi (a + b) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Icc : (λ x, a + x) '' Icc b c = Icc (a + b) (a + c) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Ico : (λ x, a + x) '' Ico b c = Ico (a + b) (a + c) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Ioc : (λ x, a + x) '' Ioc b c = Ioc (a + b) (a + c) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Ioo : (λ x, a + x) '' Ioo b c = Ioo (a + b) (a + c) :=
-by simp [add_comm]
-
 /-!
 ### Images under `x ↦ x + a`
 -/
 
-@[simp] lemma image_add_const_Ici : (λ x, x + a) '' Ici b = Ici (b + a) := by simp
 @[simp] lemma image_add_const_Iic : (λ x, x + a) '' Iic b = Iic (b + a) := by simp
 @[simp] lemma image_add_const_Iio : (λ x, x + a) '' Iio b = Iio (b + a) := by simp
-@[simp] lemma image_add_const_Ioi : (λ x, x + a) '' Ioi b = Ioi (b + a) := by simp
-
-@[simp] lemma image_add_const_Icc : (λ x, x + a) '' Icc b c = Icc (b + a) (c + a) :=
-by simp
-
-@[simp] lemma image_add_const_Ico : (λ x, x + a) '' Ico b c = Ico (b + a) (c + a) :=
-by simp
-
-@[simp] lemma image_add_const_Ioc : (λ x, x + a) '' Ioc b c = Ioc (b + a) (c + a) :=
-by simp
-
-@[simp] lemma image_add_const_Ioo : (λ x, x + a) '' Ioo b c = Ioo (b + a) (c + a) :=
-by simp
 
 /-!
 ### Images under `x ↦ -x`
@@ -299,25 +198,25 @@ lemma image_neg_Ioo : has_neg.neg '' (Ioo a b) = Ioo (-b) (-a) := by simp
 by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
 
 @[simp] lemma image_const_sub_Iic : (λ x, a - x) '' Iic b = Ici (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
 
 @[simp] lemma image_const_sub_Ioi : (λ x, a - x) '' Ioi b = Iio (a - b) :=
 by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
 
 @[simp] lemma image_const_sub_Iio : (λ x, a - x) '' Iio b = Ioi (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
 
 @[simp] lemma image_const_sub_Icc : (λ x, a - x) '' Icc b c = Icc (a - c) (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
 
 @[simp] lemma image_const_sub_Ico : (λ x, a - x) '' Ico b c = Ioc (a - c) (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
 
 @[simp] lemma image_const_sub_Ioc : (λ x, a - x) '' Ioc b c = Ico (a - c) (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
 
 @[simp] lemma image_const_sub_Ioo : (λ x, a - x) '' Ioo b c = Ioo (a - c) (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
 
 /-!
 ### Images under `x ↦ x - a`
@@ -345,16 +244,10 @@ by simp [sub_eq_neg_add]
 -/
 
 lemma Iic_add_bij : bij_on (+a) (Iic b) (Iic (b + a)) :=
-begin
-  refine ⟨λ x h, add_le_add_right (mem_Iic.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
-  simpa [add_comm a] using h,
-end
+image_add_const_Iic a b ▸ ((add_left_injective _).inj_on _).bij_on_image
 
 lemma Iio_add_bij : bij_on (+a) (Iio b) (Iio (b + a)) :=
-begin
-  refine ⟨λ x h, add_lt_add_right (mem_Iio.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
-  simpa [add_comm a] using h,
-end
+image_add_const_Iio a b ▸ ((add_left_injective _).inj_on _).bij_on_image
 
 end ordered_add_comm_group
 
diff --git a/src/data/set/pointwise/iterate.lean b/src/data/set/pointwise/iterate.lean
new file mode 100644
index 0000000000000..9ea81cdc5db2b
--- /dev/null
+++ b/src/data/set/pointwise/iterate.lean
@@ -0,0 +1,39 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import data.set.pointwise.smul
+import algebra.hom.iterate
+import dynamics.fixed_points.basic
+
+/-!
+# Results about pointwise operations on sets with iteration.
+-/
+
+open_locale pointwise
+open set function
+
+/-- Let `n : ℤ` and `s` a subset of a commutative group `G` that is invariant under preimage for
+the map `x ↦ x^n`. Then `s` is invariant under the pointwise action of the subgroup of elements
+`g : G` such that `g^(n^j) = 1` for some `j : ℕ`. (This subgroup is called the Prüfer subgroup when
+ `G` is the `circle` and `n` is prime.) -/
+@[to_additive "Let `n : ℤ` and `s` a subset of an additive commutative group `G` that is invariant
+under preimage for the map `x ↦ n • x`. Then `s` is invariant under the pointwise action of the
+additive subgroup of elements `g : G` such that `(n^j) • g = 0` for some `j : ℕ`. (This additive
+subgroup is called the Prüfer subgroup when `G` is the `add_circle` and `n` is prime.)"]
+lemma smul_eq_self_of_preimage_zpow_eq_self {G : Type*} [comm_group G]
+  {n : ℤ} {s : set G} (hs : (λ x, x^n)⁻¹' s = s)
+  {g : G} {j : ℕ} (hg : g^(n^j) = 1) : g • s = s :=
+begin
+  suffices : ∀ {g' : G} (hg' : g'^(n^j) = 1), g' • s ⊆ s,
+  { refine le_antisymm (this hg) _,
+    conv_lhs { rw ← smul_inv_smul g s, },
+    replace hg : (g⁻¹)^(n^j) = 1, { rw [inv_zpow, hg, inv_one], },
+    simpa only [le_eq_subset, set_smul_subset_set_smul_iff] using this hg, },
+  rw (is_fixed_pt.preimage_iterate hs j : ((zpow_group_hom n)^[j])⁻¹' s = s).symm,
+  rintros g' hg' - ⟨y, hy, rfl⟩,
+  change ((zpow_group_hom n)^[j]) (g' * y) ∈ s,
+  replace hg' : ((zpow_group_hom n)^[j]) g' = 1, { simpa [zpow_group_hom], },
+  rwa [monoid_hom.iterate_map_mul, hg', one_mul],
+end
diff --git a/src/data/set/pointwise/smul.lean b/src/data/set/pointwise/smul.lean
new file mode 100644
index 0000000000000..6d4f7f8d971b6
--- /dev/null
+++ b/src/data/set/pointwise/smul.lean
@@ -0,0 +1,598 @@
+/-
+Copyright (c) 2019 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin, Floris van Doorn
+-/
+import algebra.module.basic
+import data.set.pairwise
+import data.set.pointwise.basic
+
+/-!
+# Pointwise operations of sets
+
+This file defines pointwise algebraic operations on sets.
+
+## Main declarations
+
+For sets `s` and `t` and scalar `a`:
+* `s • t`: Scalar multiplication, set of all `x • y` where `x ∈ s` and `y ∈ t`.
+* `s +ᵥ t`: Scalar addition, set of all `x +ᵥ y` where `x ∈ s` and `y ∈ t`.
+* `s -ᵥ t`: Scalar subtraction, set of all `x -ᵥ y` where `x ∈ s` and `y ∈ t`.
+* `a • s`: Scaling, set of all `a • x` where `x ∈ s`.
+* `a +ᵥ s`: Translation, set of all `a +ᵥ x` where `x ∈ s`.
+
+For `α` a semigroup/monoid, `set α` is a semigroup/monoid.
+
+Appropriate definitions and results are also transported to the additive theory via `to_additive`.
+
+## Implementation notes
+
+* We put all instances in the locale `pointwise`, so that these instances are not available by
+  default. Note that we do not mark them as reducible (as argued by note [reducible non-instances])
+  since we expect the locale to be open whenever the instances are actually used (and making the
+  instances reducible changes the behavior of `simp`.
+
+-/
+
+open function
+
+variables {F α β γ : Type*}
+
+namespace set
+
+open_locale pointwise
+
+/-! ### Translation/scaling of sets -/
+
+section smul
+
+/-- The dilation of set `x • s` is defined as `{x • y | y ∈ s}` in locale `pointwise`. -/
+@[to_additive "The translation of set `x +ᵥ s` is defined as `{x +ᵥ y | y ∈ s}` in
+locale `pointwise`."]
+protected def has_smul_set [has_smul α β] : has_smul α (set β) :=
+⟨λ a, image (has_smul.smul a)⟩
+
+/-- The pointwise scalar multiplication of sets `s • t` is defined as `{x • y | x ∈ s, y ∈ t}` in
+locale `pointwise`. -/
+@[to_additive "The pointwise scalar addition of sets `s +ᵥ t` is defined as
+`{x +ᵥ y | x ∈ s, y ∈ t}` in locale `pointwise`."]
+protected def has_smul [has_smul α β] : has_smul (set α) (set β) :=
+⟨image2 has_smul.smul⟩
+
+localized "attribute [instance] set.has_smul_set set.has_smul" in pointwise
+localized "attribute [instance] set.has_vadd_set set.has_vadd" in pointwise
+
+section has_smul
+variables {ι : Sort*} {κ : ι → Sort*} [has_smul α β] {s s₁ s₂ : set α} {t t₁ t₂ u : set β} {a : α}
+  {b : β}
+
+@[simp, to_additive]
+lemma image2_smul : image2 has_smul.smul s t = s • t := rfl
+
+@[to_additive add_image_prod]
+lemma image_smul_prod : (λ x : α × β, x.fst • x.snd) '' s ×ˢ t = s • t := image_prod _
+
+@[to_additive]
+lemma mem_smul : b ∈ s • t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x • y = b := iff.rfl
+
+@[to_additive] lemma smul_mem_smul : a ∈ s → b ∈ t → a • b ∈ s • t := mem_image2_of_mem
+
+@[simp, to_additive] lemma empty_smul : (∅ : set α) • t = ∅ := image2_empty_left
+@[simp, to_additive] lemma smul_empty : s • (∅ : set β) = ∅ := image2_empty_right
+@[simp, to_additive] lemma smul_eq_empty : s • t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
+@[simp, to_additive] lemma smul_nonempty : (s • t).nonempty ↔ s.nonempty ∧ t.nonempty :=
+image2_nonempty_iff
+@[to_additive] lemma nonempty.smul : s.nonempty → t.nonempty → (s • t).nonempty := nonempty.image2
+@[to_additive] lemma nonempty.of_smul_left : (s • t).nonempty → s.nonempty :=
+nonempty.of_image2_left
+@[to_additive] lemma nonempty.of_smul_right : (s • t).nonempty → t.nonempty :=
+nonempty.of_image2_right
+@[simp, to_additive] lemma smul_singleton : s • {b} = (• b) '' s := image2_singleton_right
+@[simp, to_additive] lemma singleton_smul : ({a} : set α) • t = a • t := image2_singleton_left
+@[simp, to_additive] lemma singleton_smul_singleton : ({a} : set α) • ({b} : set β) = {a • b} :=
+image2_singleton
+
+@[to_additive, mono] lemma smul_subset_smul : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ • t₁ ⊆ s₂ • t₂ := image2_subset
+@[to_additive] lemma smul_subset_smul_left : t₁ ⊆ t₂ → s • t₁ ⊆ s • t₂ := image2_subset_left
+@[to_additive] lemma smul_subset_smul_right : s₁ ⊆ s₂ → s₁ • t ⊆ s₂ • t := image2_subset_right
+@[to_additive] lemma smul_subset_iff : s • t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a • b ∈ u := image2_subset_iff
+
+attribute [mono] vadd_subset_vadd
+
+@[to_additive] lemma union_smul : (s₁ ∪ s₂) • t = s₁ • t ∪ s₂ • t := image2_union_left
+@[to_additive] lemma smul_union : s • (t₁ ∪ t₂) = s • t₁ ∪ s • t₂ := image2_union_right
+@[to_additive] lemma inter_smul_subset : (s₁ ∩ s₂) • t ⊆ s₁ • t ∩ s₂ • t := image2_inter_subset_left
+@[to_additive] lemma smul_inter_subset : s • (t₁ ∩ t₂) ⊆ s • t₁ ∩ s • t₂ :=
+image2_inter_subset_right
+
+@[to_additive] lemma Union_smul_left_image : (⋃ a ∈ s, a • t) = s • t := Union_image_left _
+@[to_additive] lemma Union_smul_right_image : (⋃ a ∈ t, (• a) '' s) = s • t := Union_image_right _
+
+@[to_additive] lemma Union_smul (s : ι → set α) (t : set β) : (⋃ i, s i) • t = ⋃ i, s i • t :=
+image2_Union_left _ _ _
+@[to_additive] lemma smul_Union (s : set α) (t : ι → set β) : s • (⋃ i, t i) = ⋃ i, s • t i :=
+image2_Union_right _ _ _
+
+@[to_additive]
+lemma Union₂_smul (s : Π i, κ i → set α) (t : set β) : (⋃ i j, s i j) • t = ⋃ i j, s i j • t :=
+image2_Union₂_left _ _ _
+
+@[to_additive]
+lemma smul_Union₂ (s : set α) (t : Π i, κ i → set β) : s • (⋃ i j, t i j) = ⋃ i j, s • t i j :=
+image2_Union₂_right _ _ _
+
+@[to_additive]
+lemma Inter_smul_subset (s : ι → set α) (t : set β) : (⋂ i, s i) • t ⊆ ⋂ i, s i • t :=
+image2_Inter_subset_left _ _ _
+
+@[to_additive]
+lemma smul_Inter_subset (s : set α) (t : ι → set β) : s • (⋂ i, t i) ⊆ ⋂ i, s • t i :=
+image2_Inter_subset_right _ _ _
+
+@[to_additive]
+lemma Inter₂_smul_subset (s : Π i, κ i → set α) (t : set β) :
+  (⋂ i j, s i j) • t ⊆ ⋂ i j, s i j • t :=
+image2_Inter₂_subset_left _ _ _
+
+@[to_additive]
+lemma smul_Inter₂_subset (s : set α) (t : Π i, κ i → set β) :
+  s • (⋂ i j, t i j) ⊆ ⋂ i j, s • t i j :=
+image2_Inter₂_subset_right _ _ _
+
+@[simp, to_additive] lemma bUnion_smul_set (s : set α) (t : set β) :
+  (⋃ a ∈ s, a • t) = s • t :=
+Union_image_left _
+
+end has_smul
+
+section has_smul_set
+variables {ι : Sort*} {κ : ι → Sort*} [has_smul α β] {s t t₁ t₂ : set β} {a : α} {b : β} {x y : β}
+
+@[simp, to_additive] lemma image_smul : (λ x, a • x) '' t = a • t := rfl
+
+@[to_additive] lemma mem_smul_set : x ∈ a • t ↔ ∃ y, y ∈ t ∧ a • y = x := iff.rfl
+
+@[to_additive] lemma smul_mem_smul_set : b ∈ s → a • b ∈ a • s := mem_image_of_mem _
+
+@[simp, to_additive] lemma smul_set_empty : a • (∅ : set β) = ∅ := image_empty _
+@[simp, to_additive] lemma smul_set_eq_empty : a • s = ∅ ↔ s = ∅ := image_eq_empty
+@[simp, to_additive] lemma smul_set_nonempty : (a • s).nonempty ↔ s.nonempty := nonempty_image_iff
+
+@[simp, to_additive] lemma smul_set_singleton : a • ({b} : set β) = {a • b} := image_singleton
+
+@[to_additive] lemma smul_set_mono : s ⊆ t → a • s ⊆ a • t := image_subset _
+@[to_additive] lemma smul_set_subset_iff : a • s ⊆ t ↔ ∀ ⦃b⦄, b ∈ s → a • b ∈ t := image_subset_iff
+
+@[to_additive] lemma smul_set_union : a • (t₁ ∪ t₂) = a • t₁ ∪ a • t₂ := image_union _ _ _
+
+@[to_additive]
+lemma smul_set_inter_subset : a • (t₁ ∩ t₂) ⊆ a • t₁ ∩ (a • t₂) := image_inter_subset _ _ _
+
+@[to_additive]
+lemma smul_set_Union (a : α) (s : ι → set β) : a • (⋃ i, s i) = ⋃ i, a • s i := image_Union
+
+@[to_additive]
+lemma smul_set_Union₂ (a : α) (s : Π i, κ i → set β) : a • (⋃ i j, s i j) = ⋃ i j, a • s i j :=
+image_Union₂ _ _
+
+@[to_additive]
+lemma smul_set_Inter_subset (a : α) (t : ι → set β) : a • (⋂ i, t i) ⊆ ⋂ i, a • t i :=
+image_Inter_subset _ _
+
+@[to_additive]
+lemma smul_set_Inter₂_subset (a : α) (t : Π i, κ i → set β) :
+  a • (⋂ i j, t i j) ⊆ ⋂ i j, a • t i j :=
+image_Inter₂_subset _ _
+
+@[to_additive] lemma nonempty.smul_set : s.nonempty → (a • s).nonempty := nonempty.image _
+
+end has_smul_set
+
+variables {s s₁ s₂ : set α} {t t₁ t₂ : set β} {a : α} {b : β}
+
+@[simp, to_additive] lemma bUnion_op_smul_set [has_mul α] (s t : set α) :
+  (⋃ a ∈ t, mul_opposite.op a • s) = s * t :=
+Union_image_right _
+
+@[to_additive]
+lemma smul_set_inter [group α] [mul_action α β] {s t : set β} :
+  a • (s ∩ t) = a • s ∩ a • t :=
+(image_inter $ mul_action.injective a).symm
+
+lemma smul_set_inter₀ [group_with_zero α] [mul_action α β] {s t : set β} (ha : a ≠ 0) :
+  a • (s ∩ t) = a • s ∩ a • t :=
+show units.mk0 a ha • _ = _, from smul_set_inter
+
+@[simp, to_additive]
+lemma smul_set_univ [group α] [mul_action α β] {a : α} : a • (univ : set β) = univ :=
+eq_univ_of_forall $ λ b, ⟨a⁻¹ • b, trivial, smul_inv_smul _ _⟩
+
+@[simp, to_additive]
+lemma smul_univ [group α] [mul_action α β] {s : set α} (hs : s.nonempty) :
+  s • (univ : set β) = univ :=
+let ⟨a, ha⟩ := hs in eq_univ_of_forall $ λ b, ⟨a, a⁻¹ • b, ha, trivial, smul_inv_smul _ _⟩
+
+@[to_additive]
+theorem range_smul_range {ι κ : Type*} [has_smul α β] (b : ι → α) (c : κ → β) :
+  range b • range c = range (λ p : ι × κ, b p.1 • c p.2) :=
+ext $ λ x, ⟨λ hx, let ⟨p, q, ⟨i, hi⟩, ⟨j, hj⟩, hpq⟩ := set.mem_smul.1 hx in
+  ⟨(i, j), hpq ▸ hi ▸ hj ▸ rfl⟩,
+λ ⟨⟨i, j⟩, h⟩, set.mem_smul.2 ⟨b i, c j, ⟨i, rfl⟩, ⟨j, rfl⟩, h⟩⟩
+
+@[to_additive] lemma smul_set_range [has_smul α β] {ι : Sort*} {f : ι → β} :
+  a • range f = range (λ i, a • f i) := (range_comp _ _).symm
+
+@[to_additive]
+instance smul_comm_class_set [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  smul_comm_class α β (set γ) :=
+⟨λ _ _, commute.set_image $ smul_comm _ _⟩
+
+@[to_additive]
+instance smul_comm_class_set' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  smul_comm_class α (set β) (set γ) :=
+⟨λ _ _ _, image_image2_distrib_right $ smul_comm _⟩
+
+@[to_additive]
+instance smul_comm_class_set'' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  smul_comm_class (set α) β (set γ) :=
+by haveI := smul_comm_class.symm α β γ; exact smul_comm_class.symm _ _ _
+
+@[to_additive]
+instance smul_comm_class [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  smul_comm_class (set α) (set β) (set γ) :=
+⟨λ _ _ _, image2_left_comm smul_comm⟩
+
+@[to_additive]
+instance is_scalar_tower [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
+  is_scalar_tower α β (set γ) :=
+{ smul_assoc := λ a b T, by simp only [←image_smul, image_image, smul_assoc] }
+
+@[to_additive]
+instance is_scalar_tower' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
+  is_scalar_tower α (set β) (set γ) :=
+⟨λ _ _ _, image2_image_left_comm $ smul_assoc _⟩
+
+@[to_additive]
+instance is_scalar_tower'' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
+  is_scalar_tower (set α) (set β) (set γ) :=
+{ smul_assoc := λ T T' T'', image2_assoc smul_assoc }
+
+instance is_central_scalar [has_smul α β] [has_smul αᵐᵒᵖ β] [is_central_scalar α β] :
+  is_central_scalar α (set β) :=
+⟨λ a S, congr_arg (λ f, f '' S) $ by exact funext (λ _, op_smul_eq_smul _ _)⟩
+
+/-- A multiplicative action of a monoid `α` on a type `β` gives a multiplicative action of `set α`
+on `set β`. -/
+@[to_additive "An additive action of an additive monoid `α` on a type `β` gives an additive action
+of `set α` on `set β`"]
+protected def mul_action [monoid α] [mul_action α β] : mul_action (set α) (set β) :=
+{ mul_smul := λ _ _ _, image2_assoc mul_smul,
+  one_smul := λ s, image2_singleton_left.trans $ by simp_rw [one_smul, image_id'] }
+
+/-- A multiplicative action of a monoid on a type `β` gives a multiplicative action on `set β`. -/
+@[to_additive "An additive action of an additive monoid on a type `β` gives an additive action
+on `set β`."]
+protected def mul_action_set [monoid α] [mul_action α β] : mul_action α (set β) :=
+{ mul_smul := by { intros, simp only [← image_smul, image_image, ← mul_smul] },
+  one_smul := by { intros, simp only [← image_smul, one_smul, image_id'] } }
+
+localized "attribute [instance] set.mul_action_set set.add_action_set
+  set.mul_action set.add_action" in pointwise
+
+/-- A distributive multiplicative action of a monoid on an additive monoid `β` gives a distributive
+multiplicative action on `set β`. -/
+protected def distrib_mul_action_set [monoid α] [add_monoid β] [distrib_mul_action α β] :
+  distrib_mul_action α (set β) :=
+{ smul_add := λ _ _ _, image_image2_distrib $ smul_add _,
+  smul_zero := λ _, image_singleton.trans $ by rw [smul_zero, singleton_zero] }
+
+/-- A multiplicative action of a monoid on a monoid `β` gives a multiplicative action on `set β`. -/
+protected def mul_distrib_mul_action_set [monoid α] [monoid β] [mul_distrib_mul_action α β] :
+  mul_distrib_mul_action α (set β) :=
+{ smul_mul := λ _ _ _, image_image2_distrib $ smul_mul' _,
+  smul_one := λ _, image_singleton.trans $ by rw [smul_one, singleton_one] }
+
+localized "attribute [instance] set.distrib_mul_action_set set.mul_distrib_mul_action_set"
+  in pointwise
+
+instance [has_zero α] [has_zero β] [has_smul α β] [no_zero_smul_divisors α β] :
+  no_zero_smul_divisors (set α) (set β) :=
+⟨λ s t h, begin
+  by_contra' H,
+  have hst : (s • t).nonempty := h.symm.subst zero_nonempty,
+  simp_rw [←hst.of_smul_left.subset_zero_iff, ←hst.of_smul_right.subset_zero_iff, not_subset,
+    mem_zero] at H,
+  obtain ⟨⟨a, hs, ha⟩, b, ht, hb⟩ := H,
+  exact (eq_zero_or_eq_zero_of_smul_eq_zero $ h.subset $ smul_mem_smul hs ht).elim ha hb,
+end⟩
+
+instance no_zero_smul_divisors_set [has_zero α] [has_zero β] [has_smul α β]
+  [no_zero_smul_divisors α β] : no_zero_smul_divisors α (set β) :=
+⟨λ a s h, begin
+  by_contra' H,
+  have hst : (a • s).nonempty := h.symm.subst zero_nonempty,
+  simp_rw [←hst.of_image.subset_zero_iff, not_subset, mem_zero] at H,
+  obtain ⟨ha, b, ht, hb⟩ := H,
+  exact (eq_zero_or_eq_zero_of_smul_eq_zero $ h.subset $ smul_mem_smul_set ht).elim ha hb,
+end⟩
+
+instance [has_zero α] [has_mul α] [no_zero_divisors α] : no_zero_divisors (set α) :=
+⟨λ s t h, eq_zero_or_eq_zero_of_smul_eq_zero h⟩
+
+end smul
+
+section vsub
+variables {ι : Sort*} {κ : ι → Sort*} [has_vsub α β] {s s₁ s₂ t t₁ t₂ : set β} {u : set α} {a : α}
+  {b c : β}
+include α
+
+instance has_vsub : has_vsub (set α) (set β) := ⟨image2 (-ᵥ)⟩
+
+@[simp] lemma image2_vsub : (image2 has_vsub.vsub s t : set α) = s -ᵥ t := rfl
+
+lemma image_vsub_prod : (λ x : β × β, x.fst -ᵥ x.snd) '' s ×ˢ t = s -ᵥ t := image_prod _
+
+lemma mem_vsub : a ∈ s -ᵥ t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x -ᵥ y = a := iff.rfl
+
+lemma vsub_mem_vsub (hb : b ∈ s) (hc : c ∈ t) : b -ᵥ c ∈ s -ᵥ t := mem_image2_of_mem hb hc
+
+@[simp] lemma empty_vsub (t : set β) : ∅ -ᵥ t = ∅ := image2_empty_left
+@[simp] lemma vsub_empty (s : set β) : s -ᵥ ∅ = ∅ := image2_empty_right
+@[simp] lemma vsub_eq_empty : s -ᵥ t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
+@[simp] lemma vsub_nonempty : (s -ᵥ t : set α).nonempty ↔ s.nonempty ∧ t.nonempty :=
+image2_nonempty_iff
+lemma nonempty.vsub : s.nonempty → t.nonempty → (s -ᵥ t : set α).nonempty := nonempty.image2
+lemma nonempty.of_vsub_left : (s -ᵥ t :set α).nonempty → s.nonempty := nonempty.of_image2_left
+lemma nonempty.of_vsub_right : (s -ᵥ t : set α).nonempty → t.nonempty := nonempty.of_image2_right
+@[simp] lemma vsub_singleton (s : set β) (b : β) : s -ᵥ {b} = (-ᵥ b) '' s := image2_singleton_right
+@[simp] lemma singleton_vsub (t : set β) (b : β) : {b} -ᵥ t = ((-ᵥ) b) '' t := image2_singleton_left
+@[simp] lemma singleton_vsub_singleton : ({b} : set β) -ᵥ {c} = {b -ᵥ c} := image2_singleton
+
+@[mono] lemma vsub_subset_vsub : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ -ᵥ t₁ ⊆ s₂ -ᵥ t₂ := image2_subset
+lemma vsub_subset_vsub_left : t₁ ⊆ t₂ → s -ᵥ t₁ ⊆ s -ᵥ t₂ := image2_subset_left
+lemma vsub_subset_vsub_right : s₁ ⊆ s₂ → s₁ -ᵥ t ⊆ s₂ -ᵥ t := image2_subset_right
+lemma vsub_subset_iff : s -ᵥ t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), x -ᵥ y ∈ u := image2_subset_iff
+lemma vsub_self_mono (h : s ⊆ t) : s -ᵥ s ⊆ t -ᵥ t := vsub_subset_vsub h h
+
+lemma union_vsub : (s₁ ∪ s₂) -ᵥ t = s₁ -ᵥ t ∪ (s₂ -ᵥ t) := image2_union_left
+lemma vsub_union : s -ᵥ (t₁ ∪ t₂) = s -ᵥ t₁ ∪ (s -ᵥ t₂) := image2_union_right
+lemma inter_vsub_subset : s₁ ∩ s₂ -ᵥ t ⊆ (s₁ -ᵥ t) ∩ (s₂ -ᵥ t) := image2_inter_subset_left
+lemma vsub_inter_subset : s -ᵥ t₁ ∩ t₂ ⊆ (s -ᵥ t₁) ∩ (s -ᵥ t₂) := image2_inter_subset_right
+
+lemma Union_vsub_left_image : (⋃ a ∈ s, ((-ᵥ) a) '' t) = s -ᵥ t := Union_image_left _
+lemma Union_vsub_right_image : (⋃ a ∈ t, (-ᵥ a) '' s) = s -ᵥ t := Union_image_right _
+
+lemma Union_vsub (s : ι → set β) (t : set β) : (⋃ i, s i) -ᵥ t = ⋃ i, s i -ᵥ t :=
+image2_Union_left _ _ _
+lemma vsub_Union (s : set β) (t : ι → set β) : s -ᵥ (⋃ i, t i) = ⋃ i, s -ᵥ t i :=
+image2_Union_right _ _ _
+
+lemma Union₂_vsub (s : Π i, κ i → set β) (t : set β) : (⋃ i j, s i j) -ᵥ t = ⋃ i j, s i j -ᵥ t :=
+image2_Union₂_left _ _ _
+
+lemma vsub_Union₂ (s : set β) (t : Π i, κ i → set β) : s -ᵥ (⋃ i j, t i j) = ⋃ i j, s -ᵥ t i j :=
+image2_Union₂_right _ _ _
+
+lemma Inter_vsub_subset (s : ι → set β) (t : set β) : (⋂ i, s i) -ᵥ t ⊆ ⋂ i, s i -ᵥ t :=
+image2_Inter_subset_left _ _ _
+
+lemma vsub_Inter_subset (s : set β) (t : ι → set β) : s -ᵥ (⋂ i, t i) ⊆ ⋂ i, s -ᵥ t i :=
+image2_Inter_subset_right _ _ _
+
+lemma Inter₂_vsub_subset (s : Π i, κ i → set β) (t : set β) :
+  (⋂ i j, s i j) -ᵥ t ⊆ ⋂ i j, s i j -ᵥ t :=
+image2_Inter₂_subset_left _ _ _
+
+lemma vsub_Inter₂_subset (s : set β) (t : Π i, κ i → set β) :
+  s -ᵥ (⋂ i j, t i j) ⊆ ⋂ i j, s -ᵥ t i j :=
+image2_Inter₂_subset_right _ _ _
+
+
+end vsub
+
+open_locale pointwise
+
+section smul_with_zero
+variables [has_zero α] [has_zero β] [smul_with_zero α β] {s : set α} {t : set β}
+
+/-!
+Note that we have neither `smul_with_zero α (set β)` nor `smul_with_zero (set α) (set β)`
+because `0 * ∅ ≠ 0`.
+-/
+
+lemma smul_zero_subset (s : set α) : s • (0 : set β) ⊆ 0 := by simp [subset_def, mem_smul]
+lemma zero_smul_subset (t : set β) : (0 : set α) • t ⊆ 0 := by simp [subset_def, mem_smul]
+
+lemma nonempty.smul_zero (hs : s.nonempty) : s • (0 : set β) = 0 :=
+s.smul_zero_subset.antisymm $ by simpa [mem_smul] using hs
+
+lemma nonempty.zero_smul (ht : t.nonempty) : (0 : set α) • t = 0 :=
+t.zero_smul_subset.antisymm $ by simpa [mem_smul] using ht
+
+/-- A nonempty set is scaled by zero to the singleton set containing 0. -/
+lemma zero_smul_set {s : set β} (h : s.nonempty) : (0 : α) • s = (0 : set β) :=
+by simp only [← image_smul, image_eta, zero_smul, h.image_const, singleton_zero]
+
+lemma zero_smul_set_subset (s : set β) : (0 : α) • s ⊆ 0 :=
+image_subset_iff.2 $ λ x _, zero_smul α x
+
+lemma subsingleton_zero_smul_set (s : set β) : ((0 : α) • s).subsingleton :=
+subsingleton_singleton.anti $ zero_smul_set_subset s
+
+lemma zero_mem_smul_set {t : set β} {a : α} (h : (0 : β) ∈ t) : (0 : β) ∈ a • t :=
+⟨0, h, smul_zero _⟩
+
+variables [no_zero_smul_divisors α β] {a : α}
+
+lemma zero_mem_smul_iff : (0 : β) ∈ s • t ↔ (0 : α) ∈ s ∧ t.nonempty ∨ (0 : β) ∈ t ∧ s.nonempty :=
+begin
+  split,
+  { rintro ⟨a, b, ha, hb, h⟩,
+    obtain rfl | rfl := eq_zero_or_eq_zero_of_smul_eq_zero h,
+    { exact or.inl ⟨ha, b, hb⟩ },
+    { exact or.inr ⟨hb, a, ha⟩ } },
+  { rintro (⟨hs, b, hb⟩ | ⟨ht, a, ha⟩),
+    { exact ⟨0, b, hs, hb, zero_smul _ _⟩ },
+    { exact ⟨a, 0, ha, ht, smul_zero _⟩ } }
+end
+
+lemma zero_mem_smul_set_iff (ha : a ≠ 0) : (0 : β) ∈ a • t ↔ (0 : β) ∈ t :=
+begin
+  refine ⟨_, zero_mem_smul_set⟩,
+  rintro ⟨b, hb, h⟩,
+  rwa (eq_zero_or_eq_zero_of_smul_eq_zero h).resolve_left ha at hb,
+end
+
+end smul_with_zero
+
+section left_cancel_semigroup
+variables [left_cancel_semigroup α] {s t : set α}
+
+@[to_additive] lemma pairwise_disjoint_smul_iff :
+  s.pairwise_disjoint (• t) ↔ (s ×ˢ t).inj_on (λ p, p.1 * p.2) :=
+pairwise_disjoint_image_right_iff $ λ _ _, mul_right_injective _
+
+end left_cancel_semigroup
+
+section group
+variables [group α] [mul_action α β] {s t A B : set β} {a : α} {x : β}
+
+@[simp, to_additive]
+lemma smul_mem_smul_set_iff : a • x ∈ a • s ↔ x ∈ s := (mul_action.injective _).mem_set_image
+
+@[to_additive]
+lemma mem_smul_set_iff_inv_smul_mem : x ∈ a • A ↔ a⁻¹ • x ∈ A :=
+show x ∈ mul_action.to_perm a '' A ↔ _, from mem_image_equiv
+
+@[to_additive]
+lemma mem_inv_smul_set_iff : x ∈ a⁻¹ • A ↔ a • x ∈ A :=
+by simp only [← image_smul, mem_image, inv_smul_eq_iff, exists_eq_right]
+
+@[to_additive]
+lemma preimage_smul (a : α) (t : set β) : (λ x, a • x) ⁻¹' t = a⁻¹ • t :=
+((mul_action.to_perm a).symm.image_eq_preimage _).symm
+
+@[to_additive]
+lemma preimage_smul_inv (a : α) (t : set β) : (λ x, a⁻¹ • x) ⁻¹' t = a • t :=
+preimage_smul (to_units a)⁻¹ t
+
+@[simp, to_additive]
+lemma set_smul_subset_set_smul_iff : a • A ⊆ a • B ↔ A ⊆ B :=
+image_subset_image_iff $ mul_action.injective _
+
+@[to_additive]
+lemma set_smul_subset_iff : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
+(image_subset_iff).trans $ iff_of_eq $ congr_arg _ $
+  preimage_equiv_eq_image_symm _ $ mul_action.to_perm _
+
+@[to_additive]
+lemma subset_set_smul_iff : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
+iff.symm $ (image_subset_iff).trans $ iff.symm $ iff_of_eq $ congr_arg _ $
+  image_equiv_eq_preimage_symm _ $ mul_action.to_perm _
+
+@[to_additive]
+lemma smul_inter_ne_empty_iff {s t : set α} {x : α} :
+  x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ t ∧ b ∈ s) ∧ a * b⁻¹ = x :=
+begin
+  rw ←nonempty_iff_ne_empty,
+  split,
+  { rintros ⟨a, h, ha⟩,
+    obtain ⟨b, hb, rfl⟩ := mem_smul_set.mp h,
+    exact ⟨x • b, b, ⟨ha, hb⟩, by simp⟩, },
+  { rintros ⟨a, b, ⟨ha, hb⟩, rfl⟩,
+    exact ⟨a, mem_inter (mem_smul_set.mpr ⟨b, hb, by simp⟩) ha⟩, },
+end
+
+@[to_additive]
+lemma smul_inter_ne_empty_iff' {s t : set α} {x : α} :
+  x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ t ∧ b ∈ s) ∧ a / b = x :=
+by simp_rw [smul_inter_ne_empty_iff, div_eq_mul_inv]
+
+@[to_additive]
+lemma op_smul_inter_ne_empty_iff {s t : set α} {x : αᵐᵒᵖ} :
+  x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ s ∧ b ∈ t) ∧ a⁻¹ * b = mul_opposite.unop x :=
+begin
+  rw ←nonempty_iff_ne_empty,
+  split,
+  { rintros ⟨a, h, ha⟩,
+    obtain ⟨b, hb, rfl⟩ := mem_smul_set.mp h,
+    exact ⟨b, x • b, ⟨hb, ha⟩, by simp⟩, },
+  { rintros ⟨a, b, ⟨ha, hb⟩, H⟩,
+    have : mul_opposite.op (a⁻¹ * b) = x := congr_arg mul_opposite.op H,
+    exact ⟨b, mem_inter (mem_smul_set.mpr ⟨a, ha, by simp [← this]⟩) hb⟩, },
+end
+
+@[simp, to_additive] lemma Union_inv_smul :
+  (⋃ (g : α), g⁻¹ • s) = (⋃ (g : α), g • s) :=
+function.surjective.supr_congr _ inv_surjective $ λ g, rfl
+
+@[to_additive]
+lemma Union_smul_eq_set_of_exists {s : set β} :
+  (⋃ (g : α), g • s) = {a | ∃ (g : α), g • a ∈ s} :=
+by simp_rw [← Union_set_of, ← Union_inv_smul, ← preimage_smul, preimage]
+
+end group
+
+section group_with_zero
+variables [group_with_zero α] [mul_action α β] {s : set α} {a : α}
+
+@[simp] lemma smul_mem_smul_set_iff₀ (ha : a ≠ 0) (A : set β)
+  (x : β) : a • x ∈ a • A ↔ x ∈ A :=
+show units.mk0 a ha • _ ∈ _ ↔ _, from smul_mem_smul_set_iff
+
+lemma mem_smul_set_iff_inv_smul_mem₀ (ha : a ≠ 0) (A : set β) (x : β) :
+  x ∈ a • A ↔ a⁻¹ • x ∈ A :=
+show _ ∈ units.mk0 a ha • _ ↔ _, from mem_smul_set_iff_inv_smul_mem
+
+lemma mem_inv_smul_set_iff₀ (ha : a ≠ 0) (A : set β) (x : β) : x ∈ a⁻¹ • A ↔ a • x ∈ A :=
+show _ ∈ (units.mk0 a ha)⁻¹ • _ ↔ _, from mem_inv_smul_set_iff
+
+lemma preimage_smul₀ (ha : a ≠ 0) (t : set β) : (λ x, a • x) ⁻¹' t = a⁻¹ • t :=
+preimage_smul (units.mk0 a ha) t
+
+lemma preimage_smul_inv₀ (ha : a ≠ 0) (t : set β) :
+  (λ x, a⁻¹ • x) ⁻¹' t = a • t :=
+preimage_smul ((units.mk0 a ha)⁻¹) t
+
+@[simp] lemma set_smul_subset_set_smul_iff₀ (ha : a ≠ 0) {A B : set β} :
+  a • A ⊆ a • B ↔ A ⊆ B :=
+show units.mk0 a ha • _ ⊆ _ ↔ _, from set_smul_subset_set_smul_iff
+
+lemma set_smul_subset_iff₀ (ha : a ≠ 0) {A B : set β} : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
+show units.mk0 a ha • _ ⊆ _ ↔ _, from set_smul_subset_iff
+
+lemma subset_set_smul_iff₀ (ha : a ≠ 0) {A B : set β} : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
+show _ ⊆ units.mk0 a ha • _ ↔ _, from subset_set_smul_iff
+
+lemma smul_univ₀ (hs : ¬ s ⊆ 0) : s • (univ : set β) = univ :=
+let ⟨a, ha, ha₀⟩ := not_subset.1 hs in eq_univ_of_forall $ λ b,
+  ⟨a, a⁻¹ • b, ha, trivial, smul_inv_smul₀ ha₀ _⟩
+
+lemma smul_set_univ₀ (ha : a ≠ 0) : a • (univ : set β) = univ :=
+eq_univ_of_forall $ λ b, ⟨a⁻¹ • b, trivial, smul_inv_smul₀ ha _⟩
+
+end group_with_zero
+
+section monoid
+variables [monoid α] [add_group β] [distrib_mul_action α β] (a : α) (s : set α) (t : set β)
+
+@[simp] lemma smul_set_neg : a • -t = -(a • t) :=
+by simp_rw [←image_smul, ←image_neg, image_image, smul_neg]
+
+@[simp] protected lemma smul_neg : s • -t = -(s • t) :=
+by { simp_rw ←image_neg, exact image_image2_right_comm smul_neg }
+
+end monoid
+
+section ring
+variables [ring α] [add_comm_group β] [module α β] (a : α) (s : set α) (t : set β)
+
+@[simp] lemma neg_smul_set : -a • t = -(a • t) :=
+by simp_rw [←image_smul, ←image_neg, image_image, neg_smul]
+
+@[simp] protected lemma neg_smul : -s • t = -(s • t) :=
+by { simp_rw ←image_neg, exact image2_image_left_comm neg_smul }
+
+end ring
+
+end set
diff --git a/src/data/set/pointwise/support.lean b/src/data/set/pointwise/support.lean
index aa5f005933a12..2fe0996ee3a80 100644
--- a/src/data/set/pointwise/support.lean
+++ b/src/data/set/pointwise/support.lean
@@ -3,7 +3,7 @@ Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 import algebra.support
 
 /-!
diff --git a/src/data/set/prod.lean b/src/data/set/prod.lean
index be7358befe8d0..73ba2701c9978 100644
--- a/src/data/set/prod.lean
+++ b/src/data/set/prod.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Johannes Hölzl, Patrick Massot
 -/
 import data.set.basic
+import data.set.n_ary
 
 /-!
 # Sets in product and pi types
@@ -52,6 +53,9 @@ instance decidable_mem_prod [hs : decidable_pred (∈ s)] [ht : decidable_pred (
 lemma prod_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ ×ˢ t₁ ⊆ s₂ ×ˢ t₂ :=
 λ x ⟨h₁, h₂⟩, ⟨hs h₁, ht h₂⟩
 
+lemma prod_mono_left (hs : s₁ ⊆ s₂) : s₁ ×ˢ t ⊆ s₂ ×ˢ t := prod_mono hs subset.rfl
+lemma prod_mono_right (ht : t₁ ⊆ t₂) : s ×ˢ t₁ ⊆ s ×ˢ t₂ := prod_mono subset.rfl ht
+
 @[simp] lemma prod_self_subset_prod_self : s₁ ×ˢ s₁ ⊆ s₂ ×ˢ s₂ ↔ s₁ ⊆ s₂ :=
 ⟨λ h x hx, (h (mk_mem_prod hx hx)).1, λ h x hx, ⟨h hx.1, h hx.2⟩⟩
 
@@ -275,7 +279,7 @@ begin
       or_iff_right_iff_imp],
     rintro ⟨rfl, rfl⟩, exact prod_eq_empty_iff.mp h },
   rw [prod_eq_prod_iff_of_nonempty h],
-  rw [← ne_empty_iff_nonempty, ne.def, prod_eq_empty_iff] at h,
+  rw [nonempty_iff_ne_empty, ne.def, prod_eq_empty_iff] at h,
   simp_rw [h, false_and, or_false],
 end
 
@@ -560,7 +564,7 @@ eval_image_pi (mem_univ i) ht
 lemma pi_subset_pi_iff : pi s t₁ ⊆ pi s t₂ ↔ (∀ i ∈ s, t₁ i ⊆ t₂ i) ∨ pi s t₁ = ∅ :=
 begin
   refine ⟨λ h, or_iff_not_imp_right.2 _, λ h, h.elim pi_mono (λ h', h'.symm ▸ empty_subset _)⟩,
-  rw [← ne.def, ne_empty_iff_nonempty],
+  rw [← ne.def, ←nonempty_iff_ne_empty],
   intros hne i hi,
   simpa only [eval_image_pi hi hne, eval_image_pi hi (hne.mono h)]
     using image_subset (λ f : Π i, α i, f i) h
diff --git a/src/data/set/semiring.lean b/src/data/set/semiring.lean
index 2aaf0f1d3a80d..8a9825a30d394 100644
--- a/src/data/set/semiring.lean
+++ b/src/data/set/semiring.lean
@@ -3,7 +3,7 @@ Copyright (c) 2020 Floris van Doorn. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn
 -/
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 
 /-!
 # Sets as a semiring under union
diff --git a/src/data/set/sigma.lean b/src/data/set/sigma.lean
index d66f01ca457dd..8355fb6a3bb7e 100644
--- a/src/data/set/sigma.lean
+++ b/src/data/set/sigma.lean
@@ -3,7 +3,7 @@ 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 data.set.basic
+import data.set.image
 
 /-!
 # Sets in sigma types
diff --git a/src/data/setoid/partition.lean b/src/data/setoid/partition.lean
index 48645c89da3ad..187b22877bf4f 100644
--- a/src/data/setoid/partition.lean
+++ b/src/data/setoid/partition.lean
@@ -170,7 +170,7 @@ def is_partition (c : set (set α)) :=
 /-- A partition of `α` does not contain the empty set. -/
 lemma nonempty_of_mem_partition {c : set (set α)} (hc : is_partition c) {s} (h : s ∈ c) :
   s.nonempty :=
-set.ne_empty_iff_nonempty.1 $ λ hs0, hc.1 $ hs0 ▸ h
+set.nonempty_iff_ne_empty.2 $ λ hs0, hc.1 $ hs0 ▸ h
 
 lemma is_partition_classes (r : setoid α) : is_partition r.classes :=
 ⟨empty_not_mem_classes, classes_eqv_classes⟩
diff --git a/src/data/sigma/order.lean b/src/data/sigma/order.lean
index 3e026d226f1c2..163d86007be8f 100644
--- a/src/data/sigma/order.lean
+++ b/src/data/sigma/order.lean
@@ -9,6 +9,10 @@ import order.bounded_order
 /-!
 # Orders on a sigma type
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/887
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines two orders on a sigma type:
 * The disjoint sum of orders. `a` is less `b` iff `a` and `b` are in the same summand and `a` is
   less than `b` there.
diff --git a/src/data/sum/order.lean b/src/data/sum/order.lean
index a42e691d4c08b..442b722a519be 100644
--- a/src/data/sum/order.lean
+++ b/src/data/sum/order.lean
@@ -8,6 +8,10 @@ import order.hom.basic
 /-!
 # Orders on a sum type
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/880
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the disjoint sum and the linear (aka lexicographic) sum of two orders and provides
 relation instances for `sum.lift_rel` and `sum.lex`.
 
diff --git a/src/data/zmod/basic.lean b/src/data/zmod/basic.lean
index fb7dd8c76d543..8c8957dd63ae9 100644
--- a/src/data/zmod/basic.lean
+++ b/src/data/zmod/basic.lean
@@ -5,6 +5,8 @@ Authors: Chris Hughes
 -/
 
 import algebra.char_p.basic
+import data.nat.parity
+import algebra.group.conj_finite
 import tactic.fin_cases
 
 /-!
@@ -722,6 +724,25 @@ end
 | 0     a := int.nat_abs_eq_zero
 | (n+1) a := by { rw fin.ext_iff, exact iff.rfl }
 
+lemma neg_eq_self_iff {n : ℕ} (a : zmod n) : -a = a ↔ a = 0 ∨ 2 * a.val = n :=
+begin
+  rw [neg_eq_iff_add_eq_zero, ← two_mul],
+  cases n,
+  { rw [@mul_eq_zero ℤ, @mul_eq_zero ℕ, val_eq_zero],
+    exact ⟨λ h, h.elim dec_trivial or.inl, λ h, or.inr (h.elim id $ λ h, h.elim dec_trivial id)⟩ },
+  conv_lhs
+  { rw [← a.nat_cast_zmod_val, ← nat.cast_two, ← nat.cast_mul, nat_coe_zmod_eq_zero_iff_dvd] },
+  split,
+  { rintro ⟨m, he⟩, cases m,
+    { rw [mul_zero, mul_eq_zero] at he,
+      rcases he with ⟨⟨⟩⟩|he,
+      exact or.inl (a.val_eq_zero.1 he) },
+    cases m, { right, rwa mul_one at he },
+    refine (a.val_lt.not_le $ nat.le_of_mul_le_mul_left _ zero_lt_two).elim,
+    rw [he, mul_comm], apply nat.mul_le_mul_left, dec_trivial },
+  { rintro (rfl|h), { rw [val_zero, mul_zero], apply dvd_zero }, { rw h } },
+end
+
 lemma val_cast_of_lt {n : ℕ} {a : ℕ} (h : a < n) : (a : zmod n).val = a :=
 by rw [val_nat_cast, nat.mod_eq_of_lt h]
 
@@ -768,22 +789,60 @@ begin
       sub_zero] }
 end
 
+lemma injective_val_min_abs {n : ℕ} : (val_min_abs : zmod n → ℤ).injective :=
+function.injective_iff_has_left_inverse.2 ⟨_, coe_val_min_abs⟩
+
+lemma _root_.nat.le_div_two_iff_mul_two_le {n m : ℕ} : m ≤ n / 2 ↔ (m : ℤ) * 2 ≤ n :=
+by rw [nat.le_div_iff_mul_le zero_lt_two, ← int.coe_nat_le, int.coe_nat_mul, nat.cast_two]
+
+lemma val_min_abs_nonneg_iff {n : ℕ} [ne_zero n] (x : zmod n) :
+  0 ≤ x.val_min_abs ↔ x.val ≤ n / 2 :=
+begin
+  rw [val_min_abs_def_pos], split_ifs,
+  { exact iff_of_true (nat.cast_nonneg _) h },
+  { exact iff_of_false (sub_lt_zero.2 $ int.coe_nat_lt.2 x.val_lt).not_le h },
+end
+
+lemma val_min_abs_mul_two_eq_iff {n : ℕ} (a : zmod n) : a.val_min_abs * 2 = n ↔ 2 * a.val = n :=
+begin
+  cases n, { simp },
+  by_cases a.val ≤ n.succ / 2,
+  { rw [val_min_abs, if_pos h, ← int.coe_nat_inj', nat.cast_mul, nat.cast_two, mul_comm] },
+  apply iff_of_false (λ he, _) (mt _ h),
+  { rw [← a.val_min_abs_nonneg_iff, ← mul_nonneg_iff_left_nonneg_of_pos, he] at h,
+    exacts [h (nat.cast_nonneg _), zero_lt_two] },
+  { rw [mul_comm], exact λ h, (nat.le_div_iff_mul_le zero_lt_two).2 h.le },
+end
+
+lemma val_min_abs_mem_Ioc {n : ℕ} [ne_zero n] (x : zmod n) :
+  x.val_min_abs * 2 ∈ set.Ioc (-n : ℤ) n :=
+begin
+  simp_rw [val_min_abs_def_pos, nat.le_div_two_iff_mul_two_le], split_ifs,
+  { refine ⟨(neg_lt_zero.2 $ by exact_mod_cast ne_zero.pos n).trans_le (mul_nonneg _ _), h⟩,
+    exacts [nat.cast_nonneg _, zero_le_two] },
+  { refine ⟨_, trans (mul_nonpos_of_nonpos_of_nonneg _ zero_le_two) $ nat.cast_nonneg _⟩,
+    { linarith only [h] },
+    { rw [sub_nonpos, int.coe_nat_le], exact x.val_lt.le } },
+end
+
+lemma val_min_abs_spec {n : ℕ} [ne_zero n] (x : zmod n) (y : ℤ) :
+  x.val_min_abs = y ↔ x = y ∧ y * 2 ∈ set.Ioc (-n : ℤ) n :=
+⟨by { rintro rfl, exact ⟨x.coe_val_min_abs.symm, x.val_min_abs_mem_Ioc⟩ }, λ h, begin
+  rw ← sub_eq_zero,
+  apply @int.eq_zero_of_abs_lt_dvd n,
+  { rw [← int_coe_zmod_eq_zero_iff_dvd, int.cast_sub, coe_val_min_abs, h.1, sub_self] },
+  rw [← mul_lt_mul_right (@zero_lt_two ℤ _ _ _ _ _)],
+  nth_rewrite 0 ← abs_eq_self.2 (@zero_le_two ℤ _ _ _ _),
+  rw [← abs_mul, sub_mul, abs_lt], split;
+  linarith only [x.val_min_abs_mem_Ioc.1, x.val_min_abs_mem_Ioc.2, h.2.1, h.2.2],
+end⟩
+
 lemma nat_abs_val_min_abs_le {n : ℕ} [ne_zero n] (x : zmod n) : x.val_min_abs.nat_abs ≤ n / 2 :=
 begin
-  rw zmod.val_min_abs_def_pos,
-  split_ifs with h, { exact h },
-  have : (x.val - n : ℤ) ≤ 0,
-  { rw [sub_nonpos, int.coe_nat_le], exact x.val_le, },
-  rw [← int.coe_nat_le, int.of_nat_nat_abs_of_nonpos this, neg_sub],
-  conv_lhs { congr, rw [← nat.mod_add_div n 2, int.coe_nat_add, int.coe_nat_mul,
-    int.coe_nat_bit0, int.coe_nat_one] },
-  suffices : ((n % 2 : ℕ) + (n / 2) : ℤ) ≤ (val x),
-  { rw ← sub_nonneg at this ⊢, apply le_trans this (le_of_eq _), ring },
-  norm_cast,
-  calc (n : ℕ) % 2 + n / 2 ≤ 1 + n / 2 :
-    nat.add_le_add_right (nat.le_of_lt_succ (nat.mod_lt _ dec_trivial)) _
-                       ... ≤ x.val     :
-    by { rw add_comm, exact nat.succ_le_of_lt (lt_of_not_ge h) }
+  rw [nat.le_div_two_iff_mul_two_le],
+  cases x.val_min_abs.nat_abs_eq,
+  { rw ← h, exact x.val_min_abs_mem_Ioc.2 },
+  { rw [← neg_le_neg_iff, ← neg_mul, ← h], exact x.val_min_abs_mem_Ioc.1.le },
 end
 
 @[simp] lemma val_min_abs_zero : ∀ n, (0 : zmod n).val_min_abs = 0
@@ -794,12 +853,8 @@ end
   x.val_min_abs = 0 ↔ x = 0 :=
 begin
   cases n, { simp },
-  split,
-  { simp only [val_min_abs_def_pos, int.coe_nat_succ],
-    split_ifs with h h; assume h0,
-    { apply val_injective, rwa [int.coe_nat_eq_zero] at h0, },
-    { apply absurd h0, rw sub_eq_zero, apply ne_of_lt, exact_mod_cast x.val_lt } },
-  { rintro rfl, rw val_min_abs_zero }
+  rw ← val_min_abs_zero n.succ,
+  apply injective_val_min_abs.eq_iff,
 end
 
 lemma nat_cast_nat_abs_val_min_abs {n : ℕ} [ne_zero n] (a : zmod n) :
@@ -807,53 +862,82 @@ lemma nat_cast_nat_abs_val_min_abs {n : ℕ} [ne_zero n] (a : zmod n) :
 begin
   have : (a.val : ℤ) - n ≤ 0,
     by { erw [sub_nonpos, int.coe_nat_le], exact a.val_le, },
-  rw [zmod.val_min_abs_def_pos],
+  rw [val_min_abs_def_pos],
   split_ifs,
   { rw [int.nat_abs_of_nat, nat_cast_zmod_val] },
-  { rw [← int.cast_coe_nat, int.of_nat_nat_abs_of_nonpos this, int.cast_neg, int.cast_sub],
-    rw [int.cast_coe_nat, int.cast_coe_nat, nat_cast_self, sub_zero, nat_cast_zmod_val], }
+  { rw [← int.cast_coe_nat, int.of_nat_nat_abs_of_nonpos this, int.cast_neg, int.cast_sub,
+      int.cast_coe_nat, int.cast_coe_nat, nat_cast_self, sub_zero, nat_cast_zmod_val], }
+end
+
+lemma val_min_abs_neg_of_ne_half {n : ℕ} {a : zmod n} (ha : 2 * a.val ≠ n) :
+  (-a).val_min_abs = -a.val_min_abs :=
+begin
+  casesI eq_zero_or_ne_zero n, { subst h, refl },
+  refine (val_min_abs_spec _ _).2 ⟨_, _, _⟩,
+  { rw [int.cast_neg, coe_val_min_abs] },
+  { rw [neg_mul, neg_lt_neg_iff],
+    exact a.val_min_abs_mem_Ioc.2.lt_of_ne (mt a.val_min_abs_mul_two_eq_iff.1 ha) },
+  { linarith only [a.val_min_abs_mem_Ioc.1] },
 end
 
 @[simp] lemma nat_abs_val_min_abs_neg {n : ℕ} (a : zmod n) :
   (-a).val_min_abs.nat_abs = a.val_min_abs.nat_abs :=
 begin
-  cases n, { simp only [int.nat_abs_neg, val_min_abs_def_zero], },
-  by_cases ha0 : a = 0, { rw [ha0, neg_zero] },
-  by_cases haa : -a = a, { rw [haa] },
-  suffices hpa : (n+1 : ℕ) - a.val ≤ (n+1) / 2 ↔ (n+1 : ℕ) / 2 < a.val,
-  { rw [val_min_abs_def_pos, val_min_abs_def_pos],
-    rw ← not_le at hpa,
-    simp only [if_neg ha0, neg_val, hpa, int.coe_nat_sub a.val_le],
-    split_ifs,
-    all_goals { rw [← int.nat_abs_neg], congr' 1, ring } },
-  suffices : (((n+1 : ℕ) % 2) + 2 * ((n + 1) / 2)) - a.val ≤ (n+1) / 2 ↔ (n+1 : ℕ) / 2 < a.val,
-  by rwa [nat.mod_add_div] at this,
-  suffices : (n + 1) % 2 + (n + 1) / 2 ≤ val a ↔ (n + 1) / 2 < val a,
-  by rw [tsub_le_iff_tsub_le, two_mul, ← add_assoc, add_tsub_cancel_right, this],
-  cases (n + 1 : ℕ).mod_two_eq_zero_or_one with hn0 hn1,
-  { split,
-    { assume h,
-      apply lt_of_le_of_ne (le_trans (nat.le_add_left _ _) h),
-      contrapose! haa,
-      rw [← zmod.nat_cast_zmod_val a, ← haa, neg_eq_iff_add_eq_zero, ← nat.cast_add],
-      rw [char_p.cast_eq_zero_iff (zmod (n+1)) (n+1)],
-      rw [← two_mul, ← zero_add (2 * _), ← hn0, nat.mod_add_div] },
-    { rw [hn0, zero_add], exact le_of_lt } },
-  { rw [hn1, add_comm, nat.succ_le_iff] }
+  by_cases h2a : 2 * a.val = n,
+  { rw a.neg_eq_self_iff.2 (or.inr h2a) },
+  { rw [val_min_abs_neg_of_ne_half h2a, int.nat_abs_neg] }
 end
 
 lemma val_eq_ite_val_min_abs {n : ℕ} [ne_zero n] (a : zmod n) :
   (a.val : ℤ) = a.val_min_abs + if a.val ≤ n / 2 then 0 else n :=
-by { rw [zmod.val_min_abs_def_pos], split_ifs; simp only [add_zero, sub_add_cancel] }
+by { rw val_min_abs_def_pos, split_ifs; simp only [add_zero, sub_add_cancel] }
 
 lemma prime_ne_zero (p q : ℕ) [hp : fact p.prime] [hq : fact q.prime] (hpq : p ≠ q) :
   (q : zmod p) ≠ 0 :=
 by rwa [← nat.cast_zero, ne.def, eq_iff_modeq_nat, nat.modeq_zero_iff_dvd,
   ← hp.1.coprime_iff_not_dvd, nat.coprime_primes hp.1 hq.1]
 
-end zmod
+lemma val_min_abs_nat_abs_eq_min {n : ℕ} [hpos : ne_zero n] (a : zmod n) :
+  a.val_min_abs.nat_abs = min a.val (n - a.val) :=
+begin
+  rw val_min_abs_def_pos,
+  split_ifs with h h,
+  { rw int.nat_abs_of_nat, symmetry,
+    apply min_eq_left (le_trans h (le_trans
+      (nat.half_le_of_sub_le_half _) (nat.sub_le_sub_left n h))),
+    rw nat.sub_sub_self (nat.div_le_self _ _) },
+  { rw [←int.nat_abs_neg, neg_sub, ←nat.cast_sub a.val_le], symmetry,
+    apply min_eq_right (le_trans (le_trans (nat.sub_le_sub_left n (lt_of_not_ge h))
+      (nat.le_half_of_half_lt_sub _)) (le_of_not_ge h)),
+    rw nat.sub_sub_self (nat.div_lt_self (lt_of_le_of_ne' (nat.zero_le _) hpos.1) one_lt_two),
+    apply nat.lt_succ_self }
+end
 
-namespace zmod
+lemma nat_abs_min_of_le_div_two (n : ℕ) (x y : ℤ)
+  (he : (x : zmod n) = y) (hl : x.nat_abs ≤ n / 2) : x.nat_abs ≤ y.nat_abs :=
+begin
+  rw int_coe_eq_int_coe_iff_dvd_sub at he,
+  obtain ⟨m, he⟩ := he,
+  rw sub_eq_iff_eq_add at he,
+  subst he,
+  obtain rfl|hm := eq_or_ne m 0,
+  { rw [mul_zero, zero_add] },
+  apply hl.trans,
+  rw ← add_le_add_iff_right x.nat_abs,
+  refine trans (trans ((add_le_add_iff_left _).2 hl) _) (int.nat_abs_sub_le _ _),
+  rw [add_sub_cancel, int.nat_abs_mul, int.nat_abs_of_nat],
+  refine trans _ (nat.le_mul_of_pos_right $ int.nat_abs_pos_of_ne_zero hm),
+  rw ← mul_two, apply nat.div_mul_le_self,
+end
+
+lemma nat_abs_val_min_abs_add_le {n : ℕ} (a b : zmod n) :
+  (a + b).val_min_abs.nat_abs ≤ (a.val_min_abs + b.val_min_abs).nat_abs :=
+begin
+  cases n, { refl },
+  apply nat_abs_min_of_le_div_two n.succ,
+  { simp_rw [int.cast_add, coe_val_min_abs] },
+  { apply nat_abs_val_min_abs_le },
+end
 
 variables (p : ℕ) [fact p.prime]
 
diff --git a/src/dynamics/ergodic/add_circle.lean b/src/dynamics/ergodic/add_circle.lean
new file mode 100644
index 0000000000000..389be1df41d5a
--- /dev/null
+++ b/src/dynamics/ergodic/add_circle.lean
@@ -0,0 +1,134 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import measure_theory.group.add_circle
+import dynamics.ergodic.ergodic
+import measure_theory.covering.density_theorem
+import data.set.pointwise.iterate
+
+/-!
+# Ergodic maps of the additive circle
+
+This file contains proofs of ergodicity for maps of the additive circle.
+
+## Main definitions:
+
+ * `add_circle.ergodic_zsmul`: given `n : ℤ` such that `1 < |n|`, the self map `y ↦ n • y` on
+   the additive circle is ergodic (wrt the Haar measure).
+ * `add_circle.ergodic_nsmul`: given `n : ℕ` such that `1 < n`, the self map `y ↦ n • y` on
+   the additive circle is ergodic (wrt the Haar measure).
+ * `add_circle.ergodic_zsmul_add`: given `n : ℤ` such that `1 < |n|` and `x : add_circle T`, the
+   self map `y ↦ n • y + x` on the additive circle is ergodic (wrt the Haar measure).
+ * `add_circle.ergodic_nsmul_add`: given `n : ℕ` such that `1 < n` and `x : add_circle T`, the
+   self map `y ↦ n • y + x` on the additive circle is ergodic (wrt the Haar measure).
+
+-/
+
+open set function measure_theory measure_theory.measure filter metric
+open_locale measure_theory nnreal ennreal topological_space pointwise
+
+namespace add_circle
+
+variables {T : ℝ} [hT : fact (0 < T)]
+include hT
+
+/-- If a null-measurable subset of the circle is invariant under rotation by a family of rational
+angles with denominators tending to infinity, then it must be almost empty or almost full. -/
+lemma ae_empty_or_univ_of_forall_vadd_eq_self
+  {s : set $ add_circle T} (hs : null_measurable_set s volume)
+  {ι : Type*} {l : filter ι} [l.ne_bot] {u : ι → add_circle T}
+  (hu₁ : ∀ i, (u i) +ᵥ s = s) (hu₂ : tendsto (add_order_of ∘ u) l at_top) :
+  s =ᵐ[volume] (∅ : set $ add_circle T) ∨ s =ᵐ[volume] univ :=
+begin
+  /- Sketch of proof:
+  Assume `T = 1` for simplicity and let `μ` be the Haar measure. We may assume `s` has positive
+  measure since otherwise there is nothing to prove. In this case, by Lebesgue's density theorem,
+  there exists a point `d` of positive density. Let `Iⱼ` be the sequence of closed balls about `d`
+  of diameter `1 / nⱼ` where `nⱼ` is the additive order of `uⱼ`. Since `d` has positive density we
+  must have `μ (s ∩ Iⱼ) / μ Iⱼ → 1` along `l`. However since `s` is invariant under the action of
+  `uⱼ` and since `Iⱼ` is a fundamental domain for this action, we must have
+  `μ (s ∩ Iⱼ) = nⱼ * μ s = (μ Iⱼ) * μ s`. We thus have `μ s → 1` and thus `μ s = 1`. -/
+  set μ := (volume : measure $ add_circle T),
+  set n : ι → ℕ := add_order_of ∘ u,
+  have hT₀ : 0 < T := hT.out,
+  have hT₁ : ennreal.of_real T ≠ 0 := by simpa,
+  rw [ae_eq_empty, ae_eq_univ_iff_measure_eq hs, add_circle.measure_univ],
+  cases (eq_or_ne (μ s) 0) with h h, { exact or.inl h, },
+  right,
+  obtain ⟨d, -, hd⟩ : ∃ d, d ∈ s ∧ ∀ {ι'} {l : filter ι'} (w : ι' → add_circle T) (δ : ι' → ℝ),
+    tendsto δ l (𝓝[>] 0) → (∀ᶠ j in l, d ∈ closed_ball (w j) (1 * δ j)) →
+      tendsto (λ j, μ (s ∩ closed_ball (w j) (δ j)) / μ (closed_ball (w j) (δ j))) l (𝓝 1) :=
+    exists_mem_of_measure_ne_zero_of_ae h (is_doubling_measure.ae_tendsto_measure_inter_div μ s 1),
+  let I : ι → set (add_circle T) := λ j, closed_ball d (T / (2 * ↑(n j))),
+  replace hd : tendsto (λ j, μ (s ∩ I j) / μ (I j)) l (𝓝 1),
+  { let δ : ι → ℝ := λ j, T / (2 * ↑(n j)),
+    have hδ₀ : ∀ᶠ j in l, 0 < δ j :=
+      (hu₂.eventually_gt_at_top 0).mono (λ j hj, div_pos hT₀ $ by positivity),
+    have hδ₁ : tendsto δ l (𝓝[>] 0),
+    { refine tendsto_nhds_within_iff.mpr ⟨_, hδ₀⟩,
+      replace hu₂ : tendsto (λ j, (T⁻¹ * 2) * n j) l at_top :=
+        (tendsto_coe_nat_at_top_iff.mpr hu₂).const_mul_at_top (by positivity : 0 < T⁻¹ * 2),
+      convert hu₂.inv_tendsto_at_top,
+      ext j,
+      simp only [δ, pi.inv_apply, mul_inv_rev, inv_inv, div_eq_inv_mul, ← mul_assoc], },
+    have hw : ∀ᶠ j in l, d ∈ closed_ball d (1 * δ j) := hδ₀.mono (λ j hj, by simp [hj.le]),
+    exact hd _ δ hδ₁ hw, },
+  suffices : ∀ᶠ j in l, μ (s ∩ I j) / μ (I j) = μ s / ennreal.of_real T,
+  { replace hd := hd.congr' this,
+    rwa [tendsto_const_nhds_iff, ennreal.div_eq_one_iff hT₁ ennreal.of_real_ne_top] at hd, },
+  refine (hu₂.eventually_gt_at_top 0).mono (λ j hj, _),
+  have huj : is_of_fin_add_order (u j) := add_order_of_pos_iff.mp hj,
+  have huj' : 1 ≤ (↑(n j) : ℝ), { norm_cast, exact nat.succ_le_iff.mpr hj, },
+  have hI₀ : μ (I j) ≠ 0 := (measure_closed_ball_pos _ d $ by positivity).ne.symm,
+  have hI₁ : μ (I j) ≠ ⊤ := measure_ne_top _ _,
+  have hI₂ : μ (I j) * ↑(n j) = ennreal.of_real T,
+  { rw [volume_closed_ball, mul_div, mul_div_mul_left T _ two_ne_zero,
+      min_eq_right (div_le_self hT₀.le huj'), mul_comm, ← nsmul_eq_mul, ← ennreal.of_real_nsmul,
+      nsmul_eq_mul, mul_div_cancel'],
+    exact nat.cast_ne_zero.mpr hj.ne', },
+  rw [ennreal.div_eq_div_iff hT₁ ennreal.of_real_ne_top hI₀ hI₁,
+    volume_of_add_preimage_eq s _ (u j) d huj (hu₁ j) closed_ball_ae_eq_ball, nsmul_eq_mul,
+    ← mul_assoc, hI₂],
+end
+
+lemma ergodic_zsmul {n : ℤ} (hn : 1 < |n|) : ergodic (λ (y : add_circle T), n • y) :=
+{ ae_empty_or_univ := λ s hs hs',
+  begin
+    let u : ℕ → add_circle T := λ j, ↑(((↑1 : ℝ) / ↑(n.nat_abs^j)) * T),
+    replace hn : 1 < n.nat_abs, { rwa [int.abs_eq_nat_abs, nat.one_lt_cast] at hn, },
+    have hu₀ : ∀ j, add_order_of (u j) = n.nat_abs^j,
+    { exact λ j, add_order_of_div_of_gcd_eq_one (pow_pos (pos_of_gt hn) j) (gcd_one_left _), },
+    have hnu : ∀ j, n^j • (u j) = 0 := λ j, by rw [← add_order_of_dvd_iff_zsmul_eq_zero, hu₀,
+      int.coe_nat_pow, ← int.abs_eq_nat_abs, ← abs_pow, abs_dvd],
+    have hu₁ : ∀ j, (u j) +ᵥ s = s := λ j, vadd_eq_self_of_preimage_zsmul_eq_self hs' (hnu j),
+    have hu₂ : tendsto (λ j, add_order_of $ u j) at_top at_top,
+    { simp_rw hu₀, exact nat.tendsto_pow_at_top_at_top_of_one_lt hn, },
+    exact ae_empty_or_univ_of_forall_vadd_eq_self hs.null_measurable_set hu₁ hu₂,
+  end,
+  .. measure_preserving_zsmul volume (abs_pos.mp $ lt_trans zero_lt_one hn), }
+
+lemma ergodic_nsmul {n : ℕ} (hn : 1 < n) : ergodic (λ (y : add_circle T), n • y) :=
+ergodic_zsmul (by simp [hn] : 1 < |(n : ℤ)|)
+
+lemma ergodic_zsmul_add (x : add_circle T) {n : ℤ} (h : 1 < |n|) : ergodic $ λ y, n • y + x :=
+begin
+  set f : add_circle T → add_circle T := λ y, n • y + x,
+  let e : add_circle T ≃ᵐ add_circle T := measurable_equiv.add_left (divisible_by.div x $ n - 1),
+  have he : measure_preserving e volume volume := measure_preserving_add_left volume _,
+  suffices : e ∘ f ∘ e.symm = λ y, n • y,
+  { rw [← he.ergodic_conjugate_iff, this], exact ergodic_zsmul h, },
+  replace h : n - 1 ≠ 0, { rw ←abs_one at h, rw sub_ne_zero, exact ne_of_apply_ne _ (ne_of_gt h), },
+  have hnx : n • divisible_by.div x (n - 1) = x + divisible_by.div x (n - 1),
+  { conv_rhs { congr, rw ←divisible_by.div_cancel x h }, rw [sub_smul, one_smul, sub_add_cancel], },
+  ext y,
+  simp only [f, hnx, measurable_equiv.coe_add_left, measurable_equiv.symm_add_left, comp_app,
+    smul_add, zsmul_neg', neg_smul, neg_add_rev],
+  abel,
+end
+
+lemma ergodic_nsmul_add (x : add_circle T) {n : ℕ} (h : 1 < n) : ergodic $ λ y, n • y + x :=
+ergodic_zsmul_add x (by simp [h] : 1 < |(n : ℤ)|)
+
+end add_circle
diff --git a/src/dynamics/ergodic/ergodic.lean b/src/dynamics/ergodic/ergodic.lean
index c879e1a26b7c0..0adf23a110236 100644
--- a/src/dynamics/ergodic/ergodic.lean
+++ b/src/dynamics/ergodic/ergodic.lean
@@ -68,6 +68,45 @@ lemma of_iterate (n : ℕ) (hf : pre_ergodic (f^[n]) μ) : pre_ergodic f μ :=
 
 end pre_ergodic
 
+namespace measure_theory.measure_preserving
+
+variables {β : Type*} {m' : measurable_space β} {μ' : measure β} {s' : set β} {g : α → β}
+
+lemma pre_ergodic_of_pre_ergodic_conjugate (hg : measure_preserving g μ μ')
+  (hf : pre_ergodic f μ) {f' : β → β} (h_comm : g ∘ f = f' ∘ g) :
+  pre_ergodic f' μ' :=
+⟨begin
+  intros s hs₀ hs₁,
+  replace hs₁ : f⁻¹' (g⁻¹' s) = g⁻¹' s, { rw [← preimage_comp, h_comm, preimage_comp, hs₁], },
+  cases hf.ae_empty_or_univ (hg.measurable hs₀) hs₁ with hs₂ hs₂;
+  [left, right],
+  { simpa only [ae_eq_empty, hg.measure_preimage hs₀] using hs₂, },
+  { simpa only [ae_eq_univ, ← preimage_compl, hg.measure_preimage hs₀.compl] using hs₂, },
+end⟩
+
+lemma pre_ergodic_conjugate_iff {e : α ≃ᵐ β} (h : measure_preserving e μ μ') :
+  pre_ergodic (e ∘ f ∘ e.symm) μ' ↔ pre_ergodic f μ :=
+begin
+  refine ⟨λ hf, pre_ergodic_of_pre_ergodic_conjugate (h.symm e) hf _,
+          λ hf, pre_ergodic_of_pre_ergodic_conjugate h hf _⟩,
+  { change (e.symm ∘ e) ∘ f ∘ e.symm = f ∘ e.symm,
+    rw [measurable_equiv.symm_comp_self, comp.left_id], },
+  { change e ∘ f = e ∘ f ∘ e.symm ∘ e,
+    rw [measurable_equiv.symm_comp_self, comp.right_id], },
+end
+
+lemma ergodic_conjugate_iff {e : α ≃ᵐ β} (h : measure_preserving e μ μ') :
+  ergodic (e ∘ f ∘ e.symm) μ' ↔ ergodic f μ :=
+begin
+  have : measure_preserving (e ∘ f ∘ e.symm) μ' μ' ↔ measure_preserving f μ μ :=
+    by rw [h.comp_left_iff, (measure_preserving.symm e h).comp_right_iff],
+  replace h : pre_ergodic (e ∘ f ∘ e.symm) μ' ↔ pre_ergodic f μ := h.pre_ergodic_conjugate_iff,
+  exact ⟨λ hf, { .. this.mp hf.to_measure_preserving, .. h.mp hf.to_pre_ergodic, },
+         λ hf, { .. this.mpr hf.to_measure_preserving, .. h.mpr hf.to_pre_ergodic, }⟩,
+end
+
+end measure_theory.measure_preserving
+
 namespace ergodic
 
 /-- An ergodic map is quasi ergodic. -/
diff --git a/src/dynamics/ergodic/measure_preserving.lean b/src/dynamics/ergodic/measure_preserving.lean
index 305c3f171284b..a3d3eb0ca5817 100644
--- a/src/dynamics/ergodic/measure_preserving.lean
+++ b/src/dynamics/ergodic/measure_preserving.lean
@@ -83,11 +83,27 @@ protected lemma quasi_measure_preserving {f : α → β} (hf : measure_preservin
   quasi_measure_preserving f μa μb :=
 ⟨hf.1, hf.2.absolutely_continuous⟩
 
-lemma comp {g : β → γ} {f : α → β} (hg : measure_preserving g μb μc)
+protected lemma comp {g : β → γ} {f : α → β} (hg : measure_preserving g μb μc)
   (hf : measure_preserving f μa μb) :
   measure_preserving (g ∘ f) μa μc :=
 ⟨hg.1.comp hf.1, by rw [← map_map hg.1 hf.1, hf.2, hg.2]⟩
 
+protected lemma comp_left_iff {g : α → β} {e : β ≃ᵐ γ} (h : measure_preserving e μb μc) :
+  measure_preserving (e ∘ g) μa μc ↔ measure_preserving g μa μb :=
+begin
+  refine ⟨λ hg, _, λ hg, h.comp hg⟩,
+  convert (measure_preserving.symm e h).comp hg,
+  simp [← function.comp.assoc e.symm e g],
+end
+
+protected lemma comp_right_iff {g : α → β} {e : γ ≃ᵐ α} (h : measure_preserving e μc μa) :
+  measure_preserving (g ∘ e) μc μb ↔ measure_preserving g μa μb :=
+begin
+  refine ⟨λ hg, _, λ hg, hg.comp h⟩,
+  convert hg.comp (measure_preserving.symm e h),
+  simp [function.comp.assoc g e e.symm],
+end
+
 protected lemma sigma_finite {f : α → β} (hf : measure_preserving f μa μb) [sigma_finite μb] :
   sigma_finite μa :=
 sigma_finite.of_map μa hf.ae_measurable (by rwa hf.map_eq)
diff --git a/src/field_theory/abel_ruffini.lean b/src/field_theory/abel_ruffini.lean
index c60323b62c775..c637f0cce91a7 100644
--- a/src/field_theory/abel_ruffini.lean
+++ b/src/field_theory/abel_ruffini.lean
@@ -98,12 +98,11 @@ begin
   { rw [hn, pow_zero, sub_self],
     exact gal_zero_is_solvable },
   have hn' : 0 < n := pos_iff_ne_zero.mpr hn,
-  have hn'' : (X ^ n - 1 : F[X]) ≠ 0 :=
-    λ h, one_ne_zero ((leading_coeff_X_pow_sub_one hn').symm.trans (congr_arg leading_coeff h)),
+  have hn'' : (X ^ n - 1 : F[X]) ≠ 0 := X_pow_sub_C_ne_zero hn' 1,
   apply is_solvable_of_comm,
   intros σ τ,
   ext a ha,
-  rw [mem_root_set hn'', alg_hom.map_sub, aeval_X_pow, aeval_one, sub_eq_zero] at ha,
+  simp only [mem_root_set_of_ne hn'', map_sub, aeval_X_pow, aeval_one, sub_eq_zero] at ha,
   have key : ∀ σ : (X ^ n - 1 : F[X]).gal, ∃ m : ℕ, σ a = a ^ m,
   { intro σ,
     lift n to ℕ+ using hn',
@@ -125,10 +124,8 @@ begin
   { rw [hn, pow_zero, ←C_1, ←C_sub],
     exact gal_C_is_solvable (1 - a) },
   have hn' : 0 < n := pos_iff_ne_zero.mpr hn,
-  have hn'' : X ^ n - C a ≠ 0 :=
-    λ h, one_ne_zero ((leading_coeff_X_pow_sub_C hn').symm.trans (congr_arg leading_coeff h)),
-  have hn''' : (X ^ n - 1 : F[X]) ≠ 0 :=
-    λ h, one_ne_zero ((leading_coeff_X_pow_sub_one hn').symm.trans (congr_arg leading_coeff h)),
+  have hn'' : X ^ n - C a ≠ 0 := X_pow_sub_C_ne_zero hn' a,
+  have hn''' : (X ^ n - 1 : F[X]) ≠ 0 := X_pow_sub_C_ne_zero hn' 1,
   have mem_range : ∀ {c}, c ^ n = 1 → ∃ d, algebra_map F (X ^ n - C a).splitting_field d = c :=
     λ c hc, ring_hom.mem_range.mp (minpoly.mem_range_of_degree_eq_one F c (h.def.resolve_left hn'''
       (minpoly.irreducible ((splitting_field.normal (X ^ n - C a)).is_integral c)) (minpoly.dvd F c
@@ -136,7 +133,7 @@ begin
   apply is_solvable_of_comm,
   intros σ τ,
   ext b hb,
-  rw [mem_root_set hn'', alg_hom.map_sub, aeval_X_pow, aeval_C, sub_eq_zero] at hb,
+  simp only [mem_root_set_of_ne hn'', map_sub, aeval_X_pow, aeval_C, sub_eq_zero] at hb,
   have hb' : b ≠ 0,
   { intro hb',
     rw [hb', zero_pow hn'] at hb,
diff --git a/src/field_theory/adjoin.lean b/src/field_theory/adjoin.lean
index d82d4c2339588..283e523f6afdb 100644
--- a/src/field_theory/adjoin.lean
+++ b/src/field_theory/adjoin.lean
@@ -500,7 +500,7 @@ lemma exists_finset_of_mem_supr'' {ι : Type*} {f : ι → intermediate_field F
 begin
   refine exists_finset_of_mem_supr (set_like.le_def.mp (supr_le (λ i x hx, set_like.le_def.mp
     (le_supr_of_le ⟨i, x, hx⟩ le_rfl) (subset_adjoin F _ _))) hx),
-  rw [intermediate_field.minpoly_eq, subtype.coe_mk, polynomial.mem_root_set, minpoly.aeval],
+  rw [intermediate_field.minpoly_eq, subtype.coe_mk, mem_root_set_of_ne, minpoly.aeval],
   exact minpoly.ne_zero (is_integral_iff.mp (is_algebraic_iff_is_integral.mp (h i ⟨x, hx⟩)))
 end
 
diff --git a/src/field_theory/finite/basic.lean b/src/field_theory/finite/basic.lean
index 246add26fd0f9..66eda6e0c97c2 100644
--- a/src/field_theory/finite/basic.lean
+++ b/src/field_theory/finite/basic.lean
@@ -264,8 +264,8 @@ begin
   apply nodup_roots,
   rw separable_def,
   convert is_coprime_one_right.neg_right using 1,
-  { rw [derivative_sub, derivative_X, derivative_X_pow, ←C_eq_nat_cast,
-    C_eq_zero.mpr (char_p.cast_card_eq_zero K), zero_mul, zero_sub], },
+  { rw [derivative_sub, derivative_X, derivative_X_pow, char_p.cast_card_eq_zero K, C_0, zero_mul,
+      zero_sub] },
   end
 
 instance (F : Type*) [field F] [algebra F K] : is_splitting_field F K (X^q - X) :=
diff --git a/src/field_theory/finite/galois_field.lean b/src/field_theory/finite/galois_field.lean
index 7c15fdae57145..b82c540a7203d 100644
--- a/src/field_theory/finite/galois_field.lean
+++ b/src/field_theory/finite/galois_field.lean
@@ -91,12 +91,12 @@ begin
   intros x hx,
   -- We discharge the `p = 0` separately, to avoid typeclass issues on `zmod p`.
   unfreezingI { cases p, cases hp, },
-  apply subring.closure_induction hx; clear_dependent x; simp_rw mem_root_set aux,
+  apply subring.closure_induction hx; clear_dependent x; simp_rw mem_root_set_of_ne aux,
   { rintros x (⟨r, rfl⟩ | hx),
     { simp only [aeval_X_pow, aeval_X, alg_hom.map_sub],
       rw [← map_pow, zmod.pow_card_pow, sub_self], },
     { dsimp only [galois_field] at hx,
-      rwa mem_root_set aux at hx, }, },
+      rwa mem_root_set_of_ne aux at hx, apply_instance }, },
   { dsimp only [g_poly],
     rw [← coeff_zero_eq_aeval_zero'],
     simp only [coeff_X_pow, coeff_X_zero, sub_zero, _root_.map_eq_zero, ite_eq_right_iff,
diff --git a/src/field_theory/is_alg_closed/basic.lean b/src/field_theory/is_alg_closed/basic.lean
index 55550ffbb8f99..9783253d9ef7c 100644
--- a/src/field_theory/is_alg_closed/basic.lean
+++ b/src/field_theory/is_alg_closed/basic.lean
@@ -495,7 +495,7 @@ lemma algebra.is_algebraic.range_eval_eq_root_set_minpoly {F K} (A) [field F] [f
   set.range (λ ψ : K →ₐ[F] A, ψ x) = (minpoly F x).root_set A :=
 begin
   have := algebra.is_algebraic_iff_is_integral.1 hK,
-  ext a, rw mem_root_set_iff (minpoly.ne_zero $ this x) a,
+  ext a, rw [mem_root_set_of_ne (minpoly.ne_zero (this x))]; [skip, apply_instance],
   refine ⟨_, λ ha, _⟩,
   { rintro ⟨ψ, rfl⟩, rw [aeval_alg_hom_apply ψ x, minpoly.aeval, map_zero] },
   let Fx := adjoin_root (minpoly F x),
diff --git a/src/field_theory/normal.lean b/src/field_theory/normal.lean
index ceff83bdfa747..eac698418193c 100644
--- a/src/field_theory/normal.lean
+++ b/src/field_theory/normal.lean
@@ -403,7 +403,7 @@ begin
   { rintros f _ ⟨x, rfl⟩,
     refine le_supr (λ x, adjoin F ((minpoly F x).root_set L)) x
       (subset_adjoin F ((minpoly F x).root_set L) _),
-    rw [polynomial.mem_root_set, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom,
+    rw [mem_root_set_of_ne, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom,
         polynomial.aeval_alg_hom_apply, minpoly.aeval, map_zero],
     exact minpoly.ne_zero ((is_integral_algebra_map_iff (algebra_map K L).injective).mp
       (h.is_integral (algebra_map K L x))) },
diff --git a/src/field_theory/polynomial_galois_group.lean b/src/field_theory/polynomial_galois_group.lean
index 3f192ae04a2d3..7d5cfea07ace0 100644
--- a/src/field_theory/polynomial_galois_group.lean
+++ b/src/field_theory/polynomial_galois_group.lean
@@ -123,12 +123,7 @@ section roots_action
 see `polynomial.gal.map_roots_bijective`. -/
 def map_roots [fact (p.splits (algebra_map F E))] :
   root_set p p.splitting_field → root_set p E :=
-λ x, ⟨is_scalar_tower.to_alg_hom F p.splitting_field E x, begin
-  have key := subtype.mem x,
-  by_cases p = 0,
-  { simp only [h, root_set_zero] at key,
-    exact false.rec _ key },
-  { rw [mem_root_set h, aeval_alg_hom_apply, (mem_root_set h).mp key, alg_hom.map_zero] } end⟩
+set.maps_to.restrict (is_scalar_tower.to_alg_hom F p.splitting_field E) _ _ $ root_set_maps_to _
 
 lemma map_roots_bijective [h : fact (p.splits (algebra_map F E))] :
   function.bijective (map_roots p E) :=
@@ -153,15 +148,7 @@ def roots_equiv_roots [fact (p.splits (algebra_map F E))] :
 equiv.of_bijective (map_roots p E) (map_roots_bijective p E)
 
 instance gal_action_aux : mul_action p.gal (root_set p p.splitting_field) :=
-{ smul := λ ϕ x, ⟨ϕ x, begin
-    have key := subtype.mem x,
-    --simp only [root_set, finset.mem_coe, multiset.mem_to_finset] at *,
-    by_cases p = 0,
-    { simp only [h, root_set_zero] at key,
-      exact false.rec _ key },
-    { rw mem_root_set h,
-      change aeval (ϕ.to_alg_hom x) p = 0,
-      rw [aeval_alg_hom_apply, (mem_root_set h).mp key, alg_hom.map_zero] } end⟩,
+{ smul := λ ϕ, set.maps_to.restrict ϕ _ _ $ root_set_maps_to ϕ.to_alg_hom,
   one_smul := λ _, by { ext, refl },
   mul_smul := λ _ _ _, by { ext, refl } }
 
@@ -373,11 +360,11 @@ begin
   let b : finset ℂ := _,
   let c : finset ℂ := _,
   change a.card = b.card + c.card,
-  have ha : ∀ z : ℂ, z ∈ a ↔ aeval z p = 0 :=
-  λ z, by rw [set.mem_to_finset, mem_root_set hp],
+  have ha : ∀ z : ℂ, z ∈ a ↔ aeval z p = 0,
+  { intro z, rw [set.mem_to_finset, mem_root_set_of_ne hp], apply_instance },
   have hb : ∀ z : ℂ, z ∈ b ↔ aeval z p = 0 ∧ z.im = 0,
   { intro z,
-    simp_rw [finset.mem_image, exists_prop, set.mem_to_finset, mem_root_set hp],
+    simp_rw [finset.mem_image, exists_prop, set.mem_to_finset, mem_root_set_of_ne hp],
     split,
     { rintros ⟨w, hw, rfl⟩,
       exact ⟨by rw [aeval_alg_hom_apply, hw, alg_hom.map_zero], rfl⟩ },
@@ -394,9 +381,9 @@ begin
     simp_rw [finset.mem_image, exists_prop],
     split,
     { rintros ⟨w, hw, rfl⟩,
-      exact ⟨(mem_root_set hp).mp w.2, mt (hc0 w).mpr (equiv.perm.mem_support.mp hw)⟩ },
+      exact ⟨(mem_root_set.mp w.2).2, mt (hc0 w).mpr (equiv.perm.mem_support.mp hw)⟩ },
     { rintros ⟨hz1, hz2⟩,
-      exact ⟨⟨z, (mem_root_set hp).mpr hz1⟩,
+      exact ⟨⟨z, mem_root_set.mpr ⟨hp, hz1⟩⟩,
         equiv.perm.mem_support.mpr (mt (hc0 _).mp hz2), rfl⟩ } },
   rw ← finset.card_disjoint_union,
   { apply congr_arg finset.card,
diff --git a/src/field_theory/separable.lean b/src/field_theory/separable.lean
index 4a09fb62f4fac..3040b17edc7e3 100644
--- a/src/field_theory/separable.lean
+++ b/src/field_theory/separable.lean
@@ -365,9 +365,8 @@ begin
   rw [separable_def', derivative_sub, derivative_X_pow, derivative_one, sub_zero],
   -- Suppose `(n : F) = 0`, then the derivative is `0`, so `X ^ n - 1` is a unit, contradiction.
   rintro (h : is_coprime _ _) hn',
-  rw [← C_eq_nat_cast, hn', C.map_zero, zero_mul, is_coprime_zero_right] at h,
-  have := not_is_unit_X_pow_sub_one F n,
-  contradiction
+  rw [hn', C_0, zero_mul, is_coprime_zero_right] at h,
+  exact not_is_unit_X_pow_sub_one F n h
 end
 
 section splits
diff --git a/src/geometry/euclidean/angle/oriented/affine.lean b/src/geometry/euclidean/angle/oriented/affine.lean
index 5014e01c5ecfe..c627fc75e2991 100644
--- a/src/geometry/euclidean/angle/oriented/affine.lean
+++ b/src/geometry/euclidean/angle/oriented/affine.lean
@@ -22,7 +22,7 @@ This file defines oriented angles in Euclidean affine spaces.
 noncomputable theory
 
 open finite_dimensional complex
-open_locale euclidean_geometry real real_inner_product_space complex_conjugate
+open_locale affine euclidean_geometry real real_inner_product_space complex_conjugate
 
 namespace euclidean_geometry
 
@@ -197,10 +197,42 @@ end
 /-- An oriented angle is zero or `π` if and only if the three points are collinear. -/
 lemma oangle_eq_zero_or_eq_pi_iff_collinear {p₁ p₂ p₃ : P} :
   (∡ p₁ p₂ p₃ = 0 ∨ ∡ p₁ p₂ p₃ = π) ↔ collinear ℝ ({p₁, p₂, p₃} : set P) :=
+by rw [←not_iff_not, not_or_distrib, oangle_ne_zero_and_ne_pi_iff_affine_independent,
+       affine_independent_iff_not_collinear_set]
+
+/-- If twice the oriented angles between two triples of points are equal, one triple is affinely
+independent if and only if the other is. -/
+lemma affine_independent_iff_of_two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ p₅ p₆ : P}
+  (h : (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₄ p₅ p₆) :
+  affine_independent ℝ ![p₁, p₂, p₃] ↔ affine_independent ℝ ![p₄, p₅, p₆] :=
+by simp_rw [←oangle_ne_zero_and_ne_pi_iff_affine_independent, ←real.angle.two_zsmul_ne_zero_iff, h]
+
+/-- If twice the oriented angles between two triples of points are equal, one triple is collinear
+if and only if the other is. -/
+lemma collinear_iff_of_two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ p₅ p₆ : P}
+  (h : (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₄ p₅ p₆) :
+  collinear ℝ ({p₁, p₂, p₃} : set P) ↔ collinear ℝ ({p₄, p₅, p₆} : set P) :=
+by simp_rw [←oangle_eq_zero_or_eq_pi_iff_collinear, ←real.angle.two_zsmul_eq_zero_iff, h]
+
+/-- If corresponding pairs of points in two angles have the same vector span, twice those angles
+are equal. -/
+lemma two_zsmul_oangle_of_vector_span_eq {p₁ p₂ p₃ p₄ p₅ p₆ : P}
+  (h₁₂₄₅ : vector_span ℝ ({p₁, p₂} : set P) = vector_span ℝ ({p₄, p₅} : set P))
+  (h₃₂₆₅ : vector_span ℝ ({p₃, p₂} : set P) = vector_span ℝ ({p₆, p₅} : set P)) :
+  (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₄ p₅ p₆ :=
 begin
-  rw [←not_iff_not, not_or_distrib, oangle_ne_zero_and_ne_pi_iff_affine_independent,
-      affine_independent_iff_not_collinear],
-  simp [-set.union_singleton]
+  simp_rw vector_span_pair at h₁₂₄₅ h₃₂₆₅,
+  exact (o).two_zsmul_oangle_of_span_eq_of_span_eq h₁₂₄₅ h₃₂₆₅
+end
+
+/-- If the lines determined by corresponding pairs of points in two angles are parallel, twice
+those angles are equal. -/
+lemma two_zsmul_oangle_of_parallel {p₁ p₂ p₃ p₄ p₅ p₆ : P}
+  (h₁₂₄₅ : line[ℝ, p₁, p₂] ∥ line[ℝ, p₄, p₅]) (h₃₂₆₅ : line[ℝ, p₃, p₂] ∥ line[ℝ, p₆, p₅]) :
+  (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₄ p₅ p₆ :=
+begin
+  rw affine_subspace.affine_span_pair_parallel_iff_vector_span_eq at h₁₂₄₅ h₃₂₆₅,
+  exact two_zsmul_oangle_of_vector_span_eq h₁₂₄₅ h₃₂₆₅
 end
 
 /-- Given three points not equal to `p`, the angle between the first and the second at `p` plus
@@ -255,6 +287,20 @@ begin
   { simpa using hn }
 end
 
+/-- A base angle of an isosceles triangle is acute, oriented angle-at-point form. -/
+lemma abs_oangle_right_to_real_lt_pi_div_two_of_dist_eq {p₁ p₂ p₃ : P}
+  (h : dist p₁ p₂ = dist p₁ p₃) : |(∡ p₁ p₂ p₃).to_real| < π / 2 :=
+begin
+  simp_rw dist_eq_norm_vsub at h,
+  rw [oangle, ←vsub_sub_vsub_cancel_left p₃ p₂ p₁],
+  exact (o).abs_oangle_sub_right_to_real_lt_pi_div_two h
+end
+
+/-- A base angle of an isosceles triangle is acute, oriented angle-at-point form. -/
+lemma abs_oangle_left_to_real_lt_pi_div_two_of_dist_eq {p₁ p₂ p₃ : P}
+  (h : dist p₁ p₂ = dist p₁ p₃) : |(∡ p₂ p₃ p₁).to_real| < π / 2 :=
+(oangle_eq_oangle_of_dist_eq h) ▸ abs_oangle_right_to_real_lt_pi_div_two_of_dist_eq h
+
 /-- The cosine of the oriented angle at `p` between two points not equal to `p` equals that of the
 unoriented angle. -/
 lemma cos_oangle_eq_cos_angle {p p₁ p₂ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) :
diff --git a/src/geometry/euclidean/angle/oriented/basic.lean b/src/geometry/euclidean/angle/oriented/basic.lean
index 0ac7bef118827..8f1c052d56586 100644
--- a/src/geometry/euclidean/angle/oriented/basic.lean
+++ b/src/geometry/euclidean/angle/oriented/basic.lean
@@ -1457,4 +1457,33 @@ begin
         neg_mul, ←sub_eq_add_neg, mul_comm r₄, mul_comm r₃] }
 end
 
+/-- A base angle of an isosceles triangle is acute, oriented vector angle form. -/
+lemma abs_oangle_sub_left_to_real_lt_pi_div_two {x y : V} (h : ‖x‖ = ‖y‖) :
+  |(o.oangle (y - x) y).to_real| < π / 2 :=
+begin
+  by_cases hn : x = y, { simp [hn, div_pos, real.pi_pos] },
+  have hs : ((2 : ℤ) • (o.oangle (y - x) y)).sign = (o.oangle (y - x) y).sign,
+  { conv_rhs { rw oangle_sign_sub_left_swap },
+    rw [o.oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq hn h, real.angle.sign_pi_sub] },
+  rw real.angle.sign_two_zsmul_eq_sign_iff at hs,
+  rcases hs with hs | hs,
+  { rw [oangle_eq_pi_iff_oangle_rev_eq_pi, oangle_eq_pi_iff_same_ray_neg, neg_sub] at hs,
+    rcases hs with ⟨hy, -, hr⟩,
+    rw ←exists_nonneg_left_iff_same_ray hy at hr,
+    rcases hr with ⟨r, hr0, hr⟩,
+    rw [eq_sub_iff_add_eq] at hr,
+    nth_rewrite 1 ←one_smul ℝ y at hr,
+    rw ←add_smul at hr,
+    rw [←hr, norm_smul, real.norm_eq_abs, abs_of_pos (left.add_pos_of_nonneg_of_pos hr0 one_pos),
+        mul_left_eq_self₀, or_iff_left (norm_ne_zero_iff.2 hy), add_left_eq_self] at h,
+    rw [h, zero_add, one_smul] at hr,
+    exact false.elim (hn hr.symm) },
+  { exact hs }
+end
+
+/-- A base angle of an isosceles triangle is acute, oriented vector angle form. -/
+lemma abs_oangle_sub_right_to_real_lt_pi_div_two {x y : V} (h : ‖x‖ = ‖y‖) :
+  |(o.oangle x (x - y)).to_real| < π / 2 :=
+(o.oangle_sub_eq_oangle_sub_rev_of_norm_eq h).symm ▸ o.abs_oangle_sub_left_to_real_lt_pi_div_two h
+
 end orientation
diff --git a/src/geometry/euclidean/angle/unoriented/affine.lean b/src/geometry/euclidean/angle/unoriented/affine.lean
index f8e2e5b94f9ac..e99e34421fa34 100644
--- a/src/geometry/euclidean/angle/unoriented/affine.lean
+++ b/src/geometry/euclidean/angle/unoriented/affine.lean
@@ -384,4 +384,29 @@ begin
   simp [hp₁p₂, hp₁p₃, ne.symm hp₁p₃, sbtw, hp₃p₂]
 end
 
+/-- Three points are collinear if and only if the first or third point equals the second or the
+angle between them is 0 or π. -/
+lemma collinear_iff_eq_or_eq_or_angle_eq_zero_or_angle_eq_pi {p₁ p₂ p₃ : P} :
+  collinear ℝ ({p₁, p₂, p₃} : set P) ↔ p₁ = p₂ ∨ p₃ = p₂ ∨ ∠ p₁ p₂ p₃ = 0 ∨ ∠ p₁ p₂ p₃ = π :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { replace h := h.wbtw_or_wbtw_or_wbtw,
+    by_cases h₁₂ : p₁ = p₂, { exact or.inl h₁₂ },
+    by_cases h₃₂ : p₃ = p₂, { exact or.inr (or.inl h₃₂) },
+    rw [or_iff_right h₁₂, or_iff_right h₃₂],
+    rcases h with h | h | h,
+    { exact or.inr (angle_eq_pi_iff_sbtw.2 ⟨h, ne.symm h₁₂, ne.symm h₃₂⟩) },
+    { exact or.inl (h.angle₃₁₂_eq_zero_of_ne h₃₂) },
+    { exact or.inl (h.angle₂₃₁_eq_zero_of_ne h₁₂) } },
+  { rcases h with rfl | rfl | h | h,
+    { simpa using collinear_pair ℝ p₁ p₃ },
+    { simpa using collinear_pair ℝ p₁ p₃ },
+    { rw angle_eq_zero_iff_ne_and_wbtw at h,
+      rcases h with ⟨-, h⟩ | ⟨-, h⟩,
+      { rw set.insert_comm, exact h.collinear },
+      { rw [set.insert_comm, set.pair_comm], exact h.collinear } },
+    { rw angle_eq_pi_iff_sbtw at h,
+      exact h.wbtw.collinear } }
+end
+
 end euclidean_geometry
diff --git a/src/geometry/euclidean/basic.lean b/src/geometry/euclidean/basic.lean
index 57d4ced013447..117be50a146e7 100644
--- a/src/geometry/euclidean/basic.lean
+++ b/src/geometry/euclidean/basic.lean
@@ -843,6 +843,25 @@ begin
   exact (dec_trivial : (1 : fin 3) ≠ 2) (hfi hf12)
 end
 
+/-- Any three points in a cospherical set are affinely independent. -/
+lemma cospherical.affine_independent_of_mem_of_ne {s : set P} (hs : cospherical s) {p₁ p₂ p₃ : P}
+  (h₁ : p₁ ∈ s) (h₂ : p₂ ∈ s) (h₃ : p₃ ∈ s) (h₁₂ : p₁ ≠ p₂) (h₁₃ : p₁ ≠ p₃) (h₂₃ : p₂ ≠ p₃) :
+  affine_independent ℝ ![p₁, p₂, p₃] :=
+begin
+  refine hs.affine_independent _ _,
+  { simp [h₁, h₂, h₃, set.insert_subset] },
+  { erw [fin.cons_injective_iff, fin.cons_injective_iff],
+    simp [h₁₂, h₁₃, h₂₃, function.injective] }
+end
+
+/-- The three points of a cospherical set are affinely independent. -/
+lemma cospherical.affine_independent_of_ne {p₁ p₂ p₃ : P} (hs : cospherical ({p₁, p₂, p₃} : set P))
+  (h₁₂ : p₁ ≠ p₂) (h₁₃ : p₁ ≠ p₃) (h₂₃ : p₂ ≠ p₃) :
+  affine_independent ℝ ![p₁, p₂, p₃] :=
+hs.affine_independent_of_mem_of_ne (set.mem_insert _ _)
+  (set.mem_insert_of_mem _ (set.mem_insert _ _))
+  (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_singleton _))) h₁₂ h₁₃ h₂₃
+
 /-- Suppose that `p₁` and `p₂` lie in spheres `s₁` and `s₂`.  Then the vector between the centers
 of those spheres is orthogonal to that between `p₁` and `p₂`; this is a version of
 `inner_vsub_vsub_of_dist_eq_of_dist_eq` for bundled spheres.  (In two dimensions, this says that
diff --git a/src/geometry/euclidean/circumcenter.lean b/src/geometry/euclidean/circumcenter.lean
index cfc8ffd975221..f03398d2a09fc 100644
--- a/src/geometry/euclidean/circumcenter.lean
+++ b/src/geometry/euclidean/circumcenter.lean
@@ -380,6 +380,25 @@ begin
           (λ i, hr i (set.mem_univ _))).symm
 end
 
+/-- Reindexing a simplex along an `equiv` of index types does not change the circumsphere. -/
+@[simp] lemma circumsphere_reindex {m n : ℕ} (s : simplex ℝ P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  (s.reindex e).circumsphere = s.circumsphere :=
+begin
+  refine s.circumsphere_unique_dist_eq.2 _ ⟨_, _⟩; rw ←s.reindex_range_points e,
+  { exact (s.reindex e).circumsphere_unique_dist_eq.1.1 },
+  { exact (s.reindex e).circumsphere_unique_dist_eq.1.2 }
+end
+
+/-- Reindexing a simplex along an `equiv` of index types does not change the circumcenter. -/
+@[simp] lemma circumcenter_reindex {m n : ℕ} (s : simplex ℝ P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  (s.reindex e).circumcenter = s.circumcenter :=
+by simp_rw [←circumcenter, circumsphere_reindex]
+
+/-- Reindexing a simplex along an `equiv` of index types does not change the circumradius. -/
+@[simp] lemma circumradius_reindex {m n : ℕ} (s : simplex ℝ P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  (s.reindex e).circumradius = s.circumradius :=
+by simp_rw [←circumradius, circumsphere_reindex]
+
 local attribute [instance] affine_subspace.to_add_torsor
 
 /-- The orthogonal projection of a point `p` onto the hyperplane spanned by the simplex's points. -/
@@ -854,6 +873,53 @@ begin
   rw [hr sx₁ hsx₁, hr sx₂ hsx₂]
 end
 
+/-- All n-simplices among cospherical points in an n-dimensional
+subspace have the same circumsphere. -/
+lemma exists_circumsphere_eq_of_cospherical_subset {s : affine_subspace ℝ P} {ps : set P}
+  (h : ps ⊆ s) [nonempty s] {n : ℕ} [finite_dimensional ℝ s.direction]
+  (hd : finrank ℝ s.direction = n) (hc : cospherical ps) :
+  ∃ c : sphere P, ∀ sx : simplex ℝ P n, set.range sx.points ⊆ ps → sx.circumsphere = c :=
+begin
+  obtain ⟨r, hr⟩ := exists_circumradius_eq_of_cospherical_subset h hd hc,
+  obtain ⟨c, hc⟩ := exists_circumcenter_eq_of_cospherical_subset h hd hc,
+  exact ⟨⟨c, r⟩, λ sx hsx, sphere.ext _ _ (hc sx hsx) (hr sx hsx)⟩
+end
+
+/-- Two n-simplices among cospherical points in an n-dimensional
+subspace have the same circumsphere. -/
+lemma circumsphere_eq_of_cospherical_subset {s : affine_subspace ℝ P} {ps : set P}
+  (h : ps ⊆ s) [nonempty s] {n : ℕ} [finite_dimensional ℝ s.direction]
+  (hd : finrank ℝ s.direction = n) (hc : cospherical ps) {sx₁ sx₂ : simplex ℝ P n}
+  (hsx₁ : set.range sx₁.points ⊆ ps) (hsx₂ : set.range sx₂.points ⊆ ps) :
+  sx₁.circumsphere = sx₂.circumsphere :=
+begin
+  rcases exists_circumsphere_eq_of_cospherical_subset h hd hc with ⟨r, hr⟩,
+  rw [hr sx₁ hsx₁, hr sx₂ hsx₂]
+end
+
+/-- All n-simplices among cospherical points in n-space have the same
+circumsphere. -/
+lemma exists_circumsphere_eq_of_cospherical {ps : set P} {n : ℕ} [finite_dimensional ℝ V]
+  (hd : finrank ℝ V = n) (hc : cospherical ps) :
+  ∃ c : sphere P, ∀ sx : simplex ℝ P n, set.range sx.points ⊆ ps → sx.circumsphere = c :=
+begin
+  haveI : nonempty (⊤ : affine_subspace ℝ P) := set.univ.nonempty,
+  rw [←finrank_top, ←direction_top ℝ V P] at hd,
+  refine exists_circumsphere_eq_of_cospherical_subset _ hd hc,
+  exact set.subset_univ _
+end
+
+/-- Two n-simplices among cospherical points in n-space have the same
+circumsphere. -/
+lemma circumsphere_eq_of_cospherical {ps : set P} {n : ℕ} [finite_dimensional ℝ V]
+  (hd : finrank ℝ V = n) (hc : cospherical ps) {sx₁ sx₂ : simplex ℝ P n}
+  (hsx₁ : set.range sx₁.points ⊆ ps) (hsx₂ : set.range sx₂.points ⊆ ps) :
+  sx₁.circumsphere = sx₂.circumsphere :=
+begin
+  rcases exists_circumsphere_eq_of_cospherical hd hc with ⟨r, hr⟩,
+  rw [hr sx₁ hsx₁, hr sx₂ hsx₂]
+end
+
 /-- Suppose all distances from `p₁` and `p₂` to the points of a
 simplex are equal, and that `p₁` and `p₂` lie in the affine span of
 `p` with the vertices of that simplex.  Then `p₁` and `p₂` are equal
diff --git a/src/geometry/manifold/instances/sphere.lean b/src/geometry/manifold/instances/sphere.lean
index c7a7a668c29bf..1ad1ee1abe08f 100644
--- a/src/geometry/manifold/instances/sphere.lean
+++ b/src/geometry/manifold/instances/sphere.lean
@@ -124,8 +124,9 @@ begin
   suffices : ‖(4:ℝ) • w + (‖w‖ ^ 2 - 4) • v‖ ^ 2 = (‖w‖ ^ 2 + 4) ^ 2,
   { have h₃ : 0 ≤ ‖stereo_inv_fun_aux v w‖ := norm_nonneg _,
     simpa [h₁, h₃, -one_pow] using this },
+  rw submodule.mem_orthogonal_singleton_iff_inner_left at hw,
   simp [norm_add_sq_real, norm_smul, inner_smul_left, inner_smul_right,
-    inner_left_of_mem_orthogonal_singleton _ hw, mul_pow, real.norm_eq_abs, hv],
+    hw, mul_pow, real.norm_eq_abs, hv],
   ring
 end
 
@@ -186,7 +187,7 @@ lemma stereo_inv_fun_ne_north_pole (hv : ‖v‖ = 1) (w : (ℝ ∙ v)ᗮ) :
 begin
   refine subtype.ne_of_val_ne _,
   rw ← inner_lt_one_iff_real_of_norm_one _ hv,
-  { have hw : ⟪v, w⟫_ℝ = 0 := inner_right_of_mem_orthogonal_singleton v w.2,
+  { have hw : ⟪v, w⟫_ℝ = 0 := submodule.mem_orthogonal_singleton_iff_inner_right.mp w.2,
     have hw' : (‖(w:E)‖ ^ 2 + 4)⁻¹ * (‖(w:E)‖ ^ 2 - 4) < 1,
     { refine (inv_mul_lt_iff' _).mpr _,
       { nlinarith },
@@ -212,7 +213,7 @@ begin
   have split : ↑x = a • v + ↑y,
   { convert eq_sum_orthogonal_projection_self_orthogonal_complement (ℝ ∙ v) x,
     exact (orthogonal_projection_unit_singleton ℝ hv x).symm },
-  have hvy : ⟪v, y⟫_ℝ = 0 := inner_right_of_mem_orthogonal_singleton v y.2,
+  have hvy : ⟪v, y⟫_ℝ = 0 := submodule.mem_orthogonal_singleton_iff_inner_right.mp y.2,
   have pythag : 1 = a ^ 2 + ‖y‖ ^ 2,
   { have hvy' : ⟪a • v, y⟫_ℝ = 0 := by simp [inner_smul_left, hvy],
     convert norm_add_sq_eq_norm_sq_add_norm_sq_of_inner_eq_zero _ _ hvy' using 2,
@@ -261,7 +262,7 @@ begin
       orthogonal_projection_orthogonal_complement_singleton_eq_zero v,
     have h₂ : orthogonal_projection (ℝ ∙ v)ᗮ w = w :=
       orthogonal_projection_mem_subspace_eq_self w,
-    have h₃ : innerSL v w = (0:ℝ) := inner_right_of_mem_orthogonal_singleton v w.2,
+    have h₃ : innerSL v w = (0:ℝ) := submodule.mem_orthogonal_singleton_iff_inner_right.mp w.2,
     have h₄ : innerSL v v = (1:ℝ) := by simp [real_inner_self_eq_norm_mul_norm, hv],
     simp [h₁, h₂, h₃, h₄, continuous_linear_map.map_add, continuous_linear_map.map_smul,
       mul_smul] },
diff --git a/src/group_theory/commuting_probability.lean b/src/group_theory/commuting_probability.lean
index 95f3d44dbf66b..67a21e7762b7b 100644
--- a/src/group_theory/commuting_probability.lean
+++ b/src/group_theory/commuting_probability.lean
@@ -3,6 +3,7 @@ Copyright (c) 2022 Thomas Browning. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning
 -/
+import algebra.group.conj_finite
 import group_theory.abelianization
 import group_theory.group_action.conj_act
 import group_theory.group_action.quotient
diff --git a/src/group_theory/congruence.lean b/src/group_theory/congruence.lean
index ecf6cd1c003ec..11748fd953fb4 100644
--- a/src/group_theory/congruence.lean
+++ b/src/group_theory/congruence.lean
@@ -883,6 +883,11 @@ protected lemma pow {M : Type*} [monoid M] (c : con M) :
 instance {M : Type*} [mul_one_class M] (c : con M) : has_one c.quotient :=
 { one := ((1 : M) : c.quotient) }
 
+@[to_additive]
+lemma smul {α M : Type*} [mul_one_class M] [has_smul α M] [is_scalar_tower α M M] (c : con M)
+  (a : α) {w x : M} (h : c w x) : c (a • w) (a • x) :=
+by simpa only [smul_one_mul] using c.mul (c.refl' (a • 1 : M)) h
+
 instance _root_.add_con.quotient.has_nsmul
   {M : Type*} [add_monoid M] (c : add_con M) : has_smul ℕ c.quotient :=
 { smul := λ n, quotient.map' ((•) n) $ λ x y, c.nsmul n }
@@ -1021,4 +1026,34 @@ end
 
 end units
 
+section actions
+
+@[to_additive]
+instance has_smul {α M : Type*} [mul_one_class M] [has_smul α M] [is_scalar_tower α M M]
+  (c : con M) :
+  has_smul α c.quotient :=
+{ smul := λ a, quotient.map' ((•) a) $ λ x y, c.smul a }
+
+@[to_additive]
+lemma coe_smul {α M : Type*} [mul_one_class M] [has_smul α M] [is_scalar_tower α M M] (c : con M)
+  (a : α) (x : M) : (↑(a • x) : c.quotient) = a • ↑x := rfl
+
+@[to_additive]
+instance mul_action {α M : Type*} [monoid α] [mul_one_class M] [mul_action α M]
+  [is_scalar_tower α M M] (c : con M) :
+  mul_action α c.quotient :=
+{ smul := (•),
+  one_smul := quotient.ind' $ by exact λ x, congr_arg quotient.mk' $ one_smul _ _,
+  mul_smul := λ a₁ a₂, quotient.ind' $ by exact λ x, congr_arg quotient.mk' $ mul_smul _ _ _ }
+
+instance mul_distrib_mul_action {α M : Type*} [monoid α] [monoid M] [mul_distrib_mul_action α M]
+  [is_scalar_tower α M M] (c : con M) :
+  mul_distrib_mul_action α c.quotient :=
+{ smul := (•),
+  smul_one := λ r, congr_arg quotient.mk' $ smul_one _,
+  smul_mul := λ r, quotient.ind₂' $ by exact λ m₁ m₂, congr_arg quotient.mk' $ smul_mul' _ _ _,
+  .. c.mul_action }
+
+end actions
+
 end con
diff --git a/src/group_theory/finiteness.lean b/src/group_theory/finiteness.lean
index 6e4658c62819c..a8a109cd90b0e 100644
--- a/src/group_theory/finiteness.lean
+++ b/src/group_theory/finiteness.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Riccardo Brasca
 -/
 
-import data.set.finite
+import data.set.pointwise.finite
 import group_theory.quotient_group
 import group_theory.submonoid.operations
 import group_theory.subgroup.basic
diff --git a/src/group_theory/free_product.lean b/src/group_theory/free_product.lean
index 5583bd157823c..d7e1d926d1d2f 100644
--- a/src/group_theory/free_product.lean
+++ b/src/group_theory/free_product.lean
@@ -8,7 +8,7 @@ import group_theory.congruence
 import group_theory.is_free_group
 import data.list.chain
 import set_theory.cardinal.ordinal
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 
 /-!
 # The free product of groups or monoids
diff --git a/src/group_theory/group_action/basic.lean b/src/group_theory/group_action/basic.lean
index a37269a65d4b0..d3e5fd0d59cb6 100644
--- a/src/group_theory/group_action/basic.lean
+++ b/src/group_theory/group_action/basic.lean
@@ -6,7 +6,7 @@ Authors: Chris Hughes
 import group_theory.group_action.defs
 import group_theory.group_action.group
 import data.setoid.basic
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 import group_theory.subgroup.basic
 
 /-!
diff --git a/src/group_theory/group_action/defs.lean b/src/group_theory/group_action/defs.lean
index 3c33d0fd4a8ed..fbee61ba9ce03 100644
--- a/src/group_theory/group_action/defs.lean
+++ b/src/group_theory/group_action/defs.lean
@@ -12,6 +12,10 @@ import logic.embedding.basic
 /-!
 # Definitions of group actions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/854
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a hierarchy of group action type-classes on top of the previously defined
 notation classes `has_smul` and its additive version `has_vadd`:
 
diff --git a/src/group_theory/group_action/option.lean b/src/group_theory/group_action/option.lean
index c53fd7489a6fa..4a08ad259a3d3 100644
--- a/src/group_theory/group_action/option.lean
+++ b/src/group_theory/group_action/option.lean
@@ -8,6 +8,10 @@ import group_theory.group_action.defs
 /-!
 # Option instances for additive and multiplicative actions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/884
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines instances for additive and multiplicative actions on `option` type. Scalar
 multiplication is defined by `a • some b = some (a • b)` and `a • none = none`.
 
diff --git a/src/group_theory/group_action/sigma.lean b/src/group_theory/group_action/sigma.lean
index a7947d7f13176..9648b4e1bc461 100644
--- a/src/group_theory/group_action/sigma.lean
+++ b/src/group_theory/group_action/sigma.lean
@@ -8,6 +8,10 @@ import group_theory.group_action.defs
 /-!
 # Sigma instances for additive and multiplicative actions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/885
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines instances for arbitrary sum of additive and multiplicative actions.
 
 ## See also
diff --git a/src/group_theory/group_action/sum.lean b/src/group_theory/group_action/sum.lean
index a789126c6b049..78f8603467416 100644
--- a/src/group_theory/group_action/sum.lean
+++ b/src/group_theory/group_action/sum.lean
@@ -8,6 +8,10 @@ import group_theory.group_action.defs
 /-!
 # Sum instances for additive and multiplicative actions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/882
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines instances for additive and multiplicative actions on the binary `sum` type.
 
 ## See also
diff --git a/src/group_theory/group_action/units.lean b/src/group_theory/group_action/units.lean
index 108b93c18e669..6a9ab262e796d 100644
--- a/src/group_theory/group_action/units.lean
+++ b/src/group_theory/group_action/units.lean
@@ -7,6 +7,10 @@ import group_theory.group_action.defs
 
 /-! # Group actions on and by `Mˣ`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/878
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides the action of a unit on a type `α`, `has_smul Mˣ α`, in the presence of
 `has_smul M α`, with the obvious definition stated in `units.smul_def`. This definition preserves
 `mul_action` and `distrib_mul_action` structures too.
diff --git a/src/group_theory/quotient_group.lean b/src/group_theory/quotient_group.lean
index 67619bfc7bd23..a6e6354bddd3b 100644
--- a/src/group_theory/quotient_group.lean
+++ b/src/group_theory/quotient_group.lean
@@ -108,7 +108,8 @@ end
 -- for commutative groups we don't need normality assumption
 omit nN
 
-@[to_additive] instance {G : Type*} [comm_group G] (N : subgroup G) : comm_group (G ⧸ N) :=
+@[to_additive]
+instance quotient.comm_group {G : Type*} [comm_group G] (N : subgroup G) : comm_group (G ⧸ N) :=
 { mul_comm := λ a b, quotient.induction_on₂' a b
     (λ a b, congr_arg mk (mul_comm a b)),
   .. @quotient_group.quotient.group _ _ N N.normal_of_comm }
@@ -124,64 +125,36 @@ local notation ` Q ` := G ⧸ N
 @[simp, to_additive] lemma coe_pow (a : G) (n : ℕ) : ((a ^ n : G) : Q) = a ^ n := rfl
 @[simp, to_additive] lemma coe_zpow (a : G) (n : ℤ) : ((a ^ n : G) : Q) = a ^ n := rfl
 
-/-- A homomorphism `φ : G →* M` from a group to a monoid with `N ⊆ monoid_hom.ker φ` descends
-(i.e. `lift`s) to a homomorphism `G ⧸ N →* M`. -/
-@[to_additive "An addtive monoid homomorphism `φ : G →+ M` from an additive group to an additive
-monoid with `N ⊆ add_monoid_hom.ker φ` descends (i.e. `lift`s) to an additive monoid homomorphism
-`G ⧸ N →+ H`."]
-def lift (φ : G →* M) (HN : N ≤ φ.ker) : Q →* M :=
-(quotient_group.con N).lift φ $ λ x y h, (φ.eq_iff.2 (HN $ left_rel_apply.1 h)).symm
-
-@[simp, to_additive]
-lemma lift_mk {φ : G →* M} (HN : N ≤ φ.ker) (g : G) : lift N φ HN (g : Q) = φ g := rfl
+/-- A group homomorphism `φ : G →* H` with `N ⊆ ker(φ)` descends (i.e. `lift`s) to a
+group homomorphism `G/N →* H`. -/
+@[to_additive "An `add_group` homomorphism `φ : G →+ H` with `N ⊆ ker(φ)` descends (i.e. `lift`s)
+to a group homomorphism `G/N →* H`."]
+def lift (φ : G →* H) (HN : ∀x∈N, φ x = 1) : Q →* H :=
+(quotient_group.con N).lift φ $ λ x y h, begin
+  simp only [quotient_group.con, left_rel_apply, con.rel_mk] at h,
+  calc φ x = φ (y * (x⁻¹ * y)⁻¹) : by rw [mul_inv_rev, inv_inv, mul_inv_cancel_left]
+       ... = φ y                 : by rw [φ.map_mul, HN _ (N.inv_mem h), mul_one]
+  end
 
 @[simp, to_additive]
-lemma lift_mk' {φ : G →* M} (HN : N ≤ φ.ker) (g : G) : lift N φ HN (mk g : Q) = φ g := rfl
-
-@[simp, to_additive] lemma lift_quot_mk {φ : G →* M} (HN : N ≤ φ.ker) (g : G) :
-  lift N φ HN (quot.mk _ g : Q) = φ g :=
-rfl
+lemma lift_mk {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) : lift N φ HN (g : Q) = φ g := rfl
 
 @[simp, to_additive]
-lemma lift_comp_mk {φ : G →* M} (HN : N ≤ φ.ker) : (lift N φ HN).comp (mk' N) = φ :=
-monoid_hom.ext $ λ x, rfl
+lemma lift_mk' {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) : lift N φ HN (mk g : Q) = φ g := rfl
 
 @[simp, to_additive]
-lemma comap_mk'_ker_lift {φ : G →* M} (HN : N ≤ φ.ker) :
-  (lift N φ HN).ker.comap (mk' N) = φ.ker :=
-rfl
-
-@[to_additive] lemma ker_lift_eq {φ : G →* M} (HN : N ≤ φ.ker) :
-  (lift N φ HN).ker = φ.ker.map (mk' N) :=
-subgroup.comap_injective (mk'_surjective N) $
-  by rw [comap_mk'_ker_lift, subgroup.comap_map_eq, ker_mk, sup_of_le_left HN]
-
-@[simp, to_additive] lemma lift_injective_iff {φ : G →* M} (HN : N ≤ φ.ker) :
-  function.injective (lift N φ HN) ↔ N = φ.ker :=
-by simp only [← monoid_hom.ker_eq_bot_iff, ker_lift_eq, subgroup.map_eq_bot_iff, ker_mk,
-  HN.le_iff_eq, eq_comm]
-
-@[simp, to_additive] lemma surjective_lift {φ : G →* M} (HN : N ≤ φ.ker) :
-  function.surjective (lift N φ HN) ↔ function.surjective φ :=
-quot.surjective_lift _
-
-@[simp, to_additive] lemma mrange_lift {φ : G →* M} (HN : N ≤ φ.ker) :
-  (lift N φ HN).mrange = φ.mrange :=
-set_like.ext' $ set.range_quotient_lift_on' _
-
-@[simp, to_additive] lemma range_lift {φ : G →* H} (HN : N ≤ φ.ker) :
-  (lift N φ HN).range = φ.range :=
-set_like.ext' $ set.range_quotient_lift_on' _
+lemma lift_quot_mk {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) :
+  lift N φ HN (quot.mk _ g : Q) = φ g := rfl
 
 /-- A group homomorphism `f : G →* H` induces a map `G/N →* H/M` if `N ⊆ f⁻¹(M)`. -/
-@[to_additive "An `add_group` homomorphism `f : G →+ H` induces a map
-`G/N →+ H/M` if `N ⊆ f⁻¹(M)`."]
+@[to_additive "An `add_group` homomorphism `f : G →+ H` induces a map `G/N →+ H/M` if
+`N ⊆ f⁻¹(M)`."]
 def map (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f) :
   G ⧸ N →* H ⧸ M :=
 quotient_group.lift N ((mk' M).comp f) $ by rwa [← (mk' M).comap_ker, ker_mk]
 
-@[simp, to_additive]
-lemma map_coe (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f) (x : G) :
+@[simp, to_additive] lemma map_coe (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f)
+  (x : G) :
   map N M f h ↑x = ↑(f x) :=
 rfl
 
@@ -271,15 +244,20 @@ open function monoid_hom
 
 /-- The induced map from the quotient by the kernel to the codomain. -/
 @[to_additive "The induced map from the quotient by the kernel to the codomain."]
-def ker_lift : G ⧸ ker φ →* M := lift φ.ker φ le_rfl
+def ker_lift : G ⧸ ker φ →* H :=
+lift _ φ $ λ g, φ.mem_ker.mp
 
-@[simp, to_additive] lemma ker_lift_mk (g : G) : (ker_lift φ) g = φ g := rfl
-@[simp, to_additive] lemma ker_lift_mk' (g : G) : (ker_lift φ) (mk g) = φ g := rfl
+@[simp, to_additive]
+lemma ker_lift_mk (g : G) : (ker_lift φ) g = φ g := lift_mk _ _ _
 
-@[to_additive] lemma ker_lift_injective : injective (ker_lift φ) := (lift_injective_iff _ _).2 rfl
+@[simp, to_additive]
+lemma ker_lift_mk' (g : G) : (ker_lift φ) (mk g) = φ g := lift_mk' _ _ _
 
-@[simp, to_additive] lemma ker_ker_lift : (ker_lift φ).ker = ⊥ :=
-(ker_eq_bot_iff _).2 (ker_lift_injective _)
+@[to_additive]
+lemma ker_lift_injective : injective (ker_lift φ) :=
+assume a b, quotient.induction_on₂' a b $
+  assume a b (h : φ a = φ b), quotient.sound' $
+  by rw [left_rel_apply, mem_ker, φ.map_mul, ← h, φ.map_inv, inv_mul_self]
 
 @[simp, to_additive] lemma ker_lift_surjective : surjective (ker_lift φ) ↔ surjective φ :=
 surjective_lift _ _
@@ -288,50 +266,44 @@ surjective_lift _ _
 
 /-- The induced map from the quotient by the kernel to the range. -/
 @[to_additive "The induced map from the quotient by the kernel to the range."]
-def range_ker_lift : G ⧸ ker ψ →* ψ.range := lift _ ψ.range_restrict ψ.ker_range_restrict.ge
+def range_ker_lift : G ⧸ ker φ →* φ.range :=
+lift _ φ.range_restrict $ λ g hg, (mem_ker _).mp $ by rwa ker_range_restrict
 
-@[to_additive] lemma range_ker_lift_injective : injective (range_ker_lift ψ) :=
-(lift_injective_iff _ _).2 ψ.ker_range_restrict.symm
-
-@[to_additive] lemma range_ker_lift_surjective : surjective (range_ker_lift ψ) :=
-(surjective_lift _ _).2 ψ.range_restrict_surjective
+@[to_additive]
+lemma range_ker_lift_injective : injective (range_ker_lift φ) :=
+assume a b, quotient.induction_on₂' a b $
+  assume a b (h : φ.range_restrict a = φ.range_restrict b), quotient.sound' $
+  by rw [left_rel_apply, ←ker_range_restrict, mem_ker,
+  φ.range_restrict.map_mul, ← h, φ.range_restrict.map_inv, inv_mul_self]
 
-@[to_additive] lemma range_ker_lift_bijective : bijective (range_ker_lift ψ) :=
-⟨range_ker_lift_injective _, range_ker_lift_surjective _⟩
+@[to_additive]
+lemma range_ker_lift_surjective : surjective (range_ker_lift φ) :=
+begin
+  rintro ⟨_, g, rfl⟩,
+  use mk g,
+  refl,
+end
 
 /-- **Noether's first isomorphism theorem** (a definition): the canonical isomorphism between
 `G/(ker φ)` to `range φ`. -/
 @[to_additive "The first isomorphism theorem (a definition): the canonical isomorphism between
 `G/(ker φ)` to `range φ`."]
-noncomputable def quotient_ker_equiv_range : G ⧸ ker ψ ≃* range ψ :=
-mul_equiv.of_bijective (range_ker_lift ψ) (range_ker_lift_bijective ψ)
-
-/-- The canonical isomorphism `G ⧸ N ≃* H`, `N = ker φ`, induced by a homomorphism `φ : G →* H`
-with a right inverse `ψ : H → G`.
-
-This version assumes `N = ker φ` to avoid issues with definitional equalities. -/
-@[to_additive "The canonical isomorphism `G ⧸ N ≃+ H`, `N = ker φ`, induced by a homomorphism
-`φ : G →+ H` with a right inverse `ψ : H → G`.
-
-This version assumes `N = ker φ` to avoid issues with definitional equalities.", simps]
-def quotient_equiv_of_right_inverse (ψ : M → G) (N : subgroup G) [N.normal] (HN : N = ker φ)
-  (hφ : function.right_inverse ψ φ) :
-  G ⧸ N ≃* M :=
-{ to_fun := lift N φ HN.le,
-  inv_fun := mk ∘ ψ,
-  left_inv := λ x, (lift_injective_iff _ _).2 HN (by rw [function.comp_app, lift_mk', hφ]),
-  right_inv := hφ,
-  .. lift N φ HN.le }
+noncomputable def quotient_ker_equiv_range : G ⧸ ker φ ≃* range φ :=
+mul_equiv.of_bijective (range_ker_lift φ) ⟨range_ker_lift_injective φ, range_ker_lift_surjective φ⟩
 
 /-- The canonical isomorphism `G/(ker φ) ≃* H` induced by a homomorphism `φ : G →* H`
 with a right inverse `ψ : H → G`. -/
 @[to_additive "The canonical isomorphism `G/(ker φ) ≃+ H` induced by a homomorphism `φ : G →+ H`
 with a right inverse `ψ : H → G`.", simps]
-def quotient_ker_equiv_of_right_inverse (ψ : M → G) (hφ : function.right_inverse ψ φ) :
-  G ⧸ ker φ ≃* M :=
-quotient_equiv_of_right_inverse φ ψ _ rfl hφ
+def quotient_ker_equiv_of_right_inverse (ψ : H → G) (hφ : function.right_inverse ψ φ) :
+  G ⧸ ker φ ≃* H :=
+{ to_fun := ker_lift φ,
+  inv_fun := mk ∘ ψ,
+  left_inv := λ x, ker_lift_injective φ (by rw [function.comp_app, ker_lift_mk', hφ]),
+  right_inv := hφ,
+  .. ker_lift φ }
 
-/-- The canonical isomorphism `G ⧸ ⊥ ≃* G`. -/
+/-- The canonical isomorphism `G/⊥ ≃* G`. -/
 @[to_additive "The canonical isomorphism `G/⊥ ≃+ G`.", simps]
 def quotient_bot : G ⧸ (⊥ : subgroup G) ≃* G :=
 quotient_equiv_of_right_inverse (monoid_hom.id G) id ⊥ (monoid_hom.ker_id _) (λ x, rfl)
@@ -489,11 +461,7 @@ variables (M : subgroup G) [nM : M.normal]
 include nM nN
 
 @[to_additive] instance map_normal : (M.map (quotient_group.mk' N)).normal :=
-{ conj_mem := begin
-    rintro _ ⟨x, hx, rfl⟩ y,
-    refine induction_on' y (λ y, ⟨y * x * y⁻¹, subgroup.normal.conj_mem nM x hx y, _⟩),
-    simp only [mk'_apply, coe_mul, coe_inv]
-  end }
+nM.map _ mk_surjective
 
 variables (h : N ≤ M)
 
@@ -507,11 +475,13 @@ lift (M.map (mk' N))
   (by { rintro _ ⟨x, hx, rfl⟩, rw map_mk' N M _ _ x,
         exact (quotient_group.eq_one_iff _).mpr hx })
 
-@[simp, to_additive] lemma quotient_quotient_equiv_quotient_aux_coe (x : G ⧸ N) :
+@[simp, to_additive]
+lemma quotient_quotient_equiv_quotient_aux_coe (x : G ⧸ N) :
   quotient_quotient_equiv_quotient_aux N M h x = quotient_group.map N M (monoid_hom.id G) h x :=
 quotient_group.lift_mk' _ _ x
 
-@[to_additive] lemma quotient_quotient_equiv_quotient_aux_coe_coe (x : G) :
+@[to_additive]
+lemma quotient_quotient_equiv_quotient_aux_coe_coe (x : G) :
   quotient_quotient_equiv_quotient_aux N M h (x : G ⧸ N) =
     x :=
 quotient_group.lift_mk' _ _ x
diff --git a/src/group_theory/specific_groups/alternating.lean b/src/group_theory/specific_groups/alternating.lean
index 8e21bef327ee7..70da8978115a6 100644
--- a/src/group_theory/specific_groups/alternating.lean
+++ b/src/group_theory/specific_groups/alternating.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
 
+import algebra.group.conj_finite
 import group_theory.perm.fin
 import tactic.interval_cases
 
diff --git a/src/group_theory/subgroup/basic.lean b/src/group_theory/subgroup/basic.lean
index 55336f4147c51..7c384b97e950f 100644
--- a/src/group_theory/subgroup/basic.lean
+++ b/src/group_theory/subgroup/basic.lean
@@ -2201,6 +2201,9 @@ def eq_locus (f g : G →* M) : subgroup G :=
 { inv_mem' := λ x, eq_on_inv f g,
   .. eq_mlocus f g}
 
+@[simp, to_additive] lemma eq_locus_same (f : G →* N) : f.eq_locus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 /-- If two monoid homomorphisms are equal on a set, then they are equal on its subgroup closure. -/
 @[to_additive "If two monoid homomorphisms are equal on a set, then they are equal on its subgroup
 closure."]
@@ -2265,6 +2268,15 @@ namespace subgroup
 
 variables {N : Type*} [group N] (H : subgroup G)
 
+@[to_additive]
+lemma normal.map {H : subgroup G} (h : H.normal) (f : G →* N) (hf : function.surjective f) :
+  (H.map f).normal :=
+begin
+  rw [← normalizer_eq_top, ← top_le_iff, ← f.range_top_of_surjective hf, f.range_eq_map,
+    ← normalizer_eq_top.2 h],
+  exact le_normalizer_map _
+end
+
 @[to_additive] lemma map_eq_bot_iff {f : G →* N} : H.map f = ⊥ ↔ H ≤ f.ker :=
 (gc_map_comap f).l_eq_bot
 
@@ -2706,6 +2718,10 @@ end ring
 
 end add_subgroup
 
+@[simp, to_additive map_zmultiples] lemma monoid_hom.map_zpowers (f : G →* N) (x : G) :
+  (subgroup.zpowers x).map f = subgroup.zpowers (f x) :=
+by rw [subgroup.zpowers_eq_closure, subgroup.zpowers_eq_closure, f.map_closure, set.image_singleton]
+
 lemma int.mem_zmultiples_iff {a b : ℤ} :
   b ∈ add_subgroup.zmultiples a ↔ a ∣ b :=
 exists_congr (λ k, by rw [mul_comm, eq_comm, ← smul_eq_mul])
diff --git a/src/group_theory/subgroup/pointwise.lean b/src/group_theory/subgroup/pointwise.lean
index 2aa1386de9c90..67d21096238a2 100644
--- a/src/group_theory/subgroup/pointwise.lean
+++ b/src/group_theory/subgroup/pointwise.lean
@@ -244,8 +244,11 @@ lemma mem_smul_pointwise_iff_exists (m : G) (a : α) (S : subgroup G) :
   m ∈ a • S ↔ ∃ (s : G), s ∈ S ∧ a • s = m :=
 (set.mem_smul_set : m ∈ a • (S : set G) ↔ _)
 
-@[simp] lemma smul_bot (a : α) : a • (⊥ : subgroup G) = ⊥ :=
-by simp [set_like.ext_iff, mem_smul_pointwise_iff_exists, eq_comm]
+@[simp] lemma smul_bot (a : α) : a • (⊥ : subgroup G) = ⊥ := map_bot _
+lemma smul_sup (a : α) (S T : subgroup G) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+lemma smul_closure (a : α) (s : set G) : a • closure s = closure (a • s) :=
+monoid_hom.map_closure _ _
 
 instance pointwise_central_scalar [mul_distrib_mul_action αᵐᵒᵖ G] [is_central_scalar α G] :
   is_central_scalar α (subgroup G) :=
diff --git a/src/group_theory/submonoid/basic.lean b/src/group_theory/submonoid/basic.lean
index cf82c99c0e3b7..afde4a523284c 100644
--- a/src/group_theory/submonoid/basic.lean
+++ b/src/group_theory/submonoid/basic.lean
@@ -450,6 +450,9 @@ def eq_mlocus (f g : M →* N) : submonoid M :=
   one_mem' := by rw [set.mem_set_of_eq, f.map_one, g.map_one],
   mul_mem' := λ x y (hx : _ = _) (hy : _ = _), by simp [*] }
 
+@[simp, to_additive] lemma eq_mlocus_same (f : M →* N) : f.eq_mlocus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 /-- If two monoid homomorphisms are equal on a set, then they are equal on its submonoid closure. -/
 @[to_additive "If two monoid homomorphisms are equal on a set, then they are equal on its submonoid
 closure."]
diff --git a/src/group_theory/submonoid/pointwise.lean b/src/group_theory/submonoid/pointwise.lean
index ace8362ffcdae..4c450f7cbe3f1 100644
--- a/src/group_theory/submonoid/pointwise.lean
+++ b/src/group_theory/submonoid/pointwise.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 import group_theory.submonoid.membership
 import order.well_founded_set
 
@@ -197,6 +197,12 @@ lemma mem_smul_pointwise_iff_exists (m : M) (a : α) (S : submonoid M) :
   m ∈ a • S ↔ ∃ (s : M), s ∈ S ∧ a • s = m :=
 (set.mem_smul_set : m ∈ a • (S : set M) ↔ _)
 
+@[simp] lemma smul_bot (a : α) : a • (⊥ : submonoid M) = ⊥ := map_bot _
+lemma smul_sup (a : α) (S T : submonoid M) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+lemma smul_closure (a : α) (s : set M) : a • closure s = closure (a • s) :=
+monoid_hom.map_mclosure _ _
+
 instance pointwise_central_scalar [mul_distrib_mul_action αᵐᵒᵖ M] [is_central_scalar α M] :
   is_central_scalar α (submonoid M) :=
 ⟨λ a S, congr_arg (λ f : monoid.End M, S.map f) $ monoid_hom.ext $ by exact op_smul_eq_smul _⟩
@@ -293,6 +299,16 @@ open_locale pointwise
 lemma smul_mem_pointwise_smul (m : A) (a : α) (S : add_submonoid A) : m ∈ S → a • m ∈ a • S :=
 (set.smul_mem_smul_set : _ → _ ∈ a • (S : set A))
 
+lemma mem_smul_pointwise_iff_exists (m : A) (a : α) (S : add_submonoid A) :
+  m ∈ a • S ↔ ∃ (s : A), s ∈ S ∧ a • s = m :=
+(set.mem_smul_set : m ∈ a • (S : set A) ↔ _)
+
+@[simp] lemma smul_bot (a : α) : a • (⊥ : add_submonoid A) = ⊥ := map_bot _
+lemma smul_sup (a : α) (S T : add_submonoid A) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+@[simp] lemma smul_closure (a : α) (s : set A) : a • closure s = closure (a • s) :=
+add_monoid_hom.map_mclosure _ _
+
 instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ A] [is_central_scalar α A] :
   is_central_scalar α (add_submonoid A) :=
 ⟨λ a S, congr_arg (λ f : add_monoid.End A, S.map f) $
@@ -313,10 +329,6 @@ lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : add_submonoid A} {x : A}
   x ∈ a • S ↔ a⁻¹ • x ∈ S :=
 mem_smul_set_iff_inv_smul_mem
 
-lemma mem_smul_pointwise_iff_exists (m : A) (a : α) (S : add_submonoid A) :
-  m ∈ a • S ↔ ∃ (s : A), s ∈ S ∧ a • s = m :=
-(set.mem_smul_set : m ∈ a • (S : set A) ↔ _)
-
 lemma mem_inv_pointwise_smul_iff {a : α} {S : add_submonoid A} {x : A} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
 mem_inv_smul_set_iff
 
diff --git a/src/linear_algebra/affine_space/affine_subspace.lean b/src/linear_algebra/affine_space/affine_subspace.lean
index 06a6eb7d28834..51a3e02811e32 100644
--- a/src/linear_algebra/affine_space/affine_subspace.lean
+++ b/src/linear_algebra/affine_space/affine_subspace.lean
@@ -743,7 +743,7 @@ instance : nontrivial (affine_subspace k P) := ⟨⟨⊥, ⊤, bot_ne_top k V P
 
 lemma nonempty_of_affine_span_eq_top {s : set P} (h : affine_span k s = ⊤) : s.nonempty :=
 begin
-  rw ← set.ne_empty_iff_nonempty,
+  rw set.nonempty_iff_ne_empty,
   rintros rfl,
   rw affine_subspace.span_empty at h,
   exact bot_ne_top k V P h,
@@ -805,7 +805,7 @@ coe_injective.eq_iff' (bot_coe _ _ _)
 coe_injective.eq_iff' (top_coe _ _ _)
 
 lemma nonempty_iff_ne_bot (Q : affine_subspace k P) : (Q : set P).nonempty ↔ Q ≠ ⊥ :=
-by { rw ← ne_empty_iff_nonempty, exact not_congr Q.coe_eq_bot_iff }
+by { rw nonempty_iff_ne_empty, exact not_congr Q.coe_eq_bot_iff }
 
 lemma eq_bot_or_nonempty (Q : affine_subspace k P) : Q = ⊥ ∨ (Q : set P).nonempty :=
 by { rw nonempty_iff_ne_bot, apply eq_or_ne }
@@ -1128,6 +1128,12 @@ span_points_nonempty k s
 instance {s : set P} [nonempty s] : nonempty (affine_span k s) :=
 ((affine_span_nonempty k s).mpr (nonempty_subtype.mp ‹_›)).to_subtype
 
+/-- The affine span of a set is `⊥` if and only if that set is empty. -/
+@[simp] lemma affine_span_eq_bot {s : set P} :
+  affine_span k s = ⊥ ↔ s = ∅ :=
+by rw [←not_iff_not, ←ne.def, ←ne.def, ←nonempty_iff_ne_bot, affine_span_nonempty,
+       nonempty_iff_ne_empty]
+
 variables {k}
 
 /-- Suppose a set of vectors spans `V`.  Then a point `p`, together
@@ -1632,4 +1638,24 @@ begin
       { simpa using hd.symm } } }
 end
 
+lemma parallel.vector_span_eq {s₁ s₂ : set P} (h : affine_span k s₁ ∥ affine_span k s₂) :
+  vector_span k s₁ = vector_span k s₂ :=
+begin
+  simp_rw ←direction_affine_span,
+  exact h.direction_eq
+end
+
+lemma affine_span_parallel_iff_vector_span_eq_and_eq_empty_iff_eq_empty {s₁ s₂ : set P} :
+  affine_span k s₁ ∥ affine_span k s₂ ↔ vector_span k s₁ = vector_span k s₂ ∧ (s₁ = ∅ ↔ s₂ = ∅) :=
+begin
+  simp_rw [←direction_affine_span, ←affine_span_eq_bot k],
+  exact parallel_iff_direction_eq_and_eq_bot_iff_eq_bot
+end
+
+lemma affine_span_pair_parallel_iff_vector_span_eq {p₁ p₂ p₃ p₄ : P} :
+  line[k, p₁, p₂] ∥ line[k, p₃, p₄] ↔
+    vector_span k ({p₁, p₂} : set P) = vector_span k ({p₃, p₄} : set P) :=
+by simp [affine_span_parallel_iff_vector_span_eq_and_eq_empty_iff_eq_empty,
+         ←not_nonempty_iff_eq_empty]
+
 end affine_subspace
diff --git a/src/linear_algebra/affine_space/combination.lean b/src/linear_algebra/affine_space/combination.lean
index d0b7262a004bb..267ad4f89860c 100644
--- a/src/linear_algebra/affine_space/combination.lean
+++ b/src/linear_algebra/affine_space/combination.lean
@@ -73,6 +73,17 @@ by simp [weighted_vsub_of_point, linear_map.sum_apply]
   s.weighted_vsub_of_point (λ _, p) b w = (∑ i in s, w i) • (p -ᵥ b) :=
 by rw [weighted_vsub_of_point_apply, sum_smul]
 
+/-- `weighted_vsub_of_point` gives equal results for two families of weights and two families of
+points that are equal on `s`. -/
+lemma weighted_vsub_of_point_congr {w₁ w₂ : ι → k} (hw : ∀ i ∈ s, w₁ i = w₂ i) {p₁ p₂ : ι → P}
+  (hp : ∀ i ∈ s, p₁ i = p₂ i) (b : P) :
+  s.weighted_vsub_of_point p₁ b w₁ = s.weighted_vsub_of_point p₂ b w₂ :=
+begin
+  simp_rw weighted_vsub_of_point_apply,
+  convert sum_congr rfl (λ i hi, _),
+  rw [hw i hi, hp i hi]
+end
+
 /-- Given a family of points, if we use a member of the family as a base point, the
 `weighted_vsub_of_point` does not depend on the value of the weights at this point. -/
 lemma weighted_vsub_of_point_eq_of_weights_eq
@@ -212,6 +223,12 @@ begin
   simpa [hw] using hne,
 end
 
+/-- A constant multiplier of the weights in `weighted_vsub_of_point` may be moved outside the
+sum. -/
+lemma weighted_vsub_of_point_const_smul (w : ι → k) (p : ι → P) (b : P) (c : k) :
+  s.weighted_vsub_of_point p b (c • w) = c • s.weighted_vsub_of_point p b w :=
+by simp_rw [weighted_vsub_of_point_apply, smul_sum, pi.smul_apply, smul_smul, smul_eq_mul]
+
 /-- A weighted sum of the results of subtracting a default base point
 from the given points, as a linear map on the weights.  This is
 intended to be used when the sum of the weights is 0; that condition
@@ -246,6 +263,12 @@ by rw [weighted_vsub, weighted_vsub_of_point_apply_const, h, zero_smul]
   (∅ : finset ι).weighted_vsub p w = (0:V) :=
 by simp [weighted_vsub_apply]
 
+/-- `weighted_vsub` gives equal results for two families of weights and two families of points
+that are equal on `s`. -/
+lemma weighted_vsub_congr {w₁ w₂ : ι → k} (hw : ∀ i ∈ s, w₁ i = w₂ i) {p₁ p₂ : ι → P}
+  (hp : ∀ i ∈ s, p₁ i = p₂ i) : s.weighted_vsub p₁ w₁ = s.weighted_vsub p₂ w₂ :=
+s.weighted_vsub_of_point_congr hw hp _
+
 /-- The weighted sum is unaffected by changing the weights to the
 corresponding indicator function and adding points to the set. -/
 lemma weighted_vsub_indicator_subset (w : ι → k) (p : ι → P) {s₁ s₂ : finset ι} (h : s₁ ⊆ s₂) :
@@ -302,6 +325,11 @@ lemma weighted_vsub_filter_of_ne (w : ι → k) (p : ι → P) {pred : ι → Pr
   (s.filter pred).weighted_vsub p w = s.weighted_vsub p w :=
 s.weighted_vsub_of_point_filter_of_ne _ _ _ h
 
+/-- A constant multiplier of the weights in `weighted_vsub_of` may be moved outside the sum. -/
+lemma weighted_vsub_const_smul (w : ι → k) (p : ι → P) (c : k) :
+  s.weighted_vsub p (c • w) = c • s.weighted_vsub p w :=
+s.weighted_vsub_of_point_const_smul _ _ _ _
+
 /-- A weighted sum of the results of subtracting a default base point
 from the given points, added to that base point, as an affine map on
 the weights.  This is intended to be used when the sum of the weights
@@ -337,6 +365,12 @@ rfl
   s.affine_combination (λ _, p) w = p :=
 by rw [affine_combination_apply, s.weighted_vsub_of_point_apply_const, h, one_smul, vsub_vadd]
 
+/-- `affine_combination` gives equal results for two families of weights and two families of
+points that are equal on `s`. -/
+lemma affine_combination_congr {w₁ w₂ : ι → k} (hw : ∀ i ∈ s, w₁ i = w₂ i) {p₁ p₂ : ι → P}
+  (hp : ∀ i ∈ s, p₁ i = p₂ i) : s.affine_combination p₁ w₁ = s.affine_combination p₂ w₂ :=
+by simp_rw [affine_combination_apply, s.weighted_vsub_of_point_congr hw hp]
+
 /-- `affine_combination` gives the sum with any base point, when the
 sum of the weights is 1. -/
 lemma affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one (w : ι → k) (p : ι → P)
@@ -564,6 +598,120 @@ begin
     linear_map.map_smulₛₗ, affine_map.linear_map_vsub, linear_map.map_sum],
 end
 
+variables (k)
+
+omit S
+
+/-- Weights for expressing a single point as an affine combination. -/
+def affine_combination_single_weights [decidable_eq ι] (i : ι) : ι → k :=
+function.update (function.const ι 0) i 1
+
+@[simp] lemma affine_combination_single_weights_apply_self [decidable_eq ι] (i : ι) :
+  affine_combination_single_weights k i i = 1 :=
+by simp [affine_combination_single_weights]
+
+@[simp] lemma affine_combination_single_weights_apply_of_ne [decidable_eq ι] {i j : ι} (h : j ≠ i) :
+  affine_combination_single_weights k i j = 0 :=
+by simp [affine_combination_single_weights, h]
+
+@[simp] lemma sum_affine_combination_single_weights [decidable_eq ι] {i : ι} (h : i ∈ s) :
+  ∑ j in s, affine_combination_single_weights k i j = 1 :=
+begin
+  rw ←affine_combination_single_weights_apply_self k i,
+  exact sum_eq_single_of_mem i h (λ j _ hj, affine_combination_single_weights_apply_of_ne k hj)
+end
+
+/-- Weights for expressing the subtraction of two points as a `weighted_vsub`. -/
+def weighted_vsub_vsub_weights [decidable_eq ι] (i j : ι) : ι → k :=
+affine_combination_single_weights k i - affine_combination_single_weights k j
+
+@[simp] lemma weighted_vsub_vsub_weights_self [decidable_eq ι] (i : ι) :
+  weighted_vsub_vsub_weights k i i = 0 :=
+by simp [weighted_vsub_vsub_weights]
+
+@[simp] lemma weighted_vsub_vsub_weights_apply_left [decidable_eq ι] {i j : ι} (h : i ≠ j) :
+  weighted_vsub_vsub_weights k i j i = 1 :=
+by simp [weighted_vsub_vsub_weights, h]
+
+@[simp] lemma weighted_vsub_vsub_weights_apply_right [decidable_eq ι] {i j : ι} (h : i ≠ j) :
+  weighted_vsub_vsub_weights k i j j = -1 :=
+by simp [weighted_vsub_vsub_weights, h.symm]
+
+@[simp] lemma weighted_vsub_vsub_weights_apply_of_ne [decidable_eq ι] {i j t : ι} (hi : t ≠ i)
+  (hj : t ≠ j) : weighted_vsub_vsub_weights k i j t = 0 :=
+by simp [weighted_vsub_vsub_weights, hi, hj]
+
+@[simp] lemma sum_weighted_vsub_vsub_weights [decidable_eq ι] {i j : ι} (hi : i ∈ s) (hj : j ∈ s) :
+  ∑ t in s, weighted_vsub_vsub_weights k i j t = 0 :=
+begin
+  simp_rw [weighted_vsub_vsub_weights, pi.sub_apply, sum_sub_distrib],
+  simp [hi, hj]
+end
+
+variables {k}
+
+/-- Weights for expressing `line_map` as an affine combination. -/
+def affine_combination_line_map_weights [decidable_eq ι] (i j : ι) (c : k) : ι → k :=
+c • weighted_vsub_vsub_weights k j i + affine_combination_single_weights k i
+
+@[simp] lemma affine_combination_line_map_weights_self [decidable_eq ι] (i : ι) (c : k) :
+  affine_combination_line_map_weights i i c = affine_combination_single_weights k i :=
+by simp [affine_combination_line_map_weights]
+
+@[simp] lemma affine_combination_line_map_weights_apply_left [decidable_eq ι] {i j : ι}
+  (h : i ≠ j) (c : k) : affine_combination_line_map_weights i j c i = 1 - c :=
+by simp [affine_combination_line_map_weights, h.symm, sub_eq_neg_add]
+
+@[simp] lemma affine_combination_line_map_weights_apply_right [decidable_eq ι] {i j : ι}
+  (h : i ≠ j) (c : k) : affine_combination_line_map_weights i j c j = c :=
+by simp [affine_combination_line_map_weights, h.symm]
+
+@[simp] lemma affine_combination_line_map_weights_apply_of_ne [decidable_eq ι] {i j t : ι}
+  (hi : t ≠ i) (hj : t ≠ j) (c : k) : affine_combination_line_map_weights i j c t = 0 :=
+by simp [affine_combination_line_map_weights, hi, hj]
+
+@[simp] lemma sum_affine_combination_line_map_weights [decidable_eq ι] {i j : ι} (hi : i ∈ s)
+  (hj : j ∈ s) (c : k) : ∑ t in s, affine_combination_line_map_weights i j c t = 1 :=
+begin
+  simp_rw [affine_combination_line_map_weights, pi.add_apply, sum_add_distrib],
+  simp [hi, hj, ←mul_sum]
+end
+
+include S
+
+variables (k)
+
+/-- An affine combination with `affine_combination_single_weights` gives the specified point. -/
+@[simp] lemma affine_combination_affine_combination_single_weights [decidable_eq ι] (p : ι → P)
+  {i : ι} (hi : i ∈ s) : s.affine_combination p (affine_combination_single_weights k i) = p i :=
+begin
+  refine s.affine_combination_of_eq_one_of_eq_zero _ _ hi (by simp) _,
+  rintro j - hj,
+  simp [hj]
+end
+
+/-- A weighted subtraction with `weighted_vsub_vsub_weights` gives the result of subtracting the
+specified points. -/
+@[simp] lemma weighted_vsub_weighted_vsub_vsub_weights [decidable_eq ι] (p : ι → P) {i j : ι}
+  (hi : i ∈ s) (hj : j ∈ s) : s.weighted_vsub p (weighted_vsub_vsub_weights k i j) = p i -ᵥ p j :=
+begin
+  rw [weighted_vsub_vsub_weights, ←affine_combination_vsub,
+      s.affine_combination_affine_combination_single_weights k p hi,
+      s.affine_combination_affine_combination_single_weights k p hj]
+end
+
+variables {k}
+
+/-- An affine combination with `affine_combination_line_map_weights` gives the result of
+`line_map`. -/
+@[simp] lemma affine_combination_affine_combination_line_map_weights [decidable_eq ι] (p : ι → P)
+  {i j : ι} (hi : i ∈ s) (hj : j ∈ s) (c : k) :
+  s.affine_combination p (affine_combination_line_map_weights i j c) =
+    affine_map.line_map (p i) (p j) c :=
+by rw [affine_combination_line_map_weights, ←weighted_vsub_vadd_affine_combination,
+       weighted_vsub_const_smul, s.affine_combination_affine_combination_single_weights k p hi,
+       s.weighted_vsub_weighted_vsub_vsub_weights k p hj hi, affine_map.line_map_apply]
+
 end finset
 
 namespace finset
diff --git a/src/linear_algebra/affine_space/finite_dimensional.lean b/src/linear_algebra/affine_space/finite_dimensional.lean
index 265f5e6872387..ca021cbd7b0e0 100644
--- a/src/linear_algebra/affine_space/finite_dimensional.lean
+++ b/src/linear_algebra/affine_space/finite_dimensional.lean
@@ -443,6 +443,33 @@ lemma collinear_iff_not_affine_independent {p : fin 3 → P} :
 by rw [collinear_iff_finrank_le_one,
        finrank_vector_span_le_iff_not_affine_independent k p (fintype.card_fin 3)]
 
+/-- Three points are affinely independent if and only if they are not collinear. -/
+lemma affine_independent_iff_not_collinear_set {p₁ p₂ p₃ : P} :
+  affine_independent k ![p₁, p₂, p₃] ↔ ¬collinear k ({p₁, p₂, p₃} : set P) :=
+by simp [affine_independent_iff_not_collinear, -set.union_singleton]
+
+/-- Three points are collinear if and only if they are not affinely independent. -/
+lemma collinear_iff_not_affine_independent_set {p₁ p₂ p₃ : P} :
+  collinear k ({p₁, p₂, p₃} : set P) ↔ ¬affine_independent k ![p₁, p₂, p₃] :=
+affine_independent_iff_not_collinear_set.not_left.symm
+
+/-- Three points are affinely independent if and only if they are not collinear. -/
+lemma affine_independent_iff_not_collinear_of_ne {p : fin 3 → P} {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂)
+  (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
+  affine_independent k p ↔ ¬collinear k ({p i₁, p i₂, p i₃} : set P) :=
+begin
+  have hu : (finset.univ : finset (fin 3)) = {i₁, i₂, i₃}, by dec_trivial!,
+  rw [affine_independent_iff_not_collinear, ←set.image_univ, ←finset.coe_univ, hu,
+      finset.coe_insert, finset.coe_insert, finset.coe_singleton, set.image_insert_eq,
+      set.image_pair]
+end
+
+/-- Three points are collinear if and only if they are not affinely independent. -/
+lemma collinear_iff_not_affine_independent_of_ne {p : fin 3 → P} {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂)
+  (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
+  collinear k ({p i₁, p i₂, p i₃} : set P) ↔ ¬affine_independent k p:=
+(affine_independent_iff_not_collinear_of_ne h₁₂ h₁₃ h₂₃).not_left.symm
+
 /-- If three points are not collinear, the first and second are different. -/
 lemma ne₁₂_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear k ({p₁, p₂, p₃} : set P)) : p₁ ≠ p₂ :=
 by { rintro rfl, simpa [collinear_pair] using h }
@@ -500,6 +527,56 @@ lemma collinear_insert_iff_of_mem_affine_span {s : set P} {p : P} (h : p ∈ aff
   collinear k (insert p s) ↔ collinear k s :=
 by rw [collinear, collinear, vector_span_insert_eq_vector_span h]
 
+/-- If a point lies in the affine span of two points, those three points are collinear. -/
+lemma collinear_insert_of_mem_affine_span_pair {p₁ p₂ p₃ : P} (h : p₁ ∈ line[k, p₂, p₃]) :
+  collinear k ({p₁, p₂, p₃} : set P) :=
+begin
+  rw collinear_insert_iff_of_mem_affine_span h,
+  exact collinear_pair _ _ _
+end
+
+/-- If two points lie in the affine span of two points, those four points are collinear. -/
+lemma collinear_insert_insert_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ : P}
+  (h₁ : p₁ ∈ line[k, p₃, p₄]) (h₂ : p₂ ∈ line[k, p₃, p₄]) :
+  collinear k ({p₁, p₂, p₃, p₄} : set P) :=
+begin
+  rw [collinear_insert_iff_of_mem_affine_span ((affine_subspace.le_def' _ _).1
+        (affine_span_mono k (set.subset_insert _ _)) _ h₁),
+      collinear_insert_iff_of_mem_affine_span h₂],
+  exact collinear_pair _ _ _
+end
+
+/-- If three points lie in the affine span of two points, those five points are collinear. -/
+lemma collinear_insert_insert_insert_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ p₅ : P}
+  (h₁ : p₁ ∈ line[k, p₄, p₅]) (h₂ : p₂ ∈ line[k, p₄, p₅]) (h₃ : p₃ ∈ line[k, p₄, p₅]) :
+  collinear k ({p₁, p₂, p₃, p₄, p₅} : set P) :=
+begin
+  rw [collinear_insert_iff_of_mem_affine_span ((affine_subspace.le_def' _ _).1
+        (affine_span_mono k ((set.subset_insert _ _).trans (set.subset_insert _ _))) _ h₁),
+      collinear_insert_iff_of_mem_affine_span ((affine_subspace.le_def' _ _).1
+        (affine_span_mono k (set.subset_insert _ _)) _ h₂),
+      collinear_insert_iff_of_mem_affine_span h₃],
+  exact collinear_pair _ _ _
+end
+
+/-- If three points lie in the affine span of two points, the first four points are collinear. -/
+lemma collinear_insert_insert_insert_left_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ p₅ : P}
+  (h₁ : p₁ ∈ line[k, p₄, p₅]) (h₂ : p₂ ∈ line[k, p₄, p₅]) (h₃ : p₃ ∈ line[k, p₄, p₅]) :
+  collinear k ({p₁, p₂, p₃, p₄} : set P) :=
+begin
+  refine (collinear_insert_insert_insert_of_mem_affine_span_pair h₁ h₂ h₃).subset _,
+  simp [set.insert_subset_insert]
+end
+
+/-- If three points lie in the affine span of two points, the first three points are collinear. -/
+lemma collinear_triple_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ p₅ : P}
+  (h₁ : p₁ ∈ line[k, p₄, p₅]) (h₂ : p₂ ∈ line[k, p₄, p₅]) (h₃ : p₃ ∈ line[k, p₄, p₅]) :
+  collinear k ({p₁, p₂, p₃} : set P) :=
+begin
+  refine (collinear_insert_insert_insert_left_of_mem_affine_span_pair h₁ h₂ h₃).subset _,
+  simp [set.insert_subset_insert]
+end
+
 variables (k)
 
 /-- A set of points is coplanar if their `vector_span` has dimension at most `2`. -/
diff --git a/src/linear_algebra/affine_space/independent.lean b/src/linear_algebra/affine_space/independent.lean
index fa328b91b4a9f..4d42768003044 100644
--- a/src/linear_algebra/affine_space/independent.lean
+++ b/src/linear_algebra/affine_space/independent.lean
@@ -414,15 +414,12 @@ end
 by disjoint subsets of the index type are disjoint, if the underlying
 ring is nontrivial. -/
 lemma affine_independent.affine_span_disjoint_of_disjoint [nontrivial k] {p : ι → P}
-    (ha : affine_independent k p) {s1 s2 : set ι} (hd : s1 ∩ s2 = ∅) :
-  (affine_span k (p '' s1) : set P) ∩ affine_span k (p '' s2) = ∅ :=
+    (ha : affine_independent k p) {s1 s2 : set ι} (hd : disjoint s1 s2) :
+  disjoint (affine_span k (p '' s1) : set P) (affine_span k (p '' s2)) :=
 begin
-  by_contradiction hne,
-  change (affine_span k (p '' s1) : set P) ∩ affine_span k (p '' s2) ≠ ∅ at hne,
-  rw set.ne_empty_iff_nonempty at hne,
-  rcases hne with ⟨p0, hp0s1, hp0s2⟩,
+  refine set.disjoint_left.2 (λ p0 hp0s1 hp0s2, _),
   cases ha.exists_mem_inter_of_exists_mem_inter_affine_span hp0s1 hp0s2 with i hi,
-  exact set.not_mem_empty i (hd ▸ hi)
+  exact set.disjoint_iff.1 hd hi,
 end
 
 /-- If a family is affinely independent, a point in the family is in
@@ -734,6 +731,37 @@ by { ext, simp [face_points] }
   {m : ℕ} (h : fs.card = m + 1) : set.range (s.face h).points = s.points '' ↑fs :=
 by rw [face_points', set.range_comp, finset.range_order_emb_of_fin]
 
+/-- Remap a simplex along an `equiv` of index types. -/
+@[simps]
+def reindex {m n : ℕ} (s : simplex k P m) (e : fin (m + 1) ≃ fin (n + 1)) : simplex k P n :=
+⟨s.points ∘ e.symm, (affine_independent_equiv e.symm).2 s.independent⟩
+
+/-- Reindexing by `equiv.refl` yields the original simplex. -/
+@[simp] lemma reindex_refl {n : ℕ} (s : simplex k P n) :
+  s.reindex (equiv.refl (fin (n + 1))) = s :=
+ext $ λ _, rfl
+
+/-- Reindexing by the composition of two equivalences is the same as reindexing twice. -/
+@[simp] lemma reindex_trans {n₁ n₂ n₃ : ℕ} (e₁₂ : fin (n₁ + 1) ≃ fin (n₂ + 1))
+  (e₂₃ : fin (n₂ + 1) ≃ fin (n₃ + 1)) (s : simplex k P n₁) :
+  s.reindex (e₁₂.trans e₂₃) = (s.reindex e₁₂).reindex e₂₃ :=
+rfl
+
+/-- Reindexing by an equivalence and its inverse yields the original simplex. -/
+@[simp] lemma reindex_reindex_symm {m n : ℕ} (s : simplex k P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  (s.reindex e).reindex e.symm = s :=
+by rw [←reindex_trans, equiv.self_trans_symm, reindex_refl]
+
+/-- Reindexing by the inverse of an equivalence and that equivalence yields the original simplex. -/
+@[simp] lemma reindex_symm_reindex {m n : ℕ} (s : simplex k P m) (e : fin (n + 1) ≃ fin (m + 1)) :
+  (s.reindex e.symm).reindex e = s :=
+by rw [←reindex_trans, equiv.symm_trans_self, reindex_refl]
+
+/-- Reindexing a simplex produces one with the same set of points. -/
+@[simp] lemma reindex_range_points {m n : ℕ} (s : simplex k P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  set.range (s.reindex e).points = set.range s.points :=
+by rw [reindex, set.range_comp, equiv.range_eq_univ, set.image_univ]
+
 end simplex
 
 end affine
diff --git a/src/linear_algebra/alternating.lean b/src/linear_algebra/alternating.lean
index 0f12269e01963..ef26176f204d0 100644
--- a/src/linear_algebra/alternating.lean
+++ b/src/linear_algebra/alternating.lean
@@ -903,17 +903,10 @@ begin
     rw quotient_group.eq' },
 
   -- eliminate a multiplication
-  have : @finset.univ (perm (ιa ⊕ ιb)) _ = finset.univ.image ((*) σ) :=
-    (finset.eq_univ_iff_forall.mpr $ λ a, let ⟨a', ha'⟩ := mul_left_surjective σ a in
-      finset.mem_image.mpr ⟨a', finset.mem_univ _, ha'⟩).symm,
-  rw [this, finset.image_filter],
-  simp only [function.comp, mul_inv_rev, inv_mul_cancel_right, subgroup.inv_mem_iff],
-  simp only [monoid_hom.mem_range], -- needs to be separate from the above `simp only`
-  rw [finset.filter_congr_decidable,
-    finset.univ_filter_exists (perm.sum_congr_hom ιa ιb),
-    finset.sum_image (λ x _ y _ (h : _ = _), mul_right_injective _ h),
-    finset.sum_image (λ x _ y _ (h : _ = _), perm.sum_congr_hom_injective h)],
-  dsimp only,
+  rw [← finset.map_univ_equiv (equiv.mul_left σ), finset.filter_map, finset.sum_map],
+  simp_rw [equiv.coe_to_embedding, equiv.coe_mul_left, (∘), mul_inv_rev, inv_mul_cancel_right,
+    subgroup.inv_mem_iff, monoid_hom.mem_range, finset.univ_filter_exists,
+    finset.sum_image (perm.sum_congr_hom_injective.inj_on _)],
 
   -- now we're ready to clean up the RHS, pulling out the summation
   rw [dom_coprod.summand_mk', multilinear_map.dom_coprod_alternization_coe,
diff --git a/src/linear_algebra/basic.lean b/src/linear_algebra/basic.lean
index b69d6ba461d4e..e8a0ed922c08a 100644
--- a/src/linear_algebra/basic.lean
+++ b/src/linear_algebra/basic.lean
@@ -1029,6 +1029,23 @@ begin
   rw [range_comp, submodule.map_neg, submodule.map_id],
 end
 
+/-- A linear map version of `add_monoid_hom.eq_locus` -/
+def eq_locus (f g : M →ₛₗ[τ₁₂] M₂) : submodule R M :=
+{ carrier := {x | f x = g x},
+  smul_mem' := λ r x (hx : _ = _), show _ = _,
+    by simpa only [linear_map.map_smulₛₗ] using congr_arg ((•) (τ₁₂ r)) hx,
+  .. f.to_add_monoid_hom.eq_mlocus g.to_add_monoid_hom }
+
+@[simp] lemma mem_eq_locus {x : M} {f g : M →ₛₗ[τ₁₂] M₂} : x ∈ f.eq_locus g ↔ f x = g x :=
+iff.rfl
+
+lemma eq_locus_to_add_submonoid (f g : M →ₛₗ[τ₁₂] M₂) :
+  (f.eq_locus g).to_add_submonoid = (f : M →+ M₂).eq_mlocus g :=
+rfl
+
+@[simp] lemma eq_locus_same (f : M →ₛₗ[τ₁₂] M₂) : f.eq_locus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 end
 
 /--
@@ -1207,6 +1224,9 @@ lemma range_to_add_subgroup [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ
 lemma ker_to_add_subgroup (f : M →ₛₗ[τ₁₂] M₂) :
   f.ker.to_add_subgroup = f.to_add_monoid_hom.ker := rfl
 
+lemma eq_locus_eq_ker_sub (f g : M →ₛₗ[τ₁₂] M₂) : f.eq_locus g = (f - g).ker :=
+set_like.ext $ λ v, sub_eq_zero.symm
+
 include sc
 theorem sub_mem_ker_iff {x y} : x - y ∈ ker f ↔ f x = f y :=
 by rw [mem_ker, map_sub, sub_eq_zero]
diff --git a/src/linear_algebra/dimension.lean b/src/linear_algebra/dimension.lean
index dd4bbc7f1eb90..072c7e7f8a19e 100644
--- a/src/linear_algebra/dimension.lean
+++ b/src/linear_algebra/dimension.lean
@@ -272,8 +272,8 @@ begin
   apply cardinal.mk_emptyc_iff.mpr,
   simp only [subtype.coe_mk],
   by_contradiction h,
-  have ne : s.nonempty := ne_empty_iff_nonempty.mp h,
-  simpa using linear_independent.ne_zero (⟨_, ne.some_mem⟩ : s) li,
+  obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 h,
+  simpa using linear_independent.ne_zero (⟨a, ha⟩ : s) li,
 end
 
 @[simp] lemma dim_bot : module.rank R (⊥ : submodule R M) = 0 :=
@@ -469,7 +469,7 @@ begin
   { contrapose! h,
     obtain ⟨x, hx⟩ := h,
     suffices : 1 ≤ module.rank R M,
-    { intro h, exact lt_irrefl _ (lt_of_lt_of_le cardinal.zero_lt_one (h ▸ this)) },
+    { intro h, exact this.not_lt (h.symm ▸ zero_lt_one) },
     suffices : linear_independent R (λ (y : ({x} : set M)), ↑y),
     { simpa using (cardinal_le_dim_of_linear_independent this), },
     exact linear_independent_singleton hx },
diff --git a/src/linear_algebra/finite_dimensional.lean b/src/linear_algebra/finite_dimensional.lean
index ecafdced9e372..ba8e2b2484ea0 100644
--- a/src/linear_algebra/finite_dimensional.lean
+++ b/src/linear_algebra/finite_dimensional.lean
@@ -859,11 +859,8 @@ end
 /-- Given the subspaces `p q`, if `p.quotient ≃ₗ[K] q`, then `q.quotient ≃ₗ[K] p` -/
 noncomputable def linear_equiv.quot_equiv_of_quot_equiv
   {p q : subspace K V} (f : (V ⧸ p) ≃ₗ[K] q) : (V ⧸ q) ≃ₗ[K] p :=
-linear_equiv.of_finrank_eq _ _
-begin
-  rw [← @add_right_cancel_iff _ _ (finrank K q), submodule.finrank_quotient_add_finrank,
-      ← linear_equiv.finrank_eq f, add_comm, submodule.finrank_quotient_add_finrank]
-end
+linear_equiv.of_finrank_eq _ _ $ add_right_cancel $ by rw [submodule.finrank_quotient_add_finrank,
+  ← linear_equiv.finrank_eq f, add_comm, submodule.finrank_quotient_add_finrank]
 
 end division_ring
 
diff --git a/src/linear_algebra/prod.lean b/src/linear_algebra/prod.lean
index 0b9ef8a03176b..98b279f10df23 100644
--- a/src/linear_algebra/prod.lean
+++ b/src/linear_algebra/prod.lean
@@ -5,7 +5,7 @@ Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov, Eric W
 -/
 import linear_algebra.span
 import order.partial_sups
-import algebra.algebra.basic
+import algebra.algebra.prod
 
 /-! ### Products of modules
 
diff --git a/src/linear_algebra/quotient.lean b/src/linear_algebra/quotient.lean
index 514cef1e60686..2e91ca51d780d 100644
--- a/src/linear_algebra/quotient.lean
+++ b/src/linear_algebra/quotient.lean
@@ -62,7 +62,7 @@ instance : inhabited (M ⧸ p) := ⟨0⟩
 by simpa using (quotient.eq p : mk x = 0 ↔ _)
 
 instance add_comm_group : add_comm_group (M ⧸ p) :=
-quotient_add_group.add_comm_group p.to_add_subgroup
+quotient_add_group.quotient.add_comm_group p.to_add_subgroup
 
 @[simp] theorem mk_add : (mk (x + y) : M ⧸ p) = mk x + mk y := rfl
 
diff --git a/src/linear_algebra/ray.lean b/src/linear_algebra/ray.lean
index 213c4b96e97bb..9d9a2801a262f 100644
--- a/src/linear_algebra/ray.lean
+++ b/src/linear_algebra/ray.lean
@@ -330,7 +330,7 @@ lemma eq_zero_of_same_ray_self_neg [no_zero_smul_divisors R M] (h : same_ray R x
   x = 0 :=
 begin
   nontriviality M, haveI : nontrivial R := module.nontrivial R M,
-  refine eq_zero_of_same_ray_neg_smul_right (neg_lt_zero.2 (@one_pos R _ _)) _,
+  refine eq_zero_of_same_ray_neg_smul_right (neg_lt_zero.2 (zero_lt_one' R)) _,
   rwa [neg_one_smul]
 end
 
diff --git a/src/logic/basic.lean b/src/logic/basic.lean
index e9b75d9e89489..1501e9822e37c 100644
--- a/src/logic/basic.lean
+++ b/src/logic/basic.lean
@@ -801,9 +801,7 @@ not_and.trans imp_not_comm
 
 /-- One of de Morgan's laws: the negation of a disjunction is logically equivalent to the
 conjunction of the negations. -/
-theorem not_or_distrib : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b :=
-⟨λ h, ⟨λ ha, h (or.inl ha), λ hb, h (or.inr hb)⟩,
- λ ⟨h₁, h₂⟩ h, or.elim h h₁ h₂⟩
+theorem not_or_distrib : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b := or_imp_distrib
 
 -- See Note [decidable namespace]
 protected theorem decidable.or_iff_not_and_not [decidable a] [decidable b] : a ∨ b ↔ ¬ (¬a ∧ ¬b) :=
diff --git a/src/logic/embedding/set.lean b/src/logic/embedding/set.lean
index 92c99975923c5..d7948726f6cac 100644
--- a/src/logic/embedding/set.lean
+++ b/src/logic/embedding/set.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro
 -/
 import logic.embedding.basic
-import data.set.basic
+import data.set.image
 
 /-!
 # Interactions between embeddings and sets.
diff --git a/src/measure_theory/constructions/polish.lean b/src/measure_theory/constructions/polish.lean
index 94562f03a2885..def85aa002d32 100644
--- a/src/measure_theory/constructions/polish.lean
+++ b/src/measure_theory/constructions/polish.lean
@@ -510,7 +510,7 @@ begin
     choose s hs hxs using C1,
     have C2 : ∀ n, (s n).1.nonempty,
     { assume n,
-      rw ← ne_empty_iff_nonempty,
+      rw nonempty_iff_ne_empty,
       assume hn,
       have := (s n).2,
       rw hn at this,
diff --git a/src/measure_theory/constructions/prod.lean b/src/measure_theory/constructions/prod.lean
index 6bb0900ec5f03..d34a2ec880184 100644
--- a/src/measure_theory/constructions/prod.lean
+++ b/src/measure_theory/constructions/prod.lean
@@ -286,7 +286,7 @@ begin
       { refine eventually_of_forall (λ y, simple_func.tendsto_approx_on _ _ _),
         apply subset_closure,
         simp [-uncurry_apply_pair], } },
-    { simpa [f', hfx, integral_undef] using @tendsto_const_nhds _ _ _ (0 : E) _, } },
+    { simp [f', hfx, integral_undef], } },
   exact strongly_measurable_of_tendsto _ hf' h2f'
 end
 
diff --git a/src/measure_theory/covering/vitali.lean b/src/measure_theory/covering/vitali.lean
index c8ca760e001c4..11e767bed8b25 100644
--- a/src/measure_theory/covering/vitali.lean
+++ b/src/measure_theory/covering/vitali.lean
@@ -284,7 +284,7 @@ begin
     { have R0pos : 0 < R0 := (hR0 x).trans_le H,
       have vnonempty : v.nonempty,
       { by_contra,
-        rw [← ne_empty_iff_nonempty, not_not] at h,
+        rw [nonempty_iff_ne_empty, not_not] at h,
         simp only [h, real.Sup_empty, image_empty] at R0_def,
         exact lt_irrefl _ (R0pos.trans_le (le_of_eq R0_def)) },
       obtain ⟨a, hav, R0a⟩ : ∃ a ∈ v, R0/2 < r a,
diff --git a/src/measure_theory/function/convergence_in_measure.lean b/src/measure_theory/function/convergence_in_measure.lean
index 403082e262ea7..e921708ec31e5 100644
--- a/src/measure_theory/function/convergence_in_measure.lean
+++ b/src/measure_theory/function/convergence_in_measure.lean
@@ -224,7 +224,7 @@ begin
     refine ⟨max N (k - 1), λ n hn_ge, lt_of_le_of_lt _ hk_lt_ε⟩,
     specialize hNx n ((le_max_left _ _).trans hn_ge),
     have h_inv_n_le_k : (2 : ℝ)⁻¹ ^ n ≤ 2 * 2⁻¹ ^ k,
-    { rw [mul_comm, ← inv_mul_le_iff' (@two_pos ℝ _ _)],
+    { rw [mul_comm, ← inv_mul_le_iff' (zero_lt_two' ℝ)],
       conv_lhs { congr, rw ← pow_one (2 : ℝ)⁻¹ },
       rw [← pow_add, add_comm],
       exact pow_le_pow_of_le_one ((one_div (2 : ℝ)) ▸ one_half_pos.le) (inv_le_one one_le_two)
diff --git a/src/measure_theory/function/l2_space.lean b/src/measure_theory/function/l2_space.lean
index 3341afa2b63e5..f865a5f5c37e5 100644
--- a/src/measure_theory/function/l2_space.lean
+++ b/src/measure_theory/function/l2_space.lean
@@ -78,7 +78,7 @@ begin
     rw [is_R_or_C.abs_to_real, abs_eq_self.mpr],
     swap, { exact add_nonneg (by simp) (by simp), },
     refine le_trans _ (half_le_self (add_nonneg (sq_nonneg _) (sq_nonneg _))),
-    refine (le_div_iff (@zero_lt_two ℝ _ _)).mpr ((le_of_eq _).trans (two_mul_le_add_sq _ _)),
+    refine (le_div_iff (zero_lt_two' ℝ)).mpr ((le_of_eq _).trans (two_mul_le_add_sq _ _)),
     ring, },
   simp_rw [← is_R_or_C.norm_eq_abs, ← real.rpow_nat_cast] at h',
   refine (snorm_mono_ae (ae_of_all _ h')).trans_lt ((snorm_add_le _ _ le_rfl).trans_lt _),
diff --git a/src/measure_theory/function/locally_integrable.lean b/src/measure_theory/function/locally_integrable.lean
index 6655bcf24e5ea..2deb71c44f857 100644
--- a/src/measure_theory/function/locally_integrable.lean
+++ b/src/measure_theory/function/locally_integrable.lean
@@ -23,7 +23,7 @@ on compact sets.
 open measure_theory measure_theory.measure set function topological_space
 open_locale topological_space interval
 
-variables {X Y E : Type*} [measurable_space X] [topological_space X]
+variables {X Y E R : Type*} [measurable_space X] [topological_space X]
 variables [measurable_space Y] [topological_space Y]
 variables [normed_add_comm_group E] {f : X → E} {μ : measure X}
 
@@ -78,8 +78,10 @@ begin
     exact h this }
 end
 
-section real
-variables [opens_measurable_space X] {A K : set X} {g g' : X → ℝ}
+section mul
+
+variables [opens_measurable_space X] [normed_ring R] [second_countable_topology_either X R]
+  {A K : set X} {g g' : X → R}
 
 lemma integrable_on.mul_continuous_on_of_subset
   (hg : integrable_on g A μ) (hg' : continuous_on g' K)
@@ -90,10 +92,11 @@ begin
   rw [integrable_on, ← mem_ℒp_one_iff_integrable] at hg ⊢,
   have : ∀ᵐ x ∂(μ.restrict A), ‖g x * g' x‖ ≤ C * ‖g x‖,
   { filter_upwards [ae_restrict_mem hA] with x hx,
-    rw [real.norm_eq_abs, abs_mul, mul_comm, real.norm_eq_abs],
-    apply mul_le_mul_of_nonneg_right (hC x (hAK hx)) (abs_nonneg _), },
-  exact mem_ℒp.of_le_mul hg (hg.ae_strongly_measurable.ae_measurable.mul
-    ((hg'.mono hAK).ae_measurable hA)).ae_strongly_measurable this,
+    refine (norm_mul_le _ _).trans _,
+    rw mul_comm,
+    apply mul_le_mul_of_nonneg_right (hC x (hAK hx)) (norm_nonneg _), },
+  exact mem_ℒp.of_le_mul hg (hg.ae_strongly_measurable.mul $
+    (hg'.mono hAK).ae_strongly_measurable hA) this,
 end
 
 lemma integrable_on.mul_continuous_on [t2_space X]
@@ -105,14 +108,23 @@ lemma integrable_on.continuous_on_mul_of_subset
   (hg : continuous_on g K) (hg' : integrable_on g' A μ)
   (hK : is_compact K) (hA : measurable_set A) (hAK : A ⊆ K) :
   integrable_on (λ x, g x * g' x) A μ :=
-by simpa [mul_comm] using hg'.mul_continuous_on_of_subset hg hA hK hAK
+begin
+  rcases is_compact.exists_bound_of_continuous_on hK hg with ⟨C, hC⟩,
+  rw [integrable_on, ← mem_ℒp_one_iff_integrable] at hg' ⊢,
+  have : ∀ᵐ x ∂(μ.restrict A), ‖g x * g' x‖ ≤ C * ‖g' x‖,
+  { filter_upwards [ae_restrict_mem hA] with x hx,
+    refine (norm_mul_le _ _).trans _,
+    apply mul_le_mul_of_nonneg_right (hC x (hAK hx)) (norm_nonneg _), },
+  exact mem_ℒp.of_le_mul hg' (((hg.mono hAK).ae_strongly_measurable hA).mul
+    hg'.ae_strongly_measurable) this,
+end
 
 lemma integrable_on.continuous_on_mul [t2_space X]
   (hg : continuous_on g K) (hg' : integrable_on g' K μ) (hK : is_compact K) :
   integrable_on (λ x, g x * g' x) K μ :=
-integrable_on.continuous_on_mul_of_subset hg hg' hK hK.measurable_set subset.rfl
+hg'.continuous_on_mul_of_subset hg hK hK.measurable_set subset.rfl
 
-end real
+end mul
 
 end measure_theory
 open measure_theory
diff --git a/src/measure_theory/group/action.lean b/src/measure_theory/group/action.lean
index 4844a0f4c931b..746e81e3a47a8 100644
--- a/src/measure_theory/group/action.lean
+++ b/src/measure_theory/group/action.lean
@@ -189,7 +189,7 @@ include G
 @[to_additive] lemma measure_eq_zero_iff_eq_empty_of_smul_invariant (hμ : μ ≠ 0) (hU : is_open U) :
   μ U = 0 ↔ U = ∅ :=
 by rw [← not_iff_not, ← ne.def, ← pos_iff_ne_zero,
-  measure_pos_iff_nonempty_of_smul_invariant G hμ hU, ← ne_empty_iff_nonempty]
+  measure_pos_iff_nonempty_of_smul_invariant G hμ hU, nonempty_iff_ne_empty]
 
 end is_minimal
 
diff --git a/src/measure_theory/group/measure.lean b/src/measure_theory/group/measure.lean
index 55fac767a5bbd..f9e58e0ed76a6 100644
--- a/src/measure_theory/group/measure.lean
+++ b/src/measure_theory/group/measure.lean
@@ -443,7 +443,7 @@ end
 lemma measure_ne_zero_iff_nonempty_of_is_mul_left_invariant [regular μ]
   (hμ : μ ≠ 0) {s : set G} (hs : is_open s) :
   μ s ≠ 0 ↔ s.nonempty :=
-by simpa [null_iff_of_is_mul_left_invariant hs, hμ] using ne_empty_iff_nonempty
+by simpa [null_iff_of_is_mul_left_invariant hs, hμ] using nonempty_iff_ne_empty.symm
 
 @[to_additive]
 lemma measure_pos_iff_nonempty_of_is_mul_left_invariant [regular μ]
diff --git a/src/measure_theory/integral/interval_integral.lean b/src/measure_theory/integral/interval_integral.lean
index 5e7fbf3cc0745..75efc6ed2f3f4 100644
--- a/src/measure_theory/integral/interval_integral.lean
+++ b/src/measure_theory/integral/interval_integral.lean
@@ -168,7 +168,7 @@ open measure_theory set classical filter function
 
 open_locale classical topological_space filter ennreal big_operators interval nnreal
 
-variables {ι 𝕜 E F : Type*} [normed_add_comm_group E]
+variables {ι 𝕜 E F A : Type*} [normed_add_comm_group E]
 
 /-!
 ### Integrability at an interval
@@ -364,7 +364,7 @@ h.2.ae_strongly_measurable
 
 end
 
-variables {f g : ℝ → E} {a b : ℝ} {μ : measure ℝ}
+variables [normed_ring A] {f g : ℝ → E} {a b : ℝ} {μ : measure ℝ}
 
 lemma smul [normed_field 𝕜] [normed_space 𝕜 E]
   {f : ℝ → E} {a b : ℝ} {μ : measure ℝ} (h : interval_integrable f μ a b) (r : 𝕜) :
@@ -383,7 +383,7 @@ lemma sum (s : finset ι) {f : ι → ℝ → E} (h : ∀ i ∈ s, interval_inte
   interval_integrable (∑ i in s, f i) μ a b :=
 ⟨integrable_finset_sum' s (λ i hi, (h i hi).1), integrable_finset_sum' s (λ i hi, (h i hi).2)⟩
 
-lemma mul_continuous_on {f g : ℝ → ℝ}
+lemma mul_continuous_on {f g : ℝ → A}
   (hf : interval_integrable f μ a b) (hg : continuous_on g [a, b]) :
   interval_integrable (λ x, f x * g x) μ a b :=
 begin
@@ -391,17 +391,20 @@ begin
   exact hf.mul_continuous_on_of_subset hg measurable_set_Ioc is_compact_interval Ioc_subset_Icc_self
 end
 
-lemma continuous_on_mul {f g : ℝ → ℝ} (hf : interval_integrable f μ a b)
-  (hg : continuous_on g [a, b]) :
+lemma continuous_on_mul {f g : ℝ → A}
+  (hf : interval_integrable f μ a b) (hg : continuous_on g [a, b]) :
   interval_integrable (λ x, g x * f x) μ a b :=
-by simpa [mul_comm] using hf.mul_continuous_on hg
+begin
+  rw interval_integrable_iff at hf ⊢,
+  exact hf.continuous_on_mul_of_subset hg is_compact_interval measurable_set_Ioc Ioc_subset_Icc_self
+end
 
-lemma const_mul {f : ℝ → ℝ} {a b : ℝ} {μ : measure ℝ}
-  (hf : interval_integrable f μ a b) (c : ℝ) : interval_integrable (λ x, c * f x) μ a b :=
+lemma const_mul {f : ℝ → A}
+  (hf : interval_integrable f μ a b) (c : A) : interval_integrable (λ x, c * f x) μ a b :=
 hf.continuous_on_mul continuous_on_const
 
-lemma mul_const {f : ℝ → ℝ} {a b : ℝ} {μ : measure ℝ}
-  (hf : interval_integrable f μ a b) (c : ℝ) : interval_integrable (λ x, f x * c) μ a b :=
+lemma mul_const {f : ℝ → A}
+  (hf : interval_integrable f μ a b) (c : A) : interval_integrable (λ x, f x * c) μ a b :=
 hf.mul_continuous_on continuous_on_const
 
 lemma comp_mul_left (hf : interval_integrable f volume a b) (c : ℝ) :
@@ -2481,7 +2484,11 @@ end
 ### Integration by parts
 -/
 
-theorem integral_deriv_mul_eq_sub {u v u' v' : ℝ → ℝ}
+section parts
+
+variables [normed_ring A] [normed_algebra ℝ A] [complete_space A]
+
+theorem integral_deriv_mul_eq_sub {u v u' v' : ℝ → A}
   (hu : ∀ x ∈ interval a b, has_deriv_at u (u' x) x)
   (hv : ∀ x ∈ interval a b, has_deriv_at v (v' x) x)
   (hu' : interval_integrable u' volume a b) (hv' : interval_integrable v' volume a b) :
@@ -2490,19 +2497,21 @@ integral_eq_sub_of_has_deriv_at (λ x hx, (hu x hx).mul (hv x hx)) $
   (hu'.mul_continuous_on (has_deriv_at.continuous_on hv)).add
     (hv'.continuous_on_mul ((has_deriv_at.continuous_on hu)))
 
-theorem integral_mul_deriv_eq_deriv_mul {u v u' v' : ℝ → ℝ}
+theorem integral_mul_deriv_eq_deriv_mul {u v u' v' : ℝ → A}
   (hu : ∀ x ∈ interval a b, has_deriv_at u (u' x) x)
   (hv : ∀ x ∈ interval a b, has_deriv_at v (v' x) x)
   (hu' : interval_integrable u' volume a b) (hv' : interval_integrable v' volume a b) :
-  ∫ x in a..b, u x * v' x = u b * v b - u a * v a - ∫ x in a..b, v x * u' x :=
+  ∫ x in a..b, u x * v' x = u b * v b - u a * v a - ∫ x in a..b, u' x * v x :=
 begin
   rw [← integral_deriv_mul_eq_sub hu hv hu' hv', ← integral_sub],
-  { exact integral_congr (λ x hx, by simp only [mul_comm, add_sub_cancel']) },
+  { exact integral_congr (λ x hx, by simp only [add_sub_cancel']) },
   { exact ((hu'.mul_continuous_on (has_deriv_at.continuous_on hv)).add
       (hv'.continuous_on_mul (has_deriv_at.continuous_on hu))) },
-  { exact hu'.continuous_on_mul (has_deriv_at.continuous_on hv) },
+  { exact hu'.mul_continuous_on (has_deriv_at.continuous_on hv) },
 end
 
+end parts
+
 /-!
 ### Integration by substitution / Change of variables
 -/
diff --git a/src/measure_theory/integral/set_to_l1.lean b/src/measure_theory/integral/set_to_l1.lean
index 89e71330ffbc1..97479a4bb2cfb 100644
--- a/src/measure_theory/integral/set_to_l1.lean
+++ b/src/measure_theory/integral/set_to_l1.lean
@@ -626,17 +626,13 @@ lemma set_to_simple_func_indicator (T : set α → F →L[ℝ] F') (hT_empty : T
     (simple_func.piecewise s hs (simple_func.const α x) (simple_func.const α 0))
   = T s x :=
 begin
-  by_cases hs_empty : s = ∅,
-  { simp only [hs_empty, hT_empty, continuous_linear_map.zero_apply, piecewise_empty, const_zero,
-    set_to_simple_func_zero_apply], },
-  by_cases hs_univ : s = univ,
-  { casesI hα : is_empty_or_nonempty α,
-    { refine absurd _ hs_empty,
-      haveI : subsingleton (set α), by { unfold set, apply_instance, },
-      exact subsingleton.elim s ∅, },
-    simp [hs_univ, set_to_simple_func], },
+  obtain rfl | hs_empty := s.eq_empty_or_nonempty,
+  { simp only [hT_empty, continuous_linear_map.zero_apply, piecewise_empty, const_zero,
+      set_to_simple_func_zero_apply], },
   simp_rw set_to_simple_func,
-  rw [← ne.def, set.ne_empty_iff_nonempty] at hs_empty,
+  obtain rfl | hs_univ := eq_or_ne s univ,
+  { haveI hα := hs_empty.to_type,
+    simp },
   rw range_indicator hs hs_empty hs_univ,
   by_cases hx0 : x = 0,
   { simp_rw hx0, simp, },
diff --git a/src/measure_theory/measurable_space_def.lean b/src/measure_theory/measurable_space_def.lean
index d6fdcf5a2ef00..a36f71f12a64f 100644
--- a/src/measure_theory/measurable_space_def.lean
+++ b/src/measure_theory/measurable_space_def.lean
@@ -5,7 +5,6 @@ Authors: Johannes Hölzl, Mario Carneiro
 -/
 import data.set.countable
 import logic.encodable.lattice
-import order.conditionally_complete_lattice.basic
 import order.disjointed
 
 /-!
diff --git a/src/measure_theory/measure/measure_space.lean b/src/measure_theory/measure/measure_space.lean
index 4227d9ca7e3fb..ef343796071df 100644
--- a/src/measure_theory/measure/measure_space.lean
+++ b/src/measure_theory/measure/measure_space.lean
@@ -5,6 +5,7 @@ Authors: Johannes Hölzl, Mario Carneiro
 -/
 import measure_theory.measure.null_measurable
 import measure_theory.measurable_space
+import topology.algebra.order.liminf_limsup
 
 /-!
 # Measure spaces
@@ -174,6 +175,21 @@ lemma measure_bUnion_finset {s : finset ι} {f : ι → set α} (hd : pairwise_d
   μ (⋃ b ∈ s, f b) = ∑ p in s, μ (f p) :=
 measure_bUnion_finset₀ hd.ae_disjoint (λ b hb, (hm b hb).null_measurable_set)
 
+/-- The measure of a disjoint union (even uncountable) of measurable sets is at least the sum of
+the measures of the sets. -/
+lemma tsum_meas_le_meas_Union_of_disjoint {ι : Type*} [measurable_space α] (μ : measure α)
+  {As : ι → set α} (As_mble : ∀ (i : ι), measurable_set (As i))
+  (As_disj : pairwise (disjoint on As)) :
+  ∑' i, μ (As i) ≤ μ (⋃ i, As i) :=
+begin
+  rcases (show summable (λ i, μ (As i)), from ennreal.summable) with ⟨S, hS⟩,
+  rw [hS.tsum_eq],
+  refine tendsto_le_of_eventually_le hS tendsto_const_nhds (eventually_of_forall _),
+  intros s,
+  rw ← measure_bUnion_finset (λ i hi j hj hij, As_disj hij) (λ i _, As_mble i),
+  exact measure_mono (Union₂_subset_Union (λ (i : ι), i ∈ s) (λ (i : ι), As i)),
+end
+
 /-- If `s` is a countable set, then the measure of its preimage can be found as the sum of measures
 of the fibers `f ⁻¹' {y}`. -/
 lemma tsum_measure_preimage_singleton {s : set β} (hs : s.countable) {f : α → β}
@@ -2990,6 +3006,83 @@ begin
   exact (measure_mono (inter_subset_right _ _)).trans_lt (measure_spanning_sets_lt_top _ _),
 end
 
+/-- A set in a σ-finite space has zero measure if and only if its intersection with
+all members of the countable family of finite measure spanning sets has zero measure. -/
+lemma forall_measure_inter_spanning_sets_eq_zero
+  [measurable_space α] {μ : measure α} [sigma_finite μ] (s : set α) :
+  (∀ n, μ (s ∩ (spanning_sets μ n)) = 0) ↔ μ s = 0 :=
+begin
+  nth_rewrite 0 (show s = ⋃ n, (s ∩ (spanning_sets μ n)),
+                 by rw [← inter_Union, Union_spanning_sets, inter_univ]),
+  rw [measure_Union_null_iff],
+end
+
+/-- A set in a σ-finite space has positive measure if and only if its intersection with
+some member of the countable family of finite measure spanning sets has positive measure. -/
+lemma exists_measure_inter_spanning_sets_pos
+  [measurable_space α] {μ : measure α} [sigma_finite μ] (s : set α) :
+  (∃ n, 0 < μ (s ∩ (spanning_sets μ n))) ↔ 0 < μ s :=
+begin
+  rw ← not_iff_not,
+  simp only [not_exists, not_lt, nonpos_iff_eq_zero],
+  exact forall_measure_inter_spanning_sets_eq_zero s,
+end
+
+/-- If the union of disjoint measurable sets has finite measure, then there are only
+finitely many members of the union whose measure exceeds any given positive number. -/
+lemma finite_const_le_meas_of_disjoint_Union {ι : Type*} [measurable_space α] (μ : measure α)
+  {ε : ℝ≥0∞} (ε_pos : 0 < ε) {As : ι → set α} (As_mble : ∀ (i : ι), measurable_set (As i))
+  (As_disj : pairwise (disjoint on As)) (Union_As_finite : μ (⋃ i, As i) ≠ ∞) :
+  set.finite {i : ι | ε ≤ μ (As i)} :=
+begin
+  by_contradiction con,
+  have aux := lt_of_le_of_lt (tsum_meas_le_meas_Union_of_disjoint μ As_mble As_disj)
+                              (lt_top_iff_ne_top.mpr Union_As_finite),
+  exact con (ennreal.finite_const_le_of_tsum_ne_top aux.ne ε_pos.ne.symm),
+end
+
+/-- If the union of disjoint measurable sets has finite measure, then there are only
+countably many members of the union whose measure is positive. -/
+lemma countable_meas_pos_of_disjoint_of_meas_Union_ne_top {ι : Type*} [measurable_space α]
+  (μ : measure α) {As : ι → set α} (As_mble : ∀ (i : ι), measurable_set (As i))
+  (As_disj : pairwise (disjoint on As)) (Union_As_finite : μ (⋃ i, As i) ≠ ∞) :
+  set.countable {i : ι | 0 < μ (As i)} :=
+begin
+  set posmeas := {i : ι | 0 < μ (As i)} with posmeas_def,
+  rcases exists_seq_strict_anti_tendsto' ennreal.zero_lt_one with ⟨as, ⟨as_decr, ⟨as_mem, as_lim⟩⟩⟩,
+  set fairmeas := λ (n : ℕ) , {i : ι | as n ≤ μ (As i)} with fairmeas_def,
+  have countable_union : posmeas = (⋃ n, fairmeas n) ,
+  { have fairmeas_eq : ∀ n, fairmeas n = (λ i, μ (As i)) ⁻¹' Ici (as n),
+      from λ n, by simpa only [fairmeas_def],
+    simpa only [fairmeas_eq, posmeas_def, ← preimage_Union,
+                Union_Ici_eq_Ioi_of_lt_of_tendsto (0 : ℝ≥0∞) (λ n, (as_mem n).1) as_lim], },
+  rw countable_union,
+  refine countable_Union (λ n, finite.countable _),
+  refine finite_const_le_meas_of_disjoint_Union μ (as_mem n).1 As_mble As_disj Union_As_finite,
+end
+
+/-- In a σ-finite space, among disjoint measurable sets, only countably many can have positive
+measure. -/
+lemma countable_meas_pos_of_disjoint_Union
+  {ι : Type*} [measurable_space α] {μ : measure α} [sigma_finite μ]
+  {As : ι → set α} (As_mble : ∀ (i : ι), measurable_set (As i))
+  (As_disj : pairwise (disjoint on As)) :
+  set.countable {i : ι | 0 < μ (As i)} :=
+begin
+  have obs : {i : ι | 0 < μ (As i)} ⊆ (⋃ n, {i : ι | 0 < μ ((As i) ∩ (spanning_sets μ n))}),
+  { intros i i_in_nonzeroes,
+    by_contra con,
+    simp only [mem_Union, mem_set_of_eq, not_exists, not_lt, nonpos_iff_eq_zero] at *,
+    simpa [(forall_measure_inter_spanning_sets_eq_zero _).mp con] using i_in_nonzeroes, },
+  apply countable.mono obs,
+  refine countable_Union (λ n, countable_meas_pos_of_disjoint_of_meas_Union_ne_top μ _ _ _),
+  { exact λ i, measurable_set.inter (As_mble i) (measurable_spanning_sets μ n), },
+  { exact λ i j i_ne_j b hbi hbj, As_disj i_ne_j
+            (hbi.trans (inter_subset_left _ _)) (hbj.trans (inter_subset_left _ _)), },
+  { refine (lt_of_le_of_lt (measure_mono _) (measure_spanning_sets_lt_top μ n)).ne,
+    exact Union_subset (λ i, inter_subset_right _ _), },
+end
+
 /-- The measurable superset `to_measurable μ t` of `t` (which has the same measure as `t`)
 satisfies, for any measurable set `s`, the equality `μ (to_measurable μ t ∩ s) = μ (t ∩ s)`.
 This only holds when `μ` is σ-finite. For a version without this assumption (but requiring
diff --git a/src/measure_theory/measure/measure_space_def.lean b/src/measure_theory/measure/measure_space_def.lean
index 05d8b15e52c61..816b05437d4f7 100644
--- a/src/measure_theory/measure/measure_space_def.lean
+++ b/src/measure_theory/measure/measure_space_def.lean
@@ -156,7 +156,7 @@ lemma measure_eq_extend (hs : measurable_set s) :
 @[simp] lemma measure_empty : μ ∅ = 0 := μ.empty
 
 lemma nonempty_of_measure_ne_zero (h : μ s ≠ 0) : s.nonempty :=
-ne_empty_iff_nonempty.1 $ λ h', h $ h'.symm ▸ measure_empty
+nonempty_iff_ne_empty.2 $ λ h', h $ h'.symm ▸ measure_empty
 
 lemma measure_mono (h : s₁ ⊆ s₂) : μ s₁ ≤ μ s₂ := μ.mono h
 
diff --git a/src/measure_theory/measure/open_pos.lean b/src/measure_theory/measure/open_pos.lean
index 2bea33870b654..acf862904523b 100644
--- a/src/measure_theory/measure/open_pos.lean
+++ b/src/measure_theory/measure/open_pos.lean
@@ -40,7 +40,7 @@ lemma _root_.is_open.measure_pos (hU : is_open U) (hne : U.nonempty) : 0 < μ U
 (hU.measure_ne_zero μ hne).bot_lt
 
 lemma _root_.is_open.measure_pos_iff (hU : is_open U) : 0 < μ U ↔ U.nonempty :=
-⟨λ h, ne_empty_iff_nonempty.1 $ λ he, h.ne' $ he.symm ▸ measure_empty, hU.measure_pos μ⟩
+⟨λ h, nonempty_iff_ne_empty.2 $ λ he, h.ne' $ he.symm ▸ measure_empty, hU.measure_pos μ⟩
 
 lemma _root_.is_open.measure_eq_zero_iff (hU : is_open U) : μ U = 0 ↔ U = ∅ :=
 by simpa only [not_lt, nonpos_iff_eq_zero, not_nonempty_iff_eq_empty]
diff --git a/src/measure_theory/pi_system.lean b/src/measure_theory/pi_system.lean
index ef56546b7f865..eeb339d764f33 100644
--- a/src/measure_theory/pi_system.lean
+++ b/src/measure_theory/pi_system.lean
@@ -425,7 +425,7 @@ begin
   refine ⟨λ n hn, _, h_inter_eq⟩,
   simp_rw g,
   split_ifs with hn1 hn2,
-  { refine hpi n (f1 n) (hf1m n hn1) (f2 n) (hf2m n hn2) (set.ne_empty_iff_nonempty.mp (λ h, _)),
+  { refine hpi n (f1 n) (hf1m n hn1) (f2 n) (hf2m n hn2) (set.nonempty_iff_ne_empty.2 (λ h, _)),
     rw h_inter_eq at h_nonempty,
     suffices h_empty : (⋂ i ∈ p1 ∪ p2, g i) = ∅,
       from (set.not_nonempty_iff_eq_empty.mpr h_empty) h_nonempty,
diff --git a/src/model_theory/satisfiability.lean b/src/model_theory/satisfiability.lean
index c528b7d6b9159..1c1a693e6e45b 100644
--- a/src/model_theory/satisfiability.lean
+++ b/src/model_theory/satisfiability.lean
@@ -326,10 +326,53 @@ begin
   exact h,
 end
 
+lemma models_bounded_formula.realize_sentence {φ : L.sentence} (h : T ⊨ φ)
+  (M : Type*) [L.Structure M] [M ⊨ T] [nonempty M] :
+  M ⊨ φ :=
+begin
+  rw models_iff_not_satisfiable at h,
+  contrapose! h,
+  haveI : M ⊨ (T ∪ {formula.not φ}),
+  { simp only [set.union_singleton, model_iff, set.mem_insert_iff, forall_eq_or_imp,
+      sentence.realize_not],
+    rw ← model_iff,
+    exact ⟨h, infer_instance⟩ },
+  exact model.is_satisfiable M,
+end
+
 /-- A theory is complete when it is satisfiable and models each sentence or its negation. -/
 def is_complete (T : L.Theory) : Prop :=
 T.is_satisfiable ∧ ∀ (φ : L.sentence), (T ⊨ φ) ∨ (T ⊨ φ.not)
 
+namespace is_complete
+
+lemma models_not_iff (h : T.is_complete) (φ : L.sentence)  :
+  T ⊨ φ.not ↔ ¬ T ⊨ φ :=
+begin
+  cases h.2 φ with hφ hφn,
+  { simp only [hφ, not_true, iff_false],
+    rw [models_sentence_iff, not_forall],
+    refine ⟨h.1.some, _⟩,
+    simp only [sentence.realize_not, not_not],
+    exact models_sentence_iff.1 hφ _ },
+  { simp only [hφn, true_iff],
+    intro hφ,
+    rw models_sentence_iff at *,
+    exact hφn h.1.some (hφ _) }
+end
+
+lemma realize_sentence_iff (h : T.is_complete) (φ : L.sentence)
+  (M : Type*) [L.Structure M] [M ⊨ T] [nonempty M] :
+  M ⊨ φ ↔ T ⊨ φ :=
+begin
+  cases h.2 φ with hφ hφn,
+  { exact iff_of_true (hφ.realize_sentence M) hφ },
+  { exact iff_of_false ((sentence.realize_not M).1 (hφn.realize_sentence M))
+      ((h.models_not_iff φ).1 hφn), }
+end
+
+end is_complete
+
 /-- A theory is maximal when it is satisfiable and contains each sentence or its negation.
   Maximal theories are complete. -/
 def is_maximal (T : L.Theory) : Prop :=
diff --git a/src/model_theory/semantics.lean b/src/model_theory/semantics.lean
index c296b1e57beeb..724ef54eebf99 100644
--- a/src/model_theory/semantics.lean
+++ b/src/model_theory/semantics.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All righ
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn
 -/
-import data.list.prod_sigma
+import data.finset.basic
 import model_theory.syntax
 
 /-!
@@ -449,6 +449,18 @@ begin
   { exact is_empty_elim R }
 end
 
+@[simp] lemma realize_relabel_equiv {g : α ≃ β} {k} {φ : L.bounded_formula α k}
+  {v : β → M} {xs : fin k → M} :
+  (relabel_equiv g φ).realize v xs ↔ φ.realize (v ∘ g) xs :=
+begin
+  simp only [relabel_equiv, map_term_rel_equiv_apply, equiv.coe_refl],
+  refine realize_map_term_rel_id (λ n t xs, _) (λ _ _ _, rfl),
+  simp only [relabel_equiv_apply, term.realize_relabel],
+  refine congr (congr rfl _) rfl,
+  ext (i | i);
+  refl,
+end
+
 variables [nonempty M]
 
 lemma realize_all_lift_at_one_self {n : ℕ} {φ : L.bounded_formula α n}
@@ -659,6 +671,38 @@ infix (name := sentence.realize) ` ⊨ `:51 := sentence.realize
   M ⊨ φ.not ↔ ¬ M ⊨ φ :=
 iff.rfl
 
+namespace formula
+
+@[simp] lemma realize_equiv_sentence_symm_con
+  [L[[α]].Structure M] [(L.Lhom_with_constants α).is_expansion_on M]
+  (φ : L[[α]].sentence) :
+  (equiv_sentence.symm φ).realize (λ a, (L.con a : M)) ↔ φ.realize M :=
+begin
+  simp only [equiv_sentence, equiv.symm_symm, equiv.coe_trans, realize,
+    bounded_formula.realize_relabel_equiv],
+  refine trans _ bounded_formula.realize_constants_vars_equiv,
+  congr' with (i | i),
+  { refl },
+  { exact i.elim }
+end
+
+@[simp] lemma realize_equiv_sentence
+  [L[[α]].Structure M] [(L.Lhom_with_constants α).is_expansion_on M]
+  (φ : L.formula α) :
+  (equiv_sentence φ).realize M ↔ φ.realize (λ a, (L.con a : M)) :=
+by rw [← realize_equiv_sentence_symm_con M (equiv_sentence φ),
+    _root_.equiv.symm_apply_apply]
+
+lemma realize_equiv_sentence_symm (φ : L[[α]].sentence) (v : α → M) :
+  (equiv_sentence.symm φ).realize v ↔ @sentence.realize _ M
+    (@language.with_constants_Structure L M _ α (constants_on.Structure v)) φ :=
+begin
+  letI := constants_on.Structure v,
+  exact realize_equiv_sentence_symm_con M φ,
+end
+
+end formula
+
 @[simp] lemma Lhom.realize_on_sentence [L'.Structure M] (φ : L →ᴸ L') [φ.is_expansion_on M]
   (ψ : L.sentence) :
   M ⊨ φ.on_sentence ψ ↔ M ⊨ ψ :=
@@ -932,14 +976,14 @@ lemma model_distinct_constants_theory {M : Type w} [L[[α]].Structure M] (s : se
   M ⊨ L.distinct_constants_theory s ↔ set.inj_on (λ (i : α), (L.con i : M)) s :=
 begin
   simp only [distinct_constants_theory, Theory.model_iff, set.mem_image,
-    set.mem_inter_iff, set.mem_prod, set.mem_compl_iff, prod.exists, forall_exists_index, and_imp],
+    set.mem_inter, set.mem_prod, set.mem_compl, prod.exists, forall_exists_index, and_imp],
   refine ⟨λ h a as b bs ab, _, _⟩,
   { contrapose! ab,
-    have h' := h _ a b as bs ab rfl,
+    have h' := h _ a b ⟨⟨as, bs⟩, ab⟩ rfl,
     simp only [sentence.realize, formula.realize_not, formula.realize_equal,
       term.realize_constants] at h',
     exact h', },
-  { rintros h φ a b as bs ab rfl,
+  { rintros h φ a b ⟨⟨as, bs⟩, ab⟩ rfl,
     simp only [sentence.realize, formula.realize_not, formula.realize_equal,
       term.realize_constants],
     exact λ contra, ab (h as bs contra) }
@@ -982,6 +1026,5 @@ lemma infinite [Mi : infinite M] (h : M ≅[L] N) : infinite N := h.infinite_iff
 
 end elementarily_equivalent
 
-
 end language
 end first_order
diff --git a/src/model_theory/syntax.lean b/src/model_theory/syntax.lean
index d93d18ac26b9a..80477f6c59bbf 100644
--- a/src/model_theory/syntax.lean
+++ b/src/model_theory/syntax.lean
@@ -3,6 +3,7 @@ Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All righ
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn
 -/
+import data.list.prod_sigma
 import data.set.prod
 import logic.equiv.fin
 import model_theory.language_map
@@ -495,6 +496,12 @@ def relabel (g : α → (β ⊕ fin n)) {k} (φ : L.bounded_formula α k) :
 φ.map_term_rel (λ _ t, t.relabel (relabel_aux g _)) (λ _, id)
   (λ _, cast_le (ge_of_eq (add_assoc _ _ _)))
 
+/-- Relabels a bounded formula's free variables along a bijection. -/
+def relabel_equiv (g : α ≃ β) {k} :
+  L.bounded_formula α k ≃ L.bounded_formula β k :=
+map_term_rel_equiv (λ n, term.relabel_equiv (g.sum_congr (_root_.equiv.refl _)))
+  (λ n, _root_.equiv.refl _)
+
 @[simp] lemma relabel_falsum (g : α → (β ⊕ fin n)) {k} :
   (falsum : L.bounded_formula α k).relabel g = falsum :=
 rfl
@@ -883,6 +890,19 @@ protected def iff (φ ψ : L.formula α) : L.formula α := φ.iff ψ
 lemma is_atomic_graph (f : L.functions n) : (graph f).is_atomic :=
 bounded_formula.is_atomic.equal _ _
 
+/-- A bijection sending formulas to sentences with constants. -/
+def equiv_sentence : L.formula α ≃ L[[α]].sentence :=
+(bounded_formula.constants_vars_equiv.trans
+  (bounded_formula.relabel_equiv (equiv.sum_empty _ _))).symm
+
+lemma equiv_sentence_not (φ : L.formula α) :
+  equiv_sentence φ.not = (equiv_sentence φ).not :=
+rfl
+
+lemma equiv_sentence_inf (φ ψ : L.formula α) :
+  equiv_sentence (φ ⊓ ψ) = equiv_sentence φ ⊓ equiv_sentence ψ :=
+rfl
+
 end formula
 
 namespace relations
diff --git a/src/model_theory/types.lean b/src/model_theory/types.lean
index ebda7d5a6855b..ee7fe94891468 100644
--- a/src/model_theory/types.lean
+++ b/src/model_theory/types.lean
@@ -126,7 +126,7 @@ lemma nonempty_iff : nonempty (T.complete_type α) ↔
   T.is_satisfiable :=
 begin
   rw ← is_satisfiable_on_Theory_iff (Lhom_with_constants_injective L α),
-  rw [nonempty_iff_univ_nonempty, ← ne_empty_iff_nonempty, ne.def, not_iff_comm,
+  rw [nonempty_iff_univ_nonempty, nonempty_iff_ne_empty, ne.def, not_iff_comm,
     ← union_empty ((L.Lhom_with_constants α).on_Theory T), ← set_of_subset_eq_empty_iff],
   simp,
 end
diff --git a/src/number_theory/bertrand.lean b/src/number_theory/bertrand.lean
index dd790a5440843..a3cc2fd71c6d6 100644
--- a/src/number_theory/bertrand.lean
+++ b/src/number_theory/bertrand.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Stevens, Bolton Bailey
 -/
 import data.nat.choose.factorization
+import data.nat.prime_norm_num
 import number_theory.primorial
 import analysis.convex.specific_functions
 
@@ -55,7 +56,7 @@ begin
   λ x h, div_pos (mul_pos h (rpow_pos_of_pos (mul_pos two_pos h) _)) (rpow_pos_of_pos four_pos _),
   have hf : ∀ x, 0 < x → f x = log (x * (2 * x) ^ sqrt (2 * x) / 4 ^ (x / 3)),
   { intros x h5,
-    have h6 := mul_pos two_pos h5,
+    have h6 := mul_pos (zero_lt_two' ℝ) h5,
     have h7 := rpow_pos_of_pos h6 (sqrt (2 * x)),
     rw [log_div (mul_pos h5 h7).ne' (rpow_pos_of_pos four_pos _).ne', log_mul h5.ne' h7.ne',
       log_rpow h6, log_rpow zero_lt_four, ← mul_div_right_comm, ← mul_div, mul_comm x] },
@@ -145,7 +146,7 @@ lemma central_binom_le_of_no_bertrand_prime (n : ℕ) (n_big : 2 < n)
   central_binom n ≤ (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) :=
 begin
   have n_pos : 0 < n := (nat.zero_le _).trans_lt n_big,
-  have n2_pos : 1 ≤ 2 * n := mul_pos two_pos n_pos,
+  have n2_pos : 1 ≤ 2 * n := mul_pos (zero_lt_two' ℕ) n_pos,
   let S := (finset.range (2 * n / 3 + 1)).filter nat.prime,
   let f := λ x, x ^ n.central_binom.factorization x,
   have : ∏ (x : ℕ) in S, f x = ∏ (x : ℕ) in finset.range (2 * n / 3 + 1), f x,
diff --git a/src/number_theory/divisors.lean b/src/number_theory/divisors.lean
index 539e0e764b49d..9cbb0d1fed381 100644
--- a/src/number_theory/divisors.lean
+++ b/src/number_theory/divisors.lean
@@ -5,7 +5,7 @@ Authors: Aaron Anderson
 -/
 import algebra.big_operators.order
 import data.nat.interval
-import data.nat.prime
+import data.nat.factors
 
 /-!
 # Divisor finsets
diff --git a/src/number_theory/fermat4.lean b/src/number_theory/fermat4.lean
index b9fc62467ee9d..38e16e2234eec 100644
--- a/src/number_theory/fermat4.lean
+++ b/src/number_theory/fermat4.lean
@@ -203,7 +203,7 @@ begin
       (int.gcd_eq_one_iff_coprime.mp htt4)) },
   -- b is even because b ^ 2 = 2 * m * n.
   have hb2 : 2 ∣ b,
-  { apply @int.prime.dvd_pow' _ 2 _ (by norm_num : nat.prime 2),
+  { apply @int.prime.dvd_pow' _ 2 _ nat.prime_two,
     rw [ht2, mul_assoc], exact dvd_mul_right 2 (m * n) },
   cases hb2 with b' hb2',
   have hs : b' ^ 2 = m * (r * s),
diff --git a/src/number_theory/legendre_symbol/jacobi_symbol.lean b/src/number_theory/legendre_symbol/jacobi_symbol.lean
index fda88a30d30cf..d4ada59e8e139 100644
--- a/src/number_theory/legendre_symbol/jacobi_symbol.lean
+++ b/src/number_theory/legendre_symbol/jacobi_symbol.lean
@@ -225,8 +225,7 @@ by { rw [← legendre_sym.to_jacobi_sym], exact legendre_sym.eq_neg_one_iff p }
 /-- If `p` is prime and `J(a | p) = 1`, then `a` is q square mod `p`. -/
 lemma is_square_of_jacobi_sym_eq_one {a : ℤ} {p : ℕ} [fact p.prime] (h : J(a | p) = 1) :
   is_square (a : zmod p) :=
-not_not.mp $ mt nonsquare_iff_jacobi_sym_eq_neg_one.mpr $
-  λ hf, one_ne_zero $ neg_eq_self_iff.mp $ hf.symm.trans h
+not_not.mp $ by { rw [← nonsquare_iff_jacobi_sym_eq_neg_one, h], dec_trivial }
 
 end zmod
 
diff --git a/src/number_theory/legendre_symbol/mul_character.lean b/src/number_theory/legendre_symbol/mul_character.lean
index e00dc61dfc5fc..3c7903e9736f3 100644
--- a/src/number_theory/legendre_symbol/mul_character.lean
+++ b/src/number_theory/legendre_symbol/mul_character.lean
@@ -5,6 +5,7 @@ Authors: Michael Stoll
 -/
 import algebra.char_p.basic
 import algebra.euclidean_domain.instances
+import algebra.group.conj_finite
 
 /-!
 # Multiplicative characters of finite rings and fields
diff --git a/src/number_theory/lucas_lehmer.lean b/src/number_theory/lucas_lehmer.lean
index 77b6169656d51..d0d8613cb17d3 100644
--- a/src/number_theory/lucas_lehmer.lean
+++ b/src/number_theory/lucas_lehmer.lean
@@ -386,7 +386,7 @@ theorem order_ω (p' : ℕ) (h : lucas_lehmer_residue (p'+2) = 0) :
   order_of (ω_unit (p'+2)) = 2^(p'+2) :=
 begin
   apply nat.eq_prime_pow_of_dvd_least_prime_pow, -- the order of ω divides 2^p
-  { norm_num, },
+  { exact nat.prime_two, },
   { intro o,
     have ω_pow := order_of_dvd_iff_pow_eq_one.1 o,
     replace ω_pow := congr_arg (units.coe_hom (X (q (p'+2))) :
diff --git a/src/number_theory/modular.lean b/src/number_theory/modular.lean
index 4429ada266b9e..a91971dd18130 100644
--- a/src/number_theory/modular.lean
+++ b/src/number_theory/modular.lean
@@ -420,7 +420,7 @@ localized "notation (name := modular_group.fdo) `𝒟ᵒ` := modular_group.fdo"
 
 lemma abs_two_mul_re_lt_one_of_mem_fdo (h : z ∈ 𝒟ᵒ) : |2 * z.re| < 1 :=
 begin
-  rw [abs_mul, abs_two, ← lt_div_iff' (@two_pos ℝ _ _)],
+  rw [abs_mul, abs_two, ← lt_div_iff' (zero_lt_two' ℝ)],
   exact h.2,
 end
 
diff --git a/src/number_theory/multiplicity.lean b/src/number_theory/multiplicity.lean
index 52564d9bc8ed8..baaa7f075ecfe 100644
--- a/src/number_theory/multiplicity.lean
+++ b/src/number_theory/multiplicity.lean
@@ -135,7 +135,7 @@ lemma pow_sub_pow_of_prime {p : R} (hp : prime p) {x y : R} (hxy : p ∣ x - y)
   {n : ℕ} (hn : ¬p ∣ n) :
   multiplicity p (x ^ n - y ^ n) = multiplicity p (x - y) :=
 by rw [←geom_sum₂_mul, multiplicity.mul hp,
-  multiplicity_eq_zero_of_not_dvd (not_dvd_geom_sum₂ hp hxy hx hn), zero_add]
+  multiplicity_eq_zero.2 (not_dvd_geom_sum₂ hp hxy hx hn), zero_add]
 
 variables (hp : prime (p : R)) (hp1 : odd p) (hxy : ↑p ∣ x - y) (hx : ¬↑p ∣ x)
 include hp hp1 hxy hx
diff --git a/src/number_theory/number_field/embeddings.lean b/src/number_theory/number_field/embeddings.lean
index 21eb1f6a2ca08..310babad710b7 100644
--- a/src/number_theory/number_field/embeddings.lean
+++ b/src/number_theory/number_field/embeddings.lean
@@ -93,7 +93,7 @@ begin
   have := bUnion_roots_finite (algebra_map ℤ K) (finrank ℚ K) (finite_Icc (-C : ℤ) C),
   refine this.subset (λ x hx, _), simp_rw mem_Union,
   have h_map_ℚ_minpoly := minpoly.gcd_domain_eq_field_fractions' ℚ hx.1,
-  refine ⟨_, ⟨_, λ i, _⟩, (mem_root_set_iff (minpoly.ne_zero hx.1) x).2 (minpoly.aeval ℤ x)⟩,
+  refine ⟨_, ⟨_, λ i, _⟩, mem_root_set.2 ⟨minpoly.ne_zero hx.1, minpoly.aeval ℤ x⟩⟩,
   { rw [← (minpoly.monic hx.1).nat_degree_map (algebra_map ℤ ℚ), ← h_map_ℚ_minpoly],
     exact minpoly.nat_degree_le (is_integral_of_is_scalar_tower hx.1) },
   rw [mem_Icc, ← abs_le, ← @int.cast_le ℝ],
diff --git a/src/number_theory/padics/padic_integers.lean b/src/number_theory/padics/padic_integers.lean
index 698c4ca884ffe..f6d3a1373ac73 100644
--- a/src/number_theory/padics/padic_integers.lean
+++ b/src/number_theory/padics/padic_integers.lean
@@ -114,6 +114,8 @@ instance : has_one ℤ_[p] := ⟨⟨1, by norm_num⟩⟩
 lemma coe_eq_zero (z : ℤ_[p]) : (z : ℚ_[p]) = 0 ↔ z = 0 :=
 by rw [← coe_zero, subtype.coe_inj]
 
+lemma coe_ne_zero (z : ℤ_[p]) : (z : ℚ_[p]) ≠ 0 ↔ z ≠ 0 := z.coe_eq_zero.not
+
 instance : add_comm_group ℤ_[p] :=
 (by apply_instance : add_comm_group (subring p))
 
@@ -534,16 +536,14 @@ end dvr
 
 section fraction_ring
 
-instance algebra : algebra ℤ_[p] ℚ_[p] := ring_hom.to_algebra (padic_int.coe.ring_hom)
+instance algebra : algebra ℤ_[p] ℚ_[p] := algebra.of_subring (subring p)
 
 @[simp] lemma algebra_map_apply (x : ℤ_[p]) : algebra_map ℤ_[p] ℚ_[p] x = x := rfl
 
 instance is_fraction_ring : is_fraction_ring ℤ_[p] ℚ_[p] :=
 { map_units := λ ⟨x, hx⟩,
-  begin
-    rw [set_like.coe_mk, algebra_map_apply, is_unit_iff_ne_zero, ne.def, padic_int.coe_eq_zero],
-    exact mem_non_zero_divisors_iff_ne_zero.mp hx,
-  end,
+  by rwa [set_like.coe_mk, algebra_map_apply, is_unit_iff_ne_zero, padic_int.coe_ne_zero,
+      ←mem_non_zero_divisors_iff_ne_zero],
   surj := λ x,
   begin
     by_cases hx : ‖ x ‖ ≤ 1,
@@ -561,8 +561,8 @@ instance is_fraction_ring : is_fraction_ring ℤ_[p] ℚ_[p] :=
         { intro h0,
           rw [h0, norm_zero] at hx,
           exact hx (zero_le_one) },
-        rw [ha, padic_norm_e.mul, ← zpow_coe_nat, padic_norm_e.norm_p_pow,
-          padic.norm_eq_pow_val hx, ← zpow_add' , hn_coe, neg_neg, add_left_neg, zpow_zero],
+        rw [ha, padic_norm_e.mul, padic_norm_e.norm_p_pow,
+          padic.norm_eq_pow_val hx, ← zpow_add', hn_coe, neg_neg, add_left_neg, zpow_zero],
         exact or.inl (nat.cast_ne_zero.mpr (ne_zero.ne p)), },
       use (⟨a, le_of_eq ha_norm⟩,
         ⟨(p^n : ℤ_[p]), mem_non_zero_divisors_iff_ne_zero.mpr (ne_zero.ne _)⟩),
diff --git a/src/number_theory/padics/padic_numbers.lean b/src/number_theory/padics/padic_numbers.lean
index 630940e8b804e..fdd6b9baf34ce 100644
--- a/src/number_theory/padics/padic_numbers.lean
+++ b/src/number_theory/padics/padic_numbers.lean
@@ -726,8 +726,11 @@ begin
   exact_mod_cast hp.1.one_lt
 end
 
-@[simp] lemma norm_p_pow (n : ℤ) : ‖(p ^ n : ℚ_[p])‖ = p ^ -n :=
-by rw [norm_zpow, norm_p]; field_simp
+@[simp] lemma norm_p_zpow (n : ℤ) : ‖(p ^ n : ℚ_[p])‖ = p ^ -n :=
+by rw [norm_zpow, norm_p, zpow_neg, inv_zpow]
+
+@[simp] lemma norm_p_pow (n : ℕ) : ‖(p ^ n : ℚ_[p])‖ = p ^ (-n : ℤ) :=
+by rw [←norm_p_zpow, zpow_coe_nat]
 
 instance : nontrivially_normed_field ℚ_[p] :=
 { non_trivial := ⟨p⁻¹, begin
diff --git a/src/number_theory/padics/padic_val.lean b/src/number_theory/padics/padic_val.lean
index d0817533ceafc..b854224de87c8 100644
--- a/src/number_theory/padics/padic_val.lean
+++ b/src/number_theory/padics/padic_val.lean
@@ -73,8 +73,12 @@ begin
   simp [padic_val_nat, neq_one, eq_zero_false]
 end
 
+@[simp] lemma eq_zero_iff {n : ℕ} : padic_val_nat p n = 0 ↔ p = 1 ∨ n = 0 ∨ ¬ p ∣ n :=
+by simp only [padic_val_nat, dite_eq_right_iff, part_enat.get_eq_iff_eq_coe, nat.cast_zero,
+  multiplicity_eq_zero, and_imp, pos_iff_ne_zero, ne.def, ← or_iff_not_imp_left]
+
 lemma eq_zero_of_not_dvd {n : ℕ} (h : ¬ p ∣ n) : padic_val_nat p n = 0 :=
-by { rw padic_val_nat, split_ifs; simp [multiplicity_eq_zero_of_not_dvd h] }
+eq_zero_iff.2 $ or.inr $ or.inr h
 
 end padic_val_nat
 
@@ -111,7 +115,7 @@ lemma self (hp : 1 < p) : padic_val_int p p = 1 := by simp [padic_val_nat.self h
 lemma eq_zero_of_not_dvd {z : ℤ} (h : ¬ (p : ℤ) ∣ z) : padic_val_int p z = 0 :=
 begin
   rw [padic_val_int, padic_val_nat],
-  split_ifs; simp [multiplicity.int.nat_abs, multiplicity_eq_zero_of_not_dvd h],
+  split_ifs; simp [multiplicity.int.nat_abs, multiplicity_eq_zero.2 h],
 end
 
 end padic_val_int
diff --git a/src/number_theory/prime_counting.lean b/src/number_theory/prime_counting.lean
index 8a61f224fd780..f36a914bc1ad7 100644
--- a/src/number_theory/prime_counting.lean
+++ b/src/number_theory/prime_counting.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Bolton Bailey
 -/
 
-import data.nat.prime
+import data.nat.prime_fin
 import data.nat.totient
 import data.finset.locally_finite
 import data.nat.count
diff --git a/src/number_theory/primes_congruent_one.lean b/src/number_theory/primes_congruent_one.lean
index caffc329ba3fb..ced195fc722d0 100644
--- a/src/number_theory/primes_congruent_one.lean
+++ b/src/number_theory/primes_congruent_one.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Riccardo Brasca
 -/
 
+import data.nat.prime_fin
 import ring_theory.polynomial.cyclotomic.eval
 
 /-!
diff --git a/src/number_theory/zsqrtd/basic.lean b/src/number_theory/zsqrtd/basic.lean
index 89d07fd537d81..b86a6d38ba44b 100644
--- a/src/number_theory/zsqrtd/basic.lean
+++ b/src/number_theory/zsqrtd/basic.lean
@@ -696,9 +696,11 @@ protected theorem eq_zero_or_eq_zero_of_mul_eq_zero : Π {a b : ℤ√d}, a * b
        x * x * z = d * -y * (x * w) : by simp [h1, mul_assoc, mul_left_comm]
              ... = d * y * y * z : by simp [h2, mul_assoc, mul_left_comm]
 
+instance : no_zero_divisors ℤ√d :=
+{ eq_zero_or_eq_zero_of_mul_eq_zero := @zsqrtd.eq_zero_or_eq_zero_of_mul_eq_zero }
+
 instance : is_domain ℤ√d :=
-{ eq_zero_or_eq_zero_of_mul_eq_zero := @zsqrtd.eq_zero_or_eq_zero_of_mul_eq_zero,
-  .. zsqrtd.comm_ring, .. zsqrtd.nontrivial }
+by exact no_zero_divisors.to_is_domain _
 
 protected theorem mul_pos (a b : ℤ√d) (a0 : 0 < a) (b0 : 0 < b) : 0 < a * b := λab,
 or.elim (eq_zero_or_eq_zero_of_mul_eq_zero
diff --git a/src/order/antisymmetrization.lean b/src/order/antisymmetrization.lean
index ca73c3d0b8a09..78b4db2f22500 100644
--- a/src/order/antisymmetrization.lean
+++ b/src/order/antisymmetrization.lean
@@ -9,6 +9,10 @@ import logic.relation
 /-!
 # Turning a preorder into a partial order
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/876
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file allows to make a preorder into a partial order by quotienting out the elements `a`, `b`
 such that `a ≤ b` and `b ≤ a`.
 
diff --git a/src/order/atoms.lean b/src/order/atoms.lean
index e7cd68b07da61..2648f19ace44e 100644
--- a/src/order/atoms.lean
+++ b/src/order/atoms.lean
@@ -780,17 +780,15 @@ end fintype
 namespace set
 
 lemma is_atom_singleton (x : α) : is_atom ({x} : set α) :=
-⟨(singleton_nonempty x).ne_empty, λ s hs, ssubset_singleton_iff.mp hs⟩
+⟨singleton_ne_empty _, λ s hs, ssubset_singleton_iff.mp hs⟩
 
 lemma is_atom_iff (s : set α) : is_atom s ↔ ∃ x, s = {x} :=
 begin
   refine ⟨_, by { rintro ⟨x, rfl⟩, exact is_atom_singleton x }⟩,
-  rintro ⟨hs₁, hs₂⟩,
-  obtain ⟨x, hx⟩ := ne_empty_iff_nonempty.mp hs₁,
-  have := singleton_subset_iff.mpr hx,
-  refine ⟨x, subset.antisymm _ this⟩,
-  by_contra h,
-  exact (singleton_nonempty x).ne_empty (hs₂ {x} (ssubset_of_subset_not_subset this h)),
+  rw [is_atom_iff, bot_eq_empty, ←nonempty_iff_ne_empty],
+  rintro ⟨⟨x, hx⟩, hs⟩,
+  exact ⟨x, eq_singleton_iff_unique_mem.2 ⟨hx, λ y hy,
+    (hs {y} (singleton_ne_empty _) (singleton_subset_iff.2 hy) hx).symm⟩⟩,
 end
 
 lemma is_coatom_iff (s : set α) : is_coatom s ↔ ∃ x, s = {x}ᶜ :=
diff --git a/src/order/bounds/basic.lean b/src/order/bounds/basic.lean
index 2a2cadf45ab66..57ca0813a08fd 100644
--- a/src/order/bounds/basic.lean
+++ b/src/order/bounds/basic.lean
@@ -622,7 +622,7 @@ lemma is_lub_empty [preorder γ] [order_bot γ] : is_lub ∅ (⊥:γ) := @is_glb
 
 lemma is_lub.nonempty [no_min_order α] (hs : is_lub s a) : s.nonempty :=
 let ⟨a', ha'⟩ := exists_lt a in
-ne_empty_iff_nonempty.1 $ λ h, not_le_of_lt ha' $ hs.right $ by simp only [h, upper_bounds_empty]
+nonempty_iff_ne_empty.2 $ λ h, not_le_of_lt ha' $ hs.right $ by simp only [h, upper_bounds_empty]
 
 lemma is_glb.nonempty [no_max_order α] (hs : is_glb s a) : s.nonempty := hs.dual.nonempty
 
diff --git a/src/order/directed.lean b/src/order/directed.lean
index 1f75f6bbcfe2f..23191eacb3c45 100644
--- a/src/order/directed.lean
+++ b/src/order/directed.lean
@@ -3,7 +3,7 @@ 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
 -/
-import data.set.basic
+import data.set.image
 import order.lattice
 import order.max
 
diff --git a/src/order/filter/bases.lean b/src/order/filter/bases.lean
index 26fd2e3208a47..9e2ead76bddd3 100644
--- a/src/order/filter/bases.lean
+++ b/src/order/filter/bases.lean
@@ -325,7 +325,7 @@ forall_mem_nonempty_iff_ne_bot.symm.trans $ hl.forall_iff $ λ _ _, nonempty.mon
 lemma has_basis.eq_bot_iff (hl : l.has_basis p s) :
   l = ⊥ ↔ ∃ i, p i ∧ s i = ∅ :=
 not_iff_not.1 $ ne_bot_iff.symm.trans $ hl.ne_bot_iff.trans $
-by simp only [not_exists, not_and, ← ne_empty_iff_nonempty]
+by simp only [not_exists, not_and, nonempty_iff_ne_empty]
 
 lemma generate_ne_bot_iff {s : set (set α)} :
   ne_bot (generate s) ↔ ∀ t ⊆ s, t.finite → (⋂₀ t).nonempty :=
@@ -561,7 +561,7 @@ lemma has_basis.inf_principal_ne_bot_iff (hl : l.has_basis p s) {t : set α} :
 lemma has_basis.disjoint_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
   disjoint l l' ↔ ∃ i (hi : p i) i' (hi' : p' i'), disjoint (s i) (s' i') :=
 not_iff_not.mp $ by simp only [disjoint_iff, ← ne.def, ← ne_bot_iff, hl.inf_basis_ne_bot_iff hl',
-  not_exists, bot_eq_empty, ne_empty_iff_nonempty, inf_eq_inter]
+  not_exists, bot_eq_empty, ←nonempty_iff_ne_empty, inf_eq_inter]
 
 lemma _root_.disjoint.exists_mem_filter_basis (h : disjoint l l') (hl : l.has_basis p s)
   (hl' : l'.has_basis p' s') :
diff --git a/src/order/filter/basic.lean b/src/order/filter/basic.lean
index 2886d3e499b45..0577d370940b8 100644
--- a/src/order/filter/basic.lean
+++ b/src/order/filter/basic.lean
@@ -883,7 +883,7 @@ filter.ext $ λ x, by simp only [mem_supr, mem_principal, Union_subset_iff]
 empty_mem_iff_bot.symm.trans $ mem_principal.trans subset_empty_iff
 
 @[simp] lemma principal_ne_bot_iff {s : set α} : ne_bot (𝓟 s) ↔ s.nonempty :=
-ne_bot_iff.trans $ (not_congr principal_eq_bot_iff).trans ne_empty_iff_nonempty
+ne_bot_iff.trans $ (not_congr principal_eq_bot_iff).trans nonempty_iff_ne_empty.symm
 
 lemma is_compl_principal (s : set α) : is_compl (𝓟 s) (𝓟 sᶜ) :=
 is_compl.of_eq (by rw [inf_principal, inter_compl_self, principal_empty]) $
diff --git a/src/order/filter/n_ary.lean b/src/order/filter/n_ary.lean
index 4c06a1c9c2713..0407044df2f72 100644
--- a/src/order/filter/n_ary.lean
+++ b/src/order/filter/n_ary.lean
@@ -18,8 +18,8 @@ operations on filters.
 
 ## Notes
 
-This file is very similar to the n-ary section of `data.set.basic`, to `data.finset.n_ary` and to
-`data.option.n_ary`. Please keep them in sync.
+This file is very similar to `data.set.n_ary`, `data.finset.n_ary` and `data.option.n_ary`. Please
+keep them in sync.
 -/
 
 open function set
diff --git a/src/order/filter/pointwise.lean b/src/order/filter/pointwise.lean
index b64dcaba56ab7..0759bcb0ef67f 100644
--- a/src/order/filter/pointwise.lean
+++ b/src/order/filter/pointwise.lean
@@ -3,7 +3,7 @@ Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Zhouhang Zhou, Yaël Dillies
 -/
-import data.set.pointwise.basic
+import data.set.pointwise.smul
 import order.filter.n_ary
 import order.filter.ultrafilter
 
diff --git a/src/order/heyting/boundary.lean b/src/order/heyting/boundary.lean
index 192f0371025d8..23c95debed7c9 100644
--- a/src/order/heyting/boundary.lean
+++ b/src/order/heyting/boundary.lean
@@ -8,6 +8,10 @@ import order.boolean_algebra
 /-!
 # Co-Heyting boundary
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/844
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The boundary of an element of a co-Heyting algebra is the intersection of its Heyting negation with
 itself. The boundary in the co-Heyting algebra of closed sets coincides with the topological
 boundary.
diff --git a/src/order/hom/basic.lean b/src/order/hom/basic.lean
index 40cfa0f1d2271..9ba2f6867f416 100644
--- a/src/order/hom/basic.lean
+++ b/src/order/hom/basic.lean
@@ -12,6 +12,10 @@ import order.disjoint
 /-!
 # Order homomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/804
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines order homomorphisms, which are bundled monotone functions. A preorder
 homomorphism `f : α →o β` is a function `α → β` along with a proof that `∀ x y, x ≤ y → f x ≤ f y`.
 
diff --git a/src/order/hom/set.lean b/src/order/hom/set.lean
index 736dee0c5f8ab..aa77d38f09788 100644
--- a/src/order/hom/set.lean
+++ b/src/order/hom/set.lean
@@ -5,7 +5,7 @@ Authors: Johan Commelin
 -/
 import order.hom.basic
 import logic.equiv.set
-import data.set.basic
+import data.set.image
 
 /-!
 # Order homomorphisms and sets
diff --git a/src/order/monotone.lean b/src/order/monotone.lean
index 686c3519a6646..7f1a05ce9834f 100644
--- a/src/order/monotone.lean
+++ b/src/order/monotone.lean
@@ -216,7 +216,7 @@ section preorder
 variables [preorder α]
 
 section preorder
-variables [preorder β] {f : α → β} {a b : α}
+variables [preorder β] {f : α → β} {s : set α} {a b : α}
 
 /-!
 These four lemmas are there to strip off the semi-implicit arguments `⦃a b : α⦄`. This is useful
@@ -235,10 +235,10 @@ protected lemma monotone.monotone_on (hf : monotone f) (s : set α) : monotone_o
 protected lemma antitone.antitone_on (hf : antitone f) (s : set α) : antitone_on f s :=
 λ a _ b _, hf.imp
 
-lemma monotone_on_univ : monotone_on f set.univ ↔ monotone f :=
+@[simp] lemma monotone_on_univ : monotone_on f set.univ ↔ monotone f :=
 ⟨λ h a b, h trivial trivial, λ h, h.monotone_on _⟩
 
-lemma antitone_on_univ : antitone_on f set.univ ↔ antitone f :=
+@[simp] lemma antitone_on_univ : antitone_on f set.univ ↔ antitone f :=
 ⟨λ h a b, h trivial trivial, λ h, h.antitone_on _⟩
 
 protected lemma strict_mono.strict_mono_on (hf : strict_mono f) (s : set α) : strict_mono_on f s :=
@@ -247,10 +247,10 @@ protected lemma strict_mono.strict_mono_on (hf : strict_mono f) (s : set α) : s
 protected lemma strict_anti.strict_anti_on (hf : strict_anti f) (s : set α) : strict_anti_on f s :=
 λ a _ b _, hf.imp
 
-lemma strict_mono_on_univ : strict_mono_on f set.univ ↔ strict_mono f :=
+@[simp] lemma strict_mono_on_univ : strict_mono_on f set.univ ↔ strict_mono f :=
 ⟨λ h a b, h trivial trivial, λ h, h.strict_mono_on _⟩
 
-lemma strict_anti_on_univ : strict_anti_on f set.univ ↔ strict_anti f :=
+@[simp] lemma strict_anti_on_univ : strict_anti_on f set.univ ↔ strict_anti f :=
 ⟨λ h a b, h trivial trivial, λ h, h.strict_anti_on _⟩
 
 end preorder
@@ -644,12 +644,55 @@ lemma antitone.strict_anti_iff_injective (hf : antitone f) :
 
 end partial_order
 
+variables [linear_order β] {f : α → β} {s : set α} {x y : α}
+
+/-- A function between linear orders which is neither monotone nor antitone makes a dent upright or
+downright. -/
+lemma not_monotone_not_antitone_iff_exists_le_le :
+  ¬ monotone f ∧ ¬ antitone f ↔ ∃ a b c, a ≤ b ∧ b ≤ c ∧
+    (f a < f b ∧ f c < f b ∨ f b < f a ∧ f b < f c) :=
+begin
+  simp_rw [monotone, antitone, not_forall, not_le],
+  refine iff.symm ⟨_, _⟩,
+  { rintro ⟨a, b, c, hab, hbc, ⟨hfab, hfcb⟩ | ⟨hfba, hfbc⟩⟩,
+    exacts [⟨⟨_, _, hbc, hfcb⟩, _, _, hab, hfab⟩, ⟨⟨_, _, hab, hfba⟩, _, _, hbc, hfbc⟩] },
+  rintro ⟨⟨a, b, hab, hfba⟩, c, d, hcd, hfcd⟩,
+  obtain hda | had := le_total d a,
+  { obtain hfad | hfda := le_total (f a) (f d),
+    { exact ⟨c, d, b, hcd, hda.trans hab, or.inl ⟨hfcd, hfba.trans_le hfad⟩⟩ },
+    { exact ⟨c, a, b, hcd.trans hda, hab, or.inl ⟨hfcd.trans_le hfda, hfba⟩⟩ } },
+  obtain hac | hca := le_total a c,
+  { obtain hfdb | hfbd := le_or_lt (f d) (f b),
+    { exact ⟨a, c, d, hac, hcd, or.inr ⟨hfcd.trans $ hfdb.trans_lt hfba, hfcd⟩⟩ },
+    obtain hfca | hfac := lt_or_le (f c) (f a),
+    { exact ⟨a, c, d, hac, hcd, or.inr ⟨hfca, hfcd⟩⟩ },
+    obtain hbd | hdb := le_total b d,
+    { exact ⟨a, b, d, hab, hbd, or.inr ⟨hfba, hfbd⟩⟩ },
+    { exact ⟨a, d, b, had, hdb, or.inl ⟨hfac.trans_lt hfcd, hfbd⟩⟩ } },
+  { obtain hfdb | hfbd := le_or_lt (f d) (f b),
+    { exact ⟨c, a, b, hca, hab, or.inl ⟨hfcd.trans $ hfdb.trans_lt hfba, hfba⟩⟩ },
+    obtain hfca | hfac := lt_or_le (f c) (f a),
+    { exact ⟨c, a, b, hca, hab, or.inl ⟨hfca, hfba⟩⟩ },
+    obtain hbd | hdb := le_total b d,
+    { exact ⟨a, b, d, hab, hbd, or.inr ⟨hfba, hfbd⟩⟩ },
+    { exact ⟨a, d, b, had, hdb, or.inl ⟨hfac.trans_lt hfcd, hfbd⟩⟩ } }
+end
+
+/-- A function between linear orders which is neither monotone nor antitone makes a dent upright or
+downright. -/
+lemma not_monotone_not_antitone_iff_exists_lt_lt :
+  ¬ monotone f ∧ ¬ antitone f ↔ ∃ a b c, a < b ∧ b < c ∧
+    (f a < f b ∧ f c < f b ∨ f b < f a ∧ f b < f c) :=
+begin
+  simp_rw [not_monotone_not_antitone_iff_exists_le_le, ←and_assoc],
+  refine exists₃_congr (λ a b c, and_congr_left $ λ h, (ne.le_iff_lt _).and $ ne.le_iff_lt _);
+    rintro rfl; simpa using h,
+end
+
 /-!
 ### Strictly monotone functions and `cmp`
 -/
 
-variables [linear_order β] {f : α → β} {s : set α} {x y : α}
-
 lemma strict_mono_on.cmp_map_eq (hf : strict_mono_on f s) (hx : x ∈ s) (hy : y ∈ s) :
   cmp (f x) (f y) = cmp x y :=
 ((hf.compares hx hy).2 (cmp_compares x y)).cmp_eq
diff --git a/src/order/monovary.lean b/src/order/monovary.lean
index fab9d802a4108..d2ff137b04331 100644
--- a/src/order/monovary.lean
+++ b/src/order/monovary.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import data.set.basic
+import data.set.image
 
 /-!
 # Monovariance of functions
diff --git a/src/order/symm_diff.lean b/src/order/symm_diff.lean
index 401c9105dc451..803677f2be73b 100644
--- a/src/order/symm_diff.lean
+++ b/src/order/symm_diff.lean
@@ -10,6 +10,10 @@ import logic.equiv.basic
 /-!
 # Symmetric difference and bi-implication
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> https://github.com/leanprover-community/mathlib4/pull/842
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the symmetric difference and bi-implication operators in (co-)Heyting algebras.
 
 ## Examples
diff --git a/src/order/upper_lower.lean b/src/order/upper_lower.lean
index 8ae3cb28d4a41..0864b562e6a5b 100644
--- a/src/order/upper_lower.lean
+++ b/src/order/upper_lower.lean
@@ -336,6 +336,8 @@ instance : inhabited (upper_set α) := ⟨⊥⟩
 @[simp, norm_cast] lemma coe_subset_coe : (s : set α) ⊆ t ↔ t ≤ s := iff.rfl
 @[simp, norm_cast] lemma coe_top : ((⊤ : upper_set α) : set α) = ∅ := rfl
 @[simp, norm_cast] lemma coe_bot : ((⊥ : upper_set α) : set α) = univ := rfl
+@[simp, norm_cast] lemma coe_eq_univ : (s : set α) = univ ↔ s = ⊥ := by simp [set_like.ext'_iff]
+@[simp, norm_cast] lemma coe_eq_empty : (s : set α) = ∅ ↔ s = ⊤ := by simp [set_like.ext'_iff]
 @[simp, norm_cast] lemma coe_sup (s t : upper_set α) : (↑(s ⊔ t) : set α) = s ∩ t := rfl
 @[simp, norm_cast] lemma coe_inf (s t : upper_set α) : (↑(s ⊓ t) : set α) = s ∪ t := rfl
 @[simp, norm_cast] lemma coe_Sup (S : set (upper_set α)) : (↑(Sup S) : set α) = ⋂ s ∈ S, ↑s := rfl
@@ -364,6 +366,9 @@ by simp_rw mem_supr_iff
 @[simp] lemma mem_infi₂_iff {f : Π i, κ i → upper_set α} : a ∈ (⨅ i j, f i j) ↔ ∃ i j, a ∈ f i j :=
 by simp_rw mem_infi_iff
 
+@[simp, norm_cast] lemma codisjoint_coe : codisjoint (s : set α) t ↔ disjoint s t :=
+by simp [disjoint_iff, codisjoint_iff, set_like.ext'_iff]
+
 end upper_set
 
 namespace lower_set
@@ -385,6 +390,8 @@ instance : inhabited (lower_set α) := ⟨⊥⟩
 @[simp, norm_cast] lemma coe_subset_coe : (s : set α) ⊆ t ↔ s ≤ t := iff.rfl
 @[simp, norm_cast] lemma coe_top : ((⊤ : lower_set α) : set α) = univ := rfl
 @[simp, norm_cast] lemma coe_bot : ((⊥ : lower_set α) : set α) = ∅ := rfl
+@[simp, norm_cast] lemma coe_eq_univ : (s : set α) = univ ↔ s = ⊤ := by simp [set_like.ext'_iff]
+@[simp, norm_cast] lemma coe_eq_empty : (s : set α) = ∅ ↔ s = ⊥ := by simp [set_like.ext'_iff]
 @[simp, norm_cast] lemma coe_sup (s t : lower_set α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
 @[simp, norm_cast] lemma coe_inf (s t : lower_set α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
 @[simp, norm_cast] lemma coe_Sup (S : set (lower_set α)) : (↑(Sup S) : set α) = ⋃ s ∈ S, ↑s := rfl
@@ -413,6 +420,9 @@ by simp_rw mem_supr_iff
 @[simp] lemma mem_infi₂_iff {f : Π i, κ i → lower_set α} : a ∈ (⨅ i j, f i j) ↔ ∀ i j, a ∈ f i j :=
 by simp_rw mem_infi_iff
 
+@[simp, norm_cast] lemma disjoint_coe : disjoint (s : set α) t ↔ disjoint s t :=
+by simp [disjoint_iff, set_like.ext'_iff]
+
 end lower_set
 
 /-! #### Complement -/
@@ -895,7 +905,10 @@ end closure
 /-! ### Product -/
 
 section preorder
-variables [preorder α] [preorder β] {s : set α} {t : set β} {x : α × β}
+variables [preorder α] [preorder β]
+
+section
+variables {s : set α} {t : set β} {x : α × β}
 
 lemma is_upper_set.prod (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ×ˢ t) :=
 λ a b h ha, ⟨hs h.1 ha.1, ht h.2 ha.2⟩
@@ -903,15 +916,17 @@ lemma is_upper_set.prod (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_s
 lemma is_lower_set.prod (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ×ˢ t) :=
 λ a b h ha, ⟨hs h.1 ha.1, ht h.2 ha.2⟩
 
+end
+
 namespace upper_set
+variables (s s₁ s₂ : upper_set α) (t t₁ t₂ : upper_set β) {x : α × β}
 
 /-- The product of two upper sets as an upper set. -/
-def prod (s : upper_set α) (t : upper_set β) : upper_set (α × β) := ⟨s ×ˢ t, s.2.prod t.2⟩
+def prod : upper_set (α × β) := ⟨s ×ˢ t, s.2.prod t.2⟩
 
 infixr (name := upper_set.prod) ` ×ˢ `:82 := prod
 
-@[simp] lemma coe_prod (s : upper_set α) (t : upper_set β) : (↑(s ×ˢ t) : set (α × β)) = s ×ˢ t :=
-rfl
+@[simp, norm_cast] lemma coe_prod : (↑(s ×ˢ t) : set (α × β)) = s ×ˢ t := rfl
 
 @[simp] lemma mem_prod {s : upper_set α} {t : upper_set β} : x ∈ s ×ˢ t ↔ x.1 ∈ s ∧ x.2 ∈ t :=
 iff.rfl
@@ -919,21 +934,45 @@ iff.rfl
 lemma Ici_prod (x : α × β) : Ici x = Ici x.1 ×ˢ Ici x.2 := rfl
 @[simp] lemma Ici_prod_Ici (a : α) (b : β) : Ici a ×ˢ Ici b = Ici (a, b) := rfl
 
-@[simp] lemma prod_top (s : upper_set α) : s ×ˢ (⊤ : upper_set β) = ⊤ := ext prod_empty
-@[simp] lemma top_prod (t : upper_set β) : (⊤ : upper_set α) ×ˢ t = ⊤ := ext empty_prod
+@[simp] lemma prod_top : s ×ˢ (⊤ : upper_set β) = ⊤ := ext prod_empty
+@[simp] lemma top_prod : (⊤ : upper_set α) ×ˢ t = ⊤ := ext empty_prod
 @[simp] lemma bot_prod_bot : (⊥ : upper_set α) ×ˢ (⊥ : upper_set β) = ⊥ := ext univ_prod_univ
+@[simp] lemma sup_prod : (s₁ ⊔ s₂) ×ˢ t = s₁ ×ˢ t ⊔ s₂ ×ˢ t := ext inter_prod
+@[simp] lemma prod_sup : s ×ˢ (t₁ ⊔ t₂) = s ×ˢ t₁ ⊔ s ×ˢ t₂ := ext prod_inter
+@[simp] lemma inf_prod : (s₁ ⊓ s₂) ×ˢ t = s₁ ×ˢ t ⊓ s₂ ×ˢ t := ext union_prod
+@[simp] lemma prod_inf : s ×ˢ (t₁ ⊓ t₂) = s ×ˢ t₁ ⊓ s ×ˢ t₂ := ext prod_union
+lemma prod_sup_prod : s₁ ×ˢ t₁ ⊔ s₂ ×ˢ t₂ = (s₁ ⊔ s₂) ×ˢ (t₁ ⊔ t₂) := ext prod_inter_prod
+
+variables {s s₁ s₂ t t₁ t₂}
+
+lemma prod_mono : s₁ ≤ s₂ → t₁ ≤ t₂ → s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ := prod_mono
+lemma prod_mono_left : s₁ ≤ s₂ → s₁ ×ˢ t ≤ s₂ ×ˢ t := prod_mono_left
+lemma prod_mono_right : t₁ ≤ t₂ → s ×ˢ t₁ ≤ s ×ˢ t₂ := prod_mono_right
+
+@[simp] lemma prod_self_le_prod_self : s₁ ×ˢ s₁ ≤ s₂ ×ˢ s₂ ↔ s₁ ≤ s₂ := prod_self_subset_prod_self
+@[simp] lemma prod_self_lt_prod_self : s₁ ×ˢ s₁ < s₂ ×ˢ s₂ ↔ s₁ < s₂ := prod_self_ssubset_prod_self
+
+lemma prod_le_prod_iff : s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ ↔ s₁ ≤ s₂ ∧ t₁ ≤ t₂ ∨ s₂ = ⊤ ∨ t₂ = ⊤ :=
+prod_subset_prod_iff.trans $ by simp
+
+@[simp] lemma prod_eq_top : s ×ˢ t = ⊤ ↔ s = ⊤ ∨ t = ⊤ :=
+by { simp_rw set_like.ext'_iff, exact prod_eq_empty_iff }
+
+@[simp] lemma codisjoint_prod :
+  codisjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) ↔ codisjoint s₁ s₂ ∨ codisjoint t₁ t₂ :=
+by simp_rw [codisjoint_iff, prod_sup_prod, prod_eq_top]
 
 end upper_set
 
 namespace lower_set
+variables (s s₁ s₂ : lower_set α) (t t₁ t₂ : lower_set β) {x : α × β}
 
 /-- The product of two lower sets as a lower set. -/
-def prod (s : lower_set α) (t : lower_set β) : lower_set (α × β) := ⟨s ×ˢ t, s.2.prod t.2⟩
+def prod : lower_set (α × β) := ⟨s ×ˢ t, s.2.prod t.2⟩
 
 infixr (name := lower_set.prod) ` ×ˢ `:82 := lower_set.prod
 
-@[simp] lemma coe_prod (s : lower_set α) (t : lower_set β) : (↑(s ×ˢ t) : set (α × β)) = s ×ˢ t :=
-rfl
+@[simp, norm_cast] lemma coe_prod : (↑(s ×ˢ t) : set (α × β)) = s ×ˢ t := rfl
 
 @[simp] lemma mem_prod {s : lower_set α} {t : lower_set β} : x ∈ s ×ˢ t ↔ x.1 ∈ s ∧ x.2 ∈ t :=
 iff.rfl
@@ -941,9 +980,32 @@ iff.rfl
 lemma Iic_prod (x : α × β) : Iic x = Iic x.1 ×ˢ Iic x.2 := rfl
 @[simp] lemma Ici_prod_Ici (a : α) (b : β) : Iic a ×ˢ Iic b = Iic (a, b) := rfl
 
-@[simp] lemma prod_bot (s : lower_set α) : s ×ˢ (⊥ : lower_set β) = ⊥ := ext prod_empty
-@[simp] lemma bot_prod (t : lower_set β) : (⊥ : lower_set α) ×ˢ t = ⊥ := ext empty_prod
+@[simp] lemma prod_bot : s ×ˢ (⊥ : lower_set β) = ⊥ := ext prod_empty
+@[simp] lemma bot_prod : (⊥ : lower_set α) ×ˢ t = ⊥ := ext empty_prod
 @[simp] lemma top_prod_top : (⊤ : lower_set α) ×ˢ (⊤ : lower_set β) = ⊤ := ext univ_prod_univ
+@[simp] lemma inf_prod : (s₁ ⊓ s₂) ×ˢ t = s₁ ×ˢ t ⊓ s₂ ×ˢ t := ext inter_prod
+@[simp] lemma prod_inf : s ×ˢ (t₁ ⊓ t₂) = s ×ˢ t₁ ⊓ s ×ˢ t₂ := ext prod_inter
+@[simp] lemma sup_prod : (s₁ ⊔ s₂) ×ˢ t = s₁ ×ˢ t ⊔ s₂ ×ˢ t := ext union_prod
+@[simp] lemma prod_sup : s ×ˢ (t₁ ⊔ t₂) = s ×ˢ t₁ ⊔ s ×ˢ t₂ := ext prod_union
+lemma prod_inf_prod : s₁ ×ˢ t₁ ⊓ s₂ ×ˢ t₂ = (s₁ ⊓ s₂) ×ˢ (t₁ ⊓ t₂) := ext prod_inter_prod
+
+variables {s s₁ s₂ t t₁ t₂}
+
+lemma prod_mono : s₁ ≤ s₂ → t₁ ≤ t₂ → s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ := prod_mono
+lemma prod_mono_left : s₁ ≤ s₂ → s₁ ×ˢ t ≤ s₂ ×ˢ t := prod_mono_left
+lemma prod_mono_right : t₁ ≤ t₂ → s ×ˢ t₁ ≤ s ×ˢ t₂ := prod_mono_right
+
+@[simp] lemma prod_self_le_prod_self : s₁ ×ˢ s₁ ≤ s₂ ×ˢ s₂ ↔ s₁ ≤ s₂ := prod_self_subset_prod_self
+@[simp] lemma prod_self_lt_prod_self : s₁ ×ˢ s₁ < s₂ ×ˢ s₂ ↔ s₁ < s₂ := prod_self_ssubset_prod_self
+
+lemma prod_le_prod_iff : s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ ↔ s₁ ≤ s₂ ∧ t₁ ≤ t₂ ∨ s₁ = ⊥ ∨ t₁ = ⊥ :=
+prod_subset_prod_iff.trans $ by simp
+
+@[simp] lemma prod_eq_bot : s ×ˢ t = ⊥ ↔ s = ⊥ ∨ t = ⊥ :=
+by { simp_rw set_like.ext'_iff, exact prod_eq_empty_iff }
+
+@[simp] lemma disjoint_prod : disjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) ↔ disjoint s₁ s₂ ∨ disjoint t₁ t₂ :=
+by simp_rw [disjoint_iff, prod_inf_prod, prod_eq_bot]
 
 end lower_set
 
diff --git a/src/order/well_founded.lean b/src/order/well_founded.lean
index 4ee42fa17d934..11410254be56d 100644
--- a/src/order/well_founded.lean
+++ b/src/order/well_founded.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Mario Carneiro
 -/
 import tactic.by_contra
-import data.set.basic
+import data.set.image
 
 /-!
 # Well-founded relations
diff --git a/src/ring_theory/algebraic.lean b/src/ring_theory/algebraic.lean
index 46567de090a3e..d91e2bb41c483 100644
--- a/src/ring_theory/algebraic.lean
+++ b/src/ring_theory/algebraic.lean
@@ -227,11 +227,10 @@ theorem is_algebraic.alg_hom_bijective
 begin
   refine ⟨f.to_ring_hom.injective, λ b, _⟩,
   obtain ⟨p, hp, he⟩ := ha b,
-  let f' : p.root_set L → p.root_set L :=
-    set.maps_to.restrict f _ _ (root_set_maps_to (map_ne_zero hp) f),
+  let f' : p.root_set L → p.root_set L := (root_set_maps_to' id f).restrict f _ _,
   have : function.surjective f' := finite.injective_iff_surjective.1
     (λ _ _ h, subtype.eq $ f.to_ring_hom.injective $ subtype.ext_iff.1 h),
-  obtain ⟨a, ha⟩ := this ⟨b, (mem_root_set_iff hp b).2 he⟩,
+  obtain ⟨a, ha⟩ := this ⟨b, mem_root_set.2 ⟨hp, he⟩⟩,
   exact ⟨a, subtype.ext_iff.1 ha⟩,
 end
 
diff --git a/src/ring_theory/chain_of_divisors.lean b/src/ring_theory/chain_of_divisors.lean
index 3ae3837b0be67..115c19ce86355 100644
--- a/src/ring_theory/chain_of_divisors.lean
+++ b/src/ring_theory/chain_of_divisors.lean
@@ -38,6 +38,19 @@ and the set of factors of `a`.
 
 variables {M : Type*} [cancel_comm_monoid_with_zero M]
 
+lemma associates.is_atom_iff {p : associates M} (h₁ : p ≠ 0) :
+  is_atom p ↔ irreducible p :=
+⟨λ hp, ⟨by simpa only [associates.is_unit_iff_eq_one] using hp.1,
+        λ a b h, (hp.le_iff.mp ⟨_, h⟩).cases_on
+          (λ ha, or.inl (a.is_unit_iff_eq_one.mpr ha))
+          (λ ha, or.inr (show is_unit b, by {rw ha at h, apply is_unit_of_associated_mul
+          (show associated (p * b) p, by conv_rhs {rw h}) h₁ }))⟩,
+ λ hp, ⟨by simpa only [associates.is_unit_iff_eq_one, associates.bot_eq_one] using hp.1,
+        λ b ⟨⟨a, hab⟩, hb⟩, (hp.is_unit_or_is_unit hab).cases_on
+          (λ hb, show b = ⊥, by rwa [associates.is_unit_iff_eq_one, ← associates.bot_eq_one] at hb)
+          (λ ha, absurd (show p ∣ b, from ⟨(ha.unit⁻¹ : units _), by simp [hab]; rw mul_assoc;
+            rw is_unit.mul_coe_inv ha; rw mul_one⟩) hb)⟩⟩
+
 open unique_factorization_monoid multiplicity irreducible associates
 
 namespace divisor_chain
diff --git a/src/ring_theory/class_group.lean b/src/ring_theory/class_group.lean
index 59466077dfe9a..6e894f437902d 100644
--- a/src/ring_theory/class_group.lean
+++ b/src/ring_theory/class_group.lean
@@ -269,8 +269,7 @@ begin
     change setoid.r _ _,
     rw quotient_group.left_rel_apply,
     refine ⟨units.mk0 (algebra_map R _ a) fa_ne_zero, _⟩,
-    apply @mul_left_cancel _ _ I,
-    rw [← mul_assoc, mul_right_inv, one_mul, eq_comm, mul_comm I],
+    rw [_root_.eq_inv_mul_iff_mul_eq, eq_comm, mul_comm I],
     apply units.ext,
     simp only [fractional_ideal.coe_mk0, fractional_ideal.map_canonical_equiv_mk0, set_like.coe_mk,
         units.coe_mk0, coe_to_principal_ideal, coe_coe, units.coe_mul,
diff --git a/src/ring_theory/dedekind_domain/ideal.lean b/src/ring_theory/dedekind_domain/ideal.lean
index a31da5adb1398..36a23c0addf6b 100644
--- a/src/ring_theory/dedekind_domain/ideal.lean
+++ b/src/ring_theory/dedekind_domain/ideal.lean
@@ -607,6 +607,10 @@ instance ideal.cancel_comm_monoid_with_zero :
     coe_ideal_injective (ring_hom.map_zero _) (ring_hom.map_one _) (ring_hom.map_mul _)
     (ring_hom.map_pow _) }
 
+instance ideal.is_domain :
+  is_domain (ideal A) :=
+{ .. (infer_instance : is_cancel_mul_zero _), .. ideal.nontrivial }
+
 /-- For ideals in a Dedekind domain, to divide is to contain. -/
 lemma ideal.dvd_iff_le {I J : ideal A} : (I ∣ J) ↔ J ≤ I :=
 ⟨ideal.le_of_dvd,
diff --git a/src/ring_theory/finiteness.lean b/src/ring_theory/finiteness.lean
index 0d3a0b39986c7..5ab0cc4e0c2ef 100644
--- a/src/ring_theory/finiteness.lean
+++ b/src/ring_theory/finiteness.lean
@@ -502,7 +502,7 @@ lemma trans {R : Type*} (A B : Type*) [comm_semiring R] [comm_semiring A] [algeb
 | ⟨⟨s, hs⟩⟩ ⟨⟨t, ht⟩⟩ := ⟨submodule.fg_def.2
   ⟨set.image2 (•) (↑s : set A) (↑t : set B),
     set.finite.image2 _ s.finite_to_set t.finite_to_set,
-    by rw [set.image2_smul, submodule.span_smul hs (↑t : set B),
+    by rw [set.image2_smul, submodule.span_smul_of_span_eq_top hs (↑t : set B),
       ht, submodule.restrict_scalars_top]⟩⟩
 
 end algebra
diff --git a/src/ring_theory/hahn_series.lean b/src/ring_theory/hahn_series.lean
index 05899a5c64965..376950fafe105 100644
--- a/src/ring_theory/hahn_series.lean
+++ b/src/ring_theory/hahn_series.lean
@@ -783,9 +783,7 @@ instance {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [non_unital_non_assoc_s
 
 instance {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [ring R] [is_domain R] :
   is_domain (hahn_series Γ R) :=
-{ .. hahn_series.no_zero_divisors,
-  .. hahn_series.nontrivial,
-  .. hahn_series.ring }
+no_zero_divisors.to_is_domain _
 
 @[simp]
 lemma order_mul {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [non_unital_non_assoc_semiring R]
diff --git a/src/ring_theory/ideal/associated_prime.lean b/src/ring_theory/ideal/associated_prime.lean
new file mode 100644
index 0000000000000..5ed07421fc294
--- /dev/null
+++ b/src/ring_theory/ideal/associated_prime.lean
@@ -0,0 +1,166 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import linear_algebra.span
+import ring_theory.ideal.operations
+import ring_theory.finiteness
+import ring_theory.localization.ideal
+import ring_theory.ideal.minimal_prime
+
+/-!
+
+# Associated primes of a module
+
+We provide the definition and related lemmas about associated primes of modules.
+
+## Main definition
+- `is_associated_prime`: `is_associated_prime I M` if the prime ideal `I` is the
+  annihilator of some `x : M`.
+- `associated_primes`: The set of associated primes of a module.
+
+## Main results
+- `exists_le_is_associated_prime_of_is_noetherian_ring`: In a noetherian ring, any `ann(x)` is
+  contained in an associated prime for `x ≠ 0`.
+- `associated_primes.eq_singleton_of_is_primary`: In a noetherian ring, `I.radical` is the only
+  associated prime of `R ⧸ I` when `I` is primary.
+
+## Todo
+
+Generalize this to a non-commutative setting once there are annihilator for non-commutative rings.
+
+-/
+
+variables {R : Type*} [comm_ring R] (I J : ideal R) (M : Type*) [add_comm_group M] [module R M]
+
+/-- `is_associated_prime I M` if the prime ideal `I` is the annihilator of some `x : M`. -/
+def is_associated_prime : Prop :=
+I.is_prime ∧ ∃ x : M, I = (R ∙ x).annihilator
+
+variables (R)
+
+/-- The set of associated primes of a module. -/
+def associated_primes : set (ideal R) := { I | is_associated_prime I M }
+
+variables {I J M R} (h : is_associated_prime I M)
+variables {M' : Type*} [add_comm_group M'] [module R M'] (f : M →ₗ[R] M')
+
+lemma associate_primes.mem_iff : I ∈ associated_primes R M ↔ is_associated_prime I M := iff.rfl
+
+lemma is_associated_prime.is_prime : I.is_prime := h.1
+
+lemma is_associated_prime.map_of_injective
+  (h : is_associated_prime I M) (hf : function.injective f) :
+  is_associated_prime I M' :=
+begin
+  obtain ⟨x, rfl⟩ := h.2,
+  refine ⟨h.1, ⟨f x, _⟩⟩,
+  ext r,
+  rw [submodule.mem_annihilator_span_singleton, submodule.mem_annihilator_span_singleton,
+    ← map_smul, ← f.map_zero, hf.eq_iff],
+end
+
+lemma linear_equiv.is_associated_prime_iff (l : M ≃ₗ[R] M') :
+  is_associated_prime I M ↔ is_associated_prime I M' :=
+⟨λ h, h.map_of_injective l l.injective, λ h, h.map_of_injective l.symm l.symm.injective⟩
+
+lemma not_is_associated_prime_of_subsingleton [subsingleton M] : ¬ is_associated_prime I M :=
+begin
+  rintro ⟨hI, x, hx⟩,
+  apply hI.ne_top,
+  rwa [subsingleton.elim x 0, submodule.span_singleton_eq_bot.mpr rfl,
+    submodule.annihilator_bot] at hx
+end
+
+variable (R)
+
+lemma exists_le_is_associated_prime_of_is_noetherian_ring [H : is_noetherian_ring R]
+  (x : M) (hx : x ≠ 0) :
+  ∃ P : ideal R, is_associated_prime P M ∧ (R ∙ x).annihilator ≤ P :=
+begin
+  have : (R ∙ x).annihilator ≠ ⊤,
+  { rwa [ne.def, ideal.eq_top_iff_one, submodule.mem_annihilator_span_singleton, one_smul] },
+  obtain ⟨P, ⟨l, h₁, y, rfl⟩, h₃⟩ := set_has_maximal_iff_noetherian.mpr H
+    ({ P | (R ∙ x).annihilator ≤ P ∧ P ≠ ⊤ ∧ ∃ y : M, P = (R ∙ y).annihilator })
+    ⟨(R ∙ x).annihilator, rfl.le, this, x, rfl⟩,
+  refine ⟨_, ⟨⟨h₁, _⟩, y, rfl⟩, l⟩,
+  intros a b hab,
+  rw or_iff_not_imp_left,
+  intro ha,
+  rw submodule.mem_annihilator_span_singleton at ha hab,
+  have H₁ : (R ∙ y).annihilator ≤ (R ∙ a • y).annihilator,
+  { intros c hc,
+    rw submodule.mem_annihilator_span_singleton at hc ⊢,
+    rw [smul_comm, hc, smul_zero] },
+  have H₂ : (submodule.span R {a • y}).annihilator ≠ ⊤,
+  { rwa [ne.def, submodule.annihilator_eq_top_iff, submodule.span_singleton_eq_bot] },
+  rwa [← h₃ (R ∙ a • y).annihilator ⟨l.trans H₁, H₂, _, rfl⟩ H₁,
+    submodule.mem_annihilator_span_singleton, smul_comm, smul_smul]
+end
+
+variable {R}
+
+lemma associated_primes.subset_of_injective (hf : function.injective f) :
+  associated_primes R M ⊆ associated_primes R M' :=
+λ I h, h.map_of_injective f hf
+
+lemma linear_equiv.associated_primes.eq (l : M ≃ₗ[R] M') :
+  associated_primes R M = associated_primes R M' :=
+le_antisymm (associated_primes.subset_of_injective l l.injective)
+  (associated_primes.subset_of_injective l.symm l.symm.injective)
+
+lemma associated_primes.eq_empty_of_subsingleton [subsingleton M] : associated_primes R M = ∅ :=
+begin
+  ext, simp only [set.mem_empty_iff_false, iff_false], apply not_is_associated_prime_of_subsingleton
+end
+
+variables (R M)
+
+lemma associated_primes.nonempty [is_noetherian_ring R] [nontrivial M] :
+  (associated_primes R M).nonempty :=
+begin
+  obtain ⟨x, hx⟩ := exists_ne (0 : M),
+  obtain ⟨P, hP, _⟩ := exists_le_is_associated_prime_of_is_noetherian_ring R x hx,
+  exact ⟨P, hP⟩,
+end
+
+variables {R M}
+
+lemma is_associated_prime.annihilator_le (h : is_associated_prime I M) :
+  (⊤ : submodule R M).annihilator ≤ I :=
+begin
+  obtain ⟨hI, x, rfl⟩ := h,
+  exact submodule.annihilator_mono le_top,
+end
+
+lemma is_associated_prime.eq_radical (hI : I.is_primary) (h : is_associated_prime J (R ⧸ I)) :
+  J = I.radical :=
+begin
+  obtain ⟨hJ, x, e⟩ := h,
+  have : x ≠ 0,
+  { rintro rfl, apply hJ.1,
+    rwa [submodule.span_singleton_eq_bot.mpr rfl, submodule.annihilator_bot] at e },
+  obtain ⟨x, rfl⟩ := ideal.quotient.mkₐ_surjective R _ x,
+  replace e : ∀ {y}, y ∈ J ↔ x * y ∈ I,
+  { intro y, rw [e, submodule.mem_annihilator_span_singleton, ← map_smul, smul_eq_mul, mul_comm,
+      ideal.quotient.mkₐ_eq_mk, ← ideal.quotient.mk_eq_mk, submodule.quotient.mk_eq_zero] },
+  apply le_antisymm,
+  { intros y hy,
+    exact (hI.2 $ e.mp hy).resolve_left ((submodule.quotient.mk_eq_zero I).not.mp this) },
+  { rw hJ.radical_le_iff, intros y hy, exact e.mpr (I.mul_mem_left x hy) }
+end
+
+lemma associated_primes.eq_singleton_of_is_primary [is_noetherian_ring R] (hI : I.is_primary) :
+  associated_primes R (R ⧸ I) = {I.radical} :=
+begin
+  ext J,
+  rw [set.mem_singleton_iff],
+  refine ⟨is_associated_prime.eq_radical hI, _⟩,
+  rintro rfl,
+  haveI : nontrivial (R ⧸ I) := ⟨⟨(I^.quotient.mk : _) 1, (I^.quotient.mk : _) 0, _⟩⟩,
+  obtain ⟨a, ha⟩ := associated_primes.nonempty R (R ⧸ I),
+  exact ha.eq_radical hI ▸ ha,
+  rw [ne.def, ideal.quotient.eq, sub_zero, ← ideal.eq_top_iff_one],
+  exact hI.1
+end
diff --git a/src/ring_theory/ideal/operations.lean b/src/ring_theory/ideal/operations.lean
index c1c2e9edaab56..34eef05efe7f2 100644
--- a/src/ring_theory/ideal/operations.lean
+++ b/src/ring_theory/ideal/operations.lean
@@ -195,10 +195,6 @@ begin
   simpa
 end
 
-lemma span_smul_eq (r : R) (s : set M) : span R (r • s) = r • span R s :=
-by rw [← ideal_span_singleton_smul, span_smul_span, ←set.image2_eq_Union,
-    set.image2_singleton_left, set.image_smul]
-
 lemma mem_of_span_top_of_smul_mem (M' : submodule R M)
   (s : set R) (hs : ideal.span s = ⊤) (x : M) (H : ∀ r : s, (r : R) • x ∈ M') : x ∈ M' :=
 begin
diff --git a/src/ring_theory/ideal/quotient.lean b/src/ring_theory/ideal/quotient.lean
index c12b73e5d7ac6..4ddab13391a29 100644
--- a/src/ring_theory/ideal/quotient.lean
+++ b/src/ring_theory/ideal/quotient.lean
@@ -137,18 +137,25 @@ begin
            ⟨a, ha, by rw [← eq, sub_add_eq_sub_sub_swap, sub_self, zero_sub]; exact I.neg_mem hi⟩⟩
 end
 
-instance is_domain (I : ideal R) [hI : I.is_prime] : is_domain (R ⧸ I) :=
+instance no_zero_divisors (I : ideal R) [hI : I.is_prime] : no_zero_divisors (R ⧸ I) :=
 { eq_zero_or_eq_zero_of_mul_eq_zero := λ a b,
     quotient.induction_on₂' a b $ λ a b hab,
       (hI.mem_or_mem (eq_zero_iff_mem.1 hab)).elim
         (or.inl ∘ eq_zero_iff_mem.2)
-        (or.inr ∘ eq_zero_iff_mem.2),
-  .. quotient.nontrivial hI.1 }
+        (or.inr ∘ eq_zero_iff_mem.2) }
+
+instance is_domain (I : ideal R) [hI : I.is_prime] : is_domain (R ⧸ I) :=
+let _ := quotient.nontrivial hI.1 in by exactI no_zero_divisors.to_is_domain _
 
 lemma is_domain_iff_prime (I : ideal R) : is_domain (R ⧸ I) ↔ I.is_prime :=
-⟨ λ ⟨h1, h2⟩, by { haveI : nontrivial _ := ⟨h2⟩, exact ⟨zero_ne_one_iff.1 zero_ne_one, λ x y h,
-    by { simp only [←eq_zero_iff_mem, (mk I).map_mul] at ⊢ h, exact h1 h}⟩ },
-  λ h, by { resetI, apply_instance }⟩
+begin
+  refine ⟨λ H, ⟨zero_ne_one_iff.1 _, λ x y h, _⟩, λ h, by { resetI, apply_instance }⟩,
+  { haveI : nontrivial (R ⧸ I) := ⟨H.3⟩,
+    exact zero_ne_one },
+  { simp only [←eq_zero_iff_mem, (mk I).map_mul] at ⊢ h,
+    haveI := @is_domain.to_no_zero_divisors (R ⧸ I) _ H,
+    exact eq_zero_or_eq_zero_of_mul_eq_zero h }
+end
 
 lemma exists_inv {I : ideal R} [hI : I.is_maximal] :
   ∀ {a : (R ⧸ I)}, a ≠ 0 → ∃ b : (R ⧸ I), a * b = 1 :=
diff --git a/src/ring_theory/int/basic.lean b/src/ring_theory/int/basic.lean
index b457c9adad450..5b1ce2c369f36 100644
--- a/src/ring_theory/int/basic.lean
+++ b/src/ring_theory/int/basic.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Jens Wagemaker, Aaron Anderson
 -/
 import algebra.euclidean_domain.basic
-import data.nat.prime
+import data.nat.factors
 import ring_theory.coprime.basic
 import ring_theory.principal_ideal_domain
 
diff --git a/src/ring_theory/integral_domain.lean b/src/ring_theory/integral_domain.lean
index 13307294b3278..a1d2916417a8e 100644
--- a/src/ring_theory/integral_domain.lean
+++ b/src/ring_theory/integral_domain.lean
@@ -52,6 +52,31 @@ def fintype.group_with_zero_of_cancel (M : Type*) [cancel_monoid_with_zero M] [d
   ..‹nontrivial M›,
   ..‹cancel_monoid_with_zero M› }
 
+lemma exists_eq_pow_of_mul_eq_pow_of_coprime {R : Type*} [comm_semiring R] [is_domain R]
+  [gcd_monoid R] [unique Rˣ] {a b c : R} {n : ℕ} (cp : is_coprime a b) (h : a * b = c ^ n) :
+  ∃ d : R, a = d ^ n :=
+begin
+  refine exists_eq_pow_of_mul_eq_pow (is_unit_of_dvd_one _ _) h,
+  obtain ⟨x, y, hxy⟩ := cp,
+  rw [← hxy],
+  exact dvd_add (dvd_mul_of_dvd_right (gcd_dvd_left _ _) _)
+    (dvd_mul_of_dvd_right (gcd_dvd_right _ _) _)
+end
+
+lemma finset.exists_eq_pow_of_mul_eq_pow_of_coprime {ι R : Type*} [comm_semiring R] [is_domain R]
+  [gcd_monoid R] [unique Rˣ] {n : ℕ} {c : R} {s : finset ι} {f : ι → R}
+  (h : ∀ i j ∈ s, i ≠ j → is_coprime (f i) (f j))
+  (hprod : ∏ i in s, f i = c ^ n) : ∀ i ∈ s, ∃ d : R, f i = d ^ n :=
+begin
+  classical,
+  intros i hi,
+  rw [← insert_erase hi, prod_insert (not_mem_erase i s)] at hprod,
+  refine exists_eq_pow_of_mul_eq_pow_of_coprime
+    (is_coprime.prod_right (λ j hj, h i hi j (erase_subset i s hj) (λ hij, _))) hprod,
+  rw [hij] at hj,
+  exact (s.not_mem_erase _) hj
+end
+
 end cancel_monoid_with_zero
 
 variables {R : Type*} {G : Type*}
diff --git a/src/ring_theory/is_tensor_product.lean b/src/ring_theory/is_tensor_product.lean
index 2fea04cc7ff69..b939d0ea3c02a 100644
--- a/src/ring_theory/is_tensor_product.lean
+++ b/src/ring_theory/is_tensor_product.lean
@@ -220,7 +220,15 @@ variables {R M N S}
 
 /-- The base change of `M` along `R → S` is linearly equivalent to `S ⊗[R] M`. -/
 noncomputable
-def is_base_change.equiv : S ⊗[R] M ≃ₗ[R] N := h.equiv
+def is_base_change.equiv : S ⊗[R] M ≃ₗ[S] N :=
+{ map_smul' := λ r x, begin
+    change h.equiv (r • x) = r • h.equiv x,
+    apply tensor_product.induction_on x,
+    { rw [smul_zero, map_zero, smul_zero] },
+    { intros x y, simp [smul_tmul', algebra.of_id_apply] },
+    { intros x y hx hy, rw [map_add, smul_add, map_add, smul_add, hx, hy] },
+  end,
+  ..h.equiv }
 
 lemma is_base_change.equiv_tmul (s : S) (m : M) : h.equiv (s ⊗ₜ m) = s • (f m) :=
 tensor_product.lift.tmul s m
@@ -387,6 +395,18 @@ lemma algebra.is_pushout.comm :
 
 variables {R S R'}
 
+local attribute [instance] algebra.tensor_product.right_algebra
+
+instance tensor_product.is_pushout {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
+  [algebra R S] [algebra R T] :
+  algebra.is_pushout R S T (tensor_product R S T) :=
+⟨tensor_product.is_base_change R T S⟩
+
+instance tensor_product.is_pushout' {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
+  [algebra R S] [algebra R T] :
+  algebra.is_pushout R T S (tensor_product R S T) :=
+algebra.is_pushout.symm infer_instance
+
 /--
 If `S' = S ⊗[R] R'`, then any pair of `R`-algebra homomorphisms `f : S → A` and `g : R' → A`
 such that `f x` and `g y` commutes for all `x, y` descends to a (unique) homomoprhism `S' → A`.
diff --git a/src/ring_theory/local_properties.lean b/src/ring_theory/local_properties.lean
index 661aa666483e1..b862b968f5e37 100644
--- a/src/ring_theory/local_properties.lean
+++ b/src/ring_theory/local_properties.lean
@@ -417,7 +417,7 @@ begin
     by simp_rw [algebra.algebra_map_eq_smul_one, smul_assoc, one_smul],
   rw [← e, this] at hx₁,
   replace hx₁ := congr_arg (submodule.span R) hx₁,
-  rw submodule.span_smul_eq at hx₁,
+  rw submodule.span_smul at hx₁,
   replace hx : _ ∈ y' • submodule.span R (s : set S') := set.smul_mem_smul_set hx,
   rw hx₁ at hx,
   erw [← g.map_smul, ← submodule.map_span (g : S →ₗ[R] S')] at hx,
diff --git a/src/ring_theory/localization/basic.lean b/src/ring_theory/localization/basic.lean
index 1283dd6e3a0f7..aff3a6372c8cc 100644
--- a/src/ring_theory/localization/basic.lean
+++ b/src/ring_theory/localization/basic.lean
@@ -3,7 +3,7 @@ Copyright (c) 2018 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
 -/
-import algebra.algebra.basic
+import algebra.algebra.equiv
 import algebra.ring.equiv
 import group_theory.monoid_localization
 import ring_theory.ideal.basic
@@ -1050,13 +1050,13 @@ variables {S Q M}
 
 variables (A : Type*) [comm_ring A] [is_domain A]
 
-/-- A `comm_ring` `S` which is the localization of an integral domain `R` at a subset of
-non-zero elements is an integral domain.
+/-- A `comm_ring` `S` which is the localization of a ring `R` without zero divisors at a subset of
+non-zero elements does not have zero divisors.
 See note [reducible non-instances]. -/
 @[reducible]
-theorem is_domain_of_le_non_zero_divisors
+theorem no_zero_divisors_of_le_non_zero_divisors
   [algebra A S] {M : submonoid A} [is_localization M S]
-  (hM : M ≤ non_zero_divisors A) : is_domain S :=
+  (hM : M ≤ non_zero_divisors A) : no_zero_divisors S :=
 { eq_zero_or_eq_zero_of_mul_eq_zero :=
     begin
       intros z w h,
@@ -1069,9 +1069,21 @@ theorem is_domain_of_le_non_zero_divisors
       cases eq_zero_or_eq_zero_of_mul_eq_zero ((to_map_eq_zero_iff S hM).mp this.symm) with H H,
       { exact or.inl (eq_zero_of_fst_eq_zero hx H) },
       { exact or.inr (eq_zero_of_fst_eq_zero hy H) },
-    end,
-  exists_pair_ne := ⟨(algebra_map A S) 0, (algebra_map A S) 1,
-                     λ h, zero_ne_one (is_localization.injective S hM h)⟩, }
+    end }
+
+/-- A `comm_ring` `S` which is the localization of an integral domain `R` at a subset of
+non-zero elements is an integral domain.
+See note [reducible non-instances]. -/
+@[reducible]
+theorem is_domain_of_le_non_zero_divisors
+  [algebra A S] {M : submonoid A} [is_localization M S]
+  (hM : M ≤ non_zero_divisors A) : is_domain S :=
+begin
+  apply no_zero_divisors.to_is_domain _,
+  { exact ⟨⟨(algebra_map A S) 0, (algebra_map A S) 1,
+                      λ h, zero_ne_one (is_localization.injective S hM h)⟩⟩ },
+  { exact no_zero_divisors_of_le_non_zero_divisors _ hM }
+end
 
 variables {A}
 
diff --git a/src/ring_theory/localization/fraction_ring.lean b/src/ring_theory/localization/fraction_ring.lean
index f31ab35a51224..44078b93fb171 100644
--- a/src/ring_theory/localization/fraction_ring.lean
+++ b/src/ring_theory/localization/fraction_ring.lean
@@ -116,10 +116,14 @@ local attribute [semireducible] is_fraction_ring.inv
 
 protected lemma mul_inv_cancel (x : K) (hx : x ≠ 0) :
   x * is_fraction_ring.inv A x = 1 :=
-show x * dite _ _ _ = 1, by rw [dif_neg hx,
-  ←is_unit.mul_left_inj (map_units K ⟨(sec _ x).1, mem_non_zero_divisors_iff_ne_zero.2 $
-    λ h0, hx $ eq_zero_of_fst_eq_zero (sec_spec (non_zero_divisors A) x) h0⟩),
-  one_mul, mul_assoc, mk'_spec, ←eq_mk'_iff_mul_eq]; exact (mk'_sec _ x).symm
+show x * dite _ _ _ = 1, begin
+  rw [dif_neg hx, ←is_unit.mul_left_inj
+    (map_units K ⟨(sec _ x).1, mem_non_zero_divisors_iff_ne_zero.2 $
+      λ h0, hx $ eq_zero_of_fst_eq_zero (sec_spec (non_zero_divisors A) x) h0⟩),
+    one_mul, mul_assoc],
+  rw [mk'_spec, ←eq_mk'_iff_mul_eq],
+  exact (mk'_sec _ x).symm
+end
 
 /-- A `comm_ring` `K` which is the localization of an integral domain `R` at `R - {0}` is a field.
 See note [reducible non-instances]. -/
diff --git a/src/ring_theory/multiplicity.lean b/src/ring_theory/multiplicity.lean
index e48057423a0f9..fe9116d68cdc9 100644
--- a/src/ring_theory/multiplicity.lean
+++ b/src/ring_theory/multiplicity.lean
@@ -145,8 +145,8 @@ end
 @[simp] lemma unit_left (a : α) (u : αˣ) : multiplicity (u : α) a = ⊤ :=
 is_unit_left a u.is_unit
 
-lemma multiplicity_eq_zero_of_not_dvd {a b : α} (ha : ¬a ∣ b) : multiplicity a b = 0 :=
-by { rw [← nat.cast_zero, eq_coe_iff], simpa }
+lemma multiplicity_eq_zero {a b : α} : multiplicity a b = 0 ↔  ¬a ∣ b :=
+by { rw [← nat.cast_zero, eq_coe_iff], simp }
 
 lemma eq_top_iff_not_finite {a b : α} : multiplicity a b = ⊤ ↔ ¬ finite a b :=
 part.eq_none_iff'
@@ -274,10 +274,7 @@ variable [decidable_rel ((∣) : α → α → Prop)]
 part.eq_none_iff.2 (λ n ⟨⟨k, hk⟩, _⟩, hk (dvd_zero _))
 
 @[simp] lemma multiplicity_zero_eq_zero_of_ne_zero (a : α) (ha : a ≠ 0) : multiplicity 0 a = 0 :=
-begin
-  apply multiplicity.multiplicity_eq_zero_of_not_dvd,
-  rwa zero_dvd_iff,
-end
+multiplicity.multiplicity_eq_zero.2 $ mt zero_dvd_iff.1 ha
 
 end monoid_with_zero
 
diff --git a/src/ring_theory/noetherian.lean b/src/ring_theory/noetherian.lean
index 7842127fa5590..2e59f4a21cb44 100644
--- a/src/ring_theory/noetherian.lean
+++ b/src/ring_theory/noetherian.lean
@@ -352,7 +352,7 @@ theorem is_noetherian.exists_endomorphism_iterate_ker_inf_range_eq_bot
 begin
   obtain ⟨n, w⟩ := monotone_stabilizes_iff_noetherian.mpr I
     (f.iterate_ker.comp ⟨λ n, n+1, λ n m w, by linarith⟩),
-  specialize w (2 * n + 1) (by linarith),
+  specialize w (2 * n + 1) (by linarith only),
   dsimp at w,
   refine ⟨n+1, nat.succ_ne_zero _, _⟩,
   rw eq_bot_iff,
@@ -362,7 +362,7 @@ begin
   change ((f ^ (n + 1)) * (f ^ (n + 1))) y = 0 at h,
   rw ←pow_add at h,
   convert h using 3,
-  linarith,
+  ring
 end
 
 /-- Any surjective endomorphism of a Noetherian module is injective. -/
diff --git a/src/ring_theory/perfection.lean b/src/ring_theory/perfection.lean
index 0fb01b89d89cd..61ace5ec6eb22 100644
--- a/src/ring_theory/perfection.lean
+++ b/src/ring_theory/perfection.lean
@@ -550,11 +550,13 @@ end
 end classical
 
 instance : is_domain (pre_tilt K v O hv p) :=
-{ exists_pair_ne := (char_p.nontrivial_of_char_ne_one hp.1.ne_one).1,
-  eq_zero_or_eq_zero_of_mul_eq_zero := λ f g hfg,
+begin
+  haveI : nontrivial (pre_tilt K v O hv p) := ⟨(char_p.nontrivial_of_char_ne_one hp.1.ne_one).1⟩,
+  haveI : no_zero_divisors (pre_tilt K v O hv p) := ⟨λ f g hfg,
     by { simp_rw ← map_eq_zero at hfg ⊢, contrapose! hfg, rw valuation.map_mul,
-      exact mul_ne_zero hfg.1 hfg.2 },
-  .. (infer_instance : comm_ring (pre_tilt K v O hv p)) }
+    exact mul_ne_zero hfg.1 hfg.2 }⟩,
+  exact no_zero_divisors.to_is_domain _
+end
 
 end pre_tilt
 
diff --git a/src/ring_theory/polynomial/basic.lean b/src/ring_theory/polynomial/basic.lean
index ad85317af1e09..6a863a33dcc0f 100644
--- a/src/ring_theory/polynomial/basic.lean
+++ b/src/ring_theory/polynomial/basic.lean
@@ -1039,8 +1039,11 @@ end⟩
 
 /-- The multivariate polynomial ring over an integral domain is an integral domain. -/
 instance {R : Type u} {σ : Type v} [comm_ring R] [is_domain R] : is_domain (mv_polynomial σ R) :=
-{ .. mv_polynomial.no_zero_divisors,
-  .. add_monoid_algebra.nontrivial }
+begin
+  apply no_zero_divisors.to_is_domain _,
+  exact add_monoid_algebra.nontrivial,
+  exact mv_polynomial.no_zero_divisors
+end
 
 lemma map_mv_polynomial_eq_eval₂ {S : Type*} [comm_ring S] [finite σ]
   (ϕ : mv_polynomial σ R →+* S) (p : mv_polynomial σ R) :
diff --git a/src/ring_theory/polynomial/chebyshev.lean b/src/ring_theory/polynomial/chebyshev.lean
index 568cf21e85310..8c7094a4cc3d3 100644
--- a/src/ring_theory/polynomial/chebyshev.lean
+++ b/src/ring_theory/polynomial/chebyshev.lean
@@ -185,10 +185,10 @@ begin
   have h : derivative (T R (n + 2)) = (U R (n + 1) - X * U R n) + X * derivative (T R (n + 1))
                                       + 2 * X * U R n - (1 - X ^ 2) * derivative (U R n),
   { conv_lhs { rw T_eq_X_mul_T_sub_pol_U },
-  simp only [derivative_sub, derivative_mul, derivative_X, derivative_one, derivative_X_pow,
-  one_mul, T_derivative_eq_U],
-  rw [T_eq_U_sub_X_mul_U, nat.cast_bit0, nat.cast_one],
-  ring },
+    simp only [derivative_sub, derivative_mul, derivative_X, derivative_one, derivative_X_pow,
+              one_mul, T_derivative_eq_U],
+    rw [T_eq_U_sub_X_mul_U, C_eq_nat_cast, nat.cast_bit0, nat.cast_one],
+    ring },
   calc ((n : R[X]) + 1) * T R (n + 1)
       = ((n : R[X]) + 1 + 1) * (X * U R n + T R (n + 1))
         - X * ((n + 1) * U R n) - (X * U R n + T R (n + 1)) : by ring
diff --git a/src/ring_theory/power_series/basic.lean b/src/ring_theory/power_series/basic.lean
index cebc6b129f809..e512ad9a7cc90 100644
--- a/src/ring_theory/power_series/basic.lean
+++ b/src/ring_theory/power_series/basic.lean
@@ -1443,10 +1443,10 @@ rescale_neg_one_X
 end comm_ring
 
 section domain
-variables [ring R] [is_domain R]
+variables [ring R]
 
-lemma eq_zero_or_eq_zero_of_mul_eq_zero (φ ψ : power_series R) (h : φ * ψ = 0) :
-  φ = 0 ∨ ψ = 0 :=
+lemma eq_zero_or_eq_zero_of_mul_eq_zero [no_zero_divisors R] (φ ψ : power_series R)
+  (h : φ * ψ = 0) : φ = 0 ∨ ψ = 0 :=
 begin
   rw or_iff_not_imp_left, intro H,
   have ex : ∃ m, coeff R m φ ≠ 0, { contrapose! H, exact ext H },
@@ -1474,9 +1474,11 @@ begin
   { contrapose!, intro h, rw finset.nat.mem_antidiagonal }
 end
 
-instance : is_domain (power_series R) :=
-{ eq_zero_or_eq_zero_of_mul_eq_zero := eq_zero_or_eq_zero_of_mul_eq_zero,
-  .. power_series.nontrivial, }
+instance [no_zero_divisors R] : no_zero_divisors (power_series R) :=
+{ eq_zero_or_eq_zero_of_mul_eq_zero := eq_zero_or_eq_zero_of_mul_eq_zero }
+
+instance [is_domain R] : is_domain (power_series R) :=
+no_zero_divisors.to_is_domain _
 
 end domain
 
diff --git a/src/ring_theory/ring_hom/finite.lean b/src/ring_theory/ring_hom/finite.lean
index a42d5a5ea96bc..3959d106f125f 100644
--- a/src/ring_theory/ring_hom/finite.lean
+++ b/src/ring_theory/ring_hom/finite.lean
@@ -32,8 +32,9 @@ end
 lemma finite_stable_under_base_change :
   stable_under_base_change @finite :=
 begin
+  refine stable_under_base_change.mk _ finite_respects_iso _,
   classical,
-  introv R h,
+  introv h,
   resetI,
   replace h : module.finite R T := by { convert h, ext, rw algebra.smul_def, refl },
   suffices : module.finite S (S ⊗[R] T),
diff --git a/src/ring_theory/ring_hom/integral.lean b/src/ring_theory/ring_hom/integral.lean
index 35bd3121d5601..09c56649a2549 100644
--- a/src/ring_theory/ring_hom/integral.lean
+++ b/src/ring_theory/ring_hom/integral.lean
@@ -34,7 +34,8 @@ end
 lemma is_integral_stable_under_base_change :
   stable_under_base_change (λ R S _ _ f, by exactI f.is_integral) :=
 begin
-  introv R h x,
+  refine stable_under_base_change.mk _ is_integral_respects_iso _,
+  introv h x,
   resetI,
   apply tensor_product.induction_on x,
   { apply is_integral_zero },
diff --git a/src/ring_theory/ring_hom/surjective.lean b/src/ring_theory/ring_hom/surjective.lean
index b5d723521a090..a2687a5774905 100644
--- a/src/ring_theory/ring_hom/surjective.lean
+++ b/src/ring_theory/ring_hom/surjective.lean
@@ -35,10 +35,10 @@ end
 lemma surjective_stable_under_base_change :
   stable_under_base_change surjective :=
 begin
+  refine stable_under_base_change.mk _ surjective_respects_iso _,
   classical,
-  introv R h,
+  introv h x,
   resetI,
-  intro x,
   induction x using tensor_product.induction_on with x y x y ex ey,
   { exact ⟨0, map_zero _⟩ },
   { obtain ⟨y, rfl⟩ := h y, use y • x, dsimp,
diff --git a/src/ring_theory/ring_hom_properties.lean b/src/ring_theory/ring_hom_properties.lean
index 019209c051f6c..5799d9d7ea037 100644
--- a/src/ring_theory/ring_hom_properties.lean
+++ b/src/ring_theory/ring_hom_properties.lean
@@ -7,6 +7,7 @@ import algebra.category.Ring.constructions
 import algebra.category.Ring.colimits
 import category_theory.isomorphism
 import ring_theory.localization.away
+import ring_theory.is_tensor_product
 
 /-!
 # Properties of ring homomorphisms
@@ -106,9 +107,45 @@ section stable_under_base_change
 /-- A morphism property `P` is `stable_under_base_change` if `P(S →+* A)` implies
 `P(B →+* A ⊗[S] B)`. -/
 def stable_under_base_change : Prop :=
-  ∀ ⦃R S T⦄ [comm_ring R] [comm_ring S] [comm_ring T], by exactI ∀ [algebra R S] [algebra R T],
-    by exactI (P (algebra_map R T) →
-      P (algebra.tensor_product.include_left.to_ring_hom : S →+* tensor_product R S T))
+  ∀ (R S R' S') [comm_ring R] [comm_ring S] [comm_ring R'] [comm_ring S'],
+    by exactI ∀ [algebra R S] [algebra R R'] [algebra R S'] [algebra S S'] [algebra R' S'],
+    by exactI ∀ [is_scalar_tower R S S'] [is_scalar_tower R R' S'],
+    by exactI ∀ [algebra.is_pushout R S R' S'], P (algebra_map R S) → P (algebra_map R' S')
+
+lemma stable_under_base_change.mk
+  (h₁ : respects_iso @P)
+  (h₂ : ∀ ⦃R S T⦄ [comm_ring R] [comm_ring S] [comm_ring T],
+    by exactI ∀ [algebra R S] [algebra R T], by exactI (P (algebra_map R T) →
+      P (algebra.tensor_product.include_left.to_ring_hom : S →+* tensor_product R S T))) :
+  stable_under_base_change @P :=
+begin
+  introv R h H,
+  resetI,
+  let e := h.symm.1.equiv,
+  let f' := algebra.tensor_product.product_map (is_scalar_tower.to_alg_hom R R' S')
+    (is_scalar_tower.to_alg_hom R S S'),
+  have : ∀ x, e x = f' x,
+  { intro x,
+    change e.to_linear_map.restrict_scalars R x = f'.to_linear_map x,
+    congr' 1,
+    apply tensor_product.ext',
+    intros x y,
+    simp [is_base_change.equiv_tmul, algebra.smul_def] },
+  convert h₁.1 _ _ (h₂ H : P (_ : R' →+* _)),
+  swap,
+  { refine { map_mul' := λ x y, _, ..e },
+    change e (x * y) = e x * e y,
+    simp_rw this,
+    exact map_mul f' _ _ },
+  { ext,
+    change _ = e (x ⊗ₜ[R] 1),
+    dsimp only [e],
+    rw [h.symm.1.equiv_tmul, algebra.smul_def, alg_hom.to_linear_map_apply, map_one, mul_one] }
+end
+
+omit P
+
+local attribute [instance] algebra.tensor_product.right_algebra
 
 lemma stable_under_base_change.pushout_inl
   (hP : ring_hom.stable_under_base_change @P) (hP' : ring_hom.respects_iso @P) {R S T : CommRing}
@@ -116,7 +153,10 @@ lemma stable_under_base_change.pushout_inl
 begin
   rw [← (show _ = pushout.inl, from colimit.iso_colimit_cocone_ι_inv
     ⟨_, CommRing.pushout_cocone_is_colimit f g⟩ walking_span.left), hP'.cancel_right_is_iso],
-  apply hP,
+  letI := f.to_algebra,
+  letI := g.to_algebra,
+  dsimp only [CommRing.pushout_cocone_inl, pushout_cocone.ι_app_left],
+  apply hP R T S (tensor_product R S T),
   exact H,
 end
 
diff --git a/src/ring_theory/roots_of_unity.lean b/src/ring_theory/roots_of_unity.lean
index faf184ea41bff..220abd647157c 100644
--- a/src/ring_theory/roots_of_unity.lean
+++ b/src/ring_theory/roots_of_unity.lean
@@ -570,6 +570,10 @@ begin
   { exact ne_zero.of_not_dvd R hp }
 end
 
+lemma mem_nth_roots_finset (hζ : is_primitive_root ζ k) (hk : 0 < k) :
+  ζ ∈ nth_roots_finset k R :=
+(mem_nth_roots_finset hk).2 hζ.pow_eq_one
+
 end is_domain
 
 section is_domain
diff --git a/src/ring_theory/subring/basic.lean b/src/ring_theory/subring/basic.lean
index bf784d0fff7fd..44a1a9fb8c92f 100644
--- a/src/ring_theory/subring/basic.lean
+++ b/src/ring_theory/subring/basic.lean
@@ -108,7 +108,7 @@ subtype.coe_injective.comm_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, r
 /-- A subring of a domain is a domain. -/
 @[priority 75] -- Prefer subclasses of `ring` over subclasses of `subring_class`.
 instance {R} [ring R] [is_domain R] [set_like S R] [subring_class S R] : is_domain s :=
-{ .. subsemiring_class.nontrivial s, .. subsemiring_class.no_zero_divisors s }
+no_zero_divisors.to_is_domain _
 
 /-- A subring of an `ordered_ring` is an `ordered_ring`. -/
 @[priority 75] -- Prefer subclasses of `ring` over subclasses of `subring_class`.
@@ -381,7 +381,7 @@ s.to_subsemiring.no_zero_divisors
 
 /-- A subring of a domain is a domain. -/
 instance {R} [ring R] [is_domain R] (s : subring R) : is_domain s :=
-{ .. s.nontrivial, .. s.no_zero_divisors, .. s.to_ring }
+no_zero_divisors.to_is_domain _
 
 /-- A subring of an `ordered_ring` is an `ordered_ring`. -/
 instance to_ordered_ring {R} [ordered_ring R] (s : subring R) : ordered_ring s :=
@@ -935,6 +935,9 @@ range_top_iff_surjective.2 hf
 def eq_locus (f g : R →+* S) : subring R :=
 { carrier := {x | f x = g x}, .. (f : R →* S).eq_mlocus g, .. (f : R →+ S).eq_locus g }
 
+@[simp] lemma eq_locus_same (f : R →+* S) : f.eq_locus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 /-- If two ring homomorphisms are equal on a set, then they are equal on its subring closure. -/
 lemma eq_on_set_closure {f g : R →+* S} {s : set R} (h : set.eq_on f g s) :
   set.eq_on f g (closure s) :=
diff --git a/src/ring_theory/subring/pointwise.lean b/src/ring_theory/subring/pointwise.lean
index efa8ede645967..f5882efd1fd8f 100644
--- a/src/ring_theory/subring/pointwise.lean
+++ b/src/ring_theory/subring/pointwise.lean
@@ -62,6 +62,12 @@ lemma mem_smul_pointwise_iff_exists (m : M) (r : R) (S : subring R) :
   r ∈ m • S ↔ ∃ (s : R), s ∈ S ∧ m • s = r :=
 (set.mem_smul_set : r ∈ m • (S : set R) ↔ _)
 
+@[simp] lemma smul_bot (a : M) : a • (⊥ : subring R) = ⊥ := map_bot _
+lemma smul_sup (a : M) (S T : subring R) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+lemma smul_closure (a : M) (s : set R) : a • closure s = closure (a • s) :=
+ring_hom.map_closure _ _
+
 instance pointwise_central_scalar [mul_semiring_action Mᵐᵒᵖ R] [is_central_scalar M R] :
   is_central_scalar M (subring R) :=
 ⟨λ a S, congr_arg (λ f, S.map f) $ ring_hom.ext $ by exact op_smul_eq_smul _⟩
diff --git a/src/ring_theory/subsemiring/basic.lean b/src/ring_theory/subsemiring/basic.lean
index 76063edf304e2..e55183cc3e227 100644
--- a/src/ring_theory/subsemiring/basic.lean
+++ b/src/ring_theory/subsemiring/basic.lean
@@ -917,6 +917,9 @@ srange_top_iff_surjective.2 hf
 def eq_slocus (f g : R →+* S) : subsemiring R :=
 { carrier := {x | f x = g x}, .. (f : R →* S).eq_mlocus g, .. (f : R →+ S).eq_mlocus g }
 
+@[simp] lemma eq_slocus_same (f : R →+* S) : f.eq_slocus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 /-- If two ring homomorphisms are equal on a set, then they are equal on its subsemiring closure. -/
 lemma eq_on_sclosure {f g : R →+* S} {s : set R} (h : set.eq_on f g s) :
   set.eq_on f g (closure s) :=
diff --git a/src/ring_theory/subsemiring/pointwise.lean b/src/ring_theory/subsemiring/pointwise.lean
index 20f8e1d8eb845..4ac6690cf4c33 100644
--- a/src/ring_theory/subsemiring/pointwise.lean
+++ b/src/ring_theory/subsemiring/pointwise.lean
@@ -58,6 +58,12 @@ lemma mem_smul_pointwise_iff_exists (m : M) (r : R) (S : subsemiring R) :
   r ∈ m • S ↔ ∃ (s : R), s ∈ S ∧ m • s = r :=
 (set.mem_smul_set : r ∈ m • (S : set R) ↔ _)
 
+@[simp] lemma smul_bot (a : M) : a • (⊥ : subsemiring R) = ⊥ := map_bot _
+lemma smul_sup (a : M) (S T : subsemiring R) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+lemma smul_closure (a : M) (s : set R) : a • closure s = closure (a • s) :=
+ring_hom.map_sclosure _ _
+
 instance pointwise_central_scalar [mul_semiring_action Mᵐᵒᵖ R] [is_central_scalar M R] :
   is_central_scalar M (subsemiring R) :=
 ⟨λ a S, congr_arg (λ f, S.map f) $ ring_hom.ext $ by exact op_smul_eq_smul _⟩
diff --git a/src/ring_theory/tensor_product.lean b/src/ring_theory/tensor_product.lean
index 8f9bb03eb1aa5..19dfcb2c94568 100644
--- a/src/ring_theory/tensor_product.lean
+++ b/src/ring_theory/tensor_product.lean
@@ -489,6 +489,20 @@ instance : comm_ring (A ⊗[R] B) :=
   end
   .. (by apply_instance : ring (A ⊗[R] B)) }.
 
+section right_algebra
+
+/-- `S ⊗[R] T` has a `T`-algebra structure. This is not a global instance or else the action of
+`S` on `S ⊗[R] S` would be ambiguous. -/
+@[reducible] def right_algebra : algebra B (A ⊗[R] B) :=
+(algebra.tensor_product.include_right.to_ring_hom : B →+* A ⊗[R] B).to_algebra
+
+local attribute [instance] tensor_product.right_algebra
+
+instance right_is_scalar_tower : is_scalar_tower R B (A ⊗[R] B) :=
+is_scalar_tower.of_algebra_map_eq (λ r, (algebra.tensor_product.include_right.commutes r).symm)
+
+end right_algebra
+
 end comm_ring
 
 /--
diff --git a/src/ring_theory/valuation/integral.lean b/src/ring_theory/valuation/integral.lean
index 50ed4e6f915fe..4969e3647a99a 100644
--- a/src/ring_theory/valuation/integral.lean
+++ b/src/ring_theory/valuation/integral.lean
@@ -34,7 +34,7 @@ let ⟨p, hpm, hpx⟩ := hx in le_of_not_lt $ λ (hvx : 1 < v x), begin
   rw [hpm.as_sum, eval₂_add, eval₂_pow, eval₂_X, eval₂_finset_sum, add_eq_zero_iff_eq_neg] at hpx,
   replace hpx := congr_arg v hpx, refine ne_of_gt _ hpx,
   rw [v.map_neg, v.map_pow],
-  refine v.map_sum_lt' (zero_lt_one₀.trans_le (one_le_pow_of_one_le' hvx.le _)) (λ i hi, _),
+  refine v.map_sum_lt' (zero_lt_one.trans_le (one_le_pow_of_one_le' hvx.le _)) (λ i hi, _),
   rw [eval₂_mul, eval₂_pow, eval₂_C, eval₂_X, v.map_mul, v.map_pow, ← one_mul (v x ^ p.nat_degree)],
   cases (hv.2 $ p.coeff i).lt_or_eq with hvpi hvpi,
   { exact mul_lt_mul₀ hvpi (pow_lt_pow₀ hvx $ finset.mem_range.1 hi) },
diff --git a/src/ring_theory/valuation/valuation_subring.lean b/src/ring_theory/valuation/valuation_subring.lean
index 130751a47417a..5c5257f1ee706 100644
--- a/src/ring_theory/valuation/valuation_subring.lean
+++ b/src/ring_theory/valuation/valuation_subring.lean
@@ -515,7 +515,7 @@ def principal_unit_group : subgroup Kˣ :=
       ← valuation.map_mul, mul_sub_one, ← sub_add_sub_cancel],
     exact A.valuation.map_add _ _,
   end,
-  one_mem' := by simpa using zero_lt_one₀,
+  one_mem' := by simp,
   inv_mem' := begin
     dsimp,
     intros a ha,
diff --git a/src/ring_theory/witt_vector/domain.lean b/src/ring_theory/witt_vector/domain.lean
index 2f908ee64d019..356d1f0532bd6 100644
--- a/src/ring_theory/witt_vector/domain.lean
+++ b/src/ring_theory/witt_vector/domain.lean
@@ -114,7 +114,6 @@ instance [char_p R p] [no_zero_divisors R] : no_zero_divisors (𝕎 R) :=
 end⟩
 
 instance [char_p R p] [is_domain R] : is_domain (𝕎 R) :=
-{ ..witt_vector.no_zero_divisors,
-  ..witt_vector.nontrivial }
+no_zero_divisors.to_is_domain _
 
 end witt_vector
diff --git a/src/set_theory/cardinal/basic.lean b/src/set_theory/cardinal/basic.lean
index eb86eb362cc4e..cd08ffaf3e447 100644
--- a/src/set_theory/cardinal/basic.lean
+++ b/src/set_theory/cardinal/basic.lean
@@ -471,9 +471,6 @@ instance : canonically_ordered_comm_semiring cardinal.{u} :=
     by simpa only [mul_def, mk_eq_zero_iff, is_empty_prod] using id,
   ..cardinal.comm_semiring, ..cardinal.partial_order }
 
-@[simp] theorem zero_lt_one : (0 : cardinal) < 1 :=
-lt_of_le_of_ne (zero_le _) zero_ne_one
-
 lemma zero_power_le (c : cardinal.{u}) : (0 : cardinal.{u}) ^ c ≤ 1 :=
 by { by_cases h : c = 0, rw [h, power_zero], rw [zero_power h], apply zero_le }
 
@@ -615,6 +612,13 @@ lemma mk_le_mk_mul_of_mk_preimage_le {c : cardinal} (f : α → β) (hf : ∀ b
 by simpa only [←mk_congr (@equiv.sigma_fiber_equiv α β f), mk_sigma, ←sum_const']
   using sum_le_sum _ _ hf
 
+lemma lift_mk_le_lift_mk_mul_of_lift_mk_preimage_le {α : Type u} {β : Type v} {c : cardinal}
+  (f : α → β) (hf : ∀ b : β, lift.{v} #(f ⁻¹' {b}) ≤ c) :
+  lift.{v} #α ≤ lift.{u} #β * c :=
+mk_le_mk_mul_of_mk_preimage_le (λ x : ulift.{v} α, ulift.up.{u} (f x.1)) $ ulift.forall.2 $ λ b,
+  (mk_congr $ (equiv.ulift.image _).trans (equiv.trans
+    (by { rw [equiv.image_eq_preimage], simp [set.preimage] }) equiv.ulift.symm)).trans_le (hf b)
+
 /-- The range of an indexed cardinal function, whose outputs live in a higher universe than the
     inputs, is always bounded above. -/
 theorem bdd_above_range {ι : Type u} (f : ι → cardinal.{max u v}) : bdd_above (set.range f) :=
@@ -1099,9 +1103,21 @@ denumerable_iff.1 ⟨‹_›⟩
 
 lemma aleph_0_mul_aleph_0 : ℵ₀ * ℵ₀ = ℵ₀ := mk_denumerable _
 
+@[simp] lemma nat_mul_aleph_0 {n : ℕ} (hn : n ≠ 0) : ↑n * ℵ₀ = ℵ₀ :=
+le_antisymm (lift_mk_fin n ▸ mk_le_aleph_0) $ le_mul_of_one_le_left (zero_le _) $
+  by rwa [← nat.cast_one, nat_cast_le, nat.one_le_iff_ne_zero]
+
+@[simp] lemma aleph_0_mul_nat {n : ℕ} (hn : n ≠ 0) : ℵ₀ * n = ℵ₀ :=
+by rw [mul_comm, nat_mul_aleph_0 hn]
+
 @[simp] lemma add_le_aleph_0 {c₁ c₂ : cardinal} : c₁ + c₂ ≤ ℵ₀ ↔ c₁ ≤ ℵ₀ ∧ c₂ ≤ ℵ₀ :=
 ⟨λ h, ⟨le_self_add.trans h, le_add_self.trans h⟩, λ h, aleph_0_add_aleph_0 ▸ add_le_add h.1 h.2⟩
 
+@[simp] lemma aleph_0_add_nat (n : ℕ) : ℵ₀ + n = ℵ₀ :=
+(add_le_aleph_0.2 ⟨le_rfl, (nat_lt_aleph_0 n).le⟩).antisymm le_self_add
+
+@[simp] lemma nat_add_aleph_0 (n : ℕ) : ↑n + ℵ₀ = ℵ₀ := by rw [add_comm, aleph_0_add_nat]
+
 /-- This function sends finite cardinals to the corresponding natural, and infinite cardinals
   to 0. -/
 def to_nat : zero_hom cardinal ℕ :=
diff --git a/src/set_theory/cardinal/ordinal.lean b/src/set_theory/cardinal/ordinal.lean
index 4d3ef1aaef7c7..208a28970e325 100644
--- a/src/set_theory/cardinal/ordinal.lean
+++ b/src/set_theory/cardinal/ordinal.lean
@@ -509,6 +509,9 @@ begin
   convert mul_le_mul_left' (one_le_iff_ne_zero.mpr h') _, rw [mul_one],
 end
 
+lemma mul_le_max_of_aleph_0_le_right {a b : cardinal} (h : ℵ₀ ≤ b) : a * b ≤ max a b :=
+by simpa only [mul_comm, max_comm] using mul_le_max_of_aleph_0_le_left h
+
 lemma mul_eq_max_of_aleph_0_le_right {a b : cardinal} (h' : a ≠ 0) (h : ℵ₀ ≤ b) : a * b = max a b :=
 begin
   rw [mul_comm, max_comm],
diff --git a/src/set_theory/game/basic.lean b/src/set_theory/game/basic.lean
index e68c2d903471c..5becb01f79721 100644
--- a/src/set_theory/game/basic.lean
+++ b/src/set_theory/game/basic.lean
@@ -603,7 +603,7 @@ theorem inv_eq_of_lf_zero {x : pgame} (h : x ⧏ 0) : x⁻¹ = -inv' (-x) :=
 
 /-- `1⁻¹` has exactly the same moves as `1`. -/
 def inv_one : 1⁻¹ ≡r 1 :=
-by { rw inv_eq_of_pos zero_lt_one, exact inv'_one }
+by { rw inv_eq_of_pos pgame.zero_lt_one, exact inv'_one }
 
 theorem inv_one_equiv : 1⁻¹ ≈ 1 := inv_one.equiv
 
diff --git a/src/set_theory/game/nim.lean b/src/set_theory/game/nim.lean
index 97f04116f4c21..64a8e2d305989 100644
--- a/src/set_theory/game/nim.lean
+++ b/src/set_theory/game/nim.lean
@@ -124,19 +124,19 @@ noncomputable instance unique_nim_one_right_moves : unique (nim 1).right_moves :
 (equiv.cast $ right_moves_nim 1).unique
 
 @[simp] theorem default_nim_one_left_moves_eq :
-  (default : (nim 1).left_moves) = @to_left_moves_nim 1 ⟨0, ordinal.zero_lt_one⟩ :=
+  (default : (nim 1).left_moves) = @to_left_moves_nim 1 ⟨0, zero_lt_one⟩ :=
 rfl
 
 @[simp] theorem default_nim_one_right_moves_eq :
-  (default : (nim 1).right_moves) = @to_right_moves_nim 1 ⟨0, ordinal.zero_lt_one⟩ :=
+  (default : (nim 1).right_moves) = @to_right_moves_nim 1 ⟨0, zero_lt_one⟩ :=
 rfl
 
 @[simp] theorem to_left_moves_nim_one_symm (i) :
-  (@to_left_moves_nim 1).symm i = ⟨0, ordinal.zero_lt_one⟩ :=
+  (@to_left_moves_nim 1).symm i = ⟨0, zero_lt_one⟩ :=
 by simp
 
 @[simp] theorem to_right_moves_nim_one_symm (i) :
-  (@to_right_moves_nim 1).symm i = ⟨0, ordinal.zero_lt_one⟩ :=
+  (@to_right_moves_nim 1).symm i = ⟨0, zero_lt_one⟩ :=
 by simp
 
 theorem nim_one_move_left (x) : (nim 1).move_left x = nim 0 :=
diff --git a/src/set_theory/game/pgame.lean b/src/set_theory/game/pgame.lean
index 061e61c787aad..3c9a085d0633f 100644
--- a/src/set_theory/game/pgame.lean
+++ b/src/set_theory/game/pgame.lean
@@ -1361,12 +1361,12 @@ theorem star_fuzzy_zero : star ‖ 0 :=
 @[simp] theorem neg_star : -star = star :=
 by simp [star]
 
-@[simp] theorem zero_lt_one : (0 : pgame) < 1 :=
+@[simp] protected theorem zero_lt_one : (0 : pgame) < 1 :=
 lt_of_le_of_lf (zero_le_of_is_empty_right_moves 1) (zero_lf_le.2 ⟨default, le_rfl⟩)
 
-instance : zero_le_one_class pgame := ⟨zero_lt_one.le⟩
+instance : zero_le_one_class pgame := ⟨pgame.zero_lt_one.le⟩
 
 @[simp] theorem zero_lf_one : (0 : pgame) ⧏ 1 :=
-zero_lt_one.lf
+pgame.zero_lt_one.lf
 
 end pgame
diff --git a/src/set_theory/ordinal/basic.lean b/src/set_theory/ordinal/basic.lean
index ee7f435c20c61..6c36f67c2e29f 100644
--- a/src/set_theory/ordinal/basic.lean
+++ b/src/set_theory/ordinal/basic.lean
@@ -284,9 +284,9 @@ protected theorem pos_iff_ne_zero {o : ordinal} : 0 < o ↔ o ≠ 0 := bot_lt_if
 protected theorem not_lt_zero (o : ordinal) : ¬ o < 0 := not_lt_bot
 theorem eq_zero_or_pos : ∀ a : ordinal, a = 0 ∨ 0 < a := eq_bot_or_bot_lt
 
-@[simp] theorem zero_lt_one : (0 : ordinal) < 1 := principal_seg.pempty_to_punit.ordinal_type_lt
+instance : zero_le_one_class ordinal := ⟨ordinal.zero_le _⟩
 
-instance : zero_le_one_class ordinal := ⟨zero_lt_one.le⟩
+instance ne_zero.one : ne_zero (1 : ordinal) := ⟨ordinal.one_ne_zero⟩
 
 /-- Given two ordinals `α ≤ β`, then `initial_seg_out α β` is the initial segment embedding
 of `α` to `β`, as map from a model type for `α` to a model type for `β`. -/
diff --git a/src/set_theory/ordinal/notation.lean b/src/set_theory/ordinal/notation.lean
index 1e06926c5a76a..a02aae9dce46c 100644
--- a/src/set_theory/ordinal/notation.lean
+++ b/src/set_theory/ordinal/notation.lean
@@ -130,7 +130,7 @@ theorem eq_of_cmp_eq : ∀ {o₁ o₂}, cmp o₁ o₂ = ordering.eq → o₁ = o
   simp
 end
 
-theorem zero_lt_one : (0 : onote) < 1 :=
+protected theorem zero_lt_one : (0 : onote) < 1 :=
 by rw [lt_def, repr, repr_one]; exact zero_lt_one
 
 /-- `NF_below o b` says that `o` is a normal form ordinal notation
@@ -221,7 +221,7 @@ theorem NF.below_of_lt' : ∀ {o b}, repr o < ω ^ b → NF o → NF_below o b
 
 theorem NF_below_of_nat : ∀ n, NF_below (of_nat n) 1
 | 0            := NF_below.zero
-| (nat.succ n) := NF_below.oadd NF.zero NF_below.zero ordinal.zero_lt_one
+| (nat.succ n) := NF_below.oadd NF.zero NF_below.zero zero_lt_one
 
 instance NF_of_nat (n) : NF (of_nat n) := ⟨⟨_, NF_below_of_nat n⟩⟩
 
@@ -833,7 +833,7 @@ private theorem exists_lt_omega_opow' {α} {o b : ordinal}
   (hb : 1 < b) (ho : o.is_limit) {f : α → ordinal}
   (H : ∀ ⦃a⦄, a < o → ∃ i, a < f i) ⦃a⦄ (h : a < b ^ o) : ∃ i, a < b ^ f i :=
 begin
-  obtain ⟨d, hd, h'⟩ := (lt_opow_of_limit (ordinal.zero_lt_one.trans hb).ne' ho).1 h,
+  obtain ⟨d, hd, h'⟩ := (lt_opow_of_limit (zero_lt_one.trans hb).ne' ho).1 h,
   exact (H hd).imp (λ i hi, h'.trans $ (opow_lt_opow_iff_right hb).2 hi)
 end
 
diff --git a/src/set_theory/ordinal/principal.lean b/src/set_theory/ordinal/principal.lean
index 672c33df46ba9..a79c584716972 100644
--- a/src/set_theory/ordinal/principal.lean
+++ b/src/set_theory/ordinal/principal.lean
@@ -130,7 +130,7 @@ theorem principal_add_is_limit {o : ordinal} (ho₁ : 1 < o) (ho : principal (+)
 begin
   refine ⟨λ ho₀, _, λ a hao, _⟩,
   { rw ho₀ at ho₁,
-    exact not_lt_of_gt ordinal.zero_lt_one ho₁ },
+    exact not_lt_of_gt zero_lt_one ho₁ },
   { cases eq_or_ne a 0 with ha ha,
     { rw [ha, succ_zero],
       exact ho₁ },
diff --git a/src/set_theory/ordinal/topology.lean b/src/set_theory/ordinal/topology.lean
index 00475ad72e637..3936f9e539058 100644
--- a/src/set_theory/ordinal/topology.lean
+++ b/src/set_theory/ordinal/topology.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Violeta Hernández Palacios
 -/
 import set_theory.ordinal.arithmetic
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 ### Topology of ordinals
diff --git a/src/tactic/congr.lean b/src/tactic/congr.lean
index 37d5efe57eaef..128b24d53e494 100644
--- a/src/tactic/congr.lean
+++ b/src/tactic/congr.lean
@@ -224,7 +224,10 @@ begin
 -- ⊢ a + d + e + f + c + g + b ≤ N
 end
 ```
--/
+
+##  Related tactic: `move_add`
+In the case in which the expression to be changed is a sum of terms, tactic
+`tactive.interactive.move_add` can also be useful. -/
 meta def ac_change (r : parse texpr) (n : parse (tk "using" *> small_nat)?) : tactic unit :=
 convert_to r n; try ac_refl
 
diff --git a/src/tactic/linarith/lemmas.lean b/src/tactic/linarith/lemmas.lean
index 7fef5adb7fbd3..c824cdc2eae40 100644
--- a/src/tactic/linarith/lemmas.lean
+++ b/src/tactic/linarith/lemmas.lean
@@ -15,6 +15,8 @@ If you find yourself looking for a theorem here, you might be in the wrong place
 
 namespace linarith
 
+lemma zero_lt_one {α} [ordered_semiring α] [nontrivial α] : (0 : α) < 1 := zero_lt_one
+
 lemma eq_of_eq_of_eq {α} [ordered_semiring α] {a b : α} (ha : a = 0) (hb : b = 0) : a + b = 0 :=
 by simp *
 
diff --git a/src/tactic/linarith/verification.lean b/src/tactic/linarith/verification.lean
index 360a6fdf4655c..8f6e0b1e5010c 100644
--- a/src/tactic/linarith/verification.lean
+++ b/src/tactic/linarith/verification.lean
@@ -97,8 +97,8 @@ term_of_ineq_prf prf >>= infer_type
 where the numerals are natively of type `tp`.
 -/
 meta def mk_neg_one_lt_zero_pf (tp : expr) : tactic expr :=
-do zero_lt_one ← mk_mapp `zero_lt_one [tp, none, none],
-   mk_app `neg_neg_of_pos [zero_lt_one]
+do h ← mk_mapp `linarith.zero_lt_one [tp, none, none],
+   mk_app `neg_neg_of_pos [h]
 
 /--
 If `e` is a proof that `t = 0`, `mk_neg_eq_zero_pf e` returns a proof that `-t = 0`.
diff --git a/src/topology/algebra/field.lean b/src/topology/algebra/field.lean
index 3764d0a56b597..3ce7acb675118 100644
--- a/src/topology/algebra/field.lean
+++ b/src/topology/algebra/field.lean
@@ -6,6 +6,7 @@ Authors: Patrick Massot, Scott Morrison
 import topology.algebra.ring
 import topology.algebra.group_with_zero
 import topology.local_extr
+import field_theory.subfield
 
 /-!
 # Topological fields
@@ -122,6 +123,37 @@ lemma continuous_units_inv : continuous (λ x : Kˣ, (↑(x⁻¹) : K)) :=
 
 end topological_division_ring
 
+section subfield
+
+variables {α : Type*} [field α] [topological_space α] [topological_division_ring α]
+
+/-- The (topological-space) closure of a subfield of a topological field is
+itself a subfield. -/
+def subfield.topological_closure (K : subfield α) : subfield α :=
+{ carrier := closure (K : set α),
+  inv_mem' :=
+  begin
+    intros x hx,
+    by_cases h : x = 0,
+    { rwa [h, inv_zero, ← h], },
+    { convert mem_closure_image (continuous_at_inv₀ h) hx using 2,
+      ext x, split,
+      { exact λ hx, ⟨x⁻¹, ⟨K.inv_mem hx, inv_inv x⟩⟩, },
+      { rintros ⟨y, ⟨hy, rfl⟩⟩, exact K.inv_mem hy, }},
+  end,
+  ..K.to_subring.topological_closure, }
+
+lemma subfield.le_topological_closure (s : subfield α) :
+  s ≤ s.topological_closure := subset_closure
+
+lemma subfield.is_closed_topological_closure (s : subfield α) :
+  is_closed (s.topological_closure : set α) := is_closed_closure
+
+lemma subfield.topological_closure_minimal
+  (s : subfield α) {t : subfield α} (h : s ≤ t) (ht : is_closed (t : set α)) :
+  s.topological_closure ≤ t := closure_minimal h ht
+
+end subfield
 
 section affine_homeomorph
 /-!
diff --git a/src/topology/algebra/module/finite_dimension.lean b/src/topology/algebra/module/finite_dimension.lean
index 3144352d5b467..c1d55c8cbcf35 100644
--- a/src/topology/algebra/module/finite_dimension.lean
+++ b/src/topology/algebra/module/finite_dimension.lean
@@ -347,6 +347,9 @@ begin
   { simp only [map_sub, map_add, ← comp_apply f g, hg, id_apply, sub_add_cancel] }
 end
 
+instance can_lift_continuous_linear_map : can_lift (E →ₗ[𝕜] F) (E →L[𝕜] F) coe (λ _, true) :=
+⟨λ f _, ⟨f.to_continuous_linear_map, rfl⟩⟩
+
 end linear_map
 
 namespace linear_equiv
@@ -383,6 +386,10 @@ by { ext x, refl }
   e.to_continuous_linear_equiv.symm.to_linear_equiv = e.symm :=
 by { ext x, refl }
 
+instance can_lift_continuous_linear_equiv :
+  can_lift (E ≃ₗ[𝕜] F) (E ≃L[𝕜] F) continuous_linear_equiv.to_linear_equiv (λ _, true) :=
+⟨λ f _, ⟨_, f.to_linear_equiv_to_continuous_linear_equiv⟩⟩
+
 end linear_equiv
 
 namespace continuous_linear_map
diff --git a/src/topology/algebra/module/strong_topology.lean b/src/topology/algebra/module/strong_topology.lean
index 8acfe0b4abcde..9d2aeab58b238 100644
--- a/src/topology/algebra/module/strong_topology.lean
+++ b/src/topology/algebra/module/strong_topology.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anatole Dedecker
 -/
 import topology.algebra.uniform_convergence
+import topology.algebra.module.locally_convex
 
 /-!
 # Strong topologies on the space of continuous linear maps
@@ -61,8 +62,9 @@ namespace continuous_linear_map
 section general
 
 variables {𝕜₁ 𝕜₂ : Type*} [normed_field 𝕜₁] [normed_field 𝕜₂] (σ : 𝕜₁ →+* 𝕜₂)
-  {E : Type*} (F : Type*) [add_comm_group E] [module 𝕜₁ E]
-  [add_comm_group F] [module 𝕜₂ F] [topological_space E]
+  {E E' F F' : Type*} [add_comm_group E] [module 𝕜₁ E] [add_comm_group E'] [module ℝ E']
+  [add_comm_group F] [module 𝕜₂ F] [add_comm_group F'] [module ℝ F']
+  [topological_space E] [topological_space E'] (F)
 
 /-- Given `E` and `F` two topological vector spaces and `𝔖 : set (set E)`, then
 `strong_topology σ F 𝔖` is the "topology of uniform convergence on the elements of `𝔖`" on
@@ -88,6 +90,23 @@ def strong_uniformity [uniform_space F] [uniform_add_group F]
   (strong_uniformity σ F 𝔖).to_topological_space = strong_topology σ F 𝔖 :=
 rfl
 
+lemma strong_uniformity.uniform_embedding_coe_fn [uniform_space F] [uniform_add_group F]
+  (𝔖 : set (set E)) :
+  @uniform_embedding (E →SL[σ] F) (E →ᵤ[𝔖] F) (strong_uniformity σ F 𝔖)
+  (uniform_on_fun.uniform_space E F 𝔖) coe_fn :=
+begin
+  letI : uniform_space (E →SL[σ] F) := strong_uniformity σ F 𝔖,
+  exact ⟨⟨rfl⟩, fun_like.coe_injective⟩
+end
+
+lemma strong_topology.embedding_coe_fn [uniform_space F] [uniform_add_group F]
+  (𝔖 : set (set E)) :
+  @embedding (E →SL[σ] F) (E →ᵤ[𝔖] F) (strong_topology σ F 𝔖)
+  (uniform_on_fun.topological_space E F 𝔖)
+  (uniform_on_fun.of_fun 𝔖 ∘ coe_fn) :=
+@uniform_embedding.embedding _ _ (_root_.id _) _ _
+  (strong_uniformity.uniform_embedding_coe_fn _ _ _)
+
 lemma strong_uniformity.uniform_add_group [uniform_space F] [uniform_add_group F]
   (𝔖 : set (set E)) : @uniform_add_group (E →SL[σ] F) (strong_uniformity σ F 𝔖) _ :=
 begin
@@ -107,6 +126,16 @@ begin
   apply_instance
 end
 
+lemma strong_topology.t2_space [topological_space F] [topological_add_group F] [t2_space F]
+  (𝔖 : set (set E)) (h𝔖 : ⋃₀ 𝔖 = set.univ) : @t2_space (E →SL[σ] F) (strong_topology σ F 𝔖) :=
+begin
+  letI : uniform_space F := topological_add_group.to_uniform_space F,
+  haveI : uniform_add_group F := topological_add_comm_group_is_uniform,
+  letI : topological_space (E →SL[σ] F) := strong_topology σ F 𝔖,
+  haveI : t2_space (E →ᵤ[𝔖] F) := uniform_on_fun.t2_space_of_covering h𝔖,
+  exact (strong_topology.embedding_coe_fn σ F 𝔖).t2_space
+end
+
 lemma strong_topology.has_continuous_smul [ring_hom_surjective σ] [ring_hom_isometric σ]
   [topological_space F] [topological_add_group F] [has_continuous_smul 𝕜₂ F] (𝔖 : set (set E))
   (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) (h𝔖₃ : ∀ S ∈ 𝔖, bornology.is_vonN_bounded 𝕜₁ S) :
@@ -141,12 +170,28 @@ lemma strong_topology.has_basis_nhds_zero [topological_space F] [topological_add
     (λ SV, {f : E →SL[σ] F | ∀ x ∈ SV.1, f x ∈ SV.2}) :=
 strong_topology.has_basis_nhds_zero_of_basis σ F 𝔖 h𝔖₁ h𝔖₂ (𝓝 0).basis_sets
 
+lemma strong_topology.locally_convex_space [topological_space F']
+  [topological_add_group F'] [has_continuous_const_smul ℝ F'] [locally_convex_space ℝ F']
+  (𝔖 : set (set E')) (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) :
+  @locally_convex_space ℝ (E' →L[ℝ] F') _ _ _ (strong_topology (ring_hom.id ℝ) F' 𝔖) :=
+begin
+  letI : topological_space (E' →L[ℝ] F') := strong_topology (ring_hom.id ℝ) F' 𝔖,
+  haveI : topological_add_group (E' →L[ℝ] F') := strong_topology.topological_add_group _ _ _,
+  refine locally_convex_space.of_basis_zero _ _ _ _
+    (strong_topology.has_basis_nhds_zero_of_basis _ _ _ h𝔖₁ h𝔖₂
+      (locally_convex_space.convex_basis_zero ℝ F')) _,
+  rintros ⟨S, V⟩ ⟨hS, hVmem, hVconvex⟩ f hf g hg a b ha hb hab x hx,
+  exact hVconvex (hf x hx) (hg x hx) ha hb hab,
+end
+
 end general
 
 section bounded_sets
 
-variables {𝕜₁ 𝕜₂ : Type*} [normed_field 𝕜₁] [normed_field 𝕜₂] {σ : 𝕜₁ →+* 𝕜₂} {E F : Type*}
-  [add_comm_group E] [module 𝕜₁ E] [add_comm_group F] [module 𝕜₂ F] [topological_space E]
+variables {𝕜₁ 𝕜₂ : Type*} [normed_field 𝕜₁] [normed_field 𝕜₂] {σ : 𝕜₁ →+* 𝕜₂} {E E' F F' : Type*}
+  [add_comm_group E] [module 𝕜₁ E] [add_comm_group E'] [module ℝ E']
+  [add_comm_group F] [module 𝕜₂ F] [add_comm_group F'] [module ℝ F']
+  [topological_space E]
 
 /-- The topology of bounded convergence on `E →L[𝕜] F`. This coincides with the topology induced by
 the operator norm when `E` and `F` are normed spaces. -/
@@ -170,6 +215,11 @@ strong_uniformity σ F {S | bornology.is_vonN_bounded 𝕜₁ S}
 instance [uniform_space F] [uniform_add_group F] : uniform_add_group (E →SL[σ] F) :=
 strong_uniformity.uniform_add_group σ F _
 
+instance [topological_space F] [topological_add_group F] [has_continuous_smul 𝕜₁ E] [t2_space F] :
+  t2_space (E →SL[σ] F) :=
+strong_topology.t2_space σ F _ (set.eq_univ_of_forall $ λ x,
+  set.mem_sUnion_of_mem (set.mem_singleton x) (bornology.is_vonN_bounded_singleton x))
+
 protected lemma has_basis_nhds_zero_of_basis [topological_space F]
   [topological_add_group F] {ι : Type*} {p : ι → Prop} {b : ι → set F}
   (h : (𝓝 0 : filter F).has_basis p b) :
@@ -187,6 +237,12 @@ protected lemma has_basis_nhds_zero [topological_space F]
     (λ SV, {f : E →SL[σ] F | ∀ x ∈ SV.1, f x ∈ SV.2}) :=
 continuous_linear_map.has_basis_nhds_zero_of_basis (𝓝 0).basis_sets
 
+instance [topological_space E'] [topological_space F'] [topological_add_group F']
+  [has_continuous_const_smul ℝ F'] [locally_convex_space ℝ F'] :
+  locally_convex_space ℝ (E' →L[ℝ] F') :=
+strong_topology.locally_convex_space _ ⟨∅, bornology.is_vonN_bounded_empty ℝ E'⟩
+  (directed_on_of_sup_mem $ λ _ _, bornology.is_vonN_bounded.union)
+
 end bounded_sets
 
 end continuous_linear_map
diff --git a/src/topology/algebra/monoid.lean b/src/topology/algebra/monoid.lean
index c017202aa05d6..289823cba9eaf 100644
--- a/src/topology/algebra/monoid.lean
+++ b/src/topology/algebra/monoid.lean
@@ -101,6 +101,42 @@ lemma filter.tendsto.mul_const (b : M) {c : M} {f : α → M} {l : filter α}
   (h : tendsto (λ (k:α), f k) l (𝓝 c)) : tendsto (λ (k:α), f k * b) l (𝓝 (c * b)) :=
 h.mul tendsto_const_nhds
 
+section tendsto_nhds
+
+variables {𝕜 : Type*}
+  [preorder 𝕜] [has_zero 𝕜] [has_mul 𝕜] [topological_space 𝕜] [has_continuous_mul 𝕜]
+  {l : filter α} {f : α → 𝕜} {b c : 𝕜} (hb : 0 < b)
+
+lemma filter.tendsto_nhds_within_Ioi.const_mul [pos_mul_strict_mono 𝕜] [pos_mul_reflect_lt 𝕜]
+  (h : tendsto f l (𝓝[>] c)) :
+  tendsto (λ a, b * f a) l (𝓝[>] (b * c)) :=
+tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
+  ((tendsto_nhds_of_tendsto_nhds_within h).const_mul b) $
+  (tendsto_nhds_within_iff.mp h).2.mono (λ j, (mul_lt_mul_left hb).mpr)
+
+lemma filter.tendsto_nhds_within_Iio.const_mul [pos_mul_strict_mono 𝕜] [pos_mul_reflect_lt 𝕜]
+  (h : tendsto f l (𝓝[<] c)) :
+  tendsto (λ a, b * f a) l (𝓝[<] (b * c)) :=
+tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
+  ((tendsto_nhds_of_tendsto_nhds_within h).const_mul b) $
+  (tendsto_nhds_within_iff.mp h).2.mono (λ j, (mul_lt_mul_left hb).mpr)
+
+lemma filter.tendsto_nhds_within_Ioi.mul_const [mul_pos_strict_mono 𝕜] [mul_pos_reflect_lt 𝕜]
+  (h : tendsto f l (𝓝[>] c)) :
+  tendsto (λ a, f a * b) l (𝓝[>] (c * b)) :=
+tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
+  ((tendsto_nhds_of_tendsto_nhds_within h).mul_const b) $
+  (tendsto_nhds_within_iff.mp h).2.mono (λ j, (mul_lt_mul_right hb).mpr)
+
+lemma filter.tendsto_nhds_within_Iio.mul_const [mul_pos_strict_mono 𝕜] [mul_pos_reflect_lt 𝕜]
+  (h : tendsto f l (𝓝[<] c)) :
+  tendsto (λ a, f a * b) l (𝓝[<] (c * b)) :=
+tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
+  ((tendsto_nhds_of_tendsto_nhds_within h).mul_const b) $
+  (tendsto_nhds_within_iff.mp h).2.mono (λ j, (mul_lt_mul_right hb).mpr)
+
+end tendsto_nhds
+
 /-- Construct a unit from limits of units and their inverses. -/
 @[to_additive filter.tendsto.add_units "Construct an additive unit from limits of additive units
 and their negatives.", simps]
@@ -109,8 +145,8 @@ def filter.tendsto.units [topological_space N] [monoid N] [has_continuous_mul N]
   (h₁ : tendsto (λ x, ↑(f x)) l (𝓝 r₁)) (h₂ : tendsto (λ x, ↑(f x)⁻¹) l (𝓝 r₂)) : Nˣ :=
 { val := r₁,
   inv := r₂,
-  val_inv := tendsto_nhds_unique (by simpa using h₁.mul h₂) tendsto_const_nhds,
-  inv_val := tendsto_nhds_unique (by simpa using h₂.mul h₁) tendsto_const_nhds }
+  val_inv := by { symmetry, simpa using h₁.mul h₂ },
+  inv_val := by { symmetry, simpa using h₂.mul h₁ } }
 
 @[to_additive]
 lemma continuous_at.mul {f g : X → M} {x : X} (hf : continuous_at f x) (hg : continuous_at g x) :
diff --git a/src/topology/algebra/order/archimedean.lean b/src/topology/algebra/order/archimedean.lean
index 5511b5fb84162..bbf0859725ce2 100644
--- a/src/topology/algebra/order/archimedean.lean
+++ b/src/topology/algebra/order/archimedean.lean
@@ -3,14 +3,14 @@ Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 import algebra.order.archimedean
 
 /-!
 # Rational numbers are dense in a linear ordered archimedean field
 
 In this file we prove that coercion from `ℚ` to a linear ordered archimedean field has dense range.
-This lemma is in a separate file because `topology.algebra.order.basic` does not import
+This lemma is in a separate file because `topology.order.basic` does not import
 `algebra.order.archimedean`.
 -/
 
diff --git a/src/topology/algebra/order/extend_from.lean b/src/topology/algebra/order/extend_from.lean
index 9578d72199b64..922ff11885cc5 100644
--- a/src/topology/algebra/order/extend_from.lean
+++ b/src/topology/algebra/order/extend_from.lean
@@ -3,7 +3,7 @@ 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, Yury Kudryashov
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 import topology.extend_from
 
 /-!
diff --git a/src/topology/algebra/order/extr_closure.lean b/src/topology/algebra/order/extr_closure.lean
index 834214a96ff60..310426d2e8bda 100644
--- a/src/topology/algebra/order/extr_closure.lean
+++ b/src/topology/algebra/order/extr_closure.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
 import topology.local_extr
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Maximum/minimum on the closure of a set
diff --git a/src/topology/algebra/order/field.lean b/src/topology/algebra/order/field.lean
index 58445c3027a37..2b9eeecfab668 100644
--- a/src/topology/algebra/order/field.lean
+++ b/src/topology/algebra/order/field.lean
@@ -5,7 +5,7 @@ Authors: Benjamin Davidson, Devon Tuma, Eric Rodriguez, Oliver Nash
 -/
 
 import tactic.positivity
-import topology.algebra.order.basic
+import topology.order.basic
 import topology.algebra.field
 
 /-!
diff --git a/src/topology/algebra/order/filter.lean b/src/topology/algebra/order/filter.lean
index 95ce41c02b206..5ec5f68ec72c4 100644
--- a/src/topology/algebra/order/filter.lean
+++ b/src/topology/algebra/order/filter.lean
@@ -3,7 +3,7 @@ Copyright (c) 2022 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 import topology.filter
 
 /-!
diff --git a/src/topology/algebra/order/floor.lean b/src/topology/algebra/order/floor.lean
index c6c5cef0e8fde..be5a80187cd7a 100644
--- a/src/topology/algebra/order/floor.lean
+++ b/src/topology/algebra/order/floor.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anatole Dedecker
 -/
 import algebra.order.floor
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Topological facts about `int.floor`, `int.ceil` and `int.fract`
@@ -182,14 +182,14 @@ begin
       rw this,
       refine (h _ ⟨⟨⟩, by exact_mod_cast right_mem_Icc.2 (zero_le_one' α)⟩).tendsto.comp _,
       rw [nhds_within_prod_eq, nhds_within_univ],
-      rw nhds_within_Icc_eq_nhds_within_Iic (@zero_lt_one α _ _),
+      rw nhds_within_Icc_eq_nhds_within_Iic (zero_lt_one' α),
       exact tendsto_id.prod_map
         (tendsto_nhds_within_mono_right Iio_subset_Iic_self $ tendsto_fract_left _) },
     { simp only [continuous_within_at, fract_int_cast, nhds_within_prod_eq,
                   nhds_within_univ, id.def, comp_app, prod.map_mk],
       refine (h _ ⟨⟨⟩, by exact_mod_cast left_mem_Icc.2 (zero_le_one' α)⟩).tendsto.comp _,
       rw [nhds_within_prod_eq, nhds_within_univ,
-        nhds_within_Icc_eq_nhds_within_Ici (@zero_lt_one α _ _)],
+        nhds_within_Icc_eq_nhds_within_Ici (zero_lt_one' α)],
       exact tendsto_id.prod_map (tendsto_fract_right _) } },
   { have : t ∈ Ioo (floor t : α) ((floor t : α) + 1),
       from ⟨lt_of_le_of_ne (floor_le t) (ne.symm ht), lt_floor_add_one _⟩,
diff --git a/src/topology/algebra/order/intermediate_value.lean b/src/topology/algebra/order/intermediate_value.lean
index a4c47f42ca68e..7a07491077eb7 100644
--- a/src/topology/algebra/order/intermediate_value.lean
+++ b/src/topology/algebra/order/intermediate_value.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov, Alistair Tucker
 -/
 import order.complete_lattice_intervals
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Intermediate Value Theorem
diff --git a/src/topology/algebra/order/left_right_lim.lean b/src/topology/algebra/order/left_right_lim.lean
index 0e3a0d1ca0e8d..688e2f22bd595 100644
--- a/src/topology/algebra/order/left_right_lim.lean
+++ b/src/topology/algebra/order/left_right_lim.lean
@@ -3,7 +3,7 @@ Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 import topology.algebra.order.left_right
 
 /-!
diff --git a/src/topology/algebra/order/liminf_limsup.lean b/src/topology/algebra/order/liminf_limsup.lean
index d1c09bec27adb..1ad1eb77d26bf 100644
--- a/src/topology/algebra/order/liminf_limsup.lean
+++ b/src/topology/algebra/order/liminf_limsup.lean
@@ -6,7 +6,7 @@ Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov
 import algebra.big_operators.intervals
 import order.liminf_limsup
 import order.filter.archimedean
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Lemmas about liminf and limsup in an order topology.
@@ -320,6 +320,46 @@ f_incr.map_Liminf_of_continuous_at f_cont
 
 end monotone
 
+section infi_and_supr
+
+open_locale topological_space
+
+open filter set
+
+variables {ι : Type*} {R : Type*} [complete_linear_order R] [topological_space R] [order_topology R]
+
+lemma infi_eq_of_forall_le_of_tendsto {x : R} {as : ι → R}
+  (x_le : ∀ i, x ≤ as i) {F : filter ι} [filter.ne_bot F] (as_lim : filter.tendsto as F (𝓝 x)) :
+  (⨅ i, as i) = x :=
+begin
+  refine infi_eq_of_forall_ge_of_forall_gt_exists_lt (λ i, x_le i) _,
+  apply λ w x_lt_w, ‹filter.ne_bot F›.nonempty_of_mem (eventually_lt_of_tendsto_lt x_lt_w as_lim),
+end
+
+lemma supr_eq_of_forall_le_of_tendsto {x : R} {as : ι → R}
+  (le_x : ∀ i, as i ≤ x) {F : filter ι} [filter.ne_bot F] (as_lim : filter.tendsto as F (𝓝 x)) :
+  (⨆ i, as i) = x :=
+@infi_eq_of_forall_le_of_tendsto ι (order_dual R) _ _ _ x as le_x F _ as_lim
+
+lemma Union_Ici_eq_Ioi_of_lt_of_tendsto {ι : Type*} (x : R) {as : ι → R} (x_lt : ∀ i, x < as i)
+  {F : filter ι} [filter.ne_bot F] (as_lim : filter.tendsto as F (𝓝 x)) :
+  (⋃ (i : ι), Ici (as i)) = Ioi x :=
+begin
+  have obs : x ∉ range as,
+  { intro maybe_x_is,
+    rcases mem_range.mp maybe_x_is with ⟨i, hi⟩,
+    simpa only [hi, lt_self_iff_false] using x_lt i, } ,
+  rw ← infi_eq_of_forall_le_of_tendsto (λ i, (x_lt i).le) as_lim at *,
+  exact Union_Ici_eq_Ioi_infi obs,
+end
+
+lemma Union_Iic_eq_Iio_of_lt_of_tendsto {ι : Type*} (x : R) {as : ι → R} (lt_x : ∀ i, as i < x)
+  {F : filter ι} [filter.ne_bot F] (as_lim : filter.tendsto as F (𝓝 x)) :
+  (⋃ (i : ι), Iic (as i)) = Iio x :=
+@Union_Ici_eq_Ioi_of_lt_of_tendsto (order_dual R) _ _ _ ι x as lt_x F _ as_lim
+
+end infi_and_supr
+
 section indicator
 
 open_locale big_operators
diff --git a/src/topology/algebra/order/monotone_continuity.lean b/src/topology/algebra/order/monotone_continuity.lean
index 957caae659ca6..d81ec0ab63b93 100644
--- a/src/topology/algebra/order/monotone_continuity.lean
+++ b/src/topology/algebra/order/monotone_continuity.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov, Heather Macbeth
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 import topology.algebra.order.left_right
 
 /-!
diff --git a/src/topology/algebra/order/monotone_convergence.lean b/src/topology/algebra/order/monotone_convergence.lean
index fa813e949b10c..f2c2e1bfbb075 100644
--- a/src/topology/algebra/order/monotone_convergence.lean
+++ b/src/topology/algebra/order/monotone_convergence.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Heather Macbeth. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Heather Macbeth, Yury Kudryashov
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Bounded monotone sequences converge
diff --git a/src/topology/algebra/order/proj_Icc.lean b/src/topology/algebra/order/proj_Icc.lean
index a032314bb4a6d..a9c3162be3515 100644
--- a/src/topology/algebra/order/proj_Icc.lean
+++ b/src/topology/algebra/order/proj_Icc.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov, Patrick Massot
 -/
 import data.set.intervals.proj_Icc
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Projection onto a closed interval
diff --git a/src/topology/algebra/order/t5.lean b/src/topology/algebra/order/t5.lean
index 1faf616de80a7..504e4106a808b 100644
--- a/src/topology/algebra/order/t5.lean
+++ b/src/topology/algebra/order/t5.lean
@@ -3,7 +3,7 @@ Copyright (c) 2022 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 import data.set.intervals.ord_connected_component
 
 /-!
diff --git a/src/topology/algebra/uniform_ring.lean b/src/topology/algebra/uniform_ring.lean
index 352133201aa6b..1e765f6aca777 100644
--- a/src/topology/algebra/uniform_ring.lean
+++ b/src/topology/algebra/uniform_ring.lean
@@ -226,3 +226,40 @@ begin
 end
 
 end uniform_space
+
+section uniform_extension
+
+variables {α : Type*} [uniform_space α] [semiring α]
+variables {β : Type*} [uniform_space β] [semiring β] [topological_semiring β]
+variables {γ : Type*} [uniform_space γ] [semiring γ] [topological_semiring γ]
+variables [t2_space γ] [complete_space γ]
+
+/-- The dense inducing extension as a ring homomorphism. -/
+noncomputable def dense_inducing.extend_ring_hom {i : α →+* β} {f : α →+* γ}
+  (ue : uniform_inducing i) (dr : dense_range i) (hf : uniform_continuous f):
+  β →+* γ :=
+  { to_fun := (ue.dense_inducing dr).extend f,
+    map_one' := by { convert dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous 1,
+      exacts [i.map_one.symm, f.map_one.symm], },
+    map_zero' := by { convert dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous 0,
+      exacts [i.map_zero.symm, f.map_zero.symm], },
+    map_add' :=
+    begin
+      have h := (uniform_continuous_uniformly_extend ue dr hf).continuous,
+      refine λ x y, dense_range.induction_on₂ dr _ (λ a b, _) x y,
+      { exact is_closed_eq (continuous.comp h continuous_add)
+        ((h.comp continuous_fst).add (h.comp continuous_snd)), },
+      { simp_rw [← i.map_add, dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous _,
+          ← f.map_add], },
+    end,
+    map_mul' :=
+    begin
+      have h := (uniform_continuous_uniformly_extend ue dr hf).continuous,
+      refine λ x y, dense_range.induction_on₂ dr _ (λ a b, _) x y,
+      { exact is_closed_eq (continuous.comp h continuous_mul)
+        ((h.comp continuous_fst).mul (h.comp continuous_snd)), },
+      { simp_rw [← i.map_mul, dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous _,
+          ← f.map_mul], },
+    end, }
+
+end uniform_extension
diff --git a/src/topology/bases.lean b/src/topology/bases.lean
index 53d3ad93ab534..8771c8af835a9 100644
--- a/src/topology/bases.lean
+++ b/src/topology/bases.lean
@@ -81,7 +81,7 @@ begin
   refine ⟨_, by rw [sUnion_diff_singleton_empty, h.sUnion_eq], _⟩,
   { rintro t₁ ⟨h₁, -⟩ t₂ ⟨h₂, -⟩ x hx,
     obtain ⟨t₃, h₃, hs⟩ := h.exists_subset_inter _ h₁ _ h₂ x hx,
-    exact ⟨t₃, ⟨h₃, ne_empty_iff_nonempty.2 ⟨x, hs.1⟩⟩, hs⟩ },
+    exact ⟨t₃, ⟨h₃, nonempty.ne_empty ⟨x, hs.1⟩⟩, hs⟩ },
   { rw h.eq_generate_from,
     refine le_antisymm (generate_from_mono $ diff_subset s _) (le_generate_from $ λ t ht, _),
     obtain rfl|he := eq_or_ne t ∅, { convert is_open_empty },
@@ -624,7 +624,7 @@ lemma is_open_of_mem_countable_basis [second_countable_topology α] {s : set α}
 
 lemma nonempty_of_mem_countable_basis [second_countable_topology α] {s : set α}
   (hs : s ∈ countable_basis α) : s.nonempty :=
-ne_empty_iff_nonempty.1 $ ne_of_mem_of_not_mem hs $ empty_nmem_countable_basis α
+nonempty_iff_ne_empty.2 $ ne_of_mem_of_not_mem hs $ empty_nmem_countable_basis α
 
 variable (α)
 
diff --git a/src/topology/basic.lean b/src/topology/basic.lean
index 12f0028be1437..0d5ead6ede2da 100644
--- a/src/topology/basic.lean
+++ b/src/topology/basic.lean
@@ -398,7 +398,7 @@ is_closed_empty.closure_eq
 ⟨subset_eq_empty subset_closure, λ h, h.symm ▸ closure_empty⟩
 
 @[simp] lemma closure_nonempty_iff {s : set α} : (closure s).nonempty ↔ s.nonempty :=
-by simp only [← ne_empty_iff_nonempty, ne.def, closure_empty_iff]
+by simp only [nonempty_iff_ne_empty, ne.def, closure_empty_iff]
 
 alias closure_nonempty_iff ↔ set.nonempty.of_closure set.nonempty.closure
 
diff --git a/src/topology/bornology/constructions.lean b/src/topology/bornology/constructions.lean
index 1cbbd2438f29f..f0eb1fc12d236 100644
--- a/src/topology/bornology/constructions.lean
+++ b/src/topology/bornology/constructions.lean
@@ -100,7 +100,7 @@ begin
   by_cases hne : ∃ i, S i = ∅,
   { simp [hne, univ_pi_eq_empty_iff.2 hne] },
   { simp only [hne, false_or],
-    simp only [not_exists, ← ne.def, ne_empty_iff_nonempty, ← univ_pi_nonempty_iff] at hne,
+    simp only [not_exists, ← ne.def, ←nonempty_iff_ne_empty, ← univ_pi_nonempty_iff] at hne,
     exact is_bounded_pi_of_nonempty hne }
 end
 
diff --git a/src/topology/connected.lean b/src/topology/connected.lean
index 3d678d0024937..8f43a92945c4c 100644
--- a/src/topology/connected.lean
+++ b/src/topology/connected.lean
@@ -3,6 +3,7 @@ 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, Yury Kudryashov
 -/
+import data.set.bool_indicator
 import order.succ_pred.relation
 import topology.subset_properties
 import tactic.congrm
@@ -818,7 +819,7 @@ theorem is_clopen_iff [preconnected_space α] {s : set α} : is_clopen s ↔ s =
   have h1 : s ≠ ∅ ∧ sᶜ ≠ ∅, from ⟨mt or.inl h,
     mt (λ h2, or.inr $ (by rw [← compl_compl s, h2, compl_empty] : s = univ)) h⟩,
   let ⟨_, h2, h3⟩ := nonempty_inter hs.1 hs.2.is_open_compl (union_compl_self s)
-    (ne_empty_iff_nonempty.1 h1.1) (ne_empty_iff_nonempty.1 h1.2) in
+    (nonempty_iff_ne_empty.2 h1.1) (nonempty_iff_ne_empty.2 h1.2) in
   h3 h2,
 by rintro (rfl | rfl); [exact is_clopen_empty, exact is_clopen_univ]⟩
 
@@ -832,7 +833,7 @@ is_clopen_iff_frontier_eq_empty.symm.trans is_clopen_iff
 
 lemma nonempty_frontier_iff [preconnected_space α] {s : set α} :
   (frontier s).nonempty ↔ s.nonempty ∧ s ≠ univ :=
-by simp only [← ne_empty_iff_nonempty, ne.def, frontier_eq_empty_iff, not_or_distrib]
+by simp only [nonempty_iff_ne_empty, ne.def, frontier_eq_empty_iff, not_or_distrib]
 
 lemma subtype.preconnected_space {s : set α} (h : is_preconnected s) :
   preconnected_space s :=
@@ -868,18 +869,18 @@ begin
   { intros u v hu hv hs huv,
     specialize h u v hu hv hs,
     contrapose! huv,
-    rw ne_empty_iff_nonempty,
+    rw ←nonempty_iff_ne_empty,
     simp [not_subset] at huv,
     rcases huv with ⟨⟨x, hxs, hxu⟩, ⟨y, hys, hyv⟩⟩,
     have hxv : x ∈ v := or_iff_not_imp_left.mp (hs hxs) hxu,
     have hyu : y ∈ u := or_iff_not_imp_right.mp (hs hys) hyv,
     exact h ⟨y, hys, hyu⟩ ⟨x, hxs, hxv⟩ },
   { intros u v hu hv hs hsu hsv,
-    rw ← ne_empty_iff_nonempty,
+    rw nonempty_iff_ne_empty,
     intro H,
     specialize h u v hu hv hs H,
     contrapose H,
-    apply ne_empty_iff_nonempty.mpr,
+    apply nonempty.ne_empty,
     cases h,
     { rcases hsv with ⟨x, hxs, hxv⟩, exact ⟨x, hxs, ⟨h hxs, hxv⟩⟩ },
     { rcases hsu with ⟨x, hxs, hxu⟩, exact ⟨x, hxs, ⟨hxu, h hxs⟩⟩ } }
@@ -919,7 +920,7 @@ begin
         { contradiction },
         { exact ⟨x, hxs, hxu, hxv⟩ } } } },
   { split,
-    { rw ← ne_empty_iff_nonempty,
+    { rw nonempty_iff_ne_empty,
       by_contradiction hs, subst hs,
       simpa using h ∅ _ _ _; simp },
     intros u v hu hv hs hsuv,
@@ -927,7 +928,7 @@ begin
     { rw [finset.mem_insert, finset.mem_singleton] at ht,
       rcases ht with rfl|rfl; tauto },
     { intros t₁ t₂ ht₁ ht₂ hst,
-      rw ← ne_empty_iff_nonempty at hst,
+      rw nonempty_iff_ne_empty at hst,
       rw [finset.mem_insert, finset.mem_singleton] at ht₁ ht₂,
       rcases ht₁ with rfl|rfl; rcases ht₂ with rfl|rfl,
       all_goals { refl <|> contradiction <|> skip },
@@ -967,7 +968,7 @@ begin
     rw is_preconnected_closed_iff at h,
     specialize h u v hu hv hs,
     contrapose! huv,
-    rw ne_empty_iff_nonempty,
+    rw ←nonempty_iff_ne_empty,
     simp [not_subset] at huv,
     rcases huv with ⟨⟨x, hxs, hxu⟩, ⟨y, hys, hyv⟩⟩,
     have hxv : x ∈ v := or_iff_not_imp_left.mp (hs hxs) hxu,
@@ -975,11 +976,11 @@ begin
     exact h ⟨y, hys, hyu⟩ ⟨x, hxs, hxv⟩ },
   { rw is_preconnected_closed_iff,
     intros u v hu hv hs hsu hsv,
-    rw ← ne_empty_iff_nonempty,
+    rw nonempty_iff_ne_empty,
     intro H,
     specialize h u v hu hv hs H,
     contrapose H,
-    apply ne_empty_iff_nonempty.mpr,
+    apply nonempty.ne_empty,
     cases h,
     { rcases hsv with ⟨x, hxs, hxv⟩, exact ⟨x, hxs, ⟨h hxs, hxv⟩⟩ },
     { rcases hsu with ⟨x, hxs, hxu⟩, exact ⟨x, hxs, ⟨hxu, h hxs⟩⟩ } }
diff --git a/src/topology/constructions.lean b/src/topology/constructions.lean
index 04f87fe0e32d2..565bf50b7a7b7 100644
--- a/src/topology/constructions.lean
+++ b/src/topology/constructions.lean
@@ -97,12 +97,11 @@ lemma is_closed_map_to_mul : is_closed_map (to_mul : additive α → α) := is_c
 lemma is_closed_map_of_add : is_closed_map (of_add : α → multiplicative α) := is_closed_map.id
 lemma is_closed_map_to_add : is_closed_map (to_add : multiplicative α → α) := is_closed_map.id
 
-local attribute [semireducible] nhds
-
-lemma nhds_of_mul (a : α) : 𝓝 (of_mul a) = map of_mul (𝓝 a) := rfl
-lemma nhds_of_add (a : α) : 𝓝 (of_add a) = map of_add (𝓝 a) := rfl
-lemma nhds_to_mul (a : additive α) : 𝓝 (to_mul a) = map to_mul (𝓝 a) := rfl
-lemma nhds_to_add (a : multiplicative α) : 𝓝 (to_add a) = map to_add (𝓝 a) := rfl
+lemma nhds_of_mul (a : α) : 𝓝 (of_mul a) = map of_mul (𝓝 a) := by { unfold nhds, refl, }
+lemma nhds_of_add (a : α) : 𝓝 (of_add a) = map of_add (𝓝 a) := by { unfold nhds, refl, }
+lemma nhds_to_mul (a : additive α) : 𝓝 (to_mul a) = map to_mul (𝓝 a) := by { unfold nhds, refl, }
+lemma nhds_to_add (a : multiplicative α) : 𝓝 (to_add a) = map to_add (𝓝 a) :=
+by { unfold nhds, refl, }
 
 end
 
@@ -129,10 +128,8 @@ lemma is_open_map_of_dual : is_open_map (of_dual : αᵒᵈ → α) := is_open_m
 lemma is_closed_map_to_dual : is_closed_map (to_dual : α → αᵒᵈ) := is_closed_map.id
 lemma is_closed_map_of_dual : is_closed_map (of_dual : αᵒᵈ → α) := is_closed_map.id
 
-local attribute [semireducible] nhds
-
-lemma nhds_to_dual (a : α) : 𝓝 (to_dual a) = map to_dual (𝓝 a) := rfl
-lemma nhds_of_dual (a : α) : 𝓝 (of_dual a) = map of_dual (𝓝 a) := rfl
+lemma nhds_to_dual (a : α) : 𝓝 (to_dual a) = map to_dual (𝓝 a) := by { unfold nhds, refl, }
+lemma nhds_of_dual (a : α) : 𝓝 (of_dual a) = map of_dual (𝓝 a) := by { unfold nhds, refl, }
 
 end
 
@@ -228,7 +225,7 @@ lemma is_open_iff {s : set (cofinite_topology α)} :
 
 lemma is_open_iff' {s : set (cofinite_topology α)} :
   is_open s ↔ (s = ∅ ∨ (sᶜ).finite) :=
-by simp only [is_open_iff, ← ne_empty_iff_nonempty, or_iff_not_imp_left]
+by simp only [is_open_iff, nonempty_iff_ne_empty, or_iff_not_imp_left]
 
 lemma is_closed_iff {s : set (cofinite_topology α)} :
   is_closed s ↔ s = univ ∨ s.finite :=
diff --git a/src/topology/continuous_function/algebra.lean b/src/topology/continuous_function/algebra.lean
index 05486d2b68049..d0f9763b02ed5 100644
--- a/src/topology/continuous_function/algebra.lean
+++ b/src/topology/continuous_function/algebra.lean
@@ -8,6 +8,7 @@ import topology.continuous_function.ordered
 import topology.algebra.uniform_group
 import topology.uniform_space.compact_convergence
 import topology.algebra.star
+import algebra.algebra.pi
 import algebra.algebra.subalgebra.basic
 import tactic.field_simp
 import algebra.star.star_alg_hom
diff --git a/src/topology/continuous_function/bounded.lean b/src/topology/continuous_function/bounded.lean
index ff0b98316870d..7cbba6795e4d7 100644
--- a/src/topology/continuous_function/bounded.lean
+++ b/src/topology/continuous_function/bounded.lean
@@ -8,6 +8,7 @@ import analysis.normed_space.operator_norm
 import analysis.normed_space.star.basic
 import data.real.sqrt
 import topology.continuous_function.algebra
+import topology.metric_space.equicontinuity
 
 /-!
 # Bounded continuous functions
@@ -18,7 +19,7 @@ the uniform distance.
 -/
 
 noncomputable theory
-open_locale topological_space classical nnreal
+open_locale topological_space classical nnreal uniformity uniform_convergence
 
 open set filter metric function
 
@@ -226,6 +227,20 @@ iff.intro
     λ n hn, lt_of_le_of_lt ((dist_le (half_pos ε_pos).le).mpr $
     λ x, dist_comm (f x) (F n x) ▸ le_of_lt (hn x)) (half_lt_self ε_pos)))
 
+/-- The topology on `α →ᵇ β` is exactly the topology induced by the natural map to `α →ᵤ β`. -/
+lemma inducing_coe_fn : inducing (uniform_fun.of_fun ∘ coe_fn : (α →ᵇ β) → (α →ᵤ β)) :=
+begin
+  rw inducing_iff_nhds,
+  refine λ f, eq_of_forall_le_iff (λ l, _),
+  rw [← tendsto_iff_comap, ← tendsto_id', tendsto_iff_tendsto_uniformly,
+      uniform_fun.tendsto_iff_tendsto_uniformly],
+  refl
+end
+
+-- TODO: upgrade to a `uniform_embedding`
+lemma embedding_coe_fn : embedding (uniform_fun.of_fun ∘ coe_fn : (α →ᵇ β) → (α →ᵤ β)) :=
+⟨inducing_coe_fn, λ f g h, ext $ λ x, congr_fun h x⟩
+
 variables (α) {β}
 
 /-- Constant as a continuous bounded function. -/
@@ -417,10 +432,10 @@ and several useful variations around it. -/
 theorem arzela_ascoli₁ [compact_space β]
   (A : set (α →ᵇ β))
   (closed : is_closed A)
-  (H : ∀ (x:α) (ε > 0), ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
-    f ∈ A → dist (f y) (f z) < ε) :
+  (H : equicontinuous (coe_fn : A → α → β)) :
   is_compact A :=
 begin
+  simp_rw [equicontinuous, metric.equicontinuous_at_iff_pair] at H,
   refine is_compact_of_totally_bounded_is_closed _ closed,
   refine totally_bounded_of_finite_discretization (λ ε ε0, _),
   rcases exists_between ε0 with ⟨ε₁, ε₁0, εε₁⟩,
@@ -437,7 +452,7 @@ begin
     f ∈ A → dist (f y) (f z) < ε₂ := λ x,
       let ⟨U, nhdsU, hU⟩ := H x _ ε₂0,
           ⟨V, VU, openV, xV⟩ := _root_.mem_nhds_iff.1 nhdsU in
-      ⟨V, xV, openV, λy hy z hz f hf, hU y (VU hy) z (VU hz) f hf⟩,
+      ⟨V, xV, openV, λy hy z hz f hf, hU y (VU hy) z (VU hz) ⟨f, hf⟩⟩,
   choose U hU using this,
   /- For all x, the set hU x is an open set containing x on which the elements of A
   fluctuate by at most ε₂.
@@ -481,8 +496,7 @@ theorem arzela_ascoli₂
   (A : set (α →ᵇ β))
   (closed : is_closed A)
   (in_s : ∀(f : α →ᵇ β) (x : α), f ∈ A → f x ∈ s)
-  (H : ∀(x:α) (ε > 0), ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
-    f ∈ A → dist (f y) (f z) < ε) :
+  (H : equicontinuous (coe_fn : A → α → β)) :
   is_compact A :=
 /- This version is deduced from the previous one by restricting to the compact type in the target,
 using compactness there and then lifting everything to the original space. -/
@@ -492,10 +506,9 @@ begin
   refine is_compact_of_is_closed_subset
     ((_ : is_compact (F ⁻¹' A)).image (continuous_comp M)) closed (λ f hf, _),
   { haveI : compact_space s := is_compact_iff_compact_space.1 hs,
-    refine arzela_ascoli₁ _ (continuous_iff_is_closed.1 (continuous_comp M) _ closed)
-      (λ x ε ε0, bex.imp_right (λ U U_nhds hU y hy z hz f hf, _) (H x ε ε0)),
-    calc dist (f y) (f z) = dist (F f y) (F f z) : rfl
-                        ... < ε : hU y hy z hz (F f) hf },
+    refine arzela_ascoli₁ _ (continuous_iff_is_closed.1 (continuous_comp M) _ closed) _,
+    rw uniform_embedding_subtype_coe.to_uniform_inducing.equicontinuous_iff,
+    exact H.comp (A.restrict_preimage F) },
   { let g := cod_restrict s f (λx, in_s f x hf),
     rw [show f = F g, by ext; refl] at hf ⊢,
     exact ⟨g, hf, rfl⟩ }
@@ -507,8 +520,7 @@ theorem arzela_ascoli [t2_space β]
   (s : set β) (hs : is_compact s)
   (A : set (α →ᵇ β))
   (in_s : ∀(f : α →ᵇ β) (x : α), f ∈ A → f x ∈ s)
-  (H : ∀(x:α) (ε > 0), ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
-    f ∈ A → dist (f y) (f z) < ε) :
+  (H : equicontinuous (coe_fn : A → α → β)) :
   is_compact (closure A) :=
 /- This version is deduced from the previous one by checking that the closure of A, in
 addition to being closed, still satisfies the properties of compact range and equicontinuity -/
@@ -516,42 +528,7 @@ arzela_ascoli₂ s hs (closure A) is_closed_closure
   (λ f x hf, (mem_of_closed' hs.is_closed).2 $ λ ε ε0,
     let ⟨g, gA, dist_fg⟩ := metric.mem_closure_iff.1 hf ε ε0 in
     ⟨g x, in_s g x gA, lt_of_le_of_lt (dist_coe_le_dist _) dist_fg⟩)
-  (λ x ε ε0, show ∃ U ∈ 𝓝 x,
-      ∀ y z ∈ U, ∀ (f : α →ᵇ β), f ∈ closure A → dist (f y) (f z) < ε,
-    begin
-      refine bex.imp_right (λ U U_set hU y hy z hz f hf, _) (H x (ε/2) (half_pos ε0)),
-      rcases metric.mem_closure_iff.1 hf (ε/2/2) (half_pos (half_pos ε0)) with ⟨g, gA, dist_fg⟩,
-      replace dist_fg := λ x, lt_of_le_of_lt (dist_coe_le_dist x) dist_fg,
-      calc dist (f y) (f z) ≤ dist (f y) (g y) + dist (f z) (g z) + dist (g y) (g z) :
-        dist_triangle4_right _ _ _ _
-          ... < ε/2/2 + ε/2/2 + ε/2 :
-            add_lt_add (add_lt_add (dist_fg y) (dist_fg z)) (hU y hy z hz g gA)
-          ... = ε : by rw [add_halves, add_halves]
-    end)
-
-/- To apply the previous theorems, one needs to check the equicontinuity. An important
-instance is when the source space is a metric space, and there is a fixed modulus of continuity
-for all the functions in the set A -/
-
-lemma equicontinuous_of_continuity_modulus {α : Type u} [pseudo_metric_space α]
-  (b : ℝ → ℝ) (b_lim : tendsto b (𝓝 0) (𝓝 0))
-  (A : set (α →ᵇ β))
-  (H : ∀(x y:α) (f : α →ᵇ β), f ∈ A → dist (f x) (f y) ≤ b (dist x y))
-  (x:α) (ε : ℝ) (ε0 : 0 < ε) : ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
-    f ∈ A → dist (f y) (f z) < ε :=
-begin
-  rcases tendsto_nhds_nhds.1 b_lim ε ε0 with ⟨δ, δ0, hδ⟩,
-  refine ⟨ball x (δ/2), ball_mem_nhds x (half_pos δ0), λ y hy z hz f hf, _⟩,
-  have : dist y z < δ := calc
-    dist y z ≤ dist y x + dist z x : dist_triangle_right _ _ _
-    ... < δ/2 + δ/2 : add_lt_add hy hz
-    ... = δ : add_halves _,
-  calc
-    dist (f y) (f z) ≤ b (dist y z) : H y z f hf
-    ... ≤ |b (dist y z)| : le_abs_self _
-    ... = dist (b (dist y z)) 0 : by simp [real.dist_eq]
-    ... < ε : hδ (by simpa [real.dist_eq] using this),
-end
+  (H.closure' continuous_coe)
 
 end arzela_ascoli
 
diff --git a/src/topology/dense_embedding.lean b/src/topology/dense_embedding.lean
index 1a4348cb76eea..261524bd0b5d8 100644
--- a/src/topology/dense_embedding.lean
+++ b/src/topology/dense_embedding.lean
@@ -282,6 +282,10 @@ de.to_dense_inducing.dense_image
 
 end dense_embedding
 
+lemma dense_embedding_id {α : Type*} [topological_space α] : dense_embedding (id : α → α) :=
+{ dense := dense_range_id,
+  .. embedding_id }
+
 lemma dense.dense_embedding_coe [topological_space α] {s : set α} (hs : dense s) :
   dense_embedding (coe : s → α) :=
 { dense := hs.dense_range_coe,
diff --git a/src/topology/inseparable.lean b/src/topology/inseparable.lean
index 2ad7c59a4d8d9..48f4bc2623521 100644
--- a/src/topology/inseparable.lean
+++ b/src/topology/inseparable.lean
@@ -132,6 +132,8 @@ lemma specializes_rfl : x ⤳ x := le_rfl
 
 @[trans] lemma specializes.trans : x ⤳ y → y ⤳ z → x ⤳ z := le_trans
 
+lemma specializes_of_eq (e : x = y) : x ⤳ y := e ▸ specializes_refl x
+
 lemma specializes_of_nhds_within (h₁ : 𝓝[s] x ≤ 𝓝[s] y) (h₂ : x ∈ s) : x ⤳ y :=
 specializes_iff_pure.2 $
 calc pure x ≤ 𝓝[s] x : le_inf (pure_le_nhds _) (le_principal_iff.2 h₂)
@@ -256,6 +258,8 @@ namespace inseparable
 
 lemma rfl : x ~ x := refl x
 
+lemma of_eq (e : x = y) : inseparable x y := e ▸ refl x
+
 @[symm] lemma symm (h : x ~ y) : y ~ x := h.symm
 
 @[trans] lemma trans (h₁ : x ~ y) (h₂ : y ~ z) : x ~ z := h₁.trans h₂
diff --git a/src/topology/instances/add_circle.lean b/src/topology/instances/add_circle.lean
index 008031f3968c7..ddec749e13e99 100644
--- a/src/topology/instances/add_circle.lean
+++ b/src/topology/instances/add_circle.lean
@@ -3,6 +3,7 @@ Copyright (c) 2022 Oliver Nash. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Oliver Nash
 -/
+import algebra.ring.add_aut
 import group_theory.divisible
 import group_theory.order_of_element
 import ring_theory.int.basic
@@ -110,19 +111,11 @@ end linear_ordered_add_comm_group
 section linear_ordered_field
 variables [linear_ordered_field 𝕜] [topological_space 𝕜] [order_topology 𝕜] (p q : 𝕜)
 
-/-- An auxiliary definition used only for constructing `add_circle.equiv_add_circle`. -/
-private def equiv_add_circle_aux (hp : p ≠ 0) : add_circle p →+ add_circle q :=
-quotient_add_group.lift _
-  ((quotient_add_group.mk' (zmultiples q)).comp $ add_monoid_hom.mul_right (p⁻¹ * q))
-  (λ x h, by obtain ⟨z, rfl⟩ := mem_zmultiples_iff.1 h; simp [hp, mul_assoc (z : 𝕜), ← mul_assoc p])
-
 /-- The rescaling equivalence between additive circles with different periods. -/
 def equiv_add_circle (hp : p ≠ 0) (hq : q ≠ 0) : add_circle p ≃+ add_circle q :=
-{ to_fun := equiv_add_circle_aux p q hp,
-  inv_fun := equiv_add_circle_aux q p hq,
-  left_inv := by { rintros ⟨x⟩, show quotient_add_group.mk _ = _, congr, field_simp [hp, hq], },
-  right_inv := by { rintros ⟨x⟩, show quotient_add_group.mk _ = _, congr, field_simp [hp, hq], },
-  .. equiv_add_circle_aux p q hp }
+quotient_add_group.congr _ _ (add_aut.mul_right $ (units.mk0 p hp)⁻¹ * units.mk0 q hq) $
+  by rw [add_monoid_hom.map_zmultiples, add_monoid_hom.coe_coe, add_aut.mul_right_apply,
+    units.coe_mul, units.coe_mk0, units.coe_inv, units.coe_mk0, mul_inv_cancel_left₀ hp]
 
 @[simp] lemma equiv_add_circle_apply_mk (hp : p ≠ 0) (hq : q ≠ 0) (x : 𝕜) :
   equiv_add_circle p q hp hq (x : 𝕜) = (x * (p⁻¹ * q) : 𝕜) :=
diff --git a/src/topology/instances/discrete.lean b/src/topology/instances/discrete.lean
index 7f1af26b74331..1dabbe8d159fb 100644
--- a/src/topology/instances/discrete.lean
+++ b/src/topology/instances/discrete.lean
@@ -5,7 +5,7 @@ Authors: Rémy Degenne
 -/
 
 import order.succ_pred.basic
-import topology.algebra.order.basic
+import topology.order.basic
 import topology.metric_space.metrizable_uniformity
 
 /-!
diff --git a/src/topology/instances/sign.lean b/src/topology/instances/sign.lean
index 5ed4798f7a5bb..bcd69e311abe4 100644
--- a/src/topology/instances/sign.lean
+++ b/src/topology/instances/sign.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Myers
 -/
 import data.sign
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Topology on `sign_type`
diff --git a/src/topology/locally_constant/algebra.lean b/src/topology/locally_constant/algebra.lean
index 158d2fc65bc0d..3f1eda30bc7b0 100644
--- a/src/topology/locally_constant/algebra.lean
+++ b/src/topology/locally_constant/algebra.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
-import algebra.algebra.basic
+import algebra.algebra.pi
 import topology.locally_constant.basic
 
 /-!
diff --git a/src/topology/metric_space/equicontinuity.lean b/src/topology/metric_space/equicontinuity.lean
new file mode 100644
index 0000000000000..f0b61162702b8
--- /dev/null
+++ b/src/topology/metric_space/equicontinuity.lean
@@ -0,0 +1,127 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anatole Dedecker
+-/
+
+import topology.metric_space.basic
+import topology.uniform_space.equicontinuity
+/-!
+# Equicontinuity in metric spaces
+
+This files contains various facts about (uniform) equicontinuity in metric spaces. Most
+importantly, we prove the usual characterization of equicontinuity of `F` at `x₀` in the case of
+(pseudo) metric spaces: `∀ ε > 0, ∃ δ > 0, ∀ x, dist x x₀ < δ → ∀ i, dist (F i x₀) (F i x) < ε`,
+and we prove that functions sharing a common (local or global) continuity modulus are
+(locally or uniformly) equicontinuous.
+
+## Main statements
+
+* `equicontinuous_at_iff`: characterization of equicontinuity for families of functions between
+  (pseudo) metric spaces.
+* `equicontinuous_at_of_continuity_modulus`: convenient way to prove equicontinuity at a point of
+  a family of functions to a (pseudo) metric space by showing that they share a common *local*
+  continuity modulus.
+* `uniform_equicontinuous_of_continuity_modulus`: convenient way to prove uniform equicontinuity
+  of a family of functions to a (pseudo) metric space by showing that they share a common *global*
+  continuity modulus.
+
+## Tags
+
+equicontinuity, continuity modulus
+-/
+
+open filter
+open_locale topological_space uniformity
+
+variables {α β ι : Type*} [pseudo_metric_space α]
+
+namespace metric
+
+/-- Characterization of equicontinuity for families of functions taking values in a (pseudo) metric
+space. -/
+lemma equicontinuous_at_iff_right {ι : Type*} [topological_space β] {F : ι → β → α} {x₀ : β} :
+  equicontinuous_at F x₀ ↔ ∀ ε > 0, ∀ᶠ x in 𝓝 x₀, ∀ i, dist (F i x₀) (F i x) < ε :=
+uniformity_basis_dist.equicontinuous_at_iff_right
+
+/-- Characterization of equicontinuity for families of functions between (pseudo) metric spaces. -/
+lemma equicontinuous_at_iff {ι : Type*} [pseudo_metric_space β] {F : ι → β → α} {x₀ : β} :
+  equicontinuous_at F x₀ ↔ ∀ ε > 0, ∃ δ > 0, ∀ x, dist x x₀ < δ → ∀ i, dist (F i x₀) (F i x) < ε :=
+nhds_basis_ball.equicontinuous_at_iff uniformity_basis_dist
+
+/-- Reformulation of `equicontinuous_at_iff_pair` for families of functions taking values in a
+(pseudo) metric space. -/
+protected lemma equicontinuous_at_iff_pair {ι : Type*} [topological_space β] {F : ι → β → α}
+  {x₀ : β} :
+  equicontinuous_at F x₀ ↔ ∀ ε > 0, ∃ U ∈ 𝓝 x₀, ∀ (x x' ∈ U), ∀ i, dist (F i x) (F i x') < ε :=
+begin
+  rw equicontinuous_at_iff_pair,
+  split; intros H,
+  { intros ε hε,
+    refine exists_imp_exists (λ V, exists_imp_exists $ λ hV h, _) (H _ (dist_mem_uniformity hε)),
+    exact λ x hx x' hx', h _ hx _ hx' },
+  { intros U hU,
+    rcases mem_uniformity_dist.mp hU with ⟨ε, hε, hεU⟩,
+    refine exists_imp_exists (λ V, exists_imp_exists $ λ hV h, _) (H _ hε),
+    exact λ x hx x' hx' i, hεU (h _ hx _ hx' i) }
+end
+
+/-- Characterization of uniform equicontinuity for families of functions taking values in a
+(pseudo) metric space. -/
+lemma uniform_equicontinuous_iff_right {ι : Type*} [uniform_space β] {F : ι → β → α} :
+  uniform_equicontinuous F ↔
+  ∀ ε > 0, ∀ᶠ (xy : β × β) in 𝓤 β, ∀ i, dist (F i xy.1) (F i xy.2) < ε :=
+uniformity_basis_dist.uniform_equicontinuous_iff_right
+
+/-- Characterization of uniform equicontinuity for families of functions between
+(pseudo) metric spaces. -/
+lemma uniform_equicontinuous_iff {ι : Type*} [pseudo_metric_space β] {F : ι → β → α} :
+  uniform_equicontinuous F ↔
+  ∀ ε > 0, ∃ δ > 0, ∀ x y, dist x y < δ → ∀ i, dist (F i x) (F i y) < ε :=
+uniformity_basis_dist.uniform_equicontinuous_iff uniformity_basis_dist
+
+/-- For a family of functions to a (pseudo) metric spaces, a convenient way to prove
+equicontinuity at a point is to show that all of the functions share a common *local* continuity
+modulus. -/
+lemma equicontinuous_at_of_continuity_modulus {ι : Type*} [topological_space β] {x₀ : β}
+  (b : β → ℝ)
+  (b_lim : tendsto b (𝓝 x₀) (𝓝 0))
+  (F : ι → β → α)
+  (H : ∀ᶠ x in 𝓝 x₀, ∀ i, dist (F i x₀) (F i x) ≤ b x) :
+  equicontinuous_at F x₀ :=
+begin
+  rw metric.equicontinuous_at_iff_right,
+  intros ε ε0,
+  filter_upwards [b_lim (Iio_mem_nhds ε0), H] using λ x hx₁ hx₂ i, (hx₂ i).trans_lt hx₁
+end
+
+/-- For a family of functions between (pseudo) metric spaces, a convenient way to prove
+uniform equicontinuity is to show that all of the functions share a common *global* continuity
+modulus. -/
+lemma uniform_equicontinuous_of_continuity_modulus {ι : Type*} [pseudo_metric_space β] (b : ℝ → ℝ)
+  (b_lim : tendsto b (𝓝 0) (𝓝 0))
+  (F : ι → β → α)
+  (H : ∀ (x y : β) i, dist (F i x) (F i y) ≤ b (dist x y)) :
+  uniform_equicontinuous F :=
+begin
+  rw metric.uniform_equicontinuous_iff,
+  intros ε ε0,
+  rcases tendsto_nhds_nhds.1 b_lim ε ε0 with ⟨δ, δ0, hδ⟩,
+  refine ⟨δ, δ0, λ x y hxy i, _⟩,
+  calc
+    dist (F i x) (F i y) ≤ b (dist x y) : H x y i
+    ... ≤ |b (dist x y)| : le_abs_self _
+    ... = dist (b (dist x y)) 0 : by simp [real.dist_eq]
+    ... < ε : hδ (by simpa only [real.dist_eq, tsub_zero, abs_dist] using hxy)
+end
+
+/-- For a family of functions between (pseudo) metric spaces, a convenient way to prove
+equicontinuity is to show that all of the functions share a common *global* continuity modulus. -/
+lemma equicontinuous_of_continuity_modulus {ι : Type*} [pseudo_metric_space β] (b : ℝ → ℝ)
+  (b_lim : tendsto b (𝓝 0) (𝓝 0))
+  (F : ι → β → α)
+  (H : ∀ (x y : β) i, dist (F i x) (F i y) ≤ b (dist x y)) :
+  equicontinuous F :=
+(uniform_equicontinuous_of_continuity_modulus b b_lim F H).equicontinuous
+
+end metric
diff --git a/src/topology/metric_space/gromov_hausdorff_realized.lean b/src/topology/metric_space/gromov_hausdorff_realized.lean
index 1245c6d4a86c0..c8bf97b84234c 100644
--- a/src/topology/metric_space/gromov_hausdorff_realized.lean
+++ b/src/topology/metric_space/gromov_hausdorff_realized.lean
@@ -269,7 +269,7 @@ begin
     { have : tendsto (λ (t : ℝ), 2 * (max_var X Y : ℝ) * t) (𝓝 0) (𝓝 (2 * max_var X Y * 0)) :=
         tendsto_const_nhds.mul tendsto_id,
       simpa using this },
-    { assume x y f hf,
+    { rintros x y ⟨f, hf⟩,
       exact (candidates_lipschitz hf).dist_le_mul _ _ } }
 end
 
diff --git a/src/topology/metric_space/hausdorff_dimension.lean b/src/topology/metric_space/hausdorff_dimension.lean
index 976e0f419be16..28dd8e7a54eeb 100644
--- a/src/topology/metric_space/hausdorff_dimension.lean
+++ b/src/topology/metric_space/hausdorff_dimension.lean
@@ -484,7 +484,7 @@ variables {E F : Type*}
 
 theorem dense_compl_of_dimH_lt_finrank {s : set E} (hs : dimH s < finrank ℝ E) : dense sᶜ :=
 begin
-  refine λ x, mem_closure_iff_nhds.2 (λ t ht, ne_empty_iff_nonempty.1 $ λ he, hs.not_le _),
+  refine λ x, mem_closure_iff_nhds.2 (λ t ht, nonempty_iff_ne_empty.2 $ λ he, hs.not_le _),
   rw [← diff_eq, diff_eq_empty] at he,
   rw [← real.dimH_of_mem_nhds ht],
   exact dimH_mono he
diff --git a/src/topology/metric_space/metrizable_uniformity.lean b/src/topology/metric_space/metrizable_uniformity.lean
index 30a3f2f786ec1..599bd8385e659 100644
--- a/src/topology/metric_space/metrizable_uniformity.lean
+++ b/src/topology/metric_space/metrizable_uniformity.lean
@@ -226,7 +226,7 @@ begin
   { refine λ n hn, ⟨n + 1, trivial, λ x hx, _⟩,
     rw [mem_set_of_eq] at hx,
     contrapose! hx,
-    refine le_trans _ ((div_le_iff' (@two_pos ℝ _ _)).2 (hd_le x.1 x.2)),
+    refine le_trans _ ((div_le_iff' (zero_lt_two' ℝ)).2 (hd_le x.1 x.2)),
     rwa [← nnreal.coe_two, ← nnreal.coe_div, ← nnreal.coe_pow, nnreal.coe_le_coe, pow_succ',
       mul_one_div, nnreal.div_le_iff two_ne_zero, div_mul_cancel _ (two_ne_zero' ℝ≥0),
       hle_d, prod.mk.eta] }
diff --git a/src/topology/algebra/order/basic.lean b/src/topology/order/basic.lean
similarity index 99%
rename from src/topology/algebra/order/basic.lean
rename to src/topology/order/basic.lean
index bbc2f2d8c34d4..5d09aabc6822f 100644
--- a/src/topology/algebra/order/basic.lean
+++ b/src/topology/order/basic.lean
@@ -1163,7 +1163,7 @@ begin
   { assume x z xs hz,
     have A : Ioo x (y x) = ∅ := h'y _ xs,
     contrapose! A,
-    exact ne_empty_iff_nonempty.2 ⟨z, A, hz⟩ },
+    exact nonempty.ne_empty ⟨z, A, hz⟩ },
   suffices H : ∀ (a : set α), is_open a → set.countable {x | x ∈ s ∧ x ∈ a ∧ y x ∉ a},
   { have : s ⊆ ⋃ (a ∈ countable_basis α), {x | x ∈ s ∧ x ∈ a ∧ y x ∉ a},
     { assume x hx,
diff --git a/src/topology/order/lattice.lean b/src/topology/order/lattice.lean
index a8880feb4642c..9cf03943e0905 100644
--- a/src/topology/order/lattice.lean
+++ b/src/topology/order/lattice.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Christopher Hoskin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Christopher Hoskin
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 import topology.constructions
 
 /-!
diff --git a/src/topology/separation.lean b/src/topology/separation.lean
index a5bc09e356b2f..96c9ff01d93b7 100644
--- a/src/topology/separation.lean
+++ b/src/topology/separation.lean
@@ -659,7 +659,7 @@ lemma continuous_at_of_tendsto_nhds [topological_space β] [t1_space β] {f : α
   (h : tendsto f (𝓝 a) (𝓝 b)) : continuous_at f a :=
 show tendsto f (𝓝 a) (𝓝 $ f a), by rwa eq_of_tendsto_nhds h
 
-lemma tendsto_const_nhds_iff [t1_space α] {l : filter α} [ne_bot l] {c d : α} :
+@[simp] lemma tendsto_const_nhds_iff [t1_space α] {l : filter β} [ne_bot l] {c d : α} :
   tendsto (λ x, c) l (𝓝 d) ↔ c = d :=
 by simp_rw [tendsto, filter.map_const, pure_le_nhds_iff]
 
diff --git a/src/topology/sheaves/stalks.lean b/src/topology/sheaves/stalks.lean
index c502ec448242e..772a1e0c892c7 100644
--- a/src/topology/sheaves/stalks.lean
+++ b/src/topology/sheaves/stalks.lean
@@ -306,6 +306,19 @@ lemma germ_stalk_specializes' (F : X.presheaf C) {U : opens X} {x y : X} (h : x
   F.germ ⟨y, hy⟩ ≫ F.stalk_specializes h =
     F.germ ⟨x, specializes_iff_forall_open.mp h _ U.2 hy⟩ := colimit.ι_desc _ _
 
+@[simp]
+lemma stalk_specializes_refl {C : Type*} [category C] [limits.has_colimits C]
+  {X : Top} (F : X.presheaf C) (x : X) :
+  F.stalk_specializes (specializes_refl x) = 𝟙 _ :=
+F.stalk_hom_ext $ λ _ _, by { dsimp, simpa }
+
+@[simp, reassoc, elementwise]
+lemma stalk_specializes_comp {C : Type*} [category C] [limits.has_colimits C]
+  {X : Top} (F : X.presheaf C)
+  {x y z : X} (h : x ⤳ y) (h' : y ⤳ z) :
+  F.stalk_specializes h' ≫ F.stalk_specializes h = F.stalk_specializes (h.trans h') :=
+F.stalk_hom_ext $ λ _ _, by simp
+
 @[simp, reassoc, elementwise]
 lemma stalk_specializes_stalk_functor_map {F G : X.presheaf C} (f : F ⟶ G) {x y : X} (h : x ⤳ y) :
   F.stalk_specializes h ≫ (stalk_functor C x).map f =
@@ -318,6 +331,13 @@ lemma stalk_specializes_stalk_pushforward (f : X ⟶ Y) (F : X.presheaf C) {x y
     F.stalk_pushforward _ f y ≫ F.stalk_specializes h :=
 by { ext, delta stalk_pushforward, simpa [stalk_specializes] }
 
+/-- The stalks are isomorphic on inseparable points -/
+@[simps]
+def stalk_congr {X : Top} {C : Type*} [category C] [has_colimits C]
+  (F : X.presheaf C) {x y : X}
+  (e : inseparable x y) : F.stalk x ≅ F.stalk y :=
+⟨F.stalk_specializes e.ge, F.stalk_specializes e.le, by simp, by simp⟩
+
 end stalk_specializes
 
 section concrete
diff --git a/src/topology/subset_properties.lean b/src/topology/subset_properties.lean
index 6459a516b6ab0..205223f8efb92 100644
--- a/src/topology/subset_properties.lean
+++ b/src/topology/subset_properties.lean
@@ -7,6 +7,7 @@ import order.filter.pi
 import topology.bases
 import data.finset.order
 import data.set.accumulate
+import data.set.bool_indicator
 import topology.bornology.basic
 import order.minimal
 
@@ -257,7 +258,7 @@ lemma is_compact.inter_Inter_nonempty {s : set α} {ι : Type v} (hs : is_compac
   (Z : ι → set α) (hZc : ∀ i, is_closed (Z i)) (hsZ : ∀ t : finset ι, (s ∩ ⋂ i ∈ t, Z i).nonempty) :
   (s ∩ ⋂ i, Z i).nonempty :=
 begin
-  simp only [← ne_empty_iff_nonempty] at hsZ ⊢,
+  simp only [nonempty_iff_ne_empty] at hsZ ⊢,
   apply mt (hs.elim_finite_subfamily_closed Z hZc), push_neg, exact hsZ
 end
 
@@ -273,7 +274,7 @@ begin
   let Z' := λ i, Z i ∩ Z i₀,
   suffices : (⋂ i, Z' i).nonempty,
   { exact this.mono (Inter_mono $ λ i, inter_subset_left (Z i) (Z i₀)) },
-  rw ← ne_empty_iff_nonempty,
+  rw nonempty_iff_ne_empty,
   intro H,
   obtain ⟨t, ht⟩ : ∃ (t : finset ι), ((Z i₀) ∩ ⋂ (i ∈ t), Z' i) = ∅,
     from (hZc i₀).elim_finite_subfamily_closed Z'
@@ -285,7 +286,7 @@ begin
     intros j hj,
     exact subset_inter (subset.trans hi₁ (hi j hj)) hi₁₀ },
   suffices : ((Z i₀) ∩ ⋂ (i ∈ t), Z' i).nonempty,
-  { rw ← ne_empty_iff_nonempty at this, contradiction },
+  { rw nonempty_iff_ne_empty at this, contradiction },
   exact (hZn i₁).mono (subset_inter hi₁.left $ subset_Inter₂ hi₁.right),
 end
 
diff --git a/src/topology/uniform_space/compact.lean b/src/topology/uniform_space/compact.lean
index d12dd6a7977c8..ccdd3cad6874f 100644
--- a/src/topology/uniform_space/compact.lean
+++ b/src/topology/uniform_space/compact.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot, Yury Kudryashov
 -/
 import topology.uniform_space.uniform_convergence
+import topology.uniform_space.equicontinuity
 import topology.separation
 
 /-!
@@ -178,7 +179,7 @@ def uniform_space_of_compact_t2 [topological_space γ] [compact_space γ] [t2_sp
 ### Heine-Cantor theorem
 -/
 
-/-- Heine-Cantor: a continuous function on a compact separated uniform space is uniformly
+/-- Heine-Cantor: a continuous function on a compact uniform space is uniformly
 continuous. -/
 lemma compact_space.uniform_continuous_of_continuous [compact_space α]
   {f : α → β} (h : continuous f) : uniform_continuous f :=
@@ -220,3 +221,18 @@ locally compact and `β` is compact. -/
 lemma continuous.tendsto_uniformly [locally_compact_space α] [compact_space β] [uniform_space γ]
   (f : α → β → γ) (h : continuous ↿f) (x : α) : tendsto_uniformly f (f x) (𝓝 x) :=
 h.continuous_on.tendsto_uniformly univ_mem
+
+section uniform_convergence
+
+/-- An equicontinuous family of functions defined on a compact uniform space is automatically
+uniformly equicontinuous. -/
+lemma compact_space.uniform_equicontinuous_of_equicontinuous {ι : Type*} {F : ι → β → α}
+  [compact_space β] (h : equicontinuous F) :
+  uniform_equicontinuous F :=
+begin
+  rw equicontinuous_iff_continuous at h,
+  rw uniform_equicontinuous_iff_uniform_continuous,
+  exact compact_space.uniform_continuous_of_continuous h
+end
+
+end uniform_convergence
diff --git a/src/topology/uniform_space/equicontinuity.lean b/src/topology/uniform_space/equicontinuity.lean
new file mode 100644
index 0000000000000..f8fa1f4166975
--- /dev/null
+++ b/src/topology/uniform_space/equicontinuity.lean
@@ -0,0 +1,425 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anatole Dedecker
+-/
+import topology.uniform_space.uniform_convergence_topology
+
+/-!
+# Equicontinuity of a family of functions
+
+Let `X` be a topological space and `α` a `uniform_space`. A family of functions `F : ι → X → α`
+is said to be *equicontinuous at a point `x₀ : X`* when, for any entourage `U` in `α`, there is a
+neighborhood `V` of `x₀` such that, for all `x ∈ V`, and *for all `i`*, `F i x` is `U`-close to
+`F i x₀`. In other words, one has `∀ U ∈ 𝓤 α, ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ U`.
+For maps between metric spaces, this corresponds to
+`∀ ε > 0, ∃ δ > 0, ∀ x, ∀ i, dist x₀ x < δ → dist (F i x₀) (F i x) < ε`.
+
+`F` is said to be *equicontinuous* if it is equicontinuous at each point.
+
+A closely related concept is that of ***uniform*** *equicontinuity* of a family of functions
+`F : ι → β → α` between uniform spaces, which means that, for any entourage `U` in `α`, there is an
+entourage `V` in `β` such that, if `x` and `y` are `V`-close, then *for all `i`*, `F i x` and
+`F i y` are `U`-close. In other words, one has
+`∀ U ∈ 𝓤 α, ∀ᶠ xy in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ U`.
+For maps between metric spaces, this corresponds to
+`∀ ε > 0, ∃ δ > 0, ∀ x y, ∀ i, dist x y < δ → dist (F i x₀) (F i x) < ε`.
+
+## Main definitions
+
+* `equicontinuous_at`: equicontinuity of a family of functions at a point
+* `equicontinuous`: equicontinuity of a family of functions on the whole domain
+* `uniform_equicontinuous`: uniform equicontinuity of a family of functions on the whole domain
+
+## Main statements
+
+* `equicontinuous_iff_continuous`: equicontinuity can be expressed as a simple continuity
+  condition between well-chosen function spaces. This is really useful for building up the theory.
+* `equicontinuous.closure`: if a set of functions is equicontinuous, its closure
+  *for the topology of uniform convergence* is also equicontinuous.
+
+## Notations
+
+Throughout this file, we use :
+- `ι`, `κ` for indexing types
+- `X`, `Y`, `Z` for topological spaces
+- `α`, `β`, `γ` for uniform spaces
+
+## Implementation details
+
+We choose to express equicontinuity as a properties of indexed families of functions rather
+than sets of functions for the following reasons:
+- it is really easy to express equicontinuity of `H : set (X → α)` using our setup: it is just
+  equicontinuity of the family `coe : ↥H → (X → α)`. On the other hand, going the other way around
+  would require working with the range of the family, which is always annoying because it
+  introduces useless existentials.
+- in most applications, one doesn't work with bare functions but with a more specific hom type
+  `hom`. Equicontinuity of a set `H : set hom` would then have to be expressed as equicontinuity
+  of `coe_fn '' H`, which is super annoying to work with. This is much simpler with families,
+  because equicontinuity of a family `𝓕 : ι → hom` would simply be expressed as equicontinuity
+  of `coe_fn ∘ 𝓕`, which doesn't introduce any nasty existentials.
+
+To simplify statements, we do provide abbreviations `set.equicontinuous_at`, `set.equicontinuous`
+and `set.uniform_equicontinuous` asserting the corresponding fact about the family
+`coe : ↥H → (X → α)` where `H : set (X → α)`. Note however that these won't work for sets of hom
+types, and in that case one should go back to the family definition rather than using `set.image`.
+
+Since we have no use case for it yet, we don't introduce any relative version
+(i.e no `equicontinuous_within_at` or `equicontinuous_on`), but this is more of a conservative
+position than a design decision, so anyone needing relative versions should feel free to add them,
+and that should hopefully be a straightforward task.
+
+## References
+
+* [N. Bourbaki, *General Topology, Chapter X*][bourbaki1966]
+
+## Tags
+
+equicontinuity, uniform convergence, ascoli
+-/
+
+section
+
+open uniform_space filter set
+open_locale uniformity topological_space uniform_convergence
+
+variables {ι κ X Y Z α β γ 𝓕 : Type*} [topological_space X] [topological_space Y]
+  [topological_space Z] [uniform_space α] [uniform_space β] [uniform_space γ]
+
+/-- A family `F : ι → X → α` of functions from a topological space to a uniform space is
+*equicontinuous at `x₀ : X`* if, for all entourage `U ∈ 𝓤 α`, there is a neighborhood `V` of `x₀`
+such that, for all `x ∈ V` and for all `i : ι`, `F i x` is `U`-close to `F i x₀`. -/
+def equicontinuous_at (F : ι → X → α) (x₀ : X) : Prop :=
+∀ U ∈ 𝓤 α, ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ U
+
+/-- We say that a set `H : set (X → α)` of functions is equicontinuous at a point if the family
+`coe : ↥H → (X → α)` is equicontinuous at that point. -/
+protected abbreviation set.equicontinuous_at (H : set $ X → α) (x₀ : X) : Prop :=
+equicontinuous_at (coe : H → X → α) x₀
+
+/-- A family `F : ι → X → α` of functions from a topological space to a uniform space is
+*equicontinuous* on all of `X` if it is equicontinuous at each point of `X`. -/
+def equicontinuous (F : ι → X → α) : Prop :=
+∀ x₀, equicontinuous_at F x₀
+
+/-- We say that a set `H : set (X → α)` of functions is equicontinuous if the family
+`coe : ↥H → (X → α)` is equicontinuous. -/
+protected abbreviation set.equicontinuous (H : set $ X → α) : Prop :=
+equicontinuous (coe : H → X → α)
+
+/-- A family `F : ι → β → α` of functions between uniform spaces is *uniformly equicontinuous* if,
+for all entourage `U ∈ 𝓤 α`, there is an entourage `V ∈ 𝓤 β` such that, whenever `x` and `y` are
+`V`-close, we have that, *for all `i : ι`*, `F i x` is `U`-close to `F i x₀`. -/
+def uniform_equicontinuous (F : ι → β → α) : Prop :=
+∀ U ∈ 𝓤 α, ∀ᶠ (xy : β × β) in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ U
+
+/-- We say that a set `H : set (X → α)` of functions is uniformly equicontinuous if the family
+`coe : ↥H → (X → α)` is uniformly equicontinuous. -/
+protected abbreviation set.uniform_equicontinuous (H : set $ β → α) : Prop :=
+uniform_equicontinuous (coe : H → β → α)
+
+/-- Reformulation of equicontinuity at `x₀` comparing two variables near `x₀` instead of comparing
+only one with `x₀`. -/
+lemma equicontinuous_at_iff_pair {F : ι → X → α} {x₀ : X} : equicontinuous_at F x₀ ↔
+  ∀ U ∈ 𝓤 α, ∃ V ∈ 𝓝 x₀, ∀ (x y ∈ V) i, (F i x, F i y) ∈ U :=
+begin
+  split; intros H U hU,
+  { rcases comp_symm_mem_uniformity_sets hU with ⟨V, hV, hVsymm, hVU⟩,
+    refine ⟨_, H V hV, λ x hx y hy i, hVU (prod_mk_mem_comp_rel _ (hy i))⟩,
+    exact hVsymm.mk_mem_comm.mp (hx i) },
+  { rcases H U hU with ⟨V, hV, hVU⟩,
+    filter_upwards [hV] using λ x hx i, (hVU x₀ (mem_of_mem_nhds hV) x hx i) }
+end
+
+/-- Uniform equicontinuity implies equicontinuity. -/
+lemma uniform_equicontinuous.equicontinuous {F : ι → β → α} (h : uniform_equicontinuous F) :
+  equicontinuous F :=
+λ x₀ U hU, mem_of_superset (ball_mem_nhds x₀ (h U hU)) (λ x hx i, hx i)
+
+/-- Each function of a family equicontinuous at `x₀` is continuous at `x₀`. -/
+lemma equicontinuous_at.continuous_at {F : ι → X → α} {x₀ : X} (h : equicontinuous_at F x₀)
+  (i : ι) : continuous_at (F i) x₀ :=
+begin
+  intros U hU,
+  rw uniform_space.mem_nhds_iff at hU,
+  rcases hU with ⟨V, hV₁, hV₂⟩,
+  exact mem_map.mpr (mem_of_superset (h V hV₁) (λ x hx, hV₂ (hx i)))
+end
+
+protected lemma set.equicontinuous_at.continuous_at_of_mem {H : set $ X → α} {x₀ : X}
+  (h : H.equicontinuous_at x₀) {f : X → α} (hf : f ∈ H) : continuous_at f x₀ :=
+h.continuous_at ⟨f, hf⟩
+
+/-- Each function of an equicontinuous family is continuous. -/
+lemma equicontinuous.continuous {F : ι → X → α} (h : equicontinuous F) (i : ι) :
+  continuous (F i) :=
+continuous_iff_continuous_at.mpr (λ x, (h x).continuous_at i)
+
+protected lemma set.equicontinuous.continuous_of_mem {H : set $ X → α} (h : H.equicontinuous)
+  {f : X → α} (hf : f ∈ H) : continuous f :=
+h.continuous ⟨f, hf⟩
+
+/-- Each function of a uniformly equicontinuous family is uniformly continuous. -/
+lemma uniform_equicontinuous.uniform_continuous {F : ι → β → α} (h : uniform_equicontinuous F)
+  (i : ι) : uniform_continuous (F i) :=
+λ U hU, mem_map.mpr (mem_of_superset (h U hU) $ λ xy hxy, (hxy i))
+
+protected lemma set.uniform_equicontinuous.uniform_continuous_of_mem {H : set $ β → α}
+  (h : H.uniform_equicontinuous) {f : β → α} (hf : f ∈ H) : uniform_continuous f :=
+h.uniform_continuous ⟨f, hf⟩
+
+/-- Taking sub-families preserves equicontinuity at a point. -/
+lemma equicontinuous_at.comp {F : ι → X → α} {x₀ : X} (h : equicontinuous_at F x₀) (u : κ → ι) :
+  equicontinuous_at (F ∘ u) x₀ :=
+λ U hU, (h U hU).mono (λ x H k, H (u k))
+
+protected lemma set.equicontinuous_at.mono {H H' : set $ X → α} {x₀ : X}
+  (h : H.equicontinuous_at x₀) (hH : H' ⊆ H) : H'.equicontinuous_at x₀ :=
+h.comp (inclusion hH)
+
+/-- Taking sub-families preserves equicontinuity. -/
+lemma equicontinuous.comp {F : ι → X → α} (h : equicontinuous F) (u : κ → ι) :
+  equicontinuous (F ∘ u) :=
+λ x, (h x).comp u
+
+protected lemma set.equicontinuous.mono {H H' : set $ X → α}
+  (h : H.equicontinuous) (hH : H' ⊆ H) : H'.equicontinuous :=
+h.comp (inclusion hH)
+
+/-- Taking sub-families preserves uniform equicontinuity. -/
+lemma uniform_equicontinuous.comp {F : ι → β → α} (h : uniform_equicontinuous F) (u : κ → ι) :
+  uniform_equicontinuous (F ∘ u) :=
+λ U hU, (h U hU).mono (λ x H k, H (u k))
+
+protected lemma set.uniform_equicontinuous.mono {H H' : set $ β → α}
+  (h : H.uniform_equicontinuous) (hH : H' ⊆ H) : H'.uniform_equicontinuous :=
+h.comp (inclusion hH)
+
+/-- A family `𝓕 : ι → X → α` is equicontinuous at `x₀` iff `range 𝓕` is equicontinuous at `x₀`,
+i.e the family `coe : range F → X → α` is equicontinuous at `x₀`. -/
+lemma equicontinuous_at_iff_range {F : ι → X → α} {x₀ : X} :
+  equicontinuous_at F x₀ ↔ equicontinuous_at (coe : range F → X → α) x₀ :=
+⟨λ h, by rw ← comp_range_splitting F; exact h.comp _, λ h, h.comp (range_factorization F)⟩
+
+/-- A family `𝓕 : ι → X → α` is equicontinuous iff `range 𝓕` is equicontinuous,
+i.e the family `coe : range F → X → α` is equicontinuous. -/
+lemma equicontinuous_iff_range {F : ι → X → α} :
+  equicontinuous F ↔ equicontinuous (coe : range F → X → α) :=
+forall_congr (λ x₀, equicontinuous_at_iff_range)
+
+/-- A family `𝓕 : ι → β → α` is uniformly equicontinuous iff `range 𝓕` is uniformly equicontinuous,
+i.e the family `coe : range F → β → α` is uniformly equicontinuous. -/
+lemma uniform_equicontinuous_at_iff_range {F : ι → β → α} :
+  uniform_equicontinuous F ↔ uniform_equicontinuous (coe : range F → β → α) :=
+⟨λ h, by rw ← comp_range_splitting F; exact h.comp _, λ h, h.comp (range_factorization F)⟩
+
+section
+
+open uniform_fun
+
+/-- A family `𝓕 : ι → X → α` is equicontinuous at `x₀` iff the function `swap 𝓕 : X → ι → α` is
+continuous at `x₀` *when `ι → α` is equipped with the topology of uniform convergence*. This is
+very useful for developping the equicontinuity API, but it should not be used directly for other
+purposes. -/
+lemma equicontinuous_at_iff_continuous_at {F : ι → X → α} {x₀ : X} :
+  equicontinuous_at F x₀ ↔ continuous_at (of_fun ∘ function.swap F : X → ι →ᵤ α) x₀ :=
+by rw [continuous_at, (uniform_fun.has_basis_nhds ι α _).tendsto_right_iff]; refl
+
+/-- A family `𝓕 : ι → X → α` is equicontinuous iff the function `swap 𝓕 : X → ι → α` is
+continuous *when `ι → α` is equipped with the topology of uniform convergence*. This is
+very useful for developping the equicontinuity API, but it should not be used directly for other
+purposes. -/
+lemma equicontinuous_iff_continuous {F : ι → X → α} :
+  equicontinuous F ↔ continuous (of_fun ∘ function.swap F : X → ι →ᵤ α) :=
+by simp_rw [equicontinuous, continuous_iff_continuous_at, equicontinuous_at_iff_continuous_at]
+
+/-- A family `𝓕 : ι → β → α` is uniformly equicontinuous iff the function `swap 𝓕 : β → ι → α` is
+uniformly continuous *when `ι → α` is equipped with the uniform structure of uniform convergence*.
+This is very useful for developping the equicontinuity API, but it should not be used directly
+for other purposes. -/
+lemma uniform_equicontinuous_iff_uniform_continuous {F : ι → β → α} :
+  uniform_equicontinuous F ↔ uniform_continuous (of_fun ∘ function.swap F : β → ι →ᵤ α) :=
+by rw [uniform_continuous, (uniform_fun.has_basis_uniformity ι α).tendsto_right_iff]; refl
+
+lemma filter.has_basis.equicontinuous_at_iff_left {κ : Type*} {p : κ → Prop} {s : κ → set X}
+  {F : ι → X → α} {x₀ : X} (hX : (𝓝 x₀).has_basis p s) : equicontinuous_at F x₀ ↔
+  ∀ U ∈ 𝓤 α, ∃ k (_ : p k), ∀ x ∈ s k, ∀ i, (F i x₀, F i x) ∈ U :=
+begin
+  rw [equicontinuous_at_iff_continuous_at, continuous_at,
+      hX.tendsto_iff (uniform_fun.has_basis_nhds ι α _)],
+  refl
+end
+
+lemma filter.has_basis.equicontinuous_at_iff_right {κ : Type*} {p : κ → Prop} {s : κ → set (α × α)}
+  {F : ι → X → α} {x₀ : X} (hα : (𝓤 α).has_basis p s) : equicontinuous_at F x₀ ↔
+  ∀ k, p k → ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ s k :=
+begin
+  rw [equicontinuous_at_iff_continuous_at, continuous_at,
+      (uniform_fun.has_basis_nhds_of_basis ι α _ hα).tendsto_right_iff],
+  refl
+end
+
+lemma filter.has_basis.equicontinuous_at_iff {κ₁ κ₂ : Type*} {p₁ : κ₁ → Prop} {s₁ : κ₁ → set X}
+  {p₂ : κ₂ → Prop} {s₂ : κ₂ → set (α × α)} {F : ι → X → α} {x₀ : X}
+  (hX : (𝓝 x₀).has_basis p₁ s₁) (hα : (𝓤 α).has_basis p₂ s₂) : equicontinuous_at F x₀ ↔
+  ∀ k₂, p₂ k₂ → ∃ k₁ (_ : p₁ k₁), ∀ x ∈ s₁ k₁, ∀ i, (F i x₀, F i x) ∈ s₂ k₂ :=
+begin
+  rw [equicontinuous_at_iff_continuous_at, continuous_at,
+      hX.tendsto_iff (uniform_fun.has_basis_nhds_of_basis ι α _ hα)],
+  refl
+end
+
+lemma filter.has_basis.uniform_equicontinuous_iff_left {κ : Type*} {p : κ → Prop}
+  {s : κ → set (β × β)} {F : ι → β → α} (hβ : (𝓤 β).has_basis p s) : uniform_equicontinuous F ↔
+  ∀ U ∈ 𝓤 α, ∃ k (_ : p k), ∀ x y, (x, y) ∈ s k → ∀ i, (F i x, F i y) ∈ U :=
+begin
+  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_continuous,
+      hβ.tendsto_iff (uniform_fun.has_basis_uniformity ι α)],
+  simp_rw [prod.forall],
+  refl
+end
+
+lemma filter.has_basis.uniform_equicontinuous_iff_right {κ : Type*} {p : κ → Prop}
+  {s : κ → set (α × α)} {F : ι → β → α} (hα : (𝓤 α).has_basis p s) : uniform_equicontinuous F ↔
+  ∀ k, p k → ∀ᶠ (xy : β × β) in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ s k :=
+begin
+  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_continuous,
+      (uniform_fun.has_basis_uniformity_of_basis ι α hα).tendsto_right_iff],
+  refl
+end
+
+lemma filter.has_basis.uniform_equicontinuous_iff {κ₁ κ₂ : Type*} {p₁ : κ₁ → Prop}
+  {s₁ : κ₁ → set (β × β)} {p₂ : κ₂ → Prop} {s₂ : κ₂ → set (α × α)} {F : ι → β → α}
+  (hβ : (𝓤 β).has_basis p₁ s₁) (hα : (𝓤 α).has_basis p₂ s₂) : uniform_equicontinuous F ↔
+  ∀ k₂, p₂ k₂ → ∃ k₁ (_ : p₁ k₁), ∀ x y, (x, y) ∈ s₁ k₁ → ∀ i, (F i x, F i y) ∈ s₂ k₂ :=
+begin
+  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_continuous,
+      hβ.tendsto_iff (uniform_fun.has_basis_uniformity_of_basis ι α hα)],
+  simp_rw [prod.forall],
+  refl
+end
+
+/-- Given `u : α → β` a uniform inducing map, a family `𝓕 : ι → X → α` is equicontinuous at a point
+`x₀ : X` iff the family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is
+equicontinuous at `x₀`. -/
+lemma uniform_inducing.equicontinuous_at_iff {F : ι → X → α} {x₀ : X} {u : α → β}
+  (hu : uniform_inducing u) :
+  equicontinuous_at F x₀ ↔ equicontinuous_at (((∘) u) ∘ F) x₀ :=
+begin
+  have := (uniform_fun.postcomp_uniform_inducing hu).inducing,
+  rw [equicontinuous_at_iff_continuous_at, equicontinuous_at_iff_continuous_at,
+      this.continuous_at_iff],
+  refl
+end
+
+/-- Given `u : α → β` a uniform inducing map, a family `𝓕 : ι → X → α` is equicontinuous iff the
+family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is equicontinuous. -/
+lemma uniform_inducing.equicontinuous_iff {F : ι → X → α} {u : α → β}
+  (hu : uniform_inducing u) :
+  equicontinuous F ↔ equicontinuous (((∘) u) ∘ F) :=
+begin
+  congrm (∀ x, (_ : Prop)),
+  rw hu.equicontinuous_at_iff
+end
+
+/-- Given `u : α → γ` a uniform inducing map, a family `𝓕 : ι → β → α` is uniformly equicontinuous
+iff the family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is uniformly
+equicontinuous. -/
+lemma uniform_inducing.uniform_equicontinuous_iff {F : ι → β → α} {u : α → γ}
+  (hu : uniform_inducing u) :
+  uniform_equicontinuous F ↔ uniform_equicontinuous (((∘) u) ∘ F) :=
+begin
+  have := uniform_fun.postcomp_uniform_inducing hu,
+  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_equicontinuous_iff_uniform_continuous,
+      this.uniform_continuous_iff],
+  refl
+end
+
+/-- A version of `equicontinuous_at.closure` applicable to subsets of types which embed continuously
+into `X → α` with the product topology. It turns out we don't need any other condition on the
+embedding than continuity, but in practice this will mostly be applied to `fun_like` types where
+the coercion is injective. -/
+lemma equicontinuous_at.closure' {A : set Y} {u : Y → X → α} {x₀ : X}
+  (hA : equicontinuous_at (u ∘ coe : A → X → α) x₀) (hu : continuous u) :
+  equicontinuous_at (u ∘ coe : closure A → X → α) x₀ :=
+begin
+  intros U hU,
+  rcases mem_uniformity_is_closed hU with ⟨V, hV, hVclosed, hVU⟩,
+  filter_upwards [hA V hV] with x hx,
+  rw set_coe.forall at *,
+  change A ⊆ (λ f, (u f x₀, u f x)) ⁻¹' V at hx,
+  refine (closure_minimal hx $ hVclosed.preimage $ _).trans (preimage_mono hVU),
+  exact continuous.prod_mk ((continuous_apply x₀).comp hu) ((continuous_apply x).comp hu)
+end
+
+/-- If a set of functions is equicontinuous at some `x₀`, its closure for the product topology is
+also equicontinuous at `x₀`. -/
+lemma equicontinuous_at.closure {A : set $ X → α} {x₀ : X} (hA : A.equicontinuous_at x₀) :
+  (closure A).equicontinuous_at x₀ :=
+@equicontinuous_at.closure' _ _ _ _ _ _ _ id _ hA continuous_id
+
+/-- If `𝓕 : ι → X → α` tends to `f : X → α` *pointwise* along some nontrivial filter, and if the
+family `𝓕` is equicontinuous at some `x₀ : X`, then the limit is continuous at `x₀`. -/
+lemma filter.tendsto.continuous_at_of_equicontinuous_at {l : filter ι} [l.ne_bot] {F : ι → X → α}
+  {f : X → α} {x₀ : X} (h₁ : tendsto F l (𝓝 f)) (h₂ : equicontinuous_at F x₀) :
+  continuous_at f x₀ :=
+(equicontinuous_at_iff_range.mp h₂).closure.continuous_at
+  ⟨f, mem_closure_of_tendsto h₁ $ eventually_of_forall mem_range_self⟩
+
+/-- A version of `equicontinuous.closure` applicable to subsets of types which embed continuously
+into `X → α` with the product topology. It turns out we don't need any other condition on the
+embedding than continuity, but in practice this will mostly be applied to `fun_like` types where
+the coercion is injective. -/
+lemma equicontinuous.closure' {A : set Y} {u : Y → X → α}
+  (hA : equicontinuous (u ∘ coe : A → X → α)) (hu : continuous u) :
+  equicontinuous (u ∘ coe : closure A → X → α) :=
+λ x, (hA x).closure' hu
+
+/-- If a set of functions is equicontinuous, its closure for the product topology is also
+equicontinuous. -/
+lemma equicontinuous.closure {A : set $ X → α} (hA : A.equicontinuous) :
+  (closure A).equicontinuous :=
+λ x, (hA x).closure
+
+/-- If `𝓕 : ι → X → α` tends to `f : X → α` *pointwise* along some nontrivial filter, and if the
+family `𝓕` is equicontinuous, then the limit is continuous. -/
+lemma filter.tendsto.continuous_of_equicontinuous_at {l : filter ι} [l.ne_bot] {F : ι → X → α}
+  {f : X → α} (h₁ : tendsto F l (𝓝 f)) (h₂ : equicontinuous F) :
+  continuous f :=
+continuous_iff_continuous_at.mpr (λ x, h₁.continuous_at_of_equicontinuous_at (h₂ x))
+
+/-- A version of `uniform_equicontinuous.closure` applicable to subsets of types which embed
+continuously into `β → α` with the product topology. It turns out we don't need any other condition
+on the embedding than continuity, but in practice this will mostly be applied to `fun_like` types
+where the coercion is injective. -/
+lemma uniform_equicontinuous.closure' {A : set Y} {u : Y → β → α}
+  (hA : uniform_equicontinuous (u ∘ coe : A → β → α)) (hu : continuous u) :
+  uniform_equicontinuous (u ∘ coe : closure A → β → α) :=
+begin
+  intros U hU,
+  rcases mem_uniformity_is_closed hU with ⟨V, hV, hVclosed, hVU⟩,
+  filter_upwards [hA V hV],
+  rintros ⟨x, y⟩ hxy,
+  rw set_coe.forall at *,
+  change A ⊆ (λ f, (u f x, u f y)) ⁻¹' V at hxy,
+  refine (closure_minimal hxy $ hVclosed.preimage $ _).trans (preimage_mono hVU),
+  exact continuous.prod_mk ((continuous_apply x).comp hu) ((continuous_apply y).comp hu)
+end
+
+/-- If a set of functions is uniformly equicontinuous, its closure for the product topology is also
+uniformly equicontinuous. -/
+lemma uniform_equicontinuous.closure {A : set $ β → α} (hA : A.uniform_equicontinuous) :
+  (closure A).uniform_equicontinuous :=
+@uniform_equicontinuous.closure' _ _ _ _ _ _ _ id hA continuous_id
+
+/-- If `𝓕 : ι → β → α` tends to `f : β → α` *pointwise* along some nontrivial filter, and if the
+family `𝓕` is uniformly equicontinuous, then the limit is uniformly continuous. -/
+lemma filter.tendsto.uniform_continuous_of_uniform_equicontinuous {l : filter ι} [l.ne_bot]
+  {F : ι → β → α} {f : β → α} (h₁ : tendsto F l (𝓝 f)) (h₂ : uniform_equicontinuous F) :
+  uniform_continuous f :=
+(uniform_equicontinuous_at_iff_range.mp h₂).closure.uniform_continuous
+  ⟨f, mem_closure_of_tendsto h₁ $ eventually_of_forall mem_range_self⟩
+
+end
+
+end
diff --git a/test/convert.lean b/test/convert.lean
index 0e8f4ae2cf95b..d0d2b2d8d7120 100644
--- a/test/convert.lean
+++ b/test/convert.lean
@@ -3,7 +3,7 @@ Copyright (c) 2018 Simon Hudon. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Simon Hudon
 -/
-import data.set.basic
+import data.set.image
 import tactic.interactive
 
 open set
diff --git a/test/equiv.lean b/test/equiv.lean
index a9b11aa92041b..07da7917028c4 100644
--- a/test/equiv.lean
+++ b/test/equiv.lean
@@ -1,5 +1,5 @@
 import data.set.finite
-import data.finset.basic
+import data.finset.image
 
 def s : finset (fin 3) := {0, 1}
 
diff --git a/test/library_search/filter.lean b/test/library_search/filter.lean
index 903c8f5d05b33..637aeac5ce371 100644
--- a/test/library_search/filter.lean
+++ b/test/library_search/filter.lean
@@ -5,9 +5,10 @@ open filter
 /- Turn off trace messages so they don't pollute the test build: -/
 set_option trace.silence_library_search true
 
-example {α β γ : Type*} {A : filter α} {B : filter β} {C : filter γ} {f : α → β} {g : β → γ}
-  (hf : tendsto f A B) (hg : tendsto g B C) : map (g ∘ f) A = map g (map f A) :=
-by library_search
+-- The following fails with a deterministic timeout.
+-- example {α β γ : Type*} {A : filter α} {B : filter β} {C : filter γ} {f : α → β} {g : β → γ}
+--   (hf : tendsto f A B) (hg : tendsto g B C) : map (g ∘ f) A = map g (map f A) :=
+-- by library_search
 
 example {α β γ : Type*} {A : filter α} {B : filter β} {C : filter γ} {f : α → β} {g : β → γ}
   (hf : tendsto f A B) (hg : tendsto g B C) : map g (map f A) ≤ C :=
diff --git a/test/simp_rw.lean b/test/simp_rw.lean
index 5e874625d60c0..a4194e91e106b 100644
--- a/test/simp_rw.lean
+++ b/test/simp_rw.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
 import data.nat.basic
-import data.set.basic
+import data.set.image
 import tactic.simp_rw
 
 /-!