/-
Copyright (c) 2021 Filippo A. E. Nuccio. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Filippo A. E. Nuccio, Eric Wieser
-/

import data.matrix.basic
import linear_algebra.tensor_product
import ring_theory.tensor_product

/-!
# Kronecker product of matrices

This defines the [Kronecker product](https://en.wikipedia.org/wiki/Kronecker_product).

## Main definitions

* `matrix.kronecker_map`: A generalization of the Kronecker product: given a map `f : α → β → γ`
  and matrices `A` and `B` with coefficients in `α` and `β`, respectively, it is defined as the
  matrix with coefficients in `γ` such that
  `kronecker_map f A B (i₁, i₂) (j₁, j₂) = f (A i₁ j₁) (B i₁ j₂)`.
* `matrix.kronecker_map_bilinear`: when `f` is bilinear, so is `kronecker_map f`.

## Specializations

* `matrix.kronecker`: An alias of `kronecker_map (*)`. Prefer using the notation.
* `matrix.kronecker_bilinear`: `matrix.kronecker` is bilinear

* `matrix.kronecker_tmul`: An alias of `kronecker_map (⊗ₜ)`. Prefer using the notation.
* `matrix.kronecker_tmul_bilinear`: `matrix.tmul_kronecker` is bilinear

## Notations

These require `open_locale kronecker`:

* `A ⊗ₖ B` for `kronecker_map (*) A B`. Lemmas about this notation use the token `kronecker`.
* `A ⊗ₖₜ B` and `A ⊗ₖₜ[R] B` for `kronecker_map (⊗ₜ) A B`.  Lemmas about this notation use the token
  `kronecker_tmul`.

-/

namespace matrix

open_locale matrix

variables {R α α' β β' γ γ' : Type*}
variables {l m n p : Type*} {q r : Type*} {l' m' n' p' : Type*}

section kronecker_map

/-- Produce a matrix with `f` applied to every pair of elements from `A` and `B`. -/
@[simp] def kronecker_map (f : α → β → γ) (A : matrix l m α) (B : matrix n p β) :
  matrix (l × n) (m × p) γ
| i j := f (A i.1 j.1) (B i.2 j.2)

lemma kronecker_map_transpose (f : α → β → γ)
  (A : matrix l m α) (B : matrix n p β) :
  kronecker_map f Aᵀ Bᵀ = (kronecker_map f A B)ᵀ :=
ext $ λ i j, rfl

lemma kronecker_map_map_left (f : α' → β → γ) (g : α → α')
  (A : matrix l m α) (B : matrix n p β) :
  kronecker_map f (A.map g) B = kronecker_map (λ a b, f (g a) b) A B :=
ext $ λ i j, rfl

lemma kronecker_map_map_right (f : α → β' → γ) (g : β → β')
  (A : matrix l m α) (B : matrix n p β) :
  kronecker_map f A (B.map g) = kronecker_map (λ a b, f a (g b)) A B :=
ext $ λ i j, rfl

lemma kronecker_map_map (f : α → β → γ) (g : γ → γ')
  (A : matrix l m α) (B : matrix n p β) :
  (kronecker_map f A B).map g = kronecker_map (λ a b, g (f a b)) A B :=
ext $ λ i j, rfl

@[simp] lemma kronecker_map_zero_left [has_zero α] [has_zero γ]
  (f : α → β → γ) (hf : ∀ b, f 0 b = 0) (B : matrix n p β) :
  kronecker_map f (0 : matrix l m α) B = 0:=
ext $ λ i j,hf _

@[simp] lemma kronecker_map_zero_right [has_zero β] [has_zero γ]
  (f : α → β → γ) (hf : ∀ a, f a 0 = 0) (A : matrix l m α) :
  kronecker_map f A (0 : matrix n p β) = 0 :=
ext $ λ i j, hf _

lemma kronecker_map_add_left [has_add α] [has_add γ] (f : α → β → γ)
  (hf : ∀ a₁ a₂ b, f (a₁ + a₂) b = f a₁ b + f a₂ b)
  (A₁ A₂ : matrix l m α) (B : matrix n p β) :
  kronecker_map f (A₁ + A₂) B = kronecker_map f A₁ B + kronecker_map f A₂ B :=
ext $ λ i j, hf _ _ _

lemma kronecker_map_add_right [has_add β] [has_add γ] (f : α → β → γ)
  (hf : ∀ a b₁ b₂, f a (b₁ + b₂) = f a b₁ + f a b₂)
  (A : matrix l m α) (B₁ B₂ : matrix n p β) :
  kronecker_map f A (B₁ + B₂) = kronecker_map f A B₁ + kronecker_map f A B₂ :=
ext $ λ i j, hf _ _ _

lemma kronecker_map_smul_left [has_scalar R α] [has_scalar R γ] (f : α → β → γ)
  (r : R) (hf : ∀ a b, f (r • a) b = r • f a b) (A : matrix l m α) (B : matrix n p β) :
  kronecker_map f (r • A) B = r • kronecker_map f A B :=
ext $ λ i j, hf _ _

lemma kronecker_map_smul_right [has_scalar R β] [has_scalar R γ] (f : α → β → γ)
  (r : R) (hf : ∀ a b, f a (r • b) = r • f a b) (A : matrix l m α) (B : matrix n p β) :
  kronecker_map f A (r • B) = r • kronecker_map f A B :=
ext $ λ i j, hf _ _

lemma kronecker_map_diagonal_diagonal [has_zero α] [has_zero β] [has_zero γ]
  [decidable_eq m] [decidable_eq n]
  (f : α → β → γ) (hf₁ : ∀ b, f 0 b = 0) (hf₂ : ∀ a, f a 0 = 0) (a : m → α) (b : n → β):
  kronecker_map f (diagonal a) (diagonal b) = diagonal (λ mn, f (a mn.1) (b mn.2)) :=
begin
  ext ⟨i₁, i₂⟩ ⟨j₁, j₂⟩,
  simp [diagonal, apply_ite f, ite_and, ite_apply, apply_ite (f (a i₁)), hf₁, hf₂],
end

@[simp] lemma kronecker_map_one_one [has_zero α] [has_zero β] [has_zero γ]
  [has_one α] [has_one β] [has_one γ] [decidable_eq m] [decidable_eq n]
  (f : α → β → γ) (hf₁ : ∀ b, f 0 b = 0) (hf₂ : ∀ a, f a 0 = 0) (hf₃ : f 1 1 = 1) :
  kronecker_map f (1 : matrix m m α) (1 : matrix n n β) = 1 :=
(kronecker_map_diagonal_diagonal _ hf₁ hf₂ _ _).trans $ by simp only [hf₃, diagonal_one]

lemma kronecker_map_reindex (f : α → β → γ) (el : l ≃ l') (em : m ≃ m') (en : n ≃ n')
  (ep : p ≃ p') (M : matrix l m α) (N : matrix n p β) :
  kronecker_map f (reindex el em M) (reindex en ep N) =
    reindex (el.prod_congr en) (em.prod_congr ep) (kronecker_map f M N) :=
by { ext ⟨i, i'⟩ ⟨j, j'⟩, refl }

lemma kronecker_map_reindex_left (f : α → β → γ) (el : l ≃ l') (em : m ≃ m') (M : matrix l m α)
  (N : matrix n n' β) : kronecker_map f (matrix.reindex el em M) N =
  reindex (el.prod_congr (equiv.refl _)) (em.prod_congr (equiv.refl _)) (kronecker_map f M N) :=
kronecker_map_reindex _ _ _ (equiv.refl _) (equiv.refl _) _ _

lemma kronecker_map_reindex_right (f : α → β → γ) (em : m ≃ m') (en : n ≃ n') (M : matrix l l' α)
  (N : matrix m n β) : kronecker_map f M (reindex em en N) =
  reindex ((equiv.refl _).prod_congr em) ((equiv.refl _).prod_congr en) (kronecker_map f M N) :=
kronecker_map_reindex _ (equiv.refl _) (equiv.refl _) _ _ _ _

lemma kronecker_map_assoc {δ ξ ω ω' : Type*} (f : α → β → γ) (g : γ → δ → ω) (f' : α → ξ → ω')
  (g' : β → δ → ξ) (A : matrix l m α) (B : matrix n p β) (D : matrix q r δ) (φ : ω ≃ ω')
  (hφ : ∀ a b d, φ (g (f a b) d) = f' a (g' b d)) :
  (reindex (equiv.prod_assoc l n q) (equiv.prod_assoc m p r)).trans (equiv.map_matrix φ)
    (kronecker_map g (kronecker_map f A B) D) = kronecker_map f' A (kronecker_map g' B D) :=
ext $ λ i j, hφ _ _ _

lemma kronecker_map_assoc₁ {δ ξ ω : Type*} (f : α → β → γ) (g : γ → δ → ω) (f' : α → ξ → ω)
  (g' : β → δ → ξ) (A : matrix l m α) (B : matrix n p β) (D : matrix q r δ)
  (h : ∀ a b d, (g (f a b) d) = f' a (g' b d)) :
  reindex (equiv.prod_assoc l n q) (equiv.prod_assoc m p r)
    (kronecker_map g (kronecker_map f A B) D) = kronecker_map f' A (kronecker_map g' B D) :=
ext $ λ i j, h _ _ _

/-- When `f` is bilinear then `matrix.kronecker_map f` is also bilinear. -/
@[simps]
def kronecker_map_bilinear [comm_semiring R]
  [add_comm_monoid α] [add_comm_monoid β] [add_comm_monoid γ]
  [module R α] [module R β] [module R γ]
  (f : α →ₗ[R] β →ₗ[R] γ) :
  matrix l m α →ₗ[R] matrix n p β →ₗ[R] matrix (l × n) (m × p) γ :=
linear_map.mk₂ R
  (kronecker_map (λ r s, f r s))
  (kronecker_map_add_left _ $ f.map_add₂)
  (λ r, kronecker_map_smul_left _ _ $ f.map_smul₂ _)
  (kronecker_map_add_right _ $ λ a, (f a).map_add)
  (λ r, kronecker_map_smul_right _ _ $ λ a, (f a).map_smul r)

/-- `matrix.kronecker_map_bilinear` commutes with `⬝` if `f` commutes with `*`.

This is primarily used with `R = ℕ` to prove `matrix.mul_kronecker_mul`. -/
lemma kronecker_map_bilinear_mul_mul [comm_semiring R]
  [fintype m] [fintype m'] [non_unital_non_assoc_semiring α]
  [non_unital_non_assoc_semiring β] [non_unital_non_assoc_semiring γ]
  [module R α] [module R β] [module R γ]
  (f : α →ₗ[R] β →ₗ[R] γ) (h_comm : ∀ a b a' b', f (a * b) (a' * b') = f a a' * f b b')
  (A : matrix l m α) (B : matrix m n α) (A' : matrix l' m' β) (B' : matrix m' n' β) :
  kronecker_map_bilinear f (A ⬝ B) (A' ⬝ B') =
    (kronecker_map_bilinear f A A') ⬝ (kronecker_map_bilinear f B B') :=
begin
  ext ⟨i, i'⟩ ⟨j, j'⟩,
  simp only [kronecker_map_bilinear_apply_apply, mul_apply, ← finset.univ_product_univ,
    finset.sum_product, kronecker_map],
  simp_rw [f.map_sum, linear_map.sum_apply, linear_map.map_sum, h_comm],
end

end kronecker_map

/-! ### Specialization to `matrix.kronecker_map (*)` -/

section kronecker

variables (R)

open_locale matrix

/-- The Kronecker product. This is just a shorthand for `kronecker_map (*)`. Prefer the notation
`⊗ₖ` rather than this definition. -/
@[simp] def kronecker [has_mul α] : matrix l m α → matrix n p α → matrix (l × n) (m × p) α :=
kronecker_map (*)

localized "infix ` ⊗ₖ `:100 := matrix.kronecker_map (*)" in kronecker

@[simp]
lemma kronecker_apply [has_mul α] (A : matrix l m α) (B : matrix n p α) (i₁ i₂ j₁ j₂) :
  (A ⊗ₖ B) (i₁, i₂) (j₁, j₂) = A i₁ j₁ * B i₂ j₂ := rfl

/-- `matrix.kronecker` as a bilinear map. -/
def kronecker_bilinear [comm_semiring R] [semiring α] [algebra R α] :
  matrix l m α →ₗ[R] matrix n p α →ₗ[R] matrix (l × n) (m × p) α :=
kronecker_map_bilinear (algebra.lmul R α).to_linear_map

/-! What follows is a copy, in order, of every `matrix.kronecker_map` lemma above that has
hypotheses which can be filled by properties of `*`. -/

@[simp] lemma zero_kronecker [mul_zero_class α] (B : matrix n p α) : (0 : matrix l m α) ⊗ₖ B = 0 :=
kronecker_map_zero_left _ zero_mul B

@[simp] lemma kronecker_zero [mul_zero_class α] (A : matrix l m α) : A ⊗ₖ (0 : matrix n p α) = 0 :=
kronecker_map_zero_right _ mul_zero A

lemma add_kronecker [distrib α] (A₁ A₂ : matrix l m α) (B : matrix n p α) :
  (A₁ + A₂) ⊗ₖ B = A₁ ⊗ₖ B + A₂ ⊗ₖ B :=
kronecker_map_add_left _ add_mul _ _ _

lemma kronecker_add [distrib α] (A : matrix l m α) (B₁ B₂ : matrix n p α) :
  A ⊗ₖ (B₁ + B₂) = A ⊗ₖ B₁ + A ⊗ₖ B₂ :=
kronecker_map_add_right _ mul_add _ _ _

lemma smul_kronecker [monoid R] [monoid α] [mul_action R α] [is_scalar_tower R α α]
  (r : R) (A : matrix l m α) (B : matrix n p α) :
  (r • A) ⊗ₖ B = r • (A ⊗ₖ B) :=
kronecker_map_smul_left _ _ (λ _ _, smul_mul_assoc _ _ _) _ _

lemma kronecker_smul [monoid R] [monoid α] [mul_action R α] [smul_comm_class R α α]
  (r : R) (A : matrix l m α) (B : matrix n p α) :
  A ⊗ₖ (r • B) = r • (A ⊗ₖ B) :=
kronecker_map_smul_right _ _ (λ _ _, mul_smul_comm _ _ _) _ _

lemma diagonal_kronecker_diagonal [mul_zero_class α]
  [decidable_eq m] [decidable_eq n]
  (a : m → α) (b : n → α):
  (diagonal a) ⊗ₖ (diagonal b) = diagonal (λ mn, (a mn.1) * (b mn.2)) :=
kronecker_map_diagonal_diagonal _ zero_mul mul_zero _ _

@[simp] lemma one_kronecker_one [mul_zero_one_class α] [decidable_eq m] [decidable_eq n] :
  (1 : matrix m m α) ⊗ₖ (1 : matrix n n α) = 1 :=
kronecker_map_one_one _ zero_mul mul_zero (one_mul _)

lemma mul_kronecker_mul [fintype m] [fintype m'] [comm_semiring α]
  (A : matrix l m α) (B : matrix m n α) (A' : matrix l' m' α) (B' : matrix m' n' α) :
  (A ⬝ B) ⊗ₖ (A' ⬝ B') = (A ⊗ₖ A') ⬝ (B ⊗ₖ B') :=
kronecker_map_bilinear_mul_mul (algebra.lmul ℕ α).to_linear_map mul_mul_mul_comm A B A' B'

@[simp] lemma kronecker_assoc [semigroup α] (A : matrix l m α) (B : matrix n p α)
  (C : matrix q r α) : reindex (equiv.prod_assoc l n q) (equiv.prod_assoc m p r) ((A ⊗ₖ B) ⊗ₖ C) =
  A ⊗ₖ (B ⊗ₖ C) :=
kronecker_map_assoc₁ _ _ _ _ A B C mul_assoc

end kronecker

/-! ### Specialization to `matrix.kronecker_map (⊗ₜ)` -/

section kronecker_tmul

variables (R)
open tensor_product
open_locale matrix tensor_product

section module

variables [comm_semiring R] [add_comm_monoid α] [add_comm_monoid β] [add_comm_monoid γ]
variables [module R α] [module R β] [module R γ]

/-- The Kronecker tensor product. This is just a shorthand for `kronecker_map (⊗ₜ)`.
Prefer the notation `⊗ₖₜ` rather than this definition. -/
@[simp] def kronecker_tmul :
  matrix l m α → matrix n p β → matrix (l × n) (m × p) (α ⊗[R] β) :=
kronecker_map (⊗ₜ)

localized "infix ` ⊗ₖₜ `:100 := matrix.kronecker_map (⊗ₜ)" in kronecker
localized
  "notation x ` ⊗ₖₜ[`:100 R `] `:0 y:100 := matrix.kronecker_map (tensor_product.tmul R) x y"
    in kronecker

@[simp]
lemma kronecker_tmul_apply (A : matrix l m α) (B : matrix n p β) (i₁ i₂ j₁ j₂) :
  (A ⊗ₖₜ B) (i₁, i₂) (j₁, j₂) = A i₁ j₁ ⊗ₜ[R] B i₂ j₂ := rfl

/-- `matrix.kronecker` as a bilinear map. -/
def kronecker_tmul_bilinear :
  matrix l m α →ₗ[R] matrix n p β →ₗ[R] matrix (l × n) (m × p) (α ⊗[R] β) :=
kronecker_map_bilinear (tensor_product.mk R α β)

/-! What follows is a copy, in order, of every `matrix.kronecker_map` lemma above that has
hypotheses which can be filled by properties of `⊗ₜ`. -/

@[simp] lemma zero_kronecker_tmul (B : matrix n p β) : (0 : matrix l m α) ⊗ₖₜ[R] B = 0 :=
kronecker_map_zero_left _ (zero_tmul α) B

@[simp] lemma kronecker_tmul_zero (A : matrix l m α) : A ⊗ₖₜ[R] (0 : matrix n p β) = 0 :=
kronecker_map_zero_right _ (tmul_zero β) A

lemma add_kronecker_tmul (A₁ A₂ : matrix l m α) (B : matrix n p α) :
  (A₁ + A₂) ⊗ₖₜ[R] B = A₁ ⊗ₖₜ B + A₂ ⊗ₖₜ B :=
kronecker_map_add_left _ add_tmul _ _ _

lemma kronecker_tmul_add (A : matrix l m α) (B₁ B₂ : matrix n p α) :
  A ⊗ₖₜ[R] (B₁ + B₂) = A ⊗ₖₜ B₁ + A ⊗ₖₜ B₂ :=
kronecker_map_add_right _ tmul_add _ _ _

lemma smul_kronecker_tmul
  (r : R) (A : matrix l m α) (B : matrix n p α) :
  (r • A) ⊗ₖₜ[R] B = r • (A ⊗ₖₜ B) :=
kronecker_map_smul_left _ _ (λ _ _, smul_tmul' _ _ _) _ _

lemma kronecker_tmul_smul
  (r : R) (A : matrix l m α) (B : matrix n p α) :
  A ⊗ₖₜ[R] (r • B) = r • (A ⊗ₖₜ B) :=
kronecker_map_smul_right _ _ (λ _ _, tmul_smul _ _ _) _ _

lemma diagonal_kronecker_tmul_diagonal
  [decidable_eq m] [decidable_eq n]
  (a : m → α) (b : n → α):
  (diagonal a) ⊗ₖₜ[R] (diagonal b) = diagonal (λ mn, a mn.1 ⊗ₜ b mn.2) :=
kronecker_map_diagonal_diagonal _ (zero_tmul _) (tmul_zero _) _ _

@[simp] lemma kronecker_tmul_assoc (A : matrix l m α) (B : matrix n p β) (C : matrix q r γ) :
  reindex (equiv.prod_assoc l n q) (equiv.prod_assoc m p r)
    (((A ⊗ₖₜ[R] B) ⊗ₖₜ[R] C).map (tensor_product.assoc _ _ _ _)) = A ⊗ₖₜ[R] (B ⊗ₖₜ[R] C) :=
ext $ λ i j, assoc_tmul _ _ _

end module

section algebra
variables [comm_semiring R] [semiring α] [semiring β] [algebra R α] [algebra R β]

open_locale kronecker
open algebra.tensor_product

@[simp] lemma one_kronecker_tmul_one [decidable_eq m] [decidable_eq n] :
  (1 : matrix m m α) ⊗ₖₜ[R] (1 : matrix n n α) = 1 :=
kronecker_map_one_one _ (zero_tmul _) (tmul_zero _) rfl

lemma mul_kronecker_tmul_mul [fintype m] [fintype m']
  (A : matrix l m α) (B : matrix m n α) (A' : matrix l' m' β) (B' : matrix m' n' β) :
  (A ⬝ B) ⊗ₖₜ[R] (A' ⬝ B') = (A ⊗ₖₜ A') ⬝ (B ⊗ₖₜ B') :=
kronecker_map_bilinear_mul_mul (tensor_product.mk R α β) tmul_mul_tmul A B A' B'

end algebra

-- insert lemmas specific to `kronecker_tmul` below this line

end kronecker_tmul

end matrix


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro

! This file was ported from Lean 3 source module data.rat.big_operators
! leanprover-community/mathlib commit 008205aa645b3f194c1da47025c5f110c8406eab
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Rat.Cast
import Mathlib.Algebra.BigOperators.Basic

/-! # Casting lemmas for rational numbers involving sums and products
-/

open BigOperators

variable {ι α : Type _}

namespace Rat

section WithDivRing

variable [DivisionRing α] [CharZero α]

@[simp, norm_cast]
theorem cast_list_sum (s : List ℚ) : (↑s.sum : α) = (s.map (↑)).sum :=
  map_list_sum (Rat.castHom α) _
#align rat.cast_list_sum Rat.cast_list_sum

@[simp, norm_cast]
theorem cast_multiset_sum (s : Multiset ℚ) : (↑s.sum : α) = (s.map (↑)).sum :=
  map_multiset_sum (Rat.castHom α) _
#align rat.cast_multiset_sum Rat.cast_multiset_sum

@[simp, norm_cast]
theorem cast_sum (s : Finset ι) (f : ι → ℚ) : (∑ i in s, f i) = ∑ i in s, (f i : α) :=
  (map_sum (Rat.castHom α) _ s)
#align rat.cast_sum Rat.cast_sum

@[simp, norm_cast]
theorem cast_list_prod (s : List ℚ) : (↑s.prod : α) = (s.map (↑)).prod :=
  map_list_prod (Rat.castHom α) _
#align rat.cast_list_prod Rat.cast_list_prod

end WithDivRing

section Field

variable [Field α] [CharZero α]

@[simp, norm_cast]
theorem cast_multiset_prod (s : Multiset ℚ) : (↑s.prod : α) = (s.map (↑)).prod :=
  map_multiset_prod (Rat.castHom α) _
#align rat.cast_multiset_prod Rat.cast_multiset_prod

@[simp, norm_cast]
theorem cast_prod (s : Finset ι) (f : ι → ℚ) : (∏ i in s, f i) = ∏ i in s, (f i : α) :=
  map_prod (Rat.castHom α) _ _
#align rat.cast_prod Rat.cast_prod

end Field

end Rat


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.algebra.constructions
import group_theory.group_action.prod
import group_theory.group_action.basic
import topology.algebra.const_mul_action

/-!
# Continuous monoid action

In this file we define class `has_continuous_smul`. We say `has_continuous_smul M X` if `M` acts on
`X` and the map `(c, x) ↦ c • x` is continuous on `M × X`. We reuse this class for topological
(semi)modules, vector spaces and algebras.

## Main definitions

* `has_continuous_smul M X` : typeclass saying that the map `(c, x) ↦ c • x` is continuous
  on `M × X`;
* `homeomorph.smul_of_ne_zero`: if a group with zero `G₀` (e.g., a field) acts on `X` and `c : G₀`
  is a nonzero element of `G₀`, then scalar multiplication by `c` is a homeomorphism of `X`;
* `homeomorph.smul`: scalar multiplication by an element of a group `G` acting on `X`
  is a homeomorphism of `X`.
* `units.has_continuous_smul`: scalar multiplication by `Mˣ` is continuous when scalar
  multiplication by `M` is continuous. This allows `homeomorph.smul` to be used with on monoids
  with `G = Mˣ`.

## Main results

Besides homeomorphisms mentioned above, in this file we provide lemmas like `continuous.smul`
or `filter.tendsto.smul` that provide dot-syntax access to `continuous_smul`.
-/

open_locale topological_space pointwise
open filter

/-- Class `has_continuous_smul M X` says that the scalar multiplication `(•) : M → X → X`
is continuous in both arguments. We use the same class for all kinds of multiplicative actions,
including (semi)modules and algebras. -/
class has_continuous_smul (M X : Type*) [has_smul M X]
  [topological_space M] [topological_space X] : Prop :=
(continuous_smul : continuous (λp : M × X, p.1 • p.2))

export has_continuous_smul (continuous_smul)

/-- Class `has_continuous_vadd M X` says that the additive action `(+ᵥ) : M → X → X`
is continuous in both arguments. We use the same class for all kinds of additive actions,
including (semi)modules and algebras. -/
class has_continuous_vadd (M X : Type*) [has_vadd M X]
  [topological_space M] [topological_space X] : Prop :=
(continuous_vadd : continuous (λp : M × X, p.1 +ᵥ p.2))

export has_continuous_vadd (continuous_vadd)

attribute [to_additive] has_continuous_smul

section main

variables {M X Y α : Type*} [topological_space M] [topological_space X] [topological_space Y]

section has_smul

variables [has_smul M X] [has_continuous_smul M X]

@[priority 100, to_additive] instance has_continuous_smul.has_continuous_const_smul :
  has_continuous_const_smul M X :=
{ continuous_const_smul := λ _, continuous_smul.comp (continuous_const.prod_mk continuous_id) }

@[to_additive]
lemma filter.tendsto.smul {f : α → M} {g : α → X} {l : filter α} {c : M} {a : X}
  (hf : tendsto f l (𝓝 c)) (hg : tendsto g l (𝓝 a)) :
  tendsto (λ x, f x • g x) l (𝓝 $ c • a) :=
(continuous_smul.tendsto _).comp (hf.prod_mk_nhds hg)

@[to_additive]
lemma filter.tendsto.smul_const {f : α → M} {l : filter α} {c : M}
  (hf : tendsto f l (𝓝 c)) (a : X) :
  tendsto (λ x, (f x) • a) l (𝓝 (c • a)) :=
hf.smul tendsto_const_nhds

variables {f : Y → M} {g : Y → X} {b : Y} {s : set Y}

@[to_additive]
lemma continuous_within_at.smul (hf : continuous_within_at f s b)
  (hg : continuous_within_at g s b) :
  continuous_within_at (λ x, f x • g x) s b :=
hf.smul hg

@[to_additive]
lemma continuous_at.smul (hf : continuous_at f b) (hg : continuous_at g b) :
  continuous_at (λ x, f x • g x) b :=
hf.smul hg

@[to_additive]
lemma continuous_on.smul (hf : continuous_on f s) (hg : continuous_on g s) :
  continuous_on (λ x, f x • g x) s :=
λ x hx, (hf x hx).smul (hg x hx)

@[continuity, to_additive]
lemma continuous.smul (hf : continuous f) (hg : continuous g) :
  continuous (λ x, f x • g x) :=
continuous_smul.comp (hf.prod_mk hg)

/-- If a scalar is central, then its right action is continuous when its left action is. -/
instance has_continuous_smul.op [has_smul Mᵐᵒᵖ X] [is_central_scalar M X] :
  has_continuous_smul Mᵐᵒᵖ X :=
⟨ suffices continuous (λ p : M × X, mul_opposite.op p.fst • p.snd),
  from this.comp (mul_opposite.continuous_unop.prod_map continuous_id),
  by simpa only [op_smul_eq_smul] using (continuous_smul : continuous (λ p : M × X, _)) ⟩

@[to_additive] instance mul_opposite.has_continuous_smul : has_continuous_smul M Xᵐᵒᵖ :=
⟨mul_opposite.continuous_op.comp $ continuous_smul.comp $
  continuous_id.prod_map mul_opposite.continuous_unop⟩

end has_smul

section monoid

variables [monoid M] [mul_action M X] [has_continuous_smul M X]

@[to_additive] instance units.has_continuous_smul : has_continuous_smul Mˣ X :=
{ continuous_smul :=
    show continuous ((λ p : M × X, p.fst • p.snd) ∘ (λ p : Mˣ × X, (p.1, p.2))),
    from continuous_smul.comp ((units.continuous_coe.comp continuous_fst).prod_mk continuous_snd) }

end monoid

@[to_additive]
instance [has_smul M X] [has_smul M Y] [has_continuous_smul M X]
  [has_continuous_smul M Y] :
  has_continuous_smul M (X × Y) :=
⟨(continuous_fst.smul (continuous_fst.comp continuous_snd)).prod_mk
  (continuous_fst.smul (continuous_snd.comp continuous_snd))⟩

@[to_additive]
instance {ι : Type*} {γ : ι → Type*}
  [∀ i, topological_space (γ i)] [Π i, has_smul M (γ i)] [∀ i, has_continuous_smul M (γ i)] :
  has_continuous_smul M (Π i, γ i) :=
⟨continuous_pi $ λ i,
  (continuous_fst.smul continuous_snd).comp $
    continuous_fst.prod_mk ((continuous_apply i).comp continuous_snd)⟩

end main

section lattice_ops

variables {ι : Sort*} {M X : Type*} [topological_space M] [has_smul M X]

@[to_additive] lemma has_continuous_smul_Inf {ts : set (topological_space X)}
  (h : Π t ∈ ts, @has_continuous_smul M X _ _ t) :
  @has_continuous_smul M X _ _ (Inf ts) :=
{ continuous_smul :=
  begin
    rw ← @Inf_singleton _ _ ‹topological_space M›,
    exact continuous_Inf_rng (λ t ht, continuous_Inf_dom₂ (eq.refl _) ht
      (@has_continuous_smul.continuous_smul _ _ _ _ t (h t ht)))
  end }

@[to_additive] lemma has_continuous_smul_infi {ts' : ι → topological_space X}
  (h : Π i, @has_continuous_smul M X _ _ (ts' i)) :
  @has_continuous_smul M X _ _ (⨅ i, ts' i) :=
has_continuous_smul_Inf $ set.forall_range_iff.mpr h

@[to_additive] lemma has_continuous_smul_inf {t₁ t₂ : topological_space X}
  [@has_continuous_smul M X _ _ t₁] [@has_continuous_smul M X _ _ t₂] :
  @has_continuous_smul M X _ _ (t₁ ⊓ t₂) :=
by { rw inf_eq_infi, refine has_continuous_smul_infi (λ b, _), cases b; assumption }

end lattice_ops


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.monad
import Mathlib.PostPort

universes u_1 u_3 u_2 u_4

namespace Mathlib

/-!
## Expand multivariate polynomials

Given a multivariate polynomial `φ`, one may replace every occurence of `X i` by `X i ^ n`,
for some natural number `n`.
This operation is called `mv_polynomial.expand` and it is an algebra homomorphism.

### Main declaration

* `mv_polynomial.expand`: expand a polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`.
-/

namespace mv_polynomial

/-- Expand the polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`.

See also `polynomial.expand`. -/
def expand {σ : Type u_1} {R : Type u_3} [comm_semiring R] (p : ℕ) :
    alg_hom R (mv_polynomial σ R) (mv_polynomial σ R) :=
  alg_hom.mk (ring_hom.to_fun (eval₂_hom C fun (i : σ) => X i ^ p)) sorry sorry sorry sorry sorry

@[simp] theorem expand_C {σ : Type u_1} {R : Type u_3} [comm_semiring R] (p : ℕ) (r : R) :
    coe_fn (expand p) (coe_fn C r) = coe_fn C r :=
  eval₂_hom_C C (fun (n : σ) => (fun (i : σ) => X i ^ p) n) r

@[simp] theorem expand_X {σ : Type u_1} {R : Type u_3} [comm_semiring R] (p : ℕ) (i : σ) :
    coe_fn (expand p) (X i) = X i ^ p :=
  eval₂_hom_X' C (fun (n : σ) => (fun (i : σ) => X i ^ p) n) i

@[simp] theorem expand_monomial {σ : Type u_1} {R : Type u_3} [comm_semiring R] (p : ℕ) (d : σ →₀ ℕ)
    (r : R) :
    coe_fn (expand p) (monomial d r) =
        coe_fn C r * finset.prod (finsupp.support d) fun (i : σ) => (X i ^ p) ^ coe_fn d i :=
  bind₁_monomial (fun (i : σ) => X i ^ p) d r

theorem expand_one_apply {σ : Type u_1} {R : Type u_3} [comm_semiring R] (f : mv_polynomial σ R) :
    coe_fn (expand 1) f = f :=
  sorry

@[simp] theorem expand_one {σ : Type u_1} {R : Type u_3} [comm_semiring R] :
    expand 1 = alg_hom.id R (mv_polynomial σ R) :=
  sorry

theorem expand_comp_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R] (p : ℕ)
    (f : σ → mv_polynomial τ R) :
    alg_hom.comp (expand p) (bind₁ f) = bind₁ fun (i : σ) => coe_fn (expand p) (f i) :=
  sorry

theorem expand_bind₁ {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R] (p : ℕ)
    (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) :
    coe_fn (expand p) (coe_fn (bind₁ f) φ) =
        coe_fn (bind₁ fun (i : σ) => coe_fn (expand p) (f i)) φ :=
  sorry

@[simp] theorem map_expand {σ : Type u_1} {R : Type u_3} {S : Type u_4} [comm_semiring R]
    [comm_semiring S] (f : R →+* S) (p : ℕ) (φ : mv_polynomial σ R) :
    coe_fn (map f) (coe_fn (expand p) φ) = coe_fn (expand p) (coe_fn (map f) φ) :=
  sorry

@[simp] theorem rename_expand {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → τ) (p : ℕ) (φ : mv_polynomial σ R) :
    coe_fn (rename f) (coe_fn (expand p) φ) = coe_fn (expand p) (coe_fn (rename f) φ) :=
  sorry

@[simp] theorem rename_comp_expand {σ : Type u_1} {τ : Type u_2} {R : Type u_3} [comm_semiring R]
    (f : σ → τ) (p : ℕ) : alg_hom.comp (rename f) (expand p) = alg_hom.comp (expand p) (rename f) :=
  sorry

end Mathlib


/-
Authors : Kai Obendrauf
Adapted from the thesis "A Formalization of Dynamic Epistemic Logic" by Paula Neeley

This file contains proofs for a variety of propositional lemmas.
-/

import syntax.formula
import tactic.induction

----------------------------------------------------------
-- Simple Rules
----------------------------------------------------------

lemma MP' {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form}
-- ⊢ φ ⇒  ⊢ φ → ψ ⇒  ⊢ ψ
  (hL : ⊢' φ) (hImp : ⊢' (φ →' ψ)) : ⊢' (ψ) :=
mp _ _ hImp hL

lemma cut {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ → ψ) ⇒  ⊢ (ψ → χ) ⇒  ⊢ (φ → χ)
  ⊢' (φ →' ψ) → ⊢' (ψ →' χ) → ⊢' (φ →' χ) :=
λ h1 h2, mp _ _ (mp _ _ (p2 _ ψ _) (mp _ _ (p1 _ _) h2)) h1

----------------------------------------------------------
-- SKI
----------------------------------------------------------
def combS {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} (x : ⊢' (φ →' ψ →' χ)) (y : ⊢' (φ →' ψ))
  : ⊢' (φ →' χ) :=
mp _ _ (mp _ _ (p2 _ _ _) x) y

def combS2 {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ ω : form} (x : ⊢' (φ →' ψ →' χ →' ω)) (y : ⊢' (φ →' ψ)) (z : ⊢' (φ →' χ))
  : ⊢' (φ →' ω) :=
combS (combS x y) z

def propS {φ ψ χ : Type} (x : φ → ψ → χ) (y : φ → ψ) : (φ → χ) := λ z, (x z) (y z)
def propS2 {φ ψ χ ω : Type} (x : φ → ψ → χ → ω) (y : φ → ψ) (z : φ → χ) : (φ → ω) := λ w, (x w) (y w) (z w)

def combK {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} (x : ⊢' φ) : ⊢' (ψ →' φ) :=
mp _ _ (p1 _ _) x

def propK {φ ψ : Type} (x : φ) : ψ → φ := λ _, x

def combI {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} : ⊢' (φ →' φ) :=
mp _ _ (mp _ _ (p2 φ (φ →' φ) φ) (p1 _ _)) (p1 _ _)

def propI {φ : Type} : φ → φ :=
id

----------------------------------------------------------
-- Implication
----------------------------------------------------------
lemma iden {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ φ → φ
  ⊢' (φ →' φ) :=
combI

lemma hs1 {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (ψ → χ) → ((φ → ψ) → (φ → χ))
  ⊢' ((ψ →' χ) →' ((φ →' ψ) →' (φ →' χ))) :=
(mp _ _ (mp _ _ (p2 _ _ _) (mp _ _ (p1 _ _) (p2 _ _ _))) (p1 _ _))

lemma likemp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ φ → ((φ → ψ) → ψ)
  ⊢' (φ →' ((φ →' ψ) →' ψ)) :=
(mp _ _ (mp _ _ hs1 (mp _ _ (p2 _ _ _) iden)) (p1 _ _))

lemma imp_if_imp_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ → χ) ⇒  ⊢ φ → (ψ → χ)
  ⊢' (φ →' χ) → ⊢' (φ →' (ψ →' χ)) :=
λ h1, mp _ _ (mp _ _ (p2 _ _ _) (mp _ _ (p1 _ _) (p1 _ _))) h1

lemma imp_switch {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ φ → (ψ → χ) ⇒  ⊢ ψ → (φ → χ)
  ⊢' (φ →' (ψ →' χ)) → ⊢' (ψ →' (φ →' χ)) :=
λ h1, mp _ _ (mp _ _ (p2 _ _ _ ) (mp _ _ (p1 _ _) (mp _ _ (p2 _ _ _) h1))) (p1 _ _)

-- ⊢ (φ → (ψ → χ)) → (ψ → (φ → χ))
lemma l2 {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
  ⊢' ((φ →' (ψ →' χ)) →' (ψ →' (φ →' χ))) :=
(mp _ _ (mp _ _ (p2 _ _ _) (cut (p2 _ _ _) hs1)) (mp _ _ (p1 _ _) (p1 _ _)))

-- ⊢ (φ → ψ) → ((ψ → χ) → (φ → χ))
lemma hs2 {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
  ⊢' ((φ →' ψ) →' ((ψ →' χ) →' (φ →' χ))) :=
(mp _ _ l2 hs1)

-- ⊢ (φ → (φ → ψ)) → (φ → ψ)
lemma double_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
  ⊢' ((φ →' (φ →' ψ)) →' (φ →' ψ)) :=
mp _ _ (p2 _ _ _) (imp_switch iden)

lemma imp_imp_iff_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {θ φ ψ : form} :
-- ⊢ θ → (φ → (φ → ψ)) ⇔ ⊢ θ → (φ → ψ)
  ⊢' (θ →' (φ →' (φ →' ψ))) ↔ ⊢' (θ →' (φ →' ψ)) :=
begin
  split,
  {intro h1,
  exact cut h1 double_imp},
  {intro h1,
  exact cut h1 (p1 _ _)}
end

lemma imp_shift {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {θ φ ψ χ : form} :
-- ⊢ θ → (φ → (ψ → χ)) ⇔ ⊢ θ → (ψ → (φ → χ))
  ⊢' (θ →' (φ →' (ψ →' χ))) ↔ ⊢' (θ →' (ψ →' (φ →' χ))) :=
begin
  split,
  repeat
  { intro h1,
    apply cut,
    { exact h1, },
    { apply imp_switch (cut (p1 _ _ ) (imp_switch (p2 _ _ _))), }, },
end

----------------------------------------------------------
-- Additional "Cuts"
----------------------------------------------------------

lemma cut1 {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ θ : form} :
-- ⊢ θ → (φ → ψ) ⇒  ⊢ (ψ → χ) ⇒ ⊢ θ → (φ → χ)
  ⊢' (θ →' (φ →' ψ)) → ⊢' (ψ →' χ) → ⊢' (θ →' (φ →' χ)) :=
λ h1 h2, cut h1 (mp _ _ (p2 _ _ _) (mp _ _ (p1 _ _ ) h2))

lemma cut2 {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ θ : form} :
-- ⊢ (φ → ψ) ⇒  ⊢ θ → (ψ → χ) ⇒ ⊢ θ → (φ → χ)
  ⊢' (φ →' ψ) → ⊢' (θ →' (ψ →' χ)) → ⊢' (θ →' (φ →' χ)) :=
λ h1 h2, imp_switch (cut h1 (imp_switch h2))

----------------------------------------------------------
-- Iff
----------------------------------------------------------
lemma iff_l {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ φ ↔ ψ ⇒ ⊢ φ → ψ
  ⊢' (φ ↔' ψ) → ⊢' (φ →' ψ) :=
mp _ _ (p5 _ _)

lemma iff_r {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ φ ↔ ψ ⇒ ⊢ ψ → φ
  ⊢' (φ ↔' ψ) → ⊢' (ψ →' φ) :=
mp _ _ (p6 _ _)

lemma iff_iden {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ φ ↔ φ
  ⊢' (φ ↔' φ) :=
mp _ _ (mp _ _ (p4 _ _) iden) iden

-- Motivation: corresponds to Lean's `iff.intro`
@[simp] lemma ax_iff_intro {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form}
  (h1 : ⊢' (φ →' ψ)) (h2 : ⊢' (ψ →' φ)) : ⊢' (φ ↔' ψ) :=
