/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.monoidal.braided
import category_theory.monoidal.Mon_

/-!
# The category of commutative monoids in a braided monoidal category.
-/

universes v₁ v₂ u₁ u₂ u

open category_theory
open category_theory.monoidal_category

variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C] [braided_category.{v₁} C]

/--
A commutative monoid object internal to a monoidal category.
-/
structure CommMon_ extends Mon_ C :=
(mul_comm' : (β_ _ _).hom ≫ mul = mul . obviously)

restate_axiom CommMon_.mul_comm'
attribute [simp, reassoc] CommMon_.mul_comm

namespace CommMon_

/--
The trivial commutative monoid object. We later show this is initial in `CommMon_ C`.
-/
@[simps]
def trivial : CommMon_ C :=
{ mul_comm' := begin dsimp, rw [braiding_left_unitor, unitors_equal], end
  ..Mon_.trivial C }

instance : inhabited (CommMon_ C) := ⟨trivial C⟩

variables {C} {M : CommMon_ C}

instance : category (CommMon_ C) :=
induced_category.category CommMon_.to_Mon_

@[simp] lemma id_hom (A : CommMon_ C) : Mon_.hom.hom (𝟙 A) = 𝟙 A.X := rfl
@[simp] lemma comp_hom {R S T : CommMon_ C} (f : R ⟶ S) (g : S ⟶ T) :
  Mon_.hom.hom (f ≫ g) = f.hom ≫ g.hom := rfl

section
variables (C)

/-- The forgetful functor from commutative monoid objects to monoid objects. -/
@[derive [full, faithful]]
def forget₂_Mon_ : CommMon_ C ⥤ Mon_ C :=
induced_functor CommMon_.to_Mon_

@[simp] lemma forget₂_Mon_obj_one (A : CommMon_ C) : ((forget₂_Mon_ C).obj A).one = A.one := rfl
@[simp] lemma forget₂_Mon_obj_mul (A : CommMon_ C) : ((forget₂_Mon_ C).obj A).mul = A.mul := rfl
@[simp] lemma forget₂_Mon_map_hom {A B : CommMon_ C} (f : A ⟶ B) :
  ((forget₂_Mon_ C).map f).hom = f.hom := rfl

end

instance unique_hom_from_trivial (A : CommMon_ C) : unique (trivial C ⟶ A) :=
Mon_.unique_hom_from_trivial A.to_Mon_

open category_theory.limits

instance : has_initial (CommMon_ C) :=
has_initial_of_unique (trivial C)

end CommMon_

namespace category_theory.lax_braided_functor

variables {C} {D : Type u₂} [category.{v₂} D] [monoidal_category.{v₂} D] [braided_category.{v₂} D]

/--
A lax braided functor takes commutative monoid objects to commutative monoid objects.

That is, a lax braided functor `F : C ⥤ D` induces a functor `CommMon_ C ⥤ CommMon_ D`.
-/
@[simps]
def map_CommMon (F : lax_braided_functor C D) : CommMon_ C ⥤ CommMon_ D :=
{ obj := λ A,
  { mul_comm' :=
    begin
      dsimp,
      have := F.braided,
      slice_lhs 1 2 { rw ←this, },
      slice_lhs 2 3 { rw [←category_theory.functor.map_comp, A.mul_comm], },
    end,
    ..F.to_lax_monoidal_functor.map_Mon.obj A.to_Mon_ },
  map := λ A B f, F.to_lax_monoidal_functor.map_Mon.map f, }

variables (C) (D)

/-- `map_CommMon` is functorial in the lax braided functor. -/
def map_CommMon_functor : (lax_braided_functor C D) ⥤ (CommMon_ C ⥤ CommMon_ D) :=
{ obj := map_CommMon,
  map := λ F G α,
  { app := λ A,
    { hom := α.app A.X, } } }

end category_theory.lax_braided_functor

namespace CommMon_

open category_theory.lax_braided_functor

namespace equiv_lax_braided_functor_punit

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def lax_braided_to_CommMon : lax_braided_functor (discrete punit.{u+1}) C ⥤ CommMon_ C :=
{ obj := λ F, (F.map_CommMon : CommMon_ _ ⥤ CommMon_ C).obj (trivial (discrete punit)),
  map := λ F G α, ((map_CommMon_functor (discrete punit) C).map α).app _ }

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def CommMon_to_lax_braided : CommMon_ C ⥤ lax_braided_functor (discrete punit.{u+1}) C :=
{ obj := λ A,
  { obj := λ _, A.X,
    map := λ _ _ _, 𝟙 _,
    ε := A.one,
    μ := λ _ _, A.mul,
    map_id' := λ _, rfl,
    map_comp' := λ _ _ _ _ _, (category.id_comp (𝟙 A.X)).symm, },
  map := λ A B f,
  { app := λ _, f.hom,
    naturality' := λ _ _ _, by { dsimp, rw [category.id_comp, category.comp_id], },
    unit' := f.one_hom,
    tensor' := λ _ _, f.mul_hom, }, }

local attribute [tidy] tactic.discrete_cases
local attribute [simp] eq_to_iso_map

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def unit_iso :
  𝟭 (lax_braided_functor (discrete punit.{u+1}) C) ≅
    lax_braided_to_CommMon C ⋙ CommMon_to_lax_braided C :=
nat_iso.of_components (λ F, lax_braided_functor.mk_iso
  (monoidal_nat_iso.of_components
    (λ _, F.to_lax_monoidal_functor.to_functor.map_iso (eq_to_iso (by ext)))
    (by tidy) (by tidy) (by tidy)))
  (by tidy)

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def counit_iso : CommMon_to_lax_braided C ⋙ lax_braided_to_CommMon C ≅ 𝟭 (CommMon_ C) :=
nat_iso.of_components (λ F, { hom := { hom := 𝟙 _, }, inv := { hom := 𝟙 _, } })
  (by tidy)

end equiv_lax_braided_functor_punit

open equiv_lax_braided_functor_punit
local attribute [simp] eq_to_iso_map

/--
Commutative monoid objects in `C` are "just" braided lax monoidal functors from the trivial
braided monoidal category to `C`.
-/
@[simps]
def equiv_lax_braided_functor_punit : lax_braided_functor (discrete punit.{u+1}) C ≌ CommMon_ C :=
{ functor := lax_braided_to_CommMon C,
  inverse := CommMon_to_lax_braided C,
  unit_iso := unit_iso C,
  counit_iso := counit_iso C, }

end CommMon_


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

import data.fun_like.basic

/-!
# Typeclass for a type `F` with an injective map to `A ↪ B`

This typeclass is primarily for use by embeddings such as `rel_embedding`.

## Basic usage of `embedding_like`

A typical type of embedding should be declared as:
```
structure my_embedding (A B : Type*) [my_class A] [my_class B] :=
(to_fun : A → B)
(injective' : function.injective to_fun)
(map_op' : ∀ {x y : A}, to_fun (my_class.op x y) = my_class.op (to_fun x) (to_fun y))

namespace my_embedding

variables (A B : Type*) [my_class A] [my_class B]

-- This instance is optional if you follow the "Embedding class" design below:
instance : embedding_like (my_embedding A B) A B :=
{ coe := my_embedding.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  injective' := my_embedding.injective' }

/-- Helper instance for when there's too many metavariables to directly
apply `fun_like.to_coe_fn`. -/
instance : has_coe_to_fun (my_embedding A B) (λ _, A → B) := ⟨my_embedding.to_fun⟩

@[simp] lemma to_fun_eq_coe {f : my_embedding A B} : f.to_fun = (f : A → B) := rfl

@[ext] theorem ext {f g : my_embedding A B} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h

/-- Copy of a `my_embedding` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : my_embedding A B) (f' : A → B) (h : f' = ⇑f) : my_embedding A B :=
{ to_fun := f',
  injective' := h.symm ▸ f.injective',
  map_op' := h.symm ▸ f.map_op' }

end my_embedding
```

This file will then provide a `has_coe_to_fun` instance and various
extensionality and simp lemmas.

## Embedding classes extending `embedding_like`

The `embedding_like` design provides further benefits if you put in a bit more work.
The first step is to extend `embedding_like` to create a class of those types satisfying
the axioms of your new type of morphisms.
Continuing the example above:

```
/-- `my_embedding_class F A B` states that `F` is a type of `my_class.op`-preserving embeddings.
You should extend this class when you extend `my_embedding`. -/
class my_embedding_class (F : Type*) (A B : out_param $ Type*) [my_class A] [my_class B]
  extends embedding_like F A B :=
(map_op : ∀ (f : F) (x y : A), f (my_class.op x y) = my_class.op (f x) (f y))

@[simp] lemma map_op {F A B : Type*} [my_class A] [my_class B] [my_embedding_class F A B]
  (f : F) (x y : A) : f (my_class.op x y) = my_class.op (f x) (f y) :=
my_embedding_class.map_op

-- You can replace `my_embedding.embedding_like` with the below instance:
instance : my_embedding_class (my_embedding A B) A B :=
{ coe := my_embedding.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  injective' := my_embedding.injective',
  map_op := my_embedding.map_op' }

-- [Insert `has_coe_to_fun`, `to_fun_eq_coe`, `ext` and `copy` here]
```

The second step is to add instances of your new `my_embedding_class` for all types extending
`my_embedding`.
Typically, you can just declare a new class analogous to `my_embedding_class`:

```
structure cooler_embedding (A B : Type*) [cool_class A] [cool_class B]
  extends my_embedding A B :=
(map_cool' : to_fun cool_class.cool = cool_class.cool)

class cooler_embedding_class (F : Type*) (A B : out_param $ Type*) [cool_class A] [cool_class B]
  extends my_embedding_class F A B :=
(map_cool : ∀ (f : F), f cool_class.cool = cool_class.cool)

@[simp] lemma map_cool {F A B : Type*} [cool_class A] [cool_class B] [cooler_embedding_class F A B]
  (f : F) : f cool_class.cool = cool_class.cool :=
my_embedding_class.map_op

-- You can also replace `my_embedding.embedding_like` with the below instance:
instance : cool_embedding_class (cool_embedding A B) A B :=
{ coe := cool_embedding.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  injective' := my_embedding.injective',
  map_op := cool_embedding.map_op',
  map_cool := cool_embedding.map_cool' }

-- [Insert `has_coe_to_fun`, `to_fun_eq_coe`, `ext` and `copy` here]
```

Then any declaration taking a specific type of morphisms as parameter can instead take the
class you just defined:
```
-- Compare with: lemma do_something (f : my_embedding A B) : sorry := sorry
lemma do_something {F : Type*} [my_embedding_class F A B] (f : F) : sorry := sorry
```

This means anything set up for `my_embedding`s will automatically work for `cool_embedding_class`es,
and defining `cool_embedding_class` only takes a constant amount of effort,
instead of linearly increasing the work per `my_embedding`-related declaration.

-/

/-- The class `embedding_like F α β` expresses that terms of type `F` have an
injective coercion to injective functions `α ↪ β`.
-/
class embedding_like (F : Sort*) (α β : out_param Sort*)
  extends fun_like F α (λ _, β) :=
(injective' : ∀ (f : F), @function.injective α β (coe f))

namespace embedding_like

variables {F α β γ : Sort*} [i : embedding_like F α β]

include i

protected lemma injective (f : F) : function.injective f := injective' f

@[simp] lemma apply_eq_iff_eq (f : F) {x y : α} : f x = f y ↔ x = y :=
(embedding_like.injective f).eq_iff

omit i

@[simp] lemma comp_injective {F : Sort*} [embedding_like F β γ] (f : α → β) (e : F) :
  function.injective (e ∘ f) ↔ function.injective f :=
(embedding_like.injective e).of_comp_iff f

end embedding_like


import Smt

theorem cong (x y : Nat) (f : Nat → Nat) : x = y → f x = f y := by
  smt
  simp_all


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.coprime x p) : (x : ℤ_[p]) ∈ units ℤ_[p] :=
begin
  have h1 : ¬ (x : ℤ_[p]) ∈ units ℤ_[p], from by {
    assume h2 : (x : ℤ_[p]) ∈ units ℤ_[p],
    have h3 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = 1, from by {
      exact h2.right,
    },
    have h4 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h3,
    },
    have h5 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h4,
    },
    have h6 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h5,
    },
    have h7 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h6,
    },
    have h8 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h7,
    },
    have h9 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h8,
    },
    have h10 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h9,
    },
    have h11 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h10,
    },
    have h12 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h11,
    },
    have h13 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h12,
    },
    have h14 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h13,
    },
    have h15 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h14,
    },
    have h16 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h15,
    },
    have h17 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h16,
    },
    have h18 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h17,
    },
    have h19 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h18,
    },
    have h20 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h19,
    },
    have h21 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h20,
    },
    have h22 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h21,
    },
    have h23 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h22,
    },
    have h24 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h23,
    },
    have h25 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h24,
    },
    have h26 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h25,
    },
    have h27 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h26,
    },
    have h28 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h27,
    },
    have h29 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h28,
    },
    have h30 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h29,
    },
    have h31 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h30,
    },
    have h32 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h31,
    },
    have h33 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h32,
    },
    have h34 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h33,
    },
    have h35 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h34,
    },
    have h36 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h35,
    },
    have h37 : (x : ℤ_[p]) * (x : ℤ_[p])⁻¹ = (1 : ℤ_[p]), from by {
      exact h36,
    },
    have h38
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.coprime x p) : is_unit (p_adic_int.mk p x) :=
begin
  have h1 : ¬ is_unit (p_adic_int.mk p x), from by {
    assume h2 : is_unit (p_adic_int.mk p x),
    have h3 : p_adic_int.norm (p_adic_int.mk p x) = 1, from by {
      rw is_unit_iff_norm_eq_one at h2,
      exact h2,
    },
    have h4 : p_adic_int.norm (p_adic_int.mk p x) < 1, from by {
      rw p_adic_int.norm_mk,
      rw nat.mod_eq_of_lt,
      apply nat.lt_succ_self,
    },
    have h5 : p ∣ x, from by {
      rw ← h3,
      apply p_adic_int.norm_mk_dvd,
      exact h4,
    },
    have h6 : ¬ nat.coprime x p, from by {
      apply nat.not_coprime_of_dvd_of_dvd,
      exact h5,
      apply nat.dvd_refl p,
    },
    exact h6 h,
  },
  show is_unit (p_adic_int.mk p x), from by {
    apply classical.by_contradiction,
    exact h1,
  },
