-- Imagen_de_la_union.lean
-- Imagen de la unión.
-- José A. Alonso Jiménez
-- Sevilla, 4 de mayo de 2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean, la imagen de un conjunto s por una función f se representa
-- por `f '' s`; es decir,
--    f '' s = {y | ∃ x, x ∈ s ∧ f x = y}
--
-- Demostrar que
--    f '' (s ∪ t) = f '' s ∪ f '' t
-- ----------------------------------------------------------------------

import data.set.basic
import tactic

open set

variables {α : Type*} {β : Type*}
variable  f : α → β
variables s t : set α

-- 1ª demostración
-- ===============

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y,
  split,
  { intro h,
    rw mem_image at h,
    cases h with x hx,
    cases hx with xst fxy,
    rw ← fxy,
    rw mem_union at xst,
    cases xst with xs xt,
    { apply mem_union_left,
      apply mem_image_of_mem,
      exact xs, },
    { apply mem_union_right,
      apply mem_image_of_mem,
      exact xt, }},
  { intro h,
    rw mem_union at h,
    cases h with yfs yft,
    { rw mem_image,
      rw mem_image at yfs,
      cases yfs with x hx,
      cases hx with xs fxy,
      use x,
      split,
      { apply mem_union_left,
        exact xs, },
      { exact fxy, }},
    { rw mem_image,
      rw mem_image at yft,
      cases yft with x hx,
      cases hx with xt fxy,
      use x,
      split,
      { apply mem_union_right,
        exact xt, },
      { exact fxy, }}},
end

-- 2ª demostración
-- ===============

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y,
  split,
  { rintro ⟨x, xst, rfl⟩,
    cases xst with xs xt,
    { left,
      exact mem_image_of_mem f xs, },
    { right,
      exact mem_image_of_mem f xt, }},
  { rintro (yfs | yft),
    { rcases yfs with ⟨x, xs, rfl⟩,
      apply mem_image_of_mem,
      left,
      exact xs, },
    { rcases yft with ⟨x, xt, rfl⟩,
      apply mem_image_of_mem,
      right,
      exact xt, }},
end

-- 3ª demostración
-- ===============

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y,
  split,
  { rintro ⟨x, xst, rfl⟩,
    cases xst with xs xt,
    { left,
      use [x, xs], },
    { right,
      use [x, xt], }},
  { rintro (yfs | yft),
    { rcases yfs with ⟨x, xs, rfl⟩,
      use [x, or.inl xs], },
    { rcases yft with ⟨x, xt, rfl⟩,
      use [x, or.inr xt], }},
end

-- 4ª demostración
-- ===============

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y,
  split,
  { rintro ⟨x, xs | xt, rfl⟩,
    { left,
      use [x, xs], },
    { right,
      use [x, xt], }},
  { rintros (⟨x, xs, rfl⟩ | ⟨x, xt, rfl⟩),
    { use [x, or.inl xs], },
    { use [x, or.inr xt], }},
end

-- 5ª demostración
-- ===============

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y,
  split,
  { rintros ⟨x, xs | xt, rfl⟩ ; finish, },
  { rintros (⟨x, xs, rfl⟩ | ⟨x, xt, rfl⟩) ; finish, },
end

-- 6ª demostración
-- ===============

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y,
  split,
  { finish, },
  { finish, },
end

-- 7ª demostración
-- ===============

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y,
  rw iff_def,
  finish,
end

-- 8ª demostración
-- ===============

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
by finish [ext_iff, iff_def]

-- 9ª demostración
-- ===============

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
image_union f s t


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

The order topology.
-/
import data.set theories.topology.basic algebra.interval
open algebra eq.ops set interval topology

namespace order_topology

variables {X : Type} [linear_strong_order_pair X]

definition linorder_generators : set (set X) := {y | ∃ a, y = '(a, ∞) } ∪ {y | ∃ a, y = '(-∞, a)}

definition linorder_topology [instance] : topology X :=
  topology.generated_by linorder_generators

theorem Open_Ioi {a : X} : Open '(a, ∞) :=
(generators_mem_topology_generated_by linorder_generators) (!mem_unionl (exists.intro a rfl))

theorem Open_Iio {a : X} : Open '(-∞, a) :=
(generators_mem_topology_generated_by linorder_generators) (!mem_unionr (exists.intro a rfl))

theorem closed_Ici (a : X) : closed '[a,∞) :=
!compl_Ici⁻¹ ▸ Open_Iio

theorem closed_Iic (a : X) : closed '(-∞,a] :=
have '(a, ∞) = -'(-∞,a], from ext(take x, iff.intro
  (assume H, not_le_of_gt H)
  (assume H, lt_of_not_ge H)),
this ▸ Open_Ioi

theorem Open_Ioo (a b : X) : Open '(a, b) :=
Open_inter !Open_Ioi !Open_Iio

theorem closed_Icc (a b : X) : closed '[a, b] :=
closed_inter !closed_Ici !closed_Iic

section
  open classical

  theorem linorder_separation {x y : X} :
    x < y → ∃ a b, (x < a ∧ b < y) ∧ '(-∞, a) ∩ '(b, ∞) = ∅ :=
  suppose x < y,
  if H1 : ∃ z, x < z ∧ z < y then
    obtain z (Hz : x < z ∧ z < y), from H1,
    have '(-∞, z) ∩ '(z, ∞) = ∅, from ext (take r, iff.intro
      (assume H, absurd (!lt.trans (and.elim_left H) (and.elim_right H)) !lt.irrefl)
      (assume H, !not.elim !not_mem_empty H)),
    exists.intro z (exists.intro z (and.intro Hz this))
  else
    have '(-∞, y) ∩ '(x, ∞) = ∅, from ext(take r, iff.intro
      (assume H, absurd (exists.intro r (iff.elim_left and.comm H)) H1)
      (assume H, !not.elim !not_mem_empty H)),
    exists.intro y (exists.intro x (and.intro (and.intro `x < y` `x < y`) this))
end

protected definition T2_space.of_linorder_topology [trans_instance] :
  T2_space X :=
⦃ T2_space, linorder_topology,
  T2 := abstract
         take x y, assume H,
         or.elim (lt_or_gt_of_ne H)
           (assume H,
            obtain a [b Hab], from linorder_separation H,
            show _, from exists.intro '(-∞, a) (exists.intro '(b, ∞)
              (and.intro Open_Iio (and.intro Open_Ioi (iff.elim_left and.assoc Hab)))))
           (assume H,
            obtain a [b Hab], from linorder_separation H,
            have Hx : x ∈ '(b, ∞), from and.elim_right (and.elim_left Hab),
            have Hy : y ∈ '(-∞, a), from and.elim_left (and.elim_left Hab),
            have Hi : '(b, ∞) ∩ '(-∞, a) = ∅, from !inter_comm ▸ (and.elim_right Hab),
            have (Open '(b,∞)) ∧ (Open '(-∞, a)) ∧ x ∈ '(b, ∞) ∧ y ∈ '(-∞, a) ∧
                   '(b, ∞) ∩ '(-∞, a) = ∅, from
             and.intro Open_Ioi (and.intro Open_Iio (and.intro Hx (and.intro Hy Hi))),
           show _, from exists.intro '(b,∞) (exists.intro '(-∞, a) this))
        end ⦄

end order_topology


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.finset.fold
import algebra.gcd_monoid.multiset

/-!
# GCD and LCM operations on finsets

## Main definitions

- `finset.gcd` - the greatest common denominator of a `finset` of elements of a `gcd_monoid`
- `finset.lcm` - the least common multiple of a `finset` of elements of a `gcd_monoid`

## Implementation notes

Many of the proofs use the lemmas `gcd.def` and `lcm.def`, which relate `finset.gcd`
and `finset.lcm` to `multiset.gcd` and `multiset.lcm`.

TODO: simplify with a tactic and `data.finset.lattice`

## Tags

finset, gcd
-/

variables {α β γ : Type*}

namespace finset
open multiset

variables [comm_cancel_monoid_with_zero α] [normalized_gcd_monoid α]

/-! ### lcm -/
section lcm

/-- Least common multiple of a finite set -/
def lcm (s : finset β) (f : β → α) : α := s.fold gcd_monoid.lcm 1 f

variables {s s₁ s₂ : finset β} {f : β → α}

lemma lcm_def : s.lcm f = (s.1.map f).lcm := rfl

@[simp]

@[simp] lemma lcm_dvd_iff {a : α} : s.lcm f ∣ a ↔ (∀b ∈ s, f b ∣ a) :=
begin
  apply iff.trans multiset.lcm_dvd,
  simp only [multiset.mem_map, and_imp, exists_imp_distrib],
  exact ⟨λ k b hb, k _ _ hb rfl, λ k a' b hb h, h ▸ k _ hb⟩,
end

lemma lcm_dvd {a : α} : (∀b ∈ s, f b ∣ a) → s.lcm f ∣ a :=
lcm_dvd_iff.2

lemma dvd_lcm {b : β} (hb : b ∈ s) : f b ∣ s.lcm f :=
lcm_dvd_iff.1 dvd_rfl _ hb

@[simp] lemma lcm_insert [decidable_eq β] {b : β} :
  (insert b s : finset β).lcm f = gcd_monoid.lcm (f b) (s.lcm f) :=
begin
  by_cases h : b ∈ s,
  { rw [insert_eq_of_mem h,
        (lcm_eq_right_iff (f b) (s.lcm f) (multiset.normalize_lcm (s.1.map f))).2 (dvd_lcm h)] },
  apply fold_insert h,
end

@[simp] lemma lcm_singleton {b : β} : ({b} : finset β).lcm f = normalize (f b) :=
multiset.lcm_singleton

@[simp] lemma normalize_lcm : normalize (s.lcm f) = s.lcm f := by simp [lcm_def]

lemma lcm_union [decidable_eq β] : (s₁ ∪ s₂).lcm f = gcd_monoid.lcm (s₁.lcm f) (s₂.lcm f) :=
finset.induction_on s₁ (by rw [empty_union, lcm_empty, lcm_one_left, normalize_lcm]) $ λ a s has ih,
  by rw [insert_union, lcm_insert, lcm_insert, ih, lcm_assoc]

theorem lcm_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a ∈ s₂, f a = g a) :
  s₁.lcm f = s₂.lcm g :=
by { subst hs, exact finset.fold_congr hfg }

lemma lcm_mono_fun {g : β → α} (h : ∀ b ∈ s, f b ∣ g b) : s.lcm f ∣ s.lcm g :=
lcm_dvd (λ b hb, (h b hb).trans (dvd_lcm hb))

lemma lcm_mono (h : s₁ ⊆ s₂) : s₁.lcm f ∣ s₂.lcm f :=
lcm_dvd $ assume b hb, dvd_lcm (h hb)

theorem lcm_eq_zero_iff [nontrivial α] : s.lcm f = 0 ↔ 0 ∈ f '' s :=
by simp only [multiset.mem_map, lcm_def, multiset.lcm_eq_zero_iff, set.mem_image, mem_coe,
  ← finset.mem_def]

end lcm

/-! ### gcd -/
section gcd

/-- Greatest common divisor of a finite set -/
def gcd (s : finset β) (f : β → α) : α := s.fold gcd_monoid.gcd 0 f

variables {s s₁ s₂ : finset β} {f : β → α}

lemma gcd_def : s.gcd f = (s.1.map f).gcd := rfl

@[simp] lemma gcd_empty : (∅ : finset β).gcd f = 0 :=
fold_empty

lemma dvd_gcd_iff {a : α} : a ∣ s.gcd f ↔ ∀b ∈ s, a ∣ f b :=
begin
  apply iff.trans multiset.dvd_gcd,
  simp only [multiset.mem_map, and_imp, exists_imp_distrib],
  exact ⟨λ k b hb, k _ _ hb rfl, λ k a' b hb h, h ▸ k _ hb⟩,
end

lemma gcd_dvd {b : β} (hb : b ∈ s) : s.gcd f ∣ f b :=
dvd_gcd_iff.1 dvd_rfl _ hb

lemma dvd_gcd {a : α} : (∀b ∈ s, a ∣ f b) → a ∣ s.gcd f :=
dvd_gcd_iff.2

@[simp] lemma gcd_insert [decidable_eq β] {b : β} :
  (insert b s : finset β).gcd f = gcd_monoid.gcd (f b) (s.gcd f) :=
begin
  by_cases h : b ∈ s,
  { rw [insert_eq_of_mem h,
    (gcd_eq_right_iff (f b) (s.gcd f) (multiset.normalize_gcd (s.1.map f))).2 (gcd_dvd h)] ,},
  apply fold_insert h,