begin
  apply MP' h2,
  apply MP' h1,
  exact p4 _ _,
end

lemma iff_cut {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ φ ↔ ψ ⇒ ⊢ ψ → φ
  ⊢' (φ ↔' ψ) → ⊢' (ψ ↔' χ) → ⊢' (φ ↔' χ)  :=
begin
  intros h1 h2,
  apply ax_iff_intro,
  { apply cut,
    exact iff_l h1,
    exact iff_l h2, },
  { apply cut,
    exact iff_r h2,
    exact iff_r h1, },
end

/-- `φ` is provable iff `ψ` is, if it's provable `φ` and `ψ` are equivalent.

If we have the deduction theorem, the converse is also true: Pformulas are provably equivalent iff
their provability is equivalent. -/
-- Motivation: allows rewriting after proving equivalence
lemma ax_iff_mp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} (hiff : ⊢' (φ ↔' ψ)) :
  ⊢' φ ↔ ⊢' ψ :=
⟨mp _ _ (iff_l hiff), mp _ _ (iff_r hiff)⟩

----------------------------------------------------------
-- Top and Bot
----------------------------------------------------------
lemma prtrue {form : Type} [pf : Pformula form] [pax : Pformula_ax form] :
-- ⊢ ⊤
  ⊢' (⊤' : form) := iden

