/-
Author: <Redacted for anonymized submission>
-/
-- import snarks.groth16.declarations
import ...attributes
import ...integral_domain_tactic
import ...general_lemmas.polynomial_degree
import ...general_lemmas.monomial_pow
import data.mv_polynomial.basic
import data.mv_polynomial.funext
import data.polynomial.field_division
import algebra.polynomial.big_operators
-- import ...attributes
import .vars

/-!
# Knowledge Soundness

This file proves the knowledge-soundness property of the Groth16 system for type III pairings, as
presented in "Another Look at Extraction and Randomization of Groth’s zk-SNARK" by
[Baghery et al.](https://eprint.iacr.org/2020/811.pdf), for the Lipmaa SNARK

-/

open_locale big_operators classical

section lipmaa

-- TODO we open mv_polynomial, so we should be able to delete a lot of `mv_polynomial.`
open mv_polynomial

noncomputable theory

universes u

/-- The finite field parameter of our SNARK -/
parameter {F : Type u}
parameter [field F]

/-- The naturals representing:
  n_stmt - the statement size,
  n_wit - the witness size -/
parameters {n_stmt n_wit n_var : ℕ}

/-- u_stmt and u_wit are fin-indexed collections of polynomials from the square span program -/
parameter {u_stmt : fin n_stmt → (polynomial F) }
parameter {u_wit : fin n_wit → (polynomial F) }
parameter {v_stmt : fin n_stmt → (polynomial F) }
parameter {v_wit : fin n_wit → (polynomial F) }
parameter {w_stmt : fin n_stmt → (polynomial F) }
parameter {w_wit : fin n_wit → (polynomial F) }

-- We choose the following exponents
-- def α : ℕ := 6
-- def β : ℕ := 7
-- def γ : ℕ := 0
-- def δ : ℕ := 10
-- def η : ℕ := 5

def α : ℕ := 26
def β : ℕ := 27
def γ : ℕ := 0
def δ : ℕ := 40
def η : ℕ := 24

/-- The roots of the polynomial t -/
parameter {r : fin n_wit → F}
/-- l is the polynomial divisibility by which is used to verify satisfaction of the QAP -/
def l : polynomial F := ∏ i in (finset.fin_range n_wit), (polynomial.X - polynomial.C (r i))
-- TODO this could potentially be spun off into a mathlib definition

/-- Checks whether a statement witness pair satisfies the QAP -/
def satisfying (a_stmt : fin n_stmt → F ) (a_wit : fin n_wit → F) :=
((∑ i in (finset.fin_range n_stmt), a_stmt i • u_stmt i
  + (∑ i in (finset.fin_range n_wit), a_wit i • u_wit i))
  *
(∑ i in (finset.fin_range n_stmt), a_stmt i • v_stmt i
  + (∑ i in (finset.fin_range n_wit), a_wit i • v_wit i))
  -
(∑ i in (finset.fin_range n_stmt), a_stmt i • w_stmt i
  + (∑ i in (finset.fin_range n_wit), a_wit i • w_wit i)))
   %ₘ l = 0

run_cmd mk_simp_attr `crs
run_cmd tactic.add_doc_string `simp_attr.crs "Attribute for defintions of CRS elements"

/-- The modified CRS elements, see fig 3 of the paper  -/
@[crs]
def crs'_P_all_wit_1 (i : fin n_wit) : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ (β - α + δ) * C (u_wit i)
 + (X vars.y) ^ (β - α + γ) * C (v_wit i)
 + (X vars.y) ^ (2 * β - α) * C (w_wit i)
@[crs]
def crs'_P_α_1 : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ α
@[crs]
def crs'_P_powers_1 (i : fin n_var) : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ β * C (polynomial.X ^ (i : ℕ))
@[crs]
def crs'_P_l_1 (i : fin (n_var - 1)) : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ (2 * β - α) * C l * C (polynomial.X ^ (i : ℕ))
-- @[crs]
-- def crs'_P_γ_1 : mv_polynomial vars (polynomial F) :=
--  (X vars.y) ^ γ
@[crs]
def crs'_P_δ_1 : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ δ
@[crs]
def crs'_P_se_α_z_1 : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ α * (X vars.z) -- Only in S_qap^se
@[crs]
def crs'_P_se_powers_1 (i : fin n_var) : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ β * (X vars.z) * C (polynomial.X ^ (i : ℕ))  -- Only in S_qap^se
-- @[crs]
-- def crs'_P_α_2 : mv_polynomial vars (polynomial F) :=
--  (X vars.y) ^ α
@[crs]
def crs'_P_powers_2 (i : fin n_var) : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ β * C (polynomial.X ^ (i : ℕ)) -- same as crs'_P_powers_1

@[crs]
def crs'_V_all_stmt_1 (i : fin n_stmt) : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ (β - η + δ) * C (u_stmt i)
 + (X vars.y) ^ (β - η + γ) * C (v_stmt i)
 + (X vars.y) ^ (2 * β - η) * C (w_stmt i)
-- @[crs]
-- def crs'_V_γ_1 : mv_polynomial vars (polynomial F) :=
--  (X vars.y) ^ γ -- Same as crs'_P_γ_1
@[crs]
def crs'_V_se_z_1 : mv_polynomial vars (polynomial F) :=
  (X vars.z) -- Only in S_qap^se
-- @[crs]
-- def crs'_V_α_2 : mv_polynomial vars (polynomial F) :=
--  (X vars.y) ^ α
@[crs]
def crs'_V_δ_2 : mv_polynomial vars (polynomial F) :=
  (X vars.y) ^ δ
@[crs]
def crs'_V_η_2 : mv_polynomial vars (polynomial F) :=
  (X vars.y) ^ η
@[crs]
def crs'_V_γ_δ_T : mv_polynomial vars (polynomial F) :=
  (X vars.y) ^ (γ + δ)

-- Elements both prover and verifier use

@[crs]
def crs'_γ_1 : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ γ
@[crs]
def crs'_α_2 : mv_polynomial vars (polynomial F) :=
 (X vars.y) ^ α

parameters {A_comp_crs'_P_all_wit_1 : fin n_wit → F}
parameters {A_comp_crs'_P_α_1 : F}
parameters {A_comp_crs'_P_powers_1 : fin n_var → F}
parameters {A_comp_crs'_P_l_1 : fin (n_var - 1) → F}
parameters {A_comp_crs'_γ_1 : F}
parameters {A_comp_crs'_P_δ_1 : F}
-- parameters {A_comp_crs'_P_se_α_z_1 : F}
-- parameters {A_comp_crs'_P_se_powers_1 : fin n_var → F}
parameters {A_comp_crs'_V_all_stmt_1 : fin n_stmt → F}
-- parameters {A_comp_crs'_V_γ_1 : F} -- Same as previous
-- parameters {A_comp_crs'_V_se_z_1 : F}

/-- Polynomial form of A in the adversary's proof representation -/
def A' : mv_polynomial vars (polynomial F) :=
  ∑ i in (finset.fin_range n_wit), (crs'_P_all_wit_1 i) * C (polynomial.C (A_comp_crs'_P_all_wit_1 i))
  +
  crs'_P_α_1 * C (polynomial.C (A_comp_crs'_P_α_1))
  +
  ∑ i in (finset.fin_range n_var), (crs'_P_powers_1 i) * C (polynomial.C (A_comp_crs'_P_powers_1 i))
  +
  ∑ i in (finset.fin_range (n_var - 1)), (crs'_P_l_1 i) * C (polynomial.C (A_comp_crs'_P_l_1 i))
  +
  crs'_γ_1 * C (polynomial.C (A_comp_crs'_γ_1))
  +
  crs'_P_δ_1 * C (polynomial.C (A_comp_crs'_P_δ_1))
  +
  ∑ i in (finset.fin_range n_stmt), (crs'_V_all_stmt_1 i) * C (polynomial.C (A_comp_crs'_V_all_stmt_1 i))

parameters {B_comp_crs'_α_2 : F}
parameters {B_comp_crs'_P_powers_2 : fin n_var → F}
-- parameters {B_comp_crs'_V_α_2 : F} -- Same as previous
parameters {B_comp_crs'_V_δ_2 : F}
parameters {B_comp_crs'_V_η_2 : F}

/-- Polynomial form of B in the adversary's proof representation -/
def B' : mv_polynomial vars (polynomial F) :=
  crs'_α_2 * C (polynomial.C (B_comp_crs'_α_2))
  +
  ∑ i in (finset.fin_range n_var), (crs'_P_powers_2 i) * C (polynomial.C (B_comp_crs'_P_powers_2 i))
  +
  crs'_V_δ_2 * C (polynomial.C (B_comp_crs'_V_δ_2))
  +
  crs'_V_η_2 * C (polynomial.C (B_comp_crs'_V_η_2))

parameters {C_comp_crs'_P_all_wit_1 : fin n_wit → F}
parameters {C_comp_crs'_P_α_1 : F}
parameters {C_comp_crs'_P_powers_1 : fin n_var → F}
parameters {C_comp_crs'_P_l_1 : fin (n_var - 1) → F}
parameters {C_comp_crs'_P_γ_1 : F}
parameters {C_comp_crs'_P_δ_1 : F}
-- parameters {C_comp_crs'_P_se_α_z_1 : F}
-- parameters {C_comp_crs'_P_se_powers_1 : fin n_var → F}
parameters {C_comp_crs'_V_all_stmt_1 : fin n_stmt → F}
-- parameters {C_comp_crs'_V_γ_1 : F} -- Same as previous
-- parameters {C_comp_crs'_V_se_z_1 : F}

/-- Polynomial form of C in the adversary's proof representation -/
def C' : mv_polynomial vars (polynomial F) :=
  ∑ i in (finset.fin_range n_wit), (crs'_P_all_wit_1 i) * C (polynomial.C (C_comp_crs'_P_all_wit_1 i))
  +
  crs'_P_α_1 * C (polynomial.C (C_comp_crs'_P_α_1))
  +
  ∑ i in (finset.fin_range n_var), (crs'_P_powers_1 i) * C (polynomial.C (C_comp_crs'_P_powers_1 i))
  +
  ∑ i in (finset.fin_range (n_var - 1)), (crs'_P_l_1 i) * C (polynomial.C (C_comp_crs'_P_l_1 i))
  +
  crs'_γ_1 * C (polynomial.C (C_comp_crs'_P_γ_1))
  +
  crs'_P_δ_1 * C (polynomial.C (C_comp_crs'_P_δ_1))
  +
  ∑ i in (finset.fin_range n_stmt), (crs'_V_all_stmt_1 i) * C (polynomial.C (C_comp_crs'_V_all_stmt_1 i))

def verified' (a_stmt : fin n_stmt → F ) : Prop :=
  (∑ i in finset.fin_range n_stmt, C (polynomial.C (a_stmt i)) * crs'_V_all_stmt_1 i ) * crs'_V_η_2
  +
  C' * crs'_α_2
  =
  (A' + crs'_γ_1) * (B' + crs'_V_δ_2) - crs'_V_γ_δ_T

-- A, modified to be more like what we see in Baghery et al. - this includes athe extra y^γ we see
-- that the verifier adds.

def A_mod_comp_crs_P_γ_1 := A_comp_crs'_γ_1 + 1

lemma A_mod_transform :
  A' + crs'_γ_1 =
   ∑ i in (finset.fin_range n_wit), (crs'_P_all_wit_1 i) * C (polynomial.C (A_comp_crs'_P_all_wit_1 i))
  +
  crs'_P_α_1 * C (polynomial.C (A_comp_crs'_P_α_1))
  +
  ∑ i in (finset.fin_range n_var), (crs'_P_powers_1 i) * C (polynomial.C (A_comp_crs'_P_powers_1 i))
  +
  ∑ i in (finset.fin_range (n_var - 1)), (crs'_P_l_1 i) * C (polynomial.C (A_comp_crs'_P_l_1 i))
  +
  crs'_γ_1 * C (polynomial.C (A_mod_comp_crs_P_γ_1))
  +
  crs'_P_δ_1 * C (polynomial.C (A_comp_crs'_P_δ_1))
  +
  ∑ i in (finset.fin_range n_stmt), (crs'_V_all_stmt_1 i) * C (polynomial.C (A_comp_crs'_V_all_stmt_1 i)) :=
begin
  rw [A', A_mod_comp_crs_P_γ_1],
  simp only [mv_polynomial.C_add, ring_hom.map_add, ring_hom.map_one, mv_polynomial.C_1, mul_add, mul_one],
  abel,
end

-- B, modified to be more like what we see in Baghery et al. - this includes athe extra y^γ we see
-- that the verifier adds.

def B_mod_comp_crs_V_δ_2 := B_comp_crs'_V_δ_2 + 1

lemma B_mod_transform :
  B' + crs'_V_δ_2 =
  crs'_α_2 * C (polynomial.C (B_comp_crs'_α_2))
  +
  ∑ i in (finset.fin_range n_var), (crs'_P_powers_2 i) * C (polynomial.C (B_comp_crs'_P_powers_2 i))
  +
  crs'_V_δ_2 * C (polynomial.C (B_mod_comp_crs_V_δ_2))
  +
  crs'_V_η_2 * C (polynomial.C (B_comp_crs'_V_η_2)) :=
