/-
Copyright (c) 2015 Jakob von Raumer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob von Raumer, Floris van Doorn

Proof of the @[hott] theorem that (is_trunc n A) is a mere proposition
We prove this here to avoid circular dependency of files
We want to use this in .equiv; .equiv is imported by .function and .function is imported by .trunc
-/

import hott.types.pi

universe u
namespace hott
hott_theory
open hott.sigma

namespace is_trunc
  @[hott] def is_contr.sigma_char (A : Type u) :
    (Σ (center : A), Π (a : A), center = a) ≃ (is_contr A) :=
  begin
    fapply equiv.MK,
    { intro S, exact (is_contr.mk S.1 S.2)},
    { intro H, cases H with H', cases H' with ce co, exact ⟨ce, co⟩},
    { intro H, cases H with H', cases H' with ce co, exact idp},
    { intro S, cases S, apply idp}
  end

  @[hott] def is_trunc.pi_char (n : ℕ₋₂) (A : Type u) :
    (Π (x y : A), is_trunc n (x = y)) ≃ (is_trunc (n .+1) A) :=
  begin
    fapply equiv.MK,
    { exact is_trunc_succ_intro},
    { introsI H x y, apply is_trunc_eq},
    { intro H, cases H, apply idp},
    { introI P, apply eq_of_homotopy, intro a, apply eq_of_homotopy, intro b,
      change is_trunc.mk (to_internal n (a = b)) = P a b,
      induction (P a b), apply idp},
  end

  @[hott] lemma is_prop_is_trunc (n : ℕ₋₂) (A : Type u) : is_prop (is_trunc n A) :=
  begin
    induction n generalizing A,
    { apply is_trunc_equiv_closed,
      { apply is_contr.sigma_char },
      apply is_prop.mk, intros,
      fapply sigma_eq, apply x.2,
      apply is_prop.elimo', apply pi.is_prop_pi_eq },
    { apply is_trunc_equiv_closed,
      apply is_trunc.pi_char,
      unfreezeI, apply_instance },
  end

  local attribute [instance] is_prop_is_trunc
  @[hott, instance] def is_trunc_succ_is_trunc (n m : ℕ₋₂) (A : Type u) :
    is_trunc (n.+1) (is_trunc m A) :=
  is_trunc_succ_of_is_prop (is_trunc m A) n

end is_trunc

end hott


example : Prop := ∀ n, (n:Nat) + n = n.succ
example : Prop := ∀ n, n.succ = (n:Nat) + n
example : Prop := ∀ n, (n:Nat) + n.succ = n
example : Prop := ∀ n, n.succ + (n:Nat) = n
example : Prop := ∀ n, (n.succ:Nat) + n = n
example : Prop := ∀ n, (n:Nat).succ + n = n

def fib: Nat → Nat
| 0 => 0
| 1 => 1
| n + 2 => fib n + fib (n + 1)

theorem fib50Eq : fib 50 = 12586269025 :=
  rfl

inductive type : Type
  | A : type
  | B  : type

inductive val : type → Type
  | cA : val type.A
  | cB : val type.B

inductive wrap : Type
  | val : ∀ {t : type}, (val t) → wrap

def f : wrap → Nat
  | wrap.val val.cA => 1
  | _ => 1

example (a : Nat) : True := by
  have : ∀ n, n ≥ 0 → a ≤ a := fun _ _ => Nat.le_refl ..
  exact True.intro

example (ᾰ : Nat) : True := by
  have : ∀ n, n ≥ 0 → ᾰ ≤ ᾰ := fun _ _ => Nat.le_refl ..
  exact True.intro

inductive Vec.{u} (α : Type u) : Nat → Type u
  | nil  : Vec α 0
  | cons : α → {n : Nat} → Vec α n → Vec α (Nat.succ n) -- TODO: investigate why +1 doesn't work here

constant Vars : Type

structure Lang :=
  (funcs : Nat → Type)
  (consts : Type)

inductive Term (L : Lang) : Type
  | const_term : L.consts → Term L
  | var_term   : Vars → Term L
  | func_term  (n : Nat) (f : L.funcs n) (v : Vec (Term L) n) : Term L


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import data.pi
import data.set.function
import tactic.pi_instances
import algebra.group.hom_instances

/-!
# Pi instances for groups and monoids

This file defines instances for group, monoid, semigroup and related structures on Pi types.
-/

universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances
variables (x y : Π i, f i) (i : I)

namespace pi

@[to_additive]
instance semigroup [∀ i, semigroup $ f i] : semigroup (Π i : I, f i) :=
by refine_struct { mul := (*), .. }; tactic.pi_instance_derive_field

instance semigroup_with_zero [∀ i, semigroup_with_zero $ f i] :
  semigroup_with_zero (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), mul := (*), .. }; tactic.pi_instance_derive_field