----------------------------------------------------------
-- Negation
----------------------------------------------------------
lemma dne {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ ¬ ¬ φ → φ
  ⊢' ((¬' (¬' φ)) →' φ) :=
cut (cut (p1 _ _) (cut (p7 _ _) (p7 _ _))) (mp _ _ likemp (p1 φ φ))

lemma dni {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ φ → ¬ ¬ φ
  ⊢' (φ →' (¬' (¬' φ))) :=
mp _ _ (p7 _ _) dne

lemma nnn_bot {form : Type} [pf : Pformula form] [pax : Pformula_ax form] :
-- ⊢ ¬ ¬ ¬ ⊤
  ⊢' (¬' (¬' (¬' ⊥')) : form) :=
mp _ _ dni prtrue

lemma iff_dne {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ ¬ ¬ φ ↔ φ
  ⊢' ((¬' (¬' φ)) ↔' φ) :=
mp _ _ (mp _ _ (p4 _ _) dne) dni

lemma iff_dni {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ φ ↔ ¬ ¬ φ
  ⊢' (φ ↔' (¬' (¬' φ))) :=
mp _ _ (mp _ _ (p4 _ _) dni) dne

lemma not_contra {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ ¬ (φ ∧ ¬ φ)
  ⊢' (¬' (φ ∧' (¬' φ))) :=
