/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module data.int.bitwise
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Basic
import Mathbin.Data.Nat.Pow
import Mathbin.Data.Nat.Size

/-!
# Bitwise operations on integers

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

## Recursors
* `int.bit_cases_on`: Parity disjunction. Something is true/defined on `ℤ` if it's true/defined for
  even and for odd values.

-/

namespace Int

/-! ### bitwise ops -/

#print Int.bodd_zero /-
@[simp]
theorem bodd_zero : bodd 0 = false :=
  rfl
#align int.bodd_zero Int.bodd_zero
-/

#print Int.bodd_one /-
@[simp]
theorem bodd_one : bodd 1 = true :=
  rfl
#align int.bodd_one Int.bodd_one
-/

#print Int.bodd_two /-
theorem bodd_two : bodd 2 = false :=
  rfl
#align int.bodd_two Int.bodd_two
-/

#print Int.bodd_coe /-
@[simp, norm_cast]
theorem bodd_coe (n : ℕ) : Int.bodd n = Nat.bodd n :=
  rfl
#align int.bodd_coe Int.bodd_coe
-/

#print Int.bodd_subNatNat /-
@[simp]
theorem bodd_subNatNat (m n : ℕ) : bodd (subNatNat m n) = xor m.bodd n.bodd := by
  apply sub_nat_nat_elim m n fun m n i => bodd i = xor m.bodd n.bodd <;> intros <;> simp <;>
      cases i.bodd <;>
    simp
#align int.bodd_sub_nat_nat Int.bodd_subNatNat
-/

#print Int.bodd_negOfNat /-
@[simp]
theorem bodd_negOfNat (n : ℕ) : bodd (negOfNat n) = n.bodd := by cases n <;> simp <;> rfl
#align int.bodd_neg_of_nat Int.bodd_negOfNat
-/

#print Int.bodd_neg /-
@[simp]
theorem bodd_neg (n : ℤ) : bodd (-n) = bodd n := by
  cases n <;> simp [Neg.neg, Int.coe_nat_eq, Int.neg, bodd, -of_nat_eq_coe]
#align int.bodd_neg Int.bodd_neg
-/

#print Int.bodd_add /-
@[simp]
theorem bodd_add (m n : ℤ) : bodd (m + n) = xor (bodd m) (bodd n) := by
  cases' m with m m <;> cases' n with n n <;> unfold Add.add <;>
    simp [Int.add, -of_nat_eq_coe, Bool.xor_comm]
#align int.bodd_add Int.bodd_add
-/

#print Int.bodd_mul /-
@[simp]
theorem bodd_mul (m n : ℤ) : bodd (m * n) = (bodd m && bodd n) := by
  cases' m with m m <;> cases' n with n n <;>
    simp [← Int.mul_def, Int.mul, -of_nat_eq_coe, Bool.xor_comm]
#align int.bodd_mul Int.bodd_mul
-/

#print Int.bodd_add_div2 /-
theorem bodd_add_div2 : ∀ n, cond (bodd n) 1 0 + 2 * div2 n = n
  | (n : ℕ) => by
    rw [show (cond (bodd n) 1 0 : ℤ) = (cond (bodd n) 1 0 : ℕ) by cases bodd n <;> rfl] <;>
      exact congr_arg of_nat n.bodd_add_div2
  | -[n+1] => by
    refine' Eq.trans _ (congr_arg neg_succ_of_nat n.bodd_add_div2)
    dsimp [bodd]; cases Nat.bodd n <;> dsimp [cond, not, div2, Int.mul]
    · change -[2 * Nat.div2 n+1] = _
      rw [zero_add]
    · rw [zero_add, add_comm]
      rfl
#align int.bodd_add_div2 Int.bodd_add_div2
-/

#print Int.div2_val /-
theorem div2_val : ∀ n, div2 n = n / 2
  | (n : ℕ) => congr_arg ofNat n.div2_val
  | -[n+1] => congr_arg negSucc n.div2_val
#align int.div2_val Int.div2_val
-/

#print Int.bit0_val /-
theorem bit0_val (n : ℤ) : bit0 n = 2 * n :=
  (two_mul _).symm
#align int.bit0_val Int.bit0_val
-/

#print Int.bit1_val /-
theorem bit1_val (n : ℤ) : bit1 n = 2 * n + 1 :=
  congr_arg (· + (1 : ℤ)) (bit0_val _)
#align int.bit1_val Int.bit1_val
-/

#print Int.bit_val /-
theorem bit_val (b n) : bit b n = 2 * n + cond b 1 0 :=
  by
  cases b
  apply (bit0_val n).trans (add_zero _).symm
  apply bit1_val
#align int.bit_val Int.bit_val
-/

#print Int.bit_decomp /-
theorem bit_decomp (n : ℤ) : bit (bodd n) (div2 n) = n :=
  (bit_val _ _).trans <| (add_comm _ _).trans <| bodd_add_div2 _
#align int.bit_decomp Int.bit_decomp
-/

#print Int.bitCasesOn /-
/-- Defines a function from `ℤ` conditionally, if it is defined for odd and even integers separately
  using `bit`. -/
def bitCasesOn.{u} {C : ℤ → Sort u} (n) (h : ∀ b n, C (bit b n)) : C n := by
  rw [← bit_decomp n] <;> apply h
#align int.bit_cases_on Int.bitCasesOn
-/

#print Int.bit_zero /-
@[simp]
theorem bit_zero : bit false 0 = 0 :=
  rfl
#align int.bit_zero Int.bit_zero
-/

#print Int.bit_coe_nat /-
@[simp]
theorem bit_coe_nat (b) (n : ℕ) : bit b n = Nat.bit b n := by
  rw [bit_val, Nat.bit_val] <;> cases b <;> rfl
#align int.bit_coe_nat Int.bit_coe_nat
-/

#print Int.bit_negSucc /-
@[simp]
theorem bit_negSucc (b) (n : ℕ) : bit b -[n+1] = -[Nat.bit (not b) n+1] := by
  rw [bit_val, Nat.bit_val] <;> cases b <;> rfl
#align int.bit_neg_succ Int.bit_negSucc
-/

#print Int.bodd_bit /-
@[simp]
theorem bodd_bit (b n) : bodd (bit b n) = b := by
  rw [bit_val] <;> simp <;> cases b <;> cases bodd n <;> rfl
#align int.bodd_bit Int.bodd_bit
-/

#print Int.bodd_bit0 /-
@[simp]
theorem bodd_bit0 (n : ℤ) : bodd (bit0 n) = false :=
  bodd_bit false n
#align int.bodd_bit0 Int.bodd_bit0
-/

#print Int.bodd_bit1 /-
@[simp]
theorem bodd_bit1 (n : ℤ) : bodd (bit1 n) = true :=
  bodd_bit true n
#align int.bodd_bit1 Int.bodd_bit1
-/

#print Int.bit0_ne_bit1 /-
theorem bit0_ne_bit1 (m n : ℤ) : bit0 m ≠ bit1 n :=
  mt (congr_arg bodd) <| by simp
#align int.bit0_ne_bit1 Int.bit0_ne_bit1
-/

#print Int.bit1_ne_bit0 /-
theorem bit1_ne_bit0 (m n : ℤ) : bit1 m ≠ bit0 n :=
  (bit0_ne_bit1 _ _).symm
#align int.bit1_ne_bit0 Int.bit1_ne_bit0
-/

#print Int.bit1_ne_zero /-
theorem bit1_ne_zero (m : ℤ) : bit1 m ≠ 0 := by simpa only [bit0_zero] using bit1_ne_bit0 m 0
#align int.bit1_ne_zero Int.bit1_ne_zero
-/

#print Int.testBit_zero /-
@[simp]
theorem testBit_zero (b) : ∀ n, testBit (bit b n) 0 = b
  | (n : ℕ) => by rw [bit_coe_nat] <;> apply Nat.testBit_zero
  | -[n+1] => by
    rw [bit_neg_succ] <;> dsimp [test_bit] <;> rw [Nat.testBit_zero] <;> clear test_bit_zero <;>
        cases b <;>
      rfl
#align int.test_bit_zero Int.testBit_zero
-/

#print Int.testBit_succ /-
@[simp]
theorem testBit_succ (m b) : ∀ n, testBit (bit b n) (Nat.succ m) = testBit n m
  | (n : ℕ) => by rw [bit_coe_nat] <;> apply Nat.testBit_succ
  | -[n+1] => by rw [bit_neg_succ] <;> dsimp [test_bit] <;> rw [Nat.testBit_succ]
#align int.test_bit_succ Int.testBit_succ
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
private unsafe def bitwise_tac : tactic Unit :=
  sorry
#align int.bitwise_tac int.bitwise_tac

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.1792841685.bitwise_tac -/
#print Int.bitwise_or /-
theorem bitwise_or : bitwise or = lor := by
  run_tac
    bitwise_tac
#align int.bitwise_or Int.bitwise_or
-/

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.1792841685.bitwise_tac -/
#print Int.bitwise_and /-
theorem bitwise_and : bitwise and = land := by
  run_tac
    bitwise_tac
#align int.bitwise_and Int.bitwise_and
-/

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.1792841685.bitwise_tac -/
#print Int.bitwise_diff /-
theorem bitwise_diff : (bitwise fun a b => a && not b) = ldiff' := by
  run_tac
    bitwise_tac
#align int.bitwise_diff Int.bitwise_diff
-/

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic _private.1792841685.bitwise_tac -/
#print Int.bitwise_xor /-
theorem bitwise_xor : bitwise xor = lxor' := by
  run_tac
    bitwise_tac
#align int.bitwise_xor Int.bitwise_xor
-/

/- ./././Mathport/Syntax/Translate/Tactic/Lean3.lean:503:27: warning: unsupported: unfold config -/
#print Int.bitwise_bit /-
@[simp]
theorem bitwise_bit (f : Bool → Bool → Bool) (a m b n) :
    bitwise f (bit a m) (bit b n) = bit (f a b) (bitwise f m n) :=
  by
  cases' m with m m <;> cases' n with n n <;>
        repeat' first |rw [← Int.coe_nat_eq]|rw [bit_coe_nat]|rw [bit_neg_succ] <;>
      unfold bitwise nat_bitwise not <;>
    [induction' h : f ff ff with , induction' h : f ff tt with , induction' h : f tt ff with ,
    induction' h : f tt tt with ]
  all_goals
    unfold cond; rw [Nat.bitwise'_bit]
    repeat' first |rw [bit_coe_nat]|rw [bit_neg_succ]|rw [Bool.not_not]
  all_goals unfold not <;> rw [h] <;> rfl
#align int.bitwise_bit Int.bitwise_bit
-/

#print Int.lor_bit /-
@[simp]
theorem lor_bit (a m b n) : lor (bit a m) (bit b n) = bit (a || b) (lor m n) := by
  rw [← bitwise_or, bitwise_bit]
#align int.lor_bit Int.lor_bit
-/

#print Int.land_bit /-
@[simp]
theorem land_bit (a m b n) : land (bit a m) (bit b n) = bit (a && b) (land m n) := by
  rw [← bitwise_and, bitwise_bit]
#align int.land_bit Int.land_bit
-/

#print Int.ldiff_bit /-
@[simp]
theorem ldiff_bit (a m b n) : ldiff' (bit a m) (bit b n) = bit (a && not b) (ldiff' m n) := by
  rw [← bitwise_diff, bitwise_bit]
#align int.ldiff_bit Int.ldiff_bit
-/

#print Int.lxor_bit /-
@[simp]
theorem lxor_bit (a m b n) : lxor' (bit a m) (bit b n) = bit (xor a b) (lxor' m n) := by
  rw [← bitwise_xor, bitwise_bit]