@[to_additive]
instance comm_semigroup [∀ i, comm_semigroup $ f i] : comm_semigroup (Π i : I, f i) :=
by refine_struct { mul := (*), .. }; tactic.pi_instance_derive_field

@[to_additive]
instance mul_one_class [∀ i, mul_one_class $ f i] : mul_one_class (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), .. }; tactic.pi_instance_derive_field

@[to_additive]
instance monoid [∀ i, monoid $ f i] : monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := λ n x i, npow n (x i) };
tactic.pi_instance_derive_field

@[simp]
lemma pow_apply [∀ i, monoid $ f i] (n : ℕ) : (x^n) i = (x i)^n :=
begin
  induction n with n ih,
  { simp, },
  { simp [pow_succ, ih], },
end

@[to_additive]
instance comm_monoid [∀ i, comm_monoid $ f i] : comm_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := λ n x i, npow n (x i) };
tactic.pi_instance_derive_field

@[to_additive]
instance div_inv_monoid [∀ i, div_inv_monoid $ f i] :
  div_inv_monoid (Π i : I, f i) :=
{ div_eq_mul_inv := λ x y, funext (λ i, div_eq_mul_inv (x i) (y i)),
  .. pi.monoid, .. pi.has_div, .. pi.has_inv }

@[to_additive]
instance group [∀ i, group $ f i] : group (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), inv := has_inv.inv, div := has_div.div,
  npow := λ n x i, npow n (x i), gpow := λ n x i, gpow n (x i) }; tactic.pi_instance_derive_field

@[to_additive]
instance comm_group [∀ i, comm_group $ f i] : comm_group (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), inv := has_inv.inv, div := has_div.div,
  npow := λ n x i, npow n (x i), gpow := λ n x i, gpow n (x i) }; tactic.pi_instance_derive_field

@[to_additive add_left_cancel_semigroup]
instance left_cancel_semigroup [∀ i, left_cancel_semigroup $ f i] :
  left_cancel_semigroup (Π i : I, f i) :=
by refine_struct { mul := (*) }; tactic.pi_instance_derive_field

@[to_additive add_right_cancel_semigroup]
instance right_cancel_semigroup [∀ i, right_cancel_semigroup $ f i] :
  right_cancel_semigroup (Π i : I, f i) :=
by refine_struct { mul := (*) }; tactic.pi_instance_derive_field

@[to_additive add_left_cancel_monoid]
instance left_cancel_monoid [∀ i, left_cancel_monoid $ f i] :
  left_cancel_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := λ n x i, npow n (x i) };
tactic.pi_instance_derive_field

@[to_additive add_right_cancel_monoid]
instance right_cancel_monoid [∀ i, right_cancel_monoid $ f i] :
  right_cancel_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := λ n x i, npow n (x i), .. };
tactic.pi_instance_derive_field

@[to_additive add_cancel_monoid]
instance cancel_monoid [∀ i, cancel_monoid $ f i] :
  cancel_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := λ n x i, npow n (x i) };
tactic.pi_instance_derive_field

@[to_additive add_cancel_comm_monoid]
instance cancel_comm_monoid [∀ i, cancel_comm_monoid $ f i] :
  cancel_comm_monoid (Π i : I, f i) :=
by refine_struct { one := (1 : Π i, f i), mul := (*), npow := λ n x i, npow n (x i) };
tactic.pi_instance_derive_field

instance mul_zero_class [∀ i, mul_zero_class $ f i] :
  mul_zero_class (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), mul := (*), .. }; tactic.pi_instance_derive_field

instance mul_zero_one_class [∀ i, mul_zero_one_class $ f i] :
  mul_zero_one_class (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := (1 : Π i, f i), mul := (*), .. };
  tactic.pi_instance_derive_field

instance monoid_with_zero [∀ i, monoid_with_zero $ f i] :
  monoid_with_zero (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := (1 : Π i, f i), mul := (*),
  npow := λ n x i, npow n (x i) }; tactic.pi_instance_derive_field

instance comm_monoid_with_zero [∀ i, comm_monoid_with_zero $ f i] :
  comm_monoid_with_zero (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := (1 : Π i, f i), mul := (*),
  npow := λ n x i, npow n (x i) }; tactic.pi_instance_derive_field

section instance_lemmas
open function

variables {α β γ : Type*}

@[simp, to_additive] lemma const_one [has_one β] : const α (1 : β) = 1 := rfl

@[simp, to_additive] lemma comp_one [has_one β] {f : β → γ} : f ∘ 1 = const α (f 1) := rfl

@[simp, to_additive] lemma one_comp [has_one γ] {f : α → β} : (1 : β → γ) ∘ f = 1 := rfl