mp _ _ (mp _ _ (p3 _ _) (cut dne (p6 _ _))) (cut dne (p5 _ _))

lemma not_contra_equiv_true {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ ¬ (φ ∧ ¬ φ) ↔' ¬ ⊥
  ⊢' ((¬' (φ ∧' (¬' φ))) ↔' (¬' ⊥') ) :=
begin
  exact (mp _ _ (mp _ _ (p4 _ _) (mp _ _ (p1 _ _) iden)) (mp _ _ (p1 _ _) not_contra))
end

lemma not_and_subst {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ ↔' ψ) ⇒ (⊢ ¬ (χ ∧ φ) ⇔ ⊢ ¬ (χ ∧ ψ))
  ⊢' (φ ↔' ψ) → (⊢' (¬' (χ ∧' φ)) ↔ ⊢' (¬' (χ ∧' ψ))) :=
begin
  intro h1,
  split,
  {intro h2,
  exact mp _ _ (mp _ _ (p3 _ _) (mp _ _ (p1 _ _) h2))
    (cut dne (mp _ _ double_imp (cut2
      (cut (p6 _ _) (mp _ _ (p6 _ _) h1))
      (cut (p5 _ _) (p4 _ _)))))},
  {intro h2,
  exact mp _ _ (mp _ _ (p3 _ _) (mp _ _ (p1 _ _) h2))
    (cut dne (mp _ _ double_imp (cut2
      (cut (p6 _ _) (mp _ _ (p5 _ _) h1))
      (cut (p5 _ _) (p4 _ _)))))},