begin
  rw [B', B_mod_comp_crs_V_δ_2],
  simp only [mv_polynomial.C_add, ring_hom.map_add, ring_hom.map_one, mv_polynomial.C_1, mul_add, mul_one],
  abel,
end

-- TODO use this for lots of profiling data
-- set_option profiler true

open finsupp

-- TODO Add to Mathlib next to C_eq_zero
@[simp] lemma polynomial.C_eq_one (a : F) : polynomial.C a = 1 ↔ a = 1 :=
calc polynomial.C a = 1 ↔ polynomial.C a = polynomial.C 1 : by rw polynomial.C_1
         ... ↔ a = 1 : polynomial.C_inj

lemma simplifier1 (x : fin n_stmt) (a_stmt : fin n_stmt → F )
  : polynomial.C (a_stmt x) * u_stmt x = u_stmt x * polynomial.C (a_stmt x)
  :=
  by ring

lemma simplifier2 (x : fin n_stmt) (a_stmt : fin n_stmt → F )
  : polynomial.C (a_stmt x) * v_stmt x = v_stmt x * polynomial.C (a_stmt x)
  :=
  by ring

lemma polynomial.mul_mod_by_monic (t p : polynomial F) (mt : t.monic) : (t * p) %ₘ t = 0 :=
begin
  rw polynomial.dvd_iff_mod_by_monic_eq_zero,
  apply dvd_mul_right,
  exact mt,
end

lemma A_mod_comp_crs_P_γ_1_mul (p : polynomial F) : p * polynomial.C A_mod_comp_crs_P_γ_1  = polynomial.C A_mod_comp_crs_P_γ_1 * p := by ring

lemma B_mod_comp_crs_V_δ_2_mul (p : polynomial F) : p * polynomial.C B_mod_comp_crs_V_δ_2  = polynomial.C B_mod_comp_crs_V_δ_2 * p := by ring

/-- The main theorem for the soundness of the Lipmaa SNARK. This fixed version does go through. -/
theorem soundness (a_stmt : fin n_stmt → F ) :
  verified' a_stmt
  -> (satisfying a_stmt C_comp_crs'_P_all_wit_1)
:=
begin

  intros eqn',

  rw satisfying,
  simp only [polynomial.smul_eq_C_mul, rearrange_constants_right_hard],
  suffices :
    (∑ (i : fin n_stmt) in finset.fin_range n_stmt, u_stmt i * polynomial.C (a_stmt i) + ∑ (i : fin n_wit) in finset.fin_range n_wit, u_wit i * polynomial.C (C_comp_crs'_P_all_wit_1  i))
    *
    (∑ (i : fin n_stmt) in finset.fin_range n_stmt, v_stmt i * polynomial.C (a_stmt i) + ∑ (i : fin n_wit) in finset.fin_range n_wit, v_wit i * polynomial.C (C_comp_crs'_P_all_wit_1  i))
    =
    (∑ (i : fin n_stmt) in finset.fin_range n_stmt, w_stmt i * polynomial.C (a_stmt i) + ∑ (i : fin n_wit) in finset.fin_range n_wit, w_wit i * polynomial.C (C_comp_crs'_P_all_wit_1  i))
    +
    ∑ (x : fin (n_var - 1)) in finset.fin_range (n_var - 1), l * polynomial.X ^ (x : ℕ) * polynomial.C (C_comp_crs'_P_l_1 x),
  {
    rw <-sub_eq_iff_eq_add' at this,
    have h := congr_arg (%ₘ l) this,
    simp only at h,
    rw h,
    clear this h,
    conv
    begin
      to_lhs,
      congr,
      congr,
      skip,
      funext,
      rw mul_comm,
      rw <-mul_assoc,
      skip,
    end,
    simp_rw mul_comm _ l,
    simp_rw mul_assoc,
    simp_rw mul_comm l _,
    rw <-finset.sum_mul,
    rw mul_comm,
    apply polynomial.mul_mod_by_monic,
    rw l,
    apply monic_of_product_form,
  },

  rw verified' at eqn',
  rw [A_mod_transform, B_mod_transform, C'] at eqn',
  simp only [] with crs at eqn',
  -- simp only [] with polynomial_nf_3 at eqn',
  simp only [α, β, γ, δ, η, algebra.id.smul_eq_mul, nat.succ_sub_succ, nat.sub_zero, nat.zero_mul, nat.mul_zero, nat.zero_add, nat.add_zero, nat.mul_succ, nat.add_succ] at eqn',
  -- done,
  simp only [mv_polynomial.X, C_apply, mv_polynomial.monomial_mul, mv_polynomial.monomial_pow, finsupp.smul_single, one_pow, one_mul, mul_one, add_zero, zero_add, finset.sum_add_distrib, finset.sum_hom, mul_add, add_mul, sum_monomial_hom] at eqn',

  -- have h0 := congr_arg (coeff (single vars.y 0)) eqn',
  -- -- have h1 := congr_arg (coeff (single vars.y 1)) eqn',
  -- -- have h2 := congr_arg (coeff (single vars.y 2)) eqn',
  -- -- have h3 := congr_arg (coeff (single vars.y 3)) eqn',
  -- -- have h4 := congr_arg (coeff (single vars.y 4)) eqn',
  -- have h5 := congr_arg (coeff (single vars.y 5)) eqn',
  -- -- have h6 := congr_arg (coeff (single vars.y 6)) eqn',
  -- have h7 := congr_arg (coeff (single vars.y 7)) eqn',
  -- -- have h8 := congr_arg (coeff (single vars.y 8)) eqn',
  -- -- have h9 := congr_arg (coeff (single vars.y 9)) eqn',
  -- have h10 := congr_arg (coeff (single vars.y 10)) eqn',
  -- -- have h11 := congr_arg (coeff (single vars.y 11)) eqn',
  -- -- have h12 := congr_arg (coeff (single vars.y 12)) eqn',
  -- -- have h13 := congr_arg (coeff (single vars.y 13)) eqn',
  -- have h14 := congr_arg (coeff (single vars.y 14)) eqn',
  -- -- have h15 := congr_arg (coeff (single vars.y 15)) eqn',
  -- -- have h16 := congr_arg (coeff (single vars.y 16)) eqn',
  -- have h17 := congr_arg (coeff (single vars.y 17)) eqn',
  -- have h18 := congr_arg (coeff (single vars.y 18)) eqn',
  -- -- have h19 := congr_arg (coeff (single vars.y 19)) eqn',
  -- have h20 := congr_arg (coeff (single vars.y 20)) eqn',
  -- -- have h21 := congr_arg (coeff (single vars.y 21)) eqn',
  -- -- have h22 := congr_arg (coeff (single vars.y 22)) eqn',
  -- -- have h23 := congr_arg (coeff (single vars.y 23)) eqn',
  -- -- have h24 := congr_arg (coeff (single vars.y 24)) eqn',
  -- -- have h25 := congr_arg (coeff (single vars.y 25)) eqn',
  -- -- have h26 := congr_arg (coeff (single vars.y 26)) eqn',
  -- -- have h27 := congr_arg (coeff (single vars.y 27)) eqn',

-- def α : ℕ := 26
-- def β : ℕ := 27
-- def γ : ℕ := 0
-- def δ : ℕ := 40
-- def η : ℕ := 24

  -- #eval 2 * β - (β-γ) * 0 + (δ-β) * 0 - (β-η) * 1 - (β-α) * 2
  -- #eval 2 * β - (β-γ) * 0 + (δ-β) * 0 - (β-η) * 2 - (β-α) * 1
  -- #eval 2 * β - (β-γ) * 0 + (δ-β) * 0 - (β-η) * 2 - (β-α) * 2
  -- #eval 2 * β - (β-γ) * 0 + (δ-β) * 1 - (β-η) * 1 - (β-α) * 2
  -- #eval 2 * β - (β-γ) * 0 + (δ-β) * 1 - (β-η) * 2 - (β-α) * 1
  -- #eval 2 * β - (β-γ) * 0 + (δ-β) * 1 - (β-η) * 2 - (β-α) * 2
  -- #eval 2 * β - (β-γ) * 0 + (δ-β) * 2 - (β-η) * 1 - (β-α) * 2
  -- #eval 2 * β - (β-γ) * 0 + (δ-β) * 2 - (β-η) * 2 - (β-α) * 1
  -- #eval 2 * β - (β-γ) * 0 + (δ-β) * 2 - (β-η) * 2 - (β-α) * 2
  -- #eval 2 * β - (β-γ) * 1 + (δ-β) * 0 - (β-η) * 2 - (β-α) * 2
  -- -- #eval 2 * β - (β-γ) * 1 + (δ-β) * 0 - (β-η) * 2 - (β-α) * 3
  -- #eval 2 * β - (β-γ) * 1 + (δ-β) * 1 - (β-η) * 1 - (β-α) * 2
  -- #eval 2 * β - (β-γ) * 1 + (δ-β) * 1 - (β-η) * 2 - (β-α) * 1
  -- #eval 2 * β - (β-γ) * 1 + (δ-β) * 1 - (β-η) * 2 - (β-α) * 2,

  have h0012 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 0 + (δ-β) * 0 + (β-η) * 1 + (β-α) * 0))) eqn',
  have h0021 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 0 + (δ-β) * 0 + (β-η) * 0 + (β-α) * 1))) eqn',
  have h0022 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 0 + (δ-β) * 0 + (β-η) * 0 + (β-α) * 0))) eqn',
  -- have h0022 := congr_arg (coeff (single vars.y (46))) eqn',
  have h0112 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 0 + (δ-β) * 1 + (β-η) * 1 + (β-α) * 0))) eqn',
  have h0121 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 0 + (δ-β) * 1 + (β-η) * 0 + (β-α) * 1))) eqn',
  have h0122 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 0 + (δ-β) * 1 + (β-η) * 0 + (β-α) * 0))) eqn',
  have h0212 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 0 + (δ-β) * 2 + (β-η) * 1 + (β-α) * 0))) eqn',
  have h0221 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 0 + (δ-β) * 2 + (β-η) * 0 + (β-α) * 1))) eqn',
  have h0222 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 0 + (δ-β) * 2 + (β-η) * 0 + (β-α) * 0))) eqn',
  have h1022 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 1 + (δ-β) * 0 + (β-η) * 0 + (β-α) * 0))) eqn',
  -- have h1023 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 1 + (δ-β) * 0 + (β-η) * 0 - (β-α) * 3))) eqn',
  have h1112 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 1 + (δ-β) * 1 + (β-η) * 1 + (β-α) * 0))) eqn',
  have h1121 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 1 + (δ-β) * 1 + (β-η) * 0 + (β-α) * 1))) eqn',
  have h1122 := congr_arg (coeff (single vars.y (2 * β - (β-γ) * 1 + (δ-β) * 1 + (β-η) * 0 + (β-α) * 0))) eqn',

  simp only [α, β, η, δ, γ, algebra.id.smul_eq_mul, nat.succ_sub_succ, nat.sub_zero, nat.zero_mul, nat.mul_zero, nat.zero_add, nat.add_zero, nat.mul_succ, nat.add_succ] at h0012 h0021 h0022 h0112 h0121 h0122 h0212 h0221 h0222 h1022 h1112 h1121 h1122,

  -- done,

  clear eqn',
  -- clear h0012 h0021 h0112 h0121 h0122 h0212 h0221 h0222 h1022 h1112 h1121 h1122,

  -- done,

  simp only [finsupp_vars_eq_ext, mv_polynomial.coeff_sub] with coeff_simp finsupp_eq at h0012 h0021 h0022 h0112 h0121 h0122 h0212 h0221 h0222 h1022 h1112 h1121 h1122,

  -- simp only [finsupp_vars_eq_ext, mv_polynomial.coeff_sub] with coeff_simp finsupp_eq at h0022,

  -- simp only [algebra.id.smul_eq_mul, nat.succ_sub_succ, nat.sub_zero, nat.zero_mul, nat.mul_zero, nat.mul_succ, nat.add_succ] with finsupp_simp at h0022,
  simp only [algebra.id.smul_eq_mul, nat.succ_sub_succ, sub_zero, nat.zero_mul, nat.mul_zero, nat.mul_succ, nat.add_succ] with finsupp_simp at h0012 h0021 h0022 h0112 h0121 h0122 h0212 h0221 h0222 h1022 h1112 h1121 h1122,

  -- abel at *,
  rw sub_eq_zero at h1122,

  done,

  -- Step 2: Recursively simplify and case-analyze the equations

  trace "Moving Cs right",
  simp only [simplifier1, simplifier2] at *,

  trace "Grouping distributivity",
  simp only [<-mul_add, <-add_mul, <-add_assoc, add_mul_distrib, add_mul_distrib'] at *,

  have h1022' :
    polynomial.C A_mod_comp_crs_P_γ_1 *
      ∑ (x : fin n_var) in finset.fin_range n_var,
        polynomial.X ^ (x : ℕ) * polynomial.C (B_comp_crs'_P_powers_2 x) +
      (∑ (x : fin n_stmt) in finset.fin_range n_stmt, v_stmt x * polynomial.C (A_comp_crs'_V_all_stmt_1 x)) *
        polynomial.C B_comp_crs'_V_η_2 +
    (∑ (x : fin n_wit) in finset.fin_range n_wit, v_wit x * polynomial.C (A_comp_crs'_P_all_wit_1 x)) *
          polynomial.C B_comp_crs'_α_2 =
    ∑ (x : fin n_stmt) in finset.fin_range n_stmt, v_stmt x * polynomial.C (a_stmt x) +
      ∑ (x : fin n_wit) in finset.fin_range n_wit, v_wit x * polynomial.C (C_comp_crs'_P_all_wit_1 x),
  {
    rw h1022,
    ring,
  },

  have h0122' :
    polynomial.C A_comp_crs'_P_δ_1 *
      ∑ (x : fin n_var) in finset.fin_range n_var,
        polynomial.X ^ (x : ℕ) * polynomial.C (B_comp_crs'_P_powers_2 x) +
    (∑ (x : fin n_var) in finset.fin_range n_var,
       polynomial.X ^ (x : ℕ) * polynomial.C (A_comp_crs'_P_powers_1 x)) *
            polynomial.C B_mod_comp_crs_V_δ_2 +
    (∑ (x : fin n_stmt) in finset.fin_range n_stmt, u_stmt x * polynomial.C (A_comp_crs'_V_all_stmt_1 x)) *
        polynomial.C B_comp_crs'_V_η_2 +
    (∑ (x : fin n_wit) in finset.fin_range n_wit, u_wit x * polynomial.C (A_comp_crs'_P_all_wit_1 x)) *
              polynomial.C B_comp_crs'_α_2  =
    ∑ (x : fin n_stmt) in finset.fin_range n_stmt, u_stmt x * polynomial.C (a_stmt x) +
      ∑ (x : fin n_wit) in finset.fin_range n_wit, u_wit x * polynomial.C (C_comp_crs'_P_all_wit_1 x),
  {
    rw h0122,
    ring,
  },

  have h0022' :
    (∑ (x : fin n_var) in finset.fin_range n_var,
      polynomial.X ^ (x : ℕ) * polynomial.C (A_comp_crs'_P_powers_1 x)) *
    ∑ (x : fin n_var) in finset.fin_range n_var,
      polynomial.X ^ (x : ℕ) * polynomial.C (B_comp_crs'_P_powers_2 x) +
    (∑ (x : fin n_stmt) in finset.fin_range n_stmt, w_stmt x * polynomial.C (A_comp_crs'_V_all_stmt_1 x)) *
        polynomial.C B_comp_crs'_V_η_2 +
    polynomial.C B_comp_crs'_α_2  *
      ((∑ (x : fin n_wit) in finset.fin_range n_wit, w_wit x * polynomial.C (A_comp_crs'_P_all_wit_1 x)) +
       (∑ (x : fin (n_var - 1)) in finset.fin_range (n_var - 1),
         l * polynomial.X ^ (x : ℕ) * polynomial.C (A_comp_crs'_P_l_1 x)))
    =
    ∑ (x : fin n_stmt) in finset.fin_range n_stmt, w_stmt x * polynomial.C (a_stmt x) +
        ∑ (x : fin n_wit) in finset.fin_range n_wit, w_wit x * polynomial.C (C_comp_crs'_P_all_wit_1 x) +
      ∑ (x : fin (n_var - 1)) in
        finset.fin_range (n_var - 1),
        l * polynomial.X ^ (x : ℕ) * polynomial.C (C_comp_crs'_P_l_1 x),
  {
    rw h0022,
    ring,
  },

  clear h0122 h1022 h0022,

  -- hack rewrites to get things the same as in the groth16typeIII
  rw eq_comm at h0012 h0021 h0112 h0121 h0212 h0221 h0222 h1112 h1121 h1122 h0122' h1022' h0022',

  rw eq_comm at h0021 h0022' h0121 h0012 h0112 h0122' h1022' h0212 h0221 h0222 h1112 h1121 h1122,

  -- done,

  trace "Main simplification",
  simp only [*] with integral_domain_simp at *,

  -- have hγη : (1 + polynomial.C A_comp_crs'_P_γ_1) * polynomial.C B_comp_crs'_V_η_2 = 0,
  -- { rw add_mul, rw <-h5, ring, },
  -- rw mul_eq_zero at hγη,

  -- have hδδ : polynomial.C A_comp_crs'_P_δ_1 * (1 + polynomial.C B_comp_crs'_V_δ_2) = 0,
  -- { rw mul_add, rw <-h0222, ring, },
  -- rw mul_eq_zero at hδδ,

  -- have hγδ : (1 + polynomial.C A_comp_crs'_P_γ_1) * (1 + polynomial.C B_comp_crs'_V_δ_2) = 1,
  -- { rw <-sub_eq_zero, rw <-h1122, ring, },

  -- have hββ := h14,
  -- have hβγ := h7,
  -- have hβδ := h17,
  -- have hγγ := h0,
  -- have hγδ := h10,

  -- clear h0 h5 h7 h10 h14 h17 h20,

  tactic.integral_domain_tactic_v4,

  -- rw <-hβγ,
  -- rw <-hβδ,
  -- rw <-hββ,

  -- done,

  -- Solve remaining four cases by hand
  { rw [<-h1022', <-h0122', <-h0022'],
    simp only [B_mod_comp_crs_V_δ_2_mul],
    simp only [<-mul_assoc],
    simp only [A_mod_comp_crs_P_γ_1_mul],
    simp only [<-mul_assoc],
    rw h1122,
    ring, },

end

end lipmaa


/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison
-/
import topology.algebra.ring
import topology.algebra.group_with_zero

/-!
# Topological fields

A topological division ring is a topological ring whose inversion function is continuous at every
non-zero element.

-/

namespace topological_ring
open topological_space function
variables (R : Type*) [ring R]

variables  [topological_space R]

/-- The induced topology on units of a topological ring.
This is not a global instance since other topologies could be relevant. Instead there is a class
`induced_units` asserting that something equivalent to this construction holds. -/
def topological_space_units : topological_space (units R) := induced (coe : units R → R) ‹_›

/-- Asserts the topology on units is the induced topology.

 Note: this is not always the correct topology.
 Another good candidate is the subspace topology of $R \times R$,
 with the units embedded via $u \mapsto (u, u^{-1})$.
 These topologies are not (propositionally) equal in general. -/
class induced_units [t : topological_space $ units R] : Prop :=
(top_eq : t = induced (coe : units R → R) ‹_›)

variables [topological_space $ units R]

lemma units_topology_eq [induced_units R] :
  ‹topological_space (units R)› = induced (coe : units R → R) ‹_› :=
induced_units.top_eq

lemma induced_units.continuous_coe [induced_units R] : continuous (coe : units R → R) :=
(units_topology_eq R).symm ▸ continuous_induced_dom

lemma units_embedding [induced_units R] :
  embedding (coe : units R → R) :=
{ induced := units_topology_eq R,
  inj := λ x y h, units.ext h }

instance top_monoid_units [topological_ring R] [induced_units R] :
  has_continuous_mul (units R) :=
⟨begin
  let mulR := (λ (p : R × R), p.1*p.2),
  let mulRx := (λ (p : units R × units R), p.1*p.2),
  have key : coe ∘ mulRx = mulR ∘ (λ p, (p.1.val, p.2.val)), from rfl,
  rw [continuous_iff_le_induced, units_topology_eq R, prod_induced_induced,
      induced_compose, key, ← induced_compose],
  apply induced_mono,
  rw ← continuous_iff_le_induced,
  exact continuous_mul,
end⟩
end topological_ring

variables (K : Type*) [division_ring K] [topological_space K]

/-- A topological division ring is a division ring with a topology where all operations are
    continuous, including inversion. -/
class topological_division_ring extends topological_ring K : Prop :=
(continuous_inv : ∀ x : K, x ≠ 0 → continuous_at (λ x : K, x⁻¹ : K → K) x)

namespace topological_division_ring
open filter set
/-!
In this section, we show that units of a topological division ring endowed with the
induced topology form a topological group. These are not global instances because
one could want another topology on units. To turn on this feature, use:

```lean
local attribute [instance]
topological_ring.topological_space_units topological_division_ring.units_top_group
```
-/

local attribute [instance] topological_ring.topological_space_units

@[priority 100] instance induced_units : topological_ring.induced_units K := ⟨rfl⟩

variables [topological_division_ring K]

lemma units_top_group : topological_group (units K) :=
{ continuous_inv := begin
     have : (coe : units K → K) ∘ (λ x, x⁻¹ : units K → units K) =
            (λ x, x⁻¹ : K → K) ∘ (coe : units K → K), from funext units.coe_inv',
     rw continuous_iff_continuous_at,
     intros x,
     rw [continuous_at, nhds_induced, nhds_induced, tendsto_iff_comap, comap_comm this],
     apply comap_mono,
     rw [← tendsto_iff_comap, units.coe_inv'],
     exact topological_division_ring.continuous_inv (x : K) x.ne_zero
   end ,
  ..topological_ring.top_monoid_units K}

local attribute [instance] units_top_group

lemma continuous_units_inv : continuous (λ x : units K, (↑(x⁻¹) : K)) :=
(topological_ring.induced_units.continuous_coe K).comp topological_group.continuous_inv

end topological_division_ring

section affine_homeomorph
/-!
This section is about affine homeomorphisms from a topological field `𝕜` to itself.
Technically it does not require `𝕜` to be a topological field, a topological ring that
happens to be a field is enough.
-/
variables {𝕜 : Type*} [field 𝕜] [topological_space 𝕜] [topological_ring 𝕜]

/--
The map `λ x, a * x + b`, as a homeomorphism from `𝕜` (a topological field) to itself, when `a ≠ 0`.
-/
@[simps]
def affine_homeomorph (a b : 𝕜) (h : a ≠ 0) : 𝕜 ≃ₜ 𝕜 :=
{ to_fun := λ x, a * x + b,
  inv_fun := λ y, (y - b) / a,
  left_inv := λ x, by { simp only [add_sub_cancel], exact mul_div_cancel_left x h, },
  right_inv := λ y, by { simp [mul_div_cancel' _ h], }, }

end affine_homeomorph


import system.io data.list.set

meta constant io.mkdir (s : string) [io.interface] : io nat

class has_smul (α β : Type) := (smul : α → β → β)
def smul {α β : Type} [has_smul α β] : α → β → β := has_smul.smul
infixl ` ⬝ ` := smul

def pextt {P : Prop} : P → (P = true) := λ Hp, propext (iff_true_intro Hp)
def pextf {P : Prop} : ¬ P → (P = false) := λ Hnp, propext (iff.intro (λ Hp, Hnp Hp) (λ Hf, false.rec _ Hf))

namespace nat

lemma bit1_ne_bit0_eq {n m : ℕ} : (bit1 n ≠ bit0 m) = true := pextt (nat.bit1_ne_bit0 _ _)
lemma bit0_ne_bit1_eq {n m : ℕ} : (bit0 n ≠ bit1 m) = true := pextt (nat.bit0_ne_bit1 _ _)

lemma bit0_inj_eq {n m : ℕ} : (bit0 n ≠ bit0 m) = (n ≠ m) :=
begin
apply propext,
split,
intros H_ne H_eq,
subst H_eq,
exact H_ne rfl,
intros H_ne H_eq,
exact H_ne (nat.bit0_inj H_eq)
end

lemma bit1_inj_eq {n m : ℕ} : (bit1 n ≠ bit1 m) = (n ≠ m) :=
begin
apply propext,
split,
intros H_ne H_eq,
subst H_eq,
exact H_ne rfl,
intros H_ne H_eq,
exact H_ne (nat.bit1_inj H_eq)
end

lemma zero_ne_bit0_eq {n : ℕ} : (0 ≠ bit0 n) = (n ≠ 0) :=
begin
apply propext,
split,
intros H_ne H_eq,
subst H_eq,
exact H_ne rfl,
apply nat.zero_ne_bit0
end

lemma bit0_ne_zero_eq {n : ℕ} : (bit0 n ≠ 0) = (n ≠ 0) :=
begin
apply propext,
split,
intros H_ne H_eq,
subst H_eq,
exact H_ne rfl,
apply nat.bit0_ne_zero
end

lemma one_ne_bit1_eq {n : ℕ} : (1 ≠ bit1 n) = (n ≠ 0) :=
begin
apply propext,
split,
intros H_ne H_eq,
subst H_eq,
exact H_ne rfl,
apply nat.one_ne_bit1
end

lemma bit1_ne_one_eq {n : ℕ} : (bit1 n ≠ 1) = (n ≠ 0) :=
begin
apply propext,
split,
intros H_ne H_eq,
subst H_eq,
exact H_ne rfl,
apply nat.bit1_ne_one
end

lemma one_ne_bit0_eq (n : ℕ) : (1 ≠ bit0 n) = true := pextt (nat.one_ne_bit0 _)
lemma bit0_ne_one_eq (n : ℕ) : (bit0 n ≠ 1) = true := pextt (nat.bit0_ne_one _)

lemma zero_ne_bit1_eq (n : ℕ) : (0 ≠ bit1 n) = true := pextt (nat.zero_ne_bit1 _)
lemma bit1_ne_zero_eq (n : ℕ) : (bit1 n ≠ 0) = true := pextt (nat.bit1_ne_zero _)

lemma zero_ne_one_eq : (0 ≠ 1) = true := pextt nat.zero_ne_one
lemma one_ne_zero_eq : (1 ≠ 0) = true := pextt nat.one_ne_zero

end nat

namespace prod
section lt
universes u v
variables {A : Type u} [A_deceq : decidable_eq A] [A_lt : has_lt A] [A_dec_lt : decidable_rel (@has_lt.lt A _)]
          {B : Type v} [B_lt : has_lt B] [B_dec_lt : decidable_rel (@has_lt.lt B _)]

include A_deceq A_lt A_dec_lt B_lt B_dec_lt

def less_than : A × B → A × B → Prop
| ⟨x₁, y₁⟩ ⟨x₂, y₂⟩ := if x₁ < x₂ then true else (if x₂ < x₁ then false else (y₁ < y₂))

instance : has_lt (A × B) := ⟨less_than⟩

def decidable_less_than : ∀ (p q : A × B), decidable (p < q)
| ⟨x₁, y₁⟩ ⟨x₂, y₂⟩ := show decidable (if x₁ < x₂ then true else (if x₂ < x₁ then false else (y₁ < y₂))), by apply_instance

instance : decidable_rel (@has_lt.lt (A × B) _) := decidable_less_than

end lt
end prod

lemma pair_neq_of_neq₁ {X Y : Type} {x₁ x₂ : X} {y₁ y₂ : Y} : x₁ ≠ x₂ → (x₁, y₁) ≠ (x₂, y₂) :=
assume (H : x₁ ≠ x₂) (H_contra : (x₁, y₁) = (x₂, y₂)),
by { injection H_contra with Hx Hy, exact H Hx }

namespace list
section lt
variables {A : Type*} [A_deceq : decidable_eq A] [A_lt : has_lt A] [A_dec_lt : decidable_rel (@has_lt.lt A _)]

include A_deceq A_lt A_dec_lt

def less_than : list A → list A → Prop
| []      (y::ys) := true
| _       []      := false
| (x::xs) (y::ys) := x < y ∨ (x = y ∧ less_than xs ys)

instance : has_lt (list A) := ⟨less_than⟩

def decidable_less_than : ∀ (xs ys : list A), decidable (xs < ys)
| []      (y::ys) := decidable.true
| []       []     := decidable.false
| (x::xs)  []     := decidable.false
| (x::xs) (y::ys) :=
show decidable (x < y ∨ (x = y ∧ less_than xs ys)), from
have H_lt : decidable (less_than xs ys), by apply decidable_less_than,
by apply_instance

instance : decidable_rel (@has_lt.lt (list A) _) := decidable_less_than

end lt

def p1 {X Y : Type} : list (X × Y) → list X
| [] := []
| (xy::xys) := xy.1 :: p1 xys

def p2 {X Y : Type} : list (X × Y) → list Y
| [] := []
| (xy::xys) := xy.2 :: p2 xys

lemma length_p1_same {X Y : Type} : ∀ (xs : list (X × Y)), length xs^.p1 = length xs
| []      := rfl
| (x::xs) := begin dsimp [length, p1], rw length_p1_same end

lemma length_p2_same {X Y : Type} : ∀ (xs : list (X × Y)), length xs^.p2 = length xs
| []      := rfl
| (x::xs) := begin dsimp [length, p2], rw length_p2_same end

def sumr {α : Type} [has_add α] [has_zero α] : list α → α
| [] := 0
| (x::xs) := x + sumr xs

def sumrd {α : Type} [has_add α] (d : α) : list α → α
| [] := d
| (x::xs) := x + sumrd xs

lemma sumrd_sumr {α : Type} [add_comm_group α] (d : α) : ∀ (xs : list α), sumrd d xs = d + sumr xs
| []      := begin dunfold sumrd sumr, rw add_zero end
| (x::xs) := begin dunfold sumrd sumr, rw sumrd_sumr, rw [-add_assoc, -add_assoc], rw add_comm x d end

def sumr₁ {α : Type} [has_add α] [has_zero α] : list α → α
| [] := 0
| [x] := x
| (x::y::xs) := x + sumr₁ (y::xs)

lemma sumr_sumr₁ {α : Type} [add_group α] : ∀ (xs : list α), sumr₁ xs = sumr xs
| [] := rfl
| [x] := begin dunfold sumr sumr₁, rw add_zero, end
| (x::y::xs) := begin dunfold sumr sumr₁, rw sumr_sumr₁, reflexivity end

def prod {α : Type*} [has_mul α] [has_one α] : list α → α :=
foldr has_mul.mul 1

lemma append_single {α : Type*} (x : α) (xs : list α) : [x] ++ xs = x :: xs := rfl

lemma append_nil_left {α : Type*} (xs : list α) : [] ++ xs = xs := rfl

lemma in_filter {α : Type*} (P : α → Prop) [decidable_pred P] : Π (xs : list α) (x : α), x ∈ xs → P x → x ∈ filter P xs
| []      x H_x_in HPx := H_x_in
| (y::ys) x H_x_in HPx :=
have Hx : x = y ∨ x ∈ ys, from iff.mp (mem_cons_iff _ _ _) H_x_in,
have Hy : P y ∨ ¬ (P y), from decidable.em _,
begin
dunfold filter,
cases Hx with H_eq H_in,
{ subst H_eq, simp [HPx] },
cases Hy with HPy HnPy,
{ simp [HPy], exact or.inr (in_filter _ _ H_in HPx) },
{ simp [HnPy], exact in_filter _ _ H_in HPx }
end

lemma of_in_filter {α : Type*} (P : α → Prop) [decidable_pred P] : Π (xs : list α) (x : α), x ∈ filter P xs → x ∈ xs ∧ P x
| []      x H_x_in := false.rec _ (not_mem_nil _ H_x_in)
| (y::ys) x H_x_in :=
have Hy : P y ∨ ¬ (P y), from decidable.em _,
begin
cases Hy with HPy HnPy,
dunfold filter at H_x_in,
simp [HPy] at H_x_in,
split,

cases H_x_in with H_eq H_in,
{ subst H_eq, apply mem_cons_self },
{ apply mem_cons_of_mem, exact (of_in_filter _ _ H_in)^.left },

cases H_x_in with H_eq H_in,
{ subst H_eq, exact HPy  },
{ exact (of_in_filter _ _ H_in)^.right  },

dunfold filter at H_x_in,
simp [HnPy] at H_x_in,
split,
apply mem_cons_of_mem, exact (of_in_filter _ _ H_x_in)^.left,
exact (of_in_filter _ _ H_x_in)^.right
end

def miota : ℕ → ℕ → list ℕ
| i 0     := []
| i (k+1) := i :: miota (i+1) k

def riota : ℕ → list ℕ
| 0 := []
| (n+1) := n :: riota n

lemma in_riota_lt : ∀ {idx n : ℕ}, idx ∈ riota n → idx < n
| idx 0     H_mem := false.rec _ (not_mem_nil (riota 0) H_mem)
| idx (n+1) H_mem :=
begin
dsimp [riota, list.mem] at H_mem,
cases H_mem with H_idx_eq H_mem,
{ rw H_idx_eq, apply nat.lt_succ_self },
apply nat.lt.step,
apply in_riota_lt,
exact H_mem
end

lemma map_compose {X Y Z : Type} (f : X → Y) (g : Y → Z) (xs : list X) : map g (map f xs) = map (λ x, g (f x)) xs := by apply map_map

lemma map_congr_fn {X Y : Type} (f g : X → Y) (xs : list X) : f = g → map f xs = map g xs := begin intro H, rw H end
lemma map_congr_fn_pred {X Y : Type} (f g : X → Y) : Π (xs : list X) (H : ∀ x, x ∈ xs → f x = g x), map f xs = map g xs
| []      H := rfl
| (x::xs) H :=
  show f x :: map f xs = g x :: map g xs, from
  have H_x : x ∈ x :: xs, by apply mem_cons_self,
  have H_rest : ∀ x, x ∈ xs → f x = g x,
    begin intros y H_y_in_xs, apply H, apply mem_cons_of_mem, exact H_y_in_xs end,
  begin rw H x H_x, rw (map_congr_fn_pred xs H_rest) end

def dnth {α : Type*} [inhabited α] : list α → nat → α
| []       n     := default α
| (a :: l) 0     := a
| (a :: l) (n+1) := dnth l n

lemma p1_dnth {α β : Type*} [inhabited α] [inhabited β] : ∀ (xs : list (α × β)) (idx : ℕ), (dnth xs idx).1 = dnth (p1 xs) idx
| []      _       := rfl
| (x::xs) 0       := rfl
| (x::xs) (idx+1) := begin dsimp [p1, dnth], apply p1_dnth end

lemma p2_dnth {α β : Type*} [inhabited α] [inhabited β] : ∀ (xs : list (α × β)) (idx : ℕ), (dnth xs idx).2 = dnth (p2 xs) idx
| []      _       := rfl
| (x::xs) 0       := rfl
| (x::xs) (idx+1) := begin dsimp [p2, dnth], apply p2_dnth end

def at_idx {X : Type} [inhabited X] (xs : list X) (idx : ℕ) (x : X) : Prop :=
  idx < length xs ∧ x = dnth xs idx

inductive elem_at_idx {X : Type} : Π (xs : list X) (idx : ℕ) (x : X), Prop
| base : ∀ (xs : list X) (x : X), elem_at_idx (x::xs) 0 x
| step : ∀ (xs : list X) (x y : X) (idx : ℕ), elem_at_idx xs idx y → elem_at_idx (x::xs) (idx+1) y

lemma elem_at_idx_of_at_idx {X : Type} [inhabited X] : ∀ {xs : list X} {idx : ℕ} {x : X},
  at_idx xs idx x → elem_at_idx xs idx x
| [] _ _ H_at_idx := false.rec _ (nat.not_lt_zero _ H_at_idx^.left)
| (x::xs) 0       x₀ H_at_idx := by { dsimp [at_idx, dnth] at H_at_idx, rw H_at_idx^.right, constructor }
| (x::xs) (idx+1) x₀ H_at_idx :=
begin
dsimp [at_idx, dnth] at H_at_idx,
apply elem_at_idx.step,
apply elem_at_idx_of_at_idx,
apply and.intro,
exact nat.lt_of_succ_lt_succ H_at_idx^.left,
exact H_at_idx^.right
end

lemma at_idx_0 {α : Type*} [inhabited α] {x : α} {xs : list α} : at_idx (x::xs) 0 x :=
begin dunfold at_idx, split, exact nat.zero_lt_succ (length xs), reflexivity end

lemma at_idx_inj {α : Type*} [inhabited α] {x x₁ x₂ : α} {xs : list α} : at_idx (x::xs) 0 x₁ → at_idx (x::xs) 0 x₂ → x₁ = x₂ :=
begin dunfold at_idx, intros H₁ H₂, rw [H₁^.right, H₂^.right] end

lemma at_idx_of_cons {α : Type*} [inhabited α] {x : α} {xs : list α} {y : α} {idx : ℕ} :
  at_idx (x::xs) (idx+1) y → at_idx xs idx y :=
begin
dunfold at_idx,
intro H,
cases H with H_lt H_dnth,
split,
exact nat.lt_of_succ_lt_succ H_lt,
rw H_dnth, reflexivity
end

lemma at_idx_cons {α : Type*} [inhabited α] {x : α} {xs : list α} {y : α} {idx : ℕ} :
  at_idx xs idx y → at_idx (x::xs) (idx+1) y :=
begin
dunfold at_idx,
intro H,
cases H with H_lt H_dnth,
split,
exact nat.succ_lt_succ H_lt,
rw H_dnth, reflexivity
end

lemma at_idx_p1 {α β : Type} [inhabited α] [inhabited β] {xs : list (α × β)} {x : α × β} {idx : ℕ} :
  at_idx xs idx x → at_idx xs^.p1 idx x.1 :=
begin
intro H_at_idx,
cases H_at_idx with H_lt H_eq,
apply and.intro,
rw length_p1_same, exact H_lt,
rw H_eq,
apply p1_dnth
end

lemma at_idx_p2 {α β : Type} [inhabited α] [inhabited β] {xs : list (α × β)} {x : α × β} {idx : ℕ} :
  at_idx xs idx x → at_idx xs^.p2 idx x.2 :=
begin
intro H_at_idx,
cases H_at_idx with H_lt H_eq,
apply and.intro,
rw length_p2_same, exact H_lt,
rw H_eq,
apply p2_dnth
end

lemma mem_of_at_idx {α : Type*} [inhabited α] {x : α} {xs : list α} {idx : ℕ} : at_idx xs idx x → x ∈ xs :=
begin
intro H_at_idx,
assert H_elem_at_idx : elem_at_idx xs idx x, { exact elem_at_idx_of_at_idx H_at_idx },
clear H_at_idx,
induction H_elem_at_idx with xs x xs idx' x y H_elem_at_idx IH,
apply mem_cons_self,
apply mem_cons_of_mem,
exact IH
end

lemma at_idx_over {X : Type} [inhabited X] {xs : list X} {idx : ℕ} {x : X} : at_idx xs idx x → ¬ (idx < length xs) → false :=
assume H_at_idx H_idx_big, H_idx_big H_at_idx^.left

instance decidable_at_idx {α : Type*} [decidable_eq α] [inhabited α] (xs : list α) (idx : ℕ) (x : α) : decidable (at_idx xs idx x) :=
if H : idx < length xs ∧ x = dnth xs idx then decidable.is_true H else decidable.is_false H

lemma mem_of_cons_same {α : Type*} {x : α} {xs : list α} : x ∈ x::xs := by { apply or.inl, reflexivity }

definition all_prop {α : Type*} (p : α → Prop) (l : list α) : Prop :=
foldr (λ a r, p a ∧ r) true l

def rcons {α : Type*} (a : α) : list α → list α
| []        := [a]
| (x :: xs) := x :: (rcons xs)

def dnth_all {A : Type} [inhabited A] (idxs : list ℕ) (xs : list A) : list A := map (λ idx, dnth xs idx) idxs

lemma mem_not_mem_neq {X : Type*} {x₁ x₂ : X} {xs : list X} : x₁ ∈ xs → x₂ ∉ xs → x₁ ≠ x₂ :=
begin
intros H_in H_nin,
intro H_eq,
subst H_eq,
exact H_nin H_in
end

lemma nodup_cons_neq {X : Type} {x₁ x₂ : X} {xs : list X} : x₂ ∈ xs → nodup (x₁ :: xs) → x₁ ≠ x₂ :=
assume H_in H_nd,
have H_nin : x₁ ∉ xs, from not_mem_of_nodup_cons H_nd,
ne.symm $ mem_not_mem_neq H_in H_nin

lemma nodup_at_idx_neq {A : Type} [inhabited A] {x : A} {xs : list A} {y : A} {idx : ℕ} :
  nodup (x::xs) → at_idx (x::xs) (idx+1) y → y ≠ x :=
begin
intros H_nd H_at_idx,
note H_at_idx' := at_idx_of_cons H_at_idx,
assert H_in_xs : y ∈ xs,
apply mem_of_at_idx H_at_idx',
apply ne.symm,
apply nodup_cons_neq H_in_xs H_nd,
end

lemma sublist_cons_nil {X : Type*} {xs : list X} {x : X} : ¬ (x :: xs <+ []) :=
begin
intro H_contra,
note H := list.eq_nil_of_sublist_nil H_contra,
injection H
end

lemma disjoint_of_sublist_left {α : Type*} {l₁ l₂ l : list α} : l₁ <+ l → disjoint l l₂ → disjoint l₁ l₂ :=
λ ss d x xinl₁, d (subset_of_sublist ss xinl₁)

lemma disjoint_of_sublist_right {α : Type*} {l₁ l₂ l : list α} : l₂ <+ l → disjoint l₁ l → disjoint l₁ l₂ :=
λ ss d x xinl xinl₁, d xinl (subset_of_sublist ss xinl₁)

lemma nodup_append_sublist₁ {X : Type*} {ys zs : list X} (xs : list X) : nodup (ys ++ zs) → xs <+ ys → nodup (xs ++ zs) :=
assume H_nd H_sl,
have H_nd_xs : nodup xs, from nodup_of_sublist H_sl (nodup_of_nodup_append_left H_nd),
have H_nd_zs : nodup zs, from nodup_of_nodup_append_right H_nd,
have H_dj : disjoint xs zs, from disjoint_of_sublist_left H_sl (disjoint_of_nodup_append H_nd),
nodup_append_of_nodup_of_nodup_of_disjoint H_nd_xs H_nd_zs H_dj

lemma nodup_append_swap {X : Type} {xs₁ xs₂ : list X} {x : X} : nodup (xs₁ ++ (x :: xs₂)) → nodup ((x::xs₁) ++ xs₂) :=
by apply list.nodup_head

lemma nodup_mem_append₂ {X : Type} {x : X} {xs₁ xs₂ : list X} : nodup (xs₁ ++ xs₂) → x ∈ xs₂ → x ∉ xs₁ :=
assume (H_nd : nodup (xs₁ ++ xs₂)) (H₂ : x ∈ xs₂) (H₁ : x ∈ xs₁),
have H_dj : disjoint xs₁ xs₂, from disjoint_of_nodup_append H_nd,
H_dj H₁ H₂

lemma nodup_append_cons {X : Type} {xs₁ xs₂ : list X} {x : X} : nodup (xs₁ ++ (x :: xs₂)) → nodup (xs₁ ++ [x]) :=
assume H_nd,
have H_nd₁ : nodup xs₁, from nodup_of_nodup_append_left H_nd,
have H_dj : disjoint xs₁ (x :: xs₂), from disjoint_of_nodup_append H_nd,
have H_nin : x ∉ xs₁, from disjoint_right H_dj mem_of_cons_same,
begin apply nodup_app_comm, simp, apply nodup_cons H_nin H_nd₁ end

lemma nodup_append_cons_rest {X : Type} {xs₁ xs₂ : list X} {x : X} : nodup (xs₁ ++ (x :: xs₂)) → nodup (xs₁ ++ xs₂) :=
assume H_nd, nodup_of_nodup_cons (nodup_head H_nd)

lemma nodup_append_neq {X : Type} {xs₁ xs₂ : list X} {x₁ x₂ : X} : x₁ ∈ xs₁ → x₂ ∈ xs₂ → nodup (xs₁ ++ xs₂) → x₁ ≠ x₂ :=
assume H₁_in H₂_in H_nd,
have H_dj : disjoint xs₁ xs₂, from disjoint_of_nodup_append H_nd,
have H₁_nin : x₁ ∉ xs₂, from disjoint_left H_dj H₁_in,
ne.symm $ mem_not_mem_neq H₂_in H₁_nin

lemma nodup_append_cons_neq {X : Type} {xs : list X} {x₁ x₂ : X} : x₁ ∈ xs → nodup (xs ++ [x₂]) → x₁ ≠ x₂ :=
assume H₁_in H_nd,
have H_nd' : nodup (x₂ :: xs), from nodup_app_comm H_nd,
have H₂_nin : x₂ ∉ xs, from not_mem_of_nodup_cons H_nd',
mem_not_mem_neq H₁_in H₂_nin

lemma nodup_of_append_cons_cons {X : Type} {xs ys : list X} {y₁ y₂ : X} : nodup (xs ++ (y₁ :: y₂ :: ys)) → nodup (xs ++ (y₁ :: ys)) :=
assume H_nd,
have H_nd' : nodup (y₁ :: (xs ++ y₂ :: ys)), from nodup_head H_nd,
have H₁_nin : y₁ ∉ xs ++ y₂ :: ys, from not_mem_of_nodup_cons H_nd',
have H₁_nin₁ : y₁ ∉ xs, from not_mem_of_not_mem_append_left H₁_nin,
have H₁_nin₂ : y₁ ∉ ys, from not_mem_of_not_mem_cons (not_mem_of_not_mem_append_right H₁_nin),
have H_nd'' : nodup (xs ++ y₂ :: ys), from nodup_of_nodup_cons H_nd',
have H_nd''' : nodup (y₂ :: (xs ++ ys)), from nodup_head H_nd'',
have H_nd'''' : nodup (xs ++ ys), from nodup_of_nodup_cons H_nd''',
nodup_middle (nodup_cons (not_mem_append H₁_nin₁ H₁_nin₂) H_nd'''')

lemma map_filter_congr {α β : Type*} {f g : α → β} {p : α → Prop} [decidable_pred p] :
  ∀ {xs : list α}, (∀ x, x ∈ xs → p x → f x = g x) → map f (filter p xs) = map g (filter p xs)
| []      H := rfl
| (x::xs) H :=
begin
dsimp [map, filter],
assert H_px_em : p x ∨ ¬ (p x), { exact decidable.em _ },
cases H_px_em,
{ simph, apply congr_arg, apply map_filter_congr,
  intros y H_y_in_xs H_py,
  exact H y (mem_cons_of_mem _ H_y_in_xs) H_py },
{ simph, apply map_filter_congr,
  intros y H_y_in_xs H_py,
  exact H y (mem_cons_of_mem _ H_y_in_xs) H_py }
end

lemma filter_congr {α : Type*} {p q : α → Prop} [decidable_pred p] [decidable_pred q] :
  ∀ {xs : list α}, (∀ x, x ∈ xs → (p x ↔ q x)) → filter p xs = filter q xs
| [] H := rfl

| (y::ys) H :=
begin
dunfold filter,
simp [H y mem_of_cons_same],
cases (decidable.em (q y)) with Hq Hq,
{
simp [Hq],
rw filter_congr,
intros x H_in_ys,
apply H,
apply mem_cons_of_mem,
exact H_in_ys
},
{
simp [Hq],
rw filter_congr,
intros x H_in_ys,
apply H,
apply mem_cons_of_mem,
exact H_in_ys
}
end

lemma in_riota_cons : ∀ (idx m : ℕ), idx + 1 ∈ riota (m + 1) → idx ∈ riota m
| 0       0 :=
begin
rw zero_add,
dunfold riota,
exact dec_trivial
end

| idx       (m+1) :=
begin
dunfold riota,
intro H,
cases eq_or_mem_of_mem_cons H with H_in H_in,
{
assert H_idx_eq_m : idx = m, exact add_right_cancel H_in,
subst H_idx_eq_m,
simp,
},
apply list.mem_cons_of_mem,
apply in_riota_cons,
exact H_in
end

| idx 0 :=
begin
dunfold riota,
exact dec_trivial
end

lemma in_riota_self (idx : ℕ) : idx ∈ riota (idx + 1) := by { dunfold riota, apply mem_of_cons_same }

lemma nin_neq_dnth {α : Type*} [inhabited α] [decidable_eq α] (x : α) : ∀ xs, x ∉ xs → ∀ idx, idx ∈ riota (list.length xs) → x ≠ dnth xs idx
| []      H_nin idx H_in := begin exfalso, exact not_mem_nil _ H_in end

| (y::ys) H_nin 0       H_in :=
begin
dunfold dnth,
exact ne_of_not_mem_cons H_nin
end

| (y::ys) H_nin (idx+1) H_in :=
begin
dunfold dnth,
apply nin_neq_dnth,
exact list.not_mem_of_not_mem_cons H_nin,
dunfold riota length at H_in,
apply in_riota_cons,
exact H_in
end

lemma lt_length_of_in_riota {α : Type*} : Π (xs : list α) (idx : ℕ), idx ∈ riota (length xs) → idx < length xs
| [] idx H_in := begin exfalso, exact list.not_mem_nil _ H_in end

| (x::xs) 0 H_in :=
begin
dunfold riota length at H_in,
exact dec_trivial
end

| (x::xs) (idx+1) H_in :=
begin
dunfold riota length at H_in,
apply nat.succ_lt_succ,
apply lt_length_of_in_riota,
exact in_riota_cons _ _ H_in
end

lemma dnth_mem_of_lt_length {α : Type*} [inhabited α] : Π (xs : list α) (idx : ℕ), idx < length xs → dnth xs idx ∈ xs
| [] idx H_lt := begin exfalso, exact nat.not_lt_zero _ H_lt end

| (x::xs) 0 H_lt := mem_of_cons_same

| (x::xs) (idx+1) H_lt :=
begin
dunfold dnth,
apply list.mem_cons_of_mem,
apply dnth_mem_of_lt_length,
apply nat.lt_of_succ_lt_succ,
exact H_lt
end

lemma filter_false {α : Type*} [decidable_eq α] [inhabited α] : Π (xs : list α), filter (λ x, false) xs = nil
| [] := rfl
| (x::xs) := begin dunfold filter, simp [filter_false] end

lemma not_in_filter_of_match_riota {α : Type*} [decidable_eq α] [inhabited α] (x : α) :
  ∀ (xs : list α), x ∉ xs → filter (λ (idx : ℕ), x = dnth xs idx) (riota (length xs)) = nil :=
assume xs H_nin,
have H : filter (λ (idx : ℕ), x = dnth xs idx) (riota (length xs)) = filter (λ idx : ℕ, false) (riota (length xs)),
begin
apply filter_congr,
intros idx H_in,
split,
intro H_eq,
subst H_eq,
assert H_x_in : dnth xs idx ∈ xs,
apply dnth_mem_of_lt_length,
apply lt_length_of_in_riota,
exact H_in,
exact H_nin H_x_in,
intro Hf,
exfalso,
exact Hf
end,
begin
rw H,
rw filter_false
end

end list

namespace monad

def foldrM {M : Type → Type} [m : monad M] {X Y : Type} (f : Y → X → M Y) (init : Y) (xs : list X) : M Y :=
  list.foldr (λ (x : X) (k : Y → M Y) (y : Y), f y x >>= k) return xs init

end monad

@[simp]
def if_is_true {A : Type} (P : Prop) (p : P) (t e : A) :
  @ite P (is_true p) A t e = t := rfl

@[simp]
def if_is_false {A : Type} (P : Prop) (np : ¬ P) (t e : A) :
  @ite P (is_false np) A t e = e := rfl

def decidable_and (P Q : Prop) [dP : decidable P] [dQ : decidable Q] : decidable (P ∧ Q) :=
  match dP, dQ with
  | is_true p,   is_true q   := is_true (and.intro p q)
  | is_false np, _           := is_false (λ H : P ∧ Q, np H^.left)
  | _,           is_false nq := is_false (λ H : P ∧ Q, nq H^.right)
  end

def decidable_or (P Q : Prop) [dP : decidable P] [dQ : decidable Q] : decidable (P ∨ Q) :=
  match dP, dQ with
  | is_true p,   _           := is_true (or.inl p)
  | _,           is_true q   := is_true (or.inr q)
  | is_false np, is_false nq := is_false (λ H : P ∨ Q, or.rec_on H (λ p, np p) (λ q, nq q))
  end


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

The `simp_rw` tactic, a mix of `simp` and `rewrite`.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.core
import Mathlib.PostPort

namespace Mathlib

/-!
# The `simp_rw` tactic

This module defines a tactic `simp_rw` which functions as a mix of `simp` and
`rw`. Like `rw`, it applies each rewrite rule in the given order, but like
`simp` it repeatedly applies these rules and also under binders like `∀ x, ...`,
`∃ x, ...` and `λ x, ...`.

## Implementation notes

The tactic works by taking each rewrite rule in turn and applying `simp only` to
it. Arguments to `simp_rw` are of the format used by `rw` and are translated to
their equivalents for `simp`.
-/

namespace tactic.interactive

/--
`simp_rw` functions as a mix of `simp` and `rw`. Like `rw`, it applies each
rewrite rule in the given order, but like `simp` it repeatedly applies these
rules and also under binders like `∀ x, ...`, `∃ x, ...` and `λ x, ...`.

Usage:
  - `simp_rw [lemma_1, ..., lemma_n]` will rewrite the goal by applying the
    lemmas in that order. A lemma preceded by `←` is applied in the reverse direction.
  - `simp_rw [lemma_1, ..., lemma_n] at h₁ ... hₙ` will rewrite the given hypotheses.
  - `simp_rw [...] at ⊢ h₁ ... hₙ` rewrites the goal as well as the given hypotheses.
  - `simp_rw [...] at *` rewrites in the whole context: all hypotheses and the goal.

Lemmas passed to `simp_rw` must be expressions that are valid arguments to `simp`.

For example, neither `simp` nor `rw` can solve the following, but `simp_rw` can:
```lean
example {α β : Type} {f : α → β} {t : set β} : (∀ s, f '' s ⊆ t) = ∀ s : set α, ∀ x ∈ s, x ∈ f ⁻¹' t :=
by simp_rw [set.image_subset_iff, set.subset_def]
```
-/
end Mathlib


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module order.filter.n_ary
! leanprover-community/mathlib commit 78f647f8517f021d839a7553d5dc97e79b508dea
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Filter.Prod

/-!
# N-ary maps of filter

This file defines the binary and ternary maps of filters. This is mostly useful to define pointwise
operations on filters.

## Main declarations

* `Filter.map₂`: Binary map of filters.
* `Filter.map₃`: Ternary map of filters.

## Notes

This file is very similar to `Data.Set.NAry`, `Data.Finset.NAry` and `Data.Option.NAry`. Please
keep them in sync.
-/

open Function Set

open Filter

namespace Filter

variable {α α' β β' γ γ' δ δ' ε ε' : Type _} {m : α → β → γ} {f f₁ f₂ : Filter α}
  {g g₁ g₂ : Filter β} {h h₁ h₂ : Filter γ} {s s₁ s₂ : Set α} {t t₁ t₂ : Set β} {u : Set γ}
  {v : Set δ} {a : α} {b : β} {c : γ}

/-- The image of a binary function `m : α → β → γ` as a function `Filter α → Filter β → Filter γ`.
Mathematically this should be thought of as the image of the corresponding function `α × β → γ`. -/
def map₂ (m : α → β → γ) (f : Filter α) (g : Filter β) : Filter γ
    where
  sets := { s | ∃ u v, u ∈ f ∧ v ∈ g ∧ image2 m u v ⊆ s }
  univ_sets := ⟨univ, univ, univ_sets _, univ_sets _, subset_univ _⟩
  sets_of_superset hs hst :=
    Exists₂.imp (fun u v => And.imp_right <| And.imp_right fun h => Subset.trans h hst) hs
  inter_sets := by
    simp only [exists_prop, Set.mem_setOf_eq, subset_inter_iff]
    rintro _ _ ⟨s₁, s₂, hs₁, hs₂, hs⟩ ⟨t₁, t₂, ht₁, ht₂, ht⟩
    exact
      ⟨s₁ ∩ t₁, s₂ ∩ t₂, inter_sets f hs₁ ht₁, inter_sets g hs₂ ht₂,
        (image2_subset (inter_subset_left _ _) <| inter_subset_left _ _).trans hs,
        (image2_subset (inter_subset_right _ _) <| inter_subset_right _ _).trans ht⟩
#align filter.map₂ Filter.map₂

@[simp]
theorem mem_map₂_iff : u ∈ map₂ m f g ↔ ∃ s t, s ∈ f ∧ t ∈ g ∧ image2 m s t ⊆ u :=
  Iff.rfl
#align filter.mem_map₂_iff Filter.mem_map₂_iff

theorem image2_mem_map₂ (hs : s ∈ f) (ht : t ∈ g) : image2 m s t ∈ map₂ m f g :=
  ⟨_, _, hs, ht, Subset.rfl⟩
#align filter.image2_mem_map₂ Filter.image2_mem_map₂

theorem map_prod_eq_map₂ (m : α → β → γ) (f : Filter α) (g : Filter β) :
    Filter.map (fun p : α × β => m p.1 p.2) (f ×ᶠ g) = map₂ m f g := by
  ext s
  simp [mem_prod_iff, prod_subset_iff]
#align filter.map_prod_eq_map₂ Filter.map_prod_eq_map₂

theorem map_prod_eq_map₂' (m : α × β → γ) (f : Filter α) (g : Filter β) :
    Filter.map m (f ×ᶠ g) = map₂ (fun a b => m (a, b)) f g :=
  map_prod_eq_map₂ (curry m) f g
#align filter.map_prod_eq_map₂' Filter.map_prod_eq_map₂'

@[simp]
theorem map₂_mk_eq_prod (f : Filter α) (g : Filter β) : map₂ Prod.mk f g = f ×ᶠ g := by
  simp only [← map_prod_eq_map₂, map_id']
#align filter.map₂_mk_eq_prod Filter.map₂_mk_eq_prod

-- lemma image2_mem_map₂_iff (hm : injective2 m) : image2 m s t ∈ map₂ m f g ↔ s ∈ f ∧ t ∈ g :=
-- ⟨by { rintro ⟨u, v, hu, hv, h⟩, rw image2_subset_image2_iff hm at h,
--   exact ⟨mem_of_superset hu h.1, mem_of_superset hv h.2⟩ }, λ h, image2_mem_map₂ h.1 h.2⟩
theorem map₂_mono (hf : f₁ ≤ f₂) (hg : g₁ ≤ g₂) : map₂ m f₁ g₁ ≤ map₂ m f₂ g₂ :=
  fun _ ⟨s, t, hs, ht, hst⟩ => ⟨s, t, hf hs, hg ht, hst⟩
#align filter.map₂_mono Filter.map₂_mono

theorem map₂_mono_left (h : g₁ ≤ g₂) : map₂ m f g₁ ≤ map₂ m f g₂ :=
  map₂_mono Subset.rfl h
#align filter.map₂_mono_left Filter.map₂_mono_left

theorem map₂_mono_right (h : f₁ ≤ f₂) : map₂ m f₁ g ≤ map₂ m f₂ g :=
  map₂_mono h Subset.rfl
#align filter.map₂_mono_right Filter.map₂_mono_right

@[simp]
theorem le_map₂_iff {h : Filter γ} :
    h ≤ map₂ m f g ↔ ∀ ⦃s⦄, s ∈ f → ∀ ⦃t⦄, t ∈ g → image2 m s t ∈ h :=
  ⟨fun H _ hs _ ht => H <| image2_mem_map₂ hs ht, fun H _ ⟨_, _, hs, ht, hu⟩ =>
    mem_of_superset (H hs ht) hu⟩
#align filter.le_map₂_iff Filter.le_map₂_iff

@[simp]
theorem map₂_bot_left : map₂ m ⊥ g = ⊥ :=
  empty_mem_iff_bot.1 ⟨∅, univ, trivial, univ_mem, image2_empty_left.subset⟩
#align filter.map₂_bot_left Filter.map₂_bot_left

@[simp]
theorem map₂_bot_right : map₂ m f ⊥ = ⊥ :=
  empty_mem_iff_bot.1 ⟨univ, ∅, univ_mem, trivial, image2_empty_right.subset⟩
#align filter.map₂_bot_right Filter.map₂_bot_right

@[simp]
theorem map₂_eq_bot_iff : map₂ m f g = ⊥ ↔ f = ⊥ ∨ g = ⊥ := by
  simp only [← empty_mem_iff_bot, mem_map₂_iff, subset_empty_iff, image2_eq_empty_iff]
  constructor
  · rintro ⟨s, t, hs, ht, rfl | rfl⟩
    · exact Or.inl hs
    · exact Or.inr ht
  · rintro (h | h)
    · exact ⟨_, _, h, univ_mem, Or.inl rfl⟩
    · exact ⟨_, _, univ_mem, h, Or.inr rfl⟩
#align filter.map₂_eq_bot_iff Filter.map₂_eq_bot_iff

@[simp]
theorem map₂_neBot_iff : (map₂ m f g).NeBot ↔ f.NeBot ∧ g.NeBot := by
  simp_rw [neBot_iff]
  exact map₂_eq_bot_iff.not.trans not_or
#align filter.map₂_ne_bot_iff Filter.map₂_neBot_iff

theorem NeBot.map₂ (hf : f.NeBot) (hg : g.NeBot) : (map₂ m f g).NeBot :=
  map₂_neBot_iff.2 ⟨hf, hg⟩
#align filter.ne_bot.map₂ Filter.NeBot.map₂

-- Porting note: Why do I have to specify the `Filter` namespace for `map₂` here?
theorem NeBot.of_map₂_left (h : (Filter.map₂ m f g).NeBot) : f.NeBot :=
  (map₂_neBot_iff.1 h).1
#align filter.ne_bot.of_map₂_left Filter.NeBot.of_map₂_left

theorem NeBot.of_map₂_right (h : (Filter.map₂ m f g).NeBot) : g.NeBot :=
  (map₂_neBot_iff.1 h).2
#align filter.ne_bot.of_map₂_right Filter.NeBot.of_map₂_right

theorem map₂_sup_left : map₂ m (f₁ ⊔ f₂) g = map₂ m f₁ g ⊔ map₂ m f₂ g := by
  ext u
  constructor
  · rintro ⟨s, t, ⟨h₁, h₂⟩, ht, hu⟩
    exact ⟨mem_of_superset (image2_mem_map₂ h₁ ht) hu, mem_of_superset (image2_mem_map₂ h₂ ht) hu⟩
  · rintro ⟨⟨s₁, t₁, hs₁, ht₁, hu₁⟩, s₂, t₂, hs₂, ht₂, hu₂⟩
    refine' ⟨s₁ ∪ s₂, t₁ ∩ t₂, union_mem_sup hs₁ hs₂, inter_mem ht₁ ht₂, _⟩
    rw [image2_union_left]
    exact
      union_subset ((image2_subset_left <| inter_subset_left _ _).trans hu₁)
        ((image2_subset_left <| inter_subset_right _ _).trans hu₂)
#align filter.map₂_sup_left Filter.map₂_sup_left

theorem map₂_sup_right : map₂ m f (g₁ ⊔ g₂) = map₂ m f g₁ ⊔ map₂ m f g₂ := by
  ext u
  constructor
  · rintro ⟨s, t, hs, ⟨h₁, h₂⟩, hu⟩
    exact ⟨mem_of_superset (image2_mem_map₂ hs h₁) hu, mem_of_superset (image2_mem_map₂ hs h₂) hu⟩
  · rintro ⟨⟨s₁, t₁, hs₁, ht₁, hu₁⟩, s₂, t₂, hs₂, ht₂, hu₂⟩
    refine' ⟨s₁ ∩ s₂, t₁ ∪ t₂, inter_mem hs₁ hs₂, union_mem_sup ht₁ ht₂, _⟩
    rw [image2_union_right]
    exact
      union_subset ((image2_subset_right <| inter_subset_left _ _).trans hu₁)
        ((image2_subset_right <| inter_subset_right _ _).trans hu₂)
#align filter.map₂_sup_right Filter.map₂_sup_right

theorem map₂_inf_subset_left : map₂ m (f₁ ⊓ f₂) g ≤ map₂ m f₁ g ⊓ map₂ m f₂ g :=
  le_inf (map₂_mono_right inf_le_left) (map₂_mono_right inf_le_right)
#align filter.map₂_inf_subset_left Filter.map₂_inf_subset_left

theorem map₂_inf_subset_right : map₂ m f (g₁ ⊓ g₂) ≤ map₂ m f g₁ ⊓ map₂ m f g₂ :=
  le_inf (map₂_mono_left inf_le_left) (map₂_mono_left inf_le_right)
#align filter.map₂_inf_subset_right Filter.map₂_inf_subset_right

@[simp]
theorem map₂_pure_left : map₂ m (pure a) g = g.map fun b => m a b :=
  Filter.ext fun u =>
    ⟨fun ⟨s, t, hs, ht, hu⟩ =>
      mem_of_superset (image_mem_map ht) ((image_subset_image2_right <| mem_pure.1 hs).trans hu),
      fun h => ⟨{a}, _, singleton_mem_pure, h, by rw [image2_singleton_left, image_subset_iff]⟩⟩
#align filter.map₂_pure_left Filter.map₂_pure_left

@[simp]
theorem map₂_pure_right : map₂ m f (pure b) = f.map fun a => m a b :=
  Filter.ext fun u =>
    ⟨fun ⟨s, t, hs, ht, hu⟩ =>
      mem_of_superset (image_mem_map hs) ((image_subset_image2_left <| mem_pure.1 ht).trans hu),
      fun h => ⟨_, {b}, h, singleton_mem_pure, by rw [image2_singleton_right, image_subset_iff]⟩⟩
#align filter.map₂_pure_right Filter.map₂_pure_right

theorem map₂_pure : map₂ m (pure a) (pure b) = pure (m a b) := by rw [map₂_pure_right, map_pure]
#align filter.map₂_pure Filter.map₂_pure

theorem map₂_swap (m : α → β → γ) (f : Filter α) (g : Filter β) :
    map₂ m f g = map₂ (fun a b => m b a) g f := by
  ext u
  constructor <;> rintro ⟨s, t, hs, ht, hu⟩ <;> refine' ⟨t, s, ht, hs, by rwa [image2_swap]⟩
#align filter.map₂_swap Filter.map₂_swap

@[simp]
theorem map₂_left (h : g.NeBot) : map₂ (fun x _ => x) f g = f := by
  ext u
  refine' ⟨_, fun hu => ⟨_, _, hu, univ_mem, (image2_left <| h.nonempty_of_mem univ_mem).subset⟩⟩
  rintro ⟨s, t, hs, ht, hu⟩
  rw [image2_left (h.nonempty_of_mem ht)] at hu
  exact mem_of_superset hs hu
#align filter.map₂_left Filter.map₂_left

@[simp]
theorem map₂_right (h : f.NeBot) : map₂ (fun _ y => y) f g = g := by rw [map₂_swap, map₂_left h]
#align filter.map₂_right Filter.map₂_right

/-- The image of a ternary function `m : α → β → γ → δ` as a function
`Filter α → Filter β → Filter γ → Filter δ`. Mathematically this should be thought of as the image
of the corresponding function `α × β × γ → δ`. -/
def map₃ (m : α → β → γ → δ) (f : Filter α) (g : Filter β) (h : Filter γ) : Filter δ
    where
  sets := { s | ∃ u v w, u ∈ f ∧ v ∈ g ∧ w ∈ h ∧ image3 m u v w ⊆ s }
  univ_sets := ⟨univ, univ, univ, univ_sets _, univ_sets _, univ_sets _, subset_univ _⟩
  sets_of_superset hs hst :=
    Exists₃.imp
      (fun u v w => And.imp_right <| And.imp_right <| And.imp_right fun h => Subset.trans h hst) hs
  inter_sets := by
    simp only [exists_prop, mem_setOf_eq, subset_inter_iff]
    rintro _ _ ⟨s₁, s₂, s₃, hs₁, hs₂, hs₃, hs⟩ ⟨t₁, t₂, t₃, ht₁, ht₂, ht₃, ht⟩
    exact
      ⟨s₁ ∩ t₁, s₂ ∩ t₂, s₃ ∩ t₃, inter_mem hs₁ ht₁, inter_mem hs₂ ht₂, inter_mem hs₃ ht₃,
        (image3_mono (inter_subset_left _ _) (inter_subset_left _ _) <| inter_subset_left _ _).trans
          hs,
        (image3_mono (inter_subset_right _ _) (inter_subset_right _ _) <|
              inter_subset_right _ _).trans
          ht⟩
#align filter.map₃ Filter.map₃

theorem map₂_map₂_left (m : δ → γ → ε) (n : α → β → δ) :
    map₂ m (map₂ n f g) h = map₃ (fun a b c => m (n a b) c) f g h := by
  ext w
  constructor
  · rintro ⟨s, t, ⟨u, v, hu, hv, hs⟩, ht, hw⟩
    refine' ⟨u, v, t, hu, hv, ht, _⟩
    rw [← image2_image2_left]
    exact (image2_subset_right hs).trans hw
  · rintro ⟨s, t, u, hs, ht, hu, hw⟩
    exact ⟨_, u, image2_mem_map₂ hs ht, hu, by rwa [image2_image2_left]⟩
#align filter.map₂_map₂_left Filter.map₂_map₂_left

theorem map₂_map₂_right (m : α → δ → ε) (n : β → γ → δ) :
    map₂ m f (map₂ n g h) = map₃ (fun a b c => m a (n b c)) f g h := by
  ext w
  constructor
  · rintro ⟨s, t, hs, ⟨u, v, hu, hv, ht⟩, hw⟩
    refine' ⟨s, u, v, hs, hu, hv, _⟩
    rw [← image2_image2_right]
    exact (image2_subset_left ht).trans hw
  · rintro ⟨s, t, u, hs, ht, hu, hw⟩
    exact ⟨s, _, hs, image2_mem_map₂ ht hu, by rwa [image2_image2_right]⟩
#align filter.map₂_map₂_right Filter.map₂_map₂_right

theorem map_map₂ (m : α → β → γ) (n : γ → δ) :
    (map₂ m f g).map n = map₂ (fun a b => n (m a b)) f g := by
  rw [← map_prod_eq_map₂, ← map_prod_eq_map₂, map_map]; rfl
#align filter.map_map₂ Filter.map_map₂

theorem map₂_map_left (m : γ → β → δ) (n : α → γ) :
    map₂ m (f.map n) g = map₂ (fun a b => m (n a) b) f g := by
  rw [← map_prod_eq_map₂, ← map_prod_eq_map₂, ← @map_id _ g, prod_map_map_eq, map_map, map_id]; rfl
#align filter.map₂_map_left Filter.map₂_map_left

theorem map₂_map_right (m : α → γ → δ) (n : β → γ) :
    map₂ m f (g.map n) = map₂ (fun a b => m a (n b)) f g := by
  rw [map₂_swap, map₂_map_left, map₂_swap]
#align filter.map₂_map_right Filter.map₂_map_right

@[simp]
theorem map₂_curry (m : α × β → γ) (f : Filter α) (g : Filter β) :
    map₂ (curry m) f g = (f ×ᶠ g).map m :=
  (map_prod_eq_map₂' _  _ _).symm
#align filter.map₂_curry Filter.map₂_curry

@[simp]
theorem map_uncurry_prod (m : α → β → γ) (f : Filter α) (g : Filter β) :
    (f ×ᶠ g).map (uncurry m) = map₂ m f g :=
  (map₂_curry (uncurry m) f g).symm
#align filter.map_uncurry_prod Filter.map_uncurry_prod

/-!
### Algebraic replacement rules

A collection of lemmas to transfer associativity, commutativity, distributivity, ... of operations
to the associativity, commutativity, distributivity, ... of `Filter.map₂` of those operations.

The proof pattern is `map₂_lemma operation_lemma`. For example, `map₂_comm mul_comm` proves that
`map₂ (*) f g = map₂ (*) g f` in a `comm_semigroup`.
-/

theorem map₂_assoc {m : δ → γ → ε} {n : α → β → δ} {m' : α → ε' → ε} {n' : β → γ → ε'}
    {h : Filter γ} (h_assoc : ∀ a b c, m (n a b) c = m' a (n' b c)) :
    map₂ m (map₂ n f g) h = map₂ m' f (map₂ n' g h) := by
  simp only [map₂_map₂_left, map₂_map₂_right, h_assoc]
#align filter.map₂_assoc Filter.map₂_assoc

theorem map₂_comm {n : β → α → γ} (h_comm : ∀ a b, m a b = n b a) : map₂ m f g = map₂ n g f :=
  (map₂_swap _ _ _).trans <| by simp_rw [h_comm]
#align filter.map₂_comm Filter.map₂_comm

theorem map₂_left_comm {m : α → δ → ε} {n : β → γ → δ} {m' : α → γ → δ'} {n' : β → δ' → ε}
    (h_left_comm : ∀ a b c, m a (n b c) = n' b (m' a c)) :
    map₂ m f (map₂ n g h) = map₂ n' g (map₂ m' f h) := by
  rw [map₂_swap m', map₂_swap m]
  exact map₂_assoc fun _ _ _ => h_left_comm _ _ _
#align filter.map₂_left_comm Filter.map₂_left_comm

theorem map₂_right_comm {m : δ → γ → ε} {n : α → β → δ} {m' : α → γ → δ'} {n' : δ' → β → ε}
    (h_right_comm : ∀ a b c, m (n a b) c = n' (m' a c) b) :
    map₂ m (map₂ n f g) h = map₂ n' (map₂ m' f h) g := by
  rw [map₂_swap n, map₂_swap n']
  exact map₂_assoc fun _ _ _ => h_right_comm _ _ _
#align filter.map₂_right_comm Filter.map₂_right_comm

theorem map_map₂_distrib {n : γ → δ} {m' : α' → β' → δ} {n₁ : α → α'} {n₂ : β → β'}
    (h_distrib : ∀ a b, n (m a b) = m' (n₁ a) (n₂ b)) :
    (map₂ m f g).map n = map₂ m' (f.map n₁) (g.map n₂) := by
  simp_rw [map_map₂, map₂_map_left, map₂_map_right, h_distrib]
#align filter.map_map₂_distrib Filter.map_map₂_distrib

/-- Symmetric statement to `Filter.map₂_map_left_comm`. -/
theorem map_map₂_distrib_left {n : γ → δ} {m' : α' → β → δ} {n' : α → α'}
    (h_distrib : ∀ a b, n (m a b) = m' (n' a) b) : (map₂ m f g).map n = map₂ m' (f.map n') g :=
  map_map₂_distrib h_distrib
#align filter.map_map₂_distrib_left Filter.map_map₂_distrib_left

/-- Symmetric statement to `Filter.map_map₂_right_comm`. -/
theorem map_map₂_distrib_right {n : γ → δ} {m' : α → β' → δ} {n' : β → β'}
    (h_distrib : ∀ a b, n (m a b) = m' a (n' b)) : (map₂ m f g).map n = map₂ m' f (g.map n') :=
  map_map₂_distrib h_distrib
#align filter.map_map₂_distrib_right Filter.map_map₂_distrib_right

/-- Symmetric statement to `Filter.map_map₂_distrib_left`. -/
theorem map₂_map_left_comm {m : α' → β → γ} {n : α → α'} {m' : α → β → δ} {n' : δ → γ}
    (h_left_comm : ∀ a b, m (n a) b = n' (m' a b)) : map₂ m (f.map n) g = (map₂ m' f g).map n' :=
  (map_map₂_distrib_left fun a b => (h_left_comm a b).symm).symm
#align filter.map₂_map_left_comm Filter.map₂_map_left_comm

/-- Symmetric statement to `Filter.map_map₂_distrib_right`. -/
theorem map_map₂_right_comm {m : α → β' → γ} {n : β → β'} {m' : α → β → δ} {n' : δ → γ}
    (h_right_comm : ∀ a b, m a (n b) = n' (m' a b)) : map₂ m f (g.map n) = (map₂ m' f g).map n' :=
  (map_map₂_distrib_right fun a b => (h_right_comm a b).symm).symm
#align filter.map_map₂_right_comm Filter.map_map₂_right_comm

/-- The other direction does not hold because of the `f`-`f` cross terms on the RHS. -/
theorem map₂_distrib_le_left {m : α → δ → ε} {n : β → γ → δ} {m₁ : α → β → β'} {m₂ : α → γ → γ'}
    {n' : β' → γ' → ε} (h_distrib : ∀ a b c, m a (n b c) = n' (m₁ a b) (m₂ a c)) :
    map₂ m f (map₂ n g h) ≤ map₂ n' (map₂ m₁ f g) (map₂ m₂ f h) := by
  rintro s ⟨t₁, t₂, ⟨u₁, v, hu₁, hv, ht₁⟩, ⟨u₂, w, hu₂, hw, ht₂⟩, hs⟩
  refine' ⟨u₁ ∩ u₂, _, inter_mem hu₁ hu₂, image2_mem_map₂ hv hw, _⟩
  refine' (image2_distrib_subset_left h_distrib).trans ((image2_subset _ _).trans hs)
  · exact (image2_subset_right <| inter_subset_left _ _).trans ht₁
  · exact (image2_subset_right <| inter_subset_right _ _).trans ht₂
#align filter.map₂_distrib_le_left Filter.map₂_distrib_le_left

/-- The other direction does not hold because of the `h`-`h` cross terms on the RHS. -/

theorem map_map₂_antidistrib {n : γ → δ} {m' : β' → α' → δ} {n₁ : β → β'} {n₂ : α → α'}
    (h_antidistrib : ∀ a b, n (m a b) = m' (n₁ b) (n₂ a)) :
    (map₂ m f g).map n = map₂ m' (g.map n₁) (f.map n₂) := by
  rw [map₂_swap m]
  exact map_map₂_distrib fun _ _ => h_antidistrib _ _
#align filter.map_map₂_antidistrib Filter.map_map₂_antidistrib

/-- Symmetric statement to `Filter.map₂_map_left_anticomm`. -/
theorem map_map₂_antidistrib_left {n : γ → δ} {m' : β' → α → δ} {n' : β → β'}
    (h_antidistrib : ∀ a b, n (m a b) = m' (n' b) a) : (map₂ m f g).map n = map₂ m' (g.map n') f :=
  map_map₂_antidistrib h_antidistrib
#align filter.map_map₂_antidistrib_left Filter.map_map₂_antidistrib_left

/-- Symmetric statement to `Filter.map_map₂_right_anticomm`. -/
theorem map_map₂_antidistrib_right {n : γ → δ} {m' : β → α' → δ} {n' : α → α'}
    (h_antidistrib : ∀ a b, n (m a b) = m' b (n' a)) : (map₂ m f g).map n = map₂ m' g (f.map n') :=
  map_map₂_antidistrib h_antidistrib
#align filter.map_map₂_antidistrib_right Filter.map_map₂_antidistrib_right

/-- Symmetric statement to `Filter.map_map₂_antidistrib_left`. -/
theorem map₂_map_left_anticomm {m : α' → β → γ} {n : α → α'} {m' : β → α → δ} {n' : δ → γ}
    (h_left_anticomm : ∀ a b, m (n a) b = n' (m' b a)) :
    map₂ m (f.map n) g = (map₂ m' g f).map n' :=
  (map_map₂_antidistrib_left fun a b => (h_left_anticomm b a).symm).symm
#align filter.map₂_map_left_anticomm Filter.map₂_map_left_anticomm

/-- Symmetric statement to `Filter.map_map₂_antidistrib_right`. -/
theorem map_map₂_right_anticomm {m : α → β' → γ} {n : β → β'} {m' : β → α → δ} {n' : δ → γ}
    (h_right_anticomm : ∀ a b, m a (n b) = n' (m' b a)) :
    map₂ m f (g.map n) = (map₂ m' g f).map n' :=
  (map_map₂_antidistrib_right fun a b => (h_right_anticomm b a).symm).symm
#align filter.map_map₂_right_anticomm Filter.map_map₂_right_anticomm

/-- If `a` is a left identity for `f : α → β → β`, then `pure a` is a left identity for
`Filter.map₂ f`. -/
theorem map₂_left_identity {f : α → β → β} {a : α} (h : ∀ b, f a b = b) (l : Filter β) :
    map₂ f (pure a) l = l := by rw [map₂_pure_left, show f a = id from funext h, map_id]
#align filter.map₂_left_identity Filter.map₂_left_identity

/-- If `b` is a right identity for `f : α → β → α`, then `pure b` is a right identity for
`Filter.map₂ f`. -/
theorem map₂_right_identity {f : α → β → α} {b : β} (h : ∀ a, f a b = a) (l : Filter α) :
    map₂ f l (pure b) = l := by rw [map₂_pure_right, funext h, map_id']
#align filter.map₂_right_identity Filter.map₂_right_identity

end Filter


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kenny Lau
-/
import data.list.big_operators.basic
import algebra.order.monoid.min_max

/-!
# zip & unzip

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

This file provides results about `list.zip_with`, `list.zip` and `list.unzip` (definitions are in
core Lean).
`zip_with f l₁ l₂` applies `f : α → β → γ` pointwise to a list `l₁ : list α` and `l₂ : list β`. It
applies, until one of the lists is exhausted. For example,
`zip_with f [0, 1, 2] [6.28, 31] = [f 0 6.28, f 1 31]`.
`zip` is `zip_with` applied to `prod.mk`. For example,
`zip [a₁, a₂] [b₁, b₂, b₃] = [(a₁, b₁), (a₂, b₂)]`.
`unzip` undoes `zip`. For example, `unzip [(a₁, b₁), (a₂, b₂)] = ([a₁, a₂], [b₁, b₂])`.
-/

universe u

open nat

namespace list
variables {α : Type u} {β γ δ ε : Type*}

@[simp] theorem zip_with_cons_cons (f : α → β → γ) (a : α) (b : β) (l₁ : list α) (l₂ : list β) :
  zip_with f (a :: l₁) (b :: l₂) = f a b :: zip_with f l₁ l₂ := rfl

@[simp] theorem zip_cons_cons (a : α) (b : β) (l₁ : list α) (l₂ : list β) :
  zip (a :: l₁) (b :: l₂) = (a, b) :: zip l₁ l₂ := rfl

@[simp] theorem zip_with_nil_left (f : α → β → γ) (l) : zip_with f [] l = [] := rfl

@[simp] theorem zip_with_nil_right (f : α → β → γ) (l)  : zip_with f l [] = [] :=
by cases l; refl

@[simp] lemma zip_with_eq_nil_iff {f : α → β → γ} {l l'} :
  zip_with f l l' = [] ↔ l = [] ∨ l' = [] :=
by { cases l; cases l'; simp }

@[simp] theorem zip_nil_left (l : list α) : zip ([] : list β) l = [] := rfl

@[simp] theorem zip_nil_right (l : list α) : zip l ([] : list β) = [] :=
zip_with_nil_right _ l

@[simp] theorem zip_swap : ∀ (l₁ : list α) (l₂ : list β),
  (zip l₁ l₂).map prod.swap = zip l₂ l₁
| []      l₂      := (zip_nil_right _).symm
| l₁      []      := by rw zip_nil_right; refl
| (a::l₁) (b::l₂) := by simp only [zip_cons_cons, map_cons, zip_swap l₁ l₂, prod.swap_prod_mk];
    split; refl

@[simp] theorem length_zip_with (f : α → β → γ) : ∀  (l₁ : list α) (l₂ : list β),
   length (zip_with f l₁ l₂) = min (length l₁) (length l₂)
| []      l₂      := rfl
| l₁      []      := by simp only [length, min_zero, zip_with_nil_right]
| (a::l₁) (b::l₂) := by simp [length, zip_cons_cons, length_zip_with l₁ l₂, min_add_add_right]

@[simp] theorem length_zip : ∀ (l₁ : list α) (l₂ : list β),
   length (zip l₁ l₂) = min (length l₁) (length l₂) :=
length_zip_with _

theorem all₂_zip_with {f : α → β → γ} {p : γ → Prop} :
  ∀ {l₁ : list α} {l₂ : list β} (h : length l₁ = length l₂),
  all₂ p (zip_with f l₁ l₂) ↔ forall₂ (λ x y, p (f x y)) l₁ l₂
| [] [] _ := by simp
| (a :: l₁) (b :: l₂) h :=
  by { simp only [length_cons, add_left_inj] at h, simp [all₂_zip_with h] }

lemma lt_length_left_of_zip_with {f : α → β → γ} {i : ℕ} {l : list α} {l' : list β}
  (h : i < (zip_with f l l').length) :
  i < l.length :=
by { rw [length_zip_with, lt_min_iff] at h, exact h.left }

lemma lt_length_right_of_zip_with {f : α → β → γ} {i : ℕ} {l : list α} {l' : list β}
  (h : i < (zip_with f l l').length) :
  i < l'.length :=
by { rw [length_zip_with, lt_min_iff] at h, exact h.right }

lemma lt_length_left_of_zip {i : ℕ} {l : list α} {l' : list β} (h : i < (zip l l').length) :
  i < l.length :=
lt_length_left_of_zip_with h

lemma lt_length_right_of_zip {i : ℕ} {l : list α} {l' : list β} (h : i < (zip l l').length) :
  i < l'.length :=
lt_length_right_of_zip_with h

theorem zip_append : ∀ {l₁ r₁ : list α} {l₂ r₂ : list β} (h : length l₁ = length l₂),
   zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂
| []      r₁ l₂      r₂ h := by simp only [eq_nil_of_length_eq_zero h.symm]; refl
| l₁      r₁ []      r₂ h := by simp only [eq_nil_of_length_eq_zero h]; refl
| (a::l₁) r₁ (b::l₂) r₂ h := by simp only [cons_append, zip_cons_cons, zip_append (succ.inj h)];
    split; refl

theorem zip_map (f : α → γ) (g : β → δ) : ∀ (l₁ : list α) (l₂ : list β),
   zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (prod.map f g)
| []      l₂      := rfl
| l₁      []      := by simp only [map, zip_nil_right]
| (a::l₁) (b::l₂) := by simp only [map, zip_cons_cons, zip_map l₁ l₂, prod.map]; split; refl

theorem zip_map_left (f : α → γ) (l₁ : list α) (l₂ : list β) :
   zip (l₁.map f) l₂ = (zip l₁ l₂).map (prod.map f id) :=
by rw [← zip_map, map_id]

theorem zip_map_right (f : β → γ) (l₁ : list α) (l₂ : list β) :
   zip l₁ (l₂.map f) = (zip l₁ l₂).map (prod.map id f) :=
by rw [← zip_map, map_id]

@[simp] lemma zip_with_map {μ}
  (f : γ → δ → μ) (g : α → γ) (h : β → δ) (as : list α) (bs : list β) :
  zip_with f (as.map g) (bs.map h) =
  zip_with (λ a b, f (g a) (h b)) as bs :=
begin
  induction as generalizing bs,
  { simp },
  { cases bs; simp * }
end

lemma zip_with_map_left
  (f : α → β → γ) (g : δ → α) (l : list δ) (l' : list β) :
  zip_with f (l.map g) l' = zip_with (f ∘ g) l l' :=
by { convert (zip_with_map f g id l l'), exact eq.symm (list.map_id _) }

lemma zip_with_map_right
  (f : α → β → γ) (l : list α) (g : δ → β) (l' : list δ) :
  zip_with f l (l'.map g) = zip_with (λ x, f x ∘ g) l l' :=
by { convert (list.zip_with_map f id g l l'), exact eq.symm (list.map_id _) }

theorem zip_map' (f : α → β) (g : α → γ) : ∀ (l : list α),
   zip (l.map f) (l.map g) = l.map (λ a, (f a, g a))
| []     := rfl
| (a::l) := by simp only [map, zip_cons_cons, zip_map' l]; split; refl

lemma map_zip_with {δ : Type*} (f : α → β) (g : γ → δ → α) (l : list γ) (l' : list δ) :
  map f (zip_with g l l') = zip_with (λ x y, f (g x y)) l l' :=
begin
  induction l with hd tl hl generalizing l',
  { simp },
  { cases l',
    { simp },
    { simp [hl] } }
end

theorem mem_zip {a b} : ∀ {l₁ : list α} {l₂ : list β},
   (a, b) ∈ zip l₁ l₂ → a ∈ l₁ ∧ b ∈ l₂
| (_::l₁) (_::l₂) (or.inl rfl) := ⟨or.inl rfl, or.inl rfl⟩
| (a'::l₁) (b'::l₂) (or.inr h) := by split; simp only [mem_cons_iff, or_true, mem_zip h]

theorem map_fst_zip : ∀ (l₁ : list α) (l₂ : list β),
  l₁.length ≤ l₂.length →
  map prod.fst (zip l₁ l₂) = l₁
| [] bs _ := rfl
| (a :: as) (b :: bs) h := by { simp at h, simp! * }
| (a :: as) [] h := by { simp at h, contradiction }

theorem map_snd_zip : ∀ (l₁ : list α) (l₂ : list β),
  l₂.length ≤ l₁.length →
  map prod.snd (zip l₁ l₂) = l₂
| _ [] _ := by { rw zip_nil_right, refl }
| [] (b :: bs) h := by { simp at h, contradiction }
| (a :: as) (b :: bs) h := by { simp at h, simp! * }

@[simp] theorem unzip_nil : unzip (@nil (α × β)) = ([], []) := rfl

@[simp] theorem unzip_cons (a : α) (b : β) (l : list (α × β)) :
   unzip ((a, b) :: l) = (a :: (unzip l).1, b :: (unzip l).2) :=
by rw unzip; cases unzip l; refl

theorem unzip_eq_map : ∀ (l : list (α × β)), unzip l = (l.map prod.fst, l.map prod.snd)
| []            := rfl
| ((a, b) :: l) := by simp only [unzip_cons, map_cons, unzip_eq_map l]

theorem unzip_left (l : list (α × β)) : (unzip l).1 = l.map prod.fst :=
by simp only [unzip_eq_map]

theorem unzip_right (l : list (α × β)) : (unzip l).2 = l.map prod.snd :=
by simp only [unzip_eq_map]

theorem unzip_swap (l : list (α × β)) : unzip (l.map prod.swap) = (unzip l).swap :=
by simp only [unzip_eq_map, map_map]; split; refl

theorem zip_unzip : ∀ (l : list (α × β)), zip (unzip l).1 (unzip l).2 = l
| []            := rfl
| ((a, b) :: l) := by simp only [unzip_cons, zip_cons_cons, zip_unzip l]; split; refl

theorem unzip_zip_left : ∀ {l₁ : list α} {l₂ : list β}, length l₁ ≤ length l₂ →
  (unzip (zip l₁ l₂)).1 = l₁
| []      l₂      h := rfl
| l₁      []      h := by rw eq_nil_of_length_eq_zero (nat.eq_zero_of_le_zero h); refl
| (a::l₁) (b::l₂) h := by simp only [zip_cons_cons, unzip_cons,
    unzip_zip_left (le_of_succ_le_succ h)]; split; refl

theorem unzip_zip_right {l₁ : list α} {l₂ : list β} (h : length l₂ ≤ length l₁) :
  (unzip (zip l₁ l₂)).2 = l₂ :=
by rw [← zip_swap, unzip_swap]; exact unzip_zip_left h

theorem unzip_zip {l₁ : list α} {l₂ : list β} (h : length l₁ = length l₂) :
  unzip (zip l₁ l₂) = (l₁, l₂) :=
by rw [← @prod.mk.eta _ _ (unzip (zip l₁ l₂)),
  unzip_zip_left (le_of_eq h), unzip_zip_right (ge_of_eq h)]

lemma zip_of_prod {l : list α} {l' : list β} {lp : list (α × β)}
  (hl : lp.map prod.fst = l) (hr : lp.map prod.snd = l') :
  lp = l.zip l' :=
by rw [←hl, ←hr, ←zip_unzip lp, ←unzip_left, ←unzip_right, zip_unzip, zip_unzip]

lemma map_prod_left_eq_zip {l : list α} (f : α → β) : l.map (λ x, (x, f x)) = l.zip (l.map f) :=
by { rw ←zip_map', congr, exact map_id _ }

lemma zip_with_comm (f : α → β → γ) : ∀ (la : list α) (lb : list β),
  zip_with f la lb = zip_with (λ b a, f a b) lb la
| [] _ := (list.zip_with_nil_right _ _).symm
| (a :: as) [] := rfl
| (a :: as) (b :: bs) := congr_arg _ (zip_with_comm as bs)

@[congr]
lemma zip_with_congr (f g : α → β → γ) (la : list α) (lb : list β)
  (h : list.forall₂ (λ a b, f a b = g a b) la lb) :
  zip_with f la lb = zip_with g la lb :=
begin
  induction h with a b as bs hfg habs ih,
  { refl },
  { exact congr_arg2 _ hfg ih }
end

lemma zip_with_comm_of_comm (f : α → α → β) (comm : ∀ (x y : α), f x y = f y x) (l l' : list α) :
  zip_with f l l' = zip_with f l' l :=
by { rw zip_with_comm, simp only [comm] }

@[simp]
lemma zip_with_same (f : α → α → δ) : ∀ (l : list α), zip_with f l l = l.map (λ a, f a a)
| [] := rfl
| (x :: xs) := congr_arg _ (zip_with_same xs)

lemma zip_with_zip_with_left (f : δ → γ → ε) (g : α → β → δ) :
  ∀ (la : list α) (lb : list β) (lc : list γ),
    zip_with f (zip_with g la lb) lc = zip_with3 (λ a b c, f (g a b) c) la lb lc
| [] _ _ := rfl
| (a :: as) [] _ := rfl
| (a :: as) (b :: bs) [] := rfl
| (a :: as) (b :: bs) (c :: cs) := congr_arg (cons _) $ zip_with_zip_with_left as bs cs

lemma zip_with_zip_with_right (f : α → δ → ε) (g : β → γ → δ) :
  ∀ (la : list α) (lb : list β) (lc : list γ),
    zip_with f la (zip_with g lb lc) = zip_with3 (λ a b c, f a (g b c)) la lb lc
| [] _ _ := rfl
| (a :: as) [] _ := rfl
| (a :: as) (b :: bs) [] := rfl
| (a :: as) (b :: bs) (c :: cs) := congr_arg (cons _) $ zip_with_zip_with_right as bs cs

@[simp]
lemma zip_with3_same_left (f : α → α → β → γ) : ∀ (la : list α) (lb : list β),
  zip_with3 f la la lb = zip_with (λ a b, f a a b) la lb
| [] _ := rfl
| (a :: as) [] := rfl
| (a :: as) (b :: bs) := congr_arg (cons _) $ zip_with3_same_left as bs

@[simp]
lemma zip_with3_same_mid (f : α → β → α → γ) : ∀ (la : list α) (lb : list β),
  zip_with3 f la lb la = zip_with (λ a b, f a b a) la lb
| [] _ := rfl
| (a :: as) [] := rfl
| (a :: as) (b :: bs) := congr_arg (cons _) $ zip_with3_same_mid as bs

@[simp]
lemma zip_with3_same_right (f : α → β → β → γ) : ∀ (la : list α) (lb : list β),
  zip_with3 f la lb lb = zip_with (λ a b, f a b b) la lb
| [] _ := rfl
| (a :: as) [] := rfl
| (a :: as) (b :: bs) := congr_arg (cons _) $ zip_with3_same_right as bs

instance (f : α → α → β) [is_symm_op α β f] : is_symm_op (list α) (list β) (zip_with f) :=
⟨zip_with_comm_of_comm f is_symm_op.symm_op⟩

@[simp] theorem length_revzip (l : list α) : length (revzip l) = length l :=
by simp only [revzip, length_zip, length_reverse, min_self]

@[simp] theorem unzip_revzip (l : list α) : (revzip l).unzip = (l, l.reverse) :=
unzip_zip (length_reverse l).symm

@[simp] theorem revzip_map_fst (l : list α) : (revzip l).map prod.fst = l :=
by rw [← unzip_left, unzip_revzip]

@[simp] theorem revzip_map_snd (l : list α) : (revzip l).map prod.snd = l.reverse :=
by rw [← unzip_right, unzip_revzip]

theorem reverse_revzip (l : list α) : reverse l.revzip = revzip l.reverse :=
by rw [← zip_unzip.{u u} (revzip l).reverse, unzip_eq_map]; simp; simp [revzip]

theorem revzip_swap (l : list α) : (revzip l).map prod.swap = revzip l.reverse :=
by simp [revzip]

lemma nth_zip_with (f : α → β → γ) (l₁ : list α) (l₂ : list β) (i : ℕ) :
  (zip_with f l₁ l₂).nth i = ((l₁.nth i).map f).bind (λ g, (l₂.nth i).map g) :=
begin
  induction l₁ generalizing l₂ i,
  { simp [zip_with, (<*>)] },
  { cases l₂; simp only [zip_with, has_seq.seq, functor.map, nth, option.map_none'],
    { cases ((l₁_hd :: l₁_tl).nth i); refl },
    { cases i; simp only [option.map_some', nth, option.some_bind', *] } }
end

lemma nth_zip_with_eq_some {α β γ} (f : α → β → γ) (l₁ : list α) (l₂ : list β) (z : γ) (i : ℕ) :
  (zip_with f l₁ l₂).nth i = some z ↔ ∃ x y, l₁.nth i = some x ∧ l₂.nth i = some y ∧ f x y = z :=
begin
  induction l₁ generalizing l₂ i,
  { simp [zip_with] },
  { cases l₂; simp only [zip_with, nth, exists_false, and_false, false_and],
    cases i; simp *, },
end

lemma nth_zip_eq_some (l₁ : list α) (l₂ : list β) (z : α × β) (i : ℕ) :
  (zip l₁ l₂).nth i = some z ↔ l₁.nth i = some z.1 ∧ l₂.nth i = some z.2 :=
begin
  cases z,
  rw [zip, nth_zip_with_eq_some], split,
  { rintro ⟨x, y, h₀, h₁, h₂⟩, cc },
  { rintro ⟨h₀, h₁⟩, exact ⟨_,_,h₀,h₁,rfl⟩ }
end

@[simp] lemma nth_le_zip_with {f : α → β → γ} {l : list α} {l' : list β} {i : ℕ}
  {h : i < (zip_with f l l').length} :
  (zip_with f l l').nth_le i h =
    f (l.nth_le i (lt_length_left_of_zip_with h)) (l'.nth_le i (lt_length_right_of_zip_with h)) :=
begin
  rw [←option.some_inj, ←nth_le_nth, nth_zip_with_eq_some],
  refine ⟨l.nth_le i (lt_length_left_of_zip_with h), l'.nth_le i (lt_length_right_of_zip_with h),
          nth_le_nth _, _⟩,
  simp only [←nth_le_nth, eq_self_iff_true, and_self]
end

@[simp] lemma nth_le_zip {l : list α} {l' : list β} {i : ℕ} {h : i < (zip l l').length} :
  (zip l l').nth_le i h =
    (l.nth_le i (lt_length_left_of_zip h), l'.nth_le i (lt_length_right_of_zip h)) :=
nth_le_zip_with

lemma mem_zip_inits_tails {l : list α} {init tail : list α} :
  (init, tail) ∈ zip l.inits l.tails ↔ init ++ tail = l :=
begin
  induction l generalizing init tail;
    simp_rw [tails, inits, zip_cons_cons],
  { simp },
  { split; rw [mem_cons_iff, zip_map_left, mem_map, prod.exists],
    { rintros (⟨rfl, rfl⟩ | ⟨_, _, h, rfl, rfl⟩),
      { simp },
      { simp [l_ih.mp h], }, },
    { cases init,
      { simp },
      { intro h,
        right,
        use [init_tl, tail],
        simp * at *, }, }, },
end

lemma map_uncurry_zip_eq_zip_with
  (f : α → β → γ) (l : list α) (l' : list β) :
  map (function.uncurry f) (l.zip l') = zip_with f l l' :=
begin
  induction l with hd tl hl generalizing l',
  { simp },
  { cases l' with hd' tl',
    { simp },
    { simp [hl] } }
end

@[simp] lemma sum_zip_with_distrib_left {γ : Type*} [semiring γ]
  (f : α → β → γ) (n : γ) (l : list α) (l' : list β) :
  (l.zip_with (λ x y, n * f x y) l').sum = n * (l.zip_with f l').sum :=
begin
  induction l with hd tl hl generalizing f n l',
  { simp },
  { cases l' with hd' tl',
    { simp, },
    { simp [hl, mul_add] } }
end

section distrib

/-! ### Operations that can be applied before or after a `zip_with` -/

variables (f : α → β → γ) (l : list α) (l' : list β) (n : ℕ)

lemma zip_with_distrib_take :
  (zip_with f l l').take n = zip_with f (l.take n) (l'.take n) :=
begin
  induction l with hd tl hl generalizing l' n,
  { simp },
  { cases l',
    { simp },
    { cases n,
      { simp },
      { simp [hl] } } }
end

lemma zip_with_distrib_drop :
  (zip_with f l l').drop n = zip_with f (l.drop n) (l'.drop n) :=
begin
  induction l with hd tl hl generalizing l' n,
  { simp },
  { cases l',
    { simp },
    { cases n,
      { simp },
      { simp [hl] } } }
end

lemma zip_with_distrib_tail :
  (zip_with f l l').tail = zip_with f l.tail l'.tail :=
by simp_rw [←drop_one, zip_with_distrib_drop]

lemma zip_with_append (f : α → β → γ) (l la : list α) (l' lb : list β) (h : l.length = l'.length) :
  zip_with f (l ++ la) (l' ++ lb) = zip_with f l l' ++ zip_with f la lb :=
begin
  induction l with hd tl hl generalizing l',
  { have : l' = [] := eq_nil_of_length_eq_zero (by simpa using h.symm),
    simp [this], },
  { cases l',
    { simpa using h },
    { simp only [add_left_inj, length] at h,
      simp [hl _ h] } }
end

lemma zip_with_distrib_reverse (h : l.length = l'.length) :
  (zip_with f l l').reverse = zip_with f l.reverse l'.reverse :=
begin
  induction l with hd tl hl generalizing l',
  { simp },
  { cases l' with hd' tl',
    { simp },
    { simp only [add_left_inj, length] at h,
      have : tl.reverse.length = tl'.reverse.length := by simp [h],
      simp [hl _ h, zip_with_append _ _ _ _ _ this] } }
end

end distrib

section comm_monoid

variables [comm_monoid α]

@[to_additive]
lemma prod_mul_prod_eq_prod_zip_with_mul_prod_drop : ∀ (L L' : list α), L.prod * L'.prod =
  (zip_with (*) L L').prod * (L.drop L'.length).prod * (L'.drop L.length).prod
| [] ys := by simp [nat.zero_le]
| xs [] := by simp [nat.zero_le]
| (x :: xs) (y :: ys) := begin
  simp only [drop, length, zip_with_cons_cons, prod_cons],
  rw [mul_assoc x, mul_comm xs.prod, mul_assoc y, mul_comm ys.prod,
    prod_mul_prod_eq_prod_zip_with_mul_prod_drop xs ys, mul_assoc, mul_assoc, mul_assoc, mul_assoc]
end

@[to_additive]
lemma prod_mul_prod_eq_prod_zip_with_of_length_eq (L L' : list α) (h : L.length = L'.length) :
  L.prod * L'.prod = (zip_with (*) L L').prod :=
(prod_mul_prod_eq_prod_zip_with_mul_prod_drop L L').trans (by simp [h])

end comm_monoid

end list


/-
Copyright (c) 2022 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller

! This file was ported from Lean 3 source module data.finite.basic
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Powerset
import Mathbin.Data.Fintype.Prod
import Mathbin.Data.Fintype.Sigma
import Mathbin.Data.Fintype.Sum
import Mathbin.Data.Fintype.Vector

/-!
# Finite types

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

In this file we prove some theorems about `finite` and provide some instances. This typeclass is a
`Prop`-valued counterpart of the typeclass `fintype`. See more details in the file where `finite` is
defined.

## Main definitions

* `fintype.finite`, `finite.of_fintype` creates a `finite` instance from a `fintype` instance. The
  former lemma takes `fintype α` as an explicit argument while the latter takes it as an instance
  argument.
* `fintype.of_finite` noncomputably creates a `fintype` instance from a `finite` instance.

## Implementation notes

There is an apparent duplication of many `fintype` instances in this module,
however they follow a pattern: if a `fintype` instance depends on `decidable`
instances or other `fintype` instances, then we need to "lower" the instance
to be a `finite` instance by removing the `decidable` instances and switching
the `fintype` instances to `finite` instances. These are precisely the ones
that cannot be inferred using `finite.of_fintype`. (However, when using
`open_locale classical` or the `classical` tactic the instances relying only
on `decidable` instances will give `finite` instances.) In the future we might
consider writing automation to create these "lowered" instances.

## Tags

finiteness, finite types
-/

noncomputable section

open Classical

variable {α β γ : Type _}

namespace Finite

#print Finite.of_subsingleton /-
-- see Note [lower instance priority]
instance (priority := 100) of_subsingleton {α : Sort _} [Subsingleton α] : Finite α :=
  of_injective (Function.const α ()) <| Function.injective_of_subsingleton _
#align finite.of_subsingleton Finite.of_subsingleton
-/

#print Finite.prop /-
-- Higher priority for `Prop`s
@[nolint instance_priority]
instance prop (p : Prop) : Finite p :=
  Finite.of_subsingleton
#align finite.prop Finite.prop
-/

instance [Finite α] [Finite β] : Finite (α × β) :=
  by
  haveI := Fintype.ofFinite α
  haveI := Fintype.ofFinite β
  infer_instance

instance {α β : Sort _} [Finite α] [Finite β] : Finite (PProd α β) :=
  of_equiv _ Equiv.pprodEquivProdPLift.symm

#print Finite.prod_left /-
theorem prod_left (β) [Finite (α × β)] [Nonempty β] : Finite α :=
  of_surjective (Prod.fst : α × β → α) Prod.fst_surjective
#align finite.prod_left Finite.prod_left
-/

#print Finite.prod_right /-
theorem prod_right (α) [Finite (α × β)] [Nonempty α] : Finite β :=
  of_surjective (Prod.snd : α × β → β) Prod.snd_surjective
#align finite.prod_right Finite.prod_right
-/

instance [Finite α] [Finite β] : Finite (Sum α β) :=
  by
  haveI := Fintype.ofFinite α
  haveI := Fintype.ofFinite β
  infer_instance

#print Finite.sum_left /-
theorem sum_left (β) [Finite (Sum α β)] : Finite α :=
  of_injective (Sum.inl : α → Sum α β) Sum.inl_injective
#align finite.sum_left Finite.sum_left
-/

#print Finite.sum_right /-
theorem sum_right (α) [Finite (Sum α β)] : Finite β :=
  of_injective (Sum.inr : β → Sum α β) Sum.inr_injective
#align finite.sum_right Finite.sum_right
-/

instance {β : α → Type _} [Finite α] [∀ a, Finite (β a)] : Finite (Σa, β a) :=
  by
  letI := Fintype.ofFinite α
  letI := fun a => Fintype.ofFinite (β a)
  infer_instance

instance {ι : Sort _} {π : ι → Sort _} [Finite ι] [∀ i, Finite (π i)] : Finite (Σ'i, π i) :=
  of_equiv _ (Equiv.psigmaEquivSigmaPLift π).symm

instance [Finite α] : Finite (Set α) :=
  by
  cases nonempty_fintype α
  infer_instance

end Finite

#print Subtype.finite /-
/-- This instance also provides `[finite s]` for `s : set α`. -/
instance Subtype.finite {α : Sort _} [Finite α] {p : α → Prop} : Finite { x // p x } :=
  Finite.of_injective coe Subtype.coe_injective
#align subtype.finite Subtype.finite
-/

#print Pi.finite /-
instance Pi.finite {α : Sort _} {β : α → Sort _} [Finite α] [∀ a, Finite (β a)] :
    Finite (∀ a, β a) := by
  haveI := Fintype.ofFinite (PLift α)
  haveI := fun a => Fintype.ofFinite (PLift (β a))
  exact
    Finite.of_equiv (∀ a : PLift α, PLift (β (Equiv.plift a)))
      (Equiv.piCongr Equiv.plift fun _ => Equiv.plift)
#align pi.finite Pi.finite
-/

#print Vector.finite /-
instance Vector.finite {α : Type _} [Finite α] {n : ℕ} : Finite (Vector α n) :=
  by
  haveI := Fintype.ofFinite α
  infer_instance
#align vector.finite Vector.finite
-/

#print Quot.finite /-
instance Quot.finite {α : Sort _} [Finite α] (r : α → α → Prop) : Finite (Quot r) :=
  Finite.of_surjective _ (surjective_quot_mk r)
#align quot.finite Quot.finite
-/

#print Quotient.finite /-
instance Quotient.finite {α : Sort _} [Finite α] (s : Setoid α) : Finite (Quotient s) :=
  Quot.finite _
#align quotient.finite Quotient.finite
-/

/- warning: function.embedding.finite -> Function.Embedding.finite is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} [_inst_1 : Finite.{u2} β], Finite.{max 1 (imax u1 u2)} (Function.Embedding.{u1, u2} α β)
but is expected to have type
  forall {α : Sort.{u1}} {β : Sort.{u2}} [_inst_1 : Finite.{u2} β], Finite.{max (max 1 u2) u1} (Function.Embedding.{u1, u2} α β)
Case conversion may be inaccurate. Consider using '#align function.embedding.finite Function.Embedding.finiteₓ'. -/
instance Function.Embedding.finite {α β : Sort _} [Finite β] : Finite (α ↪ β) :=
  by
  cases' isEmpty_or_nonempty (α ↪ β) with _ h
  · infer_instance
  · refine' h.elim fun f => _
    haveI : Finite α := Finite.of_injective _ f.injective
    exact Finite.of_injective _ FunLike.coe_injective
#align function.embedding.finite Function.Embedding.finite

/- warning: equiv.finite_right -> Equiv.finite_right is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} [_inst_1 : Finite.{u2} β], Finite.{max 1 (imax u1 u2) (imax u2 u1)} (Equiv.{u1, u2} α β)
but is expected to have type
  forall {α : Sort.{u1}} {β : Sort.{u2}} [_inst_1 : Finite.{u2} β], Finite.{max (max 1 u2) u1} (Equiv.{u1, u2} α β)
Case conversion may be inaccurate. Consider using '#align equiv.finite_right Equiv.finite_rightₓ'. -/
instance Equiv.finite_right {α β : Sort _} [Finite β] : Finite (α ≃ β) :=
  Finite.of_injective Equiv.toEmbedding fun e₁ e₂ h => Equiv.ext <| by convert FunLike.congr_fun h
#align equiv.finite_right Equiv.finite_right

/- warning: equiv.finite_left -> Equiv.finite_left is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} [_inst_1 : Finite.{u1} α], Finite.{max 1 (imax u1 u2) (imax u2 u1)} (Equiv.{u1, u2} α β)
but is expected to have type
  forall {α : Sort.{u1}} {β : Sort.{u2}} [_inst_1 : Finite.{u1} α], Finite.{max (max 1 u2) u1} (Equiv.{u1, u2} α β)
Case conversion may be inaccurate. Consider using '#align equiv.finite_left Equiv.finite_leftₓ'. -/
instance Equiv.finite_left {α β : Sort _} [Finite α] : Finite (α ≃ β) :=
  Finite.of_equiv _ ⟨Equiv.symm, Equiv.symm, Equiv.symm_symm, Equiv.symm_symm⟩
#align equiv.finite_left Equiv.finite_left

instance [Finite α] {n : ℕ} : Finite (Sym α n) :=
  by
  haveI := Fintype.ofFinite α
  infer_instance