end instance_lemmas

end pi

section monoid_hom

variables (f) [Π i, mul_one_class (f i)]

/-- Evaluation of functions into an indexed collection of monoids at a point is a monoid
homomorphism. -/
@[to_additive "Evaluation of functions into an indexed collection of additive monoids at a point
is an additive monoid homomorphism."]
def monoid_hom.apply (i : I) : (Π i, f i) →* f i :=
{ to_fun := λ g, g i,
  map_one' := rfl,
  map_mul' := λ x y, rfl, }

@[simp, to_additive]
lemma monoid_hom.apply_apply (i : I) (g : Π i, f i) :
  (monoid_hom.apply f i) g = g i := rfl

/-- Coercion of a `monoid_hom` into a function is itself a `monoid_hom`.

See also `monoid_hom.eval`. -/
@[to_additive "Coercion of an `add_monoid_hom` into a function is itself a `add_monoid_hom`.

See also `add_monoid_hom.eval`. ", simps]
def monoid_hom.coe_fn (α β : Type*) [mul_one_class α] [comm_monoid β] : (α →* β) →* (α → β) :=
{ to_fun := λ g, g,
  map_one' := rfl,
  map_mul' := λ x y, rfl, }

end monoid_hom

section single
variables [decidable_eq I]
open pi

variables (f)

/-- The zero-preserving homomorphism including a single value
into a dependent family of values, as functions supported at a point.

This is the `zero_hom` version of `pi.single`. -/
@[simps] def zero_hom.single [Π i, has_zero $ f i] (i : I) : zero_hom (f i) (Π i, f i) :=
{ to_fun := single i,
  map_zero' := single_zero i }

/-- The additive monoid homomorphism including a single additive monoid
into a dependent family of additive monoids, as functions supported at a point.

This is the `add_monoid_hom` version of `pi.single`. -/
@[simps] def add_monoid_hom.single [Π i, add_zero_class $ f i] (i : I) : f i →+ Π i, f i :=
{ to_fun := single i,
  map_add' := single_op₂ (λ _, (+)) (λ _, zero_add _) _,
  .. (zero_hom.single f i) }

/-- The multiplicative homomorphism including a single `mul_zero_class`
into a dependent family of `mul_zero_class`es, as functions supported at a point.

This is the `mul_hom` version of `pi.single`. -/
@[simps] def mul_hom.single [Π i, mul_zero_class $ f i] (i : I) : mul_hom (f i) (Π i, f i) :=
{ to_fun := single i,
  map_mul' := single_op₂ (λ _, (*)) (λ _, zero_mul _) _, }

variables {f}

lemma pi.single_add [Π i, add_zero_class $ f i] (i : I) (x y : f i) :
  single i (x + y) = single i x + single i y :=
(add_monoid_hom.single f i).map_add x y

lemma pi.single_neg [Π i, add_group $ f i] (i : I) (x : f i) :
  single i (-x) = -single i x :=
(add_monoid_hom.single f i).map_neg x

lemma pi.single_sub [Π i, add_group $ f i] (i : I) (x y : f i) :
  single i (x - y) = single i x - single i y :=
(add_monoid_hom.single f i).map_sub x y

lemma pi.single_mul [Π i, mul_zero_class $ f i] (i : I) (x y : f i) :
  single i (x * y) = single i x * single i y :=
(mul_hom.single f i).map_mul x y

end single

section piecewise

@[to_additive]
lemma set.piecewise_mul [Π i, has_mul (f i)] (s : set I) [Π i, decidable (i ∈ s)]
  (f₁ f₂ g₁ g₂ : Π i, f i) :
  s.piecewise (f₁ * f₂) (g₁ * g₂) = s.piecewise f₁ g₁ * s.piecewise f₂ g₂ :=
s.piecewise_op₂ _ _ _ _ (λ _, (*))

@[to_additive]
lemma pi.piecewise_inv [Π i, has_inv (f i)] (s : set I) [Π i, decidable (i ∈ s)]
  (f₁ g₁ : Π i, f i) :
  s.piecewise (f₁⁻¹) (g₁⁻¹) = (s.piecewise f₁ g₁)⁻¹ :=
s.piecewise_op f₁ g₁ (λ _ x, x⁻¹)

@[to_additive]
lemma pi.piecewise_div [Π i, has_div (f i)] (s : set I) [Π i, decidable (i ∈ s)]
  (f₁ f₂ g₁ g₂ : Π i, f i) :
  s.piecewise (f₁ / f₂) (g₁ / g₂) = s.piecewise f₁ g₁ / s.piecewise f₂ g₂ :=
s.piecewise_op₂ _ _ _ _ (λ _, (/))

end piecewise