end

lemma contrapos {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ ¬ ψ → ¬ φ ⇔ ⊢ φ → ψ
  ⊢' ((¬' ψ) →' (¬' φ)) ↔ ⊢' (φ →' ψ) :=
begin
  split,
  intro h1,
  exact mp _ _ (p7 _ _) h1,
  intro h1,
  exact mp _ _ (cut (cut (mp _ _ hs1 dni) (mp _ _ hs2 dne)) (p7 _ _)) h1,
end

lemma iff_not {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ φ ↔' ψ ⇒ ⊢ ¬ φ ↔' ¬ ψ
  ⊢' (φ ↔' ψ) → ⊢' ((¬' ψ) ↔' (¬' φ)) :=
begin
  intro h1,
  have h2 : ⊢' (φ →' ψ), from mp _ _ (p5 _ _) h1,
  have h3 : ⊢' (ψ →' φ), from mp _ _ (p6 _ _) h1,
  rw ←contrapos at h2,
  rw ←contrapos at h3,
  exact (mp _ _ (mp _ _ (p4 _ _) h2) h3)
end

lemma contra_equiv_false {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ (φ ∧ ¬ φ) ↔' ⊥
  ⊢' ((φ ∧' (¬' φ)) ↔' ⊥') :=
begin
  have h1 := iff_not not_contra_equiv_true,
  exact (mp _ _ (mp _ _ (p4 _ _) (cut dni (cut (mp _ _ (p6 _ _) h1) dne)))
    (cut dni (cut (mp _ _ (p5 _ _) h1) dne)))
end

lemma contra_imp_imp_false {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ ¬ φ → φ → ⊥
  ⊢' ((¬' φ) →' (φ →' ⊥')) := iden

lemma contra_not_imp_false_ax {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ ¬ φ → ⊥ ⇒ ⊢ φ
  ⊢' ((¬' (φ)) →' ⊥') → ⊢' φ :=
begin
  intro h,
  apply mp,
  exact dne,
  exact h,
end

lemma contra_imp_false_not_ax {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢  φ → ⊥ ⇒ ⊢ ¬ φ
  ⊢' (φ →' ⊥') → ⊢' (¬' (φ)) := by simp

lemma contra_imp_imp_false' {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ φ → ¬ φ → ⊥
  ⊢' ((φ) →' (¬' φ →' ⊥')) := dni

lemma contra_iff_false_ax_not {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ ¬ φ ↔ ⊢ φ → ⊥
  ⊢' (¬' φ) ↔ ⊢' (φ →' ⊥') :=
by simp

lemma by_contra_ax {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ φ → ψ → ⊥ ⇒ ⊢ φ → ¬ ψ
 ⊢' (φ →' (ψ →' ⊥')) → ⊢' (φ →' (¬' ψ)) :=
by simp

----------------------------------------------------------
-- By contradiction
----------------------------------------------------------
@[simp] lemma explosion {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ ⊥ → φ
  ⊢' (⊥' →' φ) :=
begin
  apply contrapos.mp, exact (mp _ _ (p1 _ _) iden)
end

@[simp] lemma contra_explosion {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ φ → ¬ φ → ψ
  ⊢' (φ →' (¬' φ) →' ψ) :=
begin
  apply cut1,
  exact contra_imp_imp_false',
  exact explosion,
end

lemma ax_bot_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ (⊤ → ⊥) ⇒ ⊢ (φ → ⊥)
  ⊢' (⊤' →' ⊥' : form) → ⊢' (φ →' ⊥') :=
begin
  intro hf,
  apply mp,
  apply mp,
  apply p2,
  exact ⊤',
  apply mp,
  exact p1 _ _,
  exact hf,
  apply mp,
  exact p1 _ _,
  exact prtrue,
end

/-- If there is any formula that cannot be proven, the theory is consistent. -/
-- Motivation: a lot of places assume `¬ ⊢ ⊥'` so it's worth trying to reduce these assumptions.
lemma consistent_of_not_ax {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form}
  (hφ : ¬ ⊢' φ) : ¬ ⊢' (⊥' : form) :=
mt (mp _ _ explosion) hφ

----------------------------------------------------------
-- And
----------------------------------------------------------

-- Motivation: easier to prove Lean's `and` than in `ax`
@[simp] lemma ax_and {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
  ⊢' (φ ∧' ψ) ↔ ⊢' φ ∧ ⊢' ψ :=
⟨λ h, ⟨mp _ _ (p5 _ _) h, mp _ _ (p6 _ _) h⟩,
 λ ⟨h1, h2⟩, mp _ _ (mp _ _ (p4 _ _) h1) h2⟩

lemma and_switch {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ (φ ∧ ψ) ↔ (ψ ∧ φ)
  ⊢' ((φ ∧' ψ) ↔' (ψ ∧' φ)) :=
begin
  exact (mp _ _ (mp _ _ (p4 _ _) (mp _ _ double_imp (cut (p5 _ _)
    (imp_switch (cut (p6 _ _) (p4 _ _))))))
    (mp _ _ double_imp (cut (p5 _ _) (imp_switch (cut (p6 _ _) (p4 _ _))))))
end

lemma left_and_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ ψ → ((φ ∧ ψ) → χ ) ⇒ ⊢ (φ ∧ ψ) → χ
  ⊢' (ψ →' ((φ ∧' ψ) →' χ)) → ⊢' ((φ ∧' ψ) →' χ) :=
λ h1, mp _ _ double_imp (cut (p6 _ _) h1)

lemma and_right_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ ∧ ψ) → χ  ⇔ ⊢  ψ → (φ → χ)
  ⊢' ((φ ∧' ψ) →' χ) ↔ ⊢' (ψ →' (φ →' χ)) :=
begin
  split,
  {intro h1,
  exact mp _ _ (cut2 (p1 _ _) (p2 _ _ _)) (cut1 (p4 _ _) h1)},
  {intro h1,
  exact left_and_imp (cut2 (p5 _ _) h1) },
end

lemma phi_and_true {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢  (φ ∧ ⊤) ↔' φ
  ⊢' ((φ ∧' (¬' ⊥')) ↔' φ) :=
begin
  exact (mp _ _ (mp _ _ (p4 _ _) (p5 _ _)) (mp _ _ (imp_switch (p4 _ _)) iden))
end

lemma true_and_phi {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢  (⊤ ∧ φ) ↔ φ
  ⊢' (((¬' ⊥') ∧' φ) ↔' φ) :=
begin
  exact mp _ _(mp _ _ (p4 _ _) (cut (iff_l and_switch) (iff_l phi_and_true)))
    (mp _ _ (p4 _ _) iden),
end

lemma imp_and_and_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ θ : form} :
-- ⊢ (φ → ψ) ∧ (χ → θ)⇒ ⊢ (φ ∧ χ) → (ψ ∧ θ)
  ⊢' (((φ →' ψ) ∧' (χ →' θ))) → ⊢' (((φ ∧' χ) →' (ψ ∧' θ))) :=
