-- 7. Inductive Types
  /- Every inductive type comes with introduction rules, which show how to
     construct an element of the type, and elimination rules, which show how
     to “use” an element of the type in another construction. We have already
     seen the introduction rules for an inductive type:
     they are just the constructors that are specified in the definition of the type.
     The elimination rules provide for a principle of recursion on the type, which
     includes, as a special case, a principle of induction as well. -/

#print "==========================================="
#print "Section 7.1. Enumerated Types"
#print " "
-- https://leanprover.github.io/theorem_proving_in_lean/inductive_types.html#enumerated-types

namespace Sec_7_1
  -- The simplest kind of inductive type is a type with a finite, enumerated list of elements.
  inductive weekday : Type
  | Sunday : weekday
  | Monday : weekday
  | Tuesday : weekday
  | Wednesday : weekday
  | Thursday : weekday
  | Friday : weekday
  | Saturday : weekday

  #check weekday.Monday
  open weekday
  #check Monday

  -- Sunday, Monday, ..., Saturday are distinct elements of weekday, with no special properties.

  /- The elimination principle `weekday.rec` is defined with `weekday` and its constructors.
     `weekday.rec` is aka a recursor; it is what makes the type "inductive" and allows us
     to define a function on weekday by assigning values corresponding to each constructor.
     Intuition: an inductive type is exhaustively generated by its constructors, and has no
     elements beyond those they construct. -/

  /- We will use a slight variant of `weekday.rec`, called `weekday.rec_on`, also generated
     automatically and taking its arguments in a more convenient order.  -/

  -- Let's import `nat` and use `weekday.rec_on` to define a fn from weekday to natural numbers:

  def number_of_day (d : weekday) : ℕ := weekday.rec_on d 1 2 3 4 5 6 7

  #reduce number_of_day weekday.Sunday  -- result: 1
  #reduce number_of_day Sunday          -- (`weekday` is already opened, so this works too)
  #reduce number_of_day Thursday        -- result: 5

  /- The first (explicit) argument to `rec_on` is the element `d` being "analyzed."
     The next seven arguments are the values corresponding to the seven constructors.
     Note that `number_of_day weekday.Sunday` evaluates to 1: the computation rule for
     `rec_on` sees that `Sunday` is a constructor, and returns the appropriate argument. -/

  /- A more restricted variant of `rec_on` is `cases_on`. For enumerated types, `rec_on`
     and `cases_on` are the same, but `cases_on` emphasizes that the definition is by cases. -/

  def number_of_day' (d : weekday) : ℕ := weekday.cases_on d 1 2 3 4 5 6 7

  /- It is useful to group related definitions and theorems in a single namespace.
     We can put `number_of_day` in the `weekday` namespace and then use the shorter name
     when we open the namespace. -/

  /- The names rec_on and cases_on are generated automatically, but they are protected to
     avoid name clashes, so they're not provided by default when the namespace is opened.
     However, you can explicitly declare aliases for them using `renaming`. -/

  namespace weekday
    @[reducible]
    private def cases_on := @weekday.cases_on

    def number_of_day (d : weekday) : nat :=
      cases_on d 1 2 3 4 5 6 7
  end weekday

  -- We can define functions from weekday to weekday:
  namespace weekday
    def next (d : weekday) : weekday :=
      weekday.cases_on d Monday Tuesday Wednesday Thursday Friday Saturday Sunday

    def previous (d : weekday) : weekday :=
      weekday.cases_on d Saturday Sunday Monday Tuesday Wednesday Thursday Friday

    #reduce next (next Tuesday)
    #reduce next (previous Tuesday)

    example (d : weekday) : next (previous d) = d :=
    weekday.cases_on d
      (show next (previous Sunday) = Sunday, from rfl)
      (show next (previous Monday) = Monday, from rfl) -- etc...
      -- ...but the show is just for clarity; we can just use `rfl` by itself
      -- as we do for the remaining cases
      rfl rfl rfl rfl rfl

    -- with tactics, we can be even more concise
    example (d : weekday) : next (previous d) = d :=
      by apply weekday.cases_on d; refl
  end weekday

  -- Some fundamental data types in the Lean library are instances of enumerated types.
  namespace hide

    -- use `hide` so they don't conflict with the stdlib.

    inductive empty : Type  -- an inductive data type with no constructors

    inductive unit : Type | star : unit

    inductive bool : Type
    | ff : bool
    | tt : bool

    /- As an exercise, think about the introduction and elimination rules for these types,
       and define boolean operations `band`, `bor`, `bnot` on the boolean, and verifying
       common identities; e.g., define `band` using a case split: -/

    def band (b1 b2 : bool) : bool := bool.cases_on b1 bool.ff b2
    def bor (b1 b2 : bool) : bool := bool.cases_on b1 b2 bool.tt
    def bnot (b : bool) : bool := bool.cases_on b bool.tt bool.ff

    #reduce band bool.tt bool.tt   -- returns bool.tt
    #reduce band bool.ff bool.tt   -- returns bool.ff
    #reduce bor bool.tt bool.ff    -- returns bool.tt
    #reduce bor bool.ff bool.ff    -- returns bool.ff
    #reduce bnot bool.ff           -- returns bool.tt
    #reduce bnot bool.tt           -- returns bool.ff

-- Similarly, most identities can be proved by introducing suitable case splits, and then using rfl.

  end hide

end Sec_7_1

#print "==========================================="
#print "Section 7.2. Constructors with Arguments"
#print " "
-- https://leanprover.github.io/theorem_proving_in_lean/inductive_types.html#constructors-with-arguments

namespace Sec_7_2
  /- Enumerated types are a special case of inductive types, in which constructors take
     no arguments. In general, a "construction" can depend on data, which is then represented
     in the constructed argument. Consider the definitions of the product and sum types:-/

  universes u v

  namespace hide
    inductive prod (α : Type u) (β : Type v) | mk : α → β → prod
    inductive sum (α : Type u) (β : Type v) | inl {} : α → sum | inr {} : β → sum
  end hide

  /- To define a function on prod α β, we assume input of the form prod.mk a b, and specify
     the output in terms of a and b. For example, here is the definition of the two projections
     for prod.  -/

  -- Remember the std lib uses α × β to denote prod α β and uses (a, b) for prod.mk a b.
  def fst {α : Type u} {β : Type v} (p : α × β) : α := prod.rec_on p (λ a b, a)
  def snd {α : Type u} {β : Type v} (p : α × β) : β := prod.rec_on p (λ a b, b)

  /- `fst` takes pair `p`, applies recursor `prod.rec_on p (λ a b, a)`---which interprets
     `p` as pair `prod.mk a b`---then uses the 2nd arg to determine what to do with a and b. -/

  -- another example
  def prod_example (p : bool × ℕ) : ℕ := prod.rec_on p (λ b n, cond b (2 * n) (2 * n + 1))

  #reduce prod_example (tt, 3)  -- returns 6
  #reduce prod_example (ff, 3)  -- returns 7

  -- `cond` is a boolean conditional: `cond b t1 t2` returns `t1` if `b` is true, and `t2`
  -- otherwise. (It has the same effect as `bool.rec_on b t2 t1`.)

  /- `sum` has two constructors, `inl` and `inr` and each takes one explicit argument.
     To define a function on `sum α β`, we must handle 2 cases: if the input is of the form
     `inl a` (resp., `inr b`) then we must specify an output value in terms of a (resp `b`). -/

  def sum_example (s : ℕ ⊕ ℕ) : ℕ := sum.cases_on s (λ n, 2*n) (λ n, 2*n + 1)

  #reduce sum_example (sum.inl 3) -- returns 6
  #reduce sum_example (sum.inr 3) -- returns 7

  -- Lean's inductive def syntax allows named args for constructors before the colon:

  namespace hide₂
    inductive prod (α : Type) (β : Type) | mk (fst : α) (snd : β) : prod
    inductive sum (α : Type) (β : Type) | inl {} (a : α) : sum | inr {} (b : β) : sum
    /- These result in essentially the same types as the ones above. In `sum`, `{}` refers to
       the parameters, `α` and `β`; braces specify which args are meant to be left implicit. -/
  end hide₂

  /- A type, like `prod`, that has only one constructor is purely conjunctive:
     the constructor simply packs the list of arguments into a single piece of data,
     essentially a tuple where the type of subsequent arguments can depend on the type
     of the initial argument. We can think of such a type as a "record" or a "structure."  -/

  /- In Lean, the keyword `structure` can be used to define such an inductive type as well
     as its projections, at the same time. -/

  namespace hide₃
    structure prod (α β : Type) := mk :: (fst : α) (snd : β)
    /- This simultaneously introduces the inductive type, `prod`, its constructor, `mk`, the
       usual eliminators (`rec` and `rec_on`), as well as the projections, `fst` and `snd`. -/
  end hide₃

    /- If you don't name the constructor, Lean uses `mk` as a default. For example, the
       following defines a record to store a color as a triple of RGB values: -/

  structure color := (red : ℕ) (green : ℕ) (blue : ℕ)
  def yellow := color.mk 255 255 0
  #reduce color.red yellow     -- result: 255  (`color.red` is projection onto first component)
  #reduce color.green yellow   -- result: 255
  #reduce color.blue yellow    -- result: 0

  -- `structure` is especially useful for defining algebraic structures!!!!!!
  -- Lean provides substantial infrastructure to support working with them.

  -- Here's the definition of a semigroup:

  structure Semigroup := (carrier : Type u)
    (mul : carrier → carrier → carrier)
    (mul_assoc : ∀ a b c, mul (mul a b) c = mul a (mul b c))

  -- ==> More examples in CHAPTER 9!!!!!!! <==

  -- Recall, sigma types are also known as the "dependent product" type:

  namespace hide₄
    inductive sigma {α : Type u} (β : α → Type v) | dpair : Π a : α, β a → sigma

    -- Two more inductive types in the library are `option` and `inhabited`.
    inductive option (α : Type u)
    | none {} : option
    | some    : α → option

    inductive inhabited (α : Type u)
    | mk : α → inhabited
  end hide₄

  -- `option` type enables us to define partial functions

  /- In the semantics of dependent type theory, there is no built-in notion of a partial
     function. Every element of a function type `α → β` or a Pi type `Π x : α, β` is assumed
     total. The `option` type enables us to represent partial functions. An element of
     `option β` is either `none` or of the form `some b`, for some value `b : β`. Thus,
     `α → option β` is the type of partial functions from `α` to `β`; if `a : α`, then
     `f a` either returns `none`, indicating the `f` is "undefined" at `a`, or `some b`. -/

  /- An element of `inhabited α` is simply a witness to existence of an element of `α`.
     `inhabited` is actually an example of a **type class** in Lean: Lean can be told that
     suitable base types are inhabited, and can automatically infer that other constructed
     types are inhabited on that basis. -/

  /- As exercises, develop a notion of composition for partial functions from `α` to `β` and
     `β` to `γ`, and show that it behaves as expected. -/

  /- Also, show that `bool` and `nat` are inhabited, that the product of two inhabited types
     is inhabited, and that the type of functions to an inhabited type is inhabited. -/

end Sec_7_2

#print "==========================================="
#print "Section 7.3. Inductively Defined Propositions"
#print " "
-- https://leanprover.github.io/theorem_proving_in_lean/inductive_types.html#inductively-defined-propositions

/- Inductively defined types can live in any type universe, including the bottom-most one,
   `Prop`. In fact, this is exactly how the logical connectives are defined. -/

namespace Sec_7_3
  namespace hide₅
    inductive false : Prop
    inductive true : Prop | intro : true
    inductive and (a b : Prop) : Prop | intro : a → b → and
    inductive or (a b : Prop) : Prop
    | intro_left : a → or
    | intro_right : b → or

    -- Alternatively, we could give names to the inhabitants:
    inductive and_alt (P Q : Prop) : Prop | intro (a : P) (b : Q) : and_alt
    inductive or_alt (P Q : Prop) : Prop
    | intro_left (a : P) : or_alt
    | intro_right (b : Q) : or_alt
  end hide₅

  -- Think about how these give rise to the intro and elim rules we've already seen.

  -- There are rules that govern what the eliminator of an inductive type can eliminate to;
  -- that is, what kinds of types can be the target of a recursor.

  /- Roughly speaking, what characterizes inductive types in Prop is that one can only
     eliminate to other types in Prop. This agrees with the fact that if `p : Prop`, then
     an element `hp : p` carries no info. (There is one exception discussed below.) -/

  -- Even the existential quantifier is inductively defined:

  namespace hide₆
    universe u

    inductive Exists {α : Type u} (p : α → Prop) : Prop
    | intro : ∀(a : α), p a → Exists

    inductive Exists_alt {α : Type u} (p : α → Prop) : Prop
    | intro (w : ∀(a : α), p a) : Exists_alt

    def exists.intro := @Exists.intro
  end hide₆

  -- The notation `∃ x : α, p` is syntactic sugar for `Exists (λ x : α, p)`.

  /- The defs of `false`, `true`, `and`, and `or` are analogous to the defs of
     `empty`, `unit`, `prod`, and `sum`. The difference is the former yield
     elements of `Prop`, and the latter yield elements of `Type u` for some `u`. -/

  -- Similarly, `∃ x : α, p` is a `Prop`-valued variant of `Σ x : α, p`.

  /- Another inductive type, denoted `{x : α | p}`, is sort of a hybrid between
     `∃ x : α, P` and `Σ x : α, P`. It is the `subtype` type. -/

  namespace hide₇
    universe u
    inductive subtype {α : Type u} (p : α → Prop)
    | mk : Π(x : α), p x → subtype

    inductive subtype_alt {α : Type u} (p : α → Prop)
    | mk (w : Π(x : α), p x) : subtype_alt
  end hide₇

 -- This next example is unclear to me.
 namespace confusing_example
   universe u
   variables {α : Type u} (p : α → Prop)
   --  ==========> UNRESOLVED QUESTIONS:     <==========
   #check subtype p        -- why is the result `subtype p : Type u` ??
   #check {x : α // p x }  -- why is the result `{x // p x } : Type u` ??
 end confusing_example
 -- The notation `{x : α // p x}` is syntactic sugar for subtype `(λ x : α, p x)`.

end Sec_7_3

#print "==========================================="
#print "Section 7.4. Defining the Natural Numbers"
#print " "
-- https://leanprover.github.io/theorem_proving_in_lean/inductive_types.html#defining-the-natural-numbers