end

@[simp] lemma gcd_singleton {b : β} : ({b} : finset β).gcd f = normalize (f b) :=
multiset.gcd_singleton

@[simp] lemma normalize_gcd : normalize (s.gcd f) = s.gcd f := by simp [gcd_def]

lemma gcd_union [decidable_eq β] : (s₁ ∪ s₂).gcd f = gcd_monoid.gcd (s₁.gcd f) (s₂.gcd f) :=
finset.induction_on s₁ (by rw [empty_union, gcd_empty, gcd_zero_left, normalize_gcd]) $
  λ a s has ih, by rw [insert_union, gcd_insert, gcd_insert, ih, gcd_assoc]

theorem gcd_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a ∈ s₂, f a = g a) :
  s₁.gcd f = s₂.gcd g :=
by { subst hs, exact finset.fold_congr hfg }

lemma gcd_mono_fun {g : β → α} (h : ∀ b ∈ s, f b ∣ g b) : s.gcd f ∣ s.gcd g :=
dvd_gcd (λ b hb, (gcd_dvd hb).trans (h b hb))

lemma gcd_mono (h : s₁ ⊆ s₂) : s₂.gcd f ∣ s₁.gcd f :=
dvd_gcd $ assume b hb, gcd_dvd (h hb)

theorem gcd_image {g : γ → β} (s: finset γ) [decidable_eq β] [is_idempotent α gcd_monoid.gcd] :
  (s.image g).gcd f = s.gcd (f ∘ g) := by simp [gcd, fold_image_idem]

theorem gcd_eq_gcd_image [decidable_eq α] [is_idempotent α gcd_monoid.gcd] :
  s.gcd f = (s.image f).gcd id := (@gcd_image _ _ _ _ _ id _ _ _ _).symm

theorem gcd_eq_zero_iff : s.gcd f = 0 ↔ ∀ (x : β), x ∈ s → f x = 0 :=
begin
  rw [gcd_def, multiset.gcd_eq_zero_iff],
  split; intro h,
  { intros b bs,
    apply h (f b),
    simp only [multiset.mem_map, mem_def.1 bs],
    use b,
    simp [mem_def.1 bs] },
  { intros a as,
    rw multiset.mem_map at as,
    rcases as with ⟨b, ⟨bs, rfl⟩⟩,
    apply h b (mem_def.1 bs) }
end

lemma gcd_eq_gcd_filter_ne_zero [decidable_pred (λ (x : β), f x = 0)] :
  s.gcd f = (s.filter (λ x, f x ≠ 0)).gcd f :=
begin
  classical,
  transitivity ((s.filter (λ x, f x = 0)) ∪ (s.filter (λ x, f x ≠ 0))).gcd f,
  { rw filter_union_filter_neg_eq },
  rw gcd_union,
  transitivity gcd_monoid.gcd (0 : α) _,
  { refine congr (congr rfl _) rfl,
    apply s.induction_on, { simp },
    intros a s has h,
    rw filter_insert,
    split_ifs with h1; simp [h, h1], },
  simp [gcd_zero_left, normalize_gcd],
end

lemma gcd_mul_left {a : α} : s.gcd (λ x, a * f x) = normalize a * s.gcd f :=
begin
  classical,
  apply s.induction_on,
  { simp },
  intros b t hbt h,
  rw [gcd_insert, gcd_insert, h, ← gcd_mul_left],
  apply ((normalize_associated a).mul_right _).gcd_eq_right
end

lemma gcd_mul_right {a : α} : s.gcd (λ x, f x * a) = s.gcd f * normalize a :=
begin
  classical,
  apply s.induction_on,
  { simp },
  intros b t hbt h,
  rw [gcd_insert, gcd_insert, h, ← gcd_mul_right],
  apply ((normalize_associated a).mul_left _).gcd_eq_right
end

end gcd
end finset

namespace finset
section is_domain

variables [comm_ring α] [is_domain α] [normalized_gcd_monoid α]

lemma gcd_eq_of_dvd_sub {s : finset β} {f g : β → α} {a : α}
  (h : ∀ x : β, x ∈ s → a ∣ f x - g x) :
  gcd_monoid.gcd a (s.gcd f) = gcd_monoid.gcd a (s.gcd g) :=
begin
  classical,
  revert h,
  apply s.induction_on,
  { simp },
  intros b s bs hi h,
  rw [gcd_insert, gcd_insert, gcd_comm (f b), ← gcd_assoc, hi (λ x hx, h _ (mem_insert_of_mem hx)),
      gcd_comm a, gcd_assoc, gcd_comm a (gcd_monoid.gcd _ _),
      gcd_comm (g b), gcd_assoc _ _ a, gcd_comm _ a],
  exact congr_arg _ (gcd_eq_of_dvd_sub_right (h _ (mem_insert_self _ _)))
end

end is_domain

end finset


-- Imagen_inversa_de_la_union_general.lean
-- Imagen inversa de la unión general
-- José A. Alonso Jiménez
-- Sevilla, 26 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    f ⁻¹' (⋃ i, B i) = ⋃ i, f ⁻¹' (B i)
-- ----------------------------------------------------------------------

import data.set.basic
import tactic

open set

variables {α : Type*} {β : Type*} {I : Type*}
variable  f : α → β
variables B : I → set β

-- 1ª demostración
-- ===============

example : f ⁻¹' (⋃ i, B i) = ⋃ i, f ⁻¹' (B i) :=
begin
  ext x,
  split,
  { intro hx,
    rw mem_preimage at hx,
    rw mem_Union at hx,
    cases hx with i fxBi,
    rw mem_Union,
    use i,
    apply mem_preimage.mpr,
    exact fxBi, },
  { intro hx,
    rw mem_preimage,
    rw mem_Union,
    rw mem_Union at hx,
    cases hx with i xBi,
    use i,
    rw mem_preimage at xBi,
    exact xBi, },
end

-- 2ª demostración
-- ===============

example : f ⁻¹' (⋃ i, B i) = ⋃ i, f ⁻¹' (B i) :=
preimage_Union

-- 3ª demostración
-- ===============

example : f ⁻¹' (⋃ i, B i) = ⋃ i, f ⁻¹' (B i) :=
by  simp


import ...inClassNotes.langs.arith_expr

variables (P Q R : Prop)

/-
Excluded middle [25 points]
-/

-- A. 5 points

example : (¬P ∨ ¬Q) → ¬(P ∧ Q) :=
begin
assume h,
cases h,
assume k,
exact h k.left,
assume k,
exact h k.right,
end

-- B. 15 points

example : ¬(P ∧ Q) → (¬P ∨ ¬Q) :=
begin
assume h,
cases (classical.em P),
cases (classical.em Q),
exact false.elim (h (and.intro h_1 h_2)),
exact or.inr h_2,
exact or.inl h_1,
end

-- C. 5 Points. What do these examples teach
-- us about DeMorgan's Laws in constructive logic?

/-
-/

/-
Recursive definitions (practice) [20 points]
-/

/- 15 points
A. Write a function, le : nat → nat → bool,
that returns true if the first argument is
*less than or equal to* the second, and false
otherwise. Hints: case analysis, recursion.
-/

def leq : nat → nat → bool
| 0 n := tt
| (n'+1) 0 := ff
| (n'+1)(m'+1) := leq n' m'

/- 10 points
B. Write a function, eqn : nat → nat → bool,
that returns true if the first argument is
*equal to* the second, and false otherwise.
Hints: case analysis, recursion.
-/

def eql : nat → nat → bool
| 0 0 := tt
| _ 0 := ff
| 0 _ := ff
| (n'+1)(m'+1) := eql n' m'

/-
Better Boolean expressions [25 points]

Consolidate our definitions of the syntax and
semantics of Boolean and arithmetic expressions
into a system. Leave each algebra implemented
in its own file. Now define two new forms of
Boolean expression, as follows:

(1) if N and M are arithmetic variable
expressions, tben leq_expr N M is a Boolean
expression. It should evaluate to Boolean
true (tt) if and ony if N evaluates to a
number that is less than or equal to M,
using your leq function from the previous
problem.

(2) if N and M are arithmetic variable
expressions, then eql_expr N M is also
a Boolean expression: one that evaluates
to tt if and only if N evaluates to a
natural number (nat) that is equal to
the number to which M evaluates, using
your eql function.

Submit your work as a pair of files,
with the bool file importing from the
arithmetic file to obtain support for
arithmetic expressions. Follow naming
conventions established in the files
we developed in class. Submit the two
files in addition to your completed
version of this file.
-/

/-
Mutable state and assignment [25 points]

In this problem, we will contine to represent
a state, as we have in our previous work, as
a function from variables (objects of a type,
var) to values (here of type nat).
-/

structure Var : Type := (index : nat)
def State := Var → nat
def eqVar (v1 v2 : Var) : bool := v1.index = v2.index

/-
One of the profound differences between
imperative and functional programming is
that in the former--in languages such as
Python and C--one assumes and is given a
*mutable* global state. That is not the
case in functional programming. While we
can bind variable names to values once, we
cannot update the values bound to variables
as computations progress.

When programming in an imperative language,
by contrast, one has operations for free to
obtain the value associated with (to read)
a variable, and to override the value that
is associated with a variable (to write to
it). We call the write operation assignment.

To confuse humans who already understand
arithmetic, the designers of languages such
as Basic, C, Java, and Python use = as a
concrete notation to invoke the assignment
operation. (It's only indirectly related to
the concept of equality from basic math.)

Thus in such languages we might write code
like this:

X = 1

Ignoring the terrible choice of notation
for what you can think of as a procedure
invocation (assign X 1), what this really
means is *update the state so that the
value of the variable X is now bound to 1.

What's missing from our X = 1 diagram,
though, is a representation of the states!
Here's a better picture, one that clearly
illustrates the *effect* of an assignment
operation on a state in one scenario.

{ (X, 0), (Y, 1), (Z, 2) }
X = 1
{ (X, 1), (Y, 1), (Z, 2) }

In this case, the state before the assignment
was given by the function,
  st = { (X, 0), (Y, 1), (Z, 2) }, while after
the assignment operation it was
  st' = { (X, 1), (Y, 1), (Z, 2) }.
Notice that st' differs from st only for X, and
the new value associated with X is the one that
we "assigned" to it.

Now read this carefully. We can now represent
an assignment operation in Lean as a function:
one that takes a state, st, a variable, v, and
a value, k, and that returns a state, st', that
differs from st only to the extent that in st',
v is bound to k, whereas every other variable
remains bound to the value it had in st.
-/

def assign (st : State) (v : Var) (k : nat) : State :=
λ v', if (v.index = v'.index) then k else st v'

/-
Examples
-/

def allz : State := λ v, 0

#reduce allz

def X := Var.mk 0
def Y := Var.mk 1
def Z := Var.mk 2

/-
-- start in initial state
X = 7;
Y = 8;
Z = 9;
-/
def st :=
  assign
    (assign
      (assign
        allz
        X
        7
      )
      Y
      8
    )
    Z
    9

#eval st X
#eval st Y
#eval st Z

-- Exercise: assign 10 to X after all that, call new state st'

def st' : State := _

#eval st' X
#eval st' Y
#eval st' Z

inductive cmd : Type
| assn (v : Var) (a : aexp)
| seq (c1 c2 : cmd)

open cmd

notation v = aexp := assn v aexp
notation c1 ; c2 := seq c1 c2

def a1 : cmd := X = [7]
def a2 : cmd := Y = [8]
def a3 : cmd := Z = [9]
def a4 : cmd := X = [10]

-- Need a way to compose these commands!

def c := a1; a2; a3; a4