begin
  intro h,
  exact (mp _ _ double_imp (cut (cut (p5 _ _) (mp _ _ (p5 _ _) h))
    (cut2 (cut (p6 _ _) (mp _ _ (p6 _ _) h)) (p4 _ _))))
end

lemma imp_and_and_and_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {a b c d e f : form} :
-- ⊢ (φ → ψ →) ∧ (χ → θ)⇒ ⊢ (φ ∧ χ) → (ψ ∧ θ) → (φ ∧ χ)
  ⊢' (((a →' b →' c) ∧' (d →' e →' f))) → ⊢' (((a ∧' d) →' (b ∧' e) →' (c ∧' f))) :=
begin
  intro h,
  apply cut (imp_and_and_imp h),
  apply mp,
  apply double_imp,
  apply cut2 (p5 _ _),
  apply cut (p6 _ _),
  apply imp_shift.mp,
  apply imp_switch,
  apply mp,
  apply double_imp,
  apply cut2 (p5 _ _),
  apply cut (p6 _ _),
  apply imp_shift.mp,
  apply cut1,
  apply likemp,
  apply imp_switch,
  apply imp_shift.mp,
  apply cut1,
  apply likemp,
  exact p4 _ _,
end

lemma and_switch_ax {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ (φ ∧ ψ) ⇔ ⊢ (ψ ∧ φ)
  (⊢' (φ ∧' ψ)) ↔ (⊢' (ψ ∧' φ)) :=
begin
  split,
  repeat { exact λ h, mp _ _ (mp _ _ (p5 _ _) and_switch) h, },
end

lemma and_commute {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ ((φ ∧ ψ) ∧ χ) ↔' (φ ∧ (ψ ∧ χ))
  ⊢' (((φ ∧' ψ) ∧' χ) ↔' (φ ∧' (ψ ∧' χ))) :=
begin
  exact mp _ _ (mp _ _ (p4 _ _) (mp _ _ double_imp (imp_imp_iff_imp.mp
  (cut (cut (p5 _ _) (p6 _ _)) (cut2 (p6 _ _) (cut1 (p4 _ _)
    (imp_switch (cut (cut (p5 _ _) (p5 _ _)) (p4 _ _)))))))))
  (mp _ _ double_imp (imp_imp_iff_imp.mp (cut (cut (p6 _ _) (p5 _ _))
  (imp_switch (cut (p5 _ _) (cut1 (p4 _ _) (cut2 (cut (p6 _ _) (p6 _ _)) (p4 _ _))))))))
end

lemma imp_and_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ φ → ψ ⇒ ⊢ (χ ∧ φ) → (χ ∧ ψ)
  ⊢' (φ →' ψ) → ⊢' ((χ ∧' φ) →' (χ ∧' ψ)) :=
begin
  intros h1,
  exact imp_and_and_imp (mp _ _ (mp _ _ (p4 _ _) iden) h1)
end

lemma and_iden {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
-- ⊢ φ → (φ ∧ φ)
  ⊢' (φ →' (φ ∧' φ)) :=
begin
  have hdi : ⊢' ((φ →' (φ →' (φ ∧' φ))) →' (φ →' (φ ∧' φ))), from double_imp,
  apply mp _ _ hdi,
  exact (p4 _ _),
end

lemma imp_and_iden {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ φ → ψ ⇒ ⊢ φ → (φ ∧ ψ)
  ⊢' (φ →' ψ) → ⊢' (φ →' (φ ∧' ψ)) :=
begin
  intro h,
  have hab : ⊢' (φ →' (φ ∧' φ)), from and_iden,
  have hbc : ⊢' ((φ ∧' φ) →' (φ ∧' ψ)), from imp_and_imp h,
  exact cut hab hbc,
end

lemma imp_imp_and {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ → ψ) ⇒ ⊢ (φ → χ) ⇒ ⊢ φ → (ψ ∧ χ)
  ⊢' (φ →' ψ) → ⊢' (φ →' χ) → ⊢' (φ →' (ψ ∧' χ)) :=
begin
  intros h1 h2,
  apply cut,
  { exact and_iden, },
  { apply imp_and_and_imp,
    apply ax_and.mpr,
    split, exact h1, exact h2, },
end

lemma imp_and_r {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ → ψ) ⇒ ⊢ (χ ∧ φ) → ψ
  ⊢' (φ →' ψ) → ⊢' ((χ ∧' φ) →' ψ) :=
begin
  intro h,
  apply cut,
  exact p6 _ _,
  exact h,
end

lemma imp_and_l {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ → ψ) ⇒ ⊢ (φ ∧ χ) → ψ
  ⊢' (φ →' ψ) → ⊢' ((φ ∧' χ) →' ψ) :=
begin
  intro h,
  apply cut,
  exact p5 _ _,
  exact h,
end

lemma iff_and_top {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ (φ ∧ ⊤) → ψ ⇔ ⊢ (φ → ψ)
  ⊢' ((φ ∧' ⊤') →' ψ) ↔ ⊢' (φ →' ψ) :=
begin
  split,
  { intro h,
    apply cut,
    { exact mp _ _ (p6 _ _ ) phi_and_true, },
    { exact h,} },
  { intro h,
    apply cut,
    apply p5,
    exact h, }
end

lemma remove_and_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ ∧ φ ∧ ψ) → χ ⇒ ⊢ (φ ∧ ψ) → χ
  ⊢' ((φ ∧' (φ ∧' (ψ))) →' χ) → ⊢' ((φ ∧' (ψ)) →' χ) :=
begin
  intro h,
  apply cut,
  { exact imp_imp_and (p5 _ _) (iden), },
  { exact h, },
end

lemma imp_and {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ → (ψ ∧ χ)) → (φ → ψ)
  ⊢' ((φ →' (ψ ∧' χ)) →' (φ →' ψ)) :=
begin
  apply mp,
  apply p2,
  apply mp,
  apply p1,
  apply p5,
end

lemma and_cut_l {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ ((φ ↔ χ) ⇒ ⊢ ((φ ∧ ψ) ↔ (χ ∧ ψ))
  ⊢' (φ ↔' χ) → ⊢' ((φ ∧' ψ) ↔' (χ ∧' ψ)) :=
begin
  intro hl,
  refine ax_iff_intro _ _,
  { apply imp_imp_and,
    { apply cut,
      apply p5,
      apply iff_l,
      exact hl, },
    { exact p6 _ _, }, },
  { apply imp_imp_and,
    { apply cut,
      apply p5,
      apply iff_r,
      exact hl, },
    { exact p6 _ _, }, },
end

lemma and_cut_r {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ ((ψ ↔ χ) ⇒ ⊢ ((φ ∧ ψ) ↔ (φ ∧ χ))
  ⊢' (ψ ↔' χ) → ⊢' ((φ ∧' ψ) ↔' (φ ∧' χ)) :=
begin
  intro hr,
  refine ax_iff_intro _ _,
  { apply imp_imp_and,
    { exact p5 _ _, },
    { apply cut,
      apply p6,
      apply iff_l,
      exact hr, }, },
  { apply imp_imp_and,
    { exact p5 _ _, },
    { apply cut,
      apply p6,
      apply iff_r,
      exact hr, }, },
end

-- Motivation: for simplication in combination with `ax_iff_mp`
@[simp] lemma ax_and_top_iff {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
  ⊢' ((φ ∧' ⊤') ↔' φ) :=
by simpa using @phi_and_true _ _ _ φ

----------------------------------------------------------
-- Simplification Rules
----------------------------------------------------------

-- Motivation: corresponds more or less to Lean's `imp_congr`
@[simp] lemma ax_imp_congr_left {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ φ' ψ : form}
  (hl : ⊢' (φ ↔' φ')) : ⊢' ((φ →' ψ) ↔' (φ' →' ψ)) :=
ax_iff_intro
  (mp _ _ (imp_switch hs1) (iff_r hl))
  (mp _ _ (imp_switch hs1) (iff_l hl))

-- Motivation: for simplication in combination with `ax_iff_mp`
@[simp] lemma ax_top_imp_iff {form : Type} [pf : Pformula form] [pax : Pformula_ax form] (φ : form) :
  ⊢' ((⊤' →' φ) ↔' φ) :=
ax_iff_intro
  (combS combI (combK prtrue)) -- λ h, h prtrue
  (p1 _ _)

    -- Motivation: for simplication in combination with `ax_iff_mp`
@[simp] lemma ax_not_bot_imp_iff {form : Type} [pf : Pformula form] [pax : Pformula_ax form] (φ : form) :
  ⊢' (((¬' ⊥' ) →' φ) ↔' φ) :=
ax_top_imp_iff φ

-- Motivation: useful simplification lemma
@[simp] lemma ax_top_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
  ⊢' (⊤' →' φ) ↔ ⊢' φ :=
ax_iff_mp (ax_top_imp_iff φ)

@[simp] lemma ax_not_bot_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ : form} :
  ⊢' ((¬' ⊥' ) →' φ) ↔ ⊢' φ := ax_top_imp