#align int.lxor_bit Int.lxor_bit
-/

#print Int.lnot_bit /-
@[simp]
theorem lnot_bit (b) : ∀ n, lnot (bit b n) = bit (not b) (lnot n)
  | (n : ℕ) => by simp [lnot]
  | -[n+1] => by simp [lnot]
#align int.lnot_bit Int.lnot_bit
-/

#print Int.testBit_bitwise /-
@[simp]
theorem testBit_bitwise (f : Bool → Bool → Bool) (m n k) :
    testBit (bitwise f m n) k = f (testBit m k) (testBit n k) :=
  by
  induction' k with k IH generalizing m n <;> apply bit_cases_on m <;> intro a m' <;>
        apply bit_cases_on n <;>
      intro b n' <;>
    rw [bitwise_bit]
  · simp [test_bit_zero]
  · simp [test_bit_succ, IH]
#align int.test_bit_bitwise Int.testBit_bitwise
-/

#print Int.testBit_lor /-
@[simp]
theorem testBit_lor (m n k) : testBit (lor m n) k = (testBit m k || testBit n k) := by
  rw [← bitwise_or, test_bit_bitwise]
#align int.test_bit_lor Int.testBit_lor
-/

#print Int.testBit_land /-
@[simp]
theorem testBit_land (m n k) : testBit (land m n) k = (testBit m k && testBit n k) := by
  rw [← bitwise_and, test_bit_bitwise]
#align int.test_bit_land Int.testBit_land
-/