#reduce st
/-
-- a function that takes an argument, v', of type Var, and that returns its value
λ (v' : Var),
  decidable.rec

    -- case 1: if v' ≠ Z the return result of applying the function before the override
    (λ (hnc : 2 = v'.index → false),
       decidable.rec

          -- case A: v' ≠ Y
         (λ (hnc : 1 = v'.index → false),
            decidable.rec

              -- case a: v' ≠ X
              (λ (hnc : 0 = v'.index → false), 0)

              -- case b: v' = X
              (λ (hc : 0 = v'.index), 7)

              -- v' =? X decidable
              (nat.decidable_eq 0 v'.index))

          -- case B: v' = Y
         (λ (hc : 1 = v'.index), 8)
         (nat.decidable_eq 1 v'.index))

    -- case 2: if v' = Z then return the overriding value
    (λ (hc : 2 = v'.index), 9)
    (nat.decidable_eq 2 v'.index)
-/
#check @decidable_eq
#check @nat.decidable_eq

/-
 In English, this is the state obtained by
 starting with an all-zeros state and then
 overriding X with 1, then overriding Y with
 5 in that state, and then overriding the
 result of that with Z 4.
 -/
 /-
 How is that concept of state implemented
 using decidable.rec, answers, functions,
 or values? [?]
 -/
/-
Here's decidable.rec.
-/
#check @decidable
/-
class inductive decidable (p : Prop)
| is_false (h : ¬p) : decidable
| is_true  (h : p) : decidable
-/
#check @decidable.rec
/-
-- For any proposition, p, and a function
-- from either a proof of p or a proof of
-- not p to a type inhabiting Sort u_1,
Π {p : Prop} {C : decidable p → Sort u_1},

-- assume we have a function that takes a
-- proof, h, that p is false, and returns
-- C applied to the proof that p is false,
    (Π (h : ¬p), C (is_false h)) →
-- assume we have a function that takes a
-- proof, h, that p is true, and returns
-- C applied to the proof that p is true,

    (Π (h : p), C (is_true h)) →
-- then for any (n : decidable p), or in
-- other words for either an is_true proof
-- or an is_false proof, there is a value
-- of type C n
Π (n : decidable p), C n

-- In other words, if you've given a value
-- for the true case and one for the false
-- case then you've covered all the cases,
-- and for each case you have a function to
-- convert a proof for that case into a type.
[SEEMS_WRONG]
-/


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.reverse
import algebra.associated

/-!
# Theory of monic polynomials

We give several tools for proving that polynomials are monic, e.g.
`monic_mul`, `monic_map`.
-/

noncomputable theory
local attribute [instance, priority 100] classical.prop_decidable

open finset
open_locale big_operators

namespace polynomial
universes u v y
variables {R : Type u} {S : Type v} {a b : R} {m n : ℕ} {ι : Type y}

section semiring
variables [semiring R] {p q r : polynomial R}

lemma monic.as_sum {p : polynomial R} (hp : p.monic) :
  p = X^(p.nat_degree) + (∑ i in range p.nat_degree, C (p.coeff i) * X^i) :=
begin
  conv_lhs { rw [p.as_sum_range_C_mul_X_pow, sum_range_succ_comm] },
  suffices : C (p.coeff p.nat_degree) = 1,
  { rw [this, one_mul] },
  exact congr_arg C hp
end

lemma ne_zero_of_monic_of_zero_ne_one (hp : monic p) (h : (0 : R) ≠ 1) :
  p ≠ 0 := mt (congr_arg leading_coeff) $ by rw [monic.def.1 hp, leading_coeff_zero]; cc

lemma ne_zero_of_ne_zero_of_monic (hp : p ≠ 0) (hq : monic q) : q ≠ 0 :=
begin
  intro h, rw [h, monic.def, leading_coeff_zero] at hq,
  rw [← mul_one p, ← C_1, ← hq, C_0, mul_zero] at hp,
  exact hp rfl
end

lemma monic_map [semiring S] (f : R →+* S) (hp : monic p) : monic (p.map f) :=
if h : (0 : S) = 1 then
  by haveI := subsingleton_of_zero_eq_one h;
  exact subsingleton.elim _ _
else
have f (leading_coeff p) ≠ 0,
  by rwa [show _ = _, from hp, is_semiring_hom.map_one f, ne.def, eq_comm],
by
begin
  rw [monic, leading_coeff, coeff_map],
  suffices : p.coeff (map f p).nat_degree = 1, simp [this],
  suffices : (map f p).nat_degree = p.nat_degree, rw this, exact hp,
  rwa nat_degree_eq_of_degree_eq (degree_map_eq_of_leading_coeff_ne_zero _ _),
end

lemma monic_mul_C_of_leading_coeff_mul_eq_one [nontrivial R] {b : R}
  (hp : p.leading_coeff * b = 1) : monic (p * C b) :=
by rw [monic, leading_coeff_mul' _]; simp [leading_coeff_C b, hp]

theorem monic_of_degree_le (n : ℕ) (H1 : degree p ≤ n) (H2 : coeff p n = 1) : monic p :=
decidable.by_cases
  (assume H : degree p < n, eq_of_zero_eq_one
    (H2 ▸ (coeff_eq_zero_of_degree_lt H).symm) _ _)
  (assume H : ¬degree p < n,
    by rwa [monic, leading_coeff, nat_degree, (lt_or_eq_of_le H1).resolve_left H])

theorem monic_X_pow_add {n : ℕ} (H : degree p ≤ n) : monic (X ^ (n+1) + p) :=
have H1 : degree p < n+1, from lt_of_le_of_lt H (with_bot.coe_lt_coe.2 (nat.lt_succ_self n)),
monic_of_degree_le (n+1)
  (le_trans (degree_add_le _ _) (max_le (degree_X_pow_le _) (le_of_lt H1)))
  (by rw [coeff_add, coeff_X_pow, if_pos rfl, coeff_eq_zero_of_degree_lt H1, add_zero])

theorem monic_X_add_C (x : R) : monic (X + C x) :=
pow_one (X : polynomial R) ▸ monic_X_pow_add degree_C_le

lemma monic_mul (hp : monic p) (hq : monic q) : monic (p * q) :=
if h0 : (0 : R) = 1 then by haveI := subsingleton_of_zero_eq_one h0;
  exact subsingleton.elim _ _
else
  have leading_coeff p * leading_coeff q ≠ 0, by simp [monic.def.1 hp, monic.def.1 hq, ne.symm h0],
  by rw [monic.def, leading_coeff_mul' this, monic.def.1 hp, monic.def.1 hq, one_mul]

lemma monic_pow (hp : monic p) : ∀ (n : ℕ), monic (p ^ n)
| 0     := monic_one
| (n+1) := by { rw pow_succ, exact monic_mul hp (monic_pow n) }

lemma monic_add_of_left {p q : polynomial R} (hp : monic p) (hpq : degree q < degree p) :
  monic (p + q) :=
by rwa [monic, add_comm, leading_coeff_add_of_degree_lt hpq]

lemma monic_add_of_right {p q : polynomial R} (hq : monic q) (hpq : degree p < degree q) :
  monic (p + q) :=
by rwa [monic, leading_coeff_add_of_degree_lt hpq]

namespace monic

@[simp]
lemma degree_eq_zero_iff_eq_one {p : polynomial R} (hp : p.monic) :
  p.nat_degree = 0 ↔ p = 1 :=
begin
  split; intro h,
  swap, { rw h, exact nat_degree_one },
  have : p = C (p.coeff 0),
  { rw ← polynomial.degree_le_zero_iff,
    rwa polynomial.nat_degree_eq_zero_iff_degree_le_zero at h },
  rw this, convert C_1, rw ← h, apply hp,
end

lemma nat_degree_mul {p q : polynomial R} (hp : p.monic) (hq : q.monic) :
  (p * q).nat_degree = p.nat_degree + q.nat_degree :=
begin
  nontriviality R,
  apply nat_degree_mul',
  simp [hp.leading_coeff, hq.leading_coeff]
end

lemma next_coeff_mul {p q : polynomial R} (hp : monic p) (hq : monic q) :
  next_coeff (p * q) = next_coeff p + next_coeff q :=
begin
  nontriviality,
  simp only [← coeff_one_reverse],
  rw reverse_mul;
    simp [coeff_mul, nat.antidiagonal, hp.leading_coeff, hq.leading_coeff, add_comm]
end

end monic

end semiring

section comm_semiring
variables [comm_semiring R] {p : polynomial R}

lemma monic_multiset_prod_of_monic (t : multiset ι) (f : ι → polynomial R)
  (ht : ∀ i ∈ t, monic (f i)) :
  monic (t.map f).prod :=
begin
  revert ht,
  refine t.induction_on _ _, { simp },
  intros a t ih ht,
  rw [multiset.map_cons, multiset.prod_cons],
  exact monic_mul
    (ht _ (multiset.mem_cons_self _ _))
    (ih (λ _ hi, ht _ (multiset.mem_cons_of_mem hi)))
end

lemma monic_prod_of_monic (s : finset ι) (f : ι → polynomial R) (hs : ∀ i ∈ s, monic (f i)) :
  monic (∏ i in s, f i) :=
monic_multiset_prod_of_monic s.1 f hs

lemma is_unit_C {x : R} : is_unit (C x) ↔ is_unit x :=
begin
  rw [is_unit_iff_dvd_one, is_unit_iff_dvd_one],
  split,
  { rintros ⟨g, hg⟩,
    replace hg := congr_arg (eval 0) hg,
    rw [eval_one, eval_mul, eval_C] at hg,
    exact ⟨g.eval 0, hg⟩ },
  { rintros ⟨y, hy⟩,
    exact ⟨C y, by rw [← C_mul, ← hy, C_1]⟩ }
end

lemma eq_one_of_is_unit_of_monic (hm : monic p) (hpu : is_unit p) : p = 1 :=
have degree p ≤ 0,
  from calc degree p ≤ degree (1 : polynomial R) :
    let ⟨u, hu⟩ := is_unit_iff_dvd_one.1 hpu in
    if hu0 : u = 0
    then begin
        rw [hu0, mul_zero] at hu,
        rw [← mul_one p, hu, mul_zero],
        simp
      end
    else have p.leading_coeff * u.leading_coeff ≠ 0,
        by rw [hm.leading_coeff, one_mul, ne.def, leading_coeff_eq_zero];
          exact hu0,
      by rw [hu, degree_mul' this];
        exact le_add_of_nonneg_right (degree_nonneg_iff_ne_zero.2 hu0)
  ... ≤ 0 : degree_one_le,
by rw [eq_C_of_degree_le_zero this, ← nat_degree_eq_zero_iff_degree_le_zero.2 this,
    ← leading_coeff, hm.leading_coeff, C_1]

lemma monic.next_coeff_multiset_prod (t : multiset ι) (f : ι → polynomial R)
  (h : ∀ i ∈ t, monic (f i)) :
  next_coeff (t.map f).prod = (t.map (λ i, next_coeff (f i))).sum :=
begin
  revert h,
  refine multiset.induction_on t _ (λ a t ih ht, _),
  { simp only [multiset.not_mem_zero, forall_prop_of_true, forall_prop_of_false, multiset.map_zero,
               multiset.prod_zero, multiset.sum_zero, not_false_iff, forall_true_iff],
    rw ← C_1, rw next_coeff_C_eq_zero },
  { rw [multiset.map_cons, multiset.prod_cons, multiset.map_cons, multiset.sum_cons,
        monic.next_coeff_mul, ih],
    exacts [λ i hi, ht i (multiset.mem_cons_of_mem hi), ht a (multiset.mem_cons_self _ _),
            monic_multiset_prod_of_monic _ _ (λ b bs, ht _ (multiset.mem_cons_of_mem bs))] }
end

lemma monic.next_coeff_prod (s : finset ι) (f : ι → polynomial R) (h : ∀ i ∈ s, monic (f i)) :
  next_coeff (∏ i in s, f i) = ∑ i in s, next_coeff (f i) :=
monic.next_coeff_multiset_prod s.1 f h

end comm_semiring

section ring
variables [ring R] {p : polynomial R}

theorem monic_X_sub_C (x : R) : monic (X - C x) :=
by simpa only [sub_eq_add_neg, C_neg] using monic_X_add_C (-x)

theorem monic_X_pow_sub {n : ℕ} (H : degree p ≤ n) : monic (X ^ (n+1) - p) :=
by simpa [sub_eq_add_neg] using monic_X_pow_add (show degree (-p) ≤ n, by rwa ←degree_neg p at H)

/-- `X ^ n - a` is monic. -/
lemma monic_X_pow_sub_C {R : Type u} [ring R] (a : R) {n : ℕ} (h : n ≠ 0) : (X ^ n - C a).monic :=
begin
  obtain ⟨k, hk⟩ := nat.exists_eq_succ_of_ne_zero h,
  convert monic_X_pow_sub _,
  exact le_trans degree_C_le nat.with_bot.coe_nonneg,
end

lemma monic_sub_of_left {p q : polynomial R} (hp : monic p) (hpq : degree q < degree p) :
  monic (p - q) :=
by { rw sub_eq_add_neg, apply monic_add_of_left hp, rwa degree_neg }

lemma monic_sub_of_right {p q : polynomial R}
  (hq : q.leading_coeff = -1) (hpq : degree p < degree q) : monic (p - q) :=
have (-q).coeff (-q).nat_degree = 1 :=
by rw [nat_degree_neg, coeff_neg, show q.coeff q.nat_degree = -1, from hq, neg_neg],
by { rw sub_eq_add_neg, apply monic_add_of_right this, rwa degree_neg }

section injective
open function
variables [semiring S] {f : R →+* S} (hf : injective f)
include hf

lemma leading_coeff_of_injective (p : polynomial R) :
  leading_coeff (p.map f) = f (leading_coeff p) :=
begin
  delta leading_coeff,
  rw [coeff_map f, nat_degree_map' hf p]
end

lemma monic_of_injective {p : polynomial R} (hp : (p.map f).monic) : p.monic :=
begin
  apply hf,
  rw [← leading_coeff_of_injective hf, hp.leading_coeff, is_semiring_hom.map_one f]
end

end injective
end ring

section nonzero_semiring
variables [semiring R] [nontrivial R] {p q : polynomial R}

@[simp] lemma not_monic_zero : ¬monic (0 : polynomial R) :=
by simpa only [monic, leading_coeff_zero] using (zero_ne_one : (0 : R) ≠ 1)

lemma ne_zero_of_monic (h : monic p) : p ≠ 0 :=
λ h₁, @not_monic_zero R _ _ (h₁ ▸ h)

end nonzero_semiring

end polynomial


/-
Copyright (c) 2022 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import algebra.is_prime_pow
import data.nat.factorization.basic

/-!
# Prime powers and factorizations

This file deals with factorizations of prime powers.
-/

variables {R : Type*} [comm_monoid_with_zero R] (n p : R) (k : ℕ)

lemma is_prime_pow.min_fac_pow_factorization_eq {n : ℕ} (hn : is_prime_pow n) :
  n.min_fac ^ n.factorization n.min_fac = n :=
begin
  obtain ⟨p, k, hp, hk, rfl⟩ := hn,
  rw ←nat.prime_iff at hp,
  rw [hp.pow_min_fac hk.ne', hp.factorization_pow, finsupp.single_eq_same],
end

lemma is_prime_pow_of_min_fac_pow_factorization_eq {n : ℕ}
  (h : n.min_fac ^ n.factorization n.min_fac = n) (hn : n ≠ 1) :
  is_prime_pow n :=
begin
  rcases eq_or_ne n 0 with rfl | hn',
  { simpa using h },
  refine ⟨_, _, nat.prime_iff.1 (nat.min_fac_prime hn), _, h⟩,
  rw [pos_iff_ne_zero, ←finsupp.mem_support_iff, nat.factor_iff_mem_factorization,
    nat.mem_factors_iff_dvd hn' (nat.min_fac_prime hn)],
  apply nat.min_fac_dvd
end

lemma is_prime_pow_iff_min_fac_pow_factorization_eq {n : ℕ} (hn : n ≠ 1) :
  is_prime_pow n ↔ n.min_fac ^ n.factorization n.min_fac = n :=
⟨λ h, h.min_fac_pow_factorization_eq, λ h, is_prime_pow_of_min_fac_pow_factorization_eq h hn⟩

lemma is_prime_pow_iff_factorization_eq_single {n : ℕ} :
  is_prime_pow n ↔ ∃ p k : ℕ, 0 < k ∧ n.factorization = finsupp.single p k :=
begin
  rw is_prime_pow_nat_iff,
  refine exists₂_congr (λ p k, _),
  split,
  { rintros ⟨hp, hk, hn⟩,
    exact ⟨hk, by rw [←hn, nat.prime.factorization_pow hp]⟩ },
  { rintros ⟨hk, hn⟩,
    have hn0 : n ≠ 0,
    { rintro rfl,
      simpa only [finsupp.single_eq_zero, eq_comm, nat.factorization_zero, hk.ne'] using hn },
    rw nat.eq_pow_of_factorization_eq_single hn0 hn,
    exact ⟨nat.prime_of_mem_factorization
      (by simp [hn, hk.ne'] : p ∈ n.factorization.support), hk, rfl⟩ }
end

lemma is_prime_pow_iff_card_support_factorization_eq_one {n : ℕ} :
  is_prime_pow n ↔ n.factorization.support.card = 1 :=
by simp_rw [is_prime_pow_iff_factorization_eq_single, finsupp.card_support_eq_one', exists_prop,
  pos_iff_ne_zero]

/-- An equivalent definition for prime powers: `n` is a prime power iff there is a unique prime
dividing it. -/
lemma is_prime_pow_iff_unique_prime_dvd {n : ℕ} :
  is_prime_pow n ↔ ∃! p : ℕ, p.prime ∧ p ∣ n :=
begin
  rw is_prime_pow_nat_iff,
  split,
  { rintro ⟨p, k, hp, hk, rfl⟩,
    refine ⟨p, ⟨hp, dvd_pow_self _ hk.ne'⟩, _⟩,
    rintro q ⟨hq, hq'⟩,
    exact (nat.prime_dvd_prime_iff_eq hq hp).1 (hq.dvd_of_dvd_pow hq') },
  rintro ⟨p, ⟨hp, hn⟩, hq⟩,
  -- Take care of the n = 0 case
  rcases eq_or_ne n 0 with rfl | hn₀,
  { obtain ⟨q, hq', hq''⟩ := nat.exists_infinite_primes (p + 1),
    cases hq q ⟨hq'', by simp⟩,
    simpa using hq' },
  -- So assume 0 < n
  refine ⟨p, n.factorization p, hp, hp.factorization_pos_of_dvd hn₀ hn, _⟩,
  simp only [and_imp] at hq,
  apply nat.dvd_antisymm (nat.pow_factorization_dvd _ _),
  -- We need to show n ∣ p ^ n.factorization p
  apply nat.dvd_of_factors_subperm hn₀,
  rw [hp.factors_pow, list.subperm_ext_iff],
  intros q hq',
  rw nat.mem_factors hn₀ at hq',
  cases hq _ hq'.1 hq'.2,
  simp,
end

lemma is_prime_pow_pow_iff {n k : ℕ} (hk : k ≠ 0) :
  is_prime_pow (n ^ k) ↔ is_prime_pow n :=
begin
  simp only [is_prime_pow_iff_unique_prime_dvd],
  apply exists_unique_congr,
  simp only [and.congr_right_iff],
  intros p hp,
  exact ⟨hp.dvd_of_dvd_pow, λ t, t.trans (dvd_pow_self _ hk)⟩,
end

lemma nat.coprime.is_prime_pow_dvd_mul {n a b : ℕ} (hab : nat.coprime a b) (hn : is_prime_pow n) :
  n ∣ a * b ↔ n ∣ a ∨ n ∣ b :=
begin
  rcases eq_or_ne a 0 with rfl | ha,
  { simp only [nat.coprime_zero_left] at hab,
    simp [hab, finset.filter_singleton, not_is_prime_pow_one] },
  rcases eq_or_ne b 0 with rfl | hb,
  { simp only [nat.coprime_zero_right] at hab,
    simp [hab, finset.filter_singleton, not_is_prime_pow_one] },
  refine ⟨_, λ h, or.elim h (λ i, i.trans (dvd_mul_right _ _)) (λ i, i.trans (dvd_mul_left _ _))⟩,
  obtain ⟨p, k, hp, hk, rfl⟩ := (is_prime_pow_nat_iff _).1 hn,
  simp only [hp.pow_dvd_iff_le_factorization (mul_ne_zero ha hb),
    nat.factorization_mul ha hb, hp.pow_dvd_iff_le_factorization ha,
    hp.pow_dvd_iff_le_factorization hb, pi.add_apply, finsupp.coe_add],
  have : a.factorization p = 0 ∨ b.factorization p = 0,
  { rw [←finsupp.not_mem_support_iff, ←finsupp.not_mem_support_iff, ←not_and_distrib,
      ←finset.mem_inter],
    exact λ t, nat.factorization_disjoint_of_coprime hab t },
  cases this;
  simp [this, imp_or_distrib],
end

lemma nat.mul_divisors_filter_prime_pow {a b : ℕ} (hab : a.coprime b) :
  (a * b).divisors.filter is_prime_pow = (a.divisors ∪ b.divisors).filter is_prime_pow :=
begin
  rcases eq_or_ne a 0 with rfl | ha,
  { simp only [nat.coprime_zero_left] at hab,
    simp [hab, finset.filter_singleton, not_is_prime_pow_one] },
  rcases eq_or_ne b 0 with rfl | hb,
  { simp only [nat.coprime_zero_right] at hab,
    simp [hab, finset.filter_singleton, not_is_prime_pow_one] },
  ext n,
  simp only [ha, hb, finset.mem_union, finset.mem_filter, nat.mul_eq_zero, and_true, ne.def,
    and.congr_left_iff, not_false_iff, nat.mem_divisors, or_self],
  apply hab.is_prime_pow_dvd_mul,
end


/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/
import data.list.big_operators

/-!
# Counting in lists

This file proves basic properties of `list.countp` and `list.count`, which count the number of
elements of a list satisfying a predicate and equal to a given element respectively. Their
definitions can be found in [`data.list.defs`](./defs).
-/

open nat

variables {α β : Type*} {l l₁ l₂ : list α}

namespace list

section countp
variables (p : α → Prop) [decidable_pred p]

@[simp] lemma countp_nil : countp p [] = 0 := rfl

@[simp] lemma countp_cons_of_pos {a : α} (l) (pa : p a) : countp p (a::l) = countp p l + 1 :=
if_pos pa

@[simp] lemma countp_cons_of_neg {a : α} (l) (pa : ¬ p a) : countp p (a::l) = countp p l :=
if_neg pa

lemma countp_cons (a : α) (l) : countp p (a :: l) = countp p l + ite (p a) 1 0 :=
by { by_cases h : p a; simp [h] }

lemma length_eq_countp_add_countp (l) : length l = countp p l + countp (λ a, ¬p a) l :=
by induction l with x h ih; [refl, by_cases p x];
  [simp only [countp_cons_of_pos _ _ h, countp_cons_of_neg (λ a, ¬p a) _ (decidable.not_not.2 h),
    ih, length],
   simp only [countp_cons_of_pos (λ a, ¬p a) _ h, countp_cons_of_neg _ _ h, ih, length]]; ac_refl

lemma countp_eq_length_filter (l) : countp p l = length (filter p l) :=
by induction l with x l ih; [refl, by_cases (p x)];
  [simp only [filter_cons_of_pos _ h, countp, ih, if_pos h],
   simp only [countp_cons_of_neg _ _ h, ih, filter_cons_of_neg _ h]]; refl

lemma countp_le_length : countp p l ≤ l.length :=
by simpa only [countp_eq_length_filter] using length_le_of_sublist (filter_sublist _)

@[simp] lemma countp_append (l₁ l₂) : countp p (l₁ ++ l₂) = countp p l₁ + countp p l₂ :=
by simp only [countp_eq_length_filter, filter_append, length_append]

lemma countp_pos {l} : 0 < countp p l ↔ ∃ a ∈ l, p a :=
by simp only [countp_eq_length_filter, length_pos_iff_exists_mem, mem_filter, exists_prop]

theorem countp_eq_zero {l} : countp p l = 0 ↔ ∀ a ∈ l, ¬ p a :=
by { rw [← not_iff_not, ← ne.def, ← pos_iff_ne_zero, countp_pos], simp }

lemma countp_eq_length {l} : countp p l = l.length ↔ ∀ a ∈ l, p a :=
by rw [countp_eq_length_filter, filter_length_eq_length]

lemma length_filter_lt_length_iff_exists (l) : length (filter p l) < length l ↔ ∃ x ∈ l, ¬p x :=
by rw [length_eq_countp_add_countp p l, ← countp_pos, countp_eq_length_filter, lt_add_iff_pos_right]

lemma sublist.countp_le (s : l₁ <+ l₂) : countp p l₁ ≤ countp p l₂ :=
by simpa only [countp_eq_length_filter] using length_le_of_sublist (s.filter p)

@[simp] lemma countp_filter {q} [decidable_pred q] (l : list α) :
  countp p (filter q l) = countp (λ a, p a ∧ q a) l :=
by simp only [countp_eq_length_filter, filter_filter]

@[simp] lemma countp_true : l.countp (λ _, true) = l.length :=
by simp [countp_eq_length_filter]

@[simp] lemma countp_false : l.countp (λ _, false) = 0 :=
by simp [countp_eq_length_filter]

end countp

/-! ### count -/

section count
variables [decidable_eq α]

@[simp] lemma count_nil (a : α) : count a [] = 0 := rfl

lemma count_cons (a b : α) (l : list α) :
  count a (b :: l) = if a = b then succ (count a l) else count a l := rfl

lemma count_cons' (a b : α) (l : list α) :
  count a (b :: l) = count a l + (if a = b then 1 else 0) :=
begin rw count_cons, split_ifs; refl end

@[simp] lemma count_cons_self (a : α) (l : list α) : count a (a::l) = succ (count a l) := if_pos rfl

@[simp, priority 990]
lemma count_cons_of_ne {a b : α} (h : a ≠ b) (l : list α) : count a (b::l) = count a l := if_neg h

lemma count_tail : Π (l : list α) (a : α) (h : 0 < l.length),
  l.tail.count a = l.count a - ite (a = list.nth_le l 0 h) 1 0
| (_ :: _) a h := by { rw [count_cons], split_ifs; simp }

lemma count_le_length (a : α) (l : list α) : count a l ≤ l.length :=
countp_le_length _

lemma sublist.count_le (h : l₁ <+ l₂) (a : α) : count a l₁ ≤ count a l₂ := h.countp_le _

lemma count_le_count_cons (a b : α) (l : list α) : count a l ≤ count a (b :: l) :=
(sublist_cons _ _).count_le _

lemma count_singleton (a : α) : count a [a] = 1 := if_pos rfl

lemma count_singleton' (a b : α) : count a [b] = ite (a = b) 1 0 := rfl

@[simp] lemma count_append (a : α) : ∀ l₁ l₂, count a (l₁ ++ l₂) = count a l₁ + count a l₂ :=
countp_append _

lemma count_concat (a : α) (l : list α) : count a (concat l a) = succ (count a l) :=
by simp [-add_comm]

@[simp] lemma count_pos {a : α} {l : list α} : 0 < count a l ↔ a ∈ l :=
by simp only [count, countp_pos, exists_prop, exists_eq_right']

@[simp] lemma one_le_count_iff_mem {a : α} {l : list α} : 1 ≤ count a l ↔ a ∈ l :=
count_pos

@[simp, priority 980]
lemma count_eq_zero_of_not_mem {a : α} {l : list α} (h : a ∉ l) : count a l = 0 :=
decidable.by_contradiction $ λ h', h $ count_pos.1 (nat.pos_of_ne_zero h')

lemma not_mem_of_count_eq_zero {a : α} {l : list α} (h : count a l = 0) : a ∉ l :=
λ h', (count_pos.2 h').ne' h

lemma count_eq_zero {a : α} {l} : count a l = 0 ↔ a ∉ l :=
⟨not_mem_of_count_eq_zero, count_eq_zero_of_not_mem⟩

lemma count_eq_length {a : α} {l} : count a l = l.length ↔ ∀ b ∈ l, a = b :=
by rw [count, countp_eq_length]

@[simp] lemma count_repeat (a : α) (n : ℕ) : count a (repeat a n) = n :=
by rw [count, countp_eq_length_filter, filter_eq_self.2, length_repeat];
   exact λ b m, (eq_of_mem_repeat m).symm

lemma le_count_iff_repeat_sublist {a : α} {l : list α} {n : ℕ} :
  n ≤ count a l ↔ repeat a n <+ l :=
⟨λ h, ((repeat_sublist_repeat a).2 h).trans $
  have filter (eq a) l = repeat a (count a l), from eq_repeat.2
    ⟨by simp only [count, countp_eq_length_filter], λ b m, (of_mem_filter m).symm⟩,
  by rw ← this; apply filter_sublist,
 λ h, by simpa only [count_repeat] using h.count_le a⟩

lemma repeat_count_eq_of_count_eq_length  {a : α} {l : list α} (h : count a l = length l)  :
  repeat a (count a l) = l :=
eq_of_sublist_of_length_eq (le_count_iff_repeat_sublist.mp (le_refl (count a l)))
    (eq.trans (length_repeat a (count a l)) h)

@[simp] lemma count_filter {p} [decidable_pred p]
  {a} {l : list α} (h : p a) : count a (filter p l) = count a l :=
by simp only [count, countp_filter, show (λ b, a = b ∧ p b) = eq a, by { ext b, constructor; cc }]

lemma count_bind {α β} [decidable_eq β] (l : list α) (f : α → list β) (x : β)  :
  count x (l.bind f) = sum (map (count x ∘ f) l) :=
begin
  induction l with hd tl IH,
  { simp },
  { simpa }
end

@[simp] lemma count_map_of_injective {α β} [decidable_eq α] [decidable_eq β]
  (l : list α) (f : α → β) (hf : function.injective f) (x : α) :
  count (f x) (map f l) = count x l :=
begin
  induction l with y l IH generalizing x,
  { simp },
  { simp [map_cons, count_cons', IH, hf.eq_iff] }
end

lemma count_le_count_map [decidable_eq β] (l : list α) (f : α → β) (x : α) :
  count x l ≤ count (f x) (map f l) :=
begin
  induction l with a as IH, { simp },
  rcases eq_or_ne x a with rfl | hxa,
  { simp [succ_le_succ IH] },
  { simp [hxa, le_add_right IH, count_cons'] }
end

@[simp] lemma count_erase_self (a : α) :
  ∀ (s : list α), count a (list.erase s a) = pred (count a s)
| [] := by simp
| (h :: t) :=
begin
  rw erase_cons,
  by_cases p : h = a,
  { rw [if_pos p, count_cons', if_pos p.symm], simp },
  { rw [if_neg p, count_cons', count_cons', if_neg (λ x : a = h, p x.symm), count_erase_self],
    simp }
end

@[simp] lemma count_erase_of_ne {a b : α} (ab : a ≠ b) :
  ∀ (s : list α), count a (list.erase s b) = count a s
| [] := by simp
| (x :: xs) :=
begin
  rw erase_cons,
  split_ifs with h,
  { rw [count_cons', h, if_neg ab], simp },
  { rw [count_cons', count_cons', count_erase_of_ne] }
end

end count

end list


/-
Copyright (c) 2020 Ruben Van de Velde, Stanislas Polu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ruben Van de Velde, Stanislas Polu
-/

import data.real.basic
import analysis.normed_space.basic

/-- IMO 1972 B2

Problem: `f` and `g` are real-valued functions defined on the real line. For all `x` and `y`,
`f(x + y) + f(x - y) = 2f(x)g(y)`. `f` is not identically zero and `|f(x)| ≤ 1` for all `x`.
Prove that `|g(x)| ≤ 1` for all `x`.

This is a more concise version of the proof proposed by Ruben Van de Velde.
-/
theorem imo1972_p5_alt1 (f g : ℝ → ℝ)
  (hf1 : ∀ x, ∀ y, (f (x+y) + f(x-y)) = 2 * f(x) * g(y))
  (hf2 : bdd_above (set.range (λ x, ∥f x∥)))
  (hf3 : ∃ x, f(x) ≠ 0)
  (y : ℝ) :
  ∥g(y)∥ ≤ 1 :=
begin
  obtain ⟨x, hx⟩ := hf3,
  set k := ⨆ x, ∥f x∥,
  have h : ∀ x, ∥f x∥ ≤ k := le_csupr hf2,
  by_contra' H,
  have hgy : 0 < ∥g y∥,
    by linarith,
  have k_pos : 0 < k := lt_of_lt_of_le (norm_pos_iff.mpr hx) (h x),
  have : k / ∥g y∥ < k := (div_lt_iff hgy).mpr (lt_mul_of_one_lt_right k_pos H),
  have : k ≤ k / ∥g y∥,
  { suffices : ∀ x, ∥f x∥ ≤ k / ∥g y∥, from csupr_le this,
    intro x,
    suffices : 2 * (∥f x∥ * ∥g y∥) ≤ 2 * k,
      by { rwa [le_div_iff hgy, ←mul_le_mul_left zero_lt_two], apply_instance },
    calc 2 * (∥f x∥ * ∥g y∥)
        = ∥2 * f x * g y∥           : by simp [abs_mul, mul_assoc]
    ... = ∥f (x + y) + f (x - y)∥   : by rw hf1
    ... ≤ ∥f (x + y)∥ + ∥f (x - y)∥ : abs_add _ _
    ... ≤ 2 * k                     : by linarith [h (x+y), h (x -y)] },
  linarith,
end


-- ---------------------------------------------------------------------
-- Ejercicio. Importar las siguientes librerías
-- + tactic (con las tácticas)
-- + data.set.basic (con la teoría básica de conjuntos)
-- + data.set.lattice (con las uniones e intersecciones infinitas).
-- ---------------------------------------------------------------------

import tactic
import data.set.basic
import data.set.lattice

-- =====================================================================
-- § Introducción                                                     --
-- =====================================================================

-- Nota. Si `X` es un tipo, entonces `set X` es el tipo de los
-- subconjuntos de `X`.

-- Nota. Si `X` es un tipo, entonces
-- + `a : X`  significa que `a` es un término de tipo `X`
-- + `S : set X`  significa que `S` es un conjunto de términos de tipo `X`.

-- Nota: Si `S : set X` y `a : X`, entonces existe un predicado `a ∈ S`
-- que significa que `a` pertenece al subconjunto `S` de `X`.

-- =====================================================================
-- § Implementaciones                                                 --
-- =====================================================================

-- Nota: Si `S : set X`, entonces `S` es una función de `X` a `Prop`. La
-- idea es que un subconjunto `S` de `X` se representa como una función a
-- `{true, false}` que aplica los elementos de `S` a `true` y los
-- restantes a `false`.

-- Nota: La definición del tipo de los subconjuntos es `set X := X → Prop`

-- Nota: Si `S : set X`, entonces `a ∈ S` significa `S a`.

-- =====================================================================
-- § Notación                                                         --
-- =====================================================================

-- Nota: En lo que sigue, `X` e `Y` son tipos.

-- Nota: Cada tipo tiene un conjunto vacío denotado por `∅ : set X`

-- Nota: Cada tipo tiene un conjunto universal denotado por
-- `set.univ : set X` (o simplemente `univ : set X` si previamente se ha
-- escrito `open set`).

-- Nota: Si `S : set X` entonces su complementario es `Sᶜ : set X`.

-- Nota: En lo que sigue, `f : X → Y`.

-- Nota: Si `S : set X`, entonces `f '' S : set Y` es la imagen de `S`
-- por `f`.

-- Nota: Si `T : set Y`, entonces `f ⁻¹' T : set X` es la preimagen de
-- `T` por `f`.

-- Nota: El rango de f es `range f` (que es igual a `f '' univ`).

-- Nota: La definición de subconjunto es:
--    subset_def : S ⊆ T ↔ ∀ x, x ∈ S → x ∈ T

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar las siguientes variables:
-- + X, Y, Z sobre tipos.
-- + f sobre funciones de X en Y.
-- + g sobre funciones de Y en Z.
-- + S sobre el tipo de subconjuntos de X.
-- + T sobre el tipo de subconjuntos de Z.
-- + y sobre elementos de Y.
-- ---------------------------------------------------------------------

variables (X Y Z : Type)
variable  (f : X → Y)
variable  (g : Y → Z)
variable  (S : set X)
variable  (T : set Z)
variable  (y : Y)

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombre set (de los conjuntos).
-- ---------------------------------------------------------------------

open set

-- =====================================================================
-- § Imagen                                                           --
-- =====================================================================

-- Nota. La imagen de un conjunto mediante una función está definida en
-- pfun.lean por
--    image_def (s : set α) :
--      image f s = {y | ∃ x ∈ s, y ∈ f x}

-- Nota. La imagen, mediante f, de S se representa por
--    f '' S

-- Nota. la pertenencia a la imagen está caracterizada en basic.lean por
--    mem_image (f : α → β) (s : set α) (y : β) :
--      y ∈ f '' s ↔ ∃ x, x ∈ s ∧ f x = y

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la imagen de cualquier conjunto S por la
-- función identidad es S.
-- ---------------------------------------------------------------------

-- 1ª demostración
lemma image_identity :
  id '' S = S :=
begin
  ext x,
  split,
  { intro h,
    rw mem_image at h,
    cases h with y hy,
    cases hy with hyS hid,
    rw id.def at hid,
    rw ← hid,
    exact hyS },
  { intro hxS,
    rw mem_image,
    use x,
    split,
    { exact hxS, },
    { rw id.def, } }
end

-- 2ª demostración
example :
  id '' S = S :=
begin
  ext x,
  split,
  { intro h,
    rcases h with ⟨y, hyS, hid⟩,
    rw ← hid,
    exact hyS, },
  { intro hxS,
    use x,
    use hxS,
    refl, }
end

-- 3ª demostración
example :
  id '' S = S :=
begin
  ext x,
  split,
  { rintro ⟨y, hyS, hid⟩,
    rw ← hid,
    exact hyS, },
  { intro hxS,
    use [x, hxS],
    refl, }
end

-- 4ª demostración
example :
  id '' S = S :=
begin
  ext x,
  split,
  { rintro ⟨y, hyS, rfl⟩,
    exact hyS, },
  { intro hxS,
    exact ⟨x, hxS, rfl⟩ },
end

-- 5ª demostración
example :
  id '' S = S :=
-- by library_search [- image_identity]
image_id S

-- 6ª demostración
example :
  id '' S = S :=
by simp

-- 7ª demostración
example :
  id '' S = S :=
by finish

-- 8ª demostración
example :
  id '' S = S :=
by tidy

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (g ∘ f) '' S = g '' (f '' S)
-- ---------------------------------------------------------------------

-- 1ª demostración
example :
  (g ∘ f) '' S = g '' (f '' S) :=
begin
  ext z,
  split,
  { intro h,
    rw mem_image at *,
    cases h with x hx,
    use f x,
    split,
    { rw mem_image,
      use x,
      split,
      { exact hx.left, },
      { refl, } },
    { exact hx.right, }},
  { intro h,
    rw mem_image at *,
    cases h with x hx,
    rw mem_image at hx,
    cases hx.left with a ha,
    use a,
    split,
    { exact ha.left, },
    { dsimp,
      rw ha.2,
      rw hx.2, }},
end

-- 2ª demostración
example :
  (g ∘ f) '' S = g '' (f '' S) :=
begin
  ext z,
  split,
  { intro h,
    rw mem_image at *,
    rcases h with ⟨x, hxS, h_gfx⟩,
    use f x,
    split,
    { rw mem_image,
      use x,
      use hxS,},
    { exact h_gfx, }},
  { intro h,
    rw mem_image at *,
    rcases h with ⟨x, hxf, hxg⟩,
    rw mem_image at hxf,
    rcases hxf with ⟨a, haS, haf⟩,
    use a,
    split,
    { exact haS, },
    { dsimp,
      rw haf,
      exact hxg, }},
end

-- 3ª demostración
example :
  (g ∘ f) '' S = g '' (f '' S) :=
begin
  ext z,
  split,
  { intro h,
    rcases h with ⟨x, hxS, h_gfx⟩,
    use f x,
    split,
    { use x,
      use hxS,},
    { exact h_gfx, }},
  { intro h,
    rcases h with ⟨x, hxf, hxg⟩,
    rcases hxf with ⟨a, haS, haf⟩,
    use a,
    split,
    { exact haS, },
    { dsimp,
      rw haf,
      exact hxg, }},
end

-- 4ª demostración
example :
  (g ∘ f) '' S = g '' (f '' S) :=
begin
  ext z,
  split,
  { intro h,
    rcases h with ⟨x, hxS, h_gfx⟩,
    use f x,
    split,
    { use [x, hxS],},
    { exact h_gfx, }},
  { intro h,
    rcases h with ⟨x, hxf, hxg⟩,
    rcases hxf with ⟨a, haS, haf⟩,
    use a,
    split,
    { exact haS, },
    { dsimp,
      rw haf,
      exact hxg, }},
end

-- 5ª demostración
example :
  (g ∘ f) '' S = g '' (f '' S) :=
begin
  ext z,
  split,
  { intro h,
    rcases h with ⟨x, hxS, h_gfx⟩,
    use f x,
    { use [x, hxS, h_gfx], }},
  { intro h,
    rcases h with ⟨x, hxf, hxg⟩,
    rcases hxf with ⟨a, haS, haf⟩,
    use a,
    split,
    { exact haS, },
    { dsimp,
      rw haf,
      exact hxg, }},
end

-- 6ª demostración
example :
  (g ∘ f) '' S = g '' (f '' S) :=
begin
  ext z,
  split,
  { intro h,
    rcases h with ⟨x, hxS, h_gfx⟩,
    use [f x, x, hxS, h_gfx], },
  { intro h,
    rcases h with ⟨x, hxf, hxg⟩,
    rcases hxf with ⟨a, haS, haf⟩,
    use a,
    split,
    { exact haS, },
    { dsimp,
      rw haf,
      exact hxg, }},
end

-- 7ª demostración
lemma image_comp :
  (g ∘ f) '' S = g '' (f '' S) :=
begin
  ext z,
  split,
  { rintro ⟨x, hxS, h_gfx⟩,
    use [f x, x, hxS, h_gfx] },
  { rintro ⟨y, ⟨x, hxS, rfl⟩, rfl⟩,
    exact ⟨x, hxS, rfl⟩ }
end

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombre function (de las funciones).
-- ---------------------------------------------------------------------

open function

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es inyectiva, entonces la función que
-- le asigna a cada conjunto su imagen por f también es inyectiva.
-- ---------------------------------------------------------------------

lemma image_injective :
  injective f → injective (λ S, f '' S) :=
begin
  intro hf,
  intros S T h,
  dsimp at h,
  ext x,
  suffices : ∀ S T : set X, f '' S = f '' T → x ∈ S → x ∈ T,
  { split,
    { apply this _ _ h, },
    { apply this _ _ h.symm, }},
  { clear h S T,
    intros S T h hxS,
    have hfx : f x ∈ f '' T,
    { rw ← h,
      use [x, hxS] },
    { rcases hfx with ⟨y, hyT, hfy⟩,
      convert hyT,
      apply hf,
      exact hfy.symm, }},
end

-- =====================================================================
-- § Imagen inversa                                                   --
-- =====================================================================

-- Nota. La imagen de un conjunto mediante una función está definida en
-- pfun.lean por
--    preimage_def (s : set β) :
--      preimage f s = {x | ∃ y ∈ s, y ∈ f x}

-- Nota. La imagen inversa, mediante f, de S se representa por
--    f ⁻¹' S

-- Nota. La pertenencia a la imagen está caracterizada en basic.lean por
--    mem_preimage {s : set β} {a : α} :
--      (a ∈ f ⁻¹' s) ↔ (f a ∈ s)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la imagen inversa de cualquier conjunto por
-- la identidad es él mismo.
-- ---------------------------------------------------------------------

example :
  S = id ⁻¹' S :=
begin
  refl,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (g ∘ f) ⁻¹' T = f ⁻¹' (g ⁻¹' T)
-- ---------------------------------------------------------------------

example :
  (g ∘ f) ⁻¹' T = f ⁻¹' (g ⁻¹' T) :=
begin
  refl,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es suprayectiva, entonces la función
-- que asigna a cada conjunto su imagen inversa por f es inyectiva.
-- ---------------------------------------------------------------------

lemma preimage_injective
  (hf : surjective f)
  : injective (λ T, f ⁻¹' T) :=
begin
  intros T U h,
  ext y,
  suffices : ∀ {T U}, f ⁻¹' T = f ⁻¹' U → y ∈ T → y ∈ U,
  { exact ⟨this h, this h.symm⟩ },
  { intros T U h hyT,
    rcases hf y with ⟨x, rfl⟩,
    rwa [← mem_preimage, ← h], },
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es suprayectiva, entonces la función
-- que le asigna a cada conjunto su imagen por f es suprayectiva.
-- ---------------------------------------------------------------------

lemma image_surjective
  (hf : surjective f)
  : surjective (λ S, f '' S) :=
begin
  intro T,
  use f ⁻¹' T,
  dsimp only,
  ext y,
  split,
  { rintro ⟨x, hx, rfl⟩,
    exact hx },
  { intro hyT,
    rcases hf y with ⟨x, rfl⟩,
    use [x, hyT] }
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si f es inyectiva, entonces la función que a
-- cada conjunto le asigna su imagen inversa por S es suprayectiva.

lemma preimage_surjective
  (hf : injective f)
  : surjective (λ S, f ⁻¹' S) :=
begin
  intro S,
  use f '' S,
  ext x,
  split,
  { rintro ⟨y, hyS, h⟩,
    rwa ← (hf h) },
  { intro h,
    use [x, h, rfl] }
end

-- =====================================================================
-- § Unión general                                                    --
-- =====================================================================

-- Nota. La unión de una familia de conjuntos está definida (en
-- lattice.lean) como su supremo
--    def Union (s : ι → set β) : set β := supr s

-- Nota. Sea `(ι : Type)` y `(F : ι → set X)`, la unión de la familia de
-- conjuntos `F` se representa por `⋃ (i : ι), F i`.

-- Nota. La caracterización de la pertenencia a la unión de una familia
-- es
--    mem_Union {x : β} {s : ι → set β} :
--       x ∈ Union s ↔ ∃ i, x ∈ s i
-- o bien
--    mem_Union {x : β} {F : ι → set β} :
--       (x ∈ ⋃ (i : ι), F i) ↔ ∃ j : ι, x ∈ F j

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar
-- + ι una variable sobre tipos
-- + F una variable para las familias de subconjuntos de X con índice ι
-- + x una varible sobre términos de tipo X.
-- ---------------------------------------------------------------------

variable (ι : Type)
variable (F : ι → set X)
variable (x : X)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la imagen de la unión de una familia es
-- igual a la unión de las imágenes de cada elemento de la familia.
-- ---------------------------------------------------------------------

lemma image_Union  :
  f '' (⋃ (i : ι), F i) = ⋃ (i : ι), f '' (F i) :=
begin
  ext y,
  split,
  { rintro ⟨x, hxF, rfl⟩,
    rw mem_Union at *,
    cases hxF with i hi,
    use [i, x, hi] },
  { intro h,
    rw mem_Union at h,
    rcases h with ⟨i, x, hxi, rfl⟩,
    use x,
    rw mem_Union,
    use i,
    assumption }
end

-- =====================================================================
-- § Unión general acotada                                            --
-- =====================================================================

-- Nota. Si `F : ι → set X` y `J : set ι`, entonces `⋃ (i ∈ J), F i` es
-- la unión general acotada y sus elementos se caracterizan por
--    mem_bUnion_iff : (x ∈ ⋃ (i ∈ J), F i) ↔ ∃ (j ∈ J), x ∈ F j

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    f ⁻¹' (⋃ (i ∈ Z), F i) = ⋃ (i ∈ Z), f ⁻¹' (F i)
-- ---------------------------------------------------------------------

lemma preimage_bUnion
  (F : ι → set Y)
  (Z : set ι)
  : f ⁻¹' (⋃ (i ∈ Z), F i) = ⋃ (i ∈ Z), f ⁻¹' (F i) :=
begin
  ext y,
  rw [mem_preimage, mem_bUnion_iff, mem_bUnion_iff],
  refl,
end


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import data.real.basic
import data.real.sqrt
import data.real.nnreal
import tactic.linear_combination

/-!
# IMO 2008 Q4
Find all functions `f : (0,∞) → (0,∞)` (so, `f` is a function from the positive real
numbers to the positive real numbers) such that
      ```
      (f(w)^2 + f(x)^2)/(f(y^2) + f(z^2)) = (w^2 + x^2)/(y^2 + z^2)
      ```
for all positive real numbers `w`, `x`, `y`, `z`, satisfying `wx = yz`.

# Solution
The desired theorem is that either `f = λ x, x` or `f = λ x, 1/x`
-/

open real

lemma abs_eq_one_of_pow_eq_one (x : ℝ) (n : ℕ) (hn : n ≠ 0) (h : x ^ n = 1) : |x| = 1 :=
by rw [← pow_left_inj (abs_nonneg x) zero_le_one (pos_iff_ne_zero.2 hn), one_pow, pow_abs, h,
  abs_one]

theorem imo2008_q4
  (f : ℝ → ℝ)
  (H₁ : ∀ x > 0, f(x) > 0) :
  (∀ w x y z : ℝ, 0 < w → 0 < x → 0 < y → 0 < z → w * x = y * z →
    (f(w) ^ 2 + f(x) ^ 2) / (f(y ^ 2) + f(z ^ 2)) = (w ^ 2 + x ^ 2) / (y ^ 2 + z ^ 2)) ↔
  ((∀ x > 0, f(x) = x) ∨ (∀ x > 0, f(x) = 1 / x)) :=
begin
  split, swap,
  -- proof that f(x) = x and f(x) = 1/x satisfy the condition
  { rintros (h | h),
    { intros w x y z hw hx hy hz hprod,
      rw [h w hw, h x hx, h (y ^ 2) (pow_pos hy 2), h (z ^ 2) (pow_pos hz 2)] },
    { intros w x y z hw hx hy hz hprod,
      rw [h w hw, h x hx, h (y ^ 2) (pow_pos hy 2), h (z ^ 2) (pow_pos hz 2)],
      have hy2z2 : y ^ 2 + z ^ 2 ≠ 0 := ne_of_gt (add_pos (pow_pos hy 2) (pow_pos hz 2)),
      have hz2y2 : z ^ 2 + y ^ 2 ≠ 0 := ne_of_gt (add_pos (pow_pos hz 2) (pow_pos hy 2)),
      have hp2 : w ^ 2 * x ^ 2 = y ^ 2 * z ^ 2,
      { linear_combination (hprod, w * x + y * z) },
      field_simp [ne_of_gt hw, ne_of_gt hx, ne_of_gt hy, ne_of_gt hz, hy2z2, hz2y2, hp2],
      ring } },

  -- proof that the only solutions are f(x) = x or f(x) = 1/x
  intro H₂,
  have h₀ : f(1) ≠ 0, { specialize H₁ 1 zero_lt_one, exact ne_of_gt H₁ },

  have h₁ : f(1) = 1,
  { specialize H₂ 1 1 1 1 zero_lt_one zero_lt_one zero_lt_one zero_lt_one rfl,
    norm_num [← two_mul] at H₂,
    rw mul_div_mul_left (f(1) ^ 2) (f 1) two_ne_zero at H₂,
    rwa ← (div_eq_iff h₀).mpr (sq (f 1)) },

  have h₂ : ∀ x > 0, (f(x) - x) * (f(x) - 1 / x) = 0,
  { intros x hx,
    have h1xss : 1 * x = (sqrt x) * (sqrt x), { rw [one_mul, mul_self_sqrt (le_of_lt hx)] },
    specialize H₂ 1 x (sqrt x) (sqrt x) zero_lt_one hx (sqrt_pos.mpr hx) (sqrt_pos.mpr hx) h1xss,
    rw [h₁, one_pow 2, sq_sqrt (le_of_lt hx), ← two_mul (f(x)), ← two_mul x] at H₂,
    have hx_ne_0 : x ≠ 0 := ne_of_gt hx,
    have hfx_ne_0 : f(x) ≠ 0, { specialize H₁ x hx, exact ne_of_gt H₁ },
    field_simp at H₂ ⊢,
    linear_combination (H₂, 1/2) },

  have h₃ : ∀ x > 0, f(x) = x ∨ f(x) = 1 / x, { simpa [sub_eq_zero] using h₂ },

  by_contra' h,
  rcases h with ⟨⟨b, hb, hfb₁⟩, ⟨a, ha, hfa₁⟩⟩,
  obtain hfa₂ := or.resolve_right (h₃ a ha) hfa₁, -- f(a) ≠ 1/a, f(a) = a
  obtain hfb₂ := or.resolve_left (h₃ b hb) hfb₁,  -- f(b) ≠ b, f(b) = 1/b

  have hab : a * b > 0 := mul_pos ha hb,
  have habss : a * b = sqrt(a * b) * sqrt(a * b) := (mul_self_sqrt (le_of_lt hab)).symm,

  specialize H₂ a b (sqrt (a * b)) (sqrt (a * b)) ha hb (sqrt_pos.mpr hab) (sqrt_pos.mpr hab) habss,
  rw [sq_sqrt (le_of_lt hab), ← two_mul (f(a * b)), ← two_mul (a * b)] at H₂,
  rw [hfa₂, hfb₂] at H₂,

  have h2ab_ne_0 : 2 * (a * b) ≠ 0 := mul_ne_zero two_ne_zero (ne_of_gt hab),

  specialize h₃ (a * b) hab,
  cases h₃ with hab₁ hab₂,

  -- f(ab) = ab → b^4 = 1 → b = 1 → f(b) = b → false
  { field_simp [hab₁] at H₂,
    field_simp [ne_of_gt hb] at H₂,
    have hb₁ : b ^ 4 = 1 := by linear_combination (H₂, -1),
    obtain hb₂ := abs_eq_one_of_pow_eq_one b 4 (show 4 ≠ 0, by norm_num) hb₁,
    rw abs_of_pos hb at hb₂, rw hb₂ at hfb₁, exact hfb₁ h₁ },

  -- f(ab) = 1/ab → a^4 = 1 → a = 1 → f(a) = 1/a → false
  { have hb_ne_0 : b ≠ 0 := ne_of_gt hb,
    field_simp [hab₂] at H₂,
    have H₃ : 2 * b ^ 4 * (a ^ 4 - 1) = 0 := by linear_combination H₂,
    have h2b4_ne_0 : 2 * (b ^ 4) ≠ 0 := mul_ne_zero two_ne_zero (pow_ne_zero 4 hb_ne_0),
    have ha₁ : a ^ 4 = 1, { simpa [sub_eq_zero, h2b4_ne_0] using H₃ },
    obtain ha₂ := abs_eq_one_of_pow_eq_one a 4 (show 4 ≠ 0, by norm_num) ha₁,
    rw abs_of_pos ha at ha₂, rw ha₂ at hfa₁, norm_num at hfa₁ },
end


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import data.polynomial.erase_lead
import data.polynomial.eval

/-!
# Denominators of evaluation of polynomials at ratios

Let `i : R → K` be a homomorphism of semirings.  Assume that `K` is commutative.  If `a` and
`b` are elements of `R` such that `i b ∈ K` is invertible, then for any polynomial
`f ∈ polynomial R` the "mathematical" expression `b ^ f.nat_degree * f (a / b) ∈ K` is in
the image of the homomorphism `i`.
-/

open polynomial finset

section denoms_clearable

variables {R K : Type*} [semiring R] [comm_semiring K] {i : R →+* K}
variables {a b : R} {bi : K}
-- TODO: use hypothesis (ub : is_unit (i b)) to work with localizations.

/-- `denoms_clearable` formalizes the property that `b ^ N * f (a / b)`
does not have denominators, if the inequality `f.nat_degree ≤ N` holds.

The definition asserts the existence of an element `D` of `R` and an
element `bi = 1 / i b` of `K` such that clearing the denominators of
the fraction equals `i D`.
-/
def denoms_clearable (a b : R) (N : ℕ) (f : polynomial R) (i : R →+* K) : Prop :=
  ∃ (D : R) (bi : K), bi * i b = 1 ∧ i D = i b ^ N * eval (i a * bi) (f.map i)

lemma denoms_clearable_zero (N : ℕ) (a : R) (bu : bi * i b = 1) :
  denoms_clearable a b N 0 i :=
⟨0, bi, bu, by simp only [eval_zero, ring_hom.map_zero, mul_zero, polynomial.map_zero]⟩

lemma denoms_clearable_C_mul_X_pow {N : ℕ} (a : R) (bu : bi * i b = 1) {n : ℕ} (r : R)
  (nN : n ≤ N) : denoms_clearable a b N (C r * X ^ n) i :=
begin
  refine ⟨r * a ^ n * b ^ (N - n), bi, bu, _⟩,
  rw [C_mul_X_pow_eq_monomial, map_monomial, ← C_mul_X_pow_eq_monomial, eval_mul, eval_pow, eval_C],
  rw [ring_hom.map_mul, ring_hom.map_mul, ring_hom.map_pow, ring_hom.map_pow, eval_X, mul_comm],
  rw [← tsub_add_cancel_of_le nN] {occs := occurrences.pos [2]},
  rw [pow_add, mul_assoc, mul_comm (i b ^ n), mul_pow, mul_assoc, mul_assoc (i a ^ n), ← mul_pow],
  rw [bu, one_pow, mul_one],
end

lemma denoms_clearable.add {N : ℕ} {f g : polynomial R} :
  denoms_clearable a b N f i → denoms_clearable a b N g i → denoms_clearable a b N (f + g) i :=
λ ⟨Df, bf, bfu, Hf⟩ ⟨Dg, bg, bgu, Hg⟩, ⟨Df + Dg, bf, bfu,
  begin
    rw [ring_hom.map_add, polynomial.map_add, eval_add, mul_add, Hf, Hg],
    congr,
    refine @inv_unique K _ (i b) bg bf _ _;
    rwa mul_comm,
  end ⟩

lemma denoms_clearable_of_nat_degree_le (N : ℕ) (a : R) (bu : bi * i b = 1) :
  ∀ (f : polynomial R), f.nat_degree ≤ N → denoms_clearable a b N f i :=
induction_with_nat_degree_le N
  (denoms_clearable_zero N a bu)
  (λ N_1 r r0, denoms_clearable_C_mul_X_pow a bu r)
  (λ f g fN gN df dg, df.add dg)

/-- If `i : R → K` is a ring homomorphism, `f` is a polynomial with coefficients in `R`,
`a, b` are elements of `R`, with `i b` invertible, then there is a `D ∈ R` such that
`b ^ f.nat_degree * f (a / b)` equals `i D`. -/
theorem denoms_clearable_nat_degree
  (i : R →+* K) (f : polynomial R) (a : R) (bu : bi * i b = 1) :
  denoms_clearable a b f.nat_degree f i :=
denoms_clearable_of_nat_degree_le f.nat_degree a bu f le_rfl

end denoms_clearable

open ring_hom

/--  Evaluating a polynomial with integer coefficients at a rational number and clearing
denominators, yields a number greater than or equal to one.  The target can be any
`linear_ordered_field K`.
The assumption on `K` could be weakened to `linear_ordered_comm_ring` assuming that the
image of the denominator is invertible in `K`. -/
lemma one_le_pow_mul_abs_eval_div {K : Type*} [linear_ordered_field K] {f : polynomial ℤ}
  {a b : ℤ} (b0 : 0 < b) (fab : eval ((a : K) / b) (f.map (algebra_map ℤ K)) ≠ 0) :
  (1 : K) ≤ b ^ f.nat_degree * |eval ((a : K) / b) (f.map (algebra_map ℤ K))| :=
begin
  obtain ⟨ev, bi, bu, hF⟩ := @denoms_clearable_nat_degree _ _ _ _ b _ (algebra_map ℤ K)
    f a (by { rw [eq_int_cast, one_div_mul_cancel], rw [int.cast_ne_zero], exact (b0.ne.symm) }),
  obtain Fa := congr_arg abs hF,
  rw [eq_one_div_of_mul_eq_one_left bu, eq_int_cast, eq_int_cast, abs_mul] at Fa,
  rw [abs_of_pos (pow_pos (int.cast_pos.mpr b0) _ : 0 < (b : K) ^ _), one_div, eq_int_cast] at Fa,
  rw [div_eq_mul_inv, ← Fa, ← int.cast_abs, ← int.cast_one, int.cast_le],
  refine int.le_of_lt_add_one ((lt_add_iff_pos_left 1).mpr (abs_pos.mpr (λ F0, fab _))),
  rw [eq_one_div_of_mul_eq_one_left bu, F0, one_div, eq_int_cast, int.cast_zero, zero_eq_mul] at hF,
  cases hF with hF hF,
  { exact (not_le.mpr b0 (le_of_eq (int.cast_eq_zero.mp (pow_eq_zero hF)))).elim },
  { rwa div_eq_mul_inv }
end


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin

! This file was ported from Lean 3 source module topology.locally_constant.algebra
! leanprover-community/mathlib commit bcfa726826abd57587355b4b5b7e78ad6527b7e4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Pi
import Mathlib.Topology.LocallyConstant.Basic

/-!
# Algebraic structure on locally constant functions

This file puts algebraic structure (`Group`, `AddGroup`, etc)
on the type of locally constant functions.

-/

namespace LocallyConstant

variable {X Y : Type _} [TopologicalSpace X]

@[to_additive]
instance [One Y] : One (LocallyConstant X Y) where one := const X 1

@[to_additive (attr := simp)]
theorem coe_one [One Y] : ⇑(1 : LocallyConstant X Y) = (1 : X → Y) :=
  rfl
#align locally_constant.coe_one LocallyConstant.coe_one
#align locally_constant.coe_zero LocallyConstant.coe_zero

@[to_additive]
theorem one_apply [One Y] (x : X) : (1 : LocallyConstant X Y) x = 1 :=
  rfl
#align locally_constant.one_apply LocallyConstant.one_apply
#align locally_constant.zero_apply LocallyConstant.zero_apply

@[to_additive]
instance [Inv Y] : Inv (LocallyConstant X Y) where inv f := ⟨f⁻¹, f.isLocallyConstant.inv⟩

@[to_additive (attr := simp)]
theorem coe_inv [Inv Y] (f : LocallyConstant X Y) : ⇑(f⁻¹ : LocallyConstant X Y) = (f : X → Y)⁻¹ :=
  rfl
#align locally_constant.coe_inv LocallyConstant.coe_inv
#align locally_constant.coe_neg LocallyConstant.coe_neg

@[to_additive]
theorem inv_apply [Inv Y] (f : LocallyConstant X Y) (x : X) : f⁻¹ x = (f x)⁻¹ :=
  rfl
#align locally_constant.inv_apply LocallyConstant.inv_apply
#align locally_constant.neg_apply LocallyConstant.neg_apply

@[to_additive]
instance [Mul Y] : Mul (LocallyConstant X Y) where
  mul f g := ⟨f * g, f.isLocallyConstant.mul g.isLocallyConstant⟩

@[to_additive (attr := simp)]
theorem coe_mul [Mul Y] (f g : LocallyConstant X Y) : ⇑(f * g) = f * g :=
  rfl
#align locally_constant.coe_mul LocallyConstant.coe_mul
#align locally_constant.coe_add LocallyConstant.coe_add

@[to_additive]
theorem mul_apply [Mul Y] (f g : LocallyConstant X Y) (x : X) : (f * g) x = f x * g x :=
  rfl
#align locally_constant.mul_apply LocallyConstant.mul_apply
#align locally_constant.add_apply LocallyConstant.add_apply

@[to_additive]
instance [MulOneClass Y] : MulOneClass (LocallyConstant X Y) :=
  Function.Injective.mulOneClass FunLike.coe FunLike.coe_injective' rfl fun _ _ => rfl

/-- `FunLike.coe` is a `MonoidHom`. -/
@[to_additive (attr := simps) "`FunLike.coe` is an `AddMonoidHom`."]
def coeFnMonoidHom [MulOneClass Y] : LocallyConstant X Y →* X → Y where
  toFun := FunLike.coe
  map_one' := rfl
  map_mul' _ _ := rfl
#align locally_constant.coe_fn_monoid_hom LocallyConstant.coeFnMonoidHom
#align locally_constant.coe_fn_add_monoid_hom LocallyConstant.coeFnAddMonoidHom

/-- The constant-function embedding, as a multiplicative monoid hom. -/
@[to_additive (attr := simps) "The constant-function embedding, as an additive monoid hom."]
def constMonoidHom [MulOneClass Y] : Y →* LocallyConstant X Y where
  toFun := const X
  map_one' := rfl
  map_mul' _ _ := rfl
#align locally_constant.const_monoid_hom LocallyConstant.constMonoidHom
#align locally_constant.const_add_monoid_hom LocallyConstant.constAddMonoidHom

instance [MulZeroClass Y] : MulZeroClass (LocallyConstant X Y) :=
  Function.Injective.mulZeroClass FunLike.coe FunLike.coe_injective' rfl fun _ _ => rfl

instance [MulZeroOneClass Y] : MulZeroOneClass (LocallyConstant X Y) :=
  Function.Injective.mulZeroOneClass FunLike.coe FunLike.coe_injective' rfl rfl fun _ _ => rfl

section CharFn

variable (Y) [MulZeroOneClass Y] {U V : Set X}

/-- Characteristic functions are locally constant functions taking `x : X` to `1` if `x ∈ U`,
  where `U` is a clopen set, and `0` otherwise. -/
noncomputable def charFn (hU : IsClopen U) : LocallyConstant X Y :=
  indicator 1 hU
#align locally_constant.char_fn LocallyConstant.charFn

theorem coe_charFn (hU : IsClopen U) : (charFn Y hU : X → Y) = Set.indicator U 1 :=
  rfl
#align locally_constant.coe_char_fn LocallyConstant.coe_charFn

theorem charFn_eq_one [Nontrivial Y] (x : X) (hU : IsClopen U) : charFn Y hU x = (1 : Y) ↔ x ∈ U :=
  Set.indicator_eq_one_iff_mem _
#align locally_constant.char_fn_eq_one LocallyConstant.charFn_eq_one

theorem charFn_eq_zero [Nontrivial Y] (x : X) (hU : IsClopen U) : charFn Y hU x = (0 : Y) ↔ x ∉ U :=
  Set.indicator_eq_zero_iff_not_mem _
#align locally_constant.char_fn_eq_zero LocallyConstant.charFn_eq_zero

theorem charFn_inj [Nontrivial Y] (hU : IsClopen U) (hV : IsClopen V)
    (h : charFn Y hU = charFn Y hV) : U = V :=
  Set.indicator_one_inj Y <| coe_inj.mpr h
#align locally_constant.char_fn_inj LocallyConstant.charFn_inj

end CharFn

@[to_additive]
instance [Div Y] : Div (LocallyConstant X Y) where
  div f g := ⟨f / g, f.isLocallyConstant.div g.isLocallyConstant⟩

@[to_additive]
theorem coe_div [Div Y] (f g : LocallyConstant X Y) : ⇑(f / g) = f / g :=
  rfl
#align locally_constant.coe_div LocallyConstant.coe_div
#align locally_constant.coe_sub LocallyConstant.coe_sub

@[to_additive]
theorem div_apply [Div Y] (f g : LocallyConstant X Y) (x : X) : (f / g) x = f x / g x :=
  rfl
#align locally_constant.div_apply LocallyConstant.div_apply
#align locally_constant.sub_apply LocallyConstant.sub_apply

@[to_additive]
instance [Semigroup Y] : Semigroup (LocallyConstant X Y) :=
  Function.Injective.semigroup FunLike.coe FunLike.coe_injective' fun _ _ => rfl

instance [SemigroupWithZero Y] : SemigroupWithZero (LocallyConstant X Y) :=
  Function.Injective.semigroupWithZero FunLike.coe FunLike.coe_injective' rfl fun _ _ => rfl

@[to_additive]
instance [CommSemigroup Y] : CommSemigroup (LocallyConstant X Y) :=
  Function.Injective.commSemigroup FunLike.coe FunLike.coe_injective' fun _ _ => rfl

@[to_additive]
instance smul [SMul α Y] : SMul α (LocallyConstant X Y) where
  smul n f := f.map (n • ·)

@[to_additive (attr := simp)]
theorem coe_smul [SMul R Y] (r : R) (f : LocallyConstant X Y) : ⇑(r • f) = r • (f : X → Y) :=
  rfl
#align locally_constant.coe_smul LocallyConstant.coe_smul

@[to_additive]
theorem smul_apply [SMul R Y] (r : R) (f : LocallyConstant X Y) (x : X) : (r • f) x = r • f x :=
  rfl
#align locally_constant.smul_apply LocallyConstant.smul_apply

@[to_additive existing LocallyConstant.smul]
instance [Pow Y α] : Pow (LocallyConstant X Y) α where
  pow f n := f.map (· ^ n)

@[to_additive]
instance [Monoid Y] : Monoid (LocallyConstant X Y) :=
  Function.Injective.monoid FunLike.coe FunLike.coe_injective' rfl (fun _ _ => rfl) fun _ _ => rfl

instance [NatCast Y] : NatCast (LocallyConstant X Y) where
  natCast n := const X n

instance [IntCast Y] : IntCast (LocallyConstant X Y) where
  intCast n := const X n

instance [AddMonoidWithOne Y] : AddMonoidWithOne (LocallyConstant X Y) :=
  Function.Injective.addMonoidWithOne FunLike.coe FunLike.coe_injective' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) fun _ => rfl

@[to_additive]
instance [CommMonoid Y] : CommMonoid (LocallyConstant X Y) :=
  Function.Injective.commMonoid FunLike.coe FunLike.coe_injective' rfl (fun _ _ => rfl)
    fun _ _ => rfl

@[to_additive]
instance [Group Y] : Group (LocallyConstant X Y) :=
  Function.Injective.group FunLike.coe FunLike.coe_injective' rfl (fun _ _ => rfl)
    (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)

@[to_additive]
instance [CommGroup Y] : CommGroup (LocallyConstant X Y) :=
  Function.Injective.commGroup FunLike.coe FunLike.coe_injective' rfl (fun _ _ => rfl)
    (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)

instance [Distrib Y] : Distrib (LocallyConstant X Y) :=
  Function.Injective.distrib FunLike.coe FunLike.coe_injective' (fun _ _ => rfl) fun _ _ => rfl

instance [NonUnitalNonAssocSemiring Y] : NonUnitalNonAssocSemiring (LocallyConstant X Y) :=
  Function.Injective.nonUnitalNonAssocSemiring FunLike.coe FunLike.coe_injective' rfl
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)

instance [NonUnitalSemiring Y] : NonUnitalSemiring (LocallyConstant X Y) :=
  Function.Injective.nonUnitalSemiring FunLike.coe FunLike.coe_injective' rfl
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)

instance [NonAssocSemiring Y] : NonAssocSemiring (LocallyConstant X Y) :=
  Function.Injective.nonAssocSemiring FunLike.coe FunLike.coe_injective' rfl rfl
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl

/-- The constant-function embedding, as a ring hom.  -/
@[simps]
def constRingHom [NonAssocSemiring Y] : Y →+* LocallyConstant X Y :=
  { constMonoidHom, constAddMonoidHom with toFun := const X }
#align locally_constant.const_ring_hom LocallyConstant.constRingHom

instance [Semiring Y] : Semiring (LocallyConstant X Y) :=
  Function.Injective.semiring FunLike.coe FunLike.coe_injective' rfl rfl
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl

instance [NonUnitalCommSemiring Y] : NonUnitalCommSemiring (LocallyConstant X Y) :=
  Function.Injective.nonUnitalCommSemiring FunLike.coe FunLike.coe_injective' rfl
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)

instance [CommSemiring Y] : CommSemiring (LocallyConstant X Y) :=
  Function.Injective.commSemiring FunLike.coe FunLike.coe_injective' rfl rfl
    (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) fun _ => rfl

instance [NonUnitalNonAssocRing Y] : NonUnitalNonAssocRing (LocallyConstant X Y) :=
  Function.Injective.nonUnitalNonAssocRing FunLike.coe FunLike.coe_injective' rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)

instance [NonUnitalRing Y] : NonUnitalRing (LocallyConstant X Y) :=
  Function.Injective.nonUnitalRing FunLike.coe FunLike.coe_injective' rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)

instance [NonAssocRing Y] : NonAssocRing (LocallyConstant X Y) :=
  Function.Injective.nonAssocRing FunLike.coe FunLike.coe_injective' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ => rfl) (fun _ => rfl)

instance [Ring Y] : Ring (LocallyConstant X Y) :=
  Function.Injective.ring FunLike.coe FunLike.coe_injective' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) fun _ => rfl

instance [NonUnitalCommRing Y] : NonUnitalCommRing (LocallyConstant X Y) :=
  Function.Injective.nonUnitalCommRing FunLike.coe FunLike.coe_injective' rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)

instance [CommRing Y] : CommRing (LocallyConstant X Y) :=
  Function.Injective.commRing FunLike.coe FunLike.coe_injective' rfl rfl (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl) (fun _ _ => rfl)
    (fun _ _ => rfl) (fun _ => rfl) fun _ => rfl

variable {R : Type _}

instance [Monoid R] [MulAction R Y] : MulAction R (LocallyConstant X Y) :=
  Function.Injective.mulAction _ coe_injective fun _ _ => rfl

instance [Monoid R] [AddMonoid Y] [DistribMulAction R Y] :
    DistribMulAction R (LocallyConstant X Y) :=
  Function.Injective.distribMulAction coeFnAddMonoidHom coe_injective fun _ _ => rfl

instance [Semiring R] [AddCommMonoid Y] [Module R Y] : Module R (LocallyConstant X Y) :=
  Function.Injective.module R coeFnAddMonoidHom coe_injective fun _ _ => rfl

section Algebra

variable [CommSemiring R] [Semiring Y] [Algebra R Y]

instance : Algebra R (LocallyConstant X Y) where
  toRingHom := constRingHom.comp <| algebraMap R Y
  commutes' := by
    intros
    ext
    exact Algebra.commutes' _ _
  smul_def' := by
    intros
    ext
    exact Algebra.smul_def' _ _

@[simp]
theorem coe_algebraMap (r : R) : ⇑(algebraMap R (LocallyConstant X Y) r) = algebraMap R (X → Y) r :=
  rfl
#align locally_constant.coe_algebra_map LocallyConstant.coe_algebraMap

end Algebra

end LocallyConstant