namespace Sec_7_4
  /- The inductively defined types we have seen so far are "flat": constructors wrap data and
     insert it into a type, and the corresponding recursor unpacks the data and acts on it.
     Things get more interesting when constructors act on elements of the type being defined. -/

  -- A canonical example:
  namespace hide_7_4_1
    inductive nat : Type
    | zero : nat
    | succ : nat → nat

  /- The recursor for `nat` defines a dependent function `f` from `nat` to any domain,
     that is, `nat.rec` defines an element `f` of `Π n : nat, C n` for any `C : nat → Type`.
     It has to handle two cases: the case where the input is zero, and the case where the
     input is of the form succ n for some n : nat.
     First case: we specify a target value of appropriate type.
     Second case: the recursor assumes f(n) has been computed and the recursor uses the
     next input arg to specify a value for f (succ n) in terms of n and f n. -/

    #check @nat.rec_on  -- returns: Π {C : nat → Sort u_1} (n : nat), -- arg 1: major premise
                      --           C nat.zero →                     -- arg 2: minor premise 1
                      -- (Π (a : nat), C a → C (nat.succ a))        -- arg 3: specifies how to
                      --                                                       construct f(n+1)
                      --                                                       given n and f(n)
                      -- → C n                                      -- output type

    namespace nat
      def add (m n : nat) : nat := nat.rec_on n m (λ n add_m_n, succ add_m_n)
      #reduce add (succ zero) (succ (succ zero)) -- result: succ (succ (succ zero))

      -- Can we recurse on m instead of n?  Yes, of course.
      def add' (m n : nat) : nat := nat.rec_on m n (λ m add_m_n, succ add_m_n)
      #reduce add' (succ zero) (succ (succ zero)) -- same result as above

      /- Let's go back to the first definition of `add` and dissect it.
         + First, `nat.rec_on n` says "recurse on n".
         + The next symbol is `m` which indicates what to answer in the base case n=zero.
         + The next group of symbols is `(λ n add_m_n, succ add_m_n)` which gives the answer
           in the inductive case. The first argument to the λ abstraction is `n`, which means
           assume we know the value, `add_m_n`, that should be returned on input `m n`.
           Finally, use this to say what to do when the input is `m (succ n)`; namely,
           return `succ add_m_n`. That's all there is to it! -/

      instance : has_zero nat := has_zero.mk zero
      instance : has_add nat := has_add.mk add

      theorem add_zero (m : nat) : m + 0 = m := rfl
      theorem add_succ (m n : nat) : m + succ n = succ (m + n) := rfl
    end nat

  end   hide_7_4_1

    /- Proving `0 + m = m`, however, requires induction. The induction principle is just a
       special case of the recursion principle when the codomain `C n` is an element of `Prop`.
       It represents the familiar pattern of proof by induction: to prove `∀ n, C n`, first
       prove `C 0`, and then, for arbitrary `n`, assume `ih : C n` and prove `C (succ n)`. -/
  namespace hide_7_4_2
  open nat

  theorem zero_add (n : ℕ) : 0 + n = n := nat.rec_on n
    (show 0 + 0 = 0, from rfl)
    (assume n,
      assume ih : 0 + n = n,
      show 0 + succ n = succ n, from
        calc
          0 + succ n = succ (0 + n) : rfl
            ... = succ n : by rw ih)

  /- N.B. when `nat.rec_on` is used in a proof, it's the induction principle in disguise.
     The `rewrite` and `simp` tactics tend to be effective in proofs like these. -/
  theorem zero_add' (n : ℕ) : 0 + n = n := nat.rec_on n
  rfl (λ n ih, by simp only [add_succ, ih])

  theorem zero_add'' (n : ℕ) : 0 + n = n := nat.rec_on n
  rfl (λ n ih, by simp only [add_succ, ih])
  /- N.B. leaving off the `only` modifier would be misleading because `zero_add` is declared
     in the standard library. Using `only` guarantees `simp` uses only the identities listed.-/

  /- Associativity of addition: ∀ m n k, m + n + k = m + (n + k).
     The hardest part is figuring out which variable to do the induction on.
     Since addition is defined by recursion on the second argument, k is a good guess. -/
  theorem add_assoc (m n k : ℕ) : m + n + k = m + (n + k) := nat.rec_on k
  (show m + n + 0 = m + (n + 0), from rfl)
  (assume k,
    assume ih : m + n + k = m + (n + k),
    show (m + n) + succ k = m + (n + succ k), from
      calc
        (m + n) + succ k = succ ((m + n) + k) : rfl
                     ... = succ (m + (n + k)) : by rw ih
                     ... = m + succ (n + k) : rfl
                     ... = m + (n + succ k) : rfl)

  -- once again, there is a one-line proof
  theorem add_assoc' (m n k : ℕ) : m + n + k = m + (n + k) := nat.rec_on k
  rfl (λ k ih, by simp only [add_succ, ih])

  theorem succ_add (m n : ℕ) : succ m + n = succ (m + n) :=
    nat.rec_on n
    (show succ m + 0 = succ (m + 0), from rfl)
     (assume n,
       assume ih : succ m + n = succ (m + n),
       show succ m + succ n = succ (m + succ n), from
         calc
           succ m + succ n = succ (succ m + n) : rfl
                       ... = succ (succ (m + n)) : by rw ih
                       ... = succ (m + succ n) : rfl)

  -- Commutativity of addition:
  theorem add_comm (m n : ℕ) : m + n = n + m := nat.rec_on n
   (show m + 0 = 0 + m, by rw [nat.zero_add, nat.add_zero])
   (assume n,
     assume ih : m + n = n + m,
     show m + succ n = succ n + m, from
       calc
         m + succ n = succ (m + n) : rfl
                ... = succ (n + m) : by rw ih
                ... = succ n + m : by simp only [succ_add])

  -- Here are the shorter versions of the last two theorems:
  theorem succ_add' (m n : ℕ) : succ m + n = succ (m + n) :=
  nat.rec_on n rfl (λ n ih, by simp only [succ_add, ih])

  theorem add_comm' (m n : ℕ) : m + n = n + m := nat.rec_on n
    (by simp only [zero_add, add_zero])
    (λ n ih, by simp only [add_succ, ih, succ_add])

  end hide_7_4_2

end Sec_7_4

#print "==========================================="
#print "Section 7.5. Other Recursive Data Types"
#print " "
-- https://leanprover.github.io/theorem_proving_in_lean/inductive_types.html#other-recursive-data-types

-- Here are some more examples of inductively defined types.
namespace Sec_7_5
  -- For any type, α, the type list α of lists of elements of α is defined in the library.
  universe u
  inductive my_list (α : Type u)
  | nil {} : my_list
  | cons : α → my_list → my_list

  namespace my_list

  variable {α : Type}

  notation h :: t := cons h t

  def append (s t : my_list α) : my_list α :=
  my_list.rec t (λ (x: α) (l: my_list α) (u: my_list α), x :: u) s
  /- Dissection of append:
     The first arg to `list.rec` is `t`, meaning return `t` when `s` is `null`.
     The second arg is `(λ x l u, x :: u) s`.  I *think* this means the following:
     assuming `u` is the result of `append l t`, then `append (x :: l) t` results
     in `x :: u`.

     ==========> UNRESOLVED QUESTION:  What about `s` ....?   <==========
  -/

  /- To give some support for the claim that the foregoing interpretation is (roughtly)
     correct, let's make the types explicit and verify that the definition still type-checks: -/
  def append' (s t : my_list α) : my_list α :=
  my_list.rec (t: my_list α) (λ (x : α) (l : my_list α) (u: my_list α), x :: u) (s : my_list α)

  #check nil                       -- nil : list ?M_1
  #check (nil : my_list ℕ)           -- nil : list ℕ
  #check cons 0 nil                -- 0 :: nil : list ℕ
  #check cons "a" nil              -- 0 :: nil : list string
  #check cons "a" (cons "b" nil)   -- a :: b :: nil : list string

  notation s ++ t := append s t

  theorem nil_append (t : my_list α) : nil ++ t = t := rfl

  theorem cons_append (x : α) (s t : my_list α) : (x :: s) ++ t = x :: (s ++ t) := rfl

  -- Lean allows us to define iterative notation for lists:

  notation `{` l:(foldr `,` (h t, cons h t) nil) `}` := l

  section
    open nat
    #check {1,2,3,4,5}               -- Lean assumes this is a list of nats
    #check ({1,2,3,4,5} : my_list int)  -- Forces Lean to take this as a list of ints.
  end

  -- As an exercise, prove the following:
  theorem append_nil (t : my_list α) : t ++ nil = t := my_list.rec_on t
    (show (append nil nil) = nil, from rfl)
    (assume (x : α), assume (t : my_list α),
     assume ih : (append t nil) = t,
     show append (x :: t) nil = (x :: t), from
       calc
         append (x :: t) nil = x :: append t nil  : cons_append x t nil
                         ... = x :: t             : by rw ih)

  -- As an exercise, prove the following:
  theorem append_nil' (t : my_list α) : t ++ nil = t := my_list.rec_on t
    rfl  -- (base)
    (λ (x : α) (t : my_list α) (ih : (append t nil) = t), by simp [cons_append, ih]) -- (induct)

  --theorem append_assoc (r s t : my_list α) : r ++ s ++ t = r ++ (s ++ t) := sorry

  -- binary trees
  inductive binary_tree
  | leaf : binary_tree
  | node : binary_tree → binary_tree → binary_tree

  -- countably branching trees
  inductive cbtree
  | leaf : cbtree
  | sup : (ℕ → cbtree) → cbtree

  namespace cbtree

  def succ (t : cbtree) : cbtree := sup (λ n, t)  -- Note: (λ n, t) is a thunk; i.e., a way to
                                                  -- view t as a function of type ℕ → cbtree.

  /- Note the similarity to nat's successor.  The third cbtree after t would be
     `sup (λ n, sup (λ n, sup (λ n, t))` -/

  def omega : cbtree := sup (λ n, nat.rec_on n leaf (λ n t, succ t))
  end cbtree
  end my_list

end Sec_7_5

#print "==========================================="
#print "Section 7.6. Tactics for Inductive Types"
#print " "
-- https://leanprover.github.io/theorem_proving_in_lean/inductive_types.html#tactics-for-inductive-types