----------------------------------------------------------
-- Demorgans
----------------------------------------------------------
lemma demorgans {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ ¬ (φ ∧ ψ) ⇔ ⊢ φ → ¬ ψ
  ⊢' (¬' (φ ∧' ψ)) ↔ ⊢' (φ →' (¬' ψ)) :=
begin
  split,
  { intro h1,
    apply and_right_imp.mp,
    apply cut,
    { exact mp _ _ (p5 _ _) and_switch, },
    { exact h1, }, },
  { intro h1,
    apply (mp _ _ (contrapos.mpr (mp _ _ (p5 _ _) and_switch))),
    exact(and_right_imp.mpr h1), },
end

lemma demorgans' {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
-- ⊢ (¬ φ → ψ) → ¬ (¬ φ ∧ ¬ ψ)
  ⊢' (((¬' φ) →' ψ) →' ¬' (¬' φ ∧' ¬' ψ)) :=
combS2 (combK (p2 _ _ _)) (combK (combS (combK (p6 _ _)) combI))
  (combS2 (combK (p2 _ _ _)) (combS (combK (p1 _ _)) combI) (combK (combS (combK (p5 _ _)) combI)))

lemma demorgans'' {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
  ⊢' (¬' (φ →' ¬' ψ) →' φ ∧' ψ) :=
begin
  rw ←contrapos,
  apply cut _ dni,
  apply imp_switch,
  rw imp_shift,
  apply cut1,
  apply p4,
  exact likemp,
end

lemma demorgans''' {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
  ⊢' (¬' (φ ∧' ψ) ↔' (φ →' (¬' ψ))) :=
begin
  apply ax_iff_intro,
  { refine and_right_imp.mp _,
    refine by_contra_ax _,
    refine and_right_imp.mp _,
    apply cut,
    apply iff_r,
    apply and_commute,
    refine and_right_imp.mpr _,
    refine imp_switch _,
    apply cut,
    apply iff_l,
    apply and_switch,
    exact contra_explosion, },
  { refine contrapos.mp _,
    apply cut,
    apply dne,
    apply cut,
    apply iff_l,
    apply and_switch,
    refine and_right_imp.mpr _,
    apply imp_shift.mpr,
    exact likemp, }
end

lemma demorgans'''' {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
  ⊢' (¬' (φ →' ψ) ↔' (φ ∧' ¬' ψ)) :=