end

--OUTPUT 3
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.coprime x p) : (x : ℤ_[p]) ∈ units ℤ_[p] :=
begin
  have h1 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h2 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h3 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h4 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h5 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h6 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h7 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h8 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h9 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h10 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h11 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h12 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h13 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h14 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h15 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h16 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h17 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h18 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h19 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h20 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h21 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h22 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h23 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h24 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h25 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h26 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h27 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h28 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h29 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h30 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h31 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h32 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h33 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h34 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h35 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h36 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h37 : (x : ℤ_[p]) ∈ units ℤ_[p] ↔ (x : ℤ_[p]) ∈ units ℤ_[p], from by obviously,
  have h38 : (x : ℤ_[p]) ∈ units ℤ
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
  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`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yaël Dillies, Patrick Stevens

! This file was ported from Lean 3 source module data.nat.cast.field
! leanprover-community/mathlib commit acee671f47b8e7972a1eb6f4eed74b4b3abce829
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Order.Field.Basic
import Mathbin.Algebra.Order.Ring.CharZero
import Mathbin.Data.Nat.Cast.Basic

/-!
# Cast of naturals into fields

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

This file concerns the canonical homomorphism `ℕ → F`, where `F` is a field.

## Main results

 * `nat.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n`
 * `nat.cast_div_le`: in all cases, `↑(m / n) ≤ ↑m / ↑ n`
-/

namespace Nat

variable {α : Type _}

/- warning: nat.cast_div -> Nat.cast_div is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionSemiring.{u1} α] {m : Nat} {n : Nat}, (Dvd.Dvd.{0} Nat Nat.hasDvd n m) -> (Ne.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)))))))) n) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1))))))))) -> (Eq.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)))))))) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) m n)) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α _inst_1)))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)))))))) m) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)))))))) n)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionSemiring.{u1} α] {m : Nat} {n : Nat}, (Dvd.dvd.{0} Nat Nat.instDvdNat n m) -> (Ne.{succ u1} α (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) n) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)))))) -> (Eq.{succ u1} α (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) m n)) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivisionSemiring.toDiv.{u1} α _inst_1)) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) m) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) n)))
Case conversion may be inaccurate. Consider using '#align nat.cast_div Nat.cast_divₓ'. -/
@[simp]
theorem cast_div [DivisionSemiring α] {m n : ℕ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) :
    ((m / n : ℕ) : α) = m / n := by
  rcases n_dvd with ⟨k, rfl⟩
  have : n ≠ 0 := by
    rintro rfl
    simpa using n_nonzero
  rw [Nat.mul_div_cancel_left _ this.bot_lt, mul_comm n k, cast_mul, mul_div_cancel _ n_nonzero]
#align nat.cast_div Nat.cast_div

/- warning: nat.cast_div_div_div_cancel_right -> Nat.cast_div_div_div_cancel_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionSemiring.{u1} α] [_inst_2 : CharZero.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1))))] {m : Nat} {n : Nat} {d : Nat}, (Dvd.Dvd.{0} Nat Nat.hasDvd d n) -> (Dvd.Dvd.{0} Nat Nat.hasDvd d m) -> (Eq.{succ u1} α (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α _inst_1)))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)))))))) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) m d)) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)))))))) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) n d))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α _inst_1)))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)))))))) m) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)))))))) n)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionSemiring.{u1} α] [_inst_2 : CharZero.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1))))] {m : Nat} {n : Nat} {d : Nat}, (Dvd.dvd.{0} Nat Nat.instDvdNat d n) -> (Dvd.dvd.{0} Nat Nat.instDvdNat d m) -> (Eq.{succ u1} α (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivisionSemiring.toDiv.{u1} α _inst_1)) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) m d)) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) n d))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivisionSemiring.toDiv.{u1} α _inst_1)) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) m) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) n)))
Case conversion may be inaccurate. Consider using '#align nat.cast_div_div_div_cancel_right Nat.cast_div_div_div_cancel_rightₓ'. -/
theorem cast_div_div_div_cancel_right [DivisionSemiring α] [CharZero α] {m n d : ℕ} (hn : d ∣ n)
    (hm : d ∣ m) : (↑(m / d) : α) / (↑(n / d) : α) = (m : α) / n :=
  by
  rcases eq_or_ne d 0 with (rfl | hd); · simp [zero_dvd_iff.mp hm]
  replace hd : (d : α) ≠ 0;
  · norm_cast
    assumption
  simp [hd, hm, hn, div_div_div_cancel_right _ hd]
#align nat.cast_div_div_div_cancel_right Nat.cast_div_div_div_cancel_right

section LinearOrderedSemifield

variable [LinearOrderedSemifield α]

/- warning: nat.cast_div_le -> Nat.cast_div_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {m : Nat} {n : Nat}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) m n)) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α (Semifield.toDivisionSemiring.{u1} α (LinearOrderedSemifield.toSemifield.{u1} α _inst_1)))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) m) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) n))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {m : Nat} {n : Nat}, LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (StrictOrderedSemiring.toPartialOrder.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))) (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) m n)) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (LinearOrderedSemifield.toDiv.{u1} α _inst_1)) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))) m) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))) n))
Case conversion may be inaccurate. Consider using '#align nat.cast_div_le Nat.cast_div_leₓ'. -/
/-- Natural division is always less than division in the field. -/
theorem cast_div_le {m n : ℕ} : ((m / n : ℕ) : α) ≤ m / n :=
  by
  cases n
  · rw [cast_zero, div_zero, Nat.div_zero, cast_zero]
  rwa [le_div_iff, ← Nat.cast_mul]
  exact Nat.cast_le.2 (Nat.div_mul_le_self m n.succ)
  · exact Nat.cast_pos.2 n.succ_pos
#align nat.cast_div_le Nat.cast_div_le

/- warning: nat.inv_pos_of_nat -> Nat.inv_pos_of_nat is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {n : Nat}, LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) (Inv.inv.{u1} α (DivInvMonoid.toHasInv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α (Semifield.toDivisionSemiring.{u1} α (LinearOrderedSemifield.toSemifield.{u1} α _inst_1))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) n) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {n : Nat}, LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (StrictOrderedSemiring.toPartialOrder.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (CommMonoidWithZero.toZero.{u1} α (CommGroupWithZero.toCommMonoidWithZero.{u1} α (Semifield.toCommGroupWithZero.{u1} α (LinearOrderedSemifield.toSemifield.{u1} α _inst_1)))))) (Inv.inv.{u1} α (LinearOrderedSemifield.toInv.{u1} α _inst_1) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))) n) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))))))
Case conversion may be inaccurate. Consider using '#align nat.inv_pos_of_nat Nat.inv_pos_of_natₓ'. -/
theorem inv_pos_of_nat {n : ℕ} : 0 < ((n : α) + 1)⁻¹ :=
  inv_pos.2 <| add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one
#align nat.inv_pos_of_nat Nat.inv_pos_of_nat

/- warning: nat.one_div_pos_of_nat -> Nat.one_div_pos_of_nat is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {n : Nat}, LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α (Semifield.toDivisionSemiring.{u1} α (LinearOrderedSemifield.toSemifield.{u1} α _inst_1)))))) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) n) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {n : Nat}, LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (StrictOrderedSemiring.toPartialOrder.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (CommMonoidWithZero.toZero.{u1} α (CommGroupWithZero.toCommMonoidWithZero.{u1} α (Semifield.toCommGroupWithZero.{u1} α (LinearOrderedSemifield.toSemifield.{u1} α _inst_1)))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (LinearOrderedSemifield.toDiv.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))) n) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))))))
Case conversion may be inaccurate. Consider using '#align nat.one_div_pos_of_nat Nat.one_div_pos_of_natₓ'. -/
theorem one_div_pos_of_nat {n : ℕ} : 0 < 1 / ((n : α) + 1) :=
  by
  rw [one_div]
  exact inv_pos_of_nat
#align nat.one_div_pos_of_nat Nat.one_div_pos_of_nat

/- warning: nat.one_div_le_one_div -> Nat.one_div_le_one_div is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {n : Nat} {m : Nat}, (LE.le.{0} Nat Nat.hasLe n m) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α (Semifield.toDivisionSemiring.{u1} α (LinearOrderedSemifield.toSemifield.{u1} α _inst_1)))))) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) m) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α (Semifield.toDivisionSemiring.{u1} α (LinearOrderedSemifield.toSemifield.{u1} α _inst_1)))))) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) n) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {n : Nat} {m : Nat}, (LE.le.{0} Nat instLENat n m) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (StrictOrderedSemiring.toPartialOrder.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (LinearOrderedSemifield.toDiv.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))) m) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (LinearOrderedSemifield.toDiv.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))) n) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))
Case conversion may be inaccurate. Consider using '#align nat.one_div_le_one_div Nat.one_div_le_one_divₓ'. -/
theorem one_div_le_one_div {n m : ℕ} (h : n ≤ m) : 1 / ((m : α) + 1) ≤ 1 / ((n : α) + 1) :=
  by
  refine' one_div_le_one_div_of_le _ _
  exact Nat.cast_add_one_pos _
  simpa
#align nat.one_div_le_one_div Nat.one_div_le_one_div

/- warning: nat.one_div_lt_one_div -> Nat.one_div_lt_one_div is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {n : Nat} {m : Nat}, (LT.lt.{0} Nat Nat.hasLt n m) -> (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α (Semifield.toDivisionSemiring.{u1} α (LinearOrderedSemifield.toSemifield.{u1} α _inst_1)))))) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) m) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α (Semifield.toDivisionSemiring.{u1} α (LinearOrderedSemifield.toSemifield.{u1} α _inst_1)))))) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) n) (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u1} α] {n : Nat} {m : Nat}, (LT.lt.{0} Nat instLTNat n m) -> (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (StrictOrderedSemiring.toPartialOrder.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (LinearOrderedSemifield.toDiv.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))) m) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (LinearOrderedSemifield.toDiv.{u1} α _inst_1)) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (Nat.cast.{u1} α (Semiring.toNatCast.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))) n) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (Semiring.toOne.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))
Case conversion may be inaccurate. Consider using '#align nat.one_div_lt_one_div Nat.one_div_lt_one_divₓ'. -/
theorem one_div_lt_one_div {n m : ℕ} (h : n < m) : 1 / ((m : α) + 1) < 1 / ((n : α) + 1) :=
  by
  refine' one_div_lt_one_div_of_lt _ _
  exact Nat.cast_add_one_pos _
  simpa
#align nat.one_div_lt_one_div Nat.one_div_lt_one_div

end LinearOrderedSemifield

end Nat


-- SOUNDNESS

import syntax
import tableau

open classical
local attribute [instance, priority 10] prop_decidable

open has_sat

-- Combine a collection of pointed models with one new world using the given valuation.
-- TODO: rewrite to term mode?
def combinedModel { β : Type } (collection : β → Σ (W : Type), kripkeModel W × W) (newVal : char → Prop) :
  kripkeModel (sum unit Σ k : β, (collection k).fst) × (sum unit Σ k : β, (collection k).fst) :=
begin
  split,
  split,
  { -- making the valuation function:
    intro world,
    cases world,
    { -- the one new world:
      cases world,
      exact newVal, -- use new given valuation here!!
    },
    { -- world in one of the given models:
      cases world with R w,
      exact (collection R).snd.fst.val w,
    }
  },
  { -- defining relations:
    intros worldOne worldTwo,
    cases worldOne; cases worldTwo,
    -- four cases about two new or old worlds:
    { exact false, }, -- no reflexive loop at the new world.
    { exact (worldTwo.snd == (collection worldTwo.fst).snd.snd), }, -- conect new world to given points.
    { exact false }, -- no connection from models to new world
    { -- connect two old worlds iff they are from the same model and were connected there already:
      cases worldOne with kOne wOne,
      cases worldTwo with kTwo wTwo,
      have help : kOne = kTwo → Prop, {
        intro same,
        have sameCol : (collection kOne = collection kTwo), {
          rw ← same,
        },
        rw ← sameCol at wTwo,
        exact (collection kOne).snd.fst.rel wOne wTwo,
      },
      exact dite (kOne = kTwo)
        (λ same, help same)
        (λ _, false)
    },
  },
  { -- point at the new world:
    left,
    exact (),
  }
end

-- The combined model preserves all truths at the old worlds.
lemma combMo_preserves_truth_at_oldWOrld { β : Type }
  (collection : β → Σ (W : Type), kripkeModel W × W) (newVal : char → Prop)
  : (∀ (f : formula) (R : β) (oldWorld : (collection R).fst),
    evaluate ((combinedModel collection newVal).fst, (sum.inr ⟨R, oldWorld⟩)) f ↔ evaluate ((collection R).snd.fst, oldWorld) f) :=
begin
  intro f,
  induction f ; intros R oldWorld,
  case bottom : {
    finish,
  },
  case atom_prop : c {
    unfold combinedModel,
    unfold evaluate,
  },
  case neg : f f_IH {
    unfold evaluate,
    rw f_IH R oldWorld,
  },
  case and : f g f_IH g_IH {
    unfold evaluate,
    rw f_IH R oldWorld,
    rw g_IH R oldWorld,
  },
  case box : f f_IH {
    unfold evaluate,
    split,
    {
      intro true_in_combo,
      intros otherWorld rel_in_old_model,
      specialize f_IH R otherWorld,
      rw ← f_IH,
      specialize true_in_combo (sum.inr ⟨R, otherWorld⟩),
      apply true_in_combo,
      unfold combinedModel,
      simp,
      exact rel_in_old_model,
    },
    {
      intro true_in_old,
      simp,
      split,
      {
        intro newWorld,
        unfold combinedModel,
        tauto, -- the new world is never reachable, trivial case
      },
      {
        intros otherR otherWorld,
        intro rel_in_new_model,
        specialize f_IH otherR otherWorld,
        unfold combinedModel at rel_in_new_model,
        have sameR : R = otherR, {
          by_contradiction,
          classical,
          finish,
        },
        subst sameR,
        rw f_IH,
        apply true_in_old,
        -- remains to show that related in old model
        simp at *,
        exact rel_in_new_model,
      },
    },
  },
end

-- The combined model for X satisfies X.
lemma combMo_sat_X { X : finset formula } { β : set formula } { beta_def : β = { R : formula | ~R.box ∈ X } }
  (simple_X : simple X)
  (not_closed_X : ¬ closed X)
  (collection : β → Σ (W : Type), kripkeModel W × W)
  (all_pro_sat : ∀ R : β, ∀ f ∈ projection X ∪ {~R}, evaluate ((collection R).snd.fst, (collection R).snd.snd) f)
  : (∀ f ∈ X, evaluate ((combinedModel collection (λ c, (formula.atom_prop c ∈ X))).fst, (combinedModel collection (λ c, (formula.atom_prop c ∈ X))).snd) f) :=
begin
  intros f f_in_X,
  cases f, -- no induction because X is simple
  case formula.bottom: {
    unfold closed at not_closed_X,
    tauto,
  },
  case atom_prop: {
    unfold combinedModel,
    unfold evaluate,
    simp,
    exact f_in_X,
  },
  case neg: {
    -- subcases :-/
    cases f,
    case atom_prop: {
      unfold combinedModel,
      unfold evaluate,
      unfold closed at not_closed_X,
      rw not_or_distrib at not_closed_X,
      simp at *,
      tauto,
    },
    case box: newf {
      -- set coMo := ,
      --unfold combinedModel,
      change (evaluate ((combinedModel collection (λ c, (·c) ∈ X)).fst, (combinedModel collection (λ (c : char), (·c) ∈ X)).snd) (~□newf)),
      unfold evaluate,
      rw not_forall,
      -- need a reachable world where newf holds, choose the witness
      let h : newf ∈ β, {
        rw beta_def,
        use f_in_X,
      },
      let oldWorld : unit ⊕ Σ (k : β), (collection k).fst :=
        sum.inr ⟨⟨newf, h⟩, (collection ⟨newf, h⟩).snd.snd⟩,
      use oldWorld,
      simp,
      split,
      { -- show that worlds are related in combined model (def above, case 2)
        unfold combinedModel, simp,
      },
      { -- show that f is false at old world
        have coMoLemma := combMo_preserves_truth_at_oldWOrld collection (λ (c : char), (·c) ∈ X) newf ⟨newf, h⟩ (collection ⟨newf, h⟩).snd.snd,
        rw coMoLemma,
        specialize all_pro_sat ⟨newf, h⟩ (~newf),
        unfold evaluate at all_pro_sat,
        simp at *,
        exact all_pro_sat,
      },
    },
    case bottom: {
      tauto,
    },
    all_goals {
      unfold simple at simple_X,
      by_contradiction,
      exact simple_X _ f_in_X,
    },
  },
  case and: fa fb {
    unfold simple at simple_X,
    by_contradiction,
    exact simple_X (fa ⋏ fb) f_in_X,
  },
  case box: f {
    unfold evaluate,
    intros otherWorld is_rel,
    cases otherWorld,
    { cases is_rel, }, -- otherWorld cannot be the (unreachable) new world
    have coMoLemma := combMo_preserves_truth_at_oldWOrld collection (λ c, (·c) ∈ X) f otherWorld.fst otherWorld.snd,
    simp at coMoLemma,
    rw coMoLemma,
    specialize all_pro_sat otherWorld.fst f,
    simp at all_pro_sat,
    rw or_imp_distrib at all_pro_sat,
    cases all_pro_sat with _ all_pro_sat_right,
    rw ← proj at f_in_X,
    specialize all_pro_sat_right f_in_X,
    have sameWorld : otherWorld.snd = (collection otherWorld.fst).snd.snd, {
      rw (heq_iff_eq.mp (heq.symm is_rel)),
    },
    rw sameWorld,
    simp,
    exact all_pro_sat_right,
  },
end

-- Lemma 1 (page 16)
-- A simple set of formulas X is satisfiable if and only if
-- it is not closed  and  for all ¬[A]R ∈ X also XA; ¬R is satisfiable.
lemma Lemma1_simple_sat_iff_all_projections_sat { X : finset formula } :
  simple X → (satisfiable X ↔ (¬ closed X ∧ ∀ R, (~□R) ∈ X → satisfiable (projection X ∪ {~R}))) :=
begin
  intro X_is_simple,
  split,
  { -- left to right
    intro sat_X,
    unfold satisfiable at *,
    rcases sat_X with ⟨ W, M, w, w_sat_X ⟩,
    split,
    { -- show that X is not closed:
      by_contradiction hyp,
      unfold closed at hyp,
      cases hyp with bot_in_X f_and_notf_in_X,
      {
        exact w_sat_X ⊥ bot_in_X,
      },
      {
        rcases f_and_notf_in_X with ⟨ f, f_in_X, notf_in_X ⟩,
        let w_sat_f :=  w_sat_X f f_in_X,
        let w_sat_notf :=  w_sat_X (~f) notf_in_X,
        unfold evaluate at *,
        exact absurd w_sat_f w_sat_notf,
      }
    },
    { -- show that for each ~[]R ∈ X the projection with ~R is satisfiable:
      intros R notboxr_in_X,
      let w_sat_notboxr := w_sat_X (~□R) notboxr_in_X,
      unfold evaluate at w_sat_notboxr,
      simp at w_sat_notboxr,
      rcases w_sat_notboxr with ⟨ v, w_rel_v, v_sat_notr ⟩,
      use [W, M, v],
      intro g,
      simp at *,
      rw or_imp_distrib,
      split,
      {
        intro g_is_notR,
        rw g_is_notR,
        exact v_sat_notr,
      },
      {
        intro boxg_in_X,
        rw proj at boxg_in_X,
        specialize w_sat_X (□g) boxg_in_X,
        unfold evaluate at w_sat_X,
        exact w_sat_X v w_rel_v,
      },
    },
  },
  { -- right to left
    intro rhs,
    cases rhs with not_closed_X all_pro_sat,
    unfold satisfiable at *,
    -- Let's build a new Kripke model!
    let β := { R : formula | ~□R ∈ X },
    -- beware, using Axioms of Choice here!
    choose typeFor this_pro_sat using all_pro_sat,
    choose modelFor this_pro_sat using this_pro_sat,
    choose worldFor this_pro_sat using this_pro_sat,
    -- define the collection:
    let collection : β → (Σ (W : Type), (kripkeModel W × W)) := begin
      intro k,
      cases k with R notboxr_in_X,
      simp at notboxr_in_X,
      use [typeFor R notboxr_in_X, modelFor R notboxr_in_X, worldFor R notboxr_in_X],
    end,
    let newVal := λ c, formula.atom_prop c ∈ X,
    let BigM := combinedModel collection newVal,
    use unit ⊕ Σ k : β, (collection k).fst,
    use [BigM.fst, BigM.snd],
    -- apply Lemma, missing last argument "all_pro_sat"
    -- we need to use that X_is_simple (to restrict cases what phi can be)
    -- and that X is not closed (to ensure that it is locally consistent)
    apply combMo_sat_X X_is_simple not_closed_X collection,
    -- it remains to show that the new big model satisfies X
    intros R f f_inpro_or_notr,
    cases R with R notrbox_in_X,
    simp only [finset.mem_union, finset.mem_insert, finset.mem_singleton, subtype.coe_mk] at *,
    specialize this_pro_sat R notrbox_in_X,
    cases f_inpro_or_notr with f_inpro f_is_notboxR,
    { -- if f is in the projection
      specialize this_pro_sat f,
      rw or_imp_distrib at this_pro_sat,
      cases this_pro_sat with this_pro_sat_l  this_pro_sat_r,
      exact this_pro_sat_l f_inpro,
    },
    { -- case where f is ~[]R
      cases f_is_notboxR,
      specialize this_pro_sat (~R),
      rw or_imp_distrib at this_pro_sat,
      cases this_pro_sat with this_pro_sat_l  this_pro_sat_r,
      exact this_pro_sat_r f_is_notboxR,
    },
    simp, -- to check β
  },
end

-- Each rule is sound and preserves satisfiability "downwards"
lemma localRuleSoundness {α : finset formula} { B : finset (finset formula) } :
  localRule α B → (satisfiable α → ∃ β ∈ B, satisfiable β) :=
begin
  intro r,
  intro a_sat,
  unfold satisfiable at a_sat,
  rcases a_sat with ⟨ W, M, w, w_sat_a ⟩,
  cases r,
  case localRule.bot : a bot_in_a {
    by_contradiction,
    let w_sat_bot := w_sat_a ⊥ bot_in_a  ,
    unfold evaluate at w_sat_bot,
    exact w_sat_bot,
  },
  case localRule.not : a f hyp {
    by_contradiction,
    have w_sat_f : evaluate (M, w) f , {
      apply w_sat_a,
      exact hyp.left,
    },
    have w_sat_not_f : evaluate (M, w) (~f) , {
      apply w_sat_a (~f),
      exact hyp.right,
    },
    unfold evaluate at *,
    exact absurd w_sat_f w_sat_not_f,
  },
  case localRule.neg : a f hyp {
    have w_sat_f : evaluate (M, w) f, {
      specialize w_sat_a (~~f) hyp,
      unfold evaluate at *,
      finish,
    },
    use (a \ {~~f} ∪ {f}),
    simp only [true_and, eq_self_iff_true, sdiff_singleton_is_erase, multiset.mem_singleton, finset.mem_mk],
    unfold satisfiable,
    use [W, M, w],
    intro g,
    simp only [ne.def, union_singleton_is_insert, finset.mem_insert, finset.mem_erase],
    rw or_imp_distrib,
    split,
    {
      intro g_is_f, rw g_is_f, apply w_sat_f,
    },
    {
      rw and_imp,
      intros g_neq_notnotf g_in_a,
      apply w_sat_a,
      exact g_in_a,
    },
  },
  case localRule.con : a f g hyp {
    use ( (a \ {f ⋏ g}) ∪ { f, g } ),
    split,
    simp,
    unfold satisfiable,
    use [W, M, w],
    simp only [and_imp, forall_eq_or_imp, sdiff_singleton_is_erase, ne.def, finset.union_insert, finset.mem_insert, finset.mem_erase],
    split,
    { -- f
      specialize w_sat_a (f⋏g) hyp,
      unfold evaluate at *,
      exact w_sat_a.left,
    },
    {
      intros h hhyp,
      simp at hhyp,
      cases hhyp,
      { -- h = g
        specialize w_sat_a (f⋏g) hyp,
        unfold evaluate at *,
        rw hhyp,
        exact w_sat_a.right,
      },
      { -- h in a
        exact w_sat_a h hhyp.right,
      },
    },
  },
  case localRule.nCo : a f g notfandg_in_a {
    unfold satisfiable,
    simp,
    let w_sat_phi := w_sat_a (~(f⋏g)) notfandg_in_a,
    unfold evaluate at w_sat_phi,
    rw not_and_distrib at w_sat_phi,
    cases w_sat_phi with not_w_f not_w_g,
    { use (a \ { ~ (f ⋏ g) } ∪ {~f}),
      split,
      { simp at *, },
      { use [W, M, w],
        intro psi,
        simp,
        intro psi_def,
        cases psi_def,
        { rw psi_def,
          unfold evaluate,
          exact not_w_f,
        },
        { cases psi_def with psi_in_a,
          exact w_sat_a psi psi_def_right,
        },
      },
    },
    { use (a \ { ~ (f ⋏ g) } ∪ {~g}),
      split,
      { simp at *, },
      { use [W, M, w],
        intro psi,
        simp,
        intro psi_def,
        cases psi_def,
        { rw psi_def,
          unfold evaluate,
          exact not_w_g,
        },
        { cases psi_def with psi_in_a,
          exact w_sat_a psi psi_def_right,
        },
      },
    },
  },
end

-- The critical roule is sound and preserves satisfiability "downwards".
-- TODO: is this the same as (one of the directions of) Lemma 1 ??
lemma atmSoundness {α : finset formula} {f} (not_box_f_in_a : ~□f ∈ α) :
  simple α → satisfiable α → satisfiable (projection α ∪ {~f}) :=
begin
  intro s,
  intro aSat,
  unfold satisfiable at aSat,
  rcases aSat with ⟨W, M, w, w_sat_a⟩,
  split,
  simp,
  -- get the other reachable world:
  let w_sat_not_box_f := w_sat_a (~f.box) not_box_f_in_a,
  unfold evaluate at w_sat_not_box_f,
  simp at w_sat_not_box_f,
  rcases w_sat_not_box_f with ⟨ v,  w_rel_v, v_not_sat_f ⟩,
  -- show that the projection is satisfiable:
  use [M, v],
  split,
  { unfold evaluate,
    exact v_not_sat_f,
  },
  intros phi phi_in_proj,
  rw proj at phi_in_proj,
  {
    specialize w_sat_a phi.box _,
    exact phi_in_proj,
    unfold evaluate at w_sat_a,
    exact w_sat_a v w_rel_v,
  },
end

lemma localTableauAndEndNodesUnsatThenNotSat {Z} (ltZ : localTableau Z) :
  (Π (Y), Y ∈ endNodesOf ⟨Z, ltZ⟩ → ¬ satisfiable Y) → ¬satisfiable Z :=
begin
  intro endsOfXnotSat,
  induction ltZ,
  case byLocalRule : X YS lr next IH {
    by_contradiction satX,
    rcases localRuleSoundness lr satX with ⟨Y,Y_in_YS,satY⟩,
    specialize IH Y Y_in_YS,
    set ltY := next Y Y_in_YS,
    have endNodesInclusion : ∀ W, W ∈ endNodesOf ⟨Y, ltY⟩ → W ∈ endNodesOf ⟨X, localTableau.byLocalRule lr next⟩ , {
      rw endNodesOf,
      intros W W_endOF_Y,
      simp only [endNodesOf, finset.mem_bUnion, finset.mem_attach, exists_true_left, subtype.exists],
      use [Y, Y_in_YS],
      assumption,
    },
    have endsOfYnotSat : (∀ (Y_1 : finset formula), Y_1 ∈ endNodesOf ⟨Y, ltY⟩ → ¬ satisfiable Y_1), {
      intros W W_is_endOf_Y,
      apply endsOfXnotSat W (endNodesInclusion W W_is_endOf_Y),
    },
    finish,
  },
  case sim : X X_is_simple {
    apply endsOfXnotSat,
    unfold endNodesOf,
    simp,
  },
end

lemma tableauThenNotSat : ∀ X, closedTableau X → ¬ satisfiable X :=
begin
  intros X t,
  induction t,
  case loc: Y ltY next IH {
    apply localTableauAndEndNodesUnsatThenNotSat ltY,
    intros Z ZisEndOfY,
    exact IH Z ZisEndOfY,
  },
  case atm: Y ϕ notBoxPhiInY Y_is_simple ltProYnPhi {
    rw Lemma1_simple_sat_iff_all_projections_sat Y_is_simple,
    simp,
    intro Ynotclosed,
    use ϕ,
    use notBoxPhiInY,
    finish,
  },
end

-- Theorem 2, page 30
theorem correctness : ∀ X, satisfiable X → consistent X :=
begin
  intro X,
  contrapose,
  unfold consistent,
  simp,
  unfold inconsistent,
  intro hyp,
  cases hyp with t,
  exact tableauThenNotSat X t,
end

lemma soundTableau : ∀ φ, provable φ → ¬ satisfiable ({~φ} : finset formula) :=
begin
  intro phi,
  intro prov,
  cases prov with _ tabl,
  apply tableauThenNotSat,
  exact tabl,
end

theorem soundness : ∀ φ, provable φ → tautology φ :=
begin
  intros φ prov,
  apply notsatisfnotThenTaut,
  rw ← singletonSat_iff_sat,
  apply soundTableau,
  exact prov,
end


-- Copyright (c) Microsoft Corporation. All rights reserved.
-- Licensed under the MIT license.

import ..smtexpr
import ..smtcompile
import ..bitvector
import .spec
import .lemmas
import .lemmas_basic
import .irstate
import .freevar
import .equiv
import .closed
import smt2.syntax
import system.io
import init.meta.tactic
import init.meta.interactive

namespace spec

open irsem
open freevar

-- get_free_*_name

lemma get_free_name_diff: ∀ n,
  get_free_sbitvec_name n ≠ get_free_sbool_name n
:= begin
  intros,
  intros H,
  unfold get_free_sbitvec_name at H,
  unfold get_free_sbool_name at H,
  rw string.eq_list at H,
  rw string.append_to_list at H,
  rw string.append_to_list at H,
  have H' := list.append_eq2 H,
  cases H'
end

lemma closed_regfile_apply_add_b_bv: ∀ (rf:regfile irsem_smt) (η:freevar.env)
    vname vz bname vb
    (HC:closed_regfile (rf.apply_to_values irsem_smt (env.replace_valty η))),
  closed_regfile (rf.apply_to_values irsem_smt
      (env.replace_valty ((η.add_bv vname vz).add_b bname vb)))
:= begin
  intros,
  revert HC,
  apply regfile.induction rf,
  {
    unfold closed_regfile,
    intros,
    rw regfile.empty_apply_empty,
    apply closed_regfile_empty
  },
  {
    intros rf IH,
    intros,
    unfold closed_regfile,
    intros,
    rw regfile.apply_update_comm at HC,
    rw regfile.apply_update_comm,
    unfold closed_regfile at IH,
    rw closed_regfile_update_split at HC,
    cases HC with HC HCval,
    have HC := IH HC,
    rw closed_regfile_update_split,
    split,
    {
      assumption
    },
    {
      cases v,
      unfold freevar.env.replace_valty at HCval,
      rw closed_ival_split at HCval,
      cases HCval with HCval1 HCval2,
      unfold freevar.env.replace_valty,
      rw closed_ival_split,
      split,
      {
        have H := closed_b_add_bv vname vz HCval1,
        have H := closed_b_add_b bname vb H,
        assumption
      },
      {
        have H := closed_bv_add_bv vname vz HCval2,
        have H := closed_bv_add_b bname vb H,
        assumption
      }
    }
  }
end

lemma regfile_update_ival_closed: ∀ rf rf' (η:freevar.env) regn sz
    vn pn bvn p
    (HCRF: closed_regfile (regfile.apply_to_values irsem_smt rf
           (env.replace_valty η)))
    (HRF': rf' = regfile.update irsem_smt rf regn
           (valty.ival sz (sbitvec.var sz vn) (sbool.var pn))),
  closed_regfile (regfile.apply_to_values irsem_smt rf'
    (env.replace_valty (env.add_b (env.add_bv η vn bvn) pn p)))
:= begin
  intros,
  have H1 : closed_regfile (regfile.apply_to_values irsem_smt
            rf (env.replace_valty (env.add_b (env.add_bv η vn bvn) pn p))),
  {
    apply closed_regfile_apply_add_b_bv,
    assumption
  },
  have H2 : closed_valty
            ((env.add_b (env.add_bv η vn bvn) pn p)
              ⟦valty.ival sz (sbitvec.var sz vn) (sbool.var pn)⟧),
  { apply ival_closed },
  rw HRF',
  rw regfile.apply_update_comm,
  rw closed_regfile_update_split,
  split, assumption, assumption
end

lemma updatereg_closed: ∀ (ss ss':irstate_smt) (η:freevar.env)
    regn sz vn pn bvn p
    (HC:closed_irstate (η⟦ss⟧))
    (HNOTIN1: vn ∉ η)
    (HNOTIN2: pn ∉ η)
    (HNOTEQ: vn ≠ pn)
    (HS:ss' = irstate.updatereg irsem_smt ss regn
        (irsem.valty.ival sz (sbitvec.var sz vn) (sbool.var pn))),
  closed_irstate (((η.add_bv vn bvn).add_b pn p)⟦ss'⟧)
:= begin
  intros,
  cases ss with sub srf,
  cases ss' with sub' srf',
  unfold freevar.env.replace at *,
  rw ← irstate.setub_apply_to_values at *,
  unfold irstate.getub at *,
  simp at *,
  unfold irstate.setub at *,
  unfold irstate.apply_to_values at *,
  rw closed_irstate_split,
  rw closed_irstate_split at HC,
  cases HC with HCUB HCRF,
  unfold irstate.updatereg at HS,
  simp at *,
  injection HS,
  subst h_1,
  split,
  {
    have H0: closed_b ((env.add_bv η vn bvn)⟦sub'⟧),
    {
      apply closed_b_add_bv,
      apply HCUB
    },
    apply closed_b_add_b,
    { assumption }
  },
  {
    apply regfile_update_ival_closed, assumption, assumption
  }
end

-- encode

-- Note that `irstate_equiv η⟦iss⟧ ise` does not imply
-- closed_irstate η⟦iss⟧. It is because, for example,
-- `b_equiv (sbool.and (sbool.var _) (sbool.ff)) ff` holds.
-- Then why `encode iss ise` is needed? -> encode is
-- the only way to relate ise and iss.
lemma init_var_encode_intty: ∀ ise iss ise' iss' (sg sg':std_gen) η n t
    (HENC: encode iss ise η) (HCLOSED: closed_irstate (η⟦iss⟧))
    (HNOTIN1: get_free_sbitvec_name n ∉ η)
    (HNOTIN2: get_free_sbool_name n ∉ η)
    (HIE:(ise', sg') = create_init_var_exec n t (ise, sg))
    (HIS:iss' = create_init_var_smt n t iss),
  ∃ η', (encode iss' ise' η' ∧ closed_irstate (η'⟦iss'⟧) ∧
         env.added2 η (get_free_sbitvec_name n)
          (get_free_sbool_name n) η')
:= begin
  intros,

  unfold create_init_var_smt at HIS,
  simp at HIS,

  unfold create_init_var_exec at HIE,
  simp at HIE,
  generalize Hrbv':(get_rand_bv (get_sz_from_ty t) sg) = rbv',
  cases rbv' with rbv' sg'',
  rw Hrbv' at *,
  unfold create_init_var_exec._match_2 at HIE,
  generalize Hrb':(get_rand_bool sg'') = rb',
  cases rb' with rb' sg''',
  rw Hrb' at *,
  unfold create_init_var_exec._match_1 at HIE,
  injection HIE with HIE HIE_sg,
  simp at HIE,

  existsi ((η.add_b (get_free_sbool_name n) rb')
             .add_bv (get_free_sbitvec_name n) rbv'.to_int),
  split,
  {
    unfold encode,
    rw HIS,
    rw replace_updatereg,
    rw HIE,
    rw env.not_in_add_bv_irstate_comm,
    rw env.not_in_add_b_irstate_comm,
    rw HCLOSED, rw HCLOSED,
    rw env.not_in_add_bv_valty_comm,
    rw env.not_in_add_b_valty_comm,

    unfold freevar.env.replace_valty,
    -- making value..
    unfold get_free_sbitvec,
    rw env.not_in_replace_sbv,
    rw env.add_b_replace_sbv,
    rw env.empty_replace_sbv,
    rw env.add_bv_replace_match,
    -- making poison..
    unfold get_free_sbool,
    rw env.not_in_replace_sb,
    rw env.add_b_replace_match,
    rw env.replace_sb_of_bool,
    apply irstate.updatereg_equiv,
    {
      intros,
      cases rb',
      { -- poison
        apply val_equiv.poison_intty,
        { constructor, constructor },
        { refl },
        { refl }
      },
      {
        apply val_equiv.concrete_intty,
        { constructor, constructor },
        {
          cases rbv',
          rw sbitvec_of_int_const,
          constructor
        },
        { refl }
      }
    },
    { rw sbitvec_of_int_const, unfold equals_size, simp },
    { apply HENC },
    any_goals { assumption },
    any_goals {
      apply env.not_in_add_b,
      apply get_free_name_diff,
      assumption
    },
  },
  split,
  {
    unfold closed_irstate,
    intros,
    rw HIS,
    rw replace_updatereg,
    rw env.not_in_add_bv_irstate_comm,
    rw env.not_in_add_b_irstate_comm,
    rw HCLOSED, rw HCLOSED,
    rw env.not_in_add_bv_valty_comm,
    rw env.not_in_add_b_valty_comm,

    unfold freevar.env.replace_valty,
    -- making value..
    unfold get_free_sbitvec,
    rw env.not_in_replace_sbv,
    rw env.add_b_replace_sbv,
    rw env.empty_replace_sbv,
    rw env.add_bv_replace_match,
    -- making poison..
    unfold get_free_sbool,
    rw env.not_in_replace_sb,
    rw env.add_b_replace_match,
    rw env.replace_sb_of_bool,

    rw replace_updatereg,
    unfold freevar.env.replace_valty,
    rw env.replace_sbv_of_int,
    rw env.replace_sb_of_bool,
    rw HCLOSED,
    any_goals { assumption },
    apply env.not_in_add_b, apply get_free_name_diff, assumption,
    apply env.not_in_add_b, apply get_free_name_diff, assumption
  },
  {
    unfold env.added2,
    split, {
      intros n_1 H1 H2,
      cases H2,
      apply env.not_in_add_bv,
      assumption,
      apply env.not_in_add_b,
      assumption,
      rw env.not_in_split at H1,
      rw env.not_in_split,
      assumption
    },
    {
      intros n_1 H,
      unfold env.add_b,
      unfold env.add_bv,
      unfold has_mem.mem, simp,
      cases H,
      {
        rw if_neg, rw if_neg, unfold has_mem.mem at H,
        cases H, left, assumption, right, assumption,
        intros H', rw H' at H, apply HNOTIN1, assumption,
        intros H', rw H' at H, apply HNOTIN2, assumption,
      },
      {
        cases H,
        { right, rw if_pos, intros H0, cases H0, assumption },
        { left, rw if_pos, intros H0, cases H0, assumption }
      }
    }
  }
end

def fv_smt_names (fvnames:list string) :=
  fvnames.map get_free_sbitvec_name ++
    fvnames.map get_free_sbool_name

lemma init_state_encode_strong: ∀ (freevars:list (string × ty)) (sg sg':std_gen) ise iss
    (HUNQ: list.unique $ freevars.map prod.fst)
    (HIE:(ise, sg') = create_init_state_exec freevars sg)
    (HIS:iss = create_init_state_smt freevars),
  ∃ η, (encode iss ise η ∧ closed_irstate (η⟦iss⟧)
      ∧ env.has_only η (fv_smt_names $ freevars.map prod.fst))
:= begin
  intros,
  revert ise iss sg sg',
  induction freevars,
  {
    intros,
    unfold create_init_state_exec at HIE,
    unfold create_init_state_smt at HIS,
    simp at HIE,simp at HIS,
    injection HIE with HIE _,
    rw [HIS, HIE],
    existsi (freevar.env.empty),
    unfold encode, rw empty_replace_st,
    constructor, constructor, constructor,
    any_goals { constructor },
    {
      apply closed_irstate_empty
    },
    {
      unfold fv_smt_names, simp,
      unfold env.has_only, intros, split,
      { intros H, cases H },
      { intros H, have H := (env.not_in_empty name) H, cases H }
    }
  },
  {
    intros,
    rename freevars_tl tl,
    cases freevars_hd with vname vty,
    have HEtmp: ∀ h t, create_init_state_exec (h::t) sg
              = create_init_var_exec h.1 h.2 (create_init_state_exec t sg),
    { intros, refl },
    rw HEtmp at HIE,
    clear HEtmp,
    have HStmp: ∀ h t, create_init_state_smt (h::t)
              = create_init_var_smt h.1 h.2 (create_init_state_smt t),
    { intros, refl },
    rw HStmp at HIS,
    clear HStmp,
    generalize HE0: create_init_state_exec tl sg = ise_sg0,
    generalize HS0: create_init_state_smt tl = iss0,
    rw HE0 at *,
    rw HS0 at *,
    cases ise_sg0 with ise0 sg0,
    simp at HIE HIS,
    have HEX: (∃ (η0 : env), encode iss0 ise0 η0 ∧ closed_irstate (η0⟦iss0⟧)
                ∧ env.has_only η0 (fv_smt_names $ tl.map prod.fst)),
    {
      apply freevars_ih,
      {
        simp at HUNQ, cases HUNQ, assumption
      }, apply (eq.symm HE0), refl
    },
    cases HEX with η0 HEX,
    cases HEX with HEX1 HEX2,
    cases HEX2 with HEX2 HEX3,
    -- Now add a new variable to each irstate
    have HUPDATED: ∃ η', (encode iss ise η' ∧ closed_irstate (η'⟦iss⟧) ∧
         env.added2 η0 (get_free_sbitvec_name vname)
                            (get_free_sbool_name vname) η'),
    {
      apply init_var_encode_intty,
      apply HEX1,
      apply HEX2,
      { -- get_free_sbitvec_name vname ∉ η0
        simp at HUNQ, cases HUNQ,
        apply env.has_only_not_in,
        { apply HEX3 },
        { unfold fv_smt_names,
          unfold get_free_sbitvec_name,
          apply list.not_mem_append,
          apply slist_prefix_notin, assumption,
          apply slist_prefix_notin2 "v_" "b_" 'v' 'b', assumption,
          { intros H0, cases H0 }, refl, refl
        }
      },
      { -- get_free_sbool_name vname ∉ η0
        simp at HUNQ, cases HUNQ,
        apply env.has_only_not_in,
        { apply HEX3 },
        { unfold fv_smt_names,
          unfold get_free_sbool_name,
          apply list.not_mem_append,
          apply slist_prefix_notin2 "b_" "v_" 'b' 'v', assumption,
          { intros H0, cases H0 }, refl, refl,
          apply slist_prefix_notin, assumption,
        }
      },
      assumption, assumption
    },
    cases HUPDATED with η HUPDATED,
    cases HUPDATED with HUPDATED Htmp, -- env.has_only_added2 (Honly) (Hadd2)
    cases Htmp with HUPDATED2 HUPDATED3,
    have Hη := env.has_only_added2 HEX3 HUPDATED3,
    existsi η,
    split, assumption, split, assumption,
    {
      unfold fv_smt_names, simp,
      unfold fv_smt_names at Hη, simp at Hη,
      rw ← list.cons_append,
      rw ← env.has_only_shuffle (get_free_sbool_name vname),
      simp,
      rw env.has_only_shuffle2,
      apply Hη
    }
  }
end

theorem init_state_encode_prf: init_state_encode
:= begin
  unfold init_state_encode,
  intros,
  have H := init_state_encode_strong freevars sg sg' ise iss HUNQ
            HIE HIS,
  cases H with η H,
  cases H, existsi η, assumption
end

-- Future work: theorem that `freevars.get` correctly returns all
-- free variables.

end spec