#print Int.testBit_ldiff /-
@[simp]
theorem testBit_ldiff (m n k) : testBit (ldiff' m n) k = (testBit m k && not (testBit n k)) := by
  rw [← bitwise_diff, test_bit_bitwise]
#align int.test_bit_ldiff Int.testBit_ldiff
-/

#print Int.testBit_lxor /-
@[simp]
theorem testBit_lxor (m n k) : testBit (lxor' m n) k = xor (testBit m k) (testBit n k) := by
  rw [← bitwise_xor, test_bit_bitwise]
#align int.test_bit_lxor Int.testBit_lxor
-/

#print Int.testBit_lnot /-
@[simp]
theorem testBit_lnot : ∀ n k, testBit (lnot n) k = not (testBit n k)
  | (n : ℕ), k => by simp [lnot, test_bit]
  | -[n+1], k => by simp [lnot, test_bit]
#align int.test_bit_lnot Int.testBit_lnot
-/

#print Int.shiftl_neg /-
@[simp]
theorem shiftl_neg (m n : ℤ) : shiftl m (-n) = shiftr m n :=
  rfl
#align int.shiftl_neg Int.shiftl_neg
-/

#print Int.shiftr_neg /-
@[simp]
theorem shiftr_neg (m n : ℤ) : shiftr m (-n) = shiftl m n := by rw [← shiftl_neg, neg_neg]
#align int.shiftr_neg Int.shiftr_neg
-/

#print Int.shiftl_coe_nat /-
@[simp]
theorem shiftl_coe_nat (m n : ℕ) : shiftl m n = Nat.shiftl m n :=
  rfl
#align int.shiftl_coe_nat Int.shiftl_coe_nat
-/

#print Int.shiftr_coe_nat /-
@[simp]
theorem shiftr_coe_nat (m n : ℕ) : shiftr m n = Nat.shiftr m n := by cases n <;> rfl
#align int.shiftr_coe_nat Int.shiftr_coe_nat
-/

#print Int.shiftl_negSucc /-
@[simp]
theorem shiftl_negSucc (m n : ℕ) : shiftl -[m+1] n = -[Nat.shiftl' true m n+1] :=
  rfl
#align int.shiftl_neg_succ Int.shiftl_negSucc
-/

#print Int.shiftr_negSucc /-
@[simp]
theorem shiftr_negSucc (m n : ℕ) : shiftr -[m+1] n = -[Nat.shiftr m n+1] := by cases n <;> rfl
#align int.shiftr_neg_succ Int.shiftr_negSucc
-/

#print Int.shiftr_add /-
theorem shiftr_add : ∀ (m : ℤ) (n k : ℕ), shiftr m (n + k) = shiftr (shiftr m n) k
  | (m : ℕ), n, k => by
    rw [shiftr_coe_nat, shiftr_coe_nat, ← Int.ofNat_add, shiftr_coe_nat, Nat.shiftr_add]
  | -[m+1], n, k => by
    rw [shiftr_neg_succ, shiftr_neg_succ, ← Int.ofNat_add, shiftr_neg_succ, Nat.shiftr_add]
#align int.shiftr_add Int.shiftr_add
-/

/-! ### bitwise ops -/

attribute [local simp] Int.zero_div

#print Int.shiftl_add /-
theorem shiftl_add : ∀ (m : ℤ) (n : ℕ) (k : ℤ), shiftl m (n + k) = shiftl (shiftl m n) k
  | (m : ℕ), n, (k : ℕ) => congr_arg ofNat (Nat.shiftl_add _ _ _)
  | -[m+1], n, (k : ℕ) => congr_arg negSucc (Nat.shiftl'_add _ _ _ _)
  | (m : ℕ), n, -[k+1] =>
    subNatNat_elim n k.succ (fun n k i => shiftl (↑m) i = Nat.shiftr (Nat.shiftl m n) k)
      (fun i n =>
        congr_arg coe <| by rw [← Nat.shiftl_sub, add_tsub_cancel_left] <;> apply Nat.le_add_right)
      fun i n =>
      congr_arg coe <| by rw [add_assoc, Nat.shiftr_add, ← Nat.shiftl_sub, tsub_self] <;> rfl
  | -[m+1], n, -[k+1] =>
    subNatNat_elim n k.succ
      (fun n k i => shiftl -[m+1] i = -[Nat.shiftr (Nat.shiftl' true m n) k+1])
      (fun i n =>
        congr_arg negSucc <| by
          rw [← Nat.shiftl'_sub, add_tsub_cancel_left] <;> apply Nat.le_add_right)
      fun i n =>
      congr_arg negSucc <| by rw [add_assoc, Nat.shiftr_add, ← Nat.shiftl'_sub, tsub_self] <;> rfl
#align int.shiftl_add Int.shiftl_add
-/

#print Int.shiftl_sub /-
theorem shiftl_sub (m : ℤ) (n : ℕ) (k : ℤ) : shiftl m (n - k) = shiftr (shiftl m n) k :=
  shiftl_add _ _ _
#align int.shiftl_sub Int.shiftl_sub
-/

#print Int.shiftl_eq_mul_pow /-
theorem shiftl_eq_mul_pow : ∀ (m : ℤ) (n : ℕ), shiftl m n = m * ↑(2 ^ n)
  | (m : ℕ), n => congr_arg coe (Nat.shiftl_eq_mul_pow _ _)
  | -[m+1], n => @congr_arg ℕ ℤ _ _ (fun i => -i) (Nat.shiftl'_tt_eq_mul_pow _ _)
#align int.shiftl_eq_mul_pow Int.shiftl_eq_mul_pow
-/

#print Int.shiftr_eq_div_pow /-
theorem shiftr_eq_div_pow : ∀ (m : ℤ) (n : ℕ), shiftr m n = m / ↑(2 ^ n)
  | (m : ℕ), n => by rw [shiftr_coe_nat] <;> exact congr_arg coe (Nat.shiftr_eq_div_pow _ _)
  | -[m+1], n => by
    rw [shiftr_neg_succ, neg_succ_of_nat_div, Nat.shiftr_eq_div_pow]; rfl
    exact coe_nat_lt_coe_nat_of_lt (pow_pos (by decide) _)
#align int.shiftr_eq_div_pow Int.shiftr_eq_div_pow
-/

#print Int.one_shiftl /-
theorem one_shiftl (n : ℕ) : shiftl 1 n = (2 ^ n : ℕ) :=
  congr_arg coe (Nat.one_shiftl _)
#align int.one_shiftl Int.one_shiftl
-/

#print Int.zero_shiftl /-
@[simp]
theorem zero_shiftl : ∀ n : ℤ, shiftl 0 n = 0
  | (n : ℕ) => congr_arg coe (Nat.zero_shiftl _)
  | -[n+1] => congr_arg coe (Nat.zero_shiftr _)
#align int.zero_shiftl Int.zero_shiftl
-/

#print Int.zero_shiftr /-
@[simp]
theorem zero_shiftr (n) : shiftr 0 n = 0 :=
  zero_shiftl _
#align int.zero_shiftr Int.zero_shiftr
-/

end Int


/-
Copyright (c) 2020 Yury Kudryashov All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import linear_algebra.basic
import linear_algebra.prod

/-!
# Partially defined linear maps

A `linear_pmap R E F` is a linear map from a submodule of `E` to `F`. We define
a `semilattice_inf` with `order_bot` instance on this this, and define three operations:

* `mk_span_singleton` defines a partial linear map defined on the span of a singleton.
* `sup` takes two partial linear maps `f`, `g` that agree on the intersection of their
  domains, and returns the unique partial linear map on `f.domain ⊔ g.domain` that
  extends both `f` and `g`.
* `Sup` takes a `directed_on (≤)` set of partial linear maps, and returns the unique
  partial linear map on the `Sup` of their domains that extends all these maps.

Partially defined maps are currently used in `mathlib` to prove Hahn-Banach theorem
and its variations. Namely, `linear_pmap.Sup` implies that every chain of `linear_pmap`s
is bounded above.

Another possible use (not yet in `mathlib`) would be the theory of unbounded linear operators.
-/

open set

universes u v w

/-- A `linear_pmap R E F` is a linear map from a submodule of `E` to `F`. -/
structure linear_pmap (R : Type u) [ring R] (E : Type v) [add_comm_group E] [module R E]
  (F : Type w) [add_comm_group F] [module R F] :=
(domain : submodule R E)
(to_fun : domain →ₗ[R] F)

variables {R : Type*} [ring R] {E : Type*} [add_comm_group E] [module R E]
  {F : Type*} [add_comm_group F] [module R F]
  {G : Type*} [add_comm_group G] [module R G]

namespace linear_pmap

open submodule

instance : has_coe_to_fun (linear_pmap R E F) (λ f : linear_pmap R E F, f.domain → F) :=
⟨λ f, f.to_fun⟩

@[simp] lemma to_fun_eq_coe (f : linear_pmap R E F) (x : f.domain) :
  f.to_fun x = f x := rfl

@[simp] lemma map_zero (f : linear_pmap R E F) : f 0 = 0 := f.to_fun.map_zero

lemma map_add (f : linear_pmap R E F) (x y : f.domain) : f (x + y) = f x + f y :=
f.to_fun.map_add x y

lemma map_neg (f : linear_pmap R E F) (x : f.domain) : f (-x) = -f x :=
f.to_fun.map_neg x

lemma map_sub (f : linear_pmap R E F) (x y : f.domain) : f (x - y) = f x - f y :=
f.to_fun.map_sub x y

lemma map_smul (f : linear_pmap R E F) (c : R) (x : f.domain) : f (c • x) = c • f x :=
f.to_fun.map_smul c x

@[simp] lemma mk_apply (p : submodule R E) (f : p →ₗ[R] F) (x : p) :
  mk p f x = f x := rfl

/-- The unique `linear_pmap` on `R ∙ x` that sends `x` to `y`. This version works for modules
over rings, and requires a proof of `∀ c, c • x = 0 → c • y = 0`. -/
noncomputable def mk_span_singleton' (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0) :
  linear_pmap R E F :=
{ domain := R ∙ x,
  to_fun :=
  have H : ∀ c₁ c₂ : R, c₁ • x = c₂ • x → c₁ • y = c₂ • y,
  { intros c₁ c₂ h,
    rw [← sub_eq_zero, ← sub_smul] at h ⊢,
    exact H _ h },
  { to_fun := λ z, (classical.some (mem_span_singleton.1 z.prop) • y),
    map_add' := λ y z, begin
      rw [← add_smul],
      apply H,
      simp only [add_smul, sub_smul, classical.some_spec (mem_span_singleton.1 _)],
      apply coe_add
    end,
    map_smul' := λ c z, begin
      rw [smul_smul],
      apply H,
      simp only [mul_smul, classical.some_spec (mem_span_singleton.1 _)],
      apply coe_smul
    end } }

@[simp] lemma domain_mk_span_singleton (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0) :
  (mk_span_singleton' x y H).domain = R ∙ x := rfl

@[simp] lemma mk_span_singleton_apply (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0)
  (c : R) (h) :
  mk_span_singleton' x y H ⟨c • x, h⟩ = c • y :=
begin
  dsimp [mk_span_singleton'],
  rw [← sub_eq_zero, ← sub_smul],
  apply H,
  simp only [sub_smul, one_smul, sub_eq_zero],
  apply classical.some_spec (mem_span_singleton.1 h),
end

/-- The unique `linear_pmap` on `span R {x}` that sends a non-zero vector `x` to `y`.
This version works for modules over division rings. -/
@[reducible] noncomputable def mk_span_singleton {K E F : Type*} [division_ring K]
  [add_comm_group E] [module K E] [add_comm_group F] [module K F] (x : E) (y : F) (hx : x ≠ 0) :
  linear_pmap K E F :=
mk_span_singleton' x y $ λ c hc, (smul_eq_zero.1 hc).elim
  (λ hc, by rw [hc, zero_smul]) (λ hx', absurd hx' hx)

/-- Projection to the first coordinate as a `linear_pmap` -/
protected def fst (p : submodule R E) (p' : submodule R F) : linear_pmap R (E × F) E :=
{ domain := p.prod p',
  to_fun := (linear_map.fst R E F).comp (p.prod p').subtype }

@[simp] lemma fst_apply (p : submodule R E) (p' : submodule R F) (x : p.prod p') :
  linear_pmap.fst p p' x = (x : E × F).1 := rfl

/-- Projection to the second coordinate as a `linear_pmap` -/
protected def snd (p : submodule R E) (p' : submodule R F) : linear_pmap R (E × F) F :=
{ domain := p.prod p',
  to_fun := (linear_map.snd R E F).comp (p.prod p').subtype }

@[simp] lemma snd_apply (p : submodule R E) (p' : submodule R F) (x : p.prod p') :
  linear_pmap.snd p p' x = (x : E × F).2 := rfl

instance : has_neg (linear_pmap R E F) :=
⟨λ f, ⟨f.domain, -f.to_fun⟩⟩

@[simp] lemma neg_apply (f : linear_pmap R E F) (x) : (-f) x = -(f x) := rfl

instance : has_le (linear_pmap R E F) :=
⟨λ f g, f.domain ≤ g.domain ∧ ∀ ⦃x : f.domain⦄ ⦃y : g.domain⦄ (h : (x:E) = y), f x = g y⟩

lemma eq_of_le_of_domain_eq {f g : linear_pmap R E F} (hle : f ≤ g) (heq : f.domain = g.domain) :
  f = g :=
begin
  rcases f with ⟨f_dom, f⟩,
  rcases g with ⟨g_dom, g⟩,
  change f_dom = g_dom at heq,
  subst g_dom,
  have : f = g, from linear_map.ext (λ x, hle.2 rfl),
  subst g
end

/-- Given two partial linear maps `f`, `g`, the set of points `x` such that
both `f` and `g` are defined at `x` and `f x = g x` form a submodule. -/
def eq_locus (f g : linear_pmap R E F) : submodule R E :=
{ carrier   := {x | ∃ (hf : x ∈ f.domain) (hg : x ∈ g.domain), f ⟨x, hf⟩ = g ⟨x, hg⟩},
  zero_mem' := ⟨zero_mem _, zero_mem _, f.map_zero.trans g.map_zero.symm⟩,
  add_mem'  := λ x y ⟨hfx, hgx, hx⟩ ⟨hfy, hgy, hy⟩, ⟨add_mem _ hfx hfy, add_mem _ hgx hgy,
    by erw [f.map_add ⟨x, hfx⟩ ⟨y, hfy⟩, g.map_add ⟨x, hgx⟩ ⟨y, hgy⟩, hx, hy]⟩,
  smul_mem' := λ c x ⟨hfx, hgx, hx⟩, ⟨smul_mem _ c hfx, smul_mem _ c hgx,
    by erw [f.map_smul c ⟨x, hfx⟩, g.map_smul c ⟨x, hgx⟩, hx]⟩ }

instance : has_inf (linear_pmap R E F) :=
⟨λ f g, ⟨f.eq_locus g, f.to_fun.comp $ of_le $ λ x hx, hx.fst⟩⟩

instance : has_bot (linear_pmap R E F) := ⟨⟨⊥, 0⟩⟩

instance : inhabited (linear_pmap R E F) := ⟨⊥⟩

instance : semilattice_inf (linear_pmap R E F) :=
{ le := (≤),
  le_refl := λ f, ⟨le_refl f.domain, λ x y h, subtype.eq h ▸ rfl⟩,
  le_trans := λ f g h ⟨fg_le, fg_eq⟩ ⟨gh_le, gh_eq⟩,
    ⟨le_trans fg_le gh_le, λ x z hxz,
      have hxy : (x:E) = of_le fg_le x, from rfl,
      (fg_eq hxy).trans (gh_eq $ hxy.symm.trans hxz)⟩,
  le_antisymm := λ f g fg gf, eq_of_le_of_domain_eq fg (le_antisymm fg.1 gf.1),
  inf := (⊓),
  le_inf := λ f g h ⟨fg_le, fg_eq⟩ ⟨fh_le, fh_eq⟩,
    ⟨λ x hx, ⟨fg_le hx, fh_le hx,
      by refine (fg_eq _).symm.trans (fh_eq _); [exact ⟨x, hx⟩, refl, refl]⟩,
    λ x ⟨y, yg, hy⟩ h, by { apply fg_eq, exact h }⟩,
  inf_le_left := λ f g, ⟨λ x hx, hx.fst,
    λ x y h, congr_arg f $ subtype.eq $ by exact h⟩,
  inf_le_right := λ f g, ⟨λ x hx, hx.snd.fst,
    λ ⟨x, xf, xg, hx⟩ y h, hx.trans $ congr_arg g $ subtype.eq $ by exact h⟩ }

instance : order_bot (linear_pmap R E F) :=
{ bot := ⊥,
  bot_le := λ f, ⟨bot_le, λ x y h,
    have hx : x = 0, from subtype.eq ((mem_bot R).1 x.2),
    have hy : y = 0, from subtype.eq (h.symm.trans (congr_arg _ hx)),
    by rw [hx, hy, map_zero, map_zero]⟩ }

lemma le_of_eq_locus_ge {f g : linear_pmap R E F} (H : f.domain ≤ f.eq_locus g) :
  f ≤ g :=
suffices f ≤ f ⊓ g, from le_trans this inf_le_right,
⟨H, λ x y hxy, ((inf_le_left : f ⊓ g ≤ f).2 hxy.symm).symm⟩

lemma domain_mono : strict_mono (@domain R _ E _ _ F _ _) :=
λ f g hlt, lt_of_le_of_ne hlt.1.1 $ λ heq, ne_of_lt hlt $
eq_of_le_of_domain_eq (le_of_lt hlt) heq

private lemma sup_aux (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  ∃ fg : ↥(f.domain ⊔ g.domain) →ₗ[R] F,
    ∀ (x : f.domain) (y : g.domain) (z),
      (x:E) + y = ↑z → fg z = f x + g y :=
begin
  choose x hx y hy hxy using λ z : f.domain ⊔ g.domain, mem_sup.1 z.prop,
  set fg := λ z, f ⟨x z, hx z⟩ + g ⟨y z, hy z⟩,
  have fg_eq : ∀ (x' : f.domain) (y' : g.domain) (z' : f.domain ⊔ g.domain) (H : (x':E) + y' = z'),
    fg z' = f x' + g y',
  { intros x' y' z' H,
    dsimp [fg],
    rw [add_comm, ← sub_eq_sub_iff_add_eq_add, eq_comm, ← map_sub, ← map_sub],
    apply h,
    simp only [← eq_sub_iff_add_eq] at hxy,
    simp only [coe_sub, coe_mk, coe_mk, hxy, ← sub_add, ← sub_sub, sub_self, zero_sub, ← H],
    apply neg_add_eq_sub },
  refine ⟨{ to_fun := fg, .. }, fg_eq⟩,
  { rintros ⟨z₁, hz₁⟩ ⟨z₂, hz₂⟩,
    rw [← add_assoc, add_right_comm (f _), ← map_add, add_assoc, ← map_add],
    apply fg_eq,
    simp only [coe_add, coe_mk, ← add_assoc],
    rw [add_right_comm (x _), hxy, add_assoc, hxy, coe_mk, coe_mk] },
  { intros c z,
    rw [smul_add, ← map_smul, ← map_smul],
    apply fg_eq,
    simp only [coe_smul, coe_mk, ← smul_add, hxy, ring_hom.id_apply] },
end

/-- Given two partial linear maps that agree on the intersection of their domains,
`f.sup g h` is the unique partial linear map on `f.domain ⊔ g.domain` that agrees
with `f` and `g`. -/
protected noncomputable def sup (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  linear_pmap R E F :=
⟨_, classical.some (sup_aux f g h)⟩

@[simp] lemma domain_sup (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  (f.sup g h).domain = f.domain ⊔ g.domain :=
rfl

lemma sup_apply {f g : linear_pmap R E F}
  (H : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y)
  (x y z) (hz : (↑x:E) + ↑y = ↑z) :
  f.sup g H z = f x + g y :=
classical.some_spec (sup_aux f g H) x y z hz

protected lemma left_le_sup (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  f ≤ f.sup g h :=
begin
  refine ⟨le_sup_left, λ z₁ z₂ hz, _⟩,
  rw [← add_zero (f _), ← g.map_zero],
  refine (sup_apply h _ _ _ _).symm,
  simpa
end

protected lemma right_le_sup (f g : linear_pmap R E F)
  (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
  g ≤ f.sup g h :=
begin
  refine ⟨le_sup_right, λ z₁ z₂ hz, _⟩,
  rw [← zero_add (g _), ← f.map_zero],
  refine (sup_apply h _ _ _ _).symm,
  simpa
end

protected lemma sup_le {f g h : linear_pmap R E F}
  (H : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y)
  (fh : f ≤ h) (gh : g ≤ h) :
  f.sup g H ≤ h :=
have Hf : f ≤ (f.sup g H) ⊓ h, from le_inf (f.left_le_sup g H) fh,
have Hg : g ≤ (f.sup g H) ⊓ h, from le_inf (f.right_le_sup g H) gh,
le_of_eq_locus_ge $ sup_le Hf.1 Hg.1

/-- Hypothesis for `linear_pmap.sup` holds, if `f.domain` is disjoint with `g.domain`. -/
lemma sup_h_of_disjoint (f g : linear_pmap R E F) (h : disjoint f.domain g.domain)
  (x : f.domain) (y : g.domain) (hxy : (x:E) = y) :
  f x = g y :=
begin
  rw [disjoint_def] at h,
  have hy : y = 0, from subtype.eq (h y (hxy ▸ x.2) y.2),
  have hx : x = 0, from subtype.eq (hxy.trans $ congr_arg _ hy),
  simp [*]
end

section

variables {K : Type*} [division_ring K] [module K E] [module K F]

/-- Extend a `linear_pmap` to `f.domain ⊔ K ∙ x`. -/
noncomputable def sup_span_singleton (f : linear_pmap K E F) (x : E) (y : F) (hx : x ∉ f.domain) :
  linear_pmap K E F :=
f.sup (mk_span_singleton x y (λ h₀, hx $ h₀.symm ▸ f.domain.zero_mem)) $
  sup_h_of_disjoint _ _ $ by simpa [disjoint_span_singleton]

@[simp] lemma domain_sup_span_singleton (f : linear_pmap K E F) (x : E) (y : F)
  (hx : x ∉ f.domain) :
  (f.sup_span_singleton x y hx).domain = f.domain ⊔ K ∙ x := rfl

@[simp] lemma sup_span_singleton_apply_mk (f : linear_pmap K E F) (x : E) (y : F)
  (hx : x ∉ f.domain) (x' : E) (hx' : x' ∈ f.domain) (c : K) :
  f.sup_span_singleton x y hx ⟨x' + c • x,
    mem_sup.2 ⟨x', hx', _, mem_span_singleton.2 ⟨c, rfl⟩, rfl⟩⟩ = f ⟨x', hx'⟩ + c • y :=
begin
  erw [sup_apply _ ⟨x', hx'⟩ ⟨c • x, _⟩, mk_span_singleton_apply],
  refl,
  exact mem_span_singleton.2 ⟨c, rfl⟩
end

end

private lemma Sup_aux (c : set (linear_pmap R E F)) (hc : directed_on (≤) c) :
  ∃ f : ↥(Sup (domain '' c)) →ₗ[R] F, (⟨_, f⟩ : linear_pmap R E F) ∈ upper_bounds c :=
begin
  cases c.eq_empty_or_nonempty with ceq cne, { subst c, simp },
  have hdir : directed_on (≤) (domain '' c),
    from directed_on_image.2 (hc.mono domain_mono.monotone),
  have P : Π x : Sup (domain '' c), {p : c // (x : E) ∈ p.val.domain },
  { rintros x,
    apply classical.indefinite_description,
    have := (mem_Sup_of_directed (cne.image _) hdir).1 x.2,
    rwa [bex_image_iff, set_coe.exists'] at this },
  set f : Sup (domain '' c) → F := λ x, (P x).val.val ⟨x, (P x).property⟩,
  have f_eq : ∀ (p : c) (x : Sup (domain '' c)) (y : p.1.1) (hxy : (x : E) = y), f x = p.1 y,
  { intros p x y hxy,
    rcases hc (P x).1.1 (P x).1.2 p.1 p.2 with ⟨q, hqc, hxq, hpq⟩,
    refine (hxq.2 _).trans (hpq.2 _).symm,
    exacts [of_le hpq.1 y, hxy, rfl] },
  refine ⟨{ to_fun := f, .. }, _⟩,
  { intros x y,
    rcases hc (P x).1.1 (P x).1.2 (P y).1.1 (P y).1.2 with ⟨p, hpc, hpx, hpy⟩,
    set x' := of_le hpx.1 ⟨x, (P x).2⟩,
    set y' := of_le hpy.1 ⟨y, (P y).2⟩,
    rw [f_eq ⟨p, hpc⟩ x x' rfl, f_eq ⟨p, hpc⟩ y y' rfl, f_eq ⟨p, hpc⟩ (x + y) (x' + y') rfl,
      map_add] },
  { intros c x,
    simp [f_eq (P x).1 (c • x) (c • ⟨x, (P x).2⟩) rfl, ← map_smul] },
  { intros p hpc,
    refine ⟨le_Sup $ mem_image_of_mem domain hpc, λ x y hxy, eq.symm _⟩,
    exact f_eq ⟨p, hpc⟩ _ _ hxy.symm }
end

/-- Glue a collection of partially defined linear maps to a linear map defined on `Sup`
of these submodules. -/
protected noncomputable def Sup (c : set (linear_pmap R E F)) (hc : directed_on (≤) c) :
  linear_pmap R E F :=
⟨_, classical.some $ Sup_aux c hc⟩

protected lemma le_Sup {c : set (linear_pmap R E F)} (hc : directed_on (≤) c)
  {f : linear_pmap R E F} (hf : f ∈ c) : f ≤ linear_pmap.Sup c hc :=
classical.some_spec (Sup_aux c hc) hf

protected lemma Sup_le {c : set (linear_pmap R E F)} (hc : directed_on (≤) c)
  {g : linear_pmap R E F} (hg : ∀ f ∈ c, f ≤ g) : linear_pmap.Sup c hc ≤ g :=
le_of_eq_locus_ge $ Sup_le $ λ _ ⟨f, hf, eq⟩, eq ▸
have f ≤ (linear_pmap.Sup c hc) ⊓ g, from le_inf (linear_pmap.le_Sup _ hf) (hg f hf),
this.1

end linear_pmap

namespace linear_map

/-- Restrict a linear map to a submodule, reinterpreting the result as a `linear_pmap`. -/
def to_pmap (f : E →ₗ[R] F) (p : submodule R E) : linear_pmap R E F :=
⟨p, f.comp p.subtype⟩

@[simp] lemma to_pmap_apply (f : E →ₗ[R] F) (p : submodule R E) (x : p) :
  f.to_pmap p x = f x := rfl

/-- Compose a linear map with a `linear_pmap` -/
def comp_pmap (g : F →ₗ[R] G) (f : linear_pmap R E F) : linear_pmap R E G :=
{ domain := f.domain,
  to_fun := g.comp f.to_fun }

@[simp] lemma comp_pmap_apply (g : F →ₗ[R] G) (f : linear_pmap R E F) (x) :
  g.comp_pmap f x = g (f x) := rfl

end linear_map

namespace linear_pmap

/-- Restrict codomain of a `linear_pmap` -/
def cod_restrict (f : linear_pmap R E F) (p : submodule R F) (H : ∀ x, f x ∈ p) :
  linear_pmap R E p :=
{ domain := f.domain,
  to_fun := f.to_fun.cod_restrict p H }

/-- Compose two `linear_pmap`s -/
def comp (g : linear_pmap R F G) (f : linear_pmap R E F)
  (H : ∀ x : f.domain, f x ∈ g.domain) :
  linear_pmap R E G :=
g.to_fun.comp_pmap $ f.cod_restrict _ H

/-- `f.coprod g` is the partially defined linear map defined on `f.domain × g.domain`,
and sending `p` to `f p.1 + g p.2`. -/
def coprod (f : linear_pmap R E G) (g : linear_pmap R F G) :
  linear_pmap R (E × F) G :=
{ domain := f.domain.prod g.domain,
  to_fun := (f.comp (linear_pmap.fst f.domain g.domain) (λ x, x.2.1)).to_fun +
    (g.comp (linear_pmap.snd f.domain g.domain) (λ x, x.2.2)).to_fun }

@[simp] lemma coprod_apply (f : linear_pmap R E G) (g : linear_pmap R F G) (x) :
  f.coprod g x = f ⟨(x : E × F).1, x.2.1⟩ + g ⟨(x : E × F).2, x.2.2⟩ :=
rfl

end linear_pmap


/-
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 algebra.big_operators.order
import data.nat.totient
import group_theory.order_of_element
import tactic.group
import group_theory.exponent

/-!
# Cyclic groups

A group `G` is called cyclic if there exists an element `g : G` such that every element of `G` is of
the form `g ^ n` for some `n : ℕ`. This file only deals with the predicate on a group to be cyclic.
For the concrete cyclic group of order `n`, see `data.zmod.basic`.

## Main definitions

* `is_cyclic` is a predicate on a group stating that the group is cyclic.

## Main statements

* `is_cyclic_of_prime_card` proves that a finite group of prime order is cyclic.
* `is_simple_group_of_prime_card`, `is_simple_group.is_cyclic`,
  and `is_simple_group.prime_card` classify finite simple abelian groups.
* `is_cyclic.exponent_eq_card`: For a finite cyclic group `G`, the exponent is equal to
  the group's cardinality.
* `is_cyclic.exponent_eq_zero_of_infinite`: Infinite cyclic groups have exponent zero.
* `is_cyclic.iff_exponent_eq_card`: A finite commutative group is cyclic iff its exponent
  is equal to its cardinality.

## Tags

cyclic group
-/

universe u
variables {α : Type u} {a : α}

section cyclic

open_locale big_operators

local attribute [instance] set_fintype

open subgroup

/-- A group is called *cyclic* if it is generated by a single element. -/
class is_add_cyclic (α : Type u) [add_group α] : Prop :=
(exists_generator [] : ∃ g : α, ∀ x, x ∈ add_subgroup.zmultiples g)

/-- A group is called *cyclic* if it is generated by a single element. -/
@[to_additive is_add_cyclic] class is_cyclic (α : Type u) [group α] : Prop :=
(exists_generator [] : ∃ g : α, ∀ x, x ∈ zpowers g)

@[priority 100, to_additive is_add_cyclic_of_subsingleton]
instance is_cyclic_of_subsingleton [group α] [subsingleton α] : is_cyclic α :=
⟨⟨1, λ x, by { rw subsingleton.elim x 1, exact mem_zpowers 1 }⟩⟩

/-- A cyclic group is always commutative. This is not an `instance` because often we have a better
proof of `comm_group`. -/
@[to_additive "A cyclic group is always commutative. This is not an `instance` because often we have
  a better proof of `add_comm_group`."]
def is_cyclic.comm_group [hg : group α] [is_cyclic α] : comm_group α :=
{ mul_comm := λ x y,
    let ⟨g, hg⟩ := is_cyclic.exists_generator α,
        ⟨n, hn⟩ := hg x,
        ⟨m, hm⟩ := hg y in
    hm ▸ hn ▸ zpow_mul_comm _ _ _,
  ..hg }

variables [group α]

@[to_additive monoid_add_hom.map_add_cyclic]
lemma monoid_hom.map_cyclic {G : Type*} [group G] [h : is_cyclic G] (σ : G →* G) :
  ∃ m : ℤ, ∀ g : G, σ g = g ^ m :=
begin
  obtain ⟨h, hG⟩ := is_cyclic.exists_generator G,
  obtain ⟨m, hm⟩ := hG (σ h),
  refine ⟨m, λ g, _⟩,
  obtain ⟨n, rfl⟩ := hG g,
  rw [monoid_hom.map_zpow, ←hm, ←zpow_mul, ←zpow_mul'],
end

@[to_additive is_add_cyclic_of_order_of_eq_card]
lemma is_cyclic_of_order_of_eq_card [fintype α]  (x : α)
   (hx : order_of x = fintype.card α) : is_cyclic α :=
begin
  classical,
  use x,
  simp_rw [← set_like.mem_coe, ← set.eq_univ_iff_forall],
  rw [←fintype.card_congr (equiv.set.univ α), order_eq_card_zpowers] at hx,
  exact set.eq_of_subset_of_card_le (set.subset_univ _) (ge_of_eq hx),
end

/-- A finite group of prime order is cyclic. -/
@[to_additive is_add_cyclic_of_prime_card]
lemma is_cyclic_of_prime_card {α : Type u} [group α] [fintype α] {p : ℕ} [hp : fact p.prime]
  (h : fintype.card α = p) : is_cyclic α :=
⟨begin
  obtain ⟨g, hg⟩ : ∃ g : α, g ≠ 1 := fintype.exists_ne_of_one_lt_card (h.symm ▸ hp.1.one_lt) 1,
  classical, -- for fintype (subgroup.zpowers g)
  have : fintype.card (subgroup.zpowers g) ∣ p,
  { rw ←h,
    apply card_subgroup_dvd_card },
  rw nat.dvd_prime hp.1 at this,
  cases this,
  { rw fintype.card_eq_one_iff at this,
    cases this with t ht,
    suffices : g = 1,
    { contradiction },
    have hgt := ht ⟨g, by { change g ∈ subgroup.zpowers g, exact subgroup.mem_zpowers g }⟩,
    rw [←ht 1] at hgt,
    change (⟨_, _⟩ : subgroup.zpowers g) = ⟨_, _⟩ at hgt,
    simpa using hgt },
  { use g,
    intro x,
    rw [←h] at this,
    rw subgroup.eq_top_of_card_eq _ this,
    exact subgroup.mem_top _ }
end⟩

@[to_additive add_order_of_eq_card_of_forall_mem_zmultiples]
lemma order_of_eq_card_of_forall_mem_zpowers [fintype α]
  {g : α} (hx : ∀ x, x ∈ zpowers g) : order_of g = fintype.card α :=
begin
  classical,
  rw order_eq_card_zpowers,
  apply fintype.card_of_finset',
  simpa using hx
end

@[to_additive infinite.add_order_of_eq_zero_of_forall_mem_zmultiples]
lemma infinite.order_of_eq_zero_of_forall_mem_zpowers [infinite α] {g : α}
  (h : ∀ x, x ∈ zpowers g) : order_of g = 0 :=
begin
  classical,
  rw order_of_eq_zero_iff',
  refine λ n hn hgn, _,
  have ho := order_of_pos' ((is_of_fin_order_iff_pow_eq_one g).mpr ⟨n, hn, hgn⟩),
  obtain ⟨x, hx⟩ := infinite.exists_not_mem_finset
                    (finset.image (pow g) $ finset.range $ order_of g),
  apply hx,
  rw [←mem_powers_iff_mem_range_order_of' g x ho, submonoid.mem_powers_iff],
  obtain ⟨k, hk⟩ := h x,
  obtain ⟨k, rfl | rfl⟩ := k.eq_coe_or_neg,
  { exact ⟨k, by exact_mod_cast hk⟩ },
  let t : ℤ := -k % (order_of g),
  rw zpow_eq_mod_order_of at hk,
  have : 0 ≤ t := int.mod_nonneg (-k) (by exact_mod_cast ho.ne'),
  refine ⟨t.to_nat, _⟩,
  rwa [←zpow_coe_nat, int.to_nat_of_nonneg this]
end

@[to_additive bot.is_add_cyclic]
instance bot.is_cyclic {α : Type u} [group α] : is_cyclic (⊥ : subgroup α) :=
⟨⟨1, λ x, ⟨0, subtype.eq $ (zpow_zero (1 : α)).trans $ eq.symm (subgroup.mem_bot.1 x.2)⟩⟩⟩

@[to_additive add_subgroup.is_add_cyclic]
instance subgroup.is_cyclic {α : Type u} [group α] [is_cyclic α] (H : subgroup α) : is_cyclic H :=
by haveI := classical.prop_decidable; exact
let ⟨g, hg⟩ := is_cyclic.exists_generator α in
if hx : ∃ (x : α), x ∈ H ∧ x ≠ (1 : α) then
  let ⟨x, hx₁, hx₂⟩ := hx in
  let ⟨k, hk⟩ := hg x in
  have hex : ∃ n : ℕ, 0 < n ∧ g ^ n ∈ H,
    from ⟨k.nat_abs, nat.pos_of_ne_zero
      (λ h, hx₂ $ by rw [← hk, int.eq_zero_of_nat_abs_eq_zero h, zpow_zero]),
        match k, hk with
        | (k : ℕ), hk := by rw [int.nat_abs_of_nat, ← zpow_coe_nat, hk]; exact hx₁
        | -[1+ k], hk := by rw [int.nat_abs_of_neg_succ_of_nat,
          ← subgroup.inv_mem_iff H]; simp * at *
        end⟩,
  ⟨⟨⟨g ^ nat.find hex, (nat.find_spec hex).2⟩,
    λ ⟨x, hx⟩, let ⟨k, hk⟩ := hg x in
      have hk₁ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ zpowers (g ^ nat.find hex),
        from ⟨k / nat.find hex, by rw [← zpow_coe_nat, zpow_mul]⟩,
      have hk₂ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ H,
        by { rw zpow_mul, apply H.zpow_mem, exact_mod_cast (nat.find_spec hex).2 },
      have hk₃ : g ^ (k % nat.find hex) ∈ H,
        from (subgroup.mul_mem_cancel_right H hk₂).1 $
          by rw [← zpow_add, int.mod_add_div, hk]; exact hx,
      have hk₄ : k % nat.find hex = (k % nat.find hex).nat_abs,
        by rw int.nat_abs_of_nonneg (int.mod_nonneg _
          (int.coe_nat_ne_zero_iff_pos.2 (nat.find_spec hex).1)),
      have hk₅ : g ^ (k % nat.find hex ).nat_abs ∈ H,
        by rwa [← zpow_coe_nat, ← hk₄],
      have hk₆ : (k % (nat.find hex : ℤ)).nat_abs = 0,
        from by_contradiction (λ h,
          nat.find_min hex (int.coe_nat_lt.1 $ by rw [← hk₄];
            exact int.mod_lt_of_pos _ (int.coe_nat_pos.2 (nat.find_spec hex).1))
          ⟨nat.pos_of_ne_zero h, hk₅⟩),
      ⟨k / (nat.find hex : ℤ), subtype.ext_iff_val.2 begin
        suffices : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) = x,
        { simpa [zpow_mul] },
        rw [int.mul_div_cancel' (int.dvd_of_mod_eq_zero (int.eq_zero_of_nat_abs_eq_zero hk₆)), hk]
      end⟩⟩⟩
else
  have H = (⊥ : subgroup α), from subgroup.ext $ λ x, ⟨λ h, by simp at *; tauto,
    λ h, by rw [subgroup.mem_bot.1 h]; exact H.one_mem⟩,
  by clear _let_match; substI this; apply_instance

open finset nat

section classical

open_locale classical

@[to_additive is_add_cyclic.card_pow_eq_one_le]
lemma is_cyclic.card_pow_eq_one_le [decidable_eq α] [fintype α] [is_cyclic α] {n : ℕ}
  (hn0 : 0 < n) : (univ.filter (λ a : α, a ^ n = 1)).card ≤ n :=
let ⟨g, hg⟩ := is_cyclic.exists_generator α in
calc (univ.filter (λ a : α, a ^ n = 1)).card
  ≤ ((zpowers (g ^ (fintype.card α / (nat.gcd n (fintype.card α))))) : set α).to_finset.card :
  card_le_of_subset (λ x hx, let ⟨m, hm⟩ := show x ∈ submonoid.powers g,
    from mem_powers_iff_mem_zpowers.2 $ hg x in
    set.mem_to_finset.2 ⟨(m / (fintype.card α / (nat.gcd n (fintype.card α))) : ℕ),
      have hgmn : g ^ (m * nat.gcd n (fintype.card α)) = 1,
        by rw [pow_mul, hm, ← pow_gcd_card_eq_one_iff]; exact (mem_filter.1 hx).2,
      begin
        rw [zpow_coe_nat, ← pow_mul, nat.mul_div_cancel_left', hm],
        refine dvd_of_mul_dvd_mul_right (gcd_pos_of_pos_left (fintype.card α) hn0) _,
        conv_lhs
        { rw [nat.div_mul_cancel (nat.gcd_dvd_right _ _),
              ←order_of_eq_card_of_forall_mem_zpowers hg] },
        exact order_of_dvd_of_pow_eq_one hgmn
      end⟩)
... ≤ n :
  let ⟨m, hm⟩ := nat.gcd_dvd_right n (fintype.card α) in
  have hm0 : 0 < m, from nat.pos_of_ne_zero $
    λ hm0, by { rw [hm0, mul_zero, fintype.card_eq_zero_iff] at hm, exact hm.elim' 1 },
  begin
    simp only [set.to_finset_card, set_like.coe_sort_coe],
    rw [←order_eq_card_zpowers, order_of_pow g, order_of_eq_card_of_forall_mem_zpowers hg],
    rw [hm] {occs := occurrences.pos [2,3]},
    rw [nat.mul_div_cancel_left _  (gcd_pos_of_pos_left _ hn0), gcd_mul_left_left,
      hm, nat.mul_div_cancel _ hm0],
    exact le_of_dvd hn0 (nat.gcd_dvd_left _ _)
  end

end classical

@[to_additive]
lemma is_cyclic.exists_monoid_generator [fintype α]
[is_cyclic α] : ∃ x : α, ∀ y : α, y ∈ submonoid.powers x :=
by { simp_rw [mem_powers_iff_mem_zpowers], exact is_cyclic.exists_generator α }

section

variables [decidable_eq α] [fintype α]

@[to_additive]
lemma is_cyclic.image_range_order_of (ha : ∀ x : α, x ∈ zpowers a) :
  finset.image (λ i, a ^ i) (range (order_of a)) = univ :=
begin
  simp_rw [←set_like.mem_coe] at ha,
  simp only [image_range_order_of, set.eq_univ_iff_forall.mpr ha, set.to_finset_univ],
end

@[to_additive]
lemma is_cyclic.image_range_card (ha : ∀ x : α, x ∈ zpowers a) :
  finset.image (λ i, a ^ i) (range (fintype.card α)) = univ :=
by rw [← order_of_eq_card_of_forall_mem_zpowers ha, is_cyclic.image_range_order_of ha]

end

section totient

variables [decidable_eq α] [fintype α]
(hn : ∀ n : ℕ, 0 < n → (univ.filter (λ a : α, a ^ n = 1)).card ≤ n)

include hn

private lemma card_pow_eq_one_eq_order_of_aux (a : α) :
  (finset.univ.filter (λ b : α, b ^ order_of a = 1)).card = order_of a :=
le_antisymm
  (hn _ (order_of_pos a))
  (calc order_of a = @fintype.card (zpowers a) (id _) : order_eq_card_zpowers
    ... ≤ @fintype.card (↑(univ.filter (λ b : α, b ^ order_of a = 1)) : set α)
    (fintype.of_finset _ (λ _, iff.rfl)) :
      @fintype.card_le_of_injective (zpowers a)
        (↑(univ.filter (λ b : α, b ^ order_of a = 1)) : set α)
        (id _) (id _) (λ b, ⟨b.1, mem_filter.2 ⟨mem_univ _,
          let ⟨i, hi⟩ := b.2 in
          by rw [← hi, ← zpow_coe_nat, ← zpow_mul, mul_comm, zpow_mul, zpow_coe_nat,
            pow_order_of_eq_one, one_zpow]⟩⟩) (λ _ _ h, subtype.eq (subtype.mk.inj h))
    ... = (univ.filter (λ b : α, b ^ order_of a = 1)).card : fintype.card_of_finset _ _)

open_locale nat -- use φ for nat.totient

private lemma card_order_of_eq_totient_aux₁ :
  ∀ {d : ℕ}, d ∣ fintype.card α → 0 < (univ.filter (λ a : α, order_of a = d)).card →
  (univ.filter (λ a : α, order_of a = d)).card = φ d :=
begin
  intros d hd hd0,
  induction d using nat.strong_rec' with d IH,
  rcases d.eq_zero_or_pos with rfl | hd_pos,
  { cases fintype.card_ne_zero (eq_zero_of_zero_dvd hd) },
  rcases card_pos.1 hd0 with ⟨a, ha'⟩,
  have ha : order_of a = d := (mem_filter.1 ha').2,
  have h1 : ∑ m in d.proper_divisors, (univ.filter (λ a : α, order_of a = m)).card =
    ∑ m in d.proper_divisors, φ m,
  { refine finset.sum_congr rfl (λ m hm, _),
    simp only [mem_filter, mem_range, mem_proper_divisors] at hm,
    refine IH m hm.2 (hm.1.trans hd) (finset.card_pos.2 ⟨a ^ (d / m), _⟩),
    simp only [mem_filter, mem_univ, order_of_pow a, ha, true_and,
      nat.gcd_eq_right (div_dvd_of_dvd hm.1), nat.div_div_self hm.1 hd_pos] },
  have h2 : ∑ m in d.divisors, (univ.filter (λ a : α, order_of a = m)).card =
    ∑ m in d.divisors, φ m,
    { rw [←filter_dvd_eq_divisors hd_pos.ne', sum_card_order_of_eq_card_pow_eq_one hd_pos,
      filter_dvd_eq_divisors hd_pos.ne', sum_totient, ←ha, card_pow_eq_one_eq_order_of_aux hn a] },
  simpa [divisors_eq_proper_divisors_insert_self_of_pos hd_pos, ←h1] using h2,
end

lemma card_order_of_eq_totient_aux₂ {d : ℕ} (hd : d ∣ fintype.card α) :
  (univ.filter (λ a : α, order_of a = d)).card = φ d :=
begin
  let c := fintype.card α,
  have hc0 : 0 < c := fintype.card_pos_iff.2 ⟨1⟩,
  apply card_order_of_eq_totient_aux₁ hn hd,
  by_contradiction h0,
  simp only [not_lt, _root_.le_zero_iff, card_eq_zero] at h0,
  apply lt_irrefl c,
  calc
    c = ∑ m in c.divisors, (univ.filter (λ a : α, order_of a = m)).card : by
  { simp only [←filter_dvd_eq_divisors hc0.ne', sum_card_order_of_eq_card_pow_eq_one hc0],
    apply congr_arg card,
    simp }
  ... = ∑ m in c.divisors.erase d, (univ.filter (λ a : α, order_of a = m)).card : by
  { rw eq_comm,
    refine (sum_subset (erase_subset _ _) (λ m hm₁ hm₂, _)),
    have : m = d, by { contrapose! hm₂, exact mem_erase_of_ne_of_mem hm₂ hm₁ },
    simp [this, h0] }
  ... ≤ ∑ m in c.divisors.erase d, φ m : by
  { refine sum_le_sum (λ m hm, _),
    have hmc : m ∣ c, { simp only [mem_erase, mem_divisors] at hm, tauto },
    rcases (filter (λ (a : α), order_of a = m) univ).card.eq_zero_or_pos with h1 | h1,
    { simp [h1] }, { simp [card_order_of_eq_totient_aux₁ hn hmc h1] } }
  ... < ∑ m in c.divisors, φ m :
  sum_erase_lt_of_pos (mem_divisors.2 ⟨hd, hc0.ne'⟩) (totient_pos (pos_of_dvd_of_pos hd hc0))
   ... = c : sum_totient _
end

lemma is_cyclic_of_card_pow_eq_one_le : is_cyclic α :=
have (univ.filter (λ a : α, order_of a = fintype.card α)).nonempty,
from (card_pos.1 $
  by rw [card_order_of_eq_totient_aux₂ hn dvd_rfl];
  exact totient_pos (fintype.card_pos_iff.2 ⟨1⟩)),
let ⟨x, hx⟩ := this in
is_cyclic_of_order_of_eq_card x (finset.mem_filter.1 hx).2

lemma is_add_cyclic_of_card_pow_eq_one_le {α} [add_group α] [decidable_eq α] [fintype α]
  (hn : ∀ n : ℕ, 0 < n → (univ.filter (λ a : α, n • a = 0)).card ≤ n) : is_add_cyclic α :=
begin
  obtain ⟨g, hg⟩ := @is_cyclic_of_card_pow_eq_one_le (multiplicative α) _ _ _ hn,
  exact ⟨⟨g, hg⟩⟩
end

attribute [to_additive is_cyclic_of_card_pow_eq_one_le] is_add_cyclic_of_card_pow_eq_one_le

end totient

lemma is_cyclic.card_order_of_eq_totient [is_cyclic α] [fintype α]
  {d : ℕ} (hd : d ∣ fintype.card α) : (univ.filter (λ a : α, order_of a = d)).card = totient d :=
begin
  classical,
  apply card_order_of_eq_totient_aux₂ (λ n, is_cyclic.card_pow_eq_one_le) hd
end

lemma is_add_cyclic.card_order_of_eq_totient {α} [add_group α] [is_add_cyclic α] [fintype α] {d : ℕ}
  (hd : d ∣ fintype.card α) : (univ.filter (λ a : α, add_order_of a = d)).card = totient d :=
begin
  obtain ⟨g, hg⟩ := id ‹is_add_cyclic α›,
  exact @is_cyclic.card_order_of_eq_totient (multiplicative α) _ ⟨⟨g, hg⟩⟩ _ _ hd
end

attribute [to_additive is_cyclic.card_order_of_eq_totient] is_add_cyclic.card_order_of_eq_totient

/-- A finite group of prime order is simple. -/
@[to_additive]
lemma is_simple_group_of_prime_card {α : Type u} [group α] [fintype α] {p : ℕ} [hp : fact p.prime]
  (h : fintype.card α = p) : is_simple_group α :=
⟨begin
  have h' := nat.prime.one_lt (fact.out p.prime),
  rw ← h at h',
  haveI := fintype.one_lt_card_iff_nontrivial.1 h',
  apply exists_pair_ne α,
end, λ H Hn, begin
  classical,
  have hcard := card_subgroup_dvd_card H,
  rw [h, dvd_prime (fact.out p.prime)] at hcard,
  refine hcard.imp (λ h1, _) (λ hp, _),
  { haveI := fintype.card_le_one_iff_subsingleton.1 (le_of_eq h1),
    apply eq_bot_of_subsingleton },
  { exact eq_top_of_card_eq _ (hp.trans h.symm) }
end⟩

end cyclic

section quotient_center

open subgroup

variables {G : Type*} {H : Type*} [group G] [group H]

/-- A group is commutative if the quotient by the center is cyclic.
  Also see `comm_group_of_cycle_center_quotient` for the `comm_group` instance. -/
@[to_additive commutative_of_add_cyclic_center_quotient "A group is commutative if the quotient by
  the center is cyclic. Also see `add_comm_group_of_cycle_center_quotient`
  for the `add_comm_group` instance."]
lemma commutative_of_cyclic_center_quotient [is_cyclic H] (f : G →* H)
  (hf : f.ker ≤ center G) (a b : G) : a * b = b * a :=
let ⟨⟨x, y, (hxy : f y = x)⟩, (hx : ∀ a : f.range, a ∈ zpowers _)⟩ :=
  is_cyclic.exists_generator f.range in
let ⟨m, hm⟩ := hx ⟨f a, a, rfl⟩ in
let ⟨n, hn⟩ := hx ⟨f b, b, rfl⟩ in
have hm : x ^ m = f a, by simpa [subtype.ext_iff] using hm,
have hn : x ^ n = f b, by simpa [subtype.ext_iff] using hn,
have ha : y ^ (-m) * a ∈ center G,
  from hf (by rw [f.mem_ker, f.map_mul, f.map_zpow, hxy, zpow_neg, hm, inv_mul_self]),
have hb : y ^ (-n) * b ∈ center G,
  from hf (by rw [f.mem_ker, f.map_mul, f.map_zpow, hxy, zpow_neg, hn, inv_mul_self]),
calc a * b = y ^ m * ((y ^ (-m) * a) * y ^ n) * (y ^ (-n) * b) : by simp [mul_assoc]
... = y ^ m * (y ^ n * (y ^ (-m) * a)) * (y ^ (-n) * b) : by rw [mem_center_iff.1 ha]
... = y ^ m * y ^ n * y ^ (-m) * (a * (y ^ (-n) * b)) : by simp [mul_assoc]
... = y ^ m * y ^ n * y ^ (-m) * ((y ^ (-n) * b) * a) : by rw [mem_center_iff.1 hb]
... = b * a : by group

/-- A group is commutative if the quotient by the center is cyclic. -/
@[to_additive commutative_of_add_cycle_center_quotient "A group is commutative if the quotient by
  the center is cyclic."]
def comm_group_of_cycle_center_quotient [is_cyclic H] (f : G →* H)
  (hf : f.ker ≤ center G) : comm_group G :=
{ mul_comm := commutative_of_cyclic_center_quotient f hf,
  ..show group G, by apply_instance }

end quotient_center

namespace is_simple_group

section comm_group
variables [comm_group α] [is_simple_group α]

@[priority 100, to_additive is_simple_add_group.is_add_cyclic]
instance : is_cyclic α :=
begin
  cases subsingleton_or_nontrivial α with hi hi; haveI := hi,
  { apply is_cyclic_of_subsingleton },
  { obtain ⟨g, hg⟩ := exists_ne (1 : α),
    refine ⟨⟨g, λ x, _⟩⟩,
    cases is_simple_order.eq_bot_or_eq_top (subgroup.zpowers g) with hb ht,
    { exfalso,
      apply hg,
      rw [← subgroup.mem_bot, ← hb],
      apply subgroup.mem_zpowers },
    { rw ht,
      apply subgroup.mem_top } }
end

@[to_additive]
theorem prime_card [fintype α] : (fintype.card α).prime :=
begin
  have h0 : 0 < fintype.card α := fintype.card_pos_iff.2 (by apply_instance),
  obtain ⟨g, hg⟩ := is_cyclic.exists_generator α,
  rw nat.prime_def_lt'',
  refine ⟨fintype.one_lt_card_iff_nontrivial.2 infer_instance, λ n hn, _⟩,
  refine (is_simple_order.eq_bot_or_eq_top (subgroup.zpowers (g ^ n))).symm.imp _ _,
  { intro h,
    have hgo := order_of_pow g,
    rw [order_of_eq_card_of_forall_mem_zpowers hg, nat.gcd_eq_right_iff_dvd.1 hn,
      order_of_eq_card_of_forall_mem_zpowers, eq_comm,
      nat.div_eq_iff_eq_mul_left (nat.pos_of_dvd_of_pos hn h0) hn] at hgo,
    { exact (mul_left_cancel₀ (ne_of_gt h0) ((mul_one (fintype.card α)).trans hgo)).symm },
    { intro x,
      rw h,
      exact subgroup.mem_top _ } },
  { intro h,
    apply le_antisymm (nat.le_of_dvd h0 hn),
    rw ← order_of_eq_card_of_forall_mem_zpowers hg,
    apply order_of_le_of_pow_eq_one (nat.pos_of_dvd_of_pos hn h0),
    rw [← subgroup.mem_bot, ← h],
    exact subgroup.mem_zpowers _ }
end

end comm_group

end is_simple_group

@[to_additive add_comm_group.is_simple_iff_is_add_cyclic_and_prime_card]
theorem comm_group.is_simple_iff_is_cyclic_and_prime_card [fintype α] [comm_group α] :
  is_simple_group α ↔ is_cyclic α ∧ (fintype.card α).prime :=
begin
  split,
  { introI h,
    exact ⟨is_simple_group.is_cyclic, is_simple_group.prime_card⟩ },
  { rintro ⟨hc, hp⟩,
    haveI : fact (fintype.card α).prime := ⟨hp⟩,
    exact is_simple_group_of_prime_card rfl }
end

section exponent

open monoid

@[to_additive] lemma is_cyclic.exponent_eq_card [group α] [is_cyclic α] [fintype α] :
  exponent α = fintype.card α :=
begin
  obtain ⟨g, hg⟩ := is_cyclic.exists_generator α,
  apply nat.dvd_antisymm,
  { rw [←lcm_order_eq_exponent, finset.lcm_dvd_iff],
    exact λ b _, order_of_dvd_card_univ },
  rw ←order_of_eq_card_of_forall_mem_zpowers hg,
  exact order_dvd_exponent _
end

@[to_additive] lemma is_cyclic.of_exponent_eq_card [comm_group α] [fintype α]
  (h : exponent α = fintype.card α) : is_cyclic α :=
let ⟨g, _, hg⟩ := finset.mem_image.mp (finset.max'_mem _ _) in
is_cyclic_of_order_of_eq_card g $ hg.trans $ exponent_eq_max'_order_of.symm.trans h

@[to_additive] lemma is_cyclic.iff_exponent_eq_card [comm_group α] [fintype α] :
  is_cyclic α ↔ exponent α = fintype.card α :=
⟨λ h, by exactI is_cyclic.exponent_eq_card, is_cyclic.of_exponent_eq_card⟩

@[to_additive] lemma is_cyclic.exponent_eq_zero_of_infinite [group α] [is_cyclic α] [infinite α] :
  exponent α = 0 :=
let ⟨g, hg⟩ := is_cyclic.exists_generator α in
exponent_eq_zero_of_order_zero $ infinite.order_of_eq_zero_of_forall_mem_zpowers hg

end exponent


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.calculus.parametric_integral
import measure_theory.integral.interval_integral

/-!
# Derivatives of interval integrals depending on parameters

In this file we restate theorems about derivatives of integrals depending on parameters for interval
integrals.  -/

open topological_space measure_theory filter metric
open_locale topology filter interval

variables {𝕜 : Type*} [is_R_or_C 𝕜] {μ : measure ℝ}
          {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [normed_space 𝕜 E]
          [complete_space E]
          {H : Type*} [normed_add_comm_group H] [normed_space 𝕜 H]
          {a b ε : ℝ} {bound : ℝ → ℝ}

namespace interval_integral

/-- Differentiation under integral of `x ↦ ∫ t in a..b, F x t` at a given point `x₀`, assuming
`F x₀` is integrable, `x ↦ F x a` is locally Lipschitz on a ball around `x₀` for ae `a`
(with a ball radius independent of `a`) with integrable Lipschitz bound, and `F x` is ae-measurable
for `x` in a possibly smaller neighborhood of `x₀`. -/
lemma has_fderiv_at_integral_of_dominated_loc_of_lip {F : H → ℝ → E} {F' : ℝ → (H →L[𝕜] E)} {x₀ : H}
  (ε_pos : 0 < ε)
  (hF_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (F x) (μ.restrict (Ι a b)))
  (hF_int : interval_integrable (F x₀) μ a b)
  (hF'_meas : ae_strongly_measurable F' (μ.restrict (Ι a b)))
  (h_lip : ∀ᵐ t ∂μ, t ∈ Ι a b → lipschitz_on_with (real.nnabs $ bound t) (λ x, F x t) (ball x₀ ε))
  (bound_integrable : interval_integrable bound μ a b)
  (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → has_fderiv_at (λ x, F x t) (F' t) x₀) :
  interval_integrable F' μ a b ∧
    has_fderiv_at (λ x, ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' t ∂μ) x₀ :=
begin
  simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc,
    ← ae_restrict_iff' measurable_set_uIoc] at *,
  have := has_fderiv_at_integral_of_dominated_loc_of_lip ε_pos hF_meas hF_int hF'_meas h_lip
    bound_integrable h_diff,
  exact ⟨this.1, this.2.const_smul _⟩
end

/-- Differentiation under integral of `x ↦ ∫ F x a` at a given point `x₀`, assuming
`F x₀` is integrable, `x ↦ F x a` is differentiable on a ball around `x₀` for ae `a` with
derivative norm uniformly bounded by an integrable function (the ball radius is independent of `a`),
and `F x` is ae-measurable for `x` in a possibly smaller neighborhood of `x₀`. -/
lemma has_fderiv_at_integral_of_dominated_of_fderiv_le {F : H → ℝ → E} {F' : H → ℝ → (H →L[𝕜] E)}
  {x₀ : H} (ε_pos : 0 < ε)
  (hF_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (F x) (μ.restrict (Ι a b)))
  (hF_int : interval_integrable (F x₀) μ a b)
  (hF'_meas : ae_strongly_measurable (F' x₀) (μ.restrict (Ι a b)))
  (h_bound : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, ‖F' x t‖ ≤ bound t)
  (bound_integrable : interval_integrable bound μ a b)
  (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, has_fderiv_at (λ x, F x t) (F' x t) x) :
  has_fderiv_at (λ x, ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' x₀ t ∂μ) x₀ :=
begin
  simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc,
    ← ae_restrict_iff' measurable_set_uIoc] at *,
  exact (has_fderiv_at_integral_of_dominated_of_fderiv_le ε_pos hF_meas hF_int hF'_meas h_bound
    bound_integrable h_diff).const_smul _
end

/-- Derivative under integral of `x ↦ ∫ F x a` at a given point `x₀ : 𝕜`, `𝕜 = ℝ` or `𝕜 = ℂ`,
assuming `F x₀` is integrable, `x ↦ F x a` is locally Lipschitz on a ball around `x₀` for ae `a`
(with ball radius independent of `a`) with integrable Lipschitz bound, and `F x` is
ae-measurable for `x` in a possibly smaller neighborhood of `x₀`. -/
lemma has_deriv_at_integral_of_dominated_loc_of_lip {F : 𝕜 → ℝ → E} {F' : ℝ → E} {x₀ : 𝕜}
  (ε_pos : 0 < ε)
  (hF_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (F x) (μ.restrict (Ι a b)))
  (hF_int : interval_integrable (F x₀) μ a b)
  (hF'_meas : ae_strongly_measurable F' (μ.restrict (Ι a b)))
  (h_lipsch : ∀ᵐ t ∂μ, t ∈ Ι a b →
    lipschitz_on_with (real.nnabs $ bound t) (λ x, F x t) (ball x₀ ε))
  (bound_integrable : interval_integrable (bound : ℝ → ℝ) μ a b)
  (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → has_deriv_at (λ x, F x t) (F' t) x₀) :
  (interval_integrable F' μ a b) ∧
    has_deriv_at (λ x, ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' t ∂μ) x₀ :=
begin
  simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc,
    ← ae_restrict_iff' measurable_set_uIoc] at *,
  have := has_deriv_at_integral_of_dominated_loc_of_lip ε_pos hF_meas hF_int hF'_meas h_lipsch
    bound_integrable h_diff,
  exact ⟨this.1, this.2.const_smul _⟩
end

/-- Derivative under integral of `x ↦ ∫ F x a` at a given point `x₀ : 𝕜`, `𝕜 = ℝ` or `𝕜 = ℂ`,
assuming `F x₀` is integrable, `x ↦ F x a` is differentiable on an interval around `x₀` for ae `a`
(with interval radius independent of `a`) with derivative uniformly bounded by an integrable
function, and `F x` is ae-measurable for `x` in a possibly smaller neighborhood of `x₀`. -/
lemma has_deriv_at_integral_of_dominated_loc_of_deriv_le {F : 𝕜 → ℝ → E} {F' : 𝕜 → ℝ → E} {x₀ : 𝕜}
  (ε_pos : 0 < ε)
  (hF_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (F x) (μ.restrict (Ι a b)))
  (hF_int : interval_integrable (F x₀) μ a b)
  (hF'_meas : ae_strongly_measurable (F' x₀) (μ.restrict (Ι a b)))
  (h_bound : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, ‖F' x t‖ ≤ bound t)
  (bound_integrable : interval_integrable bound μ a b)
  (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, has_deriv_at (λ x, F x t) (F' x t) x) :
  (interval_integrable (F' x₀) μ a b) ∧
    has_deriv_at (λ x, ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' x₀ t ∂μ) x₀ :=
begin
  simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc,
    ← ae_restrict_iff' measurable_set_uIoc] at *,
  have := has_deriv_at_integral_of_dominated_loc_of_deriv_le ε_pos hF_meas hF_int hF'_meas h_bound
    bound_integrable h_diff,
  exact ⟨this.1, this.2.const_smul _⟩
end

end interval_integral


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.order.monoid_lemmas
import algebra.group_with_zero.basic
import logic.embedding

/-!
# Regular elements

We introduce left-regular, right-regular and regular elements.

By definition, a regular element in a commutative ring is a non-zero divisor.
Lemma `is_regular_of_ne_zero` implies that every non-zero element of an integral domain is regular.
Since it assumes that the ring is a `cancel_monoid_with_zero` it applies also, for instance, to `ℕ`.

The lemmas in Section `mul_zero_class` show that the `0` element is (left/right-)regular if and
only if the `mul_zero_class` is trivial.  This is useful when figuring out stopping conditions for
regular sequences: if `0` is ever an element of a regular sequence, then we can extend the sequence
by adding one further `0`.

The final goal is to develop part of the API to prove, eventually, results about non-zero-divisors.
-/
variables {R : Type*} {a b : R}

section has_mul

variable [has_mul R]

/-- A left-regular element is an element `c` such that multiplication on the left by `c`
is injective on the left. -/
def is_left_regular (c : R) := function.injective ((*) c)

/-- A right-regular element is an element `c` such that multiplication on the right by `c`
is injective on the right. -/
def is_right_regular (c : R) := function.injective (* c)

/-- A regular element is an element `c` such that multiplication by `c` both on the left and
on the right is injective. -/
structure is_regular (c : R) : Prop :=
(left : is_left_regular c)
(right : is_right_regular c)

protected lemma mul_le_cancellable.is_left_regular [partial_order R] {a : R}
  (ha : mul_le_cancellable a) : is_left_regular a :=
ha.injective

end has_mul

section semigroup

variable [semigroup R]

/-- In a semigroup, the product of left-regular elements is left-regular. -/
lemma is_left_regular.mul (lra : is_left_regular a) (lrb : is_left_regular b) :
  is_left_regular (a * b) :=
show function.injective ((*) (a * b)), from (comp_mul_left a b) ▸ lra.comp lrb

/-- In a semigroup, the product of right-regular elements is right-regular. -/
lemma is_right_regular.mul (rra : is_right_regular a) (rrb : is_right_regular b) :
  is_right_regular (a * b) :=
show function.injective (* (a * b)), from (comp_mul_right b a) ▸ rrb.comp rra

/--  If an element `b` becomes left-regular after multiplying it on the left by a left-regular
element, then `b` is left-regular. -/
lemma is_left_regular.of_mul (ab : is_left_regular (a * b)) :
  is_left_regular b :=
function.injective.of_comp (by rwa comp_mul_left a b)

/--  An element is left-regular if and only if multiplying it on the left by a left-regular element
is left-regular. -/
@[simp] lemma mul_is_left_regular_iff (b : R) (ha : is_left_regular a) :
  is_left_regular (a * b) ↔ is_left_regular b :=
⟨λ ab, is_left_regular.of_mul ab, λ ab, is_left_regular.mul ha ab⟩

/--  If an element `b` becomes right-regular after multiplying it on the right by a right-regular
element, then `b` is right-regular. -/
lemma is_right_regular.of_mul (ab : is_right_regular (b * a)) :
  is_right_regular b :=
begin
  refine λ x y xy, ab (_ : x * (b * a) = y * (b * a)),
  rw [← mul_assoc, ← mul_assoc],
  exact congr_fun (congr_arg has_mul.mul xy) a,
end

/--  An element is right-regular if and only if multiplying it on the right with a right-regular
element is right-regular. -/
@[simp] lemma mul_is_right_regular_iff (b : R) (ha : is_right_regular a) :
  is_right_regular (b * a) ↔ is_right_regular b :=
⟨λ ab, is_right_regular.of_mul ab, λ ab, is_right_regular.mul ab ha⟩

/--  Two elements `a` and `b` are regular if and only if both products `a * b` and `b * a`
are regular. -/
lemma is_regular_mul_and_mul_iff :
  is_regular (a * b) ∧ is_regular (b * a) ↔ is_regular a ∧ is_regular b :=
begin
  refine ⟨_, _⟩,
  { rintros ⟨ab, ba⟩,
    exact ⟨⟨is_left_regular.of_mul ba.left, is_right_regular.of_mul ab.right⟩,
      ⟨is_left_regular.of_mul ab.left, is_right_regular.of_mul ba.right⟩⟩ },
  { rintros ⟨ha, hb⟩,
    exact ⟨⟨(mul_is_left_regular_iff _ ha.left).mpr hb.left,
        (mul_is_right_regular_iff _ hb.right).mpr ha.right⟩,
      ⟨(mul_is_left_regular_iff _ hb.left).mpr ha.left,
        (mul_is_right_regular_iff _ ha.right).mpr hb.right⟩⟩ }
end

/--  The "most used" implication of `mul_and_mul_iff`, with split hypotheses, instead of `∧`. -/
lemma is_regular.and_of_mul_of_mul (ab : is_regular (a * b)) (ba : is_regular (b * a)) :
  is_regular a ∧ is_regular b :=
is_regular_mul_and_mul_iff.mp ⟨ab, ba⟩

end semigroup

section mul_zero_class

variables [mul_zero_class R]

/--  The element `0` is left-regular if and only if `R` is trivial. -/
lemma is_left_regular.subsingleton (h : is_left_regular (0 : R)) : subsingleton R :=
⟨λ a b, h $ eq.trans (zero_mul a) (zero_mul b).symm⟩

/--  The element `0` is right-regular if and only if `R` is trivial. -/
lemma is_right_regular.subsingleton (h : is_right_regular (0 : R)) : subsingleton R :=
⟨λ a b, h $ eq.trans (mul_zero a) (mul_zero b).symm⟩

/--  The element `0` is regular if and only if `R` is trivial. -/
lemma is_regular.subsingleton (h : is_regular (0 : R)) : subsingleton R :=
h.left.subsingleton

/--  The element `0` is left-regular if and only if `R` is trivial. -/
lemma is_left_regular_zero_iff_subsingleton : is_left_regular (0 : R) ↔ subsingleton R :=
begin
  refine ⟨λ h, h.subsingleton, _⟩,
  intros H a b h,
  exact @subsingleton.elim _ H a b
end

/--  In a non-trivial `mul_zero_class`, the `0` element is not left-regular. -/
lemma not_is_left_regular_zero_iff : ¬ is_left_regular (0 : R) ↔ nontrivial R :=
begin
  rw [nontrivial_iff, not_iff_comm, is_left_regular_zero_iff_subsingleton, subsingleton_iff],
  push_neg,
  exact iff.rfl
end

/--  The element `0` is right-regular if and only if `R` is trivial. -/
lemma is_right_regular_zero_iff_subsingleton : is_right_regular (0 : R) ↔ subsingleton R :=
begin
  refine ⟨λ h, h.subsingleton, _⟩,
  intros H a b h,
  exact @subsingleton.elim _ H a b
end

/--  In a non-trivial `mul_zero_class`, the `0` element is not right-regular. -/
lemma not_is_right_regular_zero_iff : ¬ is_right_regular (0 : R) ↔ nontrivial R :=
begin
  rw [nontrivial_iff, not_iff_comm, is_right_regular_zero_iff_subsingleton, subsingleton_iff],
  push_neg,
  exact iff.rfl
end

/--  The element `0` is regular if and only if `R` is trivial. -/
lemma is_regular_iff_subsingleton : is_regular (0 : R) ↔ subsingleton R :=
⟨λ h, h.left.subsingleton,
 λ h, ⟨is_left_regular_zero_iff_subsingleton.mpr h, is_right_regular_zero_iff_subsingleton.mpr h⟩⟩

/-- A left-regular element of a `nontrivial` `mul_zero_class` is non-zero. -/
lemma is_left_regular.ne_zero [nontrivial R] (la : is_left_regular a) : a ≠ 0 :=
begin
  rintro rfl,
  rcases exists_pair_ne R with ⟨x, y, xy⟩,
  refine xy (la _),
  rw [zero_mul, zero_mul]
end

/-- A right-regular element of a `nontrivial` `mul_zero_class` is non-zero. -/
lemma is_right_regular.ne_zero [nontrivial R] (ra : is_right_regular a) : a ≠ 0 :=
begin
  rintro rfl,
  rcases exists_pair_ne R with ⟨x, y, xy⟩,
  refine xy (ra (_ : x * 0 = y * 0)),
  rw [mul_zero, mul_zero]
end

/-- A regular element of a `nontrivial` `mul_zero_class` is non-zero. -/
lemma is_regular.ne_zero [nontrivial R] (la : is_regular a) : a ≠ 0 :=
la.left.ne_zero

/--  In a non-trivial ring, the element `0` is not left-regular -- with typeclasses. -/
lemma not_is_left_regular_zero [nR : nontrivial R] : ¬ is_left_regular (0 : R) :=
not_is_left_regular_zero_iff.mpr nR

/--  In a non-trivial ring, the element `0` is not right-regular -- with typeclasses. -/
lemma not_is_right_regular_zero [nR : nontrivial R] : ¬ is_right_regular (0 : R) :=
not_is_right_regular_zero_iff.mpr nR

/--  In a non-trivial ring, the element `0` is not regular -- with typeclasses. -/
lemma not_is_regular_zero [nontrivial R] : ¬ is_regular (0 : R) :=
λ h, is_regular.ne_zero h rfl

end mul_zero_class

section comm_semigroup

variable [comm_semigroup R]

/--  A product is regular if and only if the factors are. -/
lemma is_regular_mul_iff : is_regular (a * b) ↔ is_regular a ∧ is_regular b :=
begin
  refine iff.trans _ is_regular_mul_and_mul_iff,
  refine ⟨λ ab, ⟨ab, by rwa mul_comm⟩, λ rab, rab.1⟩
end

end comm_semigroup

section monoid

variables [monoid R]

/--  In a monoid, `1` is regular. -/
lemma is_regular_one : is_regular (1 : R) :=
⟨λ a b ab, (one_mul a).symm.trans (eq.trans ab (one_mul b)),
  λ a b ab, (mul_one a).symm.trans (eq.trans ab (mul_one b))⟩

/-- An element admitting a left inverse is left-regular. -/
lemma is_left_regular_of_mul_eq_one (h : b * a = 1) : is_left_regular a :=
@is_left_regular.of_mul R _ a _ (by { rw h, exact is_regular_one.left })

/-- An element admitting a right inverse is right-regular. -/
lemma is_right_regular_of_mul_eq_one (h : a * b = 1) : is_right_regular a :=
@is_right_regular.of_mul R _ a _ (by { rw h, exact is_regular_one.right })

/-- If `R` is a monoid, an element in `units R` is regular. -/
lemma units.is_regular (a : units R) : is_regular (a : R) :=
⟨is_left_regular_of_mul_eq_one a.inv_mul, is_right_regular_of_mul_eq_one a.mul_inv⟩

/-- A unit in a monoid is regular. -/
lemma is_unit.is_regular (ua : is_unit a) : is_regular a :=
begin
  rcases ua with ⟨a, rfl⟩,
  exact units.is_regular a,
end

end monoid

section left_or_right_cancel_semigroup

/--
The embedding of a left cancellative semigroup into itself
by left multiplication by a fixed element.
 -/
@[to_additive
  "The embedding of a left cancellative additive semigroup into itself
   by left translation by a fixed element.", simps]
def mul_left_embedding {G : Type*} [left_cancel_semigroup G] (g : G) : G ↪ G :=
{ to_fun := λ h, g * h, inj' := mul_right_injective g }

/--
The embedding of a right cancellative semigroup into itself
by right multiplication by a fixed element.
 -/
@[to_additive
  "The embedding of a right cancellative additive semigroup into itself
   by right translation by a fixed element.", simps]
def mul_right_embedding {G : Type*} [right_cancel_semigroup G] (g : G) : G ↪ G :=
{ to_fun := λ h, h * g, inj' := mul_left_injective g }

/--  Elements of a left cancel semigroup are left regular. -/
lemma is_left_regular_of_left_cancel_semigroup [left_cancel_semigroup R] (g : R) :
  is_left_regular g :=
mul_right_injective g

/--  Elements of a right cancel semigroup are right regular. -/
lemma is_right_regular_of_right_cancel_semigroup [right_cancel_semigroup R] (g : R) :
  is_right_regular g :=
mul_left_injective g

end left_or_right_cancel_semigroup

section cancel_monoid

variables [cancel_monoid R]

/--  Elements of a cancel monoid are regular.  Cancel semigroups do not appear to exist. -/
lemma is_regular_of_cancel_monoid (g : R) : is_regular g :=
⟨mul_right_injective g, mul_left_injective g⟩

end cancel_monoid

section cancel_monoid_with_zero

variables  [cancel_monoid_with_zero R]

/--  Non-zero elements of an integral domain are regular. -/
lemma is_regular_of_ne_zero (a0 : a ≠ 0) : is_regular a :=
⟨λ b c, (mul_right_inj' a0).mp, λ b c, (mul_left_inj' a0).mp⟩

/-- In a non-trivial integral domain, an element is regular iff it is non-zero. -/
lemma is_regular_iff_ne_zero [nontrivial R] : is_regular a ↔ a ≠ 0 :=
⟨is_regular.ne_zero, is_regular_of_ne_zero⟩

end cancel_monoid_with_zero