begin
  apply ax_iff_intro,
  { apply contrapos.mp,
    apply cut (iff_l demorgans'''),
    apply @cut _ _ _ _ (φ →' ψ),
    refine imp_switch _,
    apply cut1,
    exact likemp,
    exact dne,
    exact dni, },
  { apply @cut _ _ _ _ ((φ→' ψ) →' ⊥'),
    { apply imp_switch,
      refine imp_imp_iff_imp.mp _,
      apply imp_switch,
      apply cut (p5 _ _),
      apply cut1 likemp,
      apply cut2 (p6 _ _),
      exact contra_explosion, },
    { exact iden, }, },
end

----------------------------------------------------------
-- Or
----------------------------------------------------------
lemma or_cases {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
-- ⊢ (φ → χ) ⇒  ⊢ (ψ → χ) ⇒ ⊢ (¬ φ → ψ) → χ
  ⊢' (φ →' χ) → ⊢' (ψ →' χ) → ⊢' ((¬' φ →' ψ) →' χ) :=
begin
  intros h1 h2,
  have h1' := contrapos.mpr h1,
  have h2' := contrapos.mpr h2,
  have h3 := imp_imp_and h1' h2',
  rw ←contrapos,
  apply by_contra_ax,
  apply cut h3,
  apply @cut _ _ _ _ (¬' (¬' φ →' ψ)) _,
  {
    refine contrapos.mp _,
    apply cut,
    apply dne,
    exact demorgans',
  },
  exact contra_imp_imp_false,
end

lemma or_inl {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
--  ⇒  ⊢ (φ) → (¬ φ → ψ)
  ⊢' ((φ) →' ((¬' φ) →' ψ)) :=
begin
  apply cut1,
  exact contra_imp_imp_false',
  exact explosion,
end

lemma or_inr {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
--  ⇒  ⊢ (φ) → ⊢ (¬ φ → χ)
  ⊢' ((ψ) →' ((¬' φ) →' ψ)) := p1 ψ (¬' φ)

  def disjunct_rw_iff {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
  ⊢' (((¬' φ) →' ψ) ↔' (finite_disjunction (φ :: [ψ]))) :=
begin
  apply ax_iff_intro,
  { simp [finite_disjunction],
    apply imp_switch,
    apply cut1,
    exact likemp,
    exact contra_explosion, },
  { simp [finite_disjunction],
    apply imp_switch,
    apply cut1,
    exact likemp,
    apply @cut _ _ _ _ (¬' (¬' ψ)),
    exact iden,
    exact dne, },
end

lemma or_switch {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
  ⊢' ((¬' φ →' ψ) ↔' (¬' ψ →' φ)) :=
begin
  refine ax_iff_intro _ _,
  repeat
  { apply or_cases,
    exact p1 _ _,
    exact or_inl, },
end

-- ⊢ ((φ ↔ z) ⇒ ⊢ ((φ ∨ y) ↔ (z ∨ y))
lemma or_cut_l {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} (hl : ⊢' (φ ↔' χ)) :
  ⊢' ((¬' φ →' ψ) ↔' (¬' χ →' ψ)) :=
begin
  refine ax_iff_intro _ _,
  { apply or_cases,
    { apply cut,
      apply iff_l hl,
      exact or_inl, },
    { exact p1 _ _, }, },
  { apply or_cases,
    { apply cut,
      apply iff_r hl,
      exact or_inl, },
    { exact p1 _ _, }, },
end

-- ⊢ ((ψ ↔ z) ⇒ ⊢ ((φ ∨ y) ↔ (φ ∨ z))
lemma or_cut_r {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} (hr : ⊢' (ψ ↔' χ)) :
  ⊢' ((¬' φ →' ψ) ↔' (¬' φ →' χ)) :=
begin
  apply iff_cut,
  exact or_switch,
  apply iff_cut,
  exact or_cut_l hr,
  exact or_switch,
end

-- ⊢ ((φ ∧ ψ) ∨ (φ ∧ χ)) ↔ (φ ∧ (ψ ∨ χ))
lemma distr_or_and {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ χ : form} :
  ⊢' (((¬' (φ ∧' ψ)) →' (φ ∧' χ)) ↔' (φ ∧' ((¬' ψ) →' χ))) :=
begin
  apply ax_iff_intro,
  { apply or_cases,
    { apply imp_and_imp,
      exact contra_explosion, },
    { apply imp_and_imp,
      exact p1 _ _, }, },
  { apply and_right_imp.mpr,
    refine imp_shift.mp _,
    apply imp_switch,
    apply cut,
    apply iff_l,
    apply demorgans''',
    apply imp_shift.mp,
    refine imp_imp_iff_imp.mp _,
    apply imp_switch,
    apply cut1,
    exact likemp,
    apply imp_switch,
    apply imp_shift.mp,
    apply imp_switch,
    apply imp_shift.mp,
    apply imp_switch,
    apply cut1,
    exact likemp,
    apply imp_switch,
    exact p4 _ _, }
end

----------------------------------------------------------
-- Finite Conjunction
----------------------------------------------------------
-- empty conjunction = ⊤
@[simp] lemma finite_conjunction_nil {form : Type} [pf : Pformula form] [pax : Pformula_ax form] :
  finite_conjunction ([] : list form) = ⊤' := rfl

--  finite_conjunction (φ :: φs) = φ ∧ (finite_conjunction φs)
@[simp] lemma finite_conjunction_cons {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  (φ : form) (φs : list form) : finite_conjunction (φ :: φs) = φ ∧' finite_conjunction φs := rfl

lemma fin_conj_simp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] (φ : form) :
-- ⊢ ¬ finite_conjunction [φ, ¬ φ]
  ⊢' (¬' (finite_conjunction ([φ, ¬' φ]))) :=
begin
  simp [finite_conjunction],
  rw not_and_subst,
  exact not_contra,
  exact phi_and_true,
end

lemma imp_conj_imp_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  {φ ψ : form} {φs : list (form)} :
--  ⊢ finite_conjunction (φ :: φs) → ψ ⇔  ⊢ (finite_conjunction φs) → (φ → ψ)
  ⊢' ((finite_conjunction (φ :: φs)) →' ψ) ↔  ⊢' ((finite_conjunction φs) →' (φ →' ψ)) :=
begin
  split,
  { intro h,
    simp at h,
    exact and_right_imp.mp h, },
  { intro h,
    simp,
    exact and_right_imp.mpr h, },
end

lemma fin_conj_s_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  {Γ : set form} {φ ψ : form } {φs : list form} :
--  ⊢ finite_conjunction (φ :: φs) → (φ → ψ) ⇒  ⊢ (finite_conjunction φs) → (φ → ψ)
  ⊢' ((finite_conjunction (φ :: φs)) →' (φ →' ψ)) →  ⊢' ((finite_conjunction φs) →' (φ →' ψ)) :=
λ h, imp_imp_iff_imp.mp (imp_conj_imp_imp.mp h)

lemma fin_conj_append {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φs φs' : list (form)} :
--  ⊢ finite_conjunction φs' ∧ finite_conjunction φs ↔ finite_conjunction (φs' ++ φs)
  ⊢' (((finite_conjunction φs') ∧' (finite_conjunction φs)) ↔' (finite_conjunction (φs' ++ φs))) :=
begin
  induction φs', rw finite_conjunction,
  exact (mp _ _ (mp _ _ (p4 _ _) (cut (mp _ _ (p6 _ _) and_switch) (mp _ _ (p5 _ _) phi_and_true)))
    (cut (mp _ _ (p6 _ _) phi_and_true) (mp _ _ (p5 _ _) and_switch))),
  exact mp _ _ (mp _ _ (p4 _ _) (cut (mp _ _ (p5 _ _) and_commute)
    (imp_and_imp (mp _ _ (p5 _ _) φs'_ih))))
    (cut iden (cut (imp_and_imp (mp _ _ (p6 _ _) φs'_ih)) (mp _ _ (p6 _ _) and_commute)))
end

lemma fin_conj_repeat {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  {φ : form} {φs : list form} :
-- ⊢ φ → finite_conjunction [φ, φ, ...]
  (∀ ψ ∈ φs, ψ = φ) →  ⊢' (φ →' (finite_conjunction φs)) :=
begin
  intros h1, induction φs,
  simp[finite_conjunction],
  exact mp _ _ (p1 _ _) prtrue,
  rw finite_conjunction, simp at *,
  cases h1 with h1 h2,
  subst h1,
  exact cut (mp _ _ double_imp (p4 _ _)) (imp_and_and_imp (mp _ _ (mp _ _ (p4 _ _) iden) (φs_ih h2))),
end

lemma neg_fin_conj_repeat {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  {φ : form} {φs : list form} (hnpr : ¬ ( ⊢' (⊥' : form))) :
-- ⊢ [¬φ, ¬φ, ...] ⇒ ⊢ φ
  (∀ ψ ∈ φs, ψ = ¬' φ) →  ⊢' (¬' (finite_conjunction φs)) →  ⊢' φ :=
begin
  intros h1 h2, induction φs,
  simp[finite_conjunction] at h2,
  have hbot : ⊢' ⊥',
  { apply mp _ _ dne,
    simp,
    exact h2, },
  exact absurd hbot (hnpr),
  repeat {rw fin_conj at *}, simp at *,
  cases h1 with h1 h3,
  have h5 := contrapos.mpr (fin_conj_repeat h3),
  subst h1,
  apply mp _ _ (mp _ _ (p3 _ _) (contrapos.mpr (cut h5 dne))),
  have h6 := iff_not and_switch,
  apply contrapos.mpr (cut ((demorgans.mp) (mp _ _ (mp _ _ (p6 _ _) (h6)) h2)) dne),
end

lemma finite_conj_forall_iff {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  {φs : list form} : (∀ φ ∈ φs, ⊢' φ) ↔ ⊢' (finite_conjunction φs) :=
begin
  induction φs,
  { simp [finite_conjunction], },
  { unfold finite_conjunction,
    split,
    { intro h,
      rw ax_and,
      split,
      { apply h,
        simp },
      { apply φs_ih.mp,
        intros x hx,
        apply h,
        simp [hx], }, },
    { intros h x hx,
      cases hx,
      { simp [hx] at *,
        exact h.left, },
      { rw ax_and at h,
        apply φs_ih.mpr h.right,
        exact hx, }, }, },
end

lemma finite_conj_forall_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φs : list form} :
  (∀ x ∈ φs, ⊢' ((finite_conjunction φs) →' x)) :=
begin
  induction φs,
  { simp only [list.not_mem_nil, forall_false_left, implies_true_iff], },
  { intros x hx,
    unfold finite_conjunction,
    cases hx,
    { simp [hx] at *,
      exact p5 _ _, },
    { apply cut,
      { apply iff_l,
        exact and_switch, },
      { refine imp_and_l _,
        exact φs_ih x hx, }, }, },
end

lemma finite_conj_imp {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φs : list form}
  {φ : form} (h : φ ∈ φs) :
  ⊢' ((finite_conjunction φs) →' φ) := finite_conj_forall_imp φ h

lemma noin_imp_nfin_con {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φs : list form}
  {φ : form} (h : φ ∈ φs) :
  ⊢' ((¬' φ) →' ¬' (finite_conjunction φs)) := contrapos.mpr (finite_conj_imp h)

lemma demorans_fin_con {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  {φs : list (form)} :
  ⊢' ((¬' (finite_conjunction φs)) ↔' ((finite_disjunction (list.map (¬') φs)))) :=
begin
  induction φs with φ φs ih,
  { apply ax_iff_intro,
    apply dne,
    apply dni, },
  { simp only [finite_disjunction, finite_conjunction],
    apply iff_cut demorgans''',
    apply ax_iff_intro,
    { apply cut2 dne,
      apply imp_switch,
      apply cut1 likemp,
      exact iff_l ih, },
    { apply cut2 dni,
      apply imp_switch,
      apply cut1 likemp,
      exact iff_r ih, }, },
end

lemma contra_con_cons {form : Type} [pf : Pformula form] [pax : Pformula_ax form] (fs gs : list (form)) (x y : form)
  (hax : ⊢' (y ↔' ¬' x)) (hx : x ∈ fs) (hy : y ∈ gs) :
  ⊢' (¬' ((finite_conjunction fs) ∧' (finite_conjunction gs))) :=
begin
  induction' fs with f fs ihf,
  { finish, },
  { induction gs with g gs ihg,
    { finish, },
    { cases hx,
      { cases hy,
        { rw[←hx, ←hy],
          simp[finite_conjunction],
          apply cut (iff_r and_commute),
          apply imp_and_l,
          apply cut (iff_l and_switch),
          apply cut (iff_r and_commute),
          apply imp_and_l,
          rw ←contra_iff_false_ax_not,
          rw demorgans,
          apply iff_l,
          exact hax, },
        { simp[finite_conjunction],
          apply cut (iff_r and_commute),
          apply cut (iff_l and_switch),
          apply cut (iff_r and_commute),
          apply imp_and_l,
          apply cut (iff_l and_switch),
          rw ←contra_iff_false_ax_not,
          apply ihg hy, }, },
      { apply cut (iff_l and_switch),
        apply cut (iff_r and_commute),
        apply cut (iff_l and_switch),
        apply cut (iff_r and_commute),
        apply imp_and_l,
        specialize @ihf pf pax (g :: gs) x y hax hy hx,
        exact ihf, }, }, },
end

----------------------------------------------------------
-- Finite Disjunction
----------------------------------------------------------
def ax_disjunct_rw_iff {form : Type} [pf : Pformula form] [pax : Pformula_ax form] {φ ψ : form} :
  ⊢' ((¬' φ) →' ψ) ↔ ⊢' (finite_disjunction [φ, ψ]) :=
begin
  refine ax_iff_mp _,
  exact disjunct_rw_iff,
end

lemma imp_finite_disjunction {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  (ψ : form) (φs : list (form)) (h : ψ ∈ φs) :
  ⊢' (ψ →' finite_disjunction φs) :=
begin
  induction φs with φ φs ih,
  { by_contradiction, simp at *, exact h, },
  { simp [finite_disjunction] at *,
    cases em (φ = ψ) with hf hf,
    { rw hf at *,
      rw ←and_right_imp,
      apply cut,
      { exact mp _ _ (p5 _ _) and_switch, },
      { apply cut,
        { exact not_contra, },
        { exact explosion, }, }, },
    { cases h,
    { exact false.rec _ (hf (eq.symm h)), },
    { exact imp_if_imp_imp (ih h), }, }, },
end

lemma imp_finite_disjunction_subset {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  (φs φs': list (form)) (hsubset : φs ⊆ φs')  :
  ⊢' (finite_disjunction φs →' finite_disjunction φs')  :=
begin
  induction φs with φ φs ih,
  { simp[finite_disjunction], },
  { simp [finite_disjunction] at *,
    cases hsubset with hφ hsubset,
    specialize ih hsubset,
    have hφs' := imp_finite_disjunction φ φs' hφ,
    apply or_cases,
    exact hφs',
    exact ih,
  },
end

def disjunct_of_disjuncts {form : Type} [pf : Pformula form] [pax : Pformula_ax form] (φs φs': list (form)) :
  ⊢' ((finite_disjunction [(finite_disjunction φs), (finite_disjunction φs')]) ↔'
      (finite_disjunction (φs ++ φs') )) :=
begin
  apply ax_and.mpr,
  split,
  { rw finite_disjunction,
    apply or_cases,
    { apply imp_finite_disjunction_subset,
      simp, },
    { simp [finite_disjunction],
      have hdne := @dne _ _ _ (finite_disjunction φs') ,
      apply cut,
      apply hdne,
      apply imp_finite_disjunction_subset,
      simp, }, },
  { induction' φs,
    { simp [finite_disjunction] at *,
      apply cut1,
      apply p1,
      have hdni := @dni form pf pax (@finite_disjunction form pf φs') ,
      exact hdni, },
    { specialize @ih pf,
      apply or_cases,
      { rw finite_disjunction,
        simp,
        apply cut,
        apply @imp_finite_disjunction form pf pax _ (hd :: φs),
        exact set.mem_insert hd (λ (hd : form), list.mem hd φs),
        apply cut1,
        apply contra_imp_imp_false',
        apply explosion, },
      { apply cut,
        apply @ih pax,
        apply or_cases,
        { apply @cut1 _ _ _ _ (⊥'),
          apply cut,
          apply @imp_finite_disjunction_subset form pf pax _ (hd :: φs),
          simp,
          apply contra_imp_imp_false',
          apply explosion, },
        { unfold finite_disjunction,
          apply p1, }, }, }, },
end

lemma disjunc_disjunct {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  (φs φs' : list (form)) :
  ⊢' ((¬' (finite_disjunction φs) →' finite_disjunction φs')  →' finite_disjunction (φs ++ φs') )  :=
begin
  apply or_cases,
  apply imp_finite_disjunction_subset,
  simp,
  apply imp_finite_disjunction_subset,
  simp,
end

lemma ax_iff_disjunc_disjunct {form : Type} [pf : Pformula form] [pax : Pformula_ax form] (φs φs' : list (form)) :
  ⊢' (¬' (finite_disjunction φs) →' finite_disjunction φs')  ↔ ⊢' (finite_disjunction (φs ++ φs') )  :=
begin
  split,
  { intro h,
    apply MP' h,
    apply disjunc_disjunct, },
  { intro h,
    rw ax_disjunct_rw_iff,
    apply MP' h,
    apply iff_r,
    apply disjunct_of_disjuncts, },
end

lemma iff_disjunc_disjunct {form : Type} [pf : Pformula form] [pax : Pformula_ax form] (φs φs' : list (form)) :
  ⊢' ((¬' (finite_disjunction φs) →' finite_disjunction φs')  ↔' (finite_disjunction (φs ++ φs') ))  :=
begin
  apply ax_iff_intro,
  { apply disjunc_disjunct, },
  { apply cut,
    apply iff_r,
    apply disjunct_of_disjuncts,
    apply iff_r,
    exact disjunct_rw_iff, },
end

lemma demorans_fin_dis {form : Type} [pf : Pformula form] [pax : Pformula_ax form]
  {φs : list (form)} :
  ⊢' ((¬' (finite_disjunction φs)) ↔' ((finite_conjunction (list.map (¬') φs)))) :=
begin
  induction φs with φ φs ih,
  { simp [finite_disjunction, finite_conjunction], },
  { simp only [finite_disjunction, finite_conjunction],
    apply iff_cut demorgans'''',
    apply ax_iff_intro,
    { apply imp_and_and_imp,
      apply ax_and.mpr,
      exact and.intro iden (iff_l ih), },
    { apply imp_and_and_imp,
      apply ax_and.mpr,
      exact and.intro iden (iff_r ih), }, },
end