import data.real.basic

--OUTPUT 1
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 9 / 2, from by {
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
    rw [div_add_div_same, div_add_div_same, div_add_div_same],
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : 0 < (a + b + c), from by {apply lt_add_of_pos_of_pos,exact ha,exact lt_add_of_pos_of_pos hb hc},
  have h2 : (a + b + c) / 2 = (3 / 2) * (a + b + c), from by {rw mul_div_cancel,exact h1,ring},
  have h3 : (a + b + c) / 2 = (a / (b + c)) + (b / (a + c)) + (c / (a + b)), from by {rw [mul_div_cancel,mul_div_cancel,mul_div_cancel,mul_div_cancel],
    exact h1,exact hb,exact hc,exact ha,ring},
  have h4 : (a + b + c) / 2 ≥ (3 / 2) * (1 / (b + c) + 1 / (a + c) + 1 / (a + b)), from by {rw [mul_div_cancel,mul_div_cancel,mul_div_cancel,mul_div_cancel],
    exact h1,exact hb,exact hc,exact ha,apply arithmetic_mean_ge_harmonic_mean,},
  have h5 : (3 / 2) * (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) = (3 / 2) * (1 / (b + c) + 1 / (a + c)) + (3 / 2) * (1 / (a + b)), from by ring,
  have h6 : (3 / 2) * (1 / (b + c) + 1 / (a + c)) = (a + b + c) / ((b + c) + (a + c)), from by ring,
  have h7 : (3 / 2) * (1 / (a + b)) = (a + b + c) / ((a + b) + (a + b + c)), from by ring,
  have h8 : (a + b + c) / ((b + c) + (a + c)) + (a + b + c) / ((a + b) + (a + b + c)) = (a + b + c) / 2, from by ring,
  have h9 : (3 / 2) * (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) = (a + b + c) / 2, from by {rw [h5,h6,h7,h8],},
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by {rw [h3,h9],exact h4,},
end

--OUTPUT 3
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 9 / 2, from by {
    have h2 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 * (a + b + c)) / ((b + c) + (a + c) + (a + b)), from by {
      have h3 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) / 3, from by {
        rw [div_eq_mul_inv,div_eq_mul_inv,div_eq_mul_inv],
        have h4 : (a + b + c) * (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) = (a + b + c) * (2 / 3), from by {
          rw [div_eq_mul_inv,div_eq_mul_inv,div_eq_mul_inv,div_eq_mul_inv],
          have h5 : (a + b + c) * (1 / (b + c) + 1 / (a + c) + 1 / (a + b)) = ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))), from by {
            rw [mul_add,mul_add,mul_add],
            ring,
          },
          have h6 : ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) = ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))), from by {
            rw [mul_add,mul_add,mul_add,mul_add,mul_add,mul_add],
            ring,
          },
          have h7 : ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) = ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))), from by {
            rw [mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add],
            ring,
          },
          have h8 : ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) = ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))), from by {
            rw [mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add],
            ring,
          },
          have h9 : ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) = ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))) + ((a + b + c) * (1 / (b + c))) + ((a + b + c) * (1 / (a + c))) + ((a + b + c) * (1 / (a + b))), from by {
            rw [mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add,mul_add],
            ring,
          },
          have h10 : ((a + b + c) * (1 / (b +
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ 3 * (1 / ((b + c) + (a + c) + (a + b))) : by {
    rw [← add_halves,← add_halves,← add_halves,← add_halves,← add_halves,← add_halves],
    rw [← div_add_div_same,← div_add_div_same,← div_add_div_same,← div_add_div_same,← div_add_div_same,← div_add_div_same],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [← mul_div_cancel_left,← mul_div_cancel_left,← mul_div_cancel_left],
    rw [←
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 * (a + b + c)) / (2 * (b + c + a + c + a + b)),
    from by {rw mul_comm, rw mul_comm _ 2, apply arithmetic_mean_is_never_less_than_harmonic_mean,ring},
  have h2 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (3 * (a + b + c)) / (b + c + a + c + a + b),
    from by {rw ← mul_assoc, rw mul_comm, rw mul_comm _ 3, apply h1, ring},
  have h3 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 3 / 2,
    from by {rw ← mul_assoc, rw mul_comm, rw mul_comm _ 3, apply h1, ring},
  have h4 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ 3 / 2,
    from by {rw ← mul_assoc, rw mul_comm, rw mul_comm _ 3, apply h1, ring},
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ 3 / 2, from h4
end

--OUTPUT 6
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : 0 < (a + b + c), from by {apply add_pos,exact ha,exact hb,exact hc},
  have h2 : (a + b + c) / 2 = (3 / 2) * (a + b + c), from by {rw [div_mul_cancel h1,two_mul],},
  have h3 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 / 2) * (a + b + c), from by {
    rw [←h2,←h2,←h2,←h2,←h2,←h2],
    apply am_ge_hm,
    obviously,},
  have h4 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (3 / 2) * (a + b + c), from by {
    rw [←h2,←h2,←h2,←h2,←h2,←h2],
    apply am_ge_hm,
    obviously,},
  have h5 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by {
    rw [←h2,←h2,←h2,←h2,←h2,←h2],
    apply am_ge_hm,
    obviously,},
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from h5,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Nesbitt's inequality
Let $a$, $b$ and $c$ be positive real numbers.

Then:
:$\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$

`proof`
{{begin-eqn}}
{{eqn | l = \frac a {b + c} + \frac b {a + c} + \frac c {a + b}
      | o = \ge
      | r = \dfrac 3 2
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac 9 2
      | c = by adding $3$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac {9 \paren {a + b + c} } {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = as $\dfrac {a + b + c} {\paren {b + c} + \paren {a + c} + \paren {a + b} } = \dfrac 1 2$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {\frac 1 {b + c} + \frac 1 {a + c} + \frac 1 {a + b} } 3
      | o = \ge
      | r = \frac 3 {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = dividing by $3 \paren {a + b + c}$
}}
{{end-eqn}}
These are the arithmetic mean and the harmonic mean of $\dfrac 1 {b + c}$, $\dfrac 1 {a + c}$ and $\dfrac 1 {a + b}$.

From Arithmetic Mean is Never Less than Harmonic Mean the last inequality is true.

Thus Nesbitt's Inequality holds.
{{qed}}

-/
theorem  nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from assume (i j : ℤ) (hij : i ≠ j),
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α = (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j), from by {
      rw [← int.fract_eq_sub_nat_abs, ← int.fract_eq_sub_nat_abs, h2],
      ring,
    },
    have h4 : (i - j) ≠ 0, from by {
      assume h5 : (i - j) = 0,
      have h6 : i = j, from by {rw [h5, sub_eq_zero]},
      exact hij h6,
    },
    have h7 : α ∈ ℚ, from by {
      rw [← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg _), ← int.coe_nat_eq_coe_int_of_nonneg (int.nat_abs_nonneg
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.measure.measure_space

/-!
# Vitali families

On a metric space `X` with a measure `μ`, consider for each `x : X` a family of measurable sets with
nonempty interiors, called `sets_at x`. This family is a Vitali family if it satisfies the following
property: consider a (possibly non-measurable) set `s`, and for any `x` in `s` a
subfamily `f x` of `sets_at x` containing sets of arbitrarily small diameter. Then one can extract
a disjoint subfamily covering almost all `s`.

Vitali families are provided by covering theorems such as the Besicovitch covering theorem or the
Vitali covering theorem. They make it possible to formulate general versions of theorems on
differentiations of measure that apply in both contexts.

This file gives the basic definition of Vitali families. More interesting developments of this
notion are deferred to other files:
* constructions of specific Vitali families are provided by the Besicovitch covering theorem, in
`besicovitch.vitali_family`, and by the Vitali covering theorem, in `vitali.vitali_family`.
* The main theorem on differentiation of measures along a Vitali family is proved in
`vitali_family.ae_tendsto_rn_deriv`.

## Main definitions

* `vitali_family μ` is a structure made, for each `x : X`, of a family of sets around `x`, such that
one can extract an almost everywhere disjoint covering from any subfamily containing sets of
arbitrarily small diameters.

Let `v` be such a Vitali family.
* `v.fine_subfamily_on` describes the subfamilies of `v` from which one can extract almost
everywhere disjoint coverings. This property, called
`v.fine_subfamily_on.exists_disjoint_covering_ae`, is essentially a restatement of the definition
of a Vitali family. We also provide an API to use efficiently such a disjoint covering.
* `v.filter_at x` is a filter on sets of `X`, such that convergence with respect to this filter
means convergence when sets in the Vitali family shrink towards `x`.

## References

* [Herbert Federer, Geometric Measure Theory, Chapter 2.8][Federer1996] (Vitali families are called
Vitali relations there)
-/

open measure_theory metric set filter topological_space measure_theory.measure
open_locale filter measure_theory topology

variables {α : Type*} [metric_space α]

/-- On a metric space `X` with a measure `μ`, consider for each `x : X` a family of measurable sets
with nonempty interiors, called `sets_at x`. This family is a Vitali family if it satisfies the
following property: consider a (possibly non-measurable) set `s`, and for any `x` in `s` a
subfamily `f x` of `sets_at x` containing sets of arbitrarily small diameter. Then one can extract
a disjoint subfamily covering almost all `s`.

Vitali families are provided by covering theorems such as the Besicovitch covering theorem or the
Vitali covering theorem. They make it possible to formulate general versions of theorems on
differentiations of measure that apply in both contexts.
-/
@[nolint has_nonempty_instance]
structure vitali_family {m : measurable_space α} (μ : measure α) :=
(sets_at : Π (x : α), set (set α))
(measurable_set' : ∀ (x : α), ∀ (a : set α), a ∈ sets_at x → measurable_set a)
(nonempty_interior : ∀ (x : α), ∀ (y : set α), y ∈ sets_at x → (interior y).nonempty)
(nontrivial : ∀ (x : α) (ε > (0 : ℝ)), ∃ y ∈ sets_at x, y ⊆ closed_ball x ε)
(covering : ∀ (s : set α) (f : Π (x : α), set (set α)), (∀ x ∈ s, f x ⊆ sets_at x) →
  (∀ (x ∈ s) (ε > (0 : ℝ)), ∃ a ∈ f x, a ⊆ closed_ball x ε) → ∃ (t : set (α × set α)),
    (∀ (p : α × set α), p ∈ t → p.1 ∈ s) ∧ t.pairwise_disjoint (λ p, p.2) ∧
    (∀ (p : α × set α), p ∈ t → p.2 ∈ f p.1) ∧ μ (s \ ⋃ (p : α × set α) (hp : p ∈ t), p.2) = 0)

namespace vitali_family

variables {m0 : measurable_space α} {μ : measure α}
include μ

/-- A Vitali family for a measure `μ` is also a Vitali family for any measure absolutely continuous
with respect to `μ`. -/
def mono (v : vitali_family μ) (ν : measure α) (hν : ν ≪ μ) :
  vitali_family ν :=
{ sets_at := v.sets_at,
  measurable_set' := v.measurable_set',
  nonempty_interior := v.nonempty_interior,
  nontrivial := v.nontrivial,
  covering := λ s f h h', begin
    rcases v.covering s f h h' with ⟨t, ts, disj, mem_f, hμ⟩,
    exact ⟨t, ts, disj, mem_f, hν hμ⟩
  end }

/-- Given a Vitali family `v` for a measure `μ`, a family `f` is a fine subfamily on a set `s` if
every point `x` in `s` belongs to arbitrarily small sets in `v.sets_at x ∩ f x`. This is precisely
the subfamilies for which the Vitali family definition ensures that one can extract a disjoint
covering of almost all `s`. -/
def fine_subfamily_on (v : vitali_family μ) (f : α → set (set α)) (s : set α) : Prop :=
∀ x ∈ s, ∀ (ε > 0), ∃ a ∈ v.sets_at x ∩ f x, a ⊆ closed_ball x ε

namespace fine_subfamily_on

variables {v : vitali_family μ} {f : α → set (set α)} {s : set α} (h : v.fine_subfamily_on f s)
include h

theorem exists_disjoint_covering_ae :
  ∃ (t : set (α × set α)), (∀ (p : α × set α), p ∈ t → p.1 ∈ s) ∧
  t.pairwise_disjoint (λ p, p.2) ∧
  (∀ (p : α × set α), p ∈ t → p.2 ∈ v.sets_at p.1 ∩ f p.1)
  ∧ μ (s \ ⋃ (p : α × set α) (hp : p ∈ t), p.2) = 0 :=
v.covering s (λ x, v.sets_at x ∩ f x) (λ x hx, inter_subset_left _ _) h

/-- Given `h : v.fine_subfamily_on f s`, then `h.index` is a set parametrizing a disjoint
covering of almost every `s`. -/
protected def index : set (α × set α) :=
h.exists_disjoint_covering_ae.some

/-- Given `h : v.fine_subfamily_on f s`, then `h.covering p` is a set in the family,
for `p ∈ h.index`, such that these sets form a disjoint covering of almost every `s`. -/
@[nolint unused_arguments] protected def covering : α × set α → set α :=
λ p, p.2

lemma index_subset : ∀ (p : α × set α), p ∈ h.index → p.1 ∈ s :=
h.exists_disjoint_covering_ae.some_spec.1

lemma covering_disjoint : h.index.pairwise_disjoint h.covering :=
h.exists_disjoint_covering_ae.some_spec.2.1

lemma covering_disjoint_subtype : pairwise (disjoint on (λ x : h.index, h.covering x)) :=
(pairwise_subtype_iff_pairwise_set _ _).2 h.covering_disjoint

lemma covering_mem {p : α × set α} (hp : p ∈ h.index) : h.covering p ∈ f p.1 :=
(h.exists_disjoint_covering_ae.some_spec.2.2.1 p hp).2

lemma covering_mem_family {p : α × set α} (hp : p ∈ h.index) : h.covering p ∈ v.sets_at p.1 :=
(h.exists_disjoint_covering_ae.some_spec.2.2.1 p hp).1

lemma measure_diff_bUnion : μ (s \ ⋃ p ∈ h.index, h.covering p) = 0 :=
h.exists_disjoint_covering_ae.some_spec.2.2.2

lemma index_countable [second_countable_topology α] : h.index.countable :=
h.covering_disjoint.countable_of_nonempty_interior
  (λ x hx, v.nonempty_interior _ _ (h.covering_mem_family hx))

protected lemma measurable_set_u {p : α × set α} (hp : p ∈ h.index) :
  measurable_set (h.covering p) :=
v.measurable_set' p.1 _ (h.covering_mem_family hp)

lemma measure_le_tsum_of_absolutely_continuous [second_countable_topology α]
  {ρ : measure α} (hρ : ρ ≪ μ) :
  ρ s ≤ ∑' (p : h.index), ρ (h.covering p) :=
calc ρ s ≤ ρ ((s \ ⋃ (p ∈ h.index), h.covering p) ∪ (⋃ (p ∈ h.index), h.covering p)) :
    measure_mono (by simp only [subset_union_left, diff_union_self])
  ... ≤ ρ (s \ ⋃ (p ∈ h.index), h.covering p) + ρ (⋃ (p ∈ h.index), h.covering p) :
    measure_union_le _ _
  ... = ∑' (p : h.index), ρ (h.covering p) : by rw [hρ h.measure_diff_bUnion,
    measure_bUnion h.index_countable h.covering_disjoint (λ x hx, h.measurable_set_u hx),
    zero_add]

lemma measure_le_tsum [second_countable_topology α] :
  μ s ≤ ∑' (x : h.index), μ (h.covering x) :=
h.measure_le_tsum_of_absolutely_continuous measure.absolutely_continuous.rfl

end fine_subfamily_on

/-- One can enlarge a Vitali family by adding to the sets `f x` at `x` all sets which are not
contained in a `δ`-neighborhood on `x`. This does not change the local filter at a point, but it
can be convenient to get a nicer global behavior. -/
def enlarge (v : vitali_family μ) (δ : ℝ) (δpos : 0 < δ) : vitali_family μ :=
{ sets_at := λ x, v.sets_at x ∪
                {a | measurable_set a ∧ (interior a).nonempty ∧ ¬(a ⊆ closed_ball x δ)},
  measurable_set' := λ x a ha, by { cases ha, exacts [v.measurable_set' _ _ ha, ha.1] },
  nonempty_interior := λ x a ha, by { cases ha, exacts [v.nonempty_interior _ _ ha, ha.2.1] },
  nontrivial := begin
    assume x ε εpos,
    rcases v.nontrivial x ε εpos with ⟨a, ha, h'a⟩,
    exact ⟨a, mem_union_left _ ha, h'a⟩,
  end,
  covering := begin
    assume s f fset ffine,
    let g : α → set (set α) := λ x, f x ∩ v.sets_at x,
    have : ∀ x ∈ s, ∀ (ε : ℝ), ε > 0 → (∃ (a : set α) (H : a ∈ g x), a ⊆ closed_ball x ε),
    { assume x hx ε εpos,
      obtain ⟨a, af, ha⟩ : ∃ a ∈ f x, a ⊆ closed_ball x (min ε δ),
        from ffine x hx (min ε δ) (lt_min εpos δpos),
      rcases fset x hx af with h'a|h'a,
      { exact ⟨a, ⟨af, h'a⟩, ha.trans (closed_ball_subset_closed_ball (min_le_left _ _))⟩ },
      { refine false.elim (h'a.2.2 _),
        exact ha.trans (closed_ball_subset_closed_ball (min_le_right _ _)) } },
    rcases v.covering s g (λ x hx, inter_subset_right _ _) this with ⟨t, ts, tdisj, tg, μt⟩,
    exact ⟨t, ts, tdisj, λ p hp, (tg p hp).1, μt⟩,
  end }

variable (v : vitali_family μ)
include v

/-- Given a vitali family `v`, then `v.filter_at x` is the filter on `set α` made of those families
that contain all sets of `v.sets_at x` of a sufficiently small diameter. This filter makes it
possible to express limiting behavior when sets in `v.sets_at x` shrink to `x`. -/
def filter_at (x : α) : filter (set α) :=
⨅ (ε ∈ Ioi (0 : ℝ)), 𝓟 {a ∈ v.sets_at x | a ⊆ closed_ball x ε}

lemma mem_filter_at_iff {x : α} {s : set (set α)} :
  (s ∈ v.filter_at x) ↔ ∃ (ε > (0 : ℝ)), ∀ a ∈ v.sets_at x, a ⊆ closed_ball x ε → a ∈ s :=
begin
  simp only [filter_at, exists_prop, gt_iff_lt],
  rw mem_binfi_of_directed,
  { simp only [subset_def, and_imp, exists_prop, mem_sep_iff, mem_Ioi, mem_principal] },
  { simp only [directed_on, exists_prop, ge_iff_le, le_principal_iff, mem_Ioi, order.preimage,
      mem_principal],
    assume x hx y hy,
    refine ⟨min x y, lt_min hx hy,
      λ a ha, ⟨ha.1, ha.2.trans (closed_ball_subset_closed_ball (min_le_left _ _))⟩,
      λ a ha, ⟨ha.1, ha.2.trans (closed_ball_subset_closed_ball (min_le_right _ _))⟩⟩ },
  { exact ⟨(1 : ℝ), mem_Ioi.2 zero_lt_one⟩ }
end

instance filter_at_ne_bot (x : α) : (v.filter_at x).ne_bot :=
begin
  simp only [ne_bot_iff, ←empty_mem_iff_bot, mem_filter_at_iff, not_exists, exists_prop,
    mem_empty_iff_false, and_true, gt_iff_lt, not_and, ne.def, not_false_iff, not_forall],
  assume ε εpos,
  obtain ⟨w, w_sets, hw⟩ : ∃ (w ∈ v.sets_at x), w ⊆ closed_ball x ε := v.nontrivial x ε εpos,
  exact ⟨w, w_sets, hw⟩
end

lemma eventually_filter_at_iff {x : α} {P : set α → Prop} :
  (∀ᶠ a in v.filter_at x, P a) ↔ ∃ (ε > (0 : ℝ)), ∀ a ∈ v.sets_at x, a ⊆ closed_ball x ε → P a :=
v.mem_filter_at_iff

lemma eventually_filter_at_mem_sets (x : α) :
  ∀ᶠ a in v.filter_at x, a ∈ v.sets_at x :=
begin
  simp only [eventually_filter_at_iff, exists_prop, and_true, gt_iff_lt,
             implies_true_iff] {contextual := tt},
  exact ⟨1, zero_lt_one⟩
end

lemma eventually_filter_at_subset_closed_ball (x : α) {ε : ℝ} (hε : 0 < ε) :
  ∀ᶠ (a : set α) in v.filter_at x, a ⊆ closed_ball x ε :=
begin
  simp only [v.eventually_filter_at_iff],
  exact ⟨ε, hε, λ a ha ha', ha'⟩,
end

lemma tendsto_filter_at_iff {ι : Type*} {l : filter ι} {f : ι → set α} {x : α} :
  tendsto f l (v.filter_at x) ↔
  (∀ᶠ i in l, f i ∈ v.sets_at x) ∧ (∀ (ε > (0 : ℝ)), ∀ᶠ i in l, f i ⊆ closed_ball x ε) :=
begin
  refine ⟨λ H,
    ⟨H.eventually $ v.eventually_filter_at_mem_sets x,
     λ ε hε, H.eventually $ v.eventually_filter_at_subset_closed_ball x hε⟩,
    λ H s hs, (_ : ∀ᶠ i in l, f i ∈ s)⟩,
  obtain ⟨ε, εpos, hε⟩ := v.mem_filter_at_iff.mp hs,
  filter_upwards [H.1, H.2 ε εpos] with i hi hiε using hε _ hi hiε,
end

lemma eventually_filter_at_measurable_set (x : α) :
  ∀ᶠ a in v.filter_at x, measurable_set a :=
by { filter_upwards [v.eventually_filter_at_mem_sets x] with _ ha using v.measurable_set' _ _ ha }

lemma eventually_filter_at_subset_of_nhds {x : α} {o : set α} (hx : o ∈ 𝓝 x) :
  ∀ᶠ a in v.filter_at x, a ⊆ o :=
begin
  rw eventually_filter_at_iff,
  rcases metric.mem_nhds_iff.1 hx with ⟨ε, εpos, hε⟩,
  exact ⟨ε/2, half_pos εpos,
    λ a av ha, ha.trans ((closed_ball_subset_ball (half_lt_self εpos)).trans hε)⟩
end

lemma fine_subfamily_on_of_frequently (v : vitali_family μ) (f : α → set (set α)) (s : set α)
  (h : ∀ x ∈ s, ∃ᶠ a in v.filter_at x, a ∈ f x) :
  v.fine_subfamily_on f s :=
begin
  assume x hx ε εpos,
  obtain ⟨a, av, ha, af⟩ : ∃ (a : set α) (H : a ∈ v.sets_at x), a ⊆ closed_ball x ε ∧ a ∈ f x :=
    v.frequently_filter_at_iff.1 (h x hx) ε εpos,
  exact ⟨a, ⟨av, af⟩, ha⟩,
end

end vitali_family


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

import algebra.homology.homotopy
import algebraic_topology.dold_kan.notations

/-!

# Construction of homotopies for the Dold-Kan correspondence

TODO (@joelriou) continue adding the various files referenced below

(The general strategy of proof of the Dold-Kan correspondence is explained
in `equivalence.lean`.)

The purpose of the files `homotopies.lean`, `faces.lean`, `projections.lean`
and `p_infty.lean` is to construct an idempotent endomorphism
`P_infty : K[X] ⟶ K[X]` of the alternating face map complex
for each `X : simplicial_object C` when `C` is a preadditive category.
In the case `C` is abelian, this `P_infty` shall be the projection on the
normalized Moore subcomplex of `K[X]` associated to the decomposition of the
complex `K[X]` as a direct sum of this normalized subcomplex and of the
degenerate subcomplex.

In `p_infty.lean`, this endomorphism `P_infty` shall be obtained by
passing to the limit idempotent endomorphisms `P q` for all `(q : ℕ)`.
These endomorphisms `P q` are defined by induction. The idea is to
start from the identity endomorphism `P 0` of `K[X]` and to ensure by
induction that the `q` higher face maps (except $d_0$) vanish on the
image of `P q`. Then, in a certain degree `n`, the image of `P q` for
a big enough `q` will be contained in the normalized subcomplex. This
construction is done in `projections.lean`.

It would be easy to define the `P q` degreewise (similarly as it is done
in *Simplicial Homotopy Theory* by Goerrs-Jardine p. 149), but then we would
have to prove that they are compatible with the differential (i.e. they
are chain complex maps), and also that they are homotopic to the identity.
These two verifications are quite technical. In order to reduce the number
of such technical lemmas, the strategy that is followed here is to define
a series of null homotopic maps `Hσ q` (attached to families of maps `hσ`)
and use these in order to construct `P q` : the endomorphisms `P q`
shall basically be obtained by altering the identity endomorphism by adding
null homotopic maps, so that we get for free that they are morphisms
of chain complexes and that they are homotopic to the identity. The most
technical verifications that are needed about the null homotopic maps `Hσ`
are obtained in `faces.lean`.

In this file `homotopies.lean`, we define the null homotopic maps
`Hσ q : K[X] ⟶ K[X]`, show that they are natural (see `nat_trans_Hσ`) and
compatible the application of additive functors (see `map_Hσ`).

## References
* [Albrecht Dold, *Homology of Symmetric Products and Other Functors of Complexes*][dold1958]
* [Paul G. Goerss, John F. Jardine, *Simplical Homotopy Theory*][goerss-jardine-2009]

-/

open category_theory
open category_theory.category
open category_theory.limits
open category_theory.preadditive
open category_theory.simplicial_object
open homotopy
open opposite
open_locale simplicial dold_kan

noncomputable theory

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C]
variables {X : simplicial_object C}

/-- As we are using chain complexes indexed by `ℕ`, we shall need the relation
`c` such `c m n` if and only if `n+1=m`. -/
abbreviation c := complex_shape.down ℕ

/-- Helper when we need some `c.rel i j` (i.e. `complex_shape.down ℕ`),
e.g. `c_mk n (n+1) rfl` -/
lemma c_mk (i j : ℕ) (h : j+1 = i) : c.rel i j :=
complex_shape.down_mk i j h

/-- This lemma is meant to be used with `null_homotopic_map'_f_of_not_rel_left` -/
lemma cs_down_0_not_rel_left (j : ℕ) : ¬c.rel 0 j :=
begin
  intro hj,
  dsimp at hj,
  apply nat.not_succ_le_zero j,
  rw [nat.succ_eq_add_one, hj],
end

/-- The sequence of maps which gives the null homotopic maps `Hσ` that shall be in
the inductive construction of the projections `P q : K[X] ⟶ K[X]` -/
def hσ (q : ℕ) (n : ℕ) : X _[n] ⟶ X _[n+1] :=
if n<q
  then 0
  else (-1 : ℤ)^(n-q) • X.σ ⟨n-q, nat.sub_lt_succ n q⟩

/-- We can turn `hσ` into a datum that can be passed to `null_homotopic_map'`. -/
def hσ' (q : ℕ) : Π n m, c.rel m n → (K[X].X n ⟶ K[X].X m) :=
λ n m hnm, (hσ q n) ≫ eq_to_hom (by congr')

lemma hσ'_eq_zero {q n m : ℕ} (hnq : n<q) (hnm : c.rel m n) :
  (hσ' q n m hnm : X _[n] ⟶ X _[m])= 0 :=
by { simp only [hσ', hσ], split_ifs, exact zero_comp, }

lemma hσ'_eq {q n a m : ℕ} (ha : n=a+q) (hnm : c.rel m n) :
  (hσ' q n m hnm : X _[n] ⟶ X _[m]) =
  ((-1 : ℤ)^a • X.σ ⟨a, nat.lt_succ_iff.mpr (nat.le.intro (eq.symm ha))⟩) ≫
      eq_to_hom (by congr') :=
begin
  simp only [hσ', hσ],
  split_ifs,
  { exfalso, linarith, },
  { have h' := tsub_eq_of_eq_add ha,
    congr', }
end

lemma hσ'_eq' {q n a : ℕ} (ha : n=a+q) :
  (hσ' q n (n+1) rfl : X _[n] ⟶ X _[n+1]) =
  (-1 : ℤ)^a • X.σ ⟨a, nat.lt_succ_iff.mpr (nat.le.intro (eq.symm ha))⟩ :=
by rw [hσ'_eq ha rfl, eq_to_hom_refl, comp_id]

/-- The null homotopic map $(hσ q) ∘ d + d ∘ (hσ q)$ -/
def Hσ (q : ℕ) : K[X] ⟶ K[X] := null_homotopic_map' (hσ' q)

/-- `Hσ` is null homotopic -/
def homotopy_Hσ_to_zero (q : ℕ) : homotopy (Hσ q : K[X] ⟶ K[X]) 0 :=
null_homotopy' (hσ' q)

/-- In degree `0`, the null homotopic map `Hσ` is zero. -/
lemma Hσ_eq_zero (q : ℕ) : (Hσ q : K[X] ⟶ K[X]).f 0 = 0  :=
begin
  unfold Hσ,
  rw null_homotopic_map'_f_of_not_rel_left (c_mk 1 0 rfl) cs_down_0_not_rel_left,
  cases q,
  { rw hσ'_eq (show 0=0+0, by refl) (c_mk 1 0 rfl),
    simp only [pow_zero, fin.mk_zero, one_zsmul, eq_to_hom_refl, category.comp_id],
    erw chain_complex.of_d,
    simp only [alternating_face_map_complex.obj_d, fin.sum_univ_two,
      fin.coe_zero, pow_zero, one_zsmul, fin.coe_one, pow_one, comp_add,
      neg_smul, one_zsmul, comp_neg, add_neg_eq_zero],
    erw [δ_comp_σ_self, δ_comp_σ_succ], },
  { rw [hσ'_eq_zero (nat.succ_pos q) (c_mk 1 0 rfl), zero_comp], },
end

/-- The maps `hσ' q n m hnm` are natural on the simplicial object -/
lemma hσ'_naturality (q : ℕ) (n m : ℕ) (hnm : c.rel m n)
  {X Y : simplicial_object C} (f : X ⟶ Y) :
  f.app (op [n]) ≫ hσ' q n m hnm = hσ' q n m hnm ≫ f.app (op [m]) :=
begin
  have h : n+1 = m := hnm,
  subst h,
  simp only [hσ', eq_to_hom_refl, comp_id],
  unfold hσ,
  split_ifs,
  { rw [zero_comp, comp_zero], },
  { simp only [zsmul_comp, comp_zsmul],
    erw f.naturality,
    refl, },
end

/-- For each q, `Hσ q` is a natural transformation. -/
def nat_trans_Hσ (q : ℕ) :
  alternating_face_map_complex C ⟶ alternating_face_map_complex C :=
{ app := λ X, Hσ q,
  naturality' := λ X Y f, begin
    unfold Hσ,
    rw [null_homotopic_map'_comp, comp_null_homotopic_map'],
    congr,
    ext n m hnm,
    simp only [alternating_face_map_complex_map_f, hσ'_naturality],
  end, }

/-- The maps `hσ' q n m hnm` are compatible with the application of additive functors. -/
lemma map_hσ' {D : Type*} [category D] [preadditive D]
  (G : C ⥤ D) [G.additive] (X : simplicial_object C)
  (q n m : ℕ) (hnm : c.rel m n) :
  (hσ' q n m hnm : K[((whiskering _ _).obj G).obj X].X n ⟶ _) =
    G.map (hσ' q n m hnm : K[X].X n ⟶ _) :=
begin
  unfold hσ' hσ,
  split_ifs,
  { simp only [functor.map_zero, zero_comp], },
  { simpa only [eq_to_hom_map, functor.map_comp, functor.map_zsmul], },
end

/-- The null homotopic maps `Hσ` are compatible with the application of additive functors. -/
lemma map_Hσ {D : Type*} [category D] [preadditive D]
  (G : C ⥤ D) [G.additive] (X : simplicial_object C) (q n : ℕ) :
  (Hσ q : K[((whiskering C D).obj G).obj X] ⟶ _).f n =
    G.map ((Hσ q : K[X] ⟶ _).f n) :=
begin
  unfold Hσ,
  have eq := homological_complex.congr_hom (map_null_homotopic_map' G (hσ' q)) n,
  simp only [functor.map_homological_complex_map_f, ← map_hσ'] at eq,
  rw eq,
  let h := (functor.congr_obj (map_alternating_face_map_complex G) X).symm,
  congr',
end

end dold_kan

end algebraic_topology


/-
Copyright (c) 2018 Sander Dahmen, Johannes Hölzl, Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sander Dahmen, Johannes Hölzl, Robert Y. Lewis

"On large subsets of 𝔽ⁿ_q with no three-term arithmetic progression"
by J. S. Ellenberg and D. Gijswijt

This file establishes the asymptotic behavior of the cap set cardinality bound
proved in section_10_11_12.lean.
It corresponds to the second half of section 13 of our blueprint.
-/

import data.vector2 data.zmod.basic data.nat.modeq
import tactic.library_search
import
  section_10_11_12
  has_deriv

def iseg (q j) : finset (fin q) :=
finset.univ.filter (λ k, k.val ≤ j)

lemma val_le_right_of_iseg {q j} {v : fin q} (h : v ∈ iseg q j) : v.val ≤ j :=
(finset.mem_filter.1 h).2

lemma mem_iseg_of_le {q j} {v : fin q} (h : v.val ≤ j) : v ∈ iseg q j :=
by simp [iseg, h]

section fix_q
parameter (q : ℕ)

section cf_def
parameter (n : ℕ)

def sf (j : ℕ) : finset (vector (fin q) n) := finset.univ.filter (λ f, (f.nat_sum = j))

parameter {n}

lemma mem_sf {j} {v : vector (fin q) n} (h : v.nat_sum = j) : v ∈ sf j :=
finset.mem_filter.2 ⟨finset.mem_univ _, h⟩

lemma sf_sum {j : ℕ} {f : vector (fin q) n} (h : f ∈ sf j) : f.nat_sum = j :=
(finset.mem_filter.1 h).2

lemma sf_disjoint {j1 j2 : ℕ} (h : j1 ≠ j2) : sf j1 ∩ sf j2 = ∅ :=
finset.eq_empty_of_forall_not_mem $ λ x hx, h $ by simp at hx; rw [←sf_sum hx.1, ←sf_sum hx.2]

def sf_lift_i (i : fin q) (sfj : finset (vector (fin q) n)) : finset (vector (fin q) (n+1)) :=
sfj.image $ vector.cons i

lemma sf_lift_i_sum {i : fin q} {j} {f} (hf : f ∈ sf_lift_i i (sf j)) : f.nat_sum = i.val + j :=
by rcases finset.mem_image.1 hf with ⟨_, hg, hfg⟩; simp [hfg.symm, sf_sum hg]

lemma sf_lift_i_card (i : fin q) (sfj : finset (vector (fin q) n)) :
  (sf_lift_i i sfj).card = sfj.card :=
finset.card_image_of_inj_on $ λ _ _ _ _, vector.cons_inj

lemma sf_lift_i_inter_empty  {i j : fin q} (h : i ≠ j) (s1 s2 : finset (vector (fin q) n)) :
  sf_lift_i i s1 ∩ sf_lift_i j s2 = ∅ :=
finset.eq_empty_of_forall_not_mem $ λ x hx,
  let ⟨hx1, hx2⟩ := finset.mem_inter.1 hx,
      ⟨a1, hm1, ha1⟩ := finset.mem_image.1 hx1,
      ⟨a2, hm2, ha2⟩ := finset.mem_image.1 hx2 in
  h $ vector.cons_inj_left $ by rwa ←ha2 at ha1

lemma mem_sf_lift_i (v) : v ∈ sf_lift_i (vector.head v) (sf (v.nat_sum - (vector.head v).val)) :=
finset.mem_image.2 $
  ⟨v.tail, mem_sf $ eq.symm $ nat.sub_eq_of_eq_add $ by rw [←vector.nat_sum_head_tail], by simp⟩

parameter (n)
def sf_lift (j : ℕ) : finset (vector (fin q) (n+1)) :=
finset.bind (iseg q j) (λ i, sf_lift_i i (sf (j - i)))

def cf (j : ℕ) : ℕ := (sf j).card
parameter {n}

lemma sf_sum_mem_lift {j : ℕ} {f : vector (fin q) (n+1)} (h : f ∈ sf_lift j) : f.nat_sum = j :=
begin
  simp [sf_lift, sf_lift_i] at h,
  rcases h with ⟨k, ⟨hk, g, hg, hfg⟩⟩,
  suffices : k.val + (j - k.val) = j, {simpa [hfg.symm, sf_sum hg]},
  rw [nat.add_comm, nat.sub_add_cancel],
  apply val_le_right_of_iseg hk
end

end cf_def

lemma head_le_of_mem_sf {j n : ℕ} : ∀ {v : vector (fin q) (n+1)} (h : v ∈ sf (n+1) j), v.head.val ≤ j
| p@⟨h::t,_⟩ hmem :=
  have hsum : _, from vector.nat_sum_head_tail p,
  by rw sf_sum hmem at hsum; linarith

lemma sf_lift_succ (n j : ℕ) : sf (n + 1) j = sf_lift n j :=
begin
  ext v, constructor,
  { intro hv,
    apply finset.mem_bind.2,
    use [v.head, mem_iseg_of_le (head_le_of_mem_sf hv)],
    rw ←sf_sum hv,
    apply mem_sf_lift_i },
  { intro hv, simp [sf_sum_mem_lift hv, sf] }
end

lemma sf_lift_card' (n j : ℕ) :
  (sf_lift n j).card = (iseg q j).sum (λ u, finset.card ((λ i, sf_lift_i i (sf n (j - ↑i))) u)) :=
finset.card_bind $ λ x hx y hy hxy, sf_lift_i_inter_empty hxy _ _

lemma sf_lift_card (n j : ℕ) : (sf_lift n j).card = (iseg q j).sum (λ u, cf n (j - u)) :=
by simp only [sf_lift_card', sf_lift_i_card, cf]

lemma cf_zero_zero (h : q > 0) : cf 0 0 = 1 :=
finset.card_eq_one.2 ⟨ vector.nil, finset.ext.2 $
  λ v, ⟨λ _, finset.mem_singleton.2 v.eq_nil, λ hv, mem_sf (by rw finset.mem_singleton.1 hv; simp)⟩ ⟩

lemma cf_zero_succ (j : ℕ) : cf 0 (j + 1) = 0 :=
finset.card_eq_zero.2 $ finset.eq_empty_of_forall_not_mem $ λ v hv, nat.succ_ne_zero j $ by simpa using sf_sum hv

lemma cf_one_lt {j : ℕ} (hj : j < q) : cf 1 j = 1 :=
begin
  have hfs : finset.univ.filter (λ f : vector (fin q) 1, f.nat_sum = j) = {⟨j, hj⟩::vector.nil},
  { ext v, simp, constructor,
    { rw vector.vec_one v,
      intro h,
      congr,
      rw fin.ext_iff,
      simpa using h },
    { intro hv, simp [hv] } },
  simp only [cf, sf, hfs], refl
end

lemma cf_one_ge {j : ℕ} (hj : j ≥ q) : cf 1 j = 0 :=
begin
  simp only [cf, sf],
  convert finset.card_empty,
  apply finset.eq_empty_of_forall_not_mem,
  intros x hx,
  cases finset.mem_filter.1 hx with _ hx,
  apply not_lt_of_ge hj,
  rw ←hx,
  apply vector.nat_sum_one
end

lemma cf_succ (n j : ℕ) : cf (n + 1) j = (iseg q j).sum (λ u, cf n (j - u)) :=
by rw [cf, sf_lift_succ, sf_lift_card]

lemma cf_mul (n j : ℕ) : (finset.range (j + 1)).sum (λ i, (cf 1 (j - i)) * cf (n + 1) i) = cf (n+2) j :=
have hfil : finset.range (j + 1) = (finset.range (j + 1)).filter (λ k, j - k < q) ∪ (finset.range _).filter _,
  from eq.symm (finset.filter_union_filter_neg_eq _),
begin
  rw [cf_succ, hfil, finset.sum_union],
  { have hgeq : ((finset.range (j + 1)).filter (λ k, ¬ j - k < q)).sum (λ i, cf 1 (j - i) * cf (n + 1) i) = 0,
    { apply finset.sum_eq_zero,
      intros k hk,
      simp [cf_one_ge (le_of_not_gt (finset.mem_filter.1 hk).2)] },
    rw [hgeq, add_zero],
    symmetry,
    apply finset.sum_bij (λ (a : fin q) _, j - a.val),
    { intros a ha,
      simp,
      refine ⟨nat.sub_lt_succ _ _, _⟩,
      rw nat.sub_sub_self (val_le_right_of_iseg ha),
      exact a.is_lt },
    { intros a ha,
      simp [nat.sub_sub_self (val_le_right_of_iseg ha), cf_one_lt a.is_lt], refl },
    { intros a a2 ha1 ha2 heq,
      apply (fin.ext_iff _ _).2,
      rwa ← nat.sub_eq_sub_iff; apply val_le_right_of_iseg; assumption },
    { intros b hb,
      simp at hb,
      use [⟨j-b, hb.2⟩, mem_iseg_of_le (nat.sub_le_self _ _)],
      simp [nat.sub_sub_self (nat.le_of_lt_succ hb.1)] } },
  { rw [finset.filter_not], simp }
end

def one_coeff_poly : polynomial ℕ :=
(finset.range q).sum (λ k, (polynomial.X : polynomial ℕ) ^ k)

lemma one_coeff_poly_coeff {n : ℕ} : one_coeff_poly.coeff n = if n < q then 1 else 0 :=
begin
  rw [one_coeff_poly],
  symmetry,
  have hlx : (λ k : ℕ, ((polynomial.X : polynomial ℕ) ^k).coeff n) = (λ k : ℕ, if n = k then 1 else 0),
  { ext k, rw [polynomial.coeff_X_pow k n] },
  have hfr : finset.range q = (finset.range q).filter (λ k, n = k) ∪ (finset.range q).filter (λ k, n ≠ k),
    from eq.symm (finset.filter_union_filter_neg_eq _),
  have hoeq : (finset.range q).sum (λ k, ((polynomial.X : polynomial ℕ)^k).coeff n) = if n < q then 1 else 0,
  { rw [hlx, hfr, finset.sum_union, ←add_zero (ite _ _ _)],
    { congr,
      { by_cases hnq : n < q,
        { have hs : (finset.range q).filter (λ k, n = k) = finset.singleton n,
          { ext a, simp, constructor,
            { rintros ⟨_, ha⟩, rw ha },
            { intro ha, rw ha, exact ⟨hnq, rfl⟩ } },
          simp [hs, hnq] },
        { simp [hnq],
          apply finset.sum_eq_zero,
          intros x hx,
          exfalso,
          apply hnq,
          rw (finset.mem_filter.1 hx).2,
          apply finset.mem_range.1 (finset.mem_filter.1 hx).1 } },
      { apply finset.sum_eq_zero,
        intros _ hx,
        simp [(finset.mem_filter.1 hx).2] } },
    { apply finset.eq_empty_of_forall_not_mem,
      intros x hx,
      cases finset.mem_inter.1 hx with hx1 hx2,
      cases finset.mem_filter.1 hx1 with _ hxn,
      cases finset.mem_filter.1 hx2 with _ hxn2,
      exact hxn2 hxn }},
  rw ←hoeq,
  apply finset.sum_hom (λ p, polynomial.coeff p n),
  apply_instance,
  convert is_add_monoid_hom.mk _,
  { convert is_add_hom.mk _,
    intros,
    apply polynomial.coeff_add },
  { apply polynomial.coeff_zero }
end

lemma one_coeff_poly_coeff_lt {n : ℕ} (h : n < q): one_coeff_poly.coeff n = 1 :=
have he : _ := @one_coeff_poly_coeff n,
have 1 = (if n < q then 1 else 0), by split_ifs; refl,
by rw this; exact he

lemma one_coeff_poly_coeff_ge {n : ℕ} (h : n ≥ q): one_coeff_poly.coeff n = 0 :=
have he : _ := @one_coeff_poly_coeff n,
have 0 = (if n < q then 1 else 0), by simp [not_lt_of_ge h],
by rw this; exact he

lemma one_coeff_poly_eval₂_nonneg {β} [linear_ordered_semiring β] {f : ℕ → β} (hf : ∀ z, f z ≥ 0) {b : β} (hb : b ≥ 0) :
  0 ≤ one_coeff_poly.eval₂ f b :=
finset.zero_le_sum $ λ x _, mul_nonneg (hf _) (pow_nonneg hb _)

theorem lemma_13_9 (hq : q > 0) : ∀ n j : ℕ, (one_coeff_poly ^ n).coeff j = cf n j
| 0 0 := by rw [pow_zero, polynomial.coeff_one, cf_zero_zero]; [refl, assumption]
| 0 (j+1) := by rw [pow_zero, polynomial.coeff_one, cf_zero_succ]; simp [show 0 ≠ j + 1, from (nat.succ_ne_zero _).symm]
| 1 j :=
  begin
    by_cases h : j < q,
    { rw [pow_one, cf_one_lt h, one_coeff_poly_coeff_lt h] },
    { rw [pow_one, cf_one_ge (le_of_not_gt h), one_coeff_poly_coeff_ge (le_of_not_gt h)] }
  end
| (n+2) j := calc
  (one_coeff_poly ^ (n + 2)).coeff j
      = (one_coeff_poly * one_coeff_poly ^ (n + 1)).coeff j : rfl
  ... = _ : polynomial.coeff_mul_right _ _ _
  ... = (finset.range (j + 1)).sum (λ i, one_coeff_poly.coeff (j - i) * cf (n + 1) i) : by congr; ext; rw lemma_13_9
  ... = (finset.range (j + 1)).sum (λ i, (one_coeff_poly ^ 1).coeff (j - i) * cf (n + 1) i) : by rw pow_one
  ... = (finset.range (j + 1)).sum (λ i, cf 1 (j - i) * cf (n + 1) i) : by congr; ext i; rw lemma_13_9
  ... = cf (n + 2) j : cf_mul _ _

parameter {q}
def vector_of_fin_fn : ∀ {n} (v : fin n → fin q), vector (fin q) n
| 0  v := vector.nil
| (n+1) v := v ⟨n, nat.lt_succ_self _⟩ :: vector_of_fin_fn (λ k : fin n, v ⟨k, nat.lt_succ_of_lt k.is_lt⟩)

lemma vector_of_fin_fn_nth : ∀ n (v : fin (n+1) → fin q) (i : fin (n+1)),
  (vector_of_fin_fn v).nth i = v ⟨n - i.val, nat.lt_succ_of_le (nat.sub_le_self _ _)⟩
| 0 v x :=
  have hx : x = ⟨0, zero_lt_one⟩, from (fin.ext_iff _ _).2 (nat.eq_zero_of_le_zero (nat.le_of_lt_succ x.is_lt)),
  by simp [vector_of_fin_fn, hx]; refl
| (n+1) v x :=
  begin
    rw [vector_of_fin_fn],
    by_cases hx : x.val = 0,
    { have hx' : x = 0, by simp [fin.ext_iff, hx, fin.val_zero],
      simp [hx', vector.nth_zero, fin.val_zero] },
    { have : x = fin.succ ⟨x.val - 1, _⟩,
      { apply fin.eq_of_veq,
        rw fin.succ_val,
        symmetry,
        apply nat.sub_add_cancel (nat.succ_le_of_lt (nat.pos_of_ne_zero hx)) },
      { rw [this, vector.nth_cons_succ, vector_of_fin_fn_nth],
        congr, simp, refl },
      { rw nat.sub_lt_right_iff_lt_add,
        apply x.is_lt,
        exact nat.succ_le_of_lt (nat.pos_of_ne_zero hx) }}
  end

def fin_fn_of_vector : ∀ {n} (v : vector (fin q) n), fin n → fin q
| 0 v i := fin_zero_elim i
| (n+1) v i := v.nth ⟨n - i.val, nat.lt_succ_of_le (nat.sub_le_self _ _)⟩

lemma vector_of_fin_fn_inv : ∀ {n} (v : vector (fin q) n), vector_of_fin_fn (fin_fn_of_vector v) = v
| 0 v := vector.ext $ λ k, fin_zero_elim k
| (k+1) v :=
  begin
    ext m,
    simp only [fin_fn_of_vector, vector_of_fin_fn_nth],
    congr,
    rw fin.ext_iff,
    apply nat.sub_sub_self,
    exact nat.le_of_lt_succ m.is_lt
  end

lemma sum_fin_fn_of_vector : ∀ {n} (v : vector (fin q) n), fin.sum (↑(fin_fn_of_vector v) : fin n → ℕ) = v.nat_sum
| 0 v := by simp [fin.sum_zero]
| (k+1) v :=
  begin
    rw [fin.sum_succ, vector.nat_sum_head_tail],
    congr,
    { simp [cast_fin_fn, fin_fn_of_vector], congr, apply vector.nth_zero },
    { convert sum_fin_fn_of_vector _,
      ext x,
      simp [cast_fin_fn, fin_fn_of_vector],
      cases k,
      { apply fin_zero_elim x },
      { rw [fin_fn_of_vector, vector.nth_tail],
        congr,
        rw nat.succ_sub; [refl, exact nat.le_of_lt_succ x.is_lt] } }
   end

lemma inv_in_range {d : ℚ} (hd : 0 ≤ d) {n} {v : vector (fin q) n}
  (hv : v ∈ (finset.range (int.nat_abs ⌊d⌋ + 1)).bind (sf n)) :
  ↑(fin.sum (↑(fin_fn_of_vector v) : fin n → ℕ)) ≤ d :=
begin
  rw sum_fin_fn_of_vector,
  simp [-add_comm] at hv,
  rcases hv with ⟨a, ha, ha2⟩,
  replace ha2 := sf_sum ha2,
  have : 0 ≤ ⌊d⌋ := le_floor.2 hd,
  calc (vector.nat_sum v : ℚ) ≤ int.nat_abs ⌊d⌋ :
      by rw ha2; exact nat.cast_le.2 (nat.succ_le_succ_iff.1 ha)
    ... = ((int.nat_abs ⌊d⌋ : ℤ) : ℚ) : by rw [← coe_coe]
    ... = _ : by rw [← int.eq_nat_abs_of_zero_le this]
    ... ≤ d : floor_le _
end

lemma nat_sum_vector_of_fin_fn : ∀ {n} (v : fin n → fin q), (vector_of_fin_fn v).nat_sum = fin.sum (↑v : fin n → ℕ)
| 0 v := by simp [vector_of_fin_fn, fin.sum_zero]
| (n+1) v := by simp [vector_of_fin_fn, nat_sum_vector_of_fin_fn, fin.sum_succ]; refl

lemma vector_of_fin_fn_mem_bind {n} {d : ℚ}
  {v : fin n → fin q} (hv : ↑(fin.sum (↑v : fin n → ℕ)) ≤ d) :
  vector_of_fin_fn v ∈ (finset.bind (finset.range (int.nat_abs ⌊d⌋ + 1)) (sf n)) :=
begin
  apply finset.mem_bind.2,
  use fin.sum (↑v : fin n → ℕ),
  split,
  { apply finset.mem_range.2,
    refine (nat.cast_lt.1 $ lt_of_le_of_lt hv _),
    rw [nat.cast_add, nat.cast_one],
    have hd : 0 ≤ ⌊d⌋ := le_floor.2 (le_trans (nat.cast_le.2 (nat.zero_le _)) hv),
    have : (int.nat_abs ⌊d⌋ : ℚ) = ((int.nat_abs ⌊d⌋ : ℤ) : ℚ), { rw ← coe_coe },
    rw [this, ← int.eq_nat_abs_of_zero_le hd],
    exact lt_floor_add_one d },
  { apply mem_sf,
    apply nat_sum_vector_of_fin_fn }
end

lemma vector_of_fin_fn_inj : ∀ {n} {v1 v2 : fin n → fin q}, vector_of_fin_fn v1 = vector_of_fin_fn v2 → v1 = v2
| 0 v1 v2 h := funext $ λ x, fin_zero_elim x
| (n+1) v1 v2 h := funext $ λ x,
  have (λ k : fin n, v1 ⟨k, nat.lt_succ_of_lt k.is_lt⟩) = (λ k : fin n, v2 ⟨k, nat.lt_succ_of_lt k.is_lt⟩),
    from vector_of_fin_fn_inj $ vector.cons_inj h,
  begin
    by_cases hx : x.val < n,
    { convert congr_fun this ⟨x.val, _⟩,
      repeat {simp [fin.ext_iff], refl },
      exact hx },
    { have hxn : x = ⟨n, nat.lt_succ_self _⟩, from fin.eq_of_veq (nat.eq_of_lt_succ_of_not_lt x.is_lt hx),
      rw hxn, apply vector.cons_inj_left h }
  end

end fix_q

noncomputable def crq (r : ℝ) (q : ℕ) := ((one_coeff_poly q).eval₂ coe r) / r ^ ((q-1 : ℝ)/3)

lemma one_coeff_poly_support (q : ℕ) : finsupp.support (one_coeff_poly q) = finset.range q :=
begin
  ext x,
  constructor,
  { intro hx,
    have : (one_coeff_poly q).coeff x ≠ 0, from finsupp.mem_support_iff.1 hx,
    rw finset.mem_range,
    apply lt_of_not_ge,
    exact mt (one_coeff_poly_coeff_ge _) this },
  { intro hx,
    rw finsupp.mem_support_iff,
    apply ne_of_gt,
    convert zero_lt_one,
    apply one_coeff_poly_coeff_lt,
    simpa using hx }
end

lemma one_coeff_poly_nat_degree {q : ℕ} (hq : q > 0) : (one_coeff_poly q).nat_degree = q - 1 :=
begin
  have hq : ∃ n, q = n + 1, from nat.exists_eq_succ_of_ne_zero (ne_of_gt hq),
  cases hq with n hn,
  rw [hn, polynomial.nat_degree, polynomial.degree, one_coeff_poly_support, finset.sup_range],
  simp [option.get_or_else]
end

lemma one_coeff_poly_pow_nat_degree {q : ℕ} (n : ℕ) (hq : q > 0) :
  ((one_coeff_poly q)^n).nat_degree = (q-1)*n :=
begin
  rw [polynomial.nat_degree_pow_eq', one_coeff_poly_nat_degree hq, mul_comm],
  apply ne_of_gt,
  apply pow_pos,
  rw [polynomial.leading_coeff, one_coeff_poly_nat_degree hq, one_coeff_poly_coeff_lt],
  { exact zero_lt_one },
  { apply nat.sub_lt hq zero_lt_one }
end

section
variables {α : Type} [discrete_field α] [fintype α] (n : ℕ)
local notation `m` := m α n
local notation `q` := @q α _ _

lemma q_ge_two : q ≥ 2 :=
finset.card_le_of_inj_on (λ n, if n = 0 then 0 else 1) (λ _ _, finset.mem_univ _) $ λ i j hi hj,
  begin
    split_ifs; simp *,
    have hi' : i = 1,
      from nat.eq_of_lt_succ_of_not_lt hi (not_lt_of_ge (nat.succ_le_of_lt (nat.pos_of_ne_zero h))),
    have hj' : j = 1,
      from nat.eq_of_lt_succ_of_not_lt hj (not_lt_of_ge (nat.succ_le_of_lt (nat.pos_of_ne_zero h_1))),
    rwa ←hj' at hi'
  end

theorem lemma_13_8 {d : ℚ} (hd : d ≥ 0) :
  m d = (finset.range (⌊d⌋.nat_abs + 1)).sum (cf q n) :=
begin
  have hbc : finset.card (finset.univ.filter (λ v : fin n → fin q, ↑(fin.sum (↑v : fin n → ℕ)) ≤ d)) = m d,
  { have h := h_B_card α n d,
    simp only [l125_A, l125_B, total_degree_monom] at h,
    convert h },
  have hse : finset.card (finset.univ.filter (λ v : fin n → fin q, ↑(fin.sum (↑v : fin n → ℕ)) ≤ d)) = finset.card (finset.bind (finset.range (⌊d⌋.nat_abs + 1)) (λ k, sf q n k)),
  { apply finset.card_congr (λ v _, vector_of_fin_fn v),
    { intros _ ha, exact vector_of_fin_fn_mem_bind (finset.mem_filter.1 ha).2 },
    { intros _ _ _ _ hv1v2, exact vector_of_fin_fn_inj hv1v2 },
    { dsimp, intros b hb,
      exact ⟨ fin_fn_of_vector b, finset.mem_filter.2 ⟨finset.mem_univ _, (inv_in_range hd hb)⟩,
              vector_of_fin_fn_inv _ ⟩ }},
  rw [←hbc, hse, finset.card_bind], refl,
  intros _ _ _ _, apply sf_disjoint
end

lemma int.cast_nat_abs {z : ℤ} (hz : 0 ≤ z) : (z.nat_abs : ℝ) = z :=
by norm_cast; exact int.nat_abs_of_nonneg hz

lemma one_coeff_poly_pow_eval₂_nonneg {r : ℝ} (hr : 0 ≤ r) (k) : 0 ≤ polynomial.eval₂ coe r (one_coeff_poly k ^ n) :=
begin
  rw polynomial.eval₂_pow,
  apply pow_nonneg,
  apply one_coeff_poly_eval₂_nonneg,
  { exact nat.cast_nonneg },
  { assumption }
end

lemma finset_sum_range {r : ℝ} (hr : 0 < r) (hr2 : r < 1) :
  (finset.range ((q - 1) * n + 1)).sum (λ (j : ℕ), r ^ j * ↑(cf q n j)) =
     ((one_coeff_poly q) ^ n).eval₂ coe r :=
begin
  convert polynomial.poly_eq_deg_sum _ _ _,
  { rw one_coeff_poly_pow_nat_degree _ q_pos },
  { ext, rw [lemma_13_9, mul_comm], exact q_pos },
  { simp }
end

theorem theorem_14_1 {r : ℝ} (hr : 0 < r) (hr2 : r < 1) : ↑(m (((q : ℚ)- 1)*n / 3)) ≤ (crq r q) ^ n :=
let e := ⌊((q - 1 : ℝ))*n / 3⌋.nat_abs in
have hpos : ((q - 1 : ℝ))*n / 3 ≥ 0, from div_nonneg (mul_nonneg (sub_nonneg_of_le (by exact_mod_cast one_le_q)) (nat.cast_nonneg _)) (by norm_num),
have r^e * m (((q : ℚ)- 1)*n / 3) = (finset.range (e+1)).sum (λ j, r^e * cf q n j),
begin
  rw [lemma_13_8, ←finset.sum_hom coe, finset.mul_sum],
  { congr' 2, dsimp [e], congr' 2, rw ←@rat.cast_floor ℝ _ _ (((q : ℚ) + -1) * n /3), simp },
  { apply_instance },
  { assumption_mod_cast }
end,
have hmr : ∀ x, x ∈ finset.range (e + 1) → x < (q-1)*n + 1, from λ x hx,
begin
  dsimp only [e] at hx,
  have hx' := finset.mem_range.1 hx,
  apply lt_of_lt_of_le hx',
  apply nat.succ_le_succ,
  suffices : (int.nat_abs ⌊((q : ℝ) -1)*n / 3⌋ : ℝ) ≤ ↑((q-1)*n), from nat.cast_le.1 this,
  rw int.cast_nat_abs,
  { apply le_trans,
    { apply floor_le },
    { apply (div_le_iff _).2,
      convert le_mul_of_ge_one_right _ _,
      { simp [one_le_q], },
      { apply mul_nonneg,
        { apply sub_nonneg_of_le, exact_mod_cast one_le_q },
        { apply nat.cast_nonneg } },
      repeat { norm_num } } },
  rw floor_nonneg,
  exact hpos
end,
have r^e * m (((q : ℚ)- 1)*n / 3) ≤ ((one_coeff_poly q)^n).eval₂ coe r, from calc
     _ = (finset.range (e+1)).sum (λ j, r^e * cf q n j) : this
   ... ≤ (finset.range (e+1)).sum (λ j, r^j * cf q n j) : finset.sum_le_sum $ λ x hx,mul_le_mul_of_nonneg_right (pow_le_pow_of_le_one (le_of_lt hr) (le_of_lt hr2) (by linarith [finset.mem_range.1 hx])) (nat.cast_nonneg _)
   ... ≤  (finset.range ((q - 1) * n + 1)).sum (λ j, r^j * cf q n j) : finset.sum_le_sum_of_subset_of_nonneg (λ x hx, finset.mem_range.2 (hmr _ hx)) $
            λ x hx1 hx2, mul_nonneg (pow_nonneg (le_of_lt hr) _) (nat.cast_nonneg _)
   ... = ((one_coeff_poly q)^n).eval₂ coe r : finset_sum_range _ hr hr2,
calc _ ≤ ((one_coeff_poly q)^n).eval₂ coe r / r^e : (le_div_iff (pow_pos hr _)).2 (by convert this using 1; apply mul_comm)
   ... ≤ ((one_coeff_poly q)^n).eval₂ coe r / r^(((q - 1 : ℝ))*n / 3) : div_le_div_of_le_left
         (one_coeff_poly_pow_eval₂_nonneg _ (le_of_lt hr) _)
         (pow_pos hr _)
         (real.rpow_pos_of_pos hr _)
         begin rw ←real.rpow_nat_cast, apply real.rpow_le hr (le_of_lt hr2), dsimp [e], rw int.cast_nat_abs, apply floor_le, apply floor_nonneg.2 hpos end
   ... = ((one_coeff_poly q)^n).eval₂ coe r / (r^(((q - 1 : ℝ)) / 3))^n : begin rw [←real.rpow_nat_cast _ n, ←real.rpow_mul], {congr, ring}, {exact le_of_lt hr} end
   ... = ((one_coeff_poly q).eval₂ coe r / (r^(((q - 1 : ℝ)) / 3)))^n : begin rw [polynomial.eval₂_pow, ←div_pow], apply ne_of_gt, apply real.rpow_pos_of_pos hr end

end

lemma one_coeff_poly_eval_ge_one {r : ℝ} {q : ℕ} (hr : 0 ≤ r) (hq : 1 ≤ q) :
  1 ≤ (one_coeff_poly q).eval₂ coe r :=
begin
  cases nat.exists_eq_succ_of_ne_zero (ne_of_gt (lt_of_lt_of_le zero_lt_one hq)) with k hqk,
  rw [hqk, polynomial.eval₂, finsupp.sum, one_coeff_poly_support, finset.sum_range_succ', pow_zero, mul_one],
  change 1 ≤ _ + (↑((one_coeff_poly (k+1)).coeff 0) : ℝ),
  rw [one_coeff_poly_coeff_lt (k+1) (nat.succ_pos _)],
  convert (le_add_iff_nonneg_left _).2 _,
  { simp },
  { apply finset.zero_le_sum,
    intros x hx,
    apply mul_nonneg,
    { convert zero_le_one,
      show ((one_coeff_poly (k+1)).coeff (x+1) : ℝ) = 1,
      rw [one_coeff_poly_coeff_lt]; simp,
      simpa using hx },
    { apply pow_nonneg,
      exact hr } }
end

lemma crq_ge_one {r : ℝ} {q : ℕ} (hr : 0 < r) (hr2 : r ≤ 1) (hq : 1 ≤ q) : 1 ≤ crq r q :=
begin
  rw [crq, le_div_iff, one_mul],
  { transitivity (1 : ℝ),
    { apply real.rpow_le_one _ (le_of_lt hr) hr2,
      apply div_nonneg,
      { apply sub_nonneg_of_le,
        suffices : ((1 : ℕ) : ℝ) ≤ q, by simpa using this,
        exact nat.cast_le.2 hq },
        { norm_num } },
    { apply one_coeff_poly_eval_ge_one (le_of_lt hr) hq } },
  { apply real.rpow_pos_of_pos hr }
end

lemma crq_eq (r : ℝ) (q : ℕ) :
  crq r q = (finset.range q).sum (λi:ℕ, r ^ i) / r ^ ((q - 1 : ℝ) / 3) :=
begin
  rw [crq, one_coeff_poly, ← finset.sum_hom (polynomial.eval₂ (coe : ℕ → ℝ) r)],
  congr' 2, funext i,
  rw [polynomial.eval₂_pow, polynomial.eval₂_X]
end

theorem lemma_13_15 {q : ℕ} (hq : 2 ≤ q) : ∃ r : ℝ, 0 < r ∧ r < 1 ∧ crq r q < q :=
begin
  have q_pos : 0 < q := le_trans dec_trivial hq,
  have q_eq : q = (q - 1) + 1 := (nat.sub_add_cancel $ le_trans dec_trivial hq).symm,
  have q_pred : ((q - 1 : ℕ) : ℝ) = (q : ℝ) - 1,
  { rw [q_eq] { occs := occurrences.pos [2] },
    rw [nat.cast_add, nat.cast_one, add_sub_cancel] },
  have sum_pow_one : (finset.range q).sum (pow 1 : ℕ → ℝ) = (finset.range q).sum (λi, (1 : ℝ)),
  { congr, funext i, rw one_pow },
  let f : ℝ → ℝ := λr, ((finset.range q).sum (λi, r ^ i)) ^ 3 - (q : ℝ)^3 * r^(q-1),
  let f' : ℝ → ℝ := λr,
    3 * (finset.range q).sum (λi, r ^ i) ^ 2 * (finset.range (q - 1)).sum (λi, (i + 1) * r ^ i) -
    (q : ℝ)^3 * (q - 1) * r^(q-2),
  have f1 : f 1 = 0,
  { simp only [f],
    rw [sum_pow_one, finset.sum_const, finset.card_range, add_monoid.smul_one, one_pow,
      mul_one, sub_self] },
  have f'1 : 0 < f' 1,
  { simp only [f'],
    rw [one_pow, sum_pow_one, finset.sum_const, finset.card_range, add_monoid.smul_one, mul_one],
    conv { find (finset.sum _ _) { congr, skip, funext, rw [one_pow, mul_one] } },
    have : ((2:ℕ) : ℝ) ≠ 0, { rw [(≠), nat.cast_eq_zero], exact dec_trivial },
    rw [finset.sum_add_distrib, finset.sum_const, finset.card_range, add_monoid.smul_one,
      add_comm, ← finset.sum_range_succ, ← finset.sum_nat_cast, ← nat.add_one, ← q_eq,
      ← mul_div_cancel (coe (finset.sum _ _ : ℕ) : ℝ) this, ← nat.cast_mul,
      finset.sum_range_id_mul_two, nat.cast_mul, mul_assoc, ← mul_div_assoc, mul_div_comm,
      sub_pos, ← mul_assoc, ← mul_one (_ * _ : ℝ), ← pow_succ', q_pred],
    refine mul_lt_mul_of_pos_left _ _,
    { suffices : ((1 : ℕ) : ℝ) < (3 : ℕ) / (2 : ℕ),
      { simpa },
      rw [lt_div_iff, ← nat.cast_mul, nat.cast_lt],
      exact dec_trivial,
      rw [← nat.cast_zero, nat.cast_lt],
      exact dec_trivial },
    { refine mul_pos (pow_pos (nat.cast_pos.2 q_pos) _) (sub_pos.2 _),
      rw [← nat.cast_one, nat.cast_lt],
      exact hq } },
  have has_deriv_f_f' : ∀r, has_deriv f (f' r) r,
  { assume r,
    refine has_deriv.sub ((has_deriv.pow (has_deriv_finset_sum _ _) 3).congr₂ _) _,
    { exact λi:ℕ, i * r ^ (i - 1) },
    { congr' 1,
      { simp only
          [nat.succ_sub_succ_eq_sub, eq_self_iff_true, nat.cast_bit1, nat.sub_zero, nat.cast_one] },
      { rw [q_eq] { occs := occurrences.pos [1] },
        rw [finset.sum_range_succ'],
        simp only [add_zero, nat.succ_sub_succ_eq_sub, nat.zero_sub, nat.cast_zero, zero_mul,
          add_comm, eq_self_iff_true, (∘), nat.cast_succ, nat.sub_zero, pow_zero, zero_add] } },
    { refine assume n, (has_deriv.pow (has_deriv_id r) n).congr₂ _,
      rw mul_one },
    { rw mul_assoc,
      refine ((has_deriv.pow (has_deriv_id r) _).congr₂ _).mul_left _,
      rw [q_eq] { occs := occurrences.pos [3] },
      rw [nat.cast_add, nat.cast_one, add_sub_cancel, mul_one],
      refl } },
  rcases decreasing_of_fderiv_pos _ _ _ (has_deriv_f_f' 1) f'1 with ⟨ε, hε, h⟩,
  let ε' : ℝ := 1 - (min ε 1) / 2,
  have hε₁ : 1 - ε < ε',
  { refine (sub_lt_sub_iff_left _).2 (lt_of_le_of_lt (div_le_div_of_le_of_pos (min_le_left _ _) _) _);
      linarith },
  have hε₂ : ε' < 1,
  { refine (sub_lt_self _ $ div_pos (lt_min hε _) _);
      norm_num },
  have hε₃ : 0 < ε',
  { refine lt_sub.2 (lt_of_le_of_lt (div_le_div_of_le_of_pos (min_le_right _ _) _) _); norm_num },
  refine ⟨ε', hε₃, hε₂, _⟩,
  specialize h ε' hε₁ hε₂,
  rw f1 at h,
  simp only [f, sub_lt_iff_lt_add, zero_add] at h,
  rw [crq_eq, div_lt_iff],
  refine lt_of_pow_lt_pow 3 _ _,
  { exact zero_le_mul (nat.cast_nonneg _) (real.rpow_nonneg_of_nonneg (le_of_lt hε₃) _) },
  { have : ((3 : ℕ) : ℝ) = 3 := by norm_num,
    rwa [mul_pow, ← real.rpow_nat_cast (ε' ^ _), ← real.rpow_mul (le_of_lt hε₃), this,
      div_mul_cancel, ← q_pred, real.rpow_nat_cast],
    norm_num },
  { exact real.rpow_pos_of_pos hε₃ _ }
end

lemma coeff_ge_one {r : ℝ} (hr : 0 < r) (hr2 : r < 1) {q : ℕ} (hq : q ≥ 1) :
  ((3 * (crq r q)^2)/(1 - r)) ≥ 1 :=
have 1 ≤ crq r q^2, from one_le_pow_of_one_le (crq_ge_one hr (le_of_lt hr2) hq) _,
by apply (le_div_iff _).2; linarith

lemma finset.card_le_card_univ {α} [fintype α] [decidable_eq α] (A : finset α) : A.card ≤ (@finset.univ α _).card :=
finset.card_le_card_of_inj_on id (λ _ _, finset.mem_univ _) $ by simp

section
set_option class.instance_max_depth 200
variables {α : Type} [discrete_field α] [fintype α] {n : ℕ} {a b c : α} (hc : c ≠ 0)
    (habc : a + b + c = 0) {A : finset (fin n → α)}
    (hall : ∀ x y z : fin n → α, x ∈ A → y ∈ A → z ∈ A → a • x + b • y + c • z = 0 → x = y ∧ x = z)
include hc habc hall
local notation `q` := @q α _ _

theorem theorem_13_14 {r : ℝ} (hr : 0 < r) (hr2 : r < 1) : ↑A.card ≤ 3 * (crq r q)^n :=
if hn : n = 0 then
   have hcu : (@finset.univ (fin n → α) _).card = 1,
    by { convert finset.card_univ, rw hn, refl },
  have hac : A.card ≤ 1, by { convert finset.card_le_card_univ _, {exact eq.symm hcu}, {apply_instance}},
  have hac : (A.card : ℝ) ≤ 1, from suffices (A.card : ℝ) ≤ (1 : ℕ), by simpa, nat.cast_le.2 hac,
  le_trans hac (by rw [hn, pow_zero, mul_one]; norm_num)
else have hn : n > 0, from nat.pos_of_ne_zero hn,
begin
  transitivity,
  { apply nat.cast_le.2,
    apply theorem_12_1 n hc habc hn hall },
  { rw nat.cast_mul,
    convert mul_le_mul_of_nonneg_left _ _,
    { norm_cast },
    { rw [mul_comm, ←div_eq_mul_one_div],
      apply theorem_14_1; assumption },
    { norm_num } }
end

end

section
set_option class.instance_max_depth 200

theorem general_cap_set {α : Type} [discrete_field α] [fintype α] :
  ∃ C B : ℝ, B > 0 ∧ C > 0 ∧
  C < fintype.card α ∧ ∀ {a b c : α} {n : ℕ} {A : finset (fin n → α)},
   c ≠ 0 → a + b + c = 0 →
   (∀ x y z : fin n → α, x ∈ A → y ∈ A → z ∈ A → a • x + b • y + c • z = 0 → x = y ∧ x = z) →
    ↑A.card ≤ B * C^n :=
begin
  rcases lemma_13_15 q_ge_two with ⟨B, hB, hB2, hBr⟩,
  repeat {apply exists.intro},
  refine ⟨_, _, hBr, λ a b c n A hc habc hall, theorem_13_14 hc habc hall hB hB2⟩,
  { norm_num },
  { apply lt_of_lt_of_le zero_lt_one,
    exact crq_ge_one hB (le_of_lt hB2) one_le_q }
end
end

lemma one_coeff_poly_real_eval_aux (x : ℝ) :
  (one_coeff_poly 3).eval₂ coe x = (((1 : ℕ) : ℝ) * (1 : ℝ))  + ( (((1 : ℕ) : ℝ) * (x * (1 : ℝ))) + ((((1 : ℕ) : ℝ) * (x * (x * (1 : ℝ)))) + (0 : ℝ) )  ) :=
rfl

lemma one_coeff_poly_real_eval (x : ℝ) : (one_coeff_poly 3).eval₂ coe x = 1 + x + x^2 :=
by convert one_coeff_poly_real_eval_aux x using 1; simp [pow_two]

lemma calc_lemma (r a : ℝ) (hr : r = (a - 1)/8) :
  (3 / 8) ^ 3 * (207 + 33 * (8 * r + 1)) * r ^ 2 - (1 + r + r ^ 2) ^ 3 =
  -(140481/262144) - (70389*a)/131072 + (14553*a^2)/262144 + (1215*a^3)/65536
   - (279*a^4)/262144 - (9*a^5)/131072 - a^6/262144 :=
by rw hr; ring

noncomputable def r : ℝ := (real.sqrt 33 - 1) / 8

lemma r_pos : r > 0 :=
div_pos (sub_pos_of_lt (lt_of_pow_lt_pow _ (real.sqrt_nonneg _)
  (show (1 : ℝ) ^ 2 < (real.sqrt 33)^2, by rw [real.sqr_sqrt, one_pow]; norm_num))) (by norm_num)

lemma r_lt_one : r < 1 :=
begin
  apply (div_lt_iff _).2,
  apply sub_lt_iff_lt_add.2,
  apply @lt_of_pow_lt_pow _ _ _ _ 2 _,
  rw real.sqr_sqrt,
  all_goals {norm_num}
end

lemma r_def : real.sqrt 33 = 8*r + 1 :=
by rw [r, mul_div_cancel', sub_add_cancel]; norm_num

lemma c_r_cubed : (crq r 3)^3 = ((3 : ℝ) / 8)^3 * (207 + 33*real.sqrt 33) :=
begin
  rw [crq, one_coeff_poly_real_eval, div_pow],
  conv {to_lhs, congr, skip, rw [←real.rpow_nat_cast _ 3, ←real.rpow_mul (le_of_lt r_pos)], simp, norm_num},
  symmetry, apply eq_div_of_mul_eq,
  { apply ne_of_gt,
    apply real.rpow_pos_of_pos,
    exact r_pos },
  { rw [r_def],
    apply eq_of_sub_eq_zero,
    have hr2 : r^(2 : ℝ) = r^((2 : ℕ) : ℝ), by simp,
    rw [hr2, real.rpow_nat_cast, calc_lemma r _ rfl],
    change 6 with 2+2+2, change 5 with 2+2+1, change 4 with 2 + 2, change 3 with 2+1,
    simp only [pow_add, pow_one, real.sqr_sqrt (show (0:ℝ) ≤ 33, by norm_num)],
    ring },
  { apply ne_of_gt,
    apply real.rpow_pos_of_pos,
    exact r_pos }
end

lemma c_r_cuberoot : crq r 3 = (((3 : ℝ) / 8)^3 * (207 + 33*real.sqrt 33))^(1/3 : ℝ) :=
have h : _ := congr_arg (λ r : ℝ, r^(1/3:ℝ)) c_r_cubed,
begin
  rw [←real.rpow_nat_cast _ 3, ←real.rpow_mul] at h,
  { simp at h,
    rw [mul_inv_cancel] at h,
    { simpa using h },
    { norm_num } },
  { linarith [crq_ge_one r_pos (le_of_lt r_lt_one) (show 1 ≤ 3, by norm_num)] }
end

section
set_option class.instance_max_depth 200

theorem theorem_13_17 {α : Type} [discrete_field α] [fintype α] {a b c : α}
  (hq : fintype.card α = 3) (hc : c ≠ 0) (habc : a + b + c = 0) :
  ∃ B : ℝ, ∀ {n : ℕ} {A : finset (fin n → α)},
  (∀ x y z : fin n → α, x ∈ A → y ∈ A → z ∈ A → a • x + b • y + c • z = 0 → x = y ∧ x = z) →
  ↑A.card ≤ B * ((((3 : ℝ) / 8)^3 * (207 + 33*real.sqrt 33))^(1/3 : ℝ))^n :=
begin
  apply exists.intro,
  intros n A ha,
  convert theorem_13_14 hc habc ha r_pos r_lt_one,
  rw [q, hq, c_r_cuberoot]
end

end

section
private lemma three_prime : nat.prime 3 := by norm_num
local notation `ℤ/3ℤ` := zmodp 3 three_prime

set_option class.instance_max_depth 100

theorem cap_set_problem : ∃ B : ℝ, ∀ {n : ℕ} {A : finset (fin n → ℤ/3ℤ)},
  (∀ x y z : fin n → ℤ/3ℤ, x ∈ A → y ∈ A → z ∈ A → x + y + z = 0 → x = y ∧ x = z) →
  ↑A.card ≤ B * ((((3 : ℝ) / 8)^3 * (207 + 33*real.sqrt 33))^(1/3 : ℝ))^n :=
begin
  have habc : (1 : ℤ/3ℤ) + 1 + 1 = 0, from rfl,
  have hcard : fintype.card ℤ/3ℤ = 3, from zmodp.card_zmodp three_prime,
  have hone : (1 : ℤ/3ℤ) ≠ 0, from dec_trivial,
  cases theorem_13_17 hcard hone habc with B hB,
  use B,
  intros n A hxyz,
  apply hB,
  simpa using hxyz
end

theorem cap_set_problem_specific (n : ℕ) {A : finset (fin n → ℤ/3ℤ)}
  (hxyz : ∀ x y z : fin n → ℤ/3ℤ, x ∈ A → y ∈ A → z ∈ A → x + y + z = 0 → x = y ∧ x = z) :
  ↑A.card ≤ 3 * ((((3 : ℝ) / 8)^3 * (207 + 33*real.sqrt 33))^(1/3 : ℝ))^n :=
have hone : (1 : ℤ/3ℤ) ≠ 0, from dec_trivial,
have hq : @q (ℤ/3ℤ) _ _ = 3, from zmodp.card_zmodp three_prime,
begin
  transitivity,
  { convert theorem_13_14 hone _ _ r_pos r_lt_one,
    repeat {exact 1},
    { refl },
    { simpa using hxyz } },
  rw hq,
  convert mul_le_mul_of_nonneg_right _ _,
  { symmetry, exact c_r_cuberoot },
  { refl },
  { apply pow_nonneg,
    apply le_trans zero_le_one,
    apply crq_ge_one r_pos (le_of_lt r_lt_one),
    norm_num }
end

end


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import uniq.inverse
import .basic .use

universe u
variables {σ : Type u} {sig : σ → ℕ} {α : Type*} {β : Type*} {γ : Type*}
include sig

structure hom (a : alg sig α) (b : alg sig β) (f : α → β) : Prop :=
(app : ∀ (s : σ) (xs : α ^ (sig s)), f (a.app s xs) = b.app s (tup.map f xs))

section
variables {a : alg sig α} {b : alg sig β} {c : alg sig γ}

lemma hom_app {f : α → β} (hf : hom a b f) :
∀ (s : σ) {xs : α ^ (sig s)}, f (a.app s xs) = b.app s (tup.map f xs) := hf.app

lemma hom_eval {f : α → β} (hf : hom a b f) :
∀ (t : term sig) (val : ℕ → α), f (eval a val t) = eval b (λ n, f (val n)) t
| (term.var n) val := rfl
| (term.app s ts) val :=
  let fval := λ n, f (val n) in
  have tup.map f (tup.map (eval a val) ts) = tup.map (eval b fval) ts,
  from tup.ext (λ i, hom_eval (ts i) val),
  calc
  f (eval a val (term.app s ts))
      = f (a.app s (tup.map (eval a val) ts))         : by rw eval_app
  ... = b.app s (tup.map f (tup.map (eval a val) ts)) : by rw hom_app hf
  ... = b.app s (tup.map (eval b fval) ts)            : by rw this
  ... = eval b fval (term.app s ts)                   : by rw eval_app

lemma hom_eval_use {f : α → β} (hf : hom a b f) (t : term sig) (val : α ^ (use t)) :
f (eval_use a t val) = eval_use b t (tup.map f val) :=
let x := eval_use a t val in
let val' := tup.extend val (eval_use a t val) in
have tup.bar (λ n, f (val' n)) (use t) = tup.map f val,
from tup.ext (λ ⟨i,hi⟩,
  calc
  (tup.bar (λ n, f (val' n)) (use t))[⟨i,hi⟩]
      = f (tup.extend val (eval_use a t val) i) : by rw tup.bar_val
  ... = f (val[⟨i,hi⟩]) : by rw tup.extend_of_lt hi
  ... = (tup.map f val)[⟨i,hi⟩] : rfl),
calc
f (eval_use a t val)
    = f (eval_use a t (tup.bar val' (use t))) : by rw tup.bar_extend
... = f (eval a val' t) : by rw eval_use_eq_eval
... = eval b (λ n, f (val' n)) t : by rw hom_eval hf
... = eval_use b t (tup.bar (λ n, f (val' n)) (use t)) : by rw eval_use_eq_eval
... = eval_use b t (tup.map f val) : by rw this

lemma hom_comp {g : β → γ} {f : α → β} (hg : hom b c g) (hf : hom a b f) :
hom a c (g ∘ f) := {app := λ s xs, by simp [hf.app, hg.app]}

lemma hom_inverse {g : β → α} {f : α → β} (hf : hom a b f) (h : function.inverse g f) :
hom b a g :=
{ app := λ s xs,
  have hl : function.left_inverse g f, from function.left_inverse_of_inverse h,
  have hr : function.right_inverse g f, from function.right_inverse_of_inverse h,
  calc
  g (b.app s xs)
      = g (b.app s (tup.map id xs))            : rfl
  ... = g (b.app s (tup.map (f ∘ g) xs))       : by rw function.id_of_right_inverse hr
  ... = g (b.app s (tup.map f (tup.map g xs))) : by rw tup.map_map
  ... = g (f (a.app s (tup.map g xs)))         : by rw hf.app
  ... = a.app s (tup.map g xs)                 : by rw hl
}

lemma hom_sat_injective {f : α → β} (hf : hom a b f) (hi : function.injective f) :
∀ (e : eqn sig), (b ⊧ e) → (a ⊧ e) :=
λ e hb val, let val' := λ n, f (val n) in hi $
calc
f (eval a val e.fst)
    = eval b val' e.fst  : by rw hom_eval hf
... = eval b val' e.snd    : by rw hb
... = f (eval a val e.snd) : by rw hom_eval hf

lemma hom_sat_use_surjective {f : α → β} (hf : hom a b f) (hs : function.surjective f) :
∀ (e : eqn sig), (sat_use a e) → (sat_use b e) :=
λ e ha val, let m := max (use e.fst) (use e.snd) in
have ∃ (val' : α ^ m), ∀ (i : fin m), f val'[i] = val[i],
from tup.choice (λ i, hs val[i]),
exists.elim this $ λ val' hv,
have tup.map f val' = val, from tup.ext hv,
calc
eval_use_of_le b val (e.fst) (le_max_left _ _)
    = eval_use_of_le b (tup.map f val') (e.fst) (le_max_left _ _) : by rw this
... = f (eval_use_of_le a val' e.fst (le_max_left _ _)) : by rw hom_eval_use hf
... = f (eval_use_of_le a val' e.snd (le_max_right _ _)) : by rw ha
... = eval_use_of_le b (tup.map f val') e.snd (le_max_right _ _) : by rw hom_eval_use hf
... = eval_use_of_le b val (e.snd) (le_max_right _ _) : by rw this

lemma hom_sat_surjective {f : α → β} (hf : hom a b f) (hs : function.surjective f) :
∀ (e : eqn sig), (a ⊧ e) → (b ⊧ e) :=
λ e ha, sat_iff_sat_use.mpr (hom_sat_use_surjective hf hs e (sat_iff_sat_use.mp ha))

lemma hom_sat_bijective {f : α → β} (hf : hom a b f) (h : function.bijective f) :
∀ (e : eqn sig), (a ⊧ e) ↔ (b ⊧ e) :=
λ e, ⟨hom_sat_surjective hf h.right e, hom_sat_injective hf h.left e⟩

end


import Mathlib.Tactic.TFAE

open List

section zeroOne

example : TFAE []  := by tfae_finish
example : TFAE [P] := by tfae_finish

end zeroOne

namespace two

axiom P : Prop
axiom Q : Prop
axiom pq : P → Q
axiom qp : Q → P

example : TFAE [P, Q] := by
  tfae_have 1 → 2
  { exact pq }
  tfae_have 2 → 1
  { exact qp }
  tfae_finish

example : TFAE [P, Q] := by
  tfae_have 1 ↔ 2
  { exact Iff.intro pq qp }
  tfae_finish

example : TFAE [P, Q] := by
  tfae_have 2 ← 1
  { exact pq }
  tfae_have 1 ← 2
  { exact qp }
  tfae_finish

end two

namespace three

axiom P : Prop
axiom Q : Prop
axiom R : Prop
axiom pq : P → Q
axiom qr : Q → R
axiom rp : R → P

example : TFAE [P, Q, R] := by
  tfae_have 1 → 2
  { exact pq }
  tfae_have 2 → 3
  { exact qr }
  tfae_have 3 → 1
  { exact rp }
  tfae_finish

example : TFAE [P, Q, R] := by
  tfae_have 1 ↔ 2
  { exact Iff.intro pq (rp ∘ qr) }
  tfae_have 3 ↔ 2
  { exact Iff.intro (pq ∘ rp) qr }
  tfae_finish

example : TFAE [P, Q, R] := by
  tfae_have 1 → 2
  { exact pq }
  tfae_have 2 → 1
  { exact rp ∘ qr }
  tfae_have 2 ↔ 3
  { exact Iff.intro qr (pq ∘ rp) }
  tfae_finish

end three

section context

example (h₁ : P → Q) (h₂ : Q → P) : TFAE [P, Q] := by
  tfae_finish

end context


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module data.rbtree.find
! leanprover-community/mathlib commit 8f6fd1b69096c6a587f745d354306c0d46396915
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Rbtree.Basic

universe u

namespace Rbnode

variable {α : Type u}

@[elab_without_expected_type]
theorem find.induction {p : Rbnode α → Prop} (lt) [DecidableRel lt] (t x) (h₁ : p leaf)
    (h₂ : ∀ (l y r) (h : cmpUsing lt x y = Ordering.lt) (ih : p l), p (red_node l y r))
    (h₃ : ∀ (l y r) (h : cmpUsing lt x y = Ordering.eq), p (red_node l y r))
    (h₄ : ∀ (l y r) (h : cmpUsing lt x y = Ordering.gt) (ih : p r), p (red_node l y r))
    (h₅ : ∀ (l y r) (h : cmpUsing lt x y = Ordering.lt) (ih : p l), p (black_node l y r))
    (h₆ : ∀ (l y r) (h : cmpUsing lt x y = Ordering.eq), p (black_node l y r))
    (h₇ : ∀ (l y r) (h : cmpUsing lt x y = Ordering.gt) (ih : p r), p (black_node l y r)) : p t :=
  by
  induction t
  case leaf => assumption
  case red_node l y r =>
    cases h : cmpUsing lt x y
    case lt => apply h₂; assumption; assumption
    case eq => apply h₃; assumption
    case gt => apply h₄; assumption; assumption
  case black_node l y r =>
    cases h : cmpUsing lt x y
    case lt => apply h₅; assumption; assumption
    case eq => apply h₆; assumption
    case gt => apply h₇; assumption; assumption
#align rbnode.find.induction Rbnode.find.induction

theorem find_correct {t : Rbnode α} {lt x} [DecidableRel lt] [IsStrictWeakOrder α lt] :
    ∀ {lo hi} (hs : IsSearchable lt t lo hi), Mem lt x t ↔ ∃ y, find lt t x = some y ∧ x ≈[lt]y :=
  by
  apply find.induction lt t x <;> intros <;> simp only [mem, find, *]
  · simp
  iterate 2

    -- red and black cases are identical
    · cases hs
      apply Iff.intro
      · intro hm
        cases_type*or.1
        · exact Iff.mp (ih hs_hs₁) hm
        · simp at h
          cases hm
          contradiction
        · have hyx : lift lt (some y) (some x) := (range hs_hs₂ hm).1
          simp [lift] at hyx
          have hxy : lt x y := by
            simp [cmpUsing] at h
            assumption
          exact absurd (trans_of lt hxy hyx) (irrefl_of lt x)
      · intro hc
        left
        exact Iff.mpr (ih hs_hs₁) hc
    · simp at h
      simp [h, StrictWeakOrder.Equiv]
    · cases hs
      apply Iff.intro
      · intro hm
        cases_type*or.1
        · have hxy : lift lt (some x) (some y) := (range hs_hs₁ hm).2
          simp [lift] at hxy
          have hyx : lt y x := by
            simp [cmpUsing] at h
            exact h.2
          exact absurd (trans_of lt hxy hyx) (irrefl_of lt x)
        · simp at h
          cases hm
          contradiction
        · exact Iff.mp (ih hs_hs₂) hm
      · intro hc
        right
        right
        exact Iff.mpr (ih hs_hs₂) hc
#align rbnode.find_correct Rbnode.find_correct

theorem mem_of_memExact {lt} [IsIrrefl α lt] {x t} : MemExact x t → Mem lt x t :=
  by
  induction t <;> simp [mem_exact, mem, false_imp_iff] <;> intro h
  all_goals
    cases_type*or.1; simp [t_ih_lchild h]; simp [h, irrefl_of lt t_val]
    simp [t_ih_rchild h]
#align rbnode.mem_of_mem_exact Rbnode.mem_of_memExact

theorem find_correct_exact {t : Rbnode α} {lt x} [DecidableRel lt] [IsStrictWeakOrder α lt] :
    ∀ {lo hi} (hs : IsSearchable lt t lo hi), MemExact x t ↔ find lt t x = some x :=
  by
  apply find.induction lt t x <;> intros <;> simp only [mem_exact, find, *]
  iterate 2

    · cases hs
      apply Iff.intro
      · intro hm
        cases_type*or.1
        · exact Iff.mp (ih hs_hs₁) hm
        · simp at h
          subst x
          exact absurd h (irrefl y)
        · have hyx : lift lt (some y) (some x) := (range hs_hs₂ (mem_of_mem_exact hm)).1
          simp [lift] at hyx
          have hxy : lt x y := by
            simp [cmpUsing] at h
            assumption
          exact absurd (trans_of lt hxy hyx) (irrefl_of lt x)
      · intro hc
        left
        exact Iff.mpr (ih hs_hs₁) hc
    · simp at h
      cases hs
      apply Iff.intro
      · intro hm
        cases_type*or.1
        · have hxy : lift lt (some x) (some y) := (range hs_hs₁ (mem_of_mem_exact hm)).2
          simp [lift] at hxy
          exact absurd hxy h.1
        · subst hm
        · have hyx : lift lt (some y) (some x) := (range hs_hs₂ (mem_of_mem_exact hm)).1
          simp [lift] at hyx
          exact absurd hyx h.2
      · intro hm
        simp [*]
    · cases hs
      apply Iff.intro
      · intro hm
        cases_type*or.1
        · have hxy : lift lt (some x) (some y) := (range hs_hs₁ (mem_of_mem_exact hm)).2
          simp [lift] at hxy
          have hyx : lt y x := by
            simp [cmpUsing] at h
            exact h.2
          exact absurd (trans_of lt hxy hyx) (irrefl_of lt x)
        · simp at h
          subst x
          exact absurd h (irrefl y)
        · exact Iff.mp (ih hs_hs₂) hm
      · intro hc
        right
        right
        exact Iff.mpr (ih hs_hs₂) hc
#align rbnode.find_correct_exact Rbnode.find_correct_exact

theorem eqv_of_find_some {t : Rbnode α} {lt x y} [DecidableRel lt] :
    ∀ {lo hi} (hs : IsSearchable lt t lo hi) (he : find lt t x = some y), x ≈[lt]y :=
  by
  apply find.induction lt t x <;> intros <;> simp_all only [mem, find]
  iterate 2

    · cases hs
      exact ih hs_hs₁ rfl
    · subst y
      simp at h
      exact h
    · cases hs
      exact ih hs_hs₂ rfl
#align rbnode.eqv_of_find_some Rbnode.eqv_of_find_some

theorem find_eq_find_of_eqv {lt a b} [DecidableRel lt] [IsStrictWeakOrder α lt] {t : Rbnode α} :
    ∀ {lo hi} (hs : IsSearchable lt t lo hi) (heqv : a ≈[lt]b), find lt t a = find lt t b :=
  by
  apply find.induction lt t a <;> intros <;>
    simp_all [mem, find, StrictWeakOrder.Equiv, true_imp_iff]
  iterate 2

    · have : lt b y := lt_of_incomp_of_lt heqv.swap h
      simp [cmpUsing, find, *]
      cases hs
      apply ih hs_hs₁
    · have := incomp_trans_of lt heqv.swap h
      simp [cmpUsing, find, *]
    · have := lt_of_lt_of_incomp h heqv
      have := not_lt_of_lt this
      simp [cmpUsing, find, *]
      cases hs
      apply ih hs_hs₂
#align rbnode.find_eq_find_of_eqv Rbnode.find_eq_find_of_eqv

end Rbnode