import combinatorics.simple_graph.ends.defs
import combinatorics.simple_graph.ends.properties

open classical function category_theory opposite

universes u v w

noncomputable theory
local attribute [instance] prop_decidable

namespace simple_graph
namespace component_compl

variables {V : Type u} {G : simple_graph V} (Gpc : G.preconnected)

include Gpc

lemma subset_of_nicely_arranged
  (H K : set V)
  (Hnempty : H.nonempty)
  (E E' : G.component_compl H)
  (Einf' : E'.supp.infinite)
  (En : E ≠ E')
  (F : G.component_compl K)
  (H_F : H ⊆ F)
  (K_E : K ⊆ E) : (E' : set V) ⊆ F :=
begin
  have KE' : (K ∩ E') ⊆ ∅ := λ v ⟨vK, vE'⟩,
    En (component_compl.pairwise_disjoint.eq (set.not_disjoint_iff.mpr ⟨v, K_E vK, vE'⟩)),
  obtain ⟨F', sub, inf⟩ : ∃ F' : component_compl G K, (E' : set V) ⊆ F' ∧ F'.supp.infinite :=
    ⟨ of_connected_disjoint_right E'.connected (set.disjoint_iff.mpr KE'),
      subset_of_connected_disjoint_right _ _,
      Einf'.mono (subset_of_connected_disjoint_right _ _)⟩,
  have : F' = F, by
  { obtain ⟨⟨v, h⟩, vE', hH, a⟩:= exists_adj_boundary_pair Gpc Hnempty E',
    exact eq_of_adj v h (sub vE') (H_F hH) a, },
  exact this ▸ sub,
end

variable [locally_finite G]

lemma hom_not_injective
  {H K : (finset V)ᵒᵖ}
  {C : G.component_compl_functor.to_eventual_ranges.obj H}
  {D D' : G.component_compl_functor.to_eventual_ranges.obj K}
  (Ddist : D ≠ D')
  (h : D.val.supp ⊆ C.val.supp) (h' : D'.val.supp ⊆ C.val.supp) :
  ¬ (injective $
    G.component_compl_functor.to_eventual_ranges.map
      (op_hom_of_le $ finset.subset_union_left H.unop K.unop : op (H.unop ∪ K.unop) ⟶ H)) :=
begin
  obtain ⟨E, hE⟩ :=
    functor.surjective_to_eventual_ranges _ (G.component_compl_functor_is_mittag_leffler Gpc)
      (op_hom_of_le $ finset.subset_union_right H.unop K.unop : op (H.unop ∪ K.unop) ⟶ K) D,
  obtain ⟨E', hE'⟩ :=
    functor.surjective_to_eventual_ranges _ (G.component_compl_functor_is_mittag_leffler Gpc)
      (op_hom_of_le $ finset.subset_union_right H.unop K.unop : op (H.unop ∪ K.unop) ⟶ K) D',
  subst_vars,
  refine λ inj, (by { rintro rfl, exact Ddist rfl, } : E ≠ E') (inj _),
  obtain ⟨E, _⟩ := E,
  obtain ⟨E', _⟩ := E',
  dsimp only [component_compl_functor, functor.to_eventual_ranges, functor.eventual_range] at *,
  simp only [subtype.ext_iff_val, subtype.val_eq_coe, set.maps_to.coe_restrict_apply, subtype.coe_mk],
  rw [(hom_eq_iff_le _ _ _).mpr ((E.subset_hom _).trans h),
      (hom_eq_iff_le _ _ _).mpr ((E'.subset_hom _).trans h')],
end

omit Gpc
lemma _root_.fin.fin3_embedding_iff {α : Type*} :
  nonempty (fin 3 ↪ α) ↔ ∃ (a₀ a₁ a₂ : α), a₀ ≠ a₁ ∧ a₀ ≠ a₂ ∧ a₁ ≠ a₂ := sorry

lemma _root_.fin.fin3_embedding_iff' {α : Type*} (a : α):
  nonempty (fin 3 ↪ α) ↔ ∃ (a₁ a₂ : α), a ≠ a₁ ∧ a ≠ a₂ ∧ a₁ ≠ a₂ :=
begin
  split,
  rintro ⟨e⟩,
  { by_cases h : a = e 0,
    { use [e 1, e 2],
      simp only [h, embedding_like.apply_eq_iff_eq, fin.eq_iff_veq, fin.val_zero', fin.val_one,
                 fin.val_two, ne.def, zero_eq_bit0, nat.one_ne_zero, nat.zero_ne_one, not_false_iff,
                 nat.one_ne_bit0, and_self], },
    { by_cases k : a = e 1,
      { use [e 0, e 2],
        simp only [h, k, embedding_like.apply_eq_iff_eq, fin.eq_iff_veq, fin.val_zero', fin.val_one,
                 fin.val_two, ne.def, zero_eq_bit0, nat.one_ne_zero, nat.zero_ne_one, not_false_iff,
                 nat.one_ne_bit0, and_self], },
      { use [e 0, e 1],
        simp only [h, k, ne.def, embedding_like.apply_eq_iff_eq, fin.zero_eq_one_iff,
                   nat.bit1_eq_one, nat.one_ne_zero, not_false_iff, and_true],  }, }, },
  { rintro ⟨a₁,a₂,h₁,h₂,h⟩,
    refine ⟨⟨λ i, [a,a₁,a₂].nth_le i.val i.prop, _⟩⟩,
    have : list.nodup [a,a₁,a₂], by simp [h, h₁, h₂],
    rintro ⟨i,hi⟩ ⟨j,hj⟩,
    simp [list.nodup.nth_le_inj_iff this], },
end

include Gpc
lemma hom_not_injective_of_nicely_arranged
  {H K : (finset V)ᵒᵖ}
  (Hnempty : (unop H).nonempty)
  {E : G.component_compl_functor.to_eventual_ranges.obj H}
  {F : G.component_compl_functor.to_eventual_ranges.obj K}
  (H_F : (H.unop : set V) ⊆ F.val.supp)
  (K_E : (K.unop : set V) ⊆ E.val.supp)
  {hK : fin 3 ↪ (G.component_compl_functor.to_eventual_ranges.obj H)} :
  ¬ (injective $
    G.component_compl_functor.to_eventual_ranges.map
      (op_hom_of_le $ finset.subset_union_left K.unop H.unop : op (K.unop ∪ H.unop) ⟶ K)) :=
begin
  obtain ⟨E₁, E₂, h₀₁, h₀₂, h₁₂⟩ := (fin.fin3_embedding_iff' E).mp ⟨hK⟩,
  apply @hom_not_injective V G Gpc _ _ _ F E₁ E₂ h₁₂ _ _,
  { apply subset_of_nicely_arranged Gpc _ _ Hnempty E.val E₁.val,
    any_goals
    { rw infinite_iff_in_eventual_range },
    exacts [E₁.prop, λ h, h₀₁ (subtype.eq h), H_F, K_E], },
  { apply subset_of_nicely_arranged Gpc _ _ Hnempty E.val E₂.val,
    any_goals
    { rw infinite_iff_in_eventual_range },
    exacts [E₂.prop, λ h, h₀₂ (subtype.eq h), H_F, K_E], },
end

omit Gpc
-- TODO: fit somewhere
lemma _root_.fin.embedding_subsingleton {n : ℕ} {α : Type*} [subsingleton α] (e : fin n ↪ α) :
  n ≤ 1 :=
begin
  by_contra' h,
  simpa using e.inj' (subsingleton.elim (e ⟨0,zero_lt_one.trans h⟩) (e ⟨1,h⟩)),
end
include Gpc

/-
  This is the key part of Hopf-Freudenthal
  Assuming this is proved:
  As long as K has at least three infinite connected components, then so does L, and
  bwd_map ‹L⊆L› is not injective, hence the graph has more than three ends.
-/
lemma hom_not_injective_of_enough_automorphisms_of_many_components
  (auts : ∀ K : finset V, ∃ φ : G ≃g G, disjoint K (finset.image φ K))
  (K : (finset V)ᵒᵖ)
  (hK : fin 3 ↪ (G.component_compl_functor.to_eventual_ranges.obj K)) :
  ∃ (L M : (finset V)ᵒᵖ) (hL : L ⟶ K) (hM : M ⟶ L),
    ¬ (injective $ G.component_compl_functor.to_eventual_ranges.map hM) :=
begin
  have Kn : K.unop.nonempty,
  { by_contradiction h,
    rw finset.not_nonempty_iff_eq_empty at h,
    simp only [unop_eq_iff_eq_op.mp h, component_compl_functor, functor.to_eventual_ranges,
               functor.eventual_range] at hK,
    dsimp [functor.eventual_range, component_compl] at hK,
    replace hK := hK.trans ⟨_, subtype.coe_injective⟩,
    rw [set.compl_empty] at hK,
    replace hK := hK.trans (connected_component.iso (induce_univ_iso G)).to_embedding,
    haveI := Gpc.subsingleton_connected_component,
    exact nat.not_succ_le_zero _ (nat.le_of_succ_le_succ (fin.embedding_subsingleton hK)), },

  obtain ⟨L,KL,Lc,inf⟩ := exists_saturated_connected_extension Gpc Kn,
  obtain ⟨φ,φh⟩ := auts L,
  let φL := L.image φ,
  have φLc : (G.induce (φL : set V)).connected, by
  { rw [finset.coe_image, ←(induce.iso φ).connected_iff], exact Lc, },

  refine ⟨op L, op (L ∪ φL), op_hom_of_le KL, op_hom_of_le (finset.subset_union_left _ _), _⟩,

  let lol : (G.induce (L : set V)ᶜ) ≃g (G.induce (φL : set V)ᶜ), by
  { rw (by simp only [set.image_compl_eq φ.bijective, finset.coe_image] :
          (φL : set V)ᶜ = φ '' (L : set V)ᶜ),
    apply induce.iso, },

  have φinf : ∀ C : G.component_compl φL, C.supp.infinite, by
  { simp_rw ←set.infinite_coe_iff at inf ⊢,
    rintro C,
    rw [←(connected_component.iso lol).right_inv C, equiv.infinite_iff],
    exact inf ((connected_component.iso lol).symm C),
    exact (component_compl.supp_equiv _).trans
      ((connected_component.iso_equiv_supp lol _).symm.trans
        (component_compl.supp_equiv _).symm), },

  apply @hom_not_injective_of_nicely_arranged V G Gpc _ (op φL) (op L) ((Kn.mono KL).image φ) ⟨_, _⟩ ⟨_, _⟩
    (subset_of_connected_disjoint_right φLc (finset.disjoint_coe.mpr φh))
    (subset_of_connected_disjoint_right Lc (finset.disjoint_coe.mpr φh.symm)) _,
  exact (@component_compl.infinite_iff_in_eventual_range V G (op φL) _).mp (φinf _),
  exact (@component_compl.infinite_iff_in_eventual_range V G (op L) _).mp (inf _),

  have eL: G.component_compl_functor.to_eventual_ranges.obj (op L) ≃
         G.component_compl_functor.to_eventual_ranges.obj (op φL), by
  { simp_rw component_compl_functor_to_eventual_ranges_obj_eq,
    refine ((equiv.subtype_univ_equiv inf).trans (connected_component.iso lol)).trans (equiv.subtype_univ_equiv φinf).symm, },
  have iK: G.component_compl_functor.to_eventual_ranges.obj K ↪
         G.component_compl_functor.to_eventual_ranges.obj (op L), by
  { refine function.embedding.of_surjective
      (G.component_compl_functor.to_eventual_ranges.map $ op_hom_of_le KL) _,
    apply G.component_compl_functor.surjective_to_eventual_ranges,
    exact G.component_compl_functor_is_mittag_leffler Gpc, },
  exact (hK.trans iK).trans eL.to_embedding,
end

lemma Freudenthal_Hopf [Vi : infinite V]
  (auts : ∀ K :finset V, ∃ φ : G ≃g G, disjoint K (finset.image φ K))
  (many_ends : fin 3 ↪ G.end) : G.end.infinite :=
begin
  intros finite_ends,
  let Gccf := G.component_compl_functor,
  -- Gccf has nonempty sections and nonempty sets at each K
  haveI := finite_ends.fintype,
  haveI := fintype.of_equiv G.end (Gccf.to_eventual_ranges_sections_equiv).symm,
  haveI := component_compl_functor_to_eventual_ranges_fintype Gpc,
  haveI := λ j, component_compl_functor_to_eventual_ranges_nonempty_of_infinite G Gpc j,
  -- Gccf is a "surjective" system
  have surj : ∀ ⦃i j⦄ (f : i ⟶ j), function.surjective _ :=
    functor.surjective_to_eventual_ranges _ (G.component_compl_functor_is_mittag_leffler Gpc),
  -- All the maps of Gccf to `K` are injective, and `Gccf K` has at least 3 components.
  obtain ⟨K,top⟩ := Gccf.to_eventual_ranges.eventually_injective surj,
  let inj' := Gccf.to_eventual_ranges.eval_section_injective_of_eventually_injective top,
  let inj'' := (many_ends.trans (Gccf.to_eventual_ranges_sections_equiv).symm.to_embedding).trans
                 ⟨_, (inj' K (𝟙 K))⟩,
  -- But there is a point above `K` from which the `Gccf` is not injective.
  -- Derive a contradiction
  obtain ⟨L,M,KL,LM,LM_not_inj⟩ :=
    hom_not_injective_of_enough_automorphisms_of_many_components Gpc auts K inj'',
  refine LM_not_inj (@injective.of_comp _ _ _ (Gccf.to_eventual_ranges.map KL) _ _),
  rw [←types_comp,←functor.map_comp],
  apply top,
end

lemma good_automs_of_infinite_transitive
  [Vi : infinite V] [locally_finite G]
  (Gpc : G.preconnected)
  (trans : ∀ (x y : V), ∃ φ : G ≃g G, φ x = y) (K :finset V) :
  ∃ φ : G ≃g G, disjoint K (K.image φ) :=
begin
  sorry,
  -- assume K has diameter m,
  -- take x in K, and some y at distance ≥2m from x.
end

end component_compl
end simple_graph
#lint


/-
Copyright (c) 2022 Dhruv Bhatia. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author(s): Dhruv Bhatia, Robert Y. Lewis
-/

import tactic.polyrith
import data.real.basic

/-!

Each call to `polyrith` makes a call to the SageCell web API at
<https://sagecell.sagemath.org/>. To avoid making many API calls from CI,
we only test this communication in a few tests.

A full test suite is provided at the bottom of the file.

-/

/-!
## Set up testing infrastructre
-/

section tactic
open polyrith tactic
/--
For testing purposes, this behaves like `tactic.polyrith`, but takes an extra argument
representing the expected output from a call to Sage.
Allows for testing without actually making API calls.
-/
meta def tactic.test_polyrith (only_on : bool) (hyps : list pexpr)
  (sage_out : json) (expected_args : list string) (expected_out : string) :
  tactic unit := do
  (eq_names, m, R, args) ← create_args only_on hyps,
  guard (args = expected_args) <|>
    fail!"expected arguments to Sage: {expected_args}\nbut produced: {args}",
  out ← to_string <$> process_output eq_names m R sage_out,
  guard (out = expected_out) <|>
    fail!"expected final output: {expected_out}\nbut produced: {out}"

meta def format_string_list (input : list string) : format :=
"[" ++ (format.join $ (input.map (λ s, ("\"" : format) ++ format.of_string s ++ "\"")).intersperse ("," ++ format.line)) ++ "]"

setup_tactic_parser

meta def tactic.interactive.test_polyrith (restr : parse (tk "only")?)
  (hyps : parse pexpr_list?)
  (sage_out : string) (expected_args : list string) (expected_out : string) : tactic unit := do
  some sage_out ← return $ json.parse sage_out,
  tactic.test_polyrith restr.is_some (hyps.get_or_else []) sage_out expected_args expected_out

meta def tactic.interactive.test_sage_output (restr : parse (tk "only")?)
  (hyps : parse pexpr_list?) (expected_out : string) : tactic unit := do
  expected_json ← json.parse expected_out,
  sleep 10, -- otherwise can lead to weird errors when actively editing code with polyrith calls
  (eq_names, m, R, args) ← create_args restr.is_some (hyps.get_or_else []),
  sage_out ← sage_output args,
  guard (sage_out = expected_json) <|>
    fail!"Expected output from Sage: {expected_out}\nbut produced: {sage_out}"

/--
A convenience function. Given a working test, prints the code for a call to `test_sage_output`.
-/
meta def tactic.interactive.create_sage_output_test (restr : parse (tk "only")?)
  (hyps : parse pexpr_list?) : tactic unit := do
  let hyps := (hyps.get_or_else []),
  sleep 10, -- otherwise can lead to weird errors when actively editing code with polyrith calls
  (eq_names, m, R, args) ← create_args restr.is_some hyps,
  sage_out ← to_string <$> sage_output args,
  let sage_out := sage_out.fold "" (λ s c, s ++ (if c = '"' then "\\\"" else to_string c)),
  let onl := if restr.is_some then "only " else "",
  let hyps := if hyps = [] then "" else to_string hyps,
  trace!"test_sage_output {onl}{hyps} \"{sage_out}\""

/--
A convenience function. Given a working test, prints the code for a call to `test_polyrith`.
-/
meta def tactic.interactive.create_polyrith_test (restr : parse (tk "only")?)
  (hyps : parse pexpr_list?) : tactic unit := do
  let hyps := (hyps.get_or_else []),
  sleep 10, -- otherwise can lead to weird errors when actively editing code with polyrith calls
  (eq_names, m, R, args) ← create_args restr.is_some hyps,
  sage_out ← sage_output args,
  out ← to_string <$> process_output eq_names m R sage_out,
  let out := out.fold "" (λ s c, s ++ (if c = '"' then "\\\"" else to_string c)),
  let sage_out := (to_string sage_out).fold ""
    (λ s c, s ++ (if c = '"' then "\\\"" else to_string c)),
  let argstring := format_string_list args,
  let onl := if restr.is_some then "only " else "",
  let hyps := if hyps = [] then "" else to_string hyps,
  let trf := format.nest 2 $ format!"test_polyrith {onl}{hyps} \n\"{sage_out}\"\n{argstring}\n\"{out}\"",
  trace!"Try this: {trf}"

end tactic

/-!
## SageCell communcation tests
-/

example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
begin
  test_sage_output "{\"data\":[\"(poly.const 1/1)\",\"(poly.const -2/1)\"],\"success\":true}",
  linear_combination h1 - 2 * h2
end

example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
    (h3 : x + y + 5*z + 5*w = 3) :
  x + 2.2*y + 2*z - 5*w = -8.5 :=
begin
  test_sage_output "{\"data\":[\"(poly.const 2/1)\",\"(poly.const 1/1)\",\"(poly.const -2/1)\"],\"success\":true}",
  linear_combination 2 * h1 + h2 - 2 * h3
end

/-! ### Standard Cases over ℤ, ℚ, and ℝ -/

example (x y : ℤ) (h1 : 3*x + 2*y = 10):
  3*x + 2*y = 10 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
  ["ff",
  "int",
  "2",
  "[(((3 * var0) + (2 * var1)) - 10)]",
  "(((3 * var0) + (2 * var1)) - 10)"]
  "linear_combination h1"

example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/1)\",\"(poly.const -2/1)\"],\"success\":true}"
  ["ff",
  "rat",
  "2",
  "[(((var0 * var1) + (2 * var0)) - 1), (var0 - var1)]",
  "((var0 * var1) - ((-2 * var1) + 1))"]
  "linear_combination h1 - 2 * h2"

example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
by test_polyrith
  "{\"data\":[\"(poly.const 2/1)\",\"(poly.const -1/1)\"],\"success\":true}"
  ["ff",
  "real",
  "2",
  "[((var1 + 2) - -3), (var0 - 10)]",
  "(((-var0 + (2 * var1)) + 4) - -16)"]
  "linear_combination 2 * h1 - h2"

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  -3*x - 3*y - 4*z = 2 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/1)\",\"(poly.const -1/1)\",\"(poly.const -2/1)\"],\"success\":true}"
  ["ff",
  "real",
  "3",
  "[(((var0 + (2 * var1)) - var2) - 4), ((((2 * var0) + var1) + var2) - -2), (((var0 + (2 * var1)) + var2) - 2)]",
  "((((-3 * var0) - (3 * var1)) - (4 * var2)) - 2)"]
  "linear_combination ha - hb - 2 * hc"

example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
    (h3 : x + y + 5*z + 5*w = 3) :
  x + 2.2*y + 2*z - 5*w = -8.5 :=
by test_polyrith
  "{\"data\":[\"(poly.const 2/1)\",\"(poly.const 1/1)\",\"(poly.const -2/1)\"],\"success\":true}"
  ["ff",
  "real",
  "4",
  "[(((var0 + (21/10 * var1)) + (2 * var2)) - 2), (((var0 + (8 * var2)) + (5 * var3)) - -13/2), ((((var0 + var1) + (5 * var2)) + (5 * var3)) - 3)]",
  "((((var0 + (11/5 * var1)) + (2 * var2)) - (5 * var3)) - -17/2)"]
  "linear_combination 2 * h1 + h2 - 2 * h3"

example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
  2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
by test_polyrith
  "{\"data\":[\"(poly.const 2/1)\",\"(poly.const -1/1)\",\"(poly.const 3/1)\",\"(poly.const -3/1)\"],\"success\":true}"
  ["ff",
  "rat",
  "4",
  "[(var0 - 4), (3 - var3), ((var1 * 3) - var2), (-var2 - var0)]",
  "(((((2 * var0) - 3) + (9 * var1)) + (3 * var2)) - (((8 - var3) + (3 * var2)) - (3 * var0)))"]
  "linear_combination 2 * h1 - h2 + 3 * h3 - 3 * h4"

/-! ### Case with ambiguous identifiers-/

example («def evil» y : ℤ) (h1 : 3*«def evil» + 2*y = 10):
  3*«def evil» + 2*y = 10 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
  ["ff",
  "int",
  "2",
  "[(((3 * var0) + (2 * var1)) - 10)]",
  "(((3 * var0) + (2 * var1)) - 10)"]
  "linear_combination h1"

example («¥» y : ℤ) (h1 : 3*«¥» + 2*y = 10):
  «¥» * (3*«¥» + 2*y) = 10 * «¥» :=
by test_polyrith
  "{\"data\":[\"(poly.var 0)\"],\"success\":true}"
  ["ff",
  "int",
  "2",
  "[(((3 * var0) + (2 * var1)) - 10)]",
  "((var0 * ((3 * var0) + (2 * var1))) - (10 * var0))"]
  "linear_combination «¥» * h1"

/-! ### Cases with arbitrary coefficients -/

example (a b : ℤ) (h : a = b) :
  a * a = a * b :=
by test_polyrith
  "{\"data\":[\"(poly.var 0)\"],\"success\":true}"
  ["ff",
  "int",
  "2",
  "[(var0 - var1)]",
  "((var0 * var0) - (var0 * var1))"]
  "linear_combination a * h"

example (a b c : ℤ) (h : a = b) :
  a * c = b * c :=
by test_polyrith
  "{\"data\":[\"(poly.var 1)\"],\"success\":true}"
  ["ff",
  "int",
  "3",
  "[(var0 - var2)]",
  "((var0 * var1) - (var2 * var1))"]
  "linear_combination c * h"

example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
  c * a + b = c * b + 1 :=
by test_polyrith
  "{\"data\":[\"(poly.var 0)\",\"(poly.const 1/1)\"],\"success\":true}"
  ["ff",
  "int",
  "3",
  "[(var1 - var2), (var2 - 1)]",
  "(((var0 * var1) + var2) - ((var0 * var2) + 1))"]
  "linear_combination c * h1 + h2"

example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
by test_polyrith
  "{\"data\":[\"(poly.mul (poly.var 0) (poly.var 1))\",\"(poly.const 2/1)\"],\"success\":true}"
  ["ff",
  "rat",
  "2",
  "[((var0 + var1) - 3), ((3 * var0) - 7)]",
  "(((((var0 * var0) * var1) + ((var1 * var0) * var1)) + (6 * var0)) - (((3 * var0) * var1) + 14))"]
  "linear_combination x * y * h1 + 2 * h2"

example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
by test_polyrith
  "{\"data\":[\"(poly.add (poly.var 0) (poly.mul (poly.const 2/1) (poly.var 2)))\"],\"success\":true}"
  ["ff",
  "rat",
  "4",
  "[(var1 - var3)]",
  "(((var0 * var1) + ((2 * var2) * var1)) - ((var0 * var3) + ((2 * var2) * var3)))"]
  "linear_combination (x + 2 * y) * hzw"

/-! ### Cases with non-hypothesis inputs/input restrictions -/

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
  b = 2 / 3 :=
by test_polyrith only [ha, hab]
  "{\"data\":[\"(poly.const 1/6)\",\"(poly.const 1/3)\"],\"success\":true}"
  ["ff",
  "real",
  "2",
  "[((2 * var1) - 4), ((2 * var0) - (var1 - var0))]",
  "(var0 - 2/3)"]
  "linear_combination ha / 6 + hab / 3"

constant term : ∀ a b : ℚ, a + b = 0

example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
by test_polyrith only [term c d, h]
  "{\"data\":[\"(poly.const 1/1)\",\"(poly.const 1/1)\"],\"success\":true}"
  ["ff",
  "rat",
  "4",
  "[((var2 + var3) - 0), ((var0 + var1) - 0)]",
  "((((var0 + var1) + var2) + var3) - 0)"]
  "linear_combination term c d + h"

constants (qc : ℚ) (hqc : qc = 2*qc)

example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
by test_polyrith [h a b, hqc]
  "{\"data\":[\"(poly.const 3/1)\",\"(poly.const 1/1)\"],\"success\":true}"
  ["ff",
  "rat",
  "3",
  "[(var0 - var2), (var1 - (2 * var1))]",
  "(((3 * var0) + var1) - ((3 * var2) + (2 * var1)))"]
  "linear_combination 3 * h a b + hqc"

constant bad (q : ℚ) : q = 0

example (a b : ℚ) : a + b^3 = 0 :=
by test_polyrith [bad a, bad (b^2)]
  "{\"data\":[\"(poly.const 1/1)\",\"(poly.var 1)\"],\"success\":true}"
  ["ff",
  "rat",
  "2",
  "[(var0 - 0), ((var1 ^ 2) - 0)]",
  "((var0 + (var1 ^ 3)) - 0)"]
  "linear_combination bad a + b * bad (b ^ 2)"

/-! ### Case over arbitrary field/ring -/

example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
  c * (a*f - b*e) = 0 :=
by test_polyrith
  "{\"data\":[\"(poly.var 4)\",\"(poly.var 1)\"],\"success\":true}"
  ["ff",
  "α",
  "6",
  "[((var1 * var5) - (var3 * var0)), ((var0 * var2) - (var4 * var5))]",
  "((var0 * ((var1 * var2) - (var3 * var4))) - 0)"]
  "linear_combination e * h1 + a * h2"

example {K : Type*} [field K] [invertible 2] [invertible 3]
  {ω p q r s t x: K} (hp_nonzero : p ≠ 0) (hr : r ^ 2 = q ^ 2 + p ^ 3) (hs3 : s ^ 3 = q + r)
  (ht : t * s = p) (x : K) (H : 1 + ω + ω ^ 2 = 0) :
  x ^ 3 + 3 * p * x - 2 * q =
    (x - (s - t)) * (x - (s * ω - t * ω ^ 2)) * (x - (s * ω ^ 2 - t * ω)) :=
begin
  have hs_nonzero : s ≠ 0,
  { contrapose! hp_nonzero with hs_nonzero,
    test_polyrith
  "{\"data\":[\"(poly.const 0/1)\",\"(poly.const 0/1)\",\"(poly.const -1/1)\",\"(poly.const 0/1)\",\"(poly.var 4)\"],\"success\":true}"
  ["ff",
  "K",
  "6",
  "[((var1 ^ 2) - ((var2 ^ 2) + (var0 ^ 3))), ((var3 ^ 3) - (var2 + var1)), ((var4 * var3) - var0), (((1 + var5) + (var5 ^ 2)) - 0), (var3 - 0)]",
  "(var0 - 0)"]
  "linear_combination -ht + t * hs_nonzero"},
  have H' : 2 * q = s ^ 3 - t ^ 3,
  { rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero),
    test_polyrith
  "{\"data\":[\"(poly.const -1/1)\",\"(poly.sub (poly.add (poly.neg (poly.pow (poly.var 1) 3)) (poly.var 0)) (poly.var 3))\",\"(poly.add (poly.add (poly.mul (poly.pow (poly.var 1) 2) (poly.pow (poly.var 2) 2)) (poly.mul (poly.mul (poly.var 1) (poly.var 2)) (poly.var 4))) (poly.pow (poly.var 4) 2))\",\"(poly.const 0/1)\"],\"success\":true}"
  ["ff",
  "K",
  "6",
  "[((var3 ^ 2) - ((var0 ^ 2) + (var4 ^ 3))), ((var1 ^ 3) - (var0 + var3)), ((var2 * var1) - var4), (((1 + var5) + (var5 ^ 2)) - 0)]",
  "(((2 * var0) * (var1 ^ 3)) - (((var1 ^ 3) - (var2 ^ 3)) * (var1 ^ 3)))"]
  "linear_combination -hr + (-s ^ 3 + q - r) * hs3 + (s ^ 2 * t ^ 2 + s * t * p + p ^ 2) * ht"},
  test_polyrith
  "{\"data\":[\"(poly.const 0/1)\",\"(poly.const 0/1)\",\"(poly.add (poly.add (poly.sub (poly.add (poly.add (poly.sub (poly.add (poly.sub (poly.mul (poly.var 0) (poly.pow (poly.var 5) 4)) (poly.mul (poly.var 3) (poly.pow (poly.var 5) 4))) (poly.mul (poly.var 4) (poly.pow (poly.var 5) 4))) (poly.mul (poly.var 3) (poly.pow (poly.var 5) 3))) (poly.mul (poly.var 4) (poly.pow (poly.var 5) 3))) (poly.mul (poly.mul (poly.const 3/1) (poly.var 0)) (poly.pow (poly.var 5) 2))) (poly.mul (poly.var 3) (poly.pow (poly.var 5) 2))) (poly.mul (poly.var 4) (poly.pow (poly.var 5) 2))) (poly.mul (poly.mul (poly.const 2/1) (poly.var 0)) (poly.var 5)))\",\"(poly.add (poly.sub (poly.add (poly.sub (poly.sub (poly.add (poly.add (poly.sub (poly.add (poly.sub (poly.sub (poly.add (poly.neg (poly.mul (poly.mul (poly.var 0) (poly.pow (poly.var 3) 2)) (poly.var 5))) (poly.mul (poly.pow (poly.var 3) 3) (poly.var 5))) (poly.mul (poly.mul (poly.var 0) (poly.pow (poly.var 4) 2)) (poly.var 5))) (poly.mul (poly.pow (poly.var 4) 3) (poly.var 5))) (poly.mul (poly.mul (poly.var 0) (poly.var 1)) (poly.pow (poly.var 5) 2))) (poly.mul (poly.mul (poly.var 1) (poly.var 3)) (poly.pow (poly.var 5) 2))) (poly.mul (poly.mul (poly.var 1) (poly.var 4)) (poly.pow (poly.var 5) 2))) (poly.mul (poly.pow (poly.var 0) 2) (poly.var 3))) (poly.pow (poly.var 3) 3)) (poly.mul (poly.pow (poly.var 0) 2) (poly.var 4))) (poly.pow (poly.var 4) 3)) (poly.mul (poly.mul (poly.var 0) (poly.var 1)) (poly.var 5))) (poly.mul (poly.mul (poly.const 3/1) (poly.var 0)) (poly.var 1)))\",\"(poly.const -1/1)\"],\"success\":true}"
  ["ff",
  "K",
  "7",
  "[((var6 ^ 2) - ((var2 ^ 2) + (var1 ^ 3))), ((var3 ^ 3) - (var2 + var6)), ((var4 * var3) - var1), (((1 + var5) + (var5 ^ 2)) - 0), ((2 * var2) - ((var3 ^ 3) - (var4 ^ 3)))]",
  "((((var0 ^ 3) + ((3 * var1) * var0)) - (2 * var2)) - (((var0 - (var3 - var4)) * (var0 - ((var3 * var5) - (var4 * (var5 ^ 2))))) * (var0 - ((var3 * (var5 ^ 2)) - (var4 * var5)))))"]
  "linear_combination (x * ω ^ 4 - s * ω ^ 4 + t * ω ^ 4 - s * ω ^ 3 + t * ω ^ 3 + 3 * x * ω ^ 2 - s * ω ^ 2 +
      t * ω ^ 2 +
    2 * x * ω) * ht + (-(x * s ^ 2 * ω) + s ^ 3 * ω - x * t ^ 2 * ω - t ^ 3 * ω + x * p * ω ^ 2 - p * s * ω ^ 2 +
                p * t * ω ^ 2 +
              x ^ 2 * s -
            s ^ 3 -
          x ^ 2 * t +
        t ^ 3 -
      x * p * ω +
    3 * x * p) * H - H'"
end

/-! ## Degenerate cases -/

example {K : Type*} [field K] [char_zero K] {s : K} (hs : 3 * s + 1 = 4) : s = 1 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/3)\"],\"success\":true}"
  ["ff",
  "K",
  "1",
  "[(((3 * var0) + 1) - 4)]",
  "(var0 - 1)"]
  "linear_combination hs / 3"

example {x : ℤ} (h1 : x + 4 = 2) : x = -2 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
  ["ff",
  "int",
  "1",
  "[((var0 + 4) - 2)]",
  "(var0 - -2)"]
  "linear_combination h1"

example {w : ℚ} (h1 : 3 * w + 1 = 4) : w = 1 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/3)\"],\"success\":true}"
  ["ff",
  "rat",
  "1",
  "[(((3 * var0) + 1) - 4)]",
  "(var0 - 1)"]
  "linear_combination h1 / 3"

example {x : ℤ} (h1 : 2 * x + 3 = x) : x = -3 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
  ["ff",
  "int",
  "1",
  "[(((2 * var0) + 3) - var0)]",
  "(var0 - -3)"]
  "linear_combination h1"

example {c : ℚ} (h1 : 4 * c + 1 = 3 * c - 2) : c = -3 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
  ["ff",
  "rat",
  "1",
  "[(((4 * var0) + 1) - ((3 * var0) - 2))]",
  "(var0 - -3)"]
  "linear_combination h1"

example (z : ℤ) (h1 : z + 1 = 2) (h2 : z + 2 = 2) : (1 : ℤ) = 2 :=
by test_polyrith
  "{\"data\":[\"(poly.const 1/1)\",\"(poly.const -1/1)\"],\"success\":true}"
  ["ff",
  "int",
  "1",
  "[((var0 + 1) - 2), ((var0 + 2) - 2)]",
  "(1 - 2)"]
  "linear_combination h1 - h2"

-- We comment the following tests so that we don't overwhelm the SageCell API.

/-

/-! ### Standard Cases over ℤ, ℚ, and ℝ -/

example (x y : ℤ) (h1 : 3*x + 2*y = 10):
  3*x + 2*y = 10 :=
by polyrith

example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by polyrith

example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
by polyrith

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  -3*x - 3*y - 4*z = 2 :=
by polyrith

example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
    (h3 : x + y + 5*z + 5*w = 3) :
  x + 2.2*y + 2*z - 5*w = -8.5 :=
by polyrith

example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
  2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
by polyrith

/-! ### Case with ambiguous identifiers-/

example («def evil» y : ℤ) (h1 : 3*«def evil» + 2*y = 10):
  3*«def evil» + 2*y = 10 :=
by polyrith

example («¥» y : ℤ) (h1 : 3*«¥» + 2*y = 10):
  «¥» * (3*«¥» + 2*y) = 10 * «¥» :=
by polyrith

/-! ### Cases with arbitrary coefficients -/

example (a b : ℤ) (h : a = b) :
  a * a = a * b :=
by polyrith

example (a b c : ℤ) (h : a = b) :
  a * c = b * c :=
by polyrith

example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
  c * a + b = c * b + 1 :=
by polyrith

example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
by polyrith

example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
by polyrith

/-! ### Cases with non-hypothesis inputs/input restrictions -/

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
  b = 2 / 3 :=
by polyrith only [ha, hab]

-- constant term : ∀ a b : ℚ, a + b = 0

example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
by polyrith only [term c d, h]

-- constants (qc : ℚ) (hqc : qc = 2*qc)

example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
by polyrith [h a b, hqc]

-- constant bad (q : ℚ) : q = 0

example (a b : ℚ) : a + b^3 = 0 :=
by polyrith [bad a, bad (b^2)]

/-! ### Case over arbitrary field/ring -/

example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
  c * (a*f - b*e) = 0 :=
by polyrith

example {K : Type*} [field K] [invertible 2] [invertible 3]
  {ω p q r s t x: K} (hp_nonzero : p ≠ 0) (hr : r ^ 2 = q ^ 2 + p ^ 3) (hs3 : s ^ 3 = q + r)
  (ht : t * s = p) (x : K) (H : 1 + ω + ω ^ 2 = 0) :
  x ^ 3 + 3 * p * x - 2 * q =
    (x - (s - t)) * (x - (s * ω - t * ω ^ 2)) * (x - (s * ω ^ 2 - t * ω)) :=
begin
  have hs_nonzero : s ≠ 0,
  { contrapose! hp_nonzero with hs_nonzero,
    polyrith,
     },
  have H' : 2 * q = s ^ 3 - t ^ 3,
  { rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero),
    polyrith,},
  polyrith,
end

/-!
### With trace enabled
Here, the tactic will trace the command that gets sent to sage,
and so the tactic will not prove the goal. `linear_combination`
is called manually to prevent errors.
-/

set_option trace.polyrith true

example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
begin
  polyrith,
  linear_combination 2 * h1 - h2,
end

example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
  c * a + b = c * b + 1 :=
begin
  polyrith,
  linear_combination c * h1 + h2,
end

example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
begin
  polyrith only [term c d, h],
  linear_combination term c d + h,
end

example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
begin
  polyrith [h a b, hqc],
  linear_combination 3 * h a b + hqc,
end
-/

-- the following can be uncommented to regenerate the tests above.

/-

/-! ### Standard Cases over ℤ, ℚ, and ℝ -/

example (x y : ℤ) (h1 : 3*x + 2*y = 10):
  3*x + 2*y = 10 :=
by create_polyrith_test

example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by create_polyrith_test

example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
by create_polyrith_test

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  -3*x - 3*y - 4*z = 2 :=
by create_polyrith_test

example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
    (h3 : x + y + 5*z + 5*w = 3) :
  x + 2.2*y + 2*z - 5*w = -8.5 :=
by create_polyrith_test

example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
  2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
by create_polyrith_test

/-! ### Case with ambiguous identifiers-/

example («def evil» y : ℤ) (h1 : 3*«def evil» + 2*y = 10):
  3*«def evil» + 2*y = 10 :=
by create_polyrith_test

example («¥» y : ℤ) (h1 : 3*«¥» + 2*y = 10):
  «¥» * (3*«¥» + 2*y) = 10 * «¥» :=
by create_polyrith_test

/-! ### Cases with arbitrary coefficients -/

example (a b : ℤ) (h : a = b) :
  a * a = a * b :=
by create_polyrith_test

example (a b c : ℤ) (h : a = b) :
  a * c = b * c :=
by create_polyrith_test

example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
  c * a + b = c * b + 1 :=
by create_polyrith_test

example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
by create_polyrith_test

example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
by create_polyrith_test

/-! ### Cases with non-hypothesis inputs/input restrictions -/

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
  b = 2 / 3 :=
by create_polyrith_test only [ha, hab]

constant term : ∀ a b : ℚ, a + b = 0

example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
by create_polyrith_test only [term c d, h]

constants (qc : ℚ) (hqc : qc = 2*qc)

example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
by create_polyrith_test [h a b, hqc]

constant bad (q : ℚ) : q = 0

example (a b : ℚ) : a + b^3 = 0 :=
by create_polyrith_test [bad a, bad (b^2)]

/-! ### Case over arbitrary field/ring -/

example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
  c * (a*f - b*e) = 0 :=
by create_polyrith_test

example {K : Type*} [field K] [invertible 2] [invertible 3]
  {ω p q r s t x: K} (hp_nonzero : p ≠ 0) (hr : r ^ 2 = q ^ 2 + p ^ 3) (hs3 : s ^ 3 = q + r)
  (ht : t * s = p) (x : K) (H : 1 + ω + ω ^ 2 = 0) :
  x ^ 3 + 3 * p * x - 2 * q =
    (x - (s - t)) * (x - (s * ω - t * ω ^ 2)) * (x - (s * ω ^ 2 - t * ω)) :=
begin
  have hs_nonzero : s ≠ 0,
  { contrapose! hp_nonzero with hs_nonzero,
    create_polyrith_test },
  have H' : 2 * q = s ^ 3 - t ^ 3,
  { rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero),
    create_polyrith_test },
  create_polyrith_test
end

/-! ## Degenerate cases -/

example {K : Type*} [field K] [char_zero K] {s : K} (hs : 3 * s + 1 = 4) : s = 1 :=
by create_polyrith_test

example {x : ℤ} (h1 : x + 4 = 2) : x = -2 :=
by create_polyrith_test

example {w : ℚ} (h1 : 3 * w + 1 = 4) : w = 1 :=
by create_polyrith_test

example {x : ℤ} (h1 : 2 * x + 3 = x) : x = -3 :=
by create_polyrith_test

example {c : ℚ} (h1 : 4 * c + 1 = 3 * c - 2) : c = -3 :=
by create_polyrith_test

example (z : ℤ) (h1 : z + 1 = 2) (h2 : z + 2 = 2) : (1 : ℤ) = 2 :=
by create_polyrith_test

-/


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.oracle_spec

/-!
# Oracle Query Log

This file efines a simple definition of a log for queries based on continuations.
This definition is chosen over a list of sigma types to give simple type equalities.
-/

/-- Data type representing a log of oracle queries for a given `oracle_spec`.
  Represented as a list of query inputs and outputs, indexed by the indexing set in the spec -/
def query_log (spec : oracle_spec) : Type :=
Π (i : spec.ι), list (spec.domain i × spec.range i)

namespace query_log

open oracle_spec

variables {spec : oracle_spec} (log : query_log spec)
  (i j : spec.ι) (t : spec.domain i) (u : spec.range i)

@[ext] lemma ext {spec : oracle_spec} {log log' : query_log spec}
  (h : ∀ (i : spec.ι), log i = log' i) : log = log' := funext h

section init

/-- Empty query log, with no entries for any of the oracles in the spec -/
@[inline, reducible]
def init (spec : oracle_spec) : query_log spec := λ i, []

@[simp] lemma init_apply : init spec i = [] := rfl

lemma not_mem_init : (t, u) ∉ (init spec i) := list.not_mem_nil (t, u)

lemma mem_init_iff_false : (t, u) ∈ (init spec i) ↔ false :=
by simp only [iff_false, not_mem_init, not_false_iff]

end init

section log_query

/-- Given a current query log, return the new log after adding a given oracle query -/
def log_query (i : spec.ι) (t : spec.domain i) (u : spec.range i) : query_log spec :=
λ j, if hi : i = j then hi.rec_on ((t, u) :: (log i)) else log j

@[simp] lemma log_query_apply (i j : spec.ι) (t : spec.domain i) (u : spec.range i) :
  (log.log_query i t u) j = if hi : i = j then hi.rec_on ((t, u) :: log i) else log j := rfl

lemma log_query_apply_of_index_eq {i j : spec.ι} (hi : i = j) (t : spec.domain i)
  (u : spec.range i) : (log.log_query i t u) j = hi.rec_on ((t, u) :: log i) :=
dite_eq_iff.2 (or.inl ⟨hi, rfl⟩)

@[simp] lemma log_query_apply_same_index (i : spec.ι) (t : spec.domain i) (u : spec.range i) :
  (log.log_query i t u) i = (t, u) :: (log i) := log_query_apply_of_index_eq log rfl t u

lemma log_query_apply_of_index_ne {i j : spec.ι} (hi : i ≠ j) (t : spec.domain i)
  (u : spec.range i) : (log.log_query i t u) j = log j := dite_eq_iff.2 (or.inr ⟨hi, rfl⟩)

lemma nodup_log_query_apply_iff (i : spec.ι) (t : spec.domain i) (u : spec.range i) (j : spec.ι)
  (hj : (log j).nodup) : (log.log_query i t u j).nodup ↔ i ≠ j ∨ (t, u) ∉ log i :=
begin
  by_cases hi : i = j,
  { induction hi,
    simp only [log_query_apply_same_index, list.nodup_cons, hj, and_true, ne.def,
      eq_self_iff_true, not_true, false_or] },
  { simp only [log.log_query_apply_of_index_ne hi, hj, hi, ne.def, not_false_iff, true_or] }
end

lemma length_log_query_apply (i : spec.ι) (t : spec.domain i) (u : spec.range i) (j : spec.ι) :
  (log.log_query i t u j).length = (log j).length + ite (i = j) 1 0 :=
begin
  rw [log_query_apply],
  split_ifs with h,
  { obtain rfl := h, exact rfl },
  { exact symm (add_zero _) },
end

lemma length_log_query_apply_of_index_eq {i : spec.ι} (t : spec.domain i) (u : spec.range i)
  {j : spec.ι} (h : i = j) : (log.log_query i t u j).length = (log j).length + 1 :=
by {induction h, simp only [list.length, log_query_apply_same_index] }

lemma length_log_query_apply_same_index (i : spec.ι) (t : spec.domain i) (u : spec.range i) :
  (log.log_query i t u i).length = (log i).length + 1 :=
by simp only [list.length, log_query_apply_same_index]

lemma length_log_query_apply_of_index_ne {i : spec.ι} (t : spec.domain i) (u : spec.range i)
  {j : spec.ι} (h : i ≠ j) : (log.log_query i t u j).length = (log j).length :=
by rw [log_query_apply_of_index_ne log h]

lemma length_apply_le_lenght_log_query_apply (i : spec.ι) (t : spec.domain i) (u : spec.range i)
  (j : spec.ι) : (log j).length ≤ (log.log_query i t u j).length :=
begin
  by_cases hij : i = j,
  { induction hij,
    simp only [list.length, log_query_apply_same_index, le_add_iff_nonneg_right, zero_le'] },
  { rw [length_log_query_apply_of_index_ne log t u hij] }
end

end log_query

section not_queried

/- Returns whether a specific input has been previously logged. -/
def not_queried (i : spec.ι) (t : spec.domain i) : Prop :=
((log i).find ((=) t ∘ prod.fst)) = none

lemma not_queried_def (i : spec.ι) (t : spec.domain i) :
  log.not_queried i t ↔ (((log i).find ((=) t ∘ prod.fst)) = none) := iff.rfl

instance not_queried.decidable (i : spec.ι) (t : spec.domain i) : decidable (log.not_queried i t) :=
option.decidable_eq ((log i).find ((=) t ∘ prod.fst)) none

/-- An input hasn't been queried iff it isn't in the log for any possible output -/
lemma not_queried_iff_not_mem (i : spec.ι) (t : spec.domain i) :
  log.not_queried i t ↔ ∀ (u : spec.range i), (t, u) ∉ log i :=
begin
  rw [not_queried_def, list.find_eq_none],
  refine ⟨λ h u htu, h (t, u) htu rfl, λ h x hx hx', h x.2 (hx'.symm ▸ _)⟩,
  rwa [prod.mk.eta],
end

lemma not_queried_init (i : spec.ι) (t : spec.domain i) : (init spec).not_queried i t :=
begin
  rw [not_queried_def, list.find_eq_none],
  refine λ x hx _, (not_mem_init i x.1 x.2 hx),
end

lemma not_queried_log_query (i j : spec.ι) (t : spec.domain i) (t' : spec.domain j)
  (u : spec.range i) : (log.log_query i t u).not_queried j t' ↔
    (log.not_queried j t') ∧ (if hi : i = j then (hi.rec_on t ≠ t') else true) :=
begin
  split_ifs with hi,
  { induction hi,
    rw [not_queried, log_query_apply_same_index],
    by_cases ht : t' = t,
    { induction ht,
      have : (eq t' ∘ prod.fst) (t', u) := (function.comp_app (eq t') prod.fst (t', u)).symm ▸ rfl,
      simp only [list.find_cons_of_pos _ this, ne.def, eq_self_iff_true, not_true, and_false] },
    { have : ¬ (eq t' ∘ prod.fst) (t, u) := ht,
      simp only [list.find_cons_of_neg _ this, list.find_eq_none, not_queried_iff_not_mem,
        ne.def, ne.symm ht, not_false_iff, and_true, function.comp_app, prod.forall],
      exact ⟨λ h u hu, h t' u hu rfl, λ h t'' u' htu' ht', h u' $ ht'.symm ▸ htu'⟩ } },
  { simp only [not_queried, log_query_apply_of_index_ne log hi, and_true] }
end

lemma not_queried_log_query_of_index_eq {i j : spec.ι} (hi : i = j)
  (t : spec.domain i) (t' : spec.domain j) (u : spec.range i) :
  (log.log_query i t u).not_queried j t' ↔ (log.not_queried j t') ∧ (hi.rec_on t ≠ t') :=
(log.not_queried_log_query i j t t' u).trans (by rw [dif_pos hi])

lemma not_queried_log_query_same_index (i : spec.ι)
  (t t' : spec.domain i) (u : spec.range i) :
  (log.log_query i t u).not_queried i t' ↔ (log.not_queried i t') ∧ (t ≠ t') :=
log.not_queried_log_query_of_index_eq rfl t t' u

lemma not_queried_log_query_of_index_ne {i j : spec.ι} (hi : i ≠ j)
  (t : spec.domain i) (t' : spec.domain j) (u : spec.range i) :
  (log.log_query i t u).not_queried j t' ↔ log.not_queried j t' :=
(log.not_queried_log_query i j t t' u).trans (by rw [dif_neg hi, and_true])

end not_queried

section map_at_index

/-- Apply a mapping function to the log corresponding to a particular index
  TODO: I think a lot of the above functions can use this as a helper -/
def map_at_index (i : spec.ι)
  (f : list (spec.domain i × spec.range i) → list (spec.domain i × spec.range i)) :
  query_log spec :=
λ j, if hi : i = j then hi.rec_on (f $ log i) else (log j)

variables (f : list (spec.domain i × spec.range i) → list (spec.domain i × spec.range i))

@[simp]
lemma map_at_index_apply : log.map_at_index i f j =
  if hi : i = j then hi.rec_on (f $ log i) else log j := rfl

lemma map_at_index_apply_of_index_eq (h : i = j) : log.map_at_index i f j = h.rec_on (f $ log i) :=
by simp only [h, map_at_index_apply, dif_pos]

lemma map_at_index_apply_same_index : log.map_at_index i f i = f (log i) :=
by simp only [map_at_index_apply, eq_self_iff_true, dite_eq_ite, if_true]

lemma map_at_index_apply_of_index_ne (h : i ≠ j) : log.map_at_index i f j = log j :=
by simp only [h, not_false_iff, map_at_index_apply, dif_neg]

@[simp]
lemma map_at_index_init_of_nil_nil (hf : f [] = []) :
  (init spec).map_at_index i f = init spec :=
begin
  refine ext (λ i, _),
  simp only [hf, map_at_index_apply, init_apply, dite_eq_right_iff],
  exact (λ h, by {induction h, refl})
end

@[simp]
lemma map_at_index_log_query_of_ne (h : i ≠ j) (t : spec.domain j) (u : spec.range j) :
  (log.log_query j t u).map_at_index i f = (log.map_at_index i f).log_query j t u :=
begin
  refine ext (λ k, _),
  by_cases hi : i = k,
  { rw [map_at_index_apply_of_index_eq _ i k f hi],
    by_cases hj : j = k,
    { exact false.elim (h $ hi.trans hj.symm) },
    { rw [log_query_apply_of_index_ne _ hj t u, log_query_apply_of_index_ne _ h.symm t u,
        map_at_index_apply_of_index_eq log _ _ f hi] } },
  { rw [map_at_index_apply_of_index_ne _ i k f hi],
    by_cases hj : j = k,
    { rw [log_query_apply_of_index_eq log hj t u, log_query_apply_of_index_eq _ hj t u,
        map_at_index_apply_of_index_ne log i j f h] },
    { rw [log_query_apply_of_index_ne log hj t u, log_query_apply_of_index_ne _ hj t u,
        map_at_index_apply_of_index_ne _ i k f hi] } }
end

end map_at_index

section drop_at_index

/-- Drop the given number of elements from the given log at the specified index. -/
def drop_at_index (log : query_log spec) (i : spec.ι) (n : ℕ) : query_log spec :=
log.map_at_index i (list.drop n)

variables (n : ℕ)

@[simp]
lemma drop_at_index_apply (i j : spec.ι) :
  (log.drop_at_index i n) j = if i = j then (log j).drop n else log j :=
begin
  simp only [drop_at_index, map_at_index_apply],
  split_ifs,
  { induction h,
    exact rfl },
  { exact rfl }
end

lemma drop_at_index_apply_of_index_eq {i j : spec.ι} (h : i = j) :
  (log.drop_at_index i n) j = (log j).drop n :=
by simp only [h, drop_at_index_apply, eq_self_iff_true, if_true]

@[simp]
lemma drop_at_index_apply_same_index (i : spec.ι) :
  (log.drop_at_index i n) i = (log i).drop n :=
drop_at_index_apply_of_index_eq log n rfl

lemma drop_at_index_apply_of_index_ne {i j : spec.ι} (h : i ≠ j) :
  (log.drop_at_index i n) j = log j :=
by simp only [h, drop_at_index_apply, if_false]

@[simp]
lemma drop_at_index_zero (i : spec.ι) :
  log.drop_at_index i 0 = log :=
ext (λ j, by simp only [list.drop, drop_at_index_apply, if_t_t])

@[simp]
lemma drop_at_index_init (i : spec.ι) :
  (init spec).drop_at_index i n = init spec :=
map_at_index_init_of_nil_nil i (list.drop n) (list.drop_nil n)

@[simp]
lemma drop_at_index_succ_log_query (i j : spec.ι) (t : spec.domain i) (u : spec.range i) :
  (log.log_query i t u).drop_at_index j (n + 1) =
    if i = j then log.drop_at_index j n
      else (log.drop_at_index j (n + 1)).log_query i t u :=
begin
  split_ifs,
  { refine ext (λ k, _),
    by_cases hj : j = k,
    { induction h, induction hj,
      simp only [list.drop, drop_at_index_apply_same_index, log_query_apply_same_index] },
    { rw [drop_at_index_apply_of_index_ne _ (n + 1) hj,
        log_query_apply_of_index_ne log (ne_of_eq_of_ne h hj),
        drop_at_index_apply_of_index_ne _ n hj] } },
  { exact map_at_index_log_query_of_ne log j i _ (ne.symm h) t u }
end

end drop_at_index

section remove_head

/-- remove the head of the index `i` log -/
def remove_head (log : query_log spec) (i : spec.ι) :
  query_log spec :=
λ j, if i = j then (log j).tail else (log j)

@[simp]
lemma remove_head_apply (i j : spec.ι) :
  log.remove_head i j = if i = j then (log j).tail else (log j) :=
rfl

lemma remove_head_apply_of_index_eq {i j : spec.ι} (hi : i = j) :
  log.remove_head i j = (log j).tail :=
if_pos hi

@[simp]
lemma remove_head_apply_same_index (i : spec.ι) :
  log.remove_head i i = (log i).tail :=
log.remove_head_apply_of_index_eq rfl

lemma remove_head_apply_of_index_ne {i j : spec.ι} (hi : i ≠ j) :
  log.remove_head i j = log j :=
if_neg hi

@[simp]
lemma remove_head_init (i : spec.ι) : (init spec).remove_head i = init spec :=
ext (λ i', if_t_t (i = i') [])

lemma remove_head_log_query (i j : spec.ι)
  (t : spec.domain i) (u : spec.range i) :
  (log.log_query i t u).remove_head j =
    if hi : i = j then log else (log.remove_head j).log_query i t u :=
begin
  split_ifs with hi,
  { induction hi,
    refine (ext $ λ k, trans (remove_head_apply _ i k) _),
    split_ifs with hk,
    { induction hk,
      rw [log_query_apply_same_index log, list.tail_cons] },
    { exact log_query_apply_of_index_ne log hk t u } },
  { refine (ext $ λ k, _),
    simp only [remove_head_apply],
    split_ifs with hj,
    { induction hj,
      simp only [log_query_apply_of_index_ne _ hi, remove_head_apply_same_index] },
    { simp only [log_query_apply, remove_head_apply_of_index_ne _ hj,
        remove_head_apply_of_index_ne _ (ne.symm hi)] } }
end

lemma remove_head_log_query_of_index_eq {i j : spec.ι} (hi : i = j)
  (t : spec.domain i) (u : spec.range i) :
  (log.log_query i t u).remove_head j = log :=
trans (log.remove_head_log_query i j t u) (if_pos hi)

@[simp]
lemma remove_head_log_query_of_same_index (i : spec.ι)
  (t : spec.domain i) (u : spec.range i) :
  (log.log_query i t u).remove_head i = log :=
log.remove_head_log_query_of_index_eq rfl t u

lemma remove_head_log_query_of_index_ne {i j : spec.ι} (hi : i ≠ j)
  (t : spec.domain i) (u : spec.range i) :
  (log.log_query i t u).remove_head j = (log.remove_head j).log_query i t u :=
trans (log.remove_head_log_query i j t u) (if_neg hi)

end remove_head

end query_log


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yury G. Kudryashov
-/
import logic.function.basic
import tactic.basic

/-!
# Disjoint union of types

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

This file proves basic results about the sum type `α ⊕ β`.

`α ⊕ β` is the type made of a copy of `α` and a copy of `β`. It is also called *disjoint union*.

## Main declarations

* `sum.get_left`: Retrieves the left content of `x : α ⊕ β` or returns `none` if it's coming from
  the right.
* `sum.get_right`: Retrieves the right content of `x : α ⊕ β` or returns `none` if it's coming from
  the left.
* `sum.is_left`: Returns whether `x : α ⊕ β` comes from the left component or not.
* `sum.is_right`: Returns whether `x : α ⊕ β` comes from the right component or not.
* `sum.map`: Maps `α ⊕ β` to `γ ⊕ δ` component-wise.
* `sum.elim`: Nondependent eliminator/induction principle for `α ⊕ β`.
* `sum.swap`: Maps `α ⊕ β` to `β ⊕ α` by swapping components.
* `sum.lex`: Lexicographic order on `α ⊕ β` induced by a relation on `α` and a relation on `β`.

## Notes

The definition of `sum` takes values in `Type*`. This effectively forbids `Prop`- valued sum types.
To this effect, we have `psum`, which takes value in `Sort*` and carries a more complicated
universe signature in consequence. The `Prop` version is `or`.
-/

universes u v w x
variables {α : Type u} {α' : Type w} {β : Type v} {β' : Type x} {γ δ : Type*}

namespace sum

attribute [derive decidable_eq] sum

@[simp] lemma «forall» {p : α ⊕ β → Prop} : (∀ x, p x) ↔ (∀ a, p (inl a)) ∧ ∀ b, p (inr b) :=
⟨λ h, ⟨λ a, h _, λ b, h _⟩, λ ⟨h₁, h₂⟩, sum.rec h₁ h₂⟩

@[simp] lemma «exists» {p : α ⊕ β → Prop} : (∃ x, p x) ↔ (∃ a, p (inl a)) ∨ ∃ b, p (inr b) :=
⟨λ h, match h with
| ⟨inl a, h⟩ := or.inl ⟨a, h⟩
| ⟨inr b, h⟩ := or.inr ⟨b, h⟩
end, λ h, match h with
| or.inl ⟨a, h⟩ := ⟨inl a, h⟩
| or.inr ⟨b, h⟩ := ⟨inr b, h⟩
end⟩

lemma inl_injective : function.injective (inl : α → α ⊕ β) := λ x y, inl.inj
lemma inr_injective : function.injective (inr : β → α ⊕ β) := λ x y, inr.inj

section get

/-- Check if a sum is `inl` and if so, retrieve its contents. -/
@[simp] def get_left : α ⊕ β → option α
| (inl a) := some a
| (inr _) := none

/-- Check if a sum is `inr` and if so, retrieve its contents. -/
@[simp] def get_right : α ⊕ β → option β
| (inr b) := some b
| (inl _) := none

/-- Check if a sum is `inl`. -/
@[simp] def is_left : α ⊕ β → bool
| (inl _) := tt
| (inr _) := ff

/-- Check if a sum is `inr`. -/
@[simp] def is_right : α ⊕ β → bool
| (inl _) := ff
| (inr _) := tt

variables {x y : α ⊕ β}

@[simp] lemma get_left_eq_none_iff : x.get_left = none ↔ x.is_right :=
by cases x; simp only [get_left, is_right, coe_sort_tt, coe_sort_ff, eq_self_iff_true]

@[simp] lemma get_right_eq_none_iff : x.get_right = none ↔ x.is_left :=
by cases x; simp only [get_right, is_left, coe_sort_tt, coe_sort_ff, eq_self_iff_true]

@[simp] lemma get_left_eq_some_iff {a} : x.get_left = some a ↔ x = inl a :=
by cases x; simp only [get_left]

@[simp] lemma get_right_eq_some_iff {b} : x.get_right = some b ↔ x = inr b :=
by cases x; simp only [get_right]

@[simp] lemma bnot_is_left (x : α ⊕ β) : bnot x.is_left = x.is_right := by cases x; refl
@[simp] lemma is_left_eq_ff : x.is_left = ff ↔ x.is_right := by cases x; simp
lemma not_is_left : ¬x.is_left ↔ x.is_right := by simp
@[simp] lemma bnot_is_right (x : α ⊕ β) : bnot x.is_right = x.is_left := by cases x; refl
@[simp] lemma is_right_eq_ff : x.is_right = ff ↔ x.is_left := by cases x; simp
lemma not_is_right : ¬x.is_right ↔ x.is_left := by simp

lemma is_left_iff : x.is_left ↔ ∃ y, x = sum.inl y := by cases x; simp
lemma is_right_iff : x.is_right ↔ ∃ y, x = sum.inr y := by cases x; simp

end get

theorem inl.inj_iff {a b} : (inl a : α ⊕ β) = inl b ↔ a = b :=
⟨inl.inj, congr_arg _⟩

theorem inr.inj_iff {a b} : (inr a : α ⊕ β) = inr b ↔ a = b :=
⟨inr.inj, congr_arg _⟩

theorem inl_ne_inr {a : α} {b : β} : inl a ≠ inr b.

theorem inr_ne_inl {a : α} {b : β} : inr b ≠ inl a.

/-- Define a function on `α ⊕ β` by giving separate definitions on `α` and `β`. -/
protected def elim {α β γ : Sort*} (f : α → γ) (g : β → γ) : α ⊕ β → γ := λ x, sum.rec_on x f g

@[simp] lemma elim_inl {α β γ : Sort*} (f : α → γ) (g : β → γ) (x : α) :
  sum.elim f g (inl x) = f x := rfl

@[simp] lemma elim_inr {α β γ : Sort*} (f : α → γ) (g : β → γ) (x : β) :
  sum.elim f g (inr x) = g x := rfl

@[simp] lemma elim_comp_inl {α β γ : Sort*} (f : α → γ) (g : β → γ) :
  sum.elim f g ∘ inl = f := rfl

@[simp] lemma elim_comp_inr {α β γ : Sort*} (f : α → γ) (g : β → γ) :
  sum.elim f g ∘ inr = g := rfl

@[simp] lemma elim_inl_inr {α β : Sort*} :
  @sum.elim α β _ inl inr = id :=
funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)

lemma comp_elim {α β γ δ : Sort*} (f : γ → δ) (g : α → γ) (h : β → γ):
  f ∘ sum.elim g h = sum.elim (f ∘ g) (f ∘ h) :=
funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)

@[simp] lemma elim_comp_inl_inr {α β γ : Sort*} (f : α ⊕ β → γ) :
  sum.elim (f ∘ inl) (f ∘ inr) = f :=
funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)

/-- Map `α ⊕ β` to `α' ⊕ β'` sending `α` to `α'` and `β` to `β'`. -/
protected def map (f : α → α') (g : β → β') : α ⊕ β → α' ⊕ β' :=
sum.elim (inl ∘ f) (inr ∘ g)

@[simp] lemma map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl
@[simp] lemma map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl

@[simp] lemma map_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
  ∀ x : α ⊕ β, (x.map f g).map f' g' = x.map (f' ∘ f) (g' ∘ g)
| (inl a) := rfl
| (inr b) := rfl

@[simp] lemma map_comp_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
  (sum.map f' g') ∘ (sum.map f g) = sum.map (f' ∘ f) (g' ∘ g) :=
funext $ map_map f' g' f g

@[simp] lemma map_id_id (α β) : sum.map (@id α) (@id β) = id :=
funext $ λ x, sum.rec_on x (λ _, rfl) (λ _, rfl)

lemma elim_map {α β γ δ ε : Sort*} {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} {x} :
  sum.elim f₂ g₂ (sum.map f₁ g₁ x) = sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) x :=
by cases x; refl

lemma elim_comp_map {α β γ δ ε : Sort*} {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} :
  sum.elim f₂ g₂ ∘ sum.map f₁ g₁ = sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) :=
funext $ λ _, elim_map

@[simp] lemma is_left_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
  is_left (x.map f g) = is_left x :=
by cases x; refl

@[simp] lemma is_right_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
  is_right (x.map f g) = is_right x :=
by cases x; refl

@[simp] lemma get_left_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
  (x.map f g).get_left = x.get_left.map f :=
by cases x; refl

@[simp] lemma get_right_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
  (x.map f g).get_right = x.get_right.map g :=
by cases x; refl

open function (update update_eq_iff update_comp_eq_of_injective update_comp_eq_of_forall_ne)

@[simp] lemma update_elim_inl [decidable_eq α] [decidable_eq (α ⊕ β)] {f : α → γ} {g : β → γ}
  {i : α} {x : γ} :
  update (sum.elim f g) (inl i) x = sum.elim (update f i x) g :=
update_eq_iff.2 ⟨by simp, by simp { contextual := tt }⟩

@[simp] lemma update_elim_inr [decidable_eq β] [decidable_eq (α ⊕ β)] {f : α → γ} {g : β → γ}
  {i : β} {x : γ} :
  update (sum.elim f g) (inr i) x = sum.elim f (update g i x) :=
update_eq_iff.2 ⟨by simp, by simp { contextual := tt }⟩

@[simp] lemma update_inl_comp_inl [decidable_eq α] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : α}
  {x : γ} :
  update f (inl i) x ∘ inl = update (f ∘ inl) i x :=
update_comp_eq_of_injective _ inl_injective _ _

@[simp] lemma update_inl_apply_inl [decidable_eq α] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ}
  {i j : α} {x : γ} :
  update f (inl i) x (inl j) = update (f ∘ inl) i x j :=
by rw ← update_inl_comp_inl

@[simp] lemma update_inl_comp_inr [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : α} {x : γ} :
  update f (inl i) x ∘ inr = f ∘ inr :=
update_comp_eq_of_forall_ne _ _ $ λ _, inr_ne_inl

@[simp] lemma update_inl_apply_inr [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : α} {j : β} {x : γ} :
  update f (inl i) x (inr j) = f (inr j) :=
function.update_noteq inr_ne_inl _ _

@[simp] lemma update_inr_comp_inl [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : β} {x : γ} :
  update f (inr i) x ∘ inl = f ∘ inl :=
update_comp_eq_of_forall_ne _ _ $ λ _, inl_ne_inr

@[simp]

@[simp] lemma update_inr_comp_inr [decidable_eq β] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ} {i : β}
  {x : γ} :
  update f (inr i) x ∘ inr = update (f ∘ inr) i x :=
update_comp_eq_of_injective _ inr_injective _ _

@[simp] lemma update_inr_apply_inr [decidable_eq β] [decidable_eq (α ⊕ β)] {f : α ⊕ β → γ}
  {i j : β} {x : γ} :
  update f (inr i) x (inr j) = update (f ∘ inr) i x j :=
by rw ← update_inr_comp_inr

/-- Swap the factors of a sum type -/
def swap : α ⊕ β → β ⊕ α := sum.elim inr inl

@[simp] lemma swap_inl (x : α) : swap (inl x : α ⊕ β) = inr x := rfl
@[simp] lemma swap_inr (x : β) : swap (inr x : α ⊕ β) = inl x := rfl
@[simp] lemma swap_swap (x : α ⊕ β) : swap (swap x) = x := by cases x; refl
@[simp] lemma swap_swap_eq : swap ∘ swap = @id (α ⊕ β) := funext $ swap_swap
@[simp] lemma swap_left_inverse : function.left_inverse (@swap α β) swap := swap_swap
@[simp] lemma swap_right_inverse : function.right_inverse (@swap α β) swap := swap_swap
@[simp] lemma is_left_swap (x : α ⊕ β) : x.swap.is_left = x.is_right := by cases x; refl
@[simp] lemma is_right_swap (x : α ⊕ β) : x.swap.is_right = x.is_left := by cases x; refl
@[simp] lemma get_left_swap (x : α ⊕ β) : x.swap.get_left = x.get_right := by cases x; refl
@[simp] lemma get_right_swap (x : α ⊕ β) : x.swap.get_right = x.get_left := by cases x; refl

section lift_rel

/-- Lifts pointwise two relations between `α` and `γ` and between `β` and `δ` to a relation between
`α ⊕ β` and `γ ⊕ δ`. -/
inductive lift_rel (r : α → γ → Prop) (s : β → δ → Prop) : α ⊕ β → γ ⊕ δ → Prop
| inl {a c} : r a c → lift_rel (inl a) (inl c)
| inr {b d} : s b d → lift_rel (inr b) (inr d)

attribute [protected] lift_rel.inl lift_rel.inr

variables {r r₁ r₂ : α → γ → Prop} {s s₁ s₂ : β → δ → Prop} {a : α} {b : β} {c : γ} {d : δ}
  {x : α ⊕ β} {y : γ ⊕ δ}

@[simp] lemma lift_rel_inl_inl : lift_rel r s (inl a) (inl c) ↔ r a c :=
⟨λ h, by { cases h, assumption }, lift_rel.inl⟩

@[simp] lemma not_lift_rel_inl_inr : ¬ lift_rel r s (inl a) (inr d) .
@[simp] lemma not_lift_rel_inr_inl : ¬ lift_rel r s (inr b) (inl c) .

@[simp] lemma lift_rel_inr_inr : lift_rel r s (inr b) (inr d) ↔ s b d :=
⟨λ h, by { cases h, assumption }, lift_rel.inr⟩

instance [Π a c, decidable (r a c)] [Π b d, decidable (s b d)] :
  Π (ab : α ⊕ β) (cd : γ ⊕ δ), decidable (lift_rel r s ab cd)
| (inl a) (inl c) := decidable_of_iff' _ lift_rel_inl_inl
| (inl a) (inr d) := decidable.is_false not_lift_rel_inl_inr
| (inr b) (inl c) := decidable.is_false not_lift_rel_inr_inl
| (inr b) (inr d) := decidable_of_iff' _ lift_rel_inr_inr

lemma lift_rel.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b)
  (h : lift_rel r₁ s₁ x y) :
  lift_rel r₂ s₂ x y :=
by { cases h, exacts [lift_rel.inl (hr _ _ ‹_›), lift_rel.inr (hs _ _ ‹_›)] }

lemma lift_rel.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : lift_rel r₁ s x y) :
  lift_rel r₂ s x y :=
h.mono hr $ λ _ _, id

lemma lift_rel.mono_right (hs : ∀ a b, s₁ a b → s₂ a b)  (h : lift_rel r s₁ x y) :
  lift_rel r s₂ x y :=
h.mono (λ _ _, id) hs

protected lemma lift_rel.swap (h : lift_rel r s x y) : lift_rel s r x.swap y.swap :=
by { cases h, exacts [lift_rel.inr ‹_›, lift_rel.inl ‹_›] }

@[simp] lemma lift_rel_swap_iff : lift_rel s r x.swap y.swap ↔ lift_rel r s x y :=
⟨λ h, by { rw [←swap_swap x, ←swap_swap y], exact h.swap }, lift_rel.swap⟩

end lift_rel

section lex

/-- Lexicographic order for sum. Sort all the `inl a` before the `inr b`, otherwise use the
respective order on `α` or `β`. -/
inductive lex (r : α → α → Prop) (s : β → β → Prop) : α ⊕ β → α ⊕ β → Prop
| inl {a₁ a₂} (h : r a₁ a₂) : lex (inl a₁) (inl a₂)
| inr {b₁ b₂} (h : s b₁ b₂) : lex (inr b₁) (inr b₂)
| sep (a b) : lex (inl a) (inr b)

attribute [protected] sum.lex.inl sum.lex.inr
attribute [simp] lex.sep

variables {r r₁ r₂ : α → α → Prop} {s s₁ s₂ : β → β → Prop} {a a₁ a₂ : α} {b b₁ b₂ : β}
  {x y : α ⊕ β}

@[simp] lemma lex_inl_inl : lex r s (inl a₁) (inl a₂) ↔ r a₁ a₂ :=
⟨λ h, by { cases h, assumption }, lex.inl⟩

@[simp] lemma lex_inr_inr : lex r s (inr b₁) (inr b₂) ↔ s b₁ b₂ :=
⟨λ h, by { cases h, assumption }, lex.inr⟩

@[simp] lemma lex_inr_inl : ¬ lex r s (inr b) (inl a) .

instance [decidable_rel r] [decidable_rel s] : decidable_rel (lex r s)
| (inl a) (inl c) := decidable_of_iff' _ lex_inl_inl
| (inl a) (inr d) := decidable.is_true (lex.sep _ _)
| (inr b) (inl c) := decidable.is_false lex_inr_inl
| (inr b) (inr d) := decidable_of_iff' _ lex_inr_inr

protected lemma lift_rel.lex {a b : α ⊕ β} (h : lift_rel r s a b) : lex r s a b :=
by { cases h, exacts [lex.inl ‹_›, lex.inr ‹_›] }

lemma lift_rel_subrelation_lex : subrelation (lift_rel r s) (lex r s) := λ a b, lift_rel.lex

lemma lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b) (h : lex r₁ s₁ x y) :
  lex r₂ s₂ x y :=
by { cases h, exacts [lex.inl (hr _ _ ‹_›), lex.inr (hs _ _ ‹_›), lex.sep _ _] }

lemma lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : lex r₁ s x y) : lex r₂ s x y :=
h.mono hr $ λ _ _, id

lemma lex.mono_right (hs : ∀ a b, s₁ a b → s₂ a b) (h : lex r s₁ x y) : lex r s₂ x y :=
h.mono (λ _ _, id) hs

lemma lex_acc_inl {a} (aca : acc r a) : acc (lex r s) (inl a) :=
begin
  induction aca with a H IH,
  constructor, intros y h,
  cases h with a' _ h',
  exact IH _ h'
end

lemma lex_acc_inr (aca : ∀ a, acc (lex r s) (inl a)) {b} (acb : acc s b) : acc (lex r s) (inr b) :=
begin
  induction acb with b H IH,
  constructor, intros y h,
  cases h with _ _ _ b' _ h' a,
  { exact IH _ h' },
  { exact aca _ }
end

lemma lex_wf (ha : well_founded r) (hb : well_founded s) : well_founded (lex r s) :=
have aca : ∀ a, acc (lex r s) (inl a), from λ a, lex_acc_inl (ha.apply a),
⟨λ x, sum.rec_on x aca (λ b, lex_acc_inr aca (hb.apply b))⟩

end lex
end sum

open sum

namespace function

lemma injective.sum_elim {f : α → γ} {g : β → γ}
  (hf : injective f) (hg : injective g) (hfg : ∀ a b, f a ≠ g b) :
  injective (sum.elim f g)
| (inl x) (inl y) h := congr_arg inl $ hf h
| (inl x) (inr y) h := (hfg x y h).elim
| (inr x) (inl y) h := (hfg y x h.symm).elim
| (inr x) (inr y) h := congr_arg inr $ hg h

lemma injective.sum_map {f : α → β} {g : α' → β'} (hf : injective f) (hg : injective g) :
  injective (sum.map f g)
| (inl x) (inl y) h := congr_arg inl $ hf $ inl.inj h
| (inr x) (inr y) h := congr_arg inr $ hg $ inr.inj h

lemma surjective.sum_map {f : α → β} {g : α' → β'} (hf : surjective f) (hg : surjective g) :
  surjective (sum.map f g)
| (inl y) := let ⟨x, hx⟩ := hf y in ⟨inl x, congr_arg inl hx⟩
| (inr y) := let ⟨x, hx⟩ := hg y in ⟨inr x, congr_arg inr hx⟩

lemma bijective.sum_map {f : α → β} {g : α' → β'} (hf : bijective f) (hg : bijective g) :
  bijective (sum.map f g) :=
⟨hf.injective.sum_map hg.injective, hf.surjective.sum_map hg.surjective⟩

end function

namespace sum
open function

@[simp] lemma map_injective {f : α → γ} {g : β → δ} :
  injective (sum.map f g) ↔ injective f ∧ injective g :=
⟨λ h, ⟨λ a₁ a₂ ha, inl_injective $ @h (inl a₁) (inl a₂) (congr_arg inl ha : _),
      λ b₁ b₂ hb, inr_injective $ @h (inr b₁) (inr b₂) (congr_arg inr hb : _)⟩,
  λ h, h.1.sum_map h.2⟩

@[simp] lemma map_surjective {f : α → γ} {g : β → δ} :
  surjective (sum.map f g) ↔ surjective f ∧ surjective g :=
⟨λ h, ⟨λ c, begin
  obtain ⟨a | b, h⟩ := h (inl c),
  { exact ⟨a, inl_injective h⟩ },
  { cases h },
end, λ d, begin
  obtain ⟨a | b, h⟩ := h (inr d),
  { cases h },
  { exact ⟨b, inr_injective h⟩ },
end⟩, λ h, h.1.sum_map h.2⟩

@[simp] lemma map_bijective {f : α → γ} {g : β → δ} :
  bijective (sum.map f g) ↔ bijective f ∧ bijective g :=
(map_injective.and map_surjective).trans $ and_and_and_comm _ _ _ _

lemma elim_const_const (c : γ) :
  sum.elim (const _ c : α → γ) (const _ c : β → γ) = const _ c :=
by { ext x, cases x; refl }

@[simp]
lemma elim_lam_const_lam_const (c : γ) :
  sum.elim (λ (_ : α), c) (λ (_ : β), c) = λ _, c :=
sum.elim_const_const c

lemma elim_update_left [decidable_eq α] [decidable_eq β]
    (f : α → γ) (g : β → γ) (i : α) (c : γ) :
  sum.elim (function.update f i c) g = function.update (sum.elim f g) (inl i) c :=
begin
  ext x, cases x,
  { by_cases h : x = i,
    { subst h, simp },
    { simp [h] } },
  { simp }
end

lemma elim_update_right [decidable_eq α] [decidable_eq β]
    (f : α → γ) (g : β → γ) (i : β) (c : γ) :
  sum.elim f (function.update g i c) = function.update (sum.elim f g) (inr i) c :=
begin
  ext x, cases x,
  { simp },
  { by_cases h : x = i,
    { subst h, simp },
    { simp [h] } }
end

end sum

/-!
### Ternary sum

Abbreviations for the maps from the summands to `α ⊕ β ⊕ γ`. This is useful for pattern-matching.
-/

namespace sum3

/-- The map from the first summand into a ternary sum. -/
@[pattern, simp, reducible] def in₀ (a) : α ⊕ β ⊕ γ := inl a
/-- The map from the second summand into a ternary sum. -/
@[pattern, simp, reducible] def in₁ (b) : α ⊕ β ⊕ γ := inr $ inl b
/-- The map from the third summand into a ternary sum. -/
@[pattern, simp, reducible] def in₂ (c) : α ⊕ β ⊕ γ := inr $ inr c

end sum3


import algebra.category.Module.projective
import linear_algebra.free_module.basic
import category_theory.monoidal.tor

import .lte.for_mathlib.derived_functor_zero

import .flat

open category_theory category_theory.limits category_theory.monoidal_category
open_locale direct_sum zero_object

noncomputable theory

universes u v

namespace Module

variables {R : Type u} [comm_ring R] (M : Module.{u} R) [Π (N : Module.{u} R), decidable_eq N]

@[reducible]
def afree : Module.{u} R := Module.of R $ ⨁ (m : M), R

instance afree_is_free : module.free R M.afree :=
module.free.dfinsupp R _

instance afree_is_projective : projective M.afree :=
projective_of_free.{u u u} (module.free.choose_basis R M.afree)

@[reducible]
def from_afree : M.afree ⟶ M :=
direct_sum.to_module _ _ _ $ λ m,
{ to_fun := λ r, r • m,
  map_add' := λ _ _, add_smul _ _ m,
  map_smul' := λ _ _, by rw [smul_eq_mul, mul_smul, ring_hom.id_apply] }

lemma from_afree_surj : function.surjective M.from_afree :=
λ x, ⟨direct_sum.of (λ (m : M), R) x 1, by
  erw [direct_sum.to_module_lof, linear_map.coe_mk, one_smul]⟩

instance from_afree_epi : epi M.from_afree :=
(Module.epi_iff_surjective _).mpr $ M.from_afree_surj

@[reducible] def free_res.chain_complex.Xd_aux :
ℕ → Σ' (N_prev N_next : Module.{u} R) (h : module.free R N_prev ∧ module.free R N_next), N_next ⟶ N_prev :=
@nat.rec (λ _, Σ' (N_prev N_next : Module.{u} R) (h : module.free R N_prev ∧ module.free R N_next), N_next ⟶ N_prev)
⟨M.afree, (kernel M.from_afree).afree,
  ⟨Module.afree_is_free _, Module.afree_is_free _⟩,
  Module.from_afree _ ≫ kernel.ι _⟩ $ λ n P,
⟨P.2.1, (kernel P.2.2.2).afree, ⟨P.2.2.1.2, Module.afree_is_free _⟩, Module.from_afree _ ≫ kernel.ι _⟩

lemma free_res.chain_complex.Xd_aux_0 (X : Module.{u} R) :
  free_res.chain_complex.Xd_aux X 0 =
  ⟨X.afree, (kernel X.from_afree).afree, ⟨Module.afree_is_free _, Module.afree_is_free _⟩,
    Module.from_afree _ ≫ kernel.ι _⟩ := rfl

@[reducible] def free_res.chain_complex.X' (n : ℕ) : Module.{u} R :=
(free_res.chain_complex.Xd_aux M n).1

@[reducible] def free_res.chain_complex.d' (i j : ℕ) :
  free_res.chain_complex.X' M i ⟶ free_res.chain_complex.X' M j :=
if h : j + 1 = i
then (eq_to_hom $ by rw h : _ ⟶ free_res.chain_complex.X' M (j + 1)) ≫
  (free_res.chain_complex.Xd_aux M _).2.2.2
else 0

@[simps] def free_res.chain_complex : chain_complex (Module R) ℕ :=
{ X := free_res.chain_complex.X' M,
  d := free_res.chain_complex.d' M,
  shape' := λ i j (h : _ ≠ _), by rw [free_res.chain_complex.d', dif_neg h],
  d_comp_d' := λ i j k (hij : _ = _) (hjk : _ = _),
  begin
    substs hij hjk,
    rw [free_res.chain_complex.d', free_res.chain_complex.d', dif_pos rfl, dif_pos rfl, eq_to_hom_refl,
      eq_to_hom_refl, category.id_comp, category.id_comp],
    dsimp,
    suffices : (free_res.chain_complex.Xd_aux M (k + 1)).2.2.2 ≫ (free_res.chain_complex.Xd_aux M k).2.2.2 = 0,
    { convert this, },
    { change (_ ≫ _) ≫ _ = 0,
      erw [category.assoc, kernel.condition, comp_zero], },
  end }

@[reducible]
def free_res : ProjectiveResolution M :=
{ complex := free_res.chain_complex M,
  π := (chain_complex.to_single₀_equiv (free_res.chain_complex M) M).symm ⟨M.from_afree,
  begin
    dsimp only [free_res.chain_complex.d', free_res.chain_complex_d],
    erw [dif_pos (zero_add 1), category.assoc, category.assoc, kernel.condition, comp_zero],
  end⟩,
  projective := λ n, projective_of_free.{u u u} (@@module.free.choose_basis R _ _ _ _ ((free_res.chain_complex.Xd_aux M) n).2.2.1.1),
  exact₀ :=
  begin
    dsimp [free_res.chain_complex.d'],
    simp only [eq_self_iff_true, category.id_comp, if_true],
    change exact (Module.from_afree _ ≫ _) M.from_afree,
    exact exact_epi_comp exact_kernel_ι,
  end,
  exact := λ n,
  begin
    dsimp [free_res.chain_complex.d'],
    simp only [eq_self_iff_true, category.id_comp, if_true],
    suffices : exact (free_res.chain_complex.Xd_aux M (n + 1)).snd.snd.snd
      (free_res.chain_complex.Xd_aux M n).snd.snd.snd,
    { exact this },
    change exact (_ ≫ _) _,
    convert @@exact_epi_comp _ (infer_instance : has_images (Module.{u} R)) _ _
      exact_kernel_ι (Module.from_afree_epi _),
  end,
  epi := M.from_afree_epi }

instance enough_projective_ : enough_projectives (Module.{u} R) :=
Module.Module_enough_projectives.{u u}

instance has_projective_resolutions : has_projective_resolutions (Module.{u} R) :=
{ out := λ Z, ⟨nonempty.intro $ Z.free_res⟩ }

def higher_Tor'_zero_of_flat (h : module.flat.exact R M) :
  ∀ (n : ℕ) (hn : 0 < n) (N : Module.{u} R),
    ((Tor' (Module.{u} R) n).obj N).obj M ≅ 0 :=
λ n hn N,
begin
  dsimp only [Tor', functor.flip],
  refine functor.left_derived_obj_iso (tensor_right M) n N.free_res ≪≫ _,
  suffices : epi _,
  { refine @@cokernel.of_epi _ _ _ _ _ this, },
  suffices : category_theory.exact _ _,
  { exact this.2 },
  dunfold homological_complex.d_to homological_complex.d_from,
  dsimp [functor.map_homological_complex_obj_d],
  dunfold tensor_hom,
  dunfold monoidal_category.tensor_hom,
  refine h (free_res.chain_complex.d' N ((complex_shape.down ℕ).prev n) n) _ _,
  rw complex_shape.prev_eq',
  work_on_goal 3 { exact n + 1 },
  work_on_goal 2 { rw complex_shape.down_rel, },
  rw complex_shape.next_eq',
  work_on_goal 3 { exact n.pred },
  work_on_goal 2
  { rw complex_shape.down_rel, refine nat.succ_pred_eq_of_pos hn, },

  convert (N.free_res).exact (n - 1) using 2,
  { linarith, },
  { linarith, },
  { linarith, },
  { linarith, },
  { linarith, },
end

def first_Tor'_zero_of_flat (h : module.flat.exact R M) :
  ∀ (N : Module.{u} R), ((Tor' (Module.{u} R) 1).obj N).obj M ≅ 0 :=
λ _, M.higher_Tor'_zero_of_flat h 1 (by linarith) _

def first_Tor'_ideal_zero_of_flat (h : module.flat.exact R M) :
  ∀ (I : ideal R), ((Tor' (Module.{u} R) 1).obj (Module.of R (R ⧸ I))).obj M ≅ 0 :=
λ _, M.first_Tor'_zero_of_flat h _

def first_Tor'_fg_ideal_zero_of_flat (h : module.flat.exact R M) :
  ∀  (I : ideal R) (hI : I.fg),
    ((Tor' (Module.{u} R) 1).obj (Module.of R (R ⧸ I))).obj M ≅ 0 :=
λ _ _, M.first_Tor'_zero_of_flat h _

def ses_of_ideal (I : ideal R) : short_exact_sequence (Module.{u} R) :=
{ fst := Module.of R I,
  snd := Module.of R R,
  trd := Module.of R (R ⧸ I),
  f := Module.of_hom ⟨coe, λ _ _, rfl, λ _ _, rfl⟩,
  g := submodule.mkq I,
  mono' :=
  begin
    rw mono_iff_injective,
    rintros x y h,
    ext,
    exact h,
  end,
  epi' :=
  begin
    rw epi_iff_surjective,
    exact submodule.mkq_surjective _,
  end,
  exact' :=
  begin
    rw exact_iff,
    rw submodule.ker_mkq,
    ext1 (x : R),
    split,
    { rintros ⟨x, rfl⟩,
      exact x.2, },
    { rintros hx, refine ⟨⟨x, hx⟩, rfl⟩ },
  end }

def flat_of_first_Tor'_fg_ideal_zero (h : ∀  (I : ideal R) (hI : I.fg),
  ((Tor' (Module.{u} R) 1).obj (Module.of R (R ⧸ I))).obj M ≅ 0) :
  module.flat.fg_ideal R M :=
λ I hI,
begin
  have exact1 : exact_seq (Module.{u} R) [_, _] := (category_theory.abelian.functor.seven_term_exact_seq (tensor_right M)
    (ses_of_ideal I)).extract 2 2,
  rw [←exact_iff_exact_seq] at exact1,
  convert_to function.injective ((tensor_right M).map (ses_of_ideal I).f),
  rw [←mono_iff_injective, mono_iff_exact_zero_left],
  refine exact_iso_comp.mp _,
  { exact ((tensor_right M).left_derived (0 + 1)).obj (ses_of_ideal I).trd },
  { specialize h I hI, exact h.hom, },
  { exact is_iso_of_op (h I hI).hom, },
  { convert exact1 using 1,
    apply is_initial.hom_ext,
    refine is_initial.of_iso _ (h I hI).symm,
    exact is_initial.of_unique 0, },
end

namespace flat

lemma equiv_defs : tfae
  [ module.flat.ses R M
  , module.flat.inj R M
  , module.flat.ideal R M
  , module.flat.fg_ideal R M
  , module.flat.exact R M
  , ∀ (N : Module.{u} R), nonempty (((Tor' (Module.{u} R) 1).obj N).obj M ≅ 0)
  , ∀ (I : ideal R), nonempty (((Tor' (Module.{u} R) 1).obj (Module.of R (R ⧸ I))).obj M ≅ 0)
  , ∀  (I : ideal R) (hI : I.fg),
    nonempty (((Tor' (Module.{u} R) 1).obj (Module.of R (R ⧸ I))).obj M ≅ 0)
  , ∀ (n : ℕ) (hn : 0 < n) (N : Module.{u} R),
    nonempty (((Tor' (Module.{u} R) n).obj N).obj M ≅ 0)] :=
begin
  tfae_have : 1 → 2, { apply module.flat.inj_of_ses },
  tfae_have : 2 → 1, { apply module.flat.ses_of_inj },
  tfae_have : 3 → 2, { apply module.flat.inj_of_ideal },
  tfae_have : 4 → 3, { apply module.flat.ideal_of_fg_ideal },
  tfae_have : 2 → 4, { apply module.flat.fg_ideal_of_inj },
  tfae_have : 5 → 2, { apply module.flat.inj_of_exact },
  tfae_have : 1 → 5, { apply module.flat.exact_of_ses },
  tfae_have : 5 → 6, { intros H N, exact ⟨first_Tor'_zero_of_flat M H N⟩, },
  tfae_have : 5 → 7, { intros H I, exact ⟨first_Tor'_ideal_zero_of_flat _ H _⟩, },
  tfae_have : 5 → 8, { intros H I hI, exact ⟨first_Tor'_fg_ideal_zero_of_flat _ H _ hI⟩, },
  tfae_have : 8 → 4, { intros H, exact flat_of_first_Tor'_fg_ideal_zero _ (λ I hI, (H _ hI).some), },
  tfae_have : 6 → 7, { intros H I, refine ⟨(H _).some⟩, },
  tfae_have : 7 → 8, { intros H I hI, exact ⟨(H _).some⟩, },
  tfae_have : 5 → 9, { intros H n hn, refine λ N, ⟨higher_Tor'_zero_of_flat M H n hn N⟩, },
  tfae_have : 9 → 6, { intros H N, refine H _ _ _, linarith },
  tfae_finish,
end

end flat

end Module