namespace Sec_7_6
  /- There are a number of tactics designed to work with inductive types effectively.
     The `cases` tactic works on elements of an inductively defined type by decomposing
     the element into the ways it could be constructed. -/

  namespace example₁
  variable p : ℕ → Prop
  open nat
  example (hz : p 0) (hs : ∀ n, p (succ n)) : ∀ n, p n :=
  begin
    intro n,
    cases n,
      exact hz,
      apply hs
  end

  /- `cases` lets you choose names for arguments to the constructors using `with`.
     For example, we can choose the name `m` for the argument to `succ`, so the second
     case refers to `succ m`. More importantly, `cases` detects items in the local context
     that depend on the target variable. It reverts these elements, does the split, and
     reintroduces them. In the example below, notice that `h : n ≠ 0` becomes `h : 0 ≠ 0`
     in the first branch, and `h : succ m ≠ 0` in the second.-/

  example (n : ℕ) (h : n ≠ 0) : succ (pred n) = n :=
  begin
    cases n with m,  -- name cases using variable m
      -- goal: h : 0 ≠ 0 ⊢ succ (pred 0) = 0
      { apply (absurd rfl h) },
      -- goal: h : succ m ≠ 0 ⊢ succ (pred (succ m)) = succ m
      reflexivity
  end

  -- `cases` can be also be used to produce data and define functions.
  def f (n : ℕ) : ℕ :=
  begin cases n, exact 3, exact 7 end

  example : f 0 = 3 := rfl
  example : f 5 = 7 := rfl
  example : f 1000 = 7 := rfl
  -- in fact, we can prove that f n is constantly 7, except when n = 0.
  example  (n : ℕ) (h : n ≠ 0) : (f n) = 7 := begin
    cases n,
    { apply (absurd rfl h) },  -- goal: 0 ≠ 0 ⊢ f 0 = 7
    reflexivity                -- goal: (succ a ≠ 0) ⊢ f (succ a) = 7
  end
  end example₁
  -- Let's define a function that takes an single argument of type `tuple`.

  -- First define the type `tuple`.

  namespace functionals
  universe u
  open list

  -- Recall, we define a type that satisfies a predicate like this:

  def tuple (α : Type u) (n : ℕ) := subtype (λ (l : list α), (list.length l = n))
    -- { l : list α // list.length l = n }  -- (this didn't work for me)

  variables {α : Type u} {n : ℕ}

  def f {n : ℕ} (t : tuple α n) : ℕ := begin cases n, exact 3, exact 7 end

  def my_tuple : tuple ℕ 3 := ⟨[0, 1, 2], rfl⟩

  example : f my_tuple = 7 := rfl

  -- As above, we prove that f t is constantly 7, except when t.length=0.
  example  (n : ℕ) (t : tuple α n) (h : n ≠ 0) : f t = 7 :=
  begin
    cases n,
    apply (absurd rfl h),  -- goal: 0 ≠ 0 ⊢ f 0 = 7
    reflexivity            -- goal: (a : ℕ) (succ a ≠ 0) (t : tuple α (succ a)) ⊢ f t = 7
  end

  end functionals

  namespace induction_tactic

  /- Just as `cases` is used to carry out proof by cases, the `induction` tactic is used
     for proofs by induction. In contrast to `cases`, the argument to `induction` can only
     come from the local context. -/

  open nat
  theorem zero_add (n : ℕ) : 0 + n = n :=
  begin
    induction n with n ih,
      refl,
      rw [add_succ, ih]
  end

  -- The `case` tactic identifies each case with named arguments, making the proof clearer:
  theorem zero_add' (n : ℕ) : 0 + n = n :=
  begin
    induction n,
    case zero { refl },
    case succ n ih { rw [add_succ, ih] }
  end

  theorem succ_add' (m n : ℕ) : (succ m) + n = succ (m + n) :=
  begin
    induction n,
    case zero { refl },
    case succ n ih { rw [add_succ, ih] }
  end

  theorem add_comm' (m n : ℕ) : m + n = n + m :=
  begin
    induction n,
    case zero { rw zero_add, refl },
    case succ n ih { rw [add_succ, ih, succ_add] }
  end

  -- Here are terse versions of the last three proofs.
  theorem zero_add'' (n : ℕ) : 0 + n = n := by induction n; simp only [*, add_zero, add_succ]

  theorem succ_add'' (m n : ℕ) : (succ m) + n = succ (m+n) :=
  by induction n; simp only [*, add_zero, add_succ]

  theorem add_comm'' (m n : ℕ) : m + n = n + m :=
  by induction n; simp only [*, zero_add, add_zero, add_succ, succ_add]

  theorem add_assoc'' (m n k : ℕ) : m + n + k = m + (n + k) :=
  by induction k; simp only [*, add_zero, add_succ]

  end induction_tactic

  namespace injection_tactic
  /-We close this section with one last tactic that is designed to facilitate working with
    inductive types, namely, the injection tactic. By design, the elements of an inductive
    type are freely generated, which is to say, the constructors are injective and have
    disjoint ranges. The injection tactic is designed to make use of this fact:  -/
  end injection_tactic

end Sec_7_6

#print "==========================================="
#print "Section 7.7. Inductive Families"
#print " "

namespace Sec_7_7

end Sec_7_7

#print "==========================================="
#print "Section 7.8. Axiomatic Details"
#print " "

namespace Sec_7_8

end Sec_7_8

#print "==========================================="
#print "Section 7.9. Mutual and Nested Inductive Types"
#print " "

namespace Sec_7_9

end Sec_7_9

#print "==========================================="
#print "Section 7.10. Exercises"
#print " "

namespace Sec_7_10

end Sec_7_10


/-
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, Julian Kuelshammer
-/
import algebra.hom.iterate
import data.nat.modeq
import data.set.pointwise
import dynamics.periodic_pts
import group_theory.quotient_group

/-!
# Order of an element

This file defines the order of an element of a finite group. For a finite group `G` the order of
`x ∈ G` is the minimal `n ≥ 1` such that `x ^ n = 1`.

## Main definitions

* `is_of_fin_order` is a predicate on an element `x` of a monoid `G` saying that `x` is of finite
  order.
* `is_of_fin_add_order` is the additive analogue of `is_of_fin_order`.
* `order_of x` defines the order of an element `x` of a monoid `G`, by convention its value is `0`
  if `x` has infinite order.
* `add_order_of` is the additive analogue of `order_of`.

## Tags
order of an element
-/

open function nat
open_locale pointwise

universes u v

variables {G : Type u} {A : Type v}
variables {x y : G} {a b : A} {n m : ℕ}

section monoid_add_monoid

variables [monoid G] [add_monoid A]

section is_of_fin_order

@[to_additive]
lemma is_periodic_pt_mul_iff_pow_eq_one (x : G) : is_periodic_pt ((*) x) n 1 ↔ x ^ n = 1 :=
by rw [is_periodic_pt, is_fixed_pt, mul_left_iterate, mul_one]

/-- `is_of_fin_add_order` is a predicate on an element `a` of an additive monoid to be of finite
order, i.e. there exists `n ≥ 1` such that `n • a = 0`.-/
def is_of_fin_add_order (a : A) : Prop :=
(0 : A) ∈ periodic_pts ((+) a)

/-- `is_of_fin_order` is a predicate on an element `x` of a monoid to be of finite order, i.e. there
exists `n ≥ 1` such that `x ^ n = 1`.-/
@[to_additive is_of_fin_add_order]
def is_of_fin_order (x : G) : Prop :=
(1 : G) ∈ periodic_pts ((*) x)

lemma is_of_fin_add_order_of_mul_iff :
  is_of_fin_add_order (additive.of_mul x) ↔ is_of_fin_order x := iff.rfl

lemma is_of_fin_order_of_add_iff :
  is_of_fin_order (multiplicative.of_add a) ↔ is_of_fin_add_order a := iff.rfl

@[to_additive is_of_fin_add_order_iff_nsmul_eq_zero]
lemma is_of_fin_order_iff_pow_eq_one (x : G) :
  is_of_fin_order x ↔ ∃ n, 0 < n ∧ x ^ n = 1 :=
by { convert iff.rfl, simp [is_periodic_pt_mul_iff_pow_eq_one] }

/-- Elements of finite order are of finite order in subgroups.-/
@[to_additive is_of_fin_add_order_iff_coe]
lemma is_of_fin_order_iff_coe {G : Type u} [group G] (H : subgroup G) (x : H) :
  is_of_fin_order x ↔ is_of_fin_order (x : G) :=
by { rw [is_of_fin_order_iff_pow_eq_one, is_of_fin_order_iff_pow_eq_one], norm_cast }

/-- Elements of finite order are of finite order in quotient groups.-/
@[to_additive is_of_fin_add_order_iff_quotient]
lemma is_of_fin_order.quotient {G : Type u} [group G] (N : subgroup G) [N.normal] (x : G) :
  is_of_fin_order x → is_of_fin_order (x : G ⧸ N) := begin
  rw [is_of_fin_order_iff_pow_eq_one, is_of_fin_order_iff_pow_eq_one],
  rintros ⟨n, ⟨npos, hn⟩⟩,
  exact ⟨n, ⟨npos, (quotient_group.con N).eq.mpr $ hn ▸ (quotient_group.con N).eq.mp rfl⟩⟩,
end

/-- 1 is of finite order in any group. -/
@[to_additive "0 is of finite order in any additive group."]
lemma is_of_fin_order_one : is_of_fin_order (1 : G) :=
(is_of_fin_order_iff_pow_eq_one 1).mpr ⟨1, _root_.one_pos, one_pow 1⟩

end is_of_fin_order

/-- `order_of x` is the order of the element `x`, i.e. the `n ≥ 1`, s.t. `x ^ n = 1` if it exists.
Otherwise, i.e. if `x` is of infinite order, then `order_of x` is `0` by convention.-/
@[to_additive add_order_of
"`add_order_of a` is the order of the element `a`, i.e. the `n ≥ 1`, s.t. `n • a = 0` if it
exists. Otherwise, i.e. if `a` is of infinite order, then `add_order_of a` is `0` by convention."]
noncomputable def order_of (x : G) : ℕ :=
minimal_period ((*) x) 1

@[simp] lemma add_order_of_of_mul_eq_order_of (x : G) :
  add_order_of (additive.of_mul x) = order_of x := rfl

@[simp] lemma order_of_of_add_eq_add_order_of (a : A) :
  order_of (multiplicative.of_add a) = add_order_of a := rfl

@[to_additive add_order_of_pos']
lemma order_of_pos' (h : is_of_fin_order x) : 0 < order_of x :=
minimal_period_pos_of_mem_periodic_pts h

@[to_additive add_order_of_nsmul_eq_zero]
lemma pow_order_of_eq_one (x : G) : x ^ order_of x = 1 :=
begin
  convert is_periodic_pt_minimal_period ((*) x) _,
  rw [order_of, mul_left_iterate, mul_one],
end

@[to_additive add_order_of_eq_zero]
lemma order_of_eq_zero (h : ¬ is_of_fin_order x) : order_of x = 0 :=
by rwa [order_of, minimal_period, dif_neg]

@[to_additive add_order_of_eq_zero_iff] lemma order_of_eq_zero_iff :
  order_of x = 0 ↔ ¬ is_of_fin_order x :=
⟨λ h H, (order_of_pos' H).ne' h, order_of_eq_zero⟩

@[to_additive add_order_of_eq_zero_iff'] lemma order_of_eq_zero_iff' :
  order_of x = 0 ↔ ∀ n : ℕ, 0 < n → x ^ n ≠ 1 :=
by simp_rw [order_of_eq_zero_iff, is_of_fin_order_iff_pow_eq_one, not_exists, not_and]

/-- A group element has finite order iff its order is positive. -/
@[to_additive add_order_of_pos_iff
  "A group element has finite additive order iff its order is positive."]
lemma order_of_pos_iff : 0 < order_of x ↔ is_of_fin_order x :=
by rwa [iff_not_comm.mp order_of_eq_zero_iff, pos_iff_ne_zero]

@[to_additive nsmul_ne_zero_of_lt_add_order_of']
lemma pow_ne_one_of_lt_order_of' (n0 : n ≠ 0) (h : n < order_of x) : x ^ n ≠ 1 :=
λ j, not_is_periodic_pt_of_pos_of_lt_minimal_period n0 h
  ((is_periodic_pt_mul_iff_pow_eq_one x).mpr j)

@[to_additive add_order_of_le_of_nsmul_eq_zero]
lemma order_of_le_of_pow_eq_one (hn : 0 < n) (h : x ^ n = 1) : order_of x ≤ n :=
is_periodic_pt.minimal_period_le hn (by rwa is_periodic_pt_mul_iff_pow_eq_one)

@[simp, to_additive] lemma order_of_one : order_of (1 : G) = 1 :=
by rw [order_of, one_mul_eq_id, minimal_period_id]

@[simp, to_additive add_monoid.order_of_eq_one_iff] lemma order_of_eq_one_iff :
  order_of x = 1 ↔ x = 1 :=
by rw [order_of, is_fixed_point_iff_minimal_period_eq_one, is_fixed_pt, mul_one]

@[to_additive nsmul_eq_mod_add_order_of]
lemma pow_eq_mod_order_of {n : ℕ} : x ^ n = x ^ (n % order_of x) :=
calc x ^ n = x ^ (n % order_of x + order_of x * (n / order_of x)) : by rw [nat.mod_add_div]
       ... = x ^ (n % order_of x) : by simp [pow_add, pow_mul, pow_order_of_eq_one]

@[to_additive add_order_of_dvd_of_nsmul_eq_zero]
lemma order_of_dvd_of_pow_eq_one (h : x ^ n = 1) : order_of x ∣ n :=
is_periodic_pt.minimal_period_dvd ((is_periodic_pt_mul_iff_pow_eq_one _).mpr h)

@[to_additive add_order_of_dvd_iff_nsmul_eq_zero]
lemma order_of_dvd_iff_pow_eq_one {n : ℕ} : order_of x ∣ n ↔ x ^ n = 1 :=
⟨λ h, by rw [pow_eq_mod_order_of, nat.mod_eq_zero_of_dvd h, pow_zero], order_of_dvd_of_pow_eq_one⟩

@[to_additive add_order_of_map_dvd]
lemma order_of_map_dvd {H : Type*} [monoid H] (ψ : G →* H) (x : G) :
  order_of (ψ x) ∣ order_of x :=
by { apply order_of_dvd_of_pow_eq_one, rw [←map_pow, pow_order_of_eq_one], apply map_one }

@[to_additive]
lemma exists_pow_eq_self_of_coprime (h : n.coprime (order_of x)) :
  ∃ m : ℕ, (x ^ n) ^ m = x :=
begin
  by_cases h0 : order_of x = 0,
  { rw [h0, coprime_zero_right] at h,
    exact ⟨1, by rw [h, pow_one, pow_one]⟩ },
  by_cases h1 : order_of x = 1,
  { exact ⟨0, by rw [order_of_eq_one_iff.mp h1, one_pow, one_pow]⟩ },
  obtain ⟨m, hm⟩ :=
    exists_mul_mod_eq_one_of_coprime h (one_lt_iff_ne_zero_and_ne_one.mpr ⟨h0, h1⟩),
  exact ⟨m, by rw [←pow_mul, pow_eq_mod_order_of, hm, pow_one]⟩,
end

/--
If `x^n = 1`, but `x^(n/p) ≠ 1` for all prime factors `p` of `r`,
then `x` has order `n` in `G`.
-/
@[to_additive add_order_of_eq_of_nsmul_and_div_prime_nsmul]
theorem order_of_eq_of_pow_and_pow_div_prime (hn : 0 < n) (hx : x^n = 1)
  (hd : ∀ p : ℕ, p.prime → p ∣ n → x^(n/p) ≠ 1) :
  order_of x = n :=
begin
  -- Let `a` be `n/(order_of x)`, and show `a = 1`
  cases exists_eq_mul_right_of_dvd (order_of_dvd_of_pow_eq_one hx) with a ha,
  suffices : a = 1, by simp [this, ha],
  -- Assume `a` is not one...
  by_contra,
  have a_min_fac_dvd_p_sub_one : a.min_fac ∣ n,
  { obtain ⟨b, hb⟩ : ∃ (b : ℕ), a = b * a.min_fac := exists_eq_mul_left_of_dvd a.min_fac_dvd,
    rw [hb, ←mul_assoc] at ha,
    exact dvd.intro_left (order_of x * b) ha.symm, },
  -- Use the minimum prime factor of `a` as `p`.
  refine hd a.min_fac (nat.min_fac_prime h) a_min_fac_dvd_p_sub_one _,
  rw [←order_of_dvd_iff_pow_eq_one, nat.dvd_div_iff (a_min_fac_dvd_p_sub_one),
      ha, mul_comm, nat.mul_dvd_mul_iff_left (order_of_pos' _)],
  { exact nat.min_fac_dvd a, },
  { rw is_of_fin_order_iff_pow_eq_one,
    exact Exists.intro n (id ⟨hn, hx⟩) },
end

@[to_additive add_order_of_eq_add_order_of_iff]
lemma order_of_eq_order_of_iff {H : Type*} [monoid H] {y : H} :
  order_of x = order_of y ↔ ∀ n : ℕ, x ^ n = 1 ↔ y ^ n = 1 :=
by simp_rw [← is_periodic_pt_mul_iff_pow_eq_one, ← minimal_period_eq_minimal_period_iff, order_of]

@[to_additive add_order_of_injective]
lemma order_of_injective {H : Type*} [monoid H] (f : G →* H)
  (hf : function.injective f) (x : G) : order_of (f x) = order_of x :=
by simp_rw [order_of_eq_order_of_iff, ←f.map_pow, ←f.map_one, hf.eq_iff, iff_self, forall_const]

@[simp, norm_cast, to_additive] lemma order_of_submonoid {H : submonoid G}
  (y : H) : order_of (y : G) = order_of y :=
order_of_injective H.subtype subtype.coe_injective y

@[to_additive]
lemma order_of_units {y : Gˣ} : order_of (y : G) = order_of y :=
order_of_injective (units.coe_hom G) units.ext y

variables (x)

@[to_additive add_order_of_nsmul']
lemma order_of_pow' (h : n ≠ 0) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n :=
begin
  convert minimal_period_iterate_eq_div_gcd h,
  simp only [order_of, mul_left_iterate],
end

variables (a) (n)

@[to_additive add_order_of_nsmul'']
lemma order_of_pow'' (h : is_of_fin_order x) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n :=
begin
  convert minimal_period_iterate_eq_div_gcd' h,
  simp only [order_of, mul_left_iterate],
end

@[to_additive]
lemma commute.order_of_mul_dvd_lcm {x y : G} (h : commute x y) :
  order_of (x * y) ∣ nat.lcm (order_of x) (order_of y) :=
begin
  convert function.commute.minimal_period_of_comp_dvd_lcm h.function_commute_mul_left,
  rw [order_of, comp_mul_left],
end

@[to_additive add_order_of_add_dvd_mul_add_order_of]
lemma commute.order_of_mul_dvd_mul_order_of {x y : G} (h : commute x y) :
  order_of (x * y) ∣ (order_of x) * (order_of y) :=
dvd_trans h.order_of_mul_dvd_lcm (lcm_dvd_mul _ _)

@[to_additive add_order_of_add_eq_mul_add_order_of_of_coprime]
lemma commute.order_of_mul_eq_mul_order_of_of_coprime {x y : G} (h : commute x y)
  (hco : nat.coprime (order_of x) (order_of y)) :
  order_of (x * y) = (order_of x) * (order_of y) :=
begin
  convert h.function_commute_mul_left.minimal_period_of_comp_eq_mul_of_coprime hco,
  simp only [order_of, comp_mul_left],
end

/-- Commuting elements of finite order are closed under multiplication. -/
@[to_additive "Commuting elements of finite additive order are closed under addition."]
lemma commute.is_of_fin_order_mul
  {x} (h : commute x y) (hx : is_of_fin_order x) (hy : is_of_fin_order y) :
  is_of_fin_order (x * y) :=
order_of_pos_iff.mp $
  pos_of_dvd_of_pos h.order_of_mul_dvd_mul_order_of $ mul_pos (order_of_pos' hx) (order_of_pos' hy)

section p_prime

variables {a x n} {p : ℕ} [hp : fact p.prime]
include hp

@[to_additive add_order_of_eq_prime]
lemma order_of_eq_prime (hg : x ^ p = 1) (hg1 : x ≠ 1) : order_of x = p :=
minimal_period_eq_prime ((is_periodic_pt_mul_iff_pow_eq_one _).mpr hg)
  (by rwa [is_fixed_pt, mul_one])

@[to_additive add_order_of_eq_prime_pow]
lemma order_of_eq_prime_pow (hnot : ¬ x ^ p ^ n = 1) (hfin : x ^ p ^ (n + 1) = 1) :
  order_of x = p ^ (n + 1) :=
begin
  apply minimal_period_eq_prime_pow;
  rwa is_periodic_pt_mul_iff_pow_eq_one,
end

omit hp
-- An example on how to determine the order of an element of a finite group.
example : order_of (-1 : ℤˣ) = 2 :=
order_of_eq_prime (int.units_sq _) dec_trivial

end p_prime

end monoid_add_monoid

section cancel_monoid
variables [left_cancel_monoid G] (x y)

@[to_additive]
lemma pow_injective_aux (h : n ≤ m)
  (hm : m < order_of x) (eq : x ^ n = x ^ m) : n = m :=
by_contradiction $ assume ne : n ≠ m,
  have h₁ : m - n > 0, from nat.pos_of_ne_zero (by simp [tsub_eq_iff_eq_add_of_le h, ne.symm]),
  have h₂ : m = n + (m - n) := (add_tsub_cancel_of_le h).symm,
  have h₃ : x ^ (m - n) = 1,
    by { rw [h₂, pow_add] at eq, apply mul_left_cancel, convert eq.symm, exact mul_one (x ^ n) },
  have le : order_of x ≤ m - n, from order_of_le_of_pow_eq_one h₁ h₃,
  have lt : m - n < order_of x,
    from (tsub_lt_iff_left h).mpr $ nat.lt_add_left _ _ _ hm,
  lt_irrefl _ (le.trans_lt lt)

@[to_additive nsmul_injective_of_lt_add_order_of]
lemma pow_injective_of_lt_order_of
  (hn : n < order_of x) (hm : m < order_of x) (eq : x ^ n = x ^ m) : n = m :=
(le_total n m).elim
  (assume h, pow_injective_aux x h hm eq)
  (assume h, (pow_injective_aux x h hn eq.symm).symm)

@[to_additive mem_multiples_iff_mem_range_add_order_of']
lemma mem_powers_iff_mem_range_order_of' [decidable_eq G] (hx : 0 < order_of x) :
  y ∈ submonoid.powers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
finset.mem_range_iff_mem_finset_range_of_mod_eq' hx (λ i, pow_eq_mod_order_of.symm)

lemma pow_eq_one_iff_modeq : x ^ n = 1 ↔ n ≡ 0 [MOD (order_of x)] :=
by rw [modeq_zero_iff_dvd, order_of_dvd_iff_pow_eq_one]

lemma pow_eq_pow_iff_modeq : x ^ n = x ^ m ↔ n ≡ m [MOD (order_of x)] :=
begin
  wlog hmn : m ≤ n,
  obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le hmn,
  rw [← mul_one (x ^ m), pow_add, mul_left_cancel_iff, pow_eq_one_iff_modeq],
  exact ⟨λ h, nat.modeq.add_left _ h, λ h, nat.modeq.add_left_cancel' _ h⟩,
end

end cancel_monoid

section group
variables [group G] [add_group A] {x a} {i : ℤ}

/-- Inverses of elements of finite order have finite order. -/
@[to_additive "Inverses of elements of finite additive order have finite additive order."]
lemma is_of_fin_order.inv {x : G} (hx : is_of_fin_order x) : is_of_fin_order x⁻¹ :=
(is_of_fin_order_iff_pow_eq_one _).mpr $ begin
  rcases (is_of_fin_order_iff_pow_eq_one x).mp hx with ⟨n, npos, hn⟩,
  refine ⟨n, npos, by simp_rw [inv_pow, hn, one_inv]⟩,
end

/-- Inverses of elements of finite order have finite order. -/
@[simp, to_additive "Inverses of elements of finite additive order have finite additive order."]
lemma is_of_fin_order_inv_iff {x : G} : is_of_fin_order x⁻¹ ↔ is_of_fin_order x :=
⟨λ h, inv_inv x ▸ h.inv, is_of_fin_order.inv⟩

@[to_additive add_order_of_dvd_iff_zsmul_eq_zero]
lemma order_of_dvd_iff_zpow_eq_one : (order_of x : ℤ) ∣ i ↔ x ^ i = 1 :=
begin
  rcases int.eq_coe_or_neg i with ⟨i, rfl|rfl⟩,
  { rw [int.coe_nat_dvd, order_of_dvd_iff_pow_eq_one, zpow_coe_nat] },
  { rw [dvd_neg, int.coe_nat_dvd, zpow_neg, inv_eq_one, zpow_coe_nat,
      order_of_dvd_iff_pow_eq_one] }
end

@[simp, to_additive]
lemma order_of_inv (x : G) : order_of x⁻¹ = order_of x :=
by simp [order_of_eq_order_of_iff]

@[simp, norm_cast, to_additive] lemma order_of_subgroup {H : subgroup G}
  (y: H) : order_of (y : G) = order_of y :=
order_of_injective H.subtype subtype.coe_injective y

@[to_additive zsmul_eq_mod_add_order_of]
lemma zpow_eq_mod_order_of : x ^ i = x ^ (i % order_of x) :=
calc x ^ i = x ^ (i % order_of x + order_of x * (i / order_of x)) :
    by rw [int.mod_add_div]
       ... = x ^ (i % order_of x) :
    by simp [zpow_add, zpow_mul, pow_order_of_eq_one]
    set_option pp.all true

@[to_additive nsmul_inj_iff_of_add_order_of_eq_zero]
lemma pow_inj_iff_of_order_of_eq_zero (h : order_of x = 0) {n m : ℕ} :
  x ^ n = x ^ m ↔ n = m :=
begin
  rw [order_of_eq_zero_iff, is_of_fin_order_iff_pow_eq_one] at h,
  push_neg at h,
  induction n with n IH generalizing m,
  { cases m,
    { simp },
    { simpa [eq_comm] using h m.succ m.zero_lt_succ } },
  { cases m,
    { simpa using h n.succ n.zero_lt_succ },
    { simp [pow_succ, IH] } }
end

@[to_additive]
lemma pow_inj_mod {n m : ℕ} :
  x ^ n = x ^ m ↔ n % order_of x = m % order_of x :=
begin
  cases (order_of x).zero_le.eq_or_lt with hx hx,
  { simp [pow_inj_iff_of_order_of_eq_zero, hx.symm] },
  rw [pow_eq_mod_order_of, @pow_eq_mod_order_of _ _ _ m],
  exact ⟨pow_injective_of_lt_order_of _ (nat.mod_lt _ hx) (nat.mod_lt _ hx), λ h, congr_arg _ h⟩
end

end group

section comm_monoid

variables [comm_monoid G]

/-- Elements of finite order are closed under multiplication. -/
@[to_additive "Elements of finite additive order are closed under addition."]
lemma is_of_fin_order.mul (hx : is_of_fin_order x) (hy : is_of_fin_order y) :
  is_of_fin_order (x * y) :=
(commute.all x y).is_of_fin_order_mul hx hy

end comm_monoid

section fintype
variables [fintype G] [fintype A]

section finite_monoid
variables [monoid G] [add_monoid A]
open_locale big_operators

@[to_additive sum_card_add_order_of_eq_card_nsmul_eq_zero]
lemma sum_card_order_of_eq_card_pow_eq_one [decidable_eq G] (hn : 0 < n) :
  ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
  = (finset.univ.filter (λ x : G, x ^ n = 1)).card :=
calc ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
    = _ : (finset.card_bUnion (by { intros, apply finset.disjoint_filter.2, cc })).symm
... = _ : congr_arg finset.card (finset.ext (begin
  assume x,
  suffices : order_of x ≤ n ∧ order_of x ∣ n ↔ x ^ n = 1,
  { simpa [nat.lt_succ_iff], },
  exact ⟨λ h, let ⟨m, hm⟩ := h.2 in by rw [hm, pow_mul, pow_order_of_eq_one, one_pow],
    λ h, ⟨order_of_le_of_pow_eq_one hn h, order_of_dvd_of_pow_eq_one h⟩⟩
end))

end finite_monoid

section finite_cancel_monoid
-- TODO: Of course everything also works for right_cancel_monoids.
variables [left_cancel_monoid G] [add_left_cancel_monoid A]

-- TODO: Use this to show that a finite left cancellative monoid is a group.
@[to_additive]
lemma exists_pow_eq_one (x : G) : is_of_fin_order x :=
begin
  refine (is_of_fin_order_iff_pow_eq_one _).mpr _,
  obtain ⟨i, j, a_eq, ne⟩ : ∃(i j : ℕ), x ^ i = x ^ j ∧ i ≠ j :=
    by simpa only [not_forall, exists_prop, injective]
      using (not_injective_infinite_fintype (λi:ℕ, x^i)),
  wlog h'' : j ≤ i,
  refine ⟨i - j, tsub_pos_of_lt (lt_of_le_of_ne h'' ne.symm), mul_right_injective (x^j) _⟩,
  rw [mul_one, ← pow_add, ← a_eq, add_tsub_cancel_of_le h''],
end

@[to_additive add_order_of_le_card_univ]
lemma order_of_le_card_univ : order_of x ≤ fintype.card G :=
finset.le_card_of_inj_on_range ((^) x)
  (assume n _, finset.mem_univ _)
  (assume i hi j hj, pow_injective_of_lt_order_of x hi hj)

/-- This is the same as `order_of_pos' but with one fewer explicit assumption since this is
  automatic in case of a finite cancellative monoid.-/
@[to_additive add_order_of_pos
"This is the same as `add_order_of_pos' but with one fewer explicit assumption since this is
  automatic in case of a finite cancellative additive monoid."]
lemma order_of_pos (x : G) : 0 < order_of x := order_of_pos' (exists_pow_eq_one x)

open nat

/-- This is the same as `order_of_pow'` and `order_of_pow''` but with one assumption less which is
automatic in the case of a finite cancellative monoid.-/
@[to_additive add_order_of_nsmul
"This is the same as `add_order_of_nsmul'` and `add_order_of_nsmul` but with one assumption less
which is automatic in the case of a finite cancellative additive monoid."]
lemma order_of_pow (x : G) :
  order_of (x ^ n) = order_of x / gcd (order_of x) n := order_of_pow'' _ _ (exists_pow_eq_one _)

@[to_additive mem_multiples_iff_mem_range_add_order_of]
lemma mem_powers_iff_mem_range_order_of [decidable_eq G] :
  y ∈ submonoid.powers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
finset.mem_range_iff_mem_finset_range_of_mod_eq' (order_of_pos x)
  (assume i, pow_eq_mod_order_of.symm)

@[to_additive decidable_multiples]
noncomputable instance decidable_powers [decidable_eq G] :
  decidable_pred (∈ submonoid.powers x) :=
begin
  assume y,
  apply decidable_of_iff'
    (y ∈ (finset.range (order_of x)).image ((^) x)),
  exact mem_powers_iff_mem_range_order_of
end

/--The equivalence between `fin (order_of x)` and `submonoid.powers x`, sending `i` to `x ^ i`."-/
@[to_additive fin_equiv_multiples "The equivalence between `fin (add_order_of a)` and
`add_submonoid.multiples a`, sending `i` to `i • a`."]
noncomputable def fin_equiv_powers (x : G) :
  fin (order_of x) ≃ (submonoid.powers x : set G) :=
equiv.of_bijective (λ n, ⟨x ^ ↑n, ⟨n, rfl⟩⟩) ⟨λ ⟨i, hi⟩ ⟨j, hj⟩ ij,
  subtype.mk_eq_mk.2 (pow_injective_of_lt_order_of x hi hj (subtype.mk_eq_mk.1 ij)),
  λ ⟨_, i, rfl⟩, ⟨⟨i % order_of x, mod_lt i (order_of_pos x)⟩, subtype.eq pow_eq_mod_order_of.symm⟩⟩

@[simp, to_additive fin_equiv_multiples_apply]
lemma fin_equiv_powers_apply {x : G} {n : fin (order_of x)} :
  fin_equiv_powers x n = ⟨x ^ ↑n, n, rfl⟩ := rfl

@[simp, to_additive fin_equiv_multiples_symm_apply]
lemma fin_equiv_powers_symm_apply (x : G) (n : ℕ)
  {hn : ∃ (m : ℕ), x ^ m = x ^ n} :
  ((fin_equiv_powers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
by rw [equiv.symm_apply_eq, fin_equiv_powers_apply, subtype.mk_eq_mk,
  pow_eq_mod_order_of, fin.coe_mk]

/-- The equivalence between `submonoid.powers` of two elements `x, y` of the same order, mapping
  `x ^ i` to `y ^ i`. -/
@[to_additive multiples_equiv_multiples
"The equivalence between `submonoid.multiples` of two elements `a, b` of the same additive order,
  mapping `i • a` to `i • b`."]
noncomputable def powers_equiv_powers (h : order_of x = order_of y) :
  (submonoid.powers x : set G) ≃ (submonoid.powers y : set G) :=
(fin_equiv_powers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_powers y))

@[simp, to_additive multiples_equiv_multiples_apply]
lemma powers_equiv_powers_apply (h : order_of x = order_of y)
  (n : ℕ) : powers_equiv_powers h ⟨x ^ n, n, rfl⟩ = ⟨y ^ n, n, rfl⟩ :=
begin
  rw [powers_equiv_powers, equiv.trans_apply, equiv.trans_apply,
    fin_equiv_powers_symm_apply, ← equiv.eq_symm_apply, fin_equiv_powers_symm_apply],
  simp [h]
end

@[to_additive add_order_of_eq_card_multiples]
lemma order_eq_card_powers [decidable_eq G] :
  order_of x = fintype.card (submonoid.powers x : set G) :=
(fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_powers x⟩)

end finite_cancel_monoid

section finite_group
variables [group G] [add_group A]

@[to_additive]
lemma exists_zpow_eq_one (x : G) : ∃ (i : ℤ) (H : i ≠ 0), x ^ (i : ℤ) = 1 :=
begin
  rcases exists_pow_eq_one x with ⟨w, hw1, hw2⟩,
  refine ⟨w, int.coe_nat_ne_zero.mpr (ne_of_gt hw1), _⟩,
  rw zpow_coe_nat,
  exact (is_periodic_pt_mul_iff_pow_eq_one _).mp hw2,
end

open subgroup

@[to_additive mem_multiples_iff_mem_zmultiples]
lemma mem_powers_iff_mem_zpowers : y ∈ submonoid.powers x ↔ y ∈ zpowers x :=
⟨λ ⟨n, hn⟩, ⟨n, by simp * at *⟩,
λ ⟨i, hi⟩, ⟨(i % order_of x).nat_abs,
  by rwa [← zpow_coe_nat, int.nat_abs_of_nonneg (int.mod_nonneg _
    (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos x))),
    ← zpow_eq_mod_order_of]⟩⟩

@[to_additive multiples_eq_zmultiples]
lemma powers_eq_zpowers (x : G) : (submonoid.powers x : set G) = zpowers x :=
set.ext $ λ x, mem_powers_iff_mem_zpowers

@[to_additive mem_zmultiples_iff_mem_range_add_order_of]
lemma mem_zpowers_iff_mem_range_order_of [decidable_eq G] :
  y ∈ subgroup.zpowers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
by rw [← mem_powers_iff_mem_zpowers, mem_powers_iff_mem_range_order_of]

@[to_additive decidable_zmultiples]
noncomputable instance decidable_zpowers [decidable_eq G] :
  decidable_pred (∈ subgroup.zpowers x) :=
begin
  simp_rw ←set_like.mem_coe,
  rw ← powers_eq_zpowers,
  exact decidable_powers,
end

/-- The equivalence between `fin (order_of x)` and `subgroup.zpowers x`, sending `i` to `x ^ i`. -/
@[to_additive fin_equiv_zmultiples
"The equivalence between `fin (add_order_of a)` and `subgroup.zmultiples a`, sending `i`
to `i • a`."]
noncomputable def fin_equiv_zpowers (x : G) :
  fin (order_of x) ≃ (subgroup.zpowers x : set G) :=
(fin_equiv_powers x).trans (equiv.set.of_eq (powers_eq_zpowers x))

@[simp, to_additive fin_equiv_zmultiples_apply]
lemma fin_equiv_zpowers_apply {n : fin (order_of x)} :
  fin_equiv_zpowers x n = ⟨x ^ (n : ℕ), n, zpow_coe_nat x n⟩ := rfl

@[simp, to_additive fin_equiv_zmultiples_symm_apply]
lemma fin_equiv_zpowers_symm_apply (x : G) (n : ℕ)
  {hn : ∃ (m : ℤ), x ^ m = x ^ n} :
  ((fin_equiv_zpowers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
by { rw [fin_equiv_zpowers, equiv.symm_trans_apply, equiv.set.of_eq_symm_apply],
  exact fin_equiv_powers_symm_apply x n }

/-- The equivalence between `subgroup.zpowers` of two elements `x, y` of the same order, mapping
  `x ^ i` to `y ^ i`. -/
@[to_additive zmultiples_equiv_zmultiples
"The equivalence between `subgroup.zmultiples` of two elements `a, b` of the same additive order,
  mapping `i • a` to `i • b`."]
noncomputable def zpowers_equiv_zpowers (h : order_of x = order_of y) :
  (subgroup.zpowers x : set G) ≃ (subgroup.zpowers y : set G) :=
(fin_equiv_zpowers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_zpowers y))

@[simp, to_additive zmultiples_equiv_zmultiples_apply]
lemma zpowers_equiv_zpowers_apply (h : order_of x = order_of y)
  (n : ℕ) : zpowers_equiv_zpowers h ⟨x ^ n, n, zpow_coe_nat x n⟩ = ⟨y ^ n, n, zpow_coe_nat y n⟩ :=
begin
  rw [zpowers_equiv_zpowers, equiv.trans_apply, equiv.trans_apply,
    fin_equiv_zpowers_symm_apply, ← equiv.eq_symm_apply, fin_equiv_zpowers_symm_apply],
  simp [h]
end

@[to_additive add_order_eq_card_zmultiples]
lemma order_eq_card_zpowers [decidable_eq G] :
  order_of x = fintype.card (subgroup.zpowers x : set G) :=
(fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_zpowers x⟩)

open quotient_group

/- TODO: use cardinal theory, introduce `card : set G → ℕ`, or setup decidability for cosets -/
@[to_additive add_order_of_dvd_card_univ]
lemma order_of_dvd_card_univ : order_of x ∣ fintype.card G :=
begin
  classical,
  have ft_prod : fintype ((G ⧸ zpowers x) × zpowers x),
    from fintype.of_equiv G group_equiv_quotient_times_subgroup,
  have ft_s : fintype (zpowers x),
    from @fintype.prod_right _ _ _ ft_prod _,
  have ft_cosets : fintype (G ⧸ zpowers x),
    from @fintype.prod_left _ _ _ ft_prod ⟨⟨1, (zpowers x).one_mem⟩⟩,
  have eq₁ : fintype.card G = @fintype.card _ ft_cosets * @fintype.card _ ft_s,
    from calc fintype.card G = @fintype.card _ ft_prod :
        @fintype.card_congr _ _ _ ft_prod group_equiv_quotient_times_subgroup
      ... = @fintype.card _ (@prod.fintype _ _ ft_cosets ft_s) :
        congr_arg (@fintype.card _) $ subsingleton.elim _ _
      ... = @fintype.card _ ft_cosets * @fintype.card _ ft_s :
        @fintype.card_prod _ _ ft_cosets ft_s,
  have eq₂ : order_of x = @fintype.card _ ft_s,
    from calc order_of x = _ : order_eq_card_zpowers
      ... = _ : congr_arg (@fintype.card _) $ subsingleton.elim _ _,
  exact dvd.intro (@fintype.card (G ⧸ subgroup.zpowers x) ft_cosets)
          (by rw [eq₁, eq₂, mul_comm])
end

@[simp, to_additive card_nsmul_eq_zero] lemma pow_card_eq_one : x ^ fintype.card G = 1 :=
let ⟨m, hm⟩ := @order_of_dvd_card_univ _ x _ _ in
by simp [hm, pow_mul, pow_order_of_eq_one]

@[to_additive] lemma pow_eq_mod_card (n : ℕ) :
  x ^ n = x ^ (n % fintype.card G) :=
by rw [pow_eq_mod_order_of, ←nat.mod_mod_of_dvd n order_of_dvd_card_univ,
  ← pow_eq_mod_order_of]

@[to_additive] lemma zpow_eq_mod_card (n : ℤ) :
  x ^ n = x ^ (n % fintype.card G) :=
by rw [zpow_eq_mod_order_of, ← int.mod_mod_of_dvd n (int.coe_nat_dvd.2 order_of_dvd_card_univ),
  ← zpow_eq_mod_order_of]

/-- If `gcd(|G|,n)=1` then the `n`th power map is a bijection -/
@[to_additive "If `gcd(|G|,n)=1` then the smul by `n` is a bijection", simps]
  def pow_coprime (h : nat.coprime (fintype.card G) n) : G ≃ G :=
{ to_fun := λ g, g ^ n,
  inv_fun := λ g, g ^ (nat.gcd_b (fintype.card G) n),
  left_inv := λ g, by
  { have key : g ^ _ = g ^ _ := congr_arg (λ n : ℤ, g ^ n) (nat.gcd_eq_gcd_ab (fintype.card G) n),
    rwa [zpow_add, zpow_mul, zpow_mul, zpow_coe_nat, zpow_coe_nat, zpow_coe_nat,
      h.gcd_eq_one, pow_one, pow_card_eq_one, one_zpow, one_mul, eq_comm] at key },
  right_inv := λ g, by
  { have key : g ^ _ = g ^ _ := congr_arg (λ n : ℤ, g ^ n) (nat.gcd_eq_gcd_ab (fintype.card G) n),
    rwa [zpow_add, zpow_mul, zpow_mul', zpow_coe_nat, zpow_coe_nat, zpow_coe_nat,
      h.gcd_eq_one, pow_one, pow_card_eq_one, one_zpow, one_mul, eq_comm] at key } }

@[simp, to_additive] lemma pow_coprime_one (h : nat.coprime (fintype.card G) n) :
  pow_coprime h 1 = 1 := one_pow n

@[simp, to_additive] lemma pow_coprime_inv (h : nat.coprime (fintype.card G) n) {g : G} :
  pow_coprime h g⁻¹ = (pow_coprime h g)⁻¹ := inv_pow g n

@[to_additive add_inf_eq_bot_of_coprime]
lemma inf_eq_bot_of_coprime {G : Type*} [group G] {H K : subgroup G} [fintype H] [fintype K]
  (h : nat.coprime (fintype.card H) (fintype.card K)) : H ⊓ K = ⊥ :=
begin
  refine (H ⊓ K).eq_bot_iff_forall.mpr (λ x hx, _),
  rw [←order_of_eq_one_iff, ←nat.dvd_one, ←h.gcd_eq_one, nat.dvd_gcd_iff],
  exact ⟨(congr_arg (∣ fintype.card H) (order_of_subgroup ⟨x, hx.1⟩)).mpr order_of_dvd_card_univ,
    (congr_arg (∣ fintype.card K) (order_of_subgroup ⟨x, hx.2⟩)).mpr order_of_dvd_card_univ⟩,
end

variable (a)

/-- TODO: Generalise to `submonoid.powers`.-/
@[to_additive image_range_add_order_of]
lemma image_range_order_of [decidable_eq G] :
  finset.image (λ i, x ^ i) (finset.range (order_of x)) = (zpowers x : set G).to_finset :=
by { ext x, rw [set.mem_to_finset, set_like.mem_coe, mem_zpowers_iff_mem_range_order_of] }

/-- TODO: Generalise to `finite_cancel_monoid`. -/
@[to_additive gcd_nsmul_card_eq_zero_iff]
lemma pow_gcd_card_eq_one_iff : x ^ n = 1 ↔ x ^ (gcd n (fintype.card G)) = 1 :=
⟨λ h, pow_gcd_eq_one _ h $ pow_card_eq_one,
  λ h, let ⟨m, hm⟩ := gcd_dvd_left n (fintype.card G) in
    by rw [hm, pow_mul, h, one_pow]⟩

end finite_group

end fintype

section pow_is_subgroup

/-- A nonempty idempotent subset of a finite cancellative monoid is a submonoid -/
@[to_additive "A nonempty idempotent subset of a finite cancellative add monoid is a submonoid"]
def submonoid_of_idempotent {M : Type*} [left_cancel_monoid M] [fintype M] (S : set M)
  (hS1 : S.nonempty) (hS2 : S * S = S) : submonoid M :=
have pow_mem : ∀ a : M, a ∈ S → ∀ n : ℕ, a ^ (n + 1) ∈ S :=
λ a ha, nat.rec (by rwa [zero_add, pow_one])
  (λ n ih, (congr_arg2 (∈) (pow_succ a (n + 1)).symm hS2).mp (set.mul_mem_mul ha ih)),
{ carrier := S,
  one_mem' := by
  { obtain ⟨a, ha⟩ := hS1,
    rw [←pow_order_of_eq_one a, ← tsub_add_cancel_of_le (succ_le_of_lt (order_of_pos a))],
    exact pow_mem a ha (order_of a - 1) },
  mul_mem' := λ a b ha hb, (congr_arg2 (∈) rfl hS2).mp (set.mul_mem_mul ha hb) }

/-- A nonempty idempotent subset of a finite group is a subgroup -/
@[to_additive "A nonempty idempotent subset of a finite add group is a subgroup"]
def subgroup_of_idempotent {G : Type*} [group G] [fintype G] (S : set G)
  (hS1 : S.nonempty) (hS2 : S * S = S) : subgroup G :=
{ carrier := S,
  inv_mem' := λ a ha, by
  { rw [←one_mul a⁻¹, ←pow_one a, ←pow_order_of_eq_one a, ←pow_sub a (order_of_pos a)],
    exact (submonoid_of_idempotent S hS1 hS2).pow_mem ha (order_of a - 1) },
  .. submonoid_of_idempotent S hS1 hS2 }

/-- If `S` is a nonempty subset of a finite group `G`, then `S ^ |G|` is a subgroup -/
@[to_additive smul_card_add_subgroup "If `S` is a nonempty subset of a finite add group `G`,
  then `|G| • S` is a subgroup", simps]
def pow_card_subgroup {G : Type*} [group G] [fintype G] (S : set G) (hS : S.nonempty) :
  subgroup G :=
have one_mem : (1 : G) ∈ (S ^ fintype.card G) := by
{ obtain ⟨a, ha⟩ := hS,
  rw ← pow_card_eq_one,
  exact set.pow_mem_pow ha (fintype.card G) },
subgroup_of_idempotent (S ^ (fintype.card G)) ⟨1, one_mem⟩ begin
  classical,
  refine (set.eq_of_subset_of_card_le
    (λ b hb, (congr_arg (∈ _) (one_mul b)).mp (set.mul_mem_mul one_mem hb)) (ge_of_eq _)).symm,
  change _ = fintype.card (_ * _ : set G),
  rw [←pow_add, group.card_pow_eq_card_pow_card_univ S (fintype.card G) le_rfl,
      group.card_pow_eq_card_pow_card_univ S (fintype.card G + fintype.card G) le_add_self],
end

end pow_is_subgroup

section linear_ordered_ring

variable [linear_ordered_ring G]

lemma order_of_abs_ne_one (h : |x| ≠ 1) : order_of x = 0 :=
begin
  rw order_of_eq_zero_iff',
  intros n hn hx,
  replace hx : |x| ^ n = 1 := by simpa only [abs_one, abs_pow] using congr_arg abs hx,
  cases h.lt_or_lt with h h,
  { exact ((pow_lt_one (abs_nonneg x) h hn.ne').ne hx).elim },
  { exact ((one_lt_pow h hn.ne').ne' hx).elim }
end

lemma linear_ordered_ring.order_of_le_two : order_of x ≤ 2 :=
begin
  cases ne_or_eq (|x|) 1 with h h,
  { simp [order_of_abs_ne_one h] },
  rcases eq_or_eq_neg_of_abs_eq h with rfl | rfl,
  { simp },
  apply order_of_le_of_pow_eq_one; norm_num
end

end linear_ordered_ring


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, example sheet 2 : the empty set and the "universal set".

We know what the empty subset of `X` is, and the Lean notation for
it is `∅`, or, if you want to say which type we're the empty subset
of, it's `∅ : set X`.

At the other extreme, the subset of `X` containing all the terms of type `X`
is...well...mathematicians would just call it `X`, but `X` is a type, and
so if we want a set it's called `set.univ : set X`, or just `univ : set X` if
we have opened the `set` namespace. Let's do that now.

-/

open set

/-

## Important

`x ∈ ∅` is *by definition* equal to `false` and `x ∈ univ` is *by definition*
equal to `true`. You can use the `change` tactic to make these changes
if you like. But you don't have to.

## Tactics you will need

You've seen them already. `trivial` proves `⊢ true` and `exfalso`
changes `⊢ P` to `⊢ false`.

-/

-- set up variables
variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

/-

If `x : X` then `x ∈ ∅` is *by definition* `false`, and `x ∈ univ` is
*by definition* `true`. So you can use the `change` tactic to change
between these things, for example if your goal is

```
⊢ x ∈ univ
```

then `change true` will change the goal to

```
⊢ true
```

and you can now prove this goal with `trivial`. However you can prove
it with `trivial` even without `change`ing it.

-/

open set

example : x ∈ (univ : set X) :=
begin
  sorry
end

example : x ∈ (∅ : set X) → false :=
begin
  sorry
end

example : ∀ x : X, x ∈ A → x ∈ (univ : set X) :=
begin
  sorry
end

example : ∀ x : X, x ∈ (∅ : set X) → x ∈ A :=
begin
  sorry
end


universe u
variables (α β γ : Type u)

-- Exercise 1
--
-- Define the function do_twice, as described in Section 2.4.
def do_twice : (α → α) → α → α :=
  λ f : (α → α), λ x : α, f (f x)

-- Exericse 2
--
-- Define the functions curry and uncurry, as described in Section 2.4.
def curry (f : α × β → γ) : α → β → γ :=
  λ a : α, λ b : β, f (a, b)

def uncurry (f : α → β → γ) : α × β → γ :=
  λ p : α × β, f p.fst p.snd

-- Exercise 3
--
-- Above, we used the example vec α n for vectors of elements of type α of
-- length n. Declare a constant vec_add that could represent a function that
-- adds two vectors of natural numbers of the same length, and a constant
-- vec_reverse that can represent a function that reverses its argument. Use
-- implicit arguments for parameters that can be inferred. Declare some
-- variables and check some expressions involving the constants that you have
-- declared.
constant vec : Type u → ℕ → Type u

constant vec_add : Π {α : Type u}, Π {m n : ℕ}, vec α m → vec α n → vec α (m + n)

constant vec_reverse : Π {α : Type u}, Π {n : ℕ}, vec α n → vec α n

constant vec1 : vec ℕ 4
constant vec2 : vec ℕ 3

section
  variables (vec1 : vec ℕ 4) (vec2 : vec ℕ 5)

  #check vec_add vec1 vec2
  #check vec_add vec2 vec1

  #check vec_reverse vec1
  #check vec_reverse vec2
end

-- Exericse 4
--
-- Similarly, declare a constant matrix so that matrix α m n could represent the
-- type of m by n matrices. Declare some constants to represent functions on
-- this type, such as matrix addition and multiplication, and (using vec)
-- multiplication of a matrix by a vector. Once again, declare some variables
-- and check some expressions involving the constants that you have declared.
constant matrix : Type u → ℕ → ℕ → Type u

constant matrix_add : Π {α : Type u}, Π {m n : ℕ}, matrix α m n → matrix α m n → matrix α m n

constant matrix_mul : Π {α : Type u}, Π {l m n : ℕ}, matrix α l m → matrix α m n → matrix α l m

section
  variables
    (matrix1 : matrix ℕ 2 2)
    (matrix2 : matrix ℕ 3 2)

  #check matrix_add matrix1 matrix1

  -- Expect this to fail:
  -- #check matrix_add matrix1 matrix2

  #check matrix_mul matrix2 matrix1

  -- Expect this to fail:
  -- #check matrix_mul matrix1 matrix2
end


-- Regla del conjunto vacío
-- ========================

-- ----------------------------------------------------
-- Ej. 1. Demostrar
--    ∅ ⊆ A
-- ----------------------------------------------------

import data.set

variable  U : Type
variables A : set U
variable  x : U

open set

-- #reduce (∅ : set U)
-- #reduce x ∈ (∅ : set U)

-- 1ª demostración
example : ∅ ⊆ A :=
begin
  intros x h,
  simp at h,
  exfalso,
  exact h,
end

-- 2ª demostración
example : ∅ ⊆ A :=
begin
  intros x h,
  exfalso,
  exact h,
end

-- 3ª demostración
example : ∅ ⊆ A :=
assume x,
assume h : x ∈ (∅ : set U),
show x ∈ A, from false.elim h

-- 4ª demostración
example : ∅ ⊆ A :=
λ x, λ h, false.elim h

-- 5ª demostración
example : ∅ ⊆ A :=
λ _, false.elim

-- 6ª demostración
example : ∅ ⊆ A :=
-- by library_search
empty_subset A

-- 7ª demostración
example : ∅ ⊆ A :=
assume x,
assume h : x ∈ (∅ : set U),
show x ∈ A, from absurd h (not_mem_empty x)

-- 8ª demostración
example : ∅ ⊆ A :=
λ x h, absurd h (not_mem_empty x)

-- 9ª demostración
example : ∅ ⊆ A :=
-- by hint
by tauto

-- 10ª demostración
example : ∅ ⊆ A :=
by finish

-- 11ª demostración
example : ∅ ⊆ A :=
by simp


/-
Copyright (c) 2019 Yury Kudriashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudriashov
-/
import algebra.big_operators.order
import analysis.convex.hull
import linear_algebra.affine_space.basis

/-!
# Convex combinations

This file defines convex combinations of points in a vector space.

## Main declarations

* `finset.center_mass`: Center of mass of a finite family of points.

## Implementation notes

We divide by the sum of the weights in the definition of `finset.center_mass` because of the way
mathematical arguments go: one doesn't change weights, but merely adds some. This also makes a few
lemmas unconditional on the sum of the weights being `1`.
-/

open set
open_locale big_operators classical pointwise

universes u u'
variables {R E F ι ι' : Type*} [linear_ordered_field R] [add_comm_group E] [add_comm_group F]
  [module R E] [module R F] {s : set E}

/-- Center of mass of a finite collection of points with prescribed weights.
Note that we require neither `0 ≤ w i` nor `∑ w = 1`. -/
def finset.center_mass (t : finset ι) (w : ι → R) (z : ι → E) : E :=
(∑ i in t, w i)⁻¹ • (∑ i in t, w i • z i)

variables (i j : ι) (c : R) (t : finset ι) (w : ι → R) (z : ι → E)

open finset

lemma finset.center_mass_empty : (∅ : finset ι).center_mass w z = 0 :=
by simp only [center_mass, sum_empty, smul_zero]

lemma finset.center_mass_pair (hne : i ≠ j) :
  ({i, j} : finset ι).center_mass w z = (w i / (w i + w j)) • z i + (w j / (w i + w j)) • z j :=
by simp only [center_mass, sum_pair hne, smul_add, (mul_smul _ _ _).symm, div_eq_inv_mul]

variable {w}

lemma finset.center_mass_insert (ha : i ∉ t) (hw : ∑ j in t, w j ≠ 0) :
  (insert i t).center_mass w z = (w i / (w i + ∑ j in t, w j)) • z i +
    ((∑ j in t, w j) / (w i + ∑ j in t, w j)) • t.center_mass w z :=
begin
  simp only [center_mass, sum_insert ha, smul_add, (mul_smul _ _ _).symm, ← div_eq_inv_mul],
  congr' 2,
  rw [div_mul_eq_mul_div, mul_inv_cancel hw, one_div]
end

lemma finset.center_mass_singleton (hw : w i ≠ 0) : ({i} : finset ι).center_mass w z = z i :=
by rw [center_mass, sum_singleton, sum_singleton, ← mul_smul, inv_mul_cancel hw, one_smul]

lemma finset.center_mass_eq_of_sum_1 (hw : ∑ i in t, w i = 1) :
  t.center_mass w z = ∑ i in t, w i • z i :=
by simp only [finset.center_mass, hw, inv_one, one_smul]

lemma finset.center_mass_smul : t.center_mass w (λ i, c • z i) = c • t.center_mass w z :=
by simp only [finset.center_mass, finset.smul_sum, (mul_smul _ _ _).symm, mul_comm c, mul_assoc]

/-- A convex combination of two centers of mass is a center of mass as well. This version
deals with two different index types. -/
lemma finset.center_mass_segment'
  (s : finset ι) (t : finset ι') (ws : ι → R) (zs : ι → E) (wt : ι' → R) (zt : ι' → E)
  (hws : ∑ i in s, ws i = 1) (hwt : ∑ i in t, wt i = 1) (a b : R) (hab : a + b = 1) :
  a • s.center_mass ws zs + b • t.center_mass wt zt =
    (s.map function.embedding.inl ∪ t.map function.embedding.inr).center_mass
      (sum.elim (λ i, a * ws i) (λ j, b * wt j))
      (sum.elim zs zt) :=
begin
  rw [s.center_mass_eq_of_sum_1 _ hws, t.center_mass_eq_of_sum_1 _ hwt,
    smul_sum, smul_sum, ← finset.sum_sum_elim, finset.center_mass_eq_of_sum_1],
  { congr' with ⟨⟩; simp only [sum.elim_inl, sum.elim_inr, mul_smul] },
  { rw [sum_sum_elim, ← mul_sum, ← mul_sum, hws, hwt, mul_one, mul_one, hab] }
end

/-- A convex combination of two centers of mass is a center of mass as well. This version
works if two centers of mass share the set of original points. -/
lemma finset.center_mass_segment
  (s : finset ι) (w₁ w₂ : ι → R) (z : ι → E)
  (hw₁ : ∑ i in s, w₁ i = 1) (hw₂ : ∑ i in s, w₂ i = 1) (a b : R) (hab : a + b = 1) :
  a • s.center_mass w₁ z + b • s.center_mass w₂ z =
    s.center_mass (λ i, a * w₁ i + b * w₂ i) z :=
have hw : ∑ i in s, (a * w₁ i + b * w₂ i) = 1,
  by simp only [mul_sum.symm, sum_add_distrib, mul_one, *],
by simp only [finset.center_mass_eq_of_sum_1, smul_sum, sum_add_distrib, add_smul, mul_smul, *]

lemma finset.center_mass_ite_eq (hi : i ∈ t) :
  t.center_mass (λ j, if (i = j) then (1 : R) else 0) z = z i :=
begin
  rw [finset.center_mass_eq_of_sum_1],
  transitivity ∑ j in t, if (i = j) then z i else 0,
  { congr' with i, split_ifs, exacts [h ▸ one_smul _ _, zero_smul _ _] },
  { rw [sum_ite_eq, if_pos hi] },
  { rw [sum_ite_eq, if_pos hi] }
end

variables {t w}

lemma finset.center_mass_subset {t' : finset ι} (ht : t ⊆ t')
  (h : ∀ i ∈ t', i ∉ t → w i = 0) :
  t.center_mass w z = t'.center_mass w z :=
begin
  rw [center_mass, sum_subset ht h, smul_sum, center_mass, smul_sum],
  apply sum_subset ht,
  assume i hit' hit,
  rw [h i hit' hit, zero_smul, smul_zero]
end

lemma finset.center_mass_filter_ne_zero :
  (t.filter (λ i, w i ≠ 0)).center_mass w z = t.center_mass w z :=
finset.center_mass_subset z (filter_subset _ _) $ λ i hit hit',
  by simpa only [hit, mem_filter, true_and, ne.def, not_not] using hit'

variable {z}

/-- The center of mass of a finite subset of a convex set belongs to the set
provided that all weights are non-negative, and the total weight is positive. -/
lemma convex.center_mass_mem (hs : convex R s) :
  (∀ i ∈ t, 0 ≤ w i) → (0 < ∑ i in t, w i) → (∀ i ∈ t, z i ∈ s) → t.center_mass w z ∈ s :=
begin
  induction t using finset.induction with i t hi ht, { simp [lt_irrefl] },
  intros h₀ hpos hmem,
  have zi : z i ∈ s, from hmem _ (mem_insert_self _ _),
  have hs₀ : ∀ j ∈ t, 0 ≤ w j, from λ j hj, h₀ j $ mem_insert_of_mem hj,
  rw [sum_insert hi] at hpos,
  by_cases hsum_t : ∑ j in t, w j = 0,
  { have ws : ∀ j ∈ t, w j = 0, from (sum_eq_zero_iff_of_nonneg hs₀).1 hsum_t,
    have wz : ∑ j in t, w j • z j = 0, from sum_eq_zero (λ i hi, by simp [ws i hi]),
    simp only [center_mass, sum_insert hi, wz, hsum_t, add_zero],
    simp only [hsum_t, add_zero] at hpos,
    rw [← mul_smul, inv_mul_cancel (ne_of_gt hpos), one_smul],
    exact zi },
  { rw [finset.center_mass_insert _ _ _ hi hsum_t],
    refine convex_iff_div.1 hs zi (ht hs₀ _ _) _ (sum_nonneg hs₀) hpos,
    { exact lt_of_le_of_ne (sum_nonneg hs₀) (ne.symm hsum_t) },
    { intros j hj, exact hmem j (mem_insert_of_mem hj) },
    { exact h₀ _ (mem_insert_self _ _) } }
end

lemma convex.sum_mem (hs : convex R s) (h₀ : ∀ i ∈ t, 0 ≤ w i) (h₁ : ∑ i in t, w i = 1)
  (hz : ∀ i ∈ t, z i ∈ s) :
  ∑ i in t, w i • z i ∈ s :=
by simpa only [h₁, center_mass, inv_one, one_smul] using
  hs.center_mass_mem h₀ (h₁.symm ▸ zero_lt_one) hz

lemma convex_iff_sum_mem :
  convex R s ↔
    (∀ (t : finset E) (w : E → R),
      (∀ i ∈ t, 0 ≤ w i) → ∑ i in t, w i = 1 → (∀ x ∈ t, x ∈ s) → ∑ x in t, w x • x ∈ s ) :=
begin
  refine ⟨λ hs t w hw₀ hw₁ hts, hs.sum_mem hw₀ hw₁ hts, _⟩,
  intros h x y hx hy a b ha hb hab,
  by_cases h_cases: x = y,
  { rw [h_cases, ←add_smul, hab, one_smul], exact hy },
  { convert h {x, y} (λ z, if z = y then b else a) _ _ _,
    { simp only [sum_pair h_cases, if_neg h_cases, if_pos rfl] },
    { simp_intros i hi,
      cases hi; subst i; simp [ha, hb, if_neg h_cases] },
    { simp only [sum_pair h_cases, if_neg h_cases, if_pos rfl, hab] },
    { simp_intros i hi,
      cases hi; subst i; simp [hx, hy, if_neg h_cases] } }
end

lemma finset.center_mass_mem_convex_hull (t : finset ι) {w : ι → R} (hw₀ : ∀ i ∈ t, 0 ≤ w i)
  (hws : 0 < ∑ i in t, w i) {z : ι → E} (hz : ∀ i ∈ t, z i ∈ s) :
  t.center_mass w z ∈ convex_hull R s :=
(convex_convex_hull R s).center_mass_mem hw₀ hws (λ i hi, subset_convex_hull R s $ hz i hi)

/-- A refinement of `finset.center_mass_mem_convex_hull` when the indexed family is a `finset` of
the space. -/
lemma finset.center_mass_id_mem_convex_hull (t : finset E) {w : E → R} (hw₀ : ∀ i ∈ t, 0 ≤ w i)
  (hws : 0 < ∑ i in t, w i) :
  t.center_mass w id ∈ convex_hull R (t : set E) :=
t.center_mass_mem_convex_hull hw₀ hws (λ i, mem_coe.2)

lemma affine_combination_eq_center_mass {ι : Type*} {t : finset ι} {p : ι → E} {w : ι → R}
  (hw₂ : ∑ i in t, w i = 1) :
  affine_combination t p w = center_mass t w p :=
begin
  rw [affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one _ w _ hw₂ (0 : E),
    finset.weighted_vsub_of_point_apply, vadd_eq_add, add_zero, t.center_mass_eq_of_sum_1 _ hw₂],
  simp_rw [vsub_eq_sub, sub_zero],
end

lemma affine_combination_mem_convex_hull
  {s : finset ι} {v : ι → E} {w : ι → R} (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : s.sum w = 1) :
  s.affine_combination v w ∈ convex_hull R (range v) :=
begin
  rw affine_combination_eq_center_mass hw₁,
  apply s.center_mass_mem_convex_hull hw₀,
  { simp [hw₁], },
  { simp, },
end

/-- The centroid can be regarded as a center of mass. -/
@[simp] lemma finset.centroid_eq_center_mass (s : finset ι) (hs : s.nonempty) (p : ι → E) :
  s.centroid R p = s.center_mass (s.centroid_weights R) p :=
affine_combination_eq_center_mass (s.sum_centroid_weights_eq_one_of_nonempty R hs)

lemma finset.centroid_mem_convex_hull (s : finset E) (hs : s.nonempty) :
  s.centroid R id ∈ convex_hull R (s : set E) :=
begin
  rw s.centroid_eq_center_mass hs,
  apply s.center_mass_id_mem_convex_hull,
  { simp only [inv_nonneg, implies_true_iff, nat.cast_nonneg, finset.centroid_weights_apply], },
  { have hs_card : (s.card : R) ≠ 0, { simp [finset.nonempty_iff_ne_empty.mp hs] },
    simp only [hs_card, finset.sum_const, nsmul_eq_mul, mul_inv_cancel, ne.def, not_false_iff,
      finset.centroid_weights_apply, zero_lt_one] }
end

lemma convex_hull_range_eq_exists_affine_combination (v : ι → E) :
  convex_hull R (range v) = { x | ∃ (s : finset ι) (w : ι → R)
    (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : s.sum w = 1), s.affine_combination v w = x } :=
begin
  refine subset.antisymm (convex_hull_min _ _) _,
  { intros x hx,
    obtain ⟨i, hi⟩ := set.mem_range.mp hx,
    refine ⟨{i}, function.const ι (1 : R), by simp, by simp, by simp [hi]⟩, },
  { rw convex,
    rintros x y ⟨s, w, hw₀, hw₁, rfl⟩ ⟨s', w', hw₀', hw₁', rfl⟩ a b ha hb hab,
    let W : ι → R := λ i, (if i ∈ s then a * w i else 0) + (if i ∈ s' then b * w' i else 0),
    have hW₁ : (s ∪ s').sum W = 1,
    { rw [sum_add_distrib, ← sum_subset (subset_union_left s s'),
        ← sum_subset (subset_union_right s s'), sum_ite_of_true _ _ (λ i hi, hi),
        sum_ite_of_true _ _ (λ i hi, hi), ← mul_sum, ← mul_sum, hw₁, hw₁', ← add_mul, hab, mul_one];
      intros i hi hi';
      simp [hi'], },
    refine ⟨s ∪ s', W, _, hW₁, _⟩,
    { rintros i -,
      by_cases hi : i ∈ s;
      by_cases hi' : i ∈ s';
      simp [hi, hi', add_nonneg, mul_nonneg ha (hw₀ i _), mul_nonneg hb (hw₀' i _)], },
    { simp_rw [affine_combination_eq_linear_combination (s ∪ s') v _ hW₁,
        affine_combination_eq_linear_combination s v w hw₁,
        affine_combination_eq_linear_combination s' v w' hw₁', add_smul, sum_add_distrib],
      rw [← sum_subset (subset_union_left s s'), ← sum_subset (subset_union_right s s')],
      { simp only [ite_smul, sum_ite_of_true _ _ (λ i hi, hi), mul_smul, ← smul_sum], },
      { intros i hi hi', simp [hi'], },
      { intros i hi hi', simp [hi'], }, }, },
  { rintros x ⟨s, w, hw₀, hw₁, rfl⟩,
    exact affine_combination_mem_convex_hull hw₀ hw₁, },
end

/-- Convex hull of `s` is equal to the set of all centers of masses of `finset`s `t`, `z '' t ⊆ s`.
This version allows finsets in any type in any universe. -/
lemma convex_hull_eq (s : set E) :
  convex_hull R s = {x : E | ∃ (ι : Type u') (t : finset ι) (w : ι → R) (z : ι → E)
    (hw₀ : ∀ i ∈ t, 0 ≤ w i) (hw₁ : ∑ i in t, w i = 1) (hz : ∀ i ∈ t, z i ∈ s),
    t.center_mass w z = x} :=
begin
  refine subset.antisymm (convex_hull_min _ _) _,
  { intros x hx,
    use [punit, {punit.star}, λ _, 1, λ _, x, λ _ _, zero_le_one,
      finset.sum_singleton, λ _ _, hx],
    simp only [finset.center_mass, finset.sum_singleton, inv_one, one_smul] },
  { rintros x y ⟨ι, sx, wx, zx, hwx₀, hwx₁, hzx, rfl⟩ ⟨ι', sy, wy, zy, hwy₀, hwy₁, hzy, rfl⟩
      a b ha hb hab,
    rw [finset.center_mass_segment' _ _ _ _ _ _ hwx₁ hwy₁ _ _ hab],
    refine ⟨_, _, _, _, _, _, _, rfl⟩,
    { rintros i hi,
      rw [finset.mem_union, finset.mem_map, finset.mem_map] at hi,
      rcases hi with ⟨j, hj, rfl⟩|⟨j, hj, rfl⟩;
        simp only [sum.elim_inl, sum.elim_inr];
        apply_rules [mul_nonneg, hwx₀, hwy₀] },
    { simp [finset.sum_sum_elim, finset.mul_sum.symm, *] },
    { intros i hi,
      rw [finset.mem_union, finset.mem_map, finset.mem_map] at hi,
      rcases hi with ⟨j, hj, rfl⟩|⟨j, hj, rfl⟩; apply_rules [hzx, hzy] } },
  { rintros _ ⟨ι, t, w, z, hw₀, hw₁, hz, rfl⟩,
    exact t.center_mass_mem_convex_hull hw₀ (hw₁.symm ▸ zero_lt_one) hz }
end

lemma finset.convex_hull_eq (s : finset E) :
  convex_hull R ↑s = {x : E | ∃ (w : E → R) (hw₀ : ∀ y ∈ s, 0 ≤ w y) (hw₁ : ∑ y in s, w y = 1),
    s.center_mass w id = x} :=
begin
  refine subset.antisymm (convex_hull_min _ _) _,
  { intros x hx,
    rw [finset.mem_coe] at hx,
    refine ⟨_, _, _, finset.center_mass_ite_eq _ _ _ hx⟩,
    { intros, split_ifs, exacts [zero_le_one, le_refl 0] },
    { rw [finset.sum_ite_eq, if_pos hx] } },
  { rintros x y ⟨wx, hwx₀, hwx₁, rfl⟩ ⟨wy, hwy₀, hwy₁, rfl⟩
      a b ha hb hab,
    rw [finset.center_mass_segment _ _ _ _ hwx₁ hwy₁ _ _ hab],
    refine ⟨_, _, _, rfl⟩,
    { rintros i hi,
      apply_rules [add_nonneg, mul_nonneg, hwx₀, hwy₀], },
    { simp only [finset.sum_add_distrib, finset.mul_sum.symm, mul_one, *] } },
  { rintros _ ⟨w, hw₀, hw₁, rfl⟩,
    exact s.center_mass_mem_convex_hull (λ x hx, hw₀ _ hx)
      (hw₁.symm ▸ zero_lt_one) (λ x hx, hx) }
end

lemma set.finite.convex_hull_eq {s : set E} (hs : s.finite) :
  convex_hull R s = {x : E | ∃ (w : E → R) (hw₀ : ∀ y ∈ s, 0 ≤ w y)
    (hw₁ : ∑ y in hs.to_finset, w y = 1), hs.to_finset.center_mass w id = x} :=
by simpa only [set.finite.coe_to_finset, set.finite.mem_to_finset, exists_prop]
  using hs.to_finset.convex_hull_eq

/-- A weak version of Carathéodory's theorem. -/
lemma convex_hull_eq_union_convex_hull_finite_subsets (s : set E) :
  convex_hull R s = ⋃ (t : finset E) (w : ↑t ⊆ s), convex_hull R ↑t :=
begin
  refine subset.antisymm _ _,
  { rw convex_hull_eq,
    rintros x ⟨ι, t, w, z, hw₀, hw₁, hz, rfl⟩,
    simp only [mem_Union],
    refine ⟨t.image z, _, _⟩,
    { rw [coe_image, set.image_subset_iff],
      exact hz },
    { apply t.center_mass_mem_convex_hull hw₀,
      { simp only [hw₁, zero_lt_one] },
      { exact λ i hi, finset.mem_coe.2 (finset.mem_image_of_mem _ hi) } } },
  { exact Union_subset (λ i, Union_subset convex_hull_mono), },
end

lemma mk_mem_convex_hull_prod {t : set F} {x : E} {y : F} (hx : x ∈ convex_hull R s)
  (hy : y ∈ convex_hull R t) :
  (x, y) ∈ convex_hull R (s ×ˢ t) :=
begin
  rw convex_hull_eq at ⊢ hx hy,
  obtain ⟨ι, a, w, S, hw, hw', hS, hSp⟩ := hx,
  obtain ⟨κ, b, v, T, hv, hv', hT, hTp⟩ := hy,
  have h_sum : ∑ (i : ι × κ) in a.product b, w i.fst * v i.snd = 1,
  { rw [finset.sum_product, ← hw'],
    congr,
    ext i,
    have : ∑ (y : κ) in b, w i * v y = ∑ (y : κ) in b, v y * w i,
    { congr, ext, simp [mul_comm] },
    rw [this, ← finset.sum_mul, hv'],
    simp },
  refine ⟨ι × κ, a.product b, λ p, (w p.1) * (v p.2), λ p, (S p.1, T p.2),
    λ p hp, _, h_sum, λ p hp, _, _⟩,
  { rw mem_product at hp,
    exact mul_nonneg (hw p.1 hp.1) (hv p.2 hp.2) },
  { rw mem_product at hp,
    exact ⟨hS p.1 hp.1, hT p.2 hp.2⟩ },
  ext,
  { rw [←hSp, finset.center_mass_eq_of_sum_1 _ _ hw', finset.center_mass_eq_of_sum_1 _ _ h_sum],
    simp_rw [prod.fst_sum, prod.smul_mk],
    rw finset.sum_product,
    congr,
    ext i,
    have : ∑ (j : κ) in b, (w i * v j) • S i = ∑ (j : κ) in b, v j • w i • S i,
    { congr, ext, rw [mul_smul, smul_comm] },
    rw [this, ←finset.sum_smul, hv', one_smul] },
  { rw [←hTp, finset.center_mass_eq_of_sum_1 _ _ hv', finset.center_mass_eq_of_sum_1 _ _ h_sum],
    simp_rw [prod.snd_sum, prod.smul_mk],
    rw [finset.sum_product, finset.sum_comm],
    congr,
    ext j,
    simp_rw mul_smul,
    rw [←finset.sum_smul, hw', one_smul] }
end

@[simp] lemma convex_hull_prod (s : set E) (t : set F) :
  convex_hull R (s ×ˢ t) = convex_hull R s ×ˢ convex_hull R t :=
subset.antisymm (convex_hull_min (prod_mono (subset_convex_hull _ _) $ subset_convex_hull _ _) $
  (convex_convex_hull _ _).prod $ convex_convex_hull _ _) $
    prod_subset_iff.2 $ λ x hx y, mk_mem_convex_hull_prod hx

lemma convex_hull_add (s t : set E) : convex_hull R (s + t) = convex_hull R s + convex_hull R t :=
by simp_rw [←image2_add, ←image_prod, is_linear_map.is_linear_map_add.convex_hull_image,
  convex_hull_prod]

lemma convex_hull_sub (s t : set E) : convex_hull R (s - t) = convex_hull R s - convex_hull R t :=
by simp_rw [sub_eq_add_neg, convex_hull_add, convex_hull_neg]

/-! ### `std_simplex` -/

variables (ι) [fintype ι] {f : ι → R}

/-- `std_simplex 𝕜 ι` is the convex hull of the canonical basis in `ι → 𝕜`. -/
lemma convex_hull_basis_eq_std_simplex :
  convex_hull R (range $ λ(i j:ι), if i = j then (1:R) else 0) = std_simplex R ι :=
begin
  refine subset.antisymm (convex_hull_min _ (convex_std_simplex R ι)) _,
  { rintros _ ⟨i, rfl⟩,
    exact ite_eq_mem_std_simplex R i },
  { rintros w ⟨hw₀, hw₁⟩,
    rw [pi_eq_sum_univ w, ← finset.univ.center_mass_eq_of_sum_1 _ hw₁],
    exact finset.univ.center_mass_mem_convex_hull (λ i hi, hw₀ i)
      (hw₁.symm ▸ zero_lt_one) (λ i hi, mem_range_self i) }
end

variable {ι}

/-- The convex hull of a finite set is the image of the standard simplex in `s → ℝ`
under the linear map sending each function `w` to `∑ x in s, w x • x`.

Since we have no sums over finite sets, we use sum over `@finset.univ _ hs.fintype`.
The map is defined in terms of operations on `(s → ℝ) →ₗ[ℝ] ℝ` so that later we will not need
to prove that this map is linear. -/
lemma set.finite.convex_hull_eq_image {s : set E} (hs : s.finite) :
  convex_hull R s = by haveI := hs.fintype; exact
    (⇑(∑ x : s, (@linear_map.proj R s _ (λ i, R) _ _ x).smul_right x.1)) '' (std_simplex R s) :=
begin
  rw [← convex_hull_basis_eq_std_simplex, ← linear_map.convex_hull_image, ← set.range_comp, (∘)],
  apply congr_arg,
  convert subtype.range_coe.symm,
  ext x,
  simp [linear_map.sum_apply, ite_smul, finset.filter_eq]
end

/-- All values of a function `f ∈ std_simplex 𝕜 ι` belong to `[0, 1]`. -/
lemma mem_Icc_of_mem_std_simplex (hf : f ∈ std_simplex R ι) (x) :
  f x ∈ Icc (0 : R) 1 :=
⟨hf.1 x, hf.2 ▸ finset.single_le_sum (λ y hy, hf.1 y) (finset.mem_univ x)⟩

/-- The convex hull of an affine basis is the intersection of the half-spaces defined by the
corresponding barycentric coordinates. -/
lemma convex_hull_affine_basis_eq_nonneg_barycentric {ι : Type*} (b : affine_basis ι R E) :
  convex_hull R (range b.points) = { x | ∀ i, 0 ≤ b.coord i x } :=
begin
  rw convex_hull_range_eq_exists_affine_combination,
  ext x,
  split,
  { rintros ⟨s, w, hw₀, hw₁, rfl⟩ i,
    by_cases hi : i ∈ s,
    { rw b.coord_apply_combination_of_mem hi hw₁,
      exact hw₀ i hi, },
    { rw b.coord_apply_combination_of_not_mem hi hw₁, }, },
  { intros hx,
    have hx' : x ∈ affine_span R (range b.points),
    { rw b.tot, exact affine_subspace.mem_top R E x, },
    obtain ⟨s, w, hw₁, rfl⟩ := (mem_affine_span_iff_eq_affine_combination R E).mp hx',
    refine ⟨s, w, _, hw₁, rfl⟩,
    intros i hi,
    specialize hx i,
    rw b.coord_apply_combination_of_mem hi hw₁ at hx,
    exact hx, },
end


/-
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.smul_with_zero
import algebra.regular.basic

/-!
# Action of regular elements on a module

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

We introduce `M`-regular elements, in the context of an `R`-module `M`.  The corresponding
predicate is called `is_smul_regular`.

There are very limited typeclass assumptions on `R` and `M`, but the "mathematical" case of interest
is a commutative ring `R` acting an a module `M`. Since the properties are "multiplicative", there
is no actual requirement of having an addition, but there is a zero in both `R` and `M`.
Smultiplications involving `0` are, of course, all trivial.

The defining property is that an element `a ∈ R` is `M`-regular if the smultiplication map
`M → M`, defined by `m ↦ a • m`, is injective.

This property is the direct generalization to modules of the property `is_left_regular` defined in
`algebra/regular`.  Lemma `is_smul_regular.is_left_regular_iff` shows that indeed the two notions
coincide.
-/

variables {R S : Type*} (M : Type*) {a b : R} {s : S}

/-- An `M`-regular element is an element `c` such that multiplication on the left by `c` is an
injective map `M → M`. -/
def is_smul_regular [has_smul R M] (c : R) := function.injective ((•) c : M → M)

lemma is_left_regular.is_smul_regular [has_mul R] {c : R} (h : is_left_regular c) :
  is_smul_regular R c := h

/-- Left-regular multiplication on `R` is equivalent to `R`-regularity of `R` itself. -/
lemma is_left_regular_iff [has_mul R] {a : R} :
  is_left_regular a ↔ is_smul_regular R a := iff.rfl

lemma is_right_regular.is_smul_regular [has_mul R] {c : R} (h : is_right_regular c) :
  is_smul_regular R (mul_opposite.op c) := h

/-- Right-regular multiplication on `R` is equivalent to `Rᵐᵒᵖ`-regularity of `R` itself. -/
lemma is_right_regular_iff [has_mul R] {a : R} :
  is_right_regular a ↔ is_smul_regular R (mul_opposite.op a) := iff.rfl

namespace is_smul_regular

variables {M}

section has_smul

variables [has_smul R M] [has_smul R S] [has_smul S M] [is_scalar_tower R S M]

/-- The product of `M`-regular elements is `M`-regular. -/
lemma smul (ra : is_smul_regular M a) (rs : is_smul_regular M s) :
  is_smul_regular M (a • s) :=
λ a b ab, rs (ra ((smul_assoc _ _ _).symm.trans (ab.trans (smul_assoc _ _ _))))

/-- If an element `b` becomes `M`-regular after multiplying it on the left by an `M`-regular
element, then `b` is `M`-regular. -/
lemma of_smul (a : R) (ab : is_smul_regular M (a • s)) :
  is_smul_regular M s :=
@function.injective.of_comp _ _ _ (λ m : M, a • m) _ (λ c d cd, ab
  (by rwa [smul_assoc, smul_assoc]))

/-- An element is `M`-regular if and only if multiplying it on the left by an `M`-regular element
is `M`-regular. -/
@[simp] lemma smul_iff (b : S) (ha : is_smul_regular M a) :
  is_smul_regular M (a • b) ↔ is_smul_regular M b :=
⟨of_smul _, ha.smul⟩

lemma is_left_regular [has_mul R] {a : R} (h : is_smul_regular R a) :
  is_left_regular a := h

lemma is_right_regular [has_mul R] {a : R} (h : is_smul_regular R (mul_opposite.op a)) :
  is_right_regular a := h

lemma mul [has_mul R] [is_scalar_tower R R M]
  (ra : is_smul_regular M a) (rb : is_smul_regular M b) : is_smul_regular M (a * b) :=
ra.smul rb

lemma of_mul [has_mul R] [is_scalar_tower R R M] (ab : is_smul_regular M (a * b)) :
  is_smul_regular M b :=
by { rw ← smul_eq_mul at ab, exact ab.of_smul _ }

@[simp] lemma mul_iff_right [has_mul R] [is_scalar_tower R R M] (ha : is_smul_regular M a) :
  is_smul_regular M (a * b) ↔ is_smul_regular M b :=
⟨of_mul, ha.mul⟩

/-- Two elements `a` and `b` are `M`-regular if and only if both products `a * b` and `b * a`
are `M`-regular. -/
lemma mul_and_mul_iff [has_mul R] [is_scalar_tower R R M] :
  is_smul_regular M (a * b) ∧ is_smul_regular M (b * a) ↔
  is_smul_regular M a ∧ is_smul_regular M b :=
begin
  refine ⟨_, _⟩,
  { rintros ⟨ab, ba⟩,
    refine ⟨ba.of_mul, ab.of_mul⟩ },
  { rintros ⟨ha, hb⟩,
    exact ⟨ha.mul hb, hb.mul ha⟩ }
end

end has_smul

section monoid

variables [monoid R] [mul_action R M]

variable (M)

/-- One is `M`-regular always. -/
@[simp] lemma one : is_smul_regular M (1 : R) :=
λ a b ab, by rwa [one_smul, one_smul] at ab

variable {M}

/-- An element of `R` admitting a left inverse is `M`-regular. -/
lemma of_mul_eq_one (h : a * b = 1) : is_smul_regular M b :=
of_mul (by { rw h, exact one M })

/-- Any power of an `M`-regular element is `M`-regular. -/
lemma pow (n : ℕ) (ra : is_smul_regular M a) : is_smul_regular M (a ^ n) :=
begin
  induction n with n hn,
  { simp only [one, pow_zero] },
  { rw pow_succ, exact (ra.smul_iff (a ^ n)).mpr hn }
end

/-- An element `a` is `M`-regular if and only if a positive power of `a` is `M`-regular. -/
lemma pow_iff {n : ℕ} (n0 : 0 < n) :
  is_smul_regular M (a ^ n) ↔ is_smul_regular M a :=
begin
  refine ⟨_, pow n⟩,
  rw [← nat.succ_pred_eq_of_pos n0, pow_succ', ← smul_eq_mul],
  exact of_smul _,
end

end monoid

section monoid_smul

variables [monoid S] [has_smul R M] [has_smul R S] [mul_action S M] [is_scalar_tower R S M]

/-- An element of `S` admitting a left inverse in `R` is `M`-regular. -/
lemma of_smul_eq_one (h : a • s = 1) : is_smul_regular M s :=
of_smul a (by { rw h, exact one M })

end monoid_smul

section monoid_with_zero

variables [monoid_with_zero R] [monoid_with_zero S] [has_zero M]
          [mul_action_with_zero R M] [mul_action_with_zero R S] [mul_action_with_zero S M]
          [is_scalar_tower R S M]

/-- The element `0` is `M`-regular if and only if `M` is trivial. -/
protected lemma subsingleton (h : is_smul_regular M (0 : R)) : subsingleton M :=
⟨λ a b, h (by repeat { rw mul_action_with_zero.zero_smul })⟩

/-- The element `0` is `M`-regular if and only if `M` is trivial. -/
lemma zero_iff_subsingleton : is_smul_regular M (0 : R) ↔ subsingleton M :=
⟨λ h, h.subsingleton, λ H a b h, @subsingleton.elim _ H a b⟩

/-- The `0` element is not `M`-regular, on a non-trivial module. -/
lemma not_zero_iff : ¬ is_smul_regular M (0 : R) ↔ nontrivial M :=
begin
  rw [nontrivial_iff, not_iff_comm, zero_iff_subsingleton, subsingleton_iff],
  push_neg,
  exact iff.rfl
end

/-- The element `0` is `M`-regular when `M` is trivial. -/
lemma zero [sM : subsingleton M] : is_smul_regular M (0 : R) :=
zero_iff_subsingleton.mpr sM

/-- The `0` element is not `M`-regular, on a non-trivial module. -/

end monoid_with_zero

section comm_semigroup

variables [comm_semigroup R] [has_smul R M] [is_scalar_tower R R M]

/-- A product is `M`-regular if and only if the factors are. -/
lemma mul_iff : is_smul_regular M (a * b) ↔
  is_smul_regular M a ∧ is_smul_regular M b :=
begin
  rw ← mul_and_mul_iff,
  exact ⟨λ ab, ⟨ab, by rwa mul_comm⟩, λ rab, rab.1⟩
end

end comm_semigroup

end is_smul_regular

section group

variables {G : Type*} [group G]

/-- An element of a group acting on a Type is regular. This relies on the availability
of the inverse given by groups, since there is no `left_cancel_smul` typeclass. -/
lemma is_smul_regular_of_group [mul_action G R] (g : G) : is_smul_regular R g :=
begin
  intros x y h,
  convert congr_arg ((•) g⁻¹) h using 1;
  simp [←smul_assoc]
end

end group

section units

variables [monoid R] [mul_action R M]

/-- Any element in `Rˣ` is `M`-regular. -/
lemma units.is_smul_regular (a : Rˣ) : is_smul_regular M (a : R) :=
is_smul_regular.of_mul_eq_one a.inv_val

/-- A unit is `M`-regular. -/
lemma is_unit.is_smul_regular (ua : is_unit a) : is_smul_regular M a :=
begin
  rcases ua with ⟨a, rfl⟩,
  exact a.is_smul_regular M
end

end units