-- TODO Ask how to display the typeclasses for pedagogical reasons
example (α : Type*) (r : α → α → Prop) (x : α)
  (H : acc r x) : r x x → false :=
begin
intro H1,
-- only one move
induction H with y -- obv in alpha but for readability would be nice to say what
                   -- proofs were just produced by the tactic
  Hy -- ∀ (y_1 : α), r y_1 y → acc r y_1
  -- (Hy : ∀ (z : α), r z y → acc r z) -- can't do
  Hcomplicated, -- : ∀ (y_1 : α) (a : r y_1 y), (λ (x : α) ...
  -- that one's even worse because
-- I wish Hcomplicated didn't use lambda x
-- let's leave the scary term till last
clear x, -- works! x is no longer relevant
-- only one move
have H2 : acc r y := Hy y H1, -- never even use this
-- must use complicated thing
exact Hcomplicated y H1 H1,
end


import tactic data.set
import prop.language

universe u

namespace prop

variables (A : Type u)

inductive ProofCL (Γ : set Formula): set Formula
| ctx : ∀ {φ}, φ ∈ Γ → ProofCL φ
| P1  : ∀ {φ ψ}, ProofCL $ φ →' (ψ →' φ)
| P2  : ∀ {φ ψ χ}, ProofCL $ (φ →' (ψ →' χ)) →' ((φ →' ψ) →' (φ →' χ))
| P3  : ∀ {φ ψ}, ProofCL $ (¬'φ →' ¬'ψ) →' (ψ →' φ)
| mp  : ∀ {φ ψ}, ProofCL (φ →' ψ) → ProofCL φ → ProofCL ψ

-- notation `𝐂𝐋` := ProofCL

infix ` ⊢ ` :25 := ProofCL
notation `⊢ ` φ :25 := ∅ ⊢ φ

-- def consistent (Γ) : Prop := ⊥' ∉ (𝐂𝐋 Γ)
-- def inconsistent (Γ) := ¬(consistent Γ)

open ProofCL

lemma ident (Γ φ) : Γ ⊢ (φ →' φ) :=
begin
  have h₁ := @ProofCL.P2 Γ φ (φ →' φ) φ,
  have h₂ := @ProofCL.P1 Γ φ (φ →' φ),
  have h₃ := @ProofCL.P1 Γ φ φ,

  have h₄ := @mp _ _ _ h₁ h₂,
  have h₅ := @mp _ _ _ h₄ h₃,
  assumption,
end

lemma negneg (Γ φ) : (Γ ⊢ ¬'¬'φ) ↔ (Γ ⊢ φ) :=
begin
  split,
  admit,
  admit,
end

theorem expand_context (Γ φ ψ) : (Γ ⊢ ψ) → (Γ ∪ {φ} ⊢ ψ) :=
begin
  intro h,
  induction h,
  case ctx : {
    apply @ProofCL.ctx (Γ ∪ {φ}),
    finish,
  },
  case P1 : {
    apply @ProofCL.P1 (Γ ∪ {φ}),
  },
  case P2 : {
    apply @ProofCL.P2 (Γ ∪ {φ}),
  },
  case P3 : {
    apply @ProofCL.P3 (Γ ∪ {φ}),
  },
  case mp : _ _ _ _ h₁ h₂ {
    apply @ProofCL.mp (Γ ∪ {φ}) _ _ h₁ h₂,
  },
end

lemma append (Γ φ ψ) : (Γ ⊢ ψ) → (Γ ⊢ φ →' ψ) :=
begin
  admit,
end

theorem deduction (Γ φ ψ) : (Γ ∪ {φ} ⊢ ψ) → (Γ ⊢ (φ →' ψ)) :=
begin
  intro h,
  induction h,
  case ctx : a b {
    simp at *,
    cases b,
    { rw b, exact ident Γ φ, },
    {
      sorry,
    },
  },
  case P1 : φi ψi {
    -- exact @ProofCL.P1 Γ φ (φi →' ψi),
    sorry,
  },
  {sorry,},
  {sorry,},
  {sorry,},
end

theorem deduction' (Γ φ ψ) : (Γ ⊢ (φ →' ψ)) → (Γ ∪ {φ} ⊢ ψ) :=
begin
  intro h,
  -- assume h₂,
  -- apply (@append Γ φ ψ) h,
  admit,
end

example (φ ψ) : (⊢ φ →' ψ) → ({φ} ⊢ ψ) :=
begin
  intro h,
  have h₁ := (@deduction' ∅ φ ψ) h,
  rw set.empty_union at h₁,
  assumption,
end

def inconsistent (Γ) := Γ ⊢ ⊥'
def consistent (Γ) := ¬(inconsistent Γ)

lemma inconsistent_explosion (Γ φ) : (inconsistent Γ) → (Γ ⊢ φ) :=
begin
  intro h,
  admit,
end

lemma lemma_2_10 (Γ φ) : (Γ ⊢ φ) → (Γ ⊢ ¬'φ) → (inconsistent Γ) :=
begin
  intros hp hnp,
  have h₂ := deduction' _ _ _ hnp,
  have h₃ : inconsistent (Γ ∪ {φ}) := h₂,
end

lemma lemma_2_10' (Γ φ) : consistent Γ → (¬(Γ ⊢ φ)) ∨ (¬(Γ ⊢ ¬'φ)) :=
begin
  contrapose,
  rw push_neg.not_or_eq,
  repeat { rw not_not },
  intro h,
  have h4 := @lemma_2_10 Γ φ (h.elim_left) (h.elim_right),
  finish,
end

lemma lemma_2_11 (Γ φ) : (inconsistent (Γ ∪ {¬'φ})) ↔ (Γ ⊢ φ) :=
begin
  split,
  intro h,
  have h₂ := (@deduction Γ (¬'φ) ⊥') h,
  exact iff.elim_left (negneg Γ φ) h₂,

  intro h,
  apply deduction',
  apply iff.elim_right (negneg Γ φ),
  assumption,
end

lemma lemma_2_12 (Γ φ) : consistent Γ → (consistent (Γ ∪ {φ})) ∨ (consistent (Γ ∪ {¬'φ})) :=
begin
  contrapose,
  rw push_neg.not_or_eq,
  intro h,
  have hl : inconsistent (Γ ∪ {φ}) := by finish,
  have hr : inconsistent (Γ ∪ {¬'φ}) := by finish,
  have h₂ := (iff.elim_left (@lemma_2_11 Γ φ)) hr,
  have h₃ := sorry,
  have h₄ := lemma_2_10 Γ φ h₂ h₃,
  finish,
end

def satisfy (v : ℕ → Prop) : Formula → Prop
| (Formula.var p) := v p
| ⊥'              := false
| (φ →' ψ)        := (satisfy φ) → (satisfy ψ)

def models (v : ℕ → Prop) (φ : Formula) : Prop := satisfy v φ
infix `⊧` :25 := models

def valid (φ) := ∀ v, v ⊧ φ
prefix `⊧` :25 := valid

lemma valid_P1 (φ ψ) : ⊧ (φ →' ψ →' φ) :=
begin
  intro v,
  intros h₁ _,
  assumption,
end

lemma valid_P2 (φ ψ χ) : ⊧ (φ →' (ψ →' χ)) →' ((φ →' ψ) →' (φ →' χ)) :=
begin
  intro v,
  intros h₁ h₂ h₃,
  exact (h₁ h₃) (h₂ h₃),
end

lemma valid_P3 (φ ψ) : ⊧ (¬'φ →' ¬'ψ) →' (ψ →' φ) :=
begin
  intro v,
  intros h₁ h₂,
  by_contradiction h₃,
  solve_by_elim, -- TODO:
end

lemma valid_mp (φ ψ) : (⊧ φ →' ψ) → (⊧ φ) → (⊧ ψ) :=
begin
  intros h₀ h₁ v,
  exact (h₀ v) (h₁ v),
end

theorem soundness (Γ φ) : (Γ ⊢ φ) → (⊧ φ) :=
begin
  intro h,
  induction h,
  {sorry,},
  {exact @valid_P1 _ _,},
  {exact @valid_P2 _ _ _},
  {exact @valid_P3 _ _},
  case mp: _ _ _ _ h₁ h₂ {exact @valid_mp _ _ h₁ h₂,},
end

theorem completeness (Γ φ) : ⊧φ → (Γ ⊢ φ) :=
begin
  intro hM,
  sorry,
end

end prop


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Simon Hudon

! This file was ported from Lean 3 source module data.qpf.multivariate.constructions.comp
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.PFunctor.Multivariate.Basic
import Mathlib.Data.QPF.Multivariate.Basic

/-!
# The composition of QPFs is itself a QPF

We define composition between one `n`-ary functor and `n` `m`-ary functors
and show that it preserves the QPF structure
-/

universe u

namespace MvQPF

open MvFunctor

variable {n m : ℕ} (F : TypeVec.{u} n → Type _) [fF : MvFunctor F] [q : MvQPF F]
  (G : Fin2 n → TypeVec.{u} m → Type u) [fG : ∀ i, MvFunctor <| G i] [q' : ∀ i, MvQPF <| G i]

/-- Composition of an `n`-ary functor with `n` `m`-ary
functors gives us one `m`-ary functor -/
def Comp (v : TypeVec.{u} m) : Type _ :=
  F fun i : Fin2 n ↦ G i v
#align mvqpf.comp MvQPF.Comp

namespace Comp

open MvFunctor MvPFunctor

variable {F G} {α β : TypeVec.{u} m} (f : α ⟹ β)

instance [I : Inhabited (F fun i : Fin2 n ↦ G i α)] : Inhabited (Comp F G α) := I

/-- Constructor for functor composition -/
protected def mk (x : F fun i ↦ G i α) : (Comp F G) α := x
#align mvqpf.comp.mk MvQPF.Comp.mk

/-- Destructor for functor composition -/
protected def get (x : (Comp F G) α) : F fun i ↦ G i α := x
#align mvqpf.comp.get MvQPF.Comp.get

@[simp]
protected theorem mk_get (x : (Comp F G) α) : Comp.mk (Comp.get x) = x := rfl
#align mvqpf.comp.mk_get MvQPF.Comp.mk_get

@[simp]
protected theorem get_mk (x : F fun i ↦ G i α) : Comp.get (Comp.mk x) = x := rfl
#align mvqpf.comp.get_mk MvQPF.Comp.get_mk

/-- map operation defined on a vector of functors -/
protected def map' : (fun i : Fin2 n ↦ G i α) ⟹ fun i : Fin2 n ↦ G i β := fun _i ↦ map f
#align mvqpf.comp.map' MvQPF.Comp.map'

/-- The composition of functors is itself functorial -/
protected def map : (Comp F G) α → (Comp F G) β :=
  (map fun _i ↦ map f : (F fun i ↦ G i α) → F fun i ↦ G i β)
#align mvqpf.comp.map MvQPF.Comp.map

instance : MvFunctor (Comp F G) where map := Comp.map

theorem map_mk (x : F fun i ↦ G i α) :
    f <$$> Comp.mk x = Comp.mk ((fun i (x : G i α) ↦ f <$$> x) <$$> x) := rfl
#align mvqpf.comp.map_mk MvQPF.Comp.map_mk

theorem get_map (x : Comp F G α) :
    Comp.get (f <$$> x) = (fun i (x : G i α) ↦ f <$$> x) <$$> Comp.get x := rfl
#align mvqpf.comp.get_map MvQPF.Comp.get_map

instance : MvQPF (Comp F G) where
  P := MvPFunctor.comp (P F) fun i ↦ P <| G i
  abs := Comp.mk ∘ (map fun i ↦ abs) ∘ abs ∘ MvPFunctor.comp.get
  repr {α} := MvPFunctor.comp.mk ∘ repr ∘
              (map fun i ↦ (repr : G i α → (fun i : Fin2 n ↦ Obj (P (G i)) α) i)) ∘ Comp.get
  abs_repr := by intros; simp only [(· ∘ ·), comp.get_mk, abs_repr, map_map,
                                    TypeVec.comp, MvFunctor.id_map', Comp.mk_get]
  abs_map := by intros; simp only [(· ∘ ·)]; rw [← abs_map]
                simp only [comp.get_map, map_map, TypeVec.comp, abs_map, map_mk]

end Comp

end MvQPF


import data.set.basic

import topology.basic
import algebra.module.basic
import algebra.module.submodule

import analysis.normed_space.basic

-- On désigne par p1 et p2 les applications coordonnées de R 2 définies par pi (x1 , x2 ) = xi.
-- (a) Soit O un ouvert de R 2 , montrer que p 1 (O) et p 2 (O) sont des ouverts de R.
-- (b) Soit H = (x, y) ∈ R 2 xy = 1. Montrer que H est un fermé de R 2 et que p 1 (H) et p 2 (H) ne sont pas des fermés de R .
-- (c) Montrer que si F est fermé et que p2 (F) est borné, alors p1 (F) est fermé.

theorem b:
  let h p := (prod.fst p) *  (prod.snd p) = 1 in
       (is_closed h)
    /\ not (is_closed (prod.fst '' h))
    /\ not (is_closed (prod.snd '' h))
:= sorry


import GMLAlgebra.Basic
import GMLAlgebra.Semigroup
import GMLAlgebra.Category

namespace Algebra
variable {α} (s : MonoidSig α)

local infixr:70 " ⋆ " => s.op
local notation "e" => s.id

class Monoid extends Semigroup (no_index s.toSemigroupSig) : Prop where
  protected op_left_id (x) : e ⋆ x = x
  protected op_right_id (x) : x ⋆ e = x

protected def Monoid.infer [OpAssoc s.op] [OpLeftId s.op s.id] [OpRightId s.op s.id] : Monoid s where
  op_assoc := op_assoc _
  op_left_id := op_left_id _
  op_right_id := op_right_id _

namespace Monoid
variable {s} [self : Monoid s]

instance : OpLeftId (no_index s.op) (no_index s.id) := ⟨Monoid.op_left_id⟩
instance : OpRightId (no_index s.op) (no_index s.id) := ⟨Monoid.op_right_id⟩

instance : Category (no_index s.toCategorySig) where
  toSemicategory := Semicategory.infer _
  dop_left_id _ _ := op_left_id s.op
  dop_right_id _ _ := op_right_id s.op

end Monoid

class CommMonoid extends CommSemigroup (no_index s.toSemigroupSig) : Prop where
  protected op_right_id (x) : x ⋆ e = x

protected def CommMonoid.infer [OpAssoc s.op] [OpComm s.op] [OpRightId s.op s.id] : CommMonoid s where
  op_assoc := op_assoc _
  op_comm := op_comm _
  op_right_id := op_right_id _

namespace CommMonoid
variable {s} [self : CommMonoid s]

local instance : OpRightId (no_index s.op) (no_index s.id) := ⟨CommMonoid.op_right_id⟩

protected theorem op_left_id (x) : e ⋆ x = x := calc
  _ = x ⋆ e := by rw [op_comm (.⋆.)]
  _ = x := by rw [op_right_id (.⋆.)]
local instance : OpLeftId (no_index s.op) (no_index s.id) := ⟨CommMonoid.op_left_id⟩

instance : Monoid s := Monoid.infer s

end CommMonoid

class CancelMonoid extends Monoid s, CancelSemigroup (no_index s.toSemigroupSig) : Prop

protected def CancelMonoid.infer [OpAssoc s.op] [OpLeftId s.op s.id] [OpRightId s.op s.id] [OpLeftCancel s.op] [OpRightCancel s.op] : CancelMonoid s where
  op_assoc := op_assoc _
  op_left_id := op_left_id _
  op_right_id := op_right_id _
  op_left_cancel := op_left_cancel _
  op_right_cancel := op_right_cancel _

namespace CancelMonoid
variable {s} [self : CancelMonoid s]

instance : CancelCategory (no_index s.toCategorySig) where
  toCategory := Category.infer _
  dop_left_cancel _ _ _ := op_left_cancel s.op
  dop_right_cancel _ _ _ := op_right_cancel s.op

end CancelMonoid

class CancelCommMonoid extends CommMonoid s, CancelCommSemigroup (no_index s.toSemigroupSig) : Prop

protected def CancelCommMonoid.infer [OpAssoc s.op] [OpComm s.op] [OpRightId s.op s.id] [OpRightCancel s.op] : CancelCommMonoid s where
  op_assoc := op_assoc _
  op_comm := op_comm _
  op_right_id := op_right_id _
  op_right_cancel := op_right_cancel _

end Algebra


import utils
import data.vector data.list

open utils

section grids

class relative_grid (α : Type*) :=
  (carrier : Type)
  (rows    : α → ℕ)
  (cols    : α → ℕ)
  (unempty : Πg, rows g * cols g > 0)
  (data    : Πg, bounded 0 (rows g) → bounded 0 (cols g) → carrier)

class grid (α : Type*) extends relative_grid α :=
  (bottom_left : α → point)

variables {α : Type*} [grid α] (g : α)

open grid relative_grid

def size := rows g * cols g

def gsize := @size α

def top_right (bottom_left : point) (r c : ℕ) : point :=
  ⟨bottom_left.x + c, bottom_left.y - r⟩

def top_right' (bottom_left : point) {α : Type*} [relative_grid α] (g : α) :=
  top_right bottom_left (rows g) (cols g)

lemma linear_bounds {a b : ℤ} {c : ℕ} (h₁ : a < b) (h₂ : b - ↑c ≤ a) :
  int.nat_abs(a + ↑c - b) < c :=
begin
  rw [← sub_nonneg, ← sub_add, sub_add_eq_add_sub] at h₂,
  rw [
    ← int.coe_nat_lt, int.nat_abs_of_nonneg h₂,
    sub_lt_iff_lt_add', add_lt_add_iff_right
  ], exact h₁
end

structure bounding_box := (p₁ : point) (p₂ : point) (h : p₁ ↗ p₂)

def bound_box_str : bounding_box → string
  | ⟨p₁, p₂, _⟩ := "<(" ++ to_string p₁ ++ ", " ++ to_string p₂ ++ ")>"

instance : has_to_string bounding_box := ⟨bound_box_str⟩

instance : has_repr bounding_box := ⟨bound_box_str⟩

def points_of_box (bb : bounding_box) : point × point := ⟨bb.p₁, bb.p₂⟩

def rows_of_box : bounding_box → ℕ
  | ⟨⟨_, y₁⟩, ⟨_, y₂⟩, _⟩ := int.nat_abs (y₁ - y₂)

def cols_of_box : bounding_box → ℕ
  | ⟨⟨x₁, _⟩, ⟨x₂, _⟩, _⟩ := int.nat_abs (x₂ - x₁)

def rows_of_box_pos {bb : bounding_box} : rows_of_box bb > 0 :=
let ⟨⟨_, y₁⟩, ⟨_, y₂⟩, h⟩ := bb in
begin
  simp only [rows_of_box],
  simp [(↗)] at h,
  simp only [(>)],
  rw ← int.coe_nat_lt_coe_nat_iff,
  rw int.nat_abs_of_nonneg,
  rw lt_sub_iff, simp, exact h.right,
  simp only [(≥)],
  apply le_of_lt,
  rw lt_sub_iff, simp, exact h.right
end

def cols_of_box_pos {bb : bounding_box} : cols_of_box bb > 0 :=
let ⟨⟨x₁, _⟩, ⟨x₂, _⟩, h⟩ := bb in
begin
  simp only [cols_of_box],
  simp [(↗)] at h,
  simp only [(>)],
  rw ← int.coe_nat_lt_coe_nat_iff,
  rw int.nat_abs_of_nonneg,
  rw lt_sub_iff, simp, exact h.left,
  simp only [(≥)],
  apply le_of_lt,
  rw lt_sub_iff, simp, exact h.left
end

attribute [simp]
def grid_rows := rows g

attribute [simp]
def grid_cols := cols g

attribute [simp]
def grid_bottom_left := bottom_left g

attribute [simp]
def grid_top_right := top_right (bottom_left g) (rows g) (cols g)

def rows_cols_bounded {rows cols : ℕ} (h₁ : rows > 0) (h₂ : cols > 0)
  (o : point) : o↗{x := o.x + ↑cols, y := o.y - ↑rows} :=
  begin
    cases o, simp [(↗)],
    exact and.intro h₂ (sub_lt_self _ begin simp [(>)], exact h₁ end)
  end

def grid_bounding_boxes :
  bottom_left g ↗ grid_top_right g :=
begin
  simp [grid_bounded_iff, (↗), top_right, grid.bottom_left],
  have h := gt_both_of_mult (relative_grid.unempty g),
  exact and.intro h.right (sub_lt_self _ (by simp [(>)]; exact h.left))
end

def bbox_of_grid (g : α) : bounding_box :=
  ⟨bottom_left g, grid_top_right g, grid_bounding_boxes g⟩

structure relative_point :=
  (x : bounded 0 (rows g))
  (y : bounded 0 (cols g))

def relative_point_str : relative_point g → string
  | ⟨x, y⟩ := "[" ++ to_string x ++ ", " ++ to_string y ++ "]"

instance has_to_string_rp : has_to_string (relative_point g) :=
  ⟨relative_point_str g⟩

instance has_repr_rp : has_repr (relative_point g) :=
  ⟨relative_point_str g⟩

structure grid_point :=
  (x : bounded ((grid_top_right g).y) ((bottom_left g).y))
  (y : bounded ((bottom_left g).x) ((grid_top_right g).x))

def grid_point_str : grid_point g → string
  | ⟨x, y⟩ := "[" ++ to_string x ++ ", " ++ to_string y ++ "] - " ++
             to_string (bottom_left g)

instance has_to_string_gp : has_to_string (grid_point g) := ⟨grid_point_str g⟩

instance has_repr_gp : has_repr (grid_point g) := ⟨grid_point_str g⟩

def apoint_of_gpoint {g : α} : grid_point g → relative_point g
  | ⟨⟨x, ⟨lbx, ubx⟩⟩, ⟨y, ⟨lby, uby⟩⟩⟩ :=
    let top_left_x := (bottom_left g).x in
    let top_left_y := (bottom_left g).y - rows g in ⟨
      ⟨int.nat_abs (x - top_left_y),
        have h : x - top_left_y ≥ 0,
          from iff.elim_right le_sub_iff_add_le
            begin
              simp [grid_top_right, top_right] at lbx,
              simp [top_left_y],
              exact lbx
            end,
          and.intro
            (int.le_of_coe_nat_le_coe_nat $
             eq.symm (int.nat_abs_of_nonneg h) ▸ h)
            (iff.elim_left (int.coe_nat_lt_coe_nat_iff _ _) $
             eq.symm (int.nat_abs_of_nonneg h) ▸
             begin
               simp only [top_left_y], rw ← sub_add,
               rw ← zero_add (↑(rows g)), conv { to_lhs, simp only [zero_add]},
               rw add_lt_add_iff_right,
               rw sub_lt_iff,
               simp,
               exact ubx
             end)⟩,
      ⟨int.nat_abs (y - top_left_x),
        have h : y - top_left_x ≥ 0,
          from iff.elim_right le_sub_iff_add_le
            begin
              simp [top_left_y],
              exact lby
            end,
        and.intro
          (int.le_of_coe_nat_le_coe_nat $
           eq.symm (int.nat_abs_of_nonneg h) ▸ h)
          (iff.elim_left (int.coe_nat_lt_coe_nat_iff _ _) $
           eq.symm (int.nat_abs_of_nonneg h) ▸
           begin
             simp only [top_left_x],
             simp only [grid_top_right, top_right] at uby,
             rw sub_lt_iff,
             rw add_comm,
             exact uby
           end
          )⟩
    ⟩

def gpoint_of_apoint {g : α} : relative_point g → grid_point g
  | ⟨⟨x, ⟨lbx, ubx⟩⟩, ⟨y, ⟨lby, uby⟩⟩⟩ :=
    let top_left_x := (bottom_left g).x in
    let top_left_y := (bottom_left g).y - rows g in ⟨
      ⟨top_left_y + x,
       and.intro
        (by simp [top_left_y, top_right])
        begin
          simp [top_left_y, top_right],
          conv { to_rhs, rw ← add_zero (bottom_left g).y},
          rw add_lt_add_iff_left, rw ← sub_eq_add_neg,
          rw sub_lt_iff, simp,
          rw int.coe_nat_lt, exact ubx
        end⟩,
      ⟨top_left_x + y,
       and.intro
        (by simp [top_left_x])
        begin
          simp [top_left_x, grid_top_right, top_right],
          rw int.coe_nat_lt, exact uby
        end⟩
    ⟩

def prod_of_rel_point {g : α} (rp : relative_point g) := (rp.x, rp.y)

def prod_of_grid_point {g : α} (ap : grid_point g) := (ap.x, ap.y)

def grid_point_of_prod {g : α}
  (p : bounded ((bottom_left g).x) ((grid_top_right g).x) ×
       bounded ((grid_top_right g).y) ((bottom_left g).y)) : grid_point g :=
  ⟨p.snd, p.fst⟩

def grid_point_of_prod' {g : α}
  (p : bounded ((grid_top_right g).y) ((bottom_left g).y) ×
       bounded ((bottom_left g).x) ((grid_top_right g).x)) : grid_point g :=
  ⟨p.fst, p.snd⟩

def abs_data (g : α) :=
  (function.uncurry (data g)) ∘ prod_of_rel_point ∘ apoint_of_gpoint

lemma grid_rows_eq_bly_sub_try :
  grid_rows g = int.nat_abs ((bottom_left g).y - (grid_top_right g).y) :=
begin
  unfold grid_rows grid_top_right top_right,
  dsimp,
  repeat {rw ← sub_eq_add_neg},
  rw [← sub_add, sub_self, zero_add],
  refl
end

lemma grid_cols_eq_trx_sub_blx
  : grid_cols g = int.nat_abs ((grid_top_right g).x - (bottom_left g).x) :=
begin
  unfold grid_cols grid_top_right top_right,
  dsimp,
  rw [← sub_eq_add_neg, add_comm, add_sub_cancel],
  refl
end

lemma bounded_establishes_bounds {a b : ℤ}
  (h : a < b) (x : bounded 0 (int.nat_abs (b - a))) :
  a ≤ a + ↑x ∧ a + ↑x < b :=
have xpos : ↑x ≥ 0, from positive_bounded _,
have xmax : ↑x < int.nat_abs (b - a), from bounded_lt _,
and.intro begin
            apply le_add_of_nonneg_right,
            unfold coe at *
          end
          begin
            rw [add_comm, ← lt_sub_iff],
            unfold_coes at *,
            rw [← int.coe_nat_lt, int.nat_abs_of_nonneg] at xmax,
            exact xmax,
            simp [(≥)],
            rw [
              ← sub_eq_add_neg, ← add_le_add_iff_right a,
              zero_add, sub_add_cancel
            ],
            apply int.le_of_lt,
            exact h
          end

end grids

section grid_impls

structure grid₀ (α : Type) :=
  (r : ℕ)
  (c : ℕ)
  (h : r * c > 0)
  (data : vector α (r * c))

structure agrid₀ (α : Type) extends grid₀ α :=
  (o : point)

structure fgrid (α : Type) :=
  (r : ℕ)
  (c : ℕ)
  (h : r * c > 0)
  (o : point)
  (data : bounded (o.y - r) o.y → bounded o.x (o.x + c) → α)

end grid_impls

section grid_instances

lemma linearize_array {x y r c : ℕ}
  (xb : is_bounded 0 c x) (yb : is_bounded 0 r y) : y * c + x < r * c :=
let ⟨xl, xu⟩ := xb in
let ⟨yl, yu⟩ := yb in
have rows_pos : 0 < r, from lt_of_le_of_lt yl yu,
have cols_pos : 0 < c, from lt_of_le_of_lt xl xu,
have h₁ : y * c < r * c,
  from mul_lt_mul yu (le_refl _) cols_pos (le_of_lt rows_pos),
have h₂ : ∃n, nat.succ y + n = r, from nat_le_dest yu,
let ⟨n, h₂⟩ := h₂ in
by rw [← h₂, right_distrib, nat.succ_mul, add_assoc];
   exact add_lt_add_of_le_of_lt (le_refl _)
         (@nat.lt_add_right _ _ _ xu)

instance rg_grid₀ {α : Type} :
  relative_grid (grid₀ α) := {
    carrier := α,
    rows    := λg, g.r,
    cols    := λg, g.c,
    unempty := λg, g.h,
    data    :=
    λg ⟨y, ⟨yl, yu⟩⟩ ⟨x, ⟨xl, xu⟩⟩,
      g.data.nth ⟨
        y * g.c + x,
        linearize_array (is_bounded_of_bounds xl xu)
                        (is_bounded_of_bounds yl yu)
      ⟩
}

instance rg_agrid₀ {α : Type} :
  relative_grid (agrid₀ α) := {
    carrier := α,
    rows    := λg, g.r,
    cols    := λg, g.c,
    unempty := λ⟨⟨_, _, p, _⟩, _⟩, p,
    data    :=
    λg ⟨y, ⟨yl, yu⟩⟩ ⟨x, ⟨xl, xu⟩⟩,
      g.data.nth ⟨
        y * g.c + x,
        linearize_array (is_bounded_of_bounds xl xu)
                        (is_bounded_of_bounds yl yu)
      ⟩
}

lemma absolute_bounds (o : ℤ) (r : ℕ) (x : bounded 0 r) : o - ↑r + ↑x < o :=
begin
  simp, conv {to_rhs, rw ← add_zero o},
  rw add_lt_add_iff_left, apply add_lt_of_lt_sub_right,
  rw zero_sub, apply neg_lt_neg,
  cases x, rw ← coe_is_z_of_bounded,
  simp [z_of_bounded],
  rw int.coe_nat_lt, exact x_property.right
end

instance rg_fgrid {α : Type} :
  relative_grid (fgrid α) := {
    carrier := α,
    rows    := λg, g.r,
    cols    := λg, g.c,
    unempty := λg, g.h,
    data    := λg x y,
    g.data ⟨g.o.y - ↑g.r + x,
            and.intro (le_add_of_nonneg_right $ by cases x; unfold_coes)
                      (absolute_bounds g.o.y g.r x)⟩
           ⟨g.o.x + y,
            and.intro (le_add_of_nonneg_right $ by cases x; unfold_coes)
                      (add_lt_add_left (
                        let ⟨y, ⟨_, h⟩⟩ := y in
                        iff.elim_right int.coe_nat_lt h) g.o.x)⟩
}

instance ag_agrid₀ {α : Type} :
  grid (agrid₀ α) := {
    bottom_left := λg, g.o
  }

instance ag_f {α : Type} :
  grid (fgrid α) := {
    bottom_left := λg, g.o
  }

def point_of_grid_point {α : Type*} [grid α] (g : α) : grid_point g → point
  | ⟨b₁, b₂⟩ := ⟨b₁, b₂⟩

instance point_grid_point_coe {α : Type*} [grid α] (g : α) :
  has_coe (grid_point g) point := ⟨point_of_grid_point g⟩

end grid_instances

section finite_grid

open list int

notation `[|`:max x `|]`:0 := nat_abs x

variables {α : Type*} [grid α] (g : α)

def grid_row {c d : ℤ} (a b : ℤ) (row : bounded c d)
  : list (bounded a b × bounded c d) :=
  zip (range a b) (repeat row [|b - a|])

def grid_row_pure (a b row : ℤ) : list point :=
  map (function.uncurry point.mk) $ zip (range_pure a b) (repeat row [|b - a|])

lemma grid_row_pure_bounds {a b row : ℤ} :
  ∀{c : point}, c ∈ grid_row_pure a b row →
    is_bounded a b c.x ∧ is_bounded row (row + 1) c.y :=
assume c h,
begin
  simp [grid_row_pure] at h,
  cases h with a₁ h₁,
  cases h₁ with b₁ h₂,
  cases h₂ with h₂ h₃,
  have h₄ : a₁ ∈ range_pure a b, from pair_in_zip_l h₂,
  have h₅ : b₁ ∈ repeat row [|b + -a|], from pair_in_zip_r h₂,
  split; split,
    {
      rw ← h₃,
      have h₆ : (function.uncurry point.mk (a₁, b₁)).x = a₁,
        by simp [function.uncurry], rw h₆,
      have h₇ : is_bounded a b a₁, from range_pure_bounded h₄,
      cases h₇ with h₇ _,
      exact h₇
    },
    {
      rw ← h₃,
      have h₆ : (function.uncurry point.mk (a₁, b₁)).x = a₁,
        by simp [function.uncurry], rw h₆,
      have h₇ : is_bounded a b a₁, from range_pure_bounded h₄,
      cases h₇ with _ h₇,
      exact h₇
    },
    {
      rw ← h₃,
      have h₆ : (function.uncurry point.mk (a₁, b₁)).y = b₁,
        by simp [function.uncurry], rw h₆,
      have h₇ : b₁ = row, from repeat_bounded h₅,
      rw h₇
    },
    {
      rw ← h₃,
      have h₆ : (function.uncurry point.mk (a₁, b₁)).y = b₁,
        by simp [function.uncurry], rw h₆,
      have h₇ : b₁ = row, from repeat_bounded h₅,
      rw h₇,
      exact lt_add_succ _ _
    }
end

lemma grid_row_empty_iff {c d : ℤ} (a b : ℤ) (row : bounded c d) :
  grid_row a b row = [] ↔ b ≤ a :=
by unfold grid_row; exact
iff.intro
  (λh, begin
         rw zip_nil_iff at h,
         cases h,
           {rw range_empty_iff at h, exact h},
           {rw repeat_nil at h,
            rw nat_abs_zero_iff at h,
            finish}
       end)
  (λh, have h₁ : range a b = [],
         from iff.elim_right (range_empty_iff _ _) h,
       by rw h₁; refl)

lemma grid_row_length {c d : ℤ} {a b : ℤ} (h : a < b) {x : bounded c d} :
  length (grid_row a b x) = nat_abs (b - a) :=
begin
  unfold grid_row,
  rw length_zip_left,
  exact range_length (int.le_of_lt h),
  rw length_repeat,
  exact range_length (int.le_of_lt h)
end

lemma grid_row_pure_length {a b : ℤ} (h : a < b) {x : ℤ} :
  length (grid_row_pure a b x) = nat_abs (b - a) :=
begin
  unfold grid_row_pure,
  rw length_map,
  rw length_zip_left,
  exact range_length_pure (int.le_of_lt h),
  rw length_repeat,
  exact range_length_pure (int.le_of_lt h)
end

def grid_indices (p₁ p₂ : point) : list (bounded p₁.x p₂.x × bounded p₂.y p₁.y)
  := join (map (grid_row p₁.x p₂.x) (range p₂.y p₁.y))

def grid_indices_pure (p₁ p₂ : point) : list point :=
  join (map (grid_row_pure p₁.x p₂.x) (range_pure p₂.y p₁.y))

open relative_grid grid

def grid_indices_g := grid_indices (bottom_left g) (grid_top_right g)

def grid_indices_g_pure := grid_indices_pure (bottom_left g) (grid_top_right g)

def is_in_grid' (xy : point) :=
  is_bounded (grid_top_right g).y (grid_bottom_left g).y xy.y ∧
  is_bounded (grid_bottom_left g).x (grid_top_right g).x xy.x

def is_in_grid (bb : bounding_box) (xy : point) :=
  is_bounded bb.p₂.y bb.p₁.y xy.y ∧ is_bounded bb.p₁.x bb.p₂.x xy.x

lemma grid_indices_pure_in_grid {p₁ p₂ : point} {h : p₁ ↗ p₂} :
  ∀{a}, a ∈ grid_indices_pure p₁ p₂ → is_in_grid ⟨p₁, p₂, h⟩ a :=
assume a h,
begin
  cases a with al ar,
  simp [grid_indices_pure] at h,
  cases h with l h, cases h with h h₁,
  cases h with a₁ h₂, cases h₂ with h₂ h₃,
  have h₄ := range_pure_bounded h₂,
  rw ← h₃ at h₁,
  have h₅ := grid_row_pure_bounds h₁,
  split; split,
    {
      simp [bounding_box.p₁],
      cases h₅ with h₅l h₅r,
      cases h₅l with h₅l₁ h₅l₂,
      cases h₅r with h₅r₁ h₅r₂,
      simp [point.x, point.y] at *,
      cases h₄ with h₄l h₄r,
      transitivity a₁; assumption
    },
    {
      have h₄ := range_pure_bounded h₂,
      exact lt_of_le_of_lt (le_of_lt_add_one h₅.right.right) h₄.right
    },
    {exact h₅.left.left},
    {exact h₅.left.right}
end

def grid_indices_g_pure_in_grid {g : α} :
  ∀{a}, a ∈ grid_indices_g_pure g → is_in_grid (bbox_of_grid g) a :=
assume a h, grid_indices_pure_in_grid h

def decide_grid :=
  map (abs_data g ∘ grid_point_of_prod) (grid_indices_g g)

lemma attach_length {α : Type} {l : list α} :
  length (list.attach l) = length l :=
begin
  induction l with x xs ih,
    {
      refl
    },
    {
      simp [attach]
    }
end

def make_bounded_idx {g : α} (p : point) (h : is_in_grid (bbox_of_grid g) p) :
  bounded ((bottom_left g).x) ((grid_top_right g).x) ×
  bounded ((grid_top_right g).y) ((bottom_left g).y) :=
    (make_bounded h.right, make_bounded h.left)

def make_bounded_indices (is : list point)
                         (h : ∀p, p ∈ is → is_in_grid (bbox_of_grid g) p) :
  list (
    bounded ((bottom_left g).x) ((grid_top_right g).x) ×
    bounded ((grid_top_right g).y) ((bottom_left g).y)
  ) := map (λp : {x // x ∈ is},
         (⟨p.val.x, (h p.val p.property).right⟩,
          ⟨p.val.y, (h p.val p.property).left⟩)) (attach is)

def decide_grid_pure :=
  map (abs_data g ∘ grid_point_of_prod ∘
       (λidx : {x // x ∈ grid_indices_g_pure g},
          make_bounded_idx idx.val (grid_indices_g_pure_in_grid idx.property)))
          (attach $ grid_indices_g_pure g)

lemma grid_indices_ignores_data {α : Type*} [grid α] {g : α} :
  grid_indices_g g = grid_indices (grid_bottom_left g) (grid_top_right g) := rfl

def fgrid_iso_grid [decidable_eq (carrier α)] (g₁ g₂ : α) : bool :=
    rows g₁ = rows g₂ ∧ cols g₁ = cols g₂ ∧ bottom_left g₁ = bottom_left g₂ ∧
    let l₁ := decide_grid g₁ in
    let l₂ := decide_grid g₂ in
    if list_iso l₁ l₂ then tt else ff

infix `~ₘ`:100 := fgrid_iso_grid

instance gdec [decidable_eq (carrier α)] (g₁ g₂ : α) : decidable (g₁ ~ₘ g₂) :=
  by apply_instance

lemma fgrid_iso_refl [decidable_eq (carrier α)] : g ~ₘ g :=
  by simp [fgrid_iso_grid, list_iso_refl]

lemma fgrid_iso_symm [decidable_eq (carrier α)] {g₁ g₂ : α}
  (h : g₁ ~ₘ g₂) : g₂ ~ₘ g₁ :=
begin
  simp [fgrid_iso_grid] at h, simp [fgrid_iso_grid],
  split; try {split},
    {exact eq.symm h.left},
    {exact eq.symm h.right.left},
    {split, exact eq.symm h.right.right.left,
            apply list_iso_symm, exact h.right.right.right}
end

lemma fgrid_iso_trans [decidable_eq (carrier α)] {g₁ g₂ g₃ : α}
  (h : g₁ ~ₘ g₂) (h₁ : g₂ ~ₘ g₃) : g₁ ~ₘ g₃ :=
begin
  simp [fgrid_iso_grid], simp [fgrid_iso_grid] at h h₁,
  split; try {split},
    {cc},
    {transitivity cols g₂, exact h.right.left, exact h₁.right.left},
    {split, transitivity bottom_left g₂, exact h.right.right.left,
     exact h₁.right.right.left,
     exact list_iso_trans h.right.right.right h₁.right.right.right}
end

lemma caut_iso_size [decidable_eq (carrier α)] {g₁ g₂ : α}
  (h : g₁ ~ₘ g₂) : gsize g₁ = gsize g₂ :=
begin
  simp [fgrid_iso_grid] at h,
  by_cases h₁ : rows g₁ = rows g₂;
  by_cases h₂ : cols g₁ = cols g₂; try {cc},
    {unfold gsize size relative_grid.rows relative_grid.cols, cc}
end

section grid_instances

instance fgrid_functor : functor fgrid := {
  map := λα β f g, ⟨g.r, g.c, g.h, g.o, λx y, f (g.data x y)⟩
}

end grid_instances

def point_of_bounded_prod {a b c d : ℤ} : bounded a b × bounded c d → point
  | ⟨⟨a, _⟩, ⟨c, _⟩⟩ := ⟨a, c⟩

lemma grid_indices_bad_horizontal {p₁ p₂ : point}
  (h : p₂.x ≤ p₁.x) : grid_indices p₁ p₂ = [] :=
begin
  unfold grid_indices,
  cases p₁, cases p₂,
  unfold_projs at *,
  apply join_empty_of_all_empty,
  intros x h₁,
  rw list.mem_map at h₁,
  cases h₁, cases h₁_h,
  rw [← h₁_h_right, grid_row_empty_iff],
  exact h
end

lemma grid_indices_bad_vertical {p₁ p₂ : point}
  (h : p₁.y ≤ p₂.y) : grid_indices p₁ p₂ = [] :=
begin
  unfold grid_indices,
  cases p₁, cases p₂,
  unfold_projs at *,
  have h₁ : range p₂_y p₁_y = [],
    from iff.elim_right (range_empty_iff _ _) h,
  rw h₁, refl
end

-- This takes forever to typecheck due to generalize
-- lemma range_ex {a b : ℤ} (h : a < b) :
--   range a b = ⟨a, and.intro (le_refl _) h⟩ ::
--               list.map range_weaken (range (a + 1) b) :=
-- begin
--   generalize hack : range (a + 1) b = l,
--   unfold1 utils.range, simp [h],
--   rw ← hack
-- end

lemma range_ex {a b : ℤ} (h : a < b) : ∀l, range (a + 1) b = l →
  range a b = ⟨a, and.intro (le_refl _) h⟩ ::
              list.map range_weaken l :=
assume l hack,
begin
  unfold1 utils.range,
  rw [dif_pos h, ← hack]
end

lemma grid_indices_bad_iff (p₁ p₂ : point) :
  grid_indices p₁ p₂ = [] ↔ ¬p₁ ↗ p₂ :=
iff.intro (λh, begin
                 intros contra,
                 cases p₁; cases p₂,
                 simp [(↗)] at contra,
                 cases contra with l r,
                 unfold grid_indices at h,
                 dsimp at h,
                 revert h,
                 rw range_ex r (range (p₂_y + 1) p₁_y) rfl,
                 unfold map join grid_row,
                 rw range_ex l (range (p₁_x + 1) p₂_x) rfl,
                 have h₂ : nat_abs (p₂_x - p₁_x) ≥ 1,
                   from nat_abs_of_lt l,
                 rw repeat_more, unfold zip zip_with,
                 intros contra, cases contra, exact h₂
               end
          )
          (λh, begin
                 rw not_grid_bounded_iff at h,
                 cases h, exact grid_indices_bad_horizontal h,
                 exact grid_indices_bad_vertical h
               end
          )

lemma grid_indices_length {p₁ p₂ : point} (h : p₁ ↗ p₂) :
  length (grid_indices p₁ p₂) = [|p₁.y - p₂.y|] * [|p₂.x - p₁.x|] :=
begin
  rw [← int.coe_nat_eq_coe_nat_iff, ← nat_abs_mul],
  rw grid_bounded_iff at h,
  have h₁ : (p₁.y - p₂.y) * (p₂.x - p₁.x) > 0, from
    mul_pos begin
              simp [(>)],
              rw ← add_lt_add_iff_right p₂.y,
              rw zero_add, simp, exact h.right
            end
            begin
              simp [(>)],
              rw ← add_lt_add_iff_right p₁.x,
              rw zero_add, simp, exact h.left
            end,
  rw nat_abs_of_nonneg (int.le_of_lt h₁),
  unfold grid_indices,
  rw [length_join, map_map],
  simp [(∘)],
  simp [grid_row_length h.left ],
  rw range_length (int.le_of_lt h.right),
  repeat {rw ← sub_eq_add_neg},
  repeat {rw nat_abs_of_nonneg},
  rw mul_comm,
  simp [(≥)],
  rw [
    ← sub_eq_add_neg,
    ← add_le_add_iff_right p₂.y,
    zero_add, sub_add_cancel
  ], exact (int.le_of_lt h.right),
  simp [(≥)],
  rw [
    ← sub_eq_add_neg,
    ← add_le_add_iff_right p₁.x,
    zero_add,
    sub_add_cancel
  ],
  exact (int.le_of_lt h.left)
end

lemma grid_indices_pure_length {p₁ p₂ : point} (h : p₁ ↗ p₂) :
  length (grid_indices_pure p₁ p₂) = [|p₁.y - p₂.y|] * [|p₂.x - p₁.x|] :=
begin
  rw [← int.coe_nat_eq_coe_nat_iff, ← nat_abs_mul],
  rw grid_bounded_iff at h,
  have h₁ : (p₁.y - p₂.y) * (p₂.x - p₁.x) > 0, from
    mul_pos begin
              simp [(>)],
              rw ← add_lt_add_iff_right p₂.y,
              rw zero_add, simp, exact h.right
            end
            begin
              simp [(>)],
              rw ← add_lt_add_iff_right p₁.x,
              rw zero_add, simp, exact h.left
            end,
  rw nat_abs_of_nonneg (int.le_of_lt h₁),
  unfold grid_indices_pure,
  rw [length_join, map_map],
  simp [(∘)],
  simp [grid_row_pure_length h.left],
  rw range_length_pure (int.le_of_lt h.right),
  repeat {rw ← sub_eq_add_neg},
  repeat {rw nat_abs_of_nonneg},
  rw mul_comm,
  simp [(≥)],
  rw [
    ← sub_eq_add_neg,
    ← add_le_add_iff_right p₂.y,
    zero_add, sub_add_cancel
  ], exact (int.le_of_lt h.right),
  simp [(≥)],
  rw [
    ← sub_eq_add_neg,
    ← add_le_add_iff_right p₁.x,
    zero_add,
    sub_add_cancel
  ],
  exact (int.le_of_lt h.left)
end

lemma grid_indices_len_g_pure :
  length (grid_indices_g_pure g) =
  length (grid_indices_pure (bottom_left g) (grid_top_right g)) :=
  by simp [grid_indices_g_pure]

theorem decide_grid_length {α : Type*} [grid α] (g : α) :
  length (decide_grid g) = grid_rows g * grid_cols g :=
begin
  unfold decide_grid grid_indices_g,
  rw [
    length_map,
    grid_rows_eq_bly_sub_try, grid_cols_eq_trx_sub_blx, grid_indices_length
  ],
  exact grid_bounding_boxes g
end

theorem decide_grid_pure_length {α : Type*} [grid α] (g : α) :
  length (decide_grid_pure g) = grid_rows g * grid_cols g :=
begin
  unfold decide_grid_pure grid_indices_g_pure,
  rw length_map,
  rw grid_rows_eq_bly_sub_try,
  rw grid_cols_eq_trx_sub_blx,
  rw attach_length,
  rw grid_indices_len_g_pure,
  rw grid_indices_pure_length,
  exact grid_bounding_boxes g
end

def agrid_of_fgrid {α : Type} (g : fgrid α) : agrid₀ α :=
    ⟨⟨g.r, g.c, g.h, ⟨decide_grid g, decide_grid_length g⟩⟩, g.o⟩

def fgrid_of_agrid {α : Type} (g : agrid₀ α) : fgrid α :=
  ⟨g.r, g.c, g.h, g.o, λx y, abs_data g ⟨x, y⟩⟩

instance f_a_coe {α : Type} : has_coe (fgrid α) (agrid₀ α) := ⟨agrid_of_fgrid⟩
instance a_f_coe {α : Type} : has_coe (agrid₀ α) (fgrid α) := ⟨fgrid_of_agrid⟩

def row (n : bounded 0 (relative_grid.rows g)) :
  (bounded 0 (relative_grid.cols g)) → relative_grid.carrier α :=
  relative_grid.data g n

def col (n : bounded 0 (relative_grid.cols g)) :
  (bounded 0 (relative_grid.rows g)) → relative_grid.carrier α :=
  flip (relative_grid.data g) n

def top :=
  row g ⟨0,
    and.intro (le_refl _)
              begin
                exact and.elim_left (gt_both_of_mult (relative_grid.unempty g))
              end⟩

def bot :=
  row g ⟨nat.pred (relative_grid.rows g),
         and.intro (nat.zero_le _)
                   begin
                     apply nat.pred_lt,
                     have c_unempty := relative_grid.unempty g,
                     unfold_projs,
                     cases relative_grid.rows g,
                     rw zero_mul at c_unempty,
                     have : ¬0 > 0, from gt_irrefl _,
                       contradiction,
                     trivial
                   end⟩

def left :=
  have h : relative_grid.cols g > 0,
    from and.elim_right (gt_both_of_mult (relative_grid.unempty g)),
  col g ⟨0, and.intro (le_refl _) h⟩

def right :=
  have h : relative_grid.cols g > 0,
    from and.elim_right (gt_both_of_mult (relative_grid.unempty g)),
  col g ⟨nat.pred (relative_grid.cols g),
         and.intro (nat.zero_le _)
                   begin
                     apply nat.pred_lt,
                     cases relative_grid.cols g,
                     have : ¬0 > 0, from gt_irrefl _,
                       contradiction,
                     trivial
                   end⟩

def grid_bounds' (h : relative_grid.rows g * relative_grid.cols g > 0)
  : bounding_box :=
  ⟨grid_bottom_left g, grid_top_right g,
   have h : _ := gt_both_of_mult h,
   rows_cols_bounded h.left h.right _⟩

def grid_bounds : bounding_box :=
  ⟨grid_bottom_left g, grid_top_right g,
     have h : _ := gt_both_of_mult (relative_grid.unempty g),
     rows_cols_bounded h.left h.right _⟩

instance decidable_is_in_grid' {xy : point}
   : decidable (is_in_grid' g xy) :=
   by simp [is_in_grid']; apply_instance

instance decidable_is_in_grid (bb : bounding_box) {xy : point}
   : decidable (is_in_grid bb xy) :=
   by simp [is_in_grid]; apply_instance

lemma is_in_grid_grid'_iff (xy : point) :
  is_in_grid' g xy ↔
  is_in_grid ⟨grid.bottom_left g,
              grid_top_right g,
              grid_bounding_boxes g⟩ xy :=
iff.intro (λh, and.intro h.left h.right)
          (λh, and.intro h.left h.right)

def overlaid_by (p₁ p₂ : bounding_box) :=
  (p₂.p₁.x ≤ p₁.p₁.x ∧ p₁.p₂.x ≤ p₂.p₂.x) ∧
  (p₂.p₂.y ≤ p₁.p₂.y ∧ p₁.p₁.y ≤ p₂.p₁.y)

def in_grid_bounded (p : point)
  (h : is_in_grid' g p) :=
  let ⟨left, right⟩ :=
    h in (make_bounded left, make_bounded right)

instance overlaid_decidable (p₁ p₂ : bounding_box) :
  decidable (overlaid_by p₁ p₂) := by simp [overlaid_by]; apply_instance

lemma overlaid_by_refl (p : bounding_box) : overlaid_by p p :=
  by simp [overlaid_by]; repeat {split}; refl

lemma overlaid_by_trans {p₁ p₂ p₃ : bounding_box}
  (h : overlaid_by p₁ p₂) (h₁ : overlaid_by p₂ p₃) : overlaid_by p₁ p₃ :=
begin
  simp [overlaid_by] at *; repeat {split}; transitivity,
  exact h₁.left.left, exact h.left.left,
  exact h.left.right, exact h₁.left.right,
  exact h₁.right.left, exact h.right.left,
  exact h.right.right, exact h₁.right.right
end

lemma overlaid_by_antisymm {p₁ p₂ : bounding_box}
  (h : overlaid_by p₁ p₂) (h₁ : overlaid_by p₂ p₁) : p₁ = p₂ :=
begin
  simp [overlaid_by] at *,
  cases h, cases h₁,
  cases h_left, cases h_right,
  cases h₁_left, cases h₁_right,
  cases p₁, cases p₂,
  congr;
  unfold bounding_box.p₁ bounding_box.p₂ at *;
  cases p₁_p₁; cases p₂_p₂;
  cases p₁_p₂; cases p₂_p₁;
  unfold point.x point.y at *; congr;
  apply le_antisymm; assumption
end

lemma is_in_larger {bb₁ bb₂ : bounding_box} {xy : point}
  (h : is_in_grid bb₁ xy) (h₁ : overlaid_by bb₁ bb₂) : is_in_grid bb₂ xy :=
begin
  unfold overlaid_by is_in_grid is_bounded at *,
  exact and.intro (and.intro (le_trans h₁.right.left h.left.left)
                             (lt_of_lt_of_le h.left.right h₁.right.right))
                  (and.intro (le_trans h₁.left.left h.right.left)
                             (lt_of_lt_of_le h.right.right h₁.left.right))
end

end finite_grid

section grid_instances

def split_rows_cols : ℕ → ℕ → list string → list string
  | cols 0 ls := [""]
  | cols (k + 1) ls := list.take cols ls ++ ["\n"]
                       ++ split_rows_cols cols k (list.drop cols ls)

def grid_str {α : Type*} [grid α]
  [has_to_string (relative_grid.carrier α)] (g : α) : string :=
  let points := list.map to_string $ decide_grid g in
    " " ++ (list.foldr append "" $
                       list.intersperse " " $
                       split_rows_cols (relative_grid.cols g)
                                       (relative_grid.rows g) points)

instance grid_repr {α : Type*} [grid α]
  [has_to_string (relative_grid.carrier α)] : has_repr α := ⟨grid_str⟩

instance grid_to_string {α : Type*} [grid α]
  [has_to_string (relative_grid.carrier α)] : has_to_string α := ⟨grid_str⟩

end grid_instances


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/

import geometry.manifold.algebra.structures

/-!
# Algebraic structures over smooth functions

In this file, we define instances of algebraic structures over smooth functions.
-/

noncomputable theory

open_locale manifold

variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
{H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{N : Type*} [topological_space N] [charted_space H N]
{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
{N' : Type*} [topological_space N'] [charted_space H'' N']

namespace smooth_map

@[to_additive]
instance has_mul {G : Type*} [has_mul G] [topological_space G] [charted_space H' G]
  [has_smooth_mul I' G] :
  has_mul C^∞⟮I, N; I', G⟯ :=
⟨λ f g, ⟨f * g, f.smooth.mul g.smooth⟩⟩

@[simp, to_additive]
lemma coe_mul {G : Type*} [has_mul G] [topological_space G] [charted_space H' G]
  [has_smooth_mul I' G] (f g : C^∞⟮I, N; I', G⟯) :
  ⇑(f * g) = f * g := rfl

@[simp, to_additive] lemma mul_comp {G : Type*} [has_mul G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] (f g : C^∞⟮I'', N'; I', G⟯) (h : C^∞⟮I, N; I'', N'⟯) :
(f * g).comp h = (f.comp h) * (g.comp h) :=
by ext; simp only [cont_mdiff_map.comp_apply, coe_mul, pi.mul_apply]

@[to_additive]
instance has_one {G : Type*} [monoid G] [topological_space G] [charted_space H' G] :
  has_one C^∞⟮I, N; I', G⟯ :=
⟨cont_mdiff_map.const (1 : G)⟩

@[simp, to_additive]
lemma coe_one {G : Type*} [monoid G] [topological_space G] [charted_space H' G] :
  ⇑(1 : C^∞⟮I, N; I', G⟯) = 1 := rfl

section group_structure

/-!
### Group structure

In this section we show that smooth functions valued in a Lie group inherit a group structure
under pointwise multiplication.
-/

@[to_additive]
instance semigroup {G : Type*} [semigroup G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] :
  semigroup C^∞⟮I, N; I', G⟯ :=
{ mul_assoc := λ a b c, by ext; exact mul_assoc _ _ _,
  ..smooth_map.has_mul}

@[to_additive]
instance monoid {G : Type*} [monoid G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] :
  monoid C^∞⟮I, N; I', G⟯ :=
{ one_mul := λ a, by ext; exact one_mul _,
  mul_one := λ a, by ext; exact mul_one _,
  ..smooth_map.semigroup,
  ..smooth_map.has_one }

/-- Coercion to a function as an `monoid_hom`. Similar to `monoid_hom.coe_fn`. -/
@[to_additive "Coercion to a function as an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn`.",
  simps]
def coe_fn_monoid_hom {G : Type*} [monoid G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] : C^∞⟮I, N; I', G⟯ →* (N → G) :=
{ to_fun := coe_fn, map_one' := coe_one, map_mul' := coe_mul }

@[to_additive]
instance comm_monoid {G : Type*} [comm_monoid G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] :
  comm_monoid C^∞⟮I, N; I', G⟯ :=
{ mul_comm := λ a b, by ext; exact mul_comm _ _,
  ..smooth_map.monoid,
  ..smooth_map.has_one }

@[to_additive]
instance group {G : Type*} [group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] :
  group C^∞⟮I, N; I', G⟯ :=
{ inv := λ f, ⟨λ x, (f x)⁻¹, f.smooth.inv⟩,
  mul_left_inv := λ a, by ext; exact mul_left_inv _,
  div := λ f g, ⟨f / g, f.smooth.div g.smooth⟩,
  div_eq_mul_inv := λ f g, by ext; exact div_eq_mul_inv _ _,
  .. smooth_map.monoid }

@[simp, to_additive]
lemma coe_inv {G : Type*} [group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] (f : C^∞⟮I, N; I', G⟯) :
  ⇑f⁻¹ = f⁻¹ := rfl

@[simp, to_additive]
lemma coe_div {G : Type*} [group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] (f g : C^∞⟮I, N; I', G⟯) :
  ⇑(f / g) = f / g :=
rfl

@[to_additive]
instance comm_group {G : Type*} [comm_group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] :
  comm_group C^∞⟮I, N; I', G⟯ :=
{ ..smooth_map.group,
  ..smooth_map.comm_monoid }

end group_structure

section ring_structure

/-!
### Ring stucture

In this section we show that smooth functions valued in a smooth ring `R` inherit a ring structure
under pointwise multiplication.
-/

instance semiring {R : Type*} [semiring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] :
  semiring C^∞⟮I, N; I', R⟯ :=
{ left_distrib := λ a b c, by ext; exact left_distrib _ _ _,
  right_distrib := λ a b c, by ext; exact right_distrib _ _ _,
  zero_mul := λ a, by ext; exact zero_mul _,
  mul_zero := λ a, by ext; exact mul_zero _,
  ..smooth_map.add_comm_monoid,
  ..smooth_map.monoid }

instance ring {R : Type*} [ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] :
  ring C^∞⟮I, N; I', R⟯ :=
{ ..smooth_map.semiring,
  ..smooth_map.add_comm_group, }

instance comm_ring {R : Type*} [comm_ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] :
  comm_ring C^∞⟮I, N; I', R⟯ :=
{ ..smooth_map.semiring,
  ..smooth_map.add_comm_group,
  ..smooth_map.comm_monoid,}

/-- Coercion to a function as a `ring_hom`. -/
@[simps]
def coe_fn_ring_hom {R : Type*} [comm_ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] : C^∞⟮I, N; I', R⟯ →+* (N → R) :=
{ to_fun := coe_fn,
  ..(coe_fn_monoid_hom : C^∞⟮I, N; I', R⟯ →* _),
  ..(coe_fn_add_monoid_hom : C^∞⟮I, N; I', R⟯ →+ _) }

/-- `function.eval` as a `ring_hom` on the ring of smooth functions. -/
def eval_ring_hom {R : Type*} [comm_ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] (n : N) : C^∞⟮I, N; I', R⟯ →+* R :=
(pi.eval_ring_hom _ n : (N → R) →+* R).comp smooth_map.coe_fn_ring_hom

end ring_structure

section module_structure

/-!
### Semiodule stucture

In this section we show that smooth functions valued in a vector space `M` over a normed
field `𝕜` inherit a vector space structure.
-/

instance has_smul {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
  has_smul 𝕜 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
⟨λ r f, ⟨r • f, smooth_const.smul f.smooth⟩⟩

@[simp]
lemma coe_smul {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V]
  (r : 𝕜) (f : C^∞⟮I, N; 𝓘(𝕜, V), V⟯) :
  ⇑(r • f) = r • f := rfl

@[simp] lemma smul_comp {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V]
  (r : 𝕜) (g : C^∞⟮I'', N'; 𝓘(𝕜, V), V⟯) (h : C^∞⟮I, N; I'', N'⟯) :
(r • g).comp h = r • (g.comp h) := rfl

instance module {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
  module 𝕜 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
function.injective.module 𝕜 coe_fn_add_monoid_hom cont_mdiff_map.coe_inj coe_smul

/-- Coercion to a function as a `linear_map`. -/
@[simps]
def coe_fn_linear_map {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
C^∞⟮I, N; 𝓘(𝕜, V), V⟯ →ₗ[𝕜] (N → V) :=
{ to_fun := coe_fn,
  map_smul' := coe_smul,
  ..(coe_fn_add_monoid_hom : C^∞⟮I, N; 𝓘(𝕜, V), V⟯ →+ _) }

end module_structure

section algebra_structure

/-!
### Algebra structure

In this section we show that smooth functions valued in a normed algebra `A` over a normed field `𝕜`
inherit an algebra structure.
-/

variables {A : Type*} [normed_ring A] [normed_algebra 𝕜 A] [smooth_ring 𝓘(𝕜, A) A]

/-- Smooth constant functions as a `ring_hom`. -/
def C : 𝕜 →+* C^∞⟮I, N; 𝓘(𝕜, A), A⟯ :=
{ to_fun    := λ c : 𝕜, ⟨λ x, ((algebra_map 𝕜 A) c), smooth_const⟩,
  map_one'  := by ext x; exact (algebra_map 𝕜 A).map_one,
  map_mul'  := λ c₁ c₂, by ext x; exact (algebra_map 𝕜 A).map_mul _ _,
  map_zero' := by ext x; exact (algebra_map 𝕜 A).map_zero,
  map_add'  := λ c₁ c₂, by ext x; exact (algebra_map 𝕜 A).map_add _ _ }

instance algebra : algebra 𝕜 C^∞⟮I, N; 𝓘(𝕜, A), A⟯ :=
{ smul := λ r f,
  ⟨r • f, smooth_const.smul f.smooth⟩,
  to_ring_hom := smooth_map.C,
  commutes' := λ c f, by ext x; exact algebra.commutes' _ _,
  smul_def' := λ c f, by ext x; exact algebra.smul_def' _ _,
  ..smooth_map.semiring }

/-- Coercion to a function as an `alg_hom`. -/
@[simps]
def coe_fn_alg_hom : C^∞⟮I, N; 𝓘(𝕜, A), A⟯ →ₐ[𝕜] (N → A) :=
{ to_fun := coe_fn,
  commutes' := λ r, rfl,
  -- `..(smooth_map.coe_fn_ring_hom : C^∞⟮I, N; 𝓘(𝕜, A), A⟯ →+* _)` times out for some reason
  map_zero' := smooth_map.coe_zero,
  map_one' := smooth_map.coe_one,
  map_add' := smooth_map.coe_add,
  map_mul' := smooth_map.coe_mul }

end algebra_structure

section module_over_continuous_functions

/-!
### Structure as module over scalar functions

If `V` is a module over `𝕜`, then we show that the space of smooth functions from `N` to `V`
is naturally a vector space over the ring of smooth functions from `N` to `𝕜`. -/

instance has_smul' {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
  has_smul C^∞⟮I, N; 𝕜⟯ C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
⟨λ f g, ⟨λ x, (f x) • (g x), (smooth.smul f.2 g.2)⟩⟩

@[simp] lemma smul_comp' {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V]
  (f : C^∞⟮I'', N'; 𝕜⟯) (g : C^∞⟮I'', N'; 𝓘(𝕜, V), V⟯) (h : C^∞⟮I, N; I'', N'⟯) :
(f • g).comp h = (f.comp h) • (g.comp h) := rfl

instance module' {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
  module C^∞⟮I, N; 𝓘(𝕜), 𝕜⟯ C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
{ smul     := (•),
  smul_add := λ c f g, by ext x; exact smul_add (c x) (f x) (g x),
  add_smul := λ c₁ c₂ f, by ext x; exact add_smul (c₁ x) (c₂ x) (f x),
  mul_smul := λ c₁ c₂ f, by ext x; exact mul_smul (c₁ x) (c₂ x) (f x),
  one_smul := λ f, by ext x; exact one_smul 𝕜 (f x),
  zero_smul := λ f, by ext x; exact zero_smul _ _,
  smul_zero := λ r, by ext x; exact smul_zero _, }

end module_over_continuous_functions

end smooth_map


import data.zmod.defs
import data.zmod.basic

#check zmod.fintype 6
#check (zmod.fintype 6).elems
#eval (zmod.fintype 6).elems

lemma zmod_6_elems_eq_0_to_5 : (zmod.fintype 6).elems = {0, 1, 2, 3, 4, 5} := begin
  refl,
end

lemma eq_val_of_eq_zmod { n : ℕ } {a b : zmod n} (h : a = b) : a.val = b.val := begin
  rw h,
end

example (p : ℕ) (h₁ : prime p) (h₂ : p > 3) : p % 6 = 1 ∨ p % 6 = 5 := begin
  have h : (p : zmod 6) ∈ ({0, 1, 2, 3, 4, 5} : finset (zmod 6)),
  {
    rw ← zmod_6_elems_eq_0_to_5,
    apply (zmod.fintype 6).complete,
  },
  simp at h,
  rcases h with (_|_|_|_|_|_);
  have h' := eq_val_of_eq_zmod h;
  rw zmod.val at h';
  norm_num at h',
  {
    exfalso,
    sorry,
  },
  {
    exact or.inl h',
  },
  {
    sorry,
  },
  {
    sorry,
  },
  {
    sorry,
  },
  {
    sorry,
  },
end


import classes.unrestricted.basics.toolbox
import utilities.language_operations
import utilities.list_utils

variables {T : Type}

section auxiliary

private def reversal_grule {N : Type} (r : grule T N) : grule T N :=
grule.mk r.input_R.reverse r.input_N r.input_L.reverse r.output_string.reverse

private lemma dual_of_reversal_grule {N : Type} (r : grule T N) :
  reversal_grule (reversal_grule r) = r :=
begin
  cases r,
  unfold reversal_grule,
  dsimp only,
  simp [list.reverse_reverse],
end

private lemma reversal_grule_reversal_grule {N : Type} :
  @reversal_grule T N ∘ @reversal_grule T N = id :=
begin
  ext,
  apply dual_of_reversal_grule,
end

private def reversal_grammar (g : grammar T) : grammar T :=
grammar.mk g.nt g.initial (list.map reversal_grule g.rules)

private lemma dual_of_reversal_grammar (g : grammar T) :
  reversal_grammar (reversal_grammar g) = g :=
begin
  cases g,
  unfold reversal_grammar,
  dsimp only,
  rw list.map_map,
  rw reversal_grule_reversal_grule,
  rw list.map_id,
end

private lemma derives_reversed (g : grammar T) (v : list (symbol T g.nt)) :
  grammar_derives (reversal_grammar g) [symbol.nonterminal (reversal_grammar g).initial] v →
    grammar_derives g [symbol.nonterminal g.initial] v.reverse :=
begin
  intro hv,
  induction hv with u w trash orig ih,
  {
    rw list.reverse_singleton,
    apply grammar_deri_self,
  },
  apply grammar_deri_of_deri_tran ih,
  rcases orig with ⟨r, rin, x, y, bef, aft⟩,
  change r ∈ (list.map _ g.rules) at rin,
  rw list.mem_map at rin,
  rcases rin with ⟨r₀, rin₀, r_from_r₀⟩,
  use r₀,
  split,
  {
    exact rin₀,
  },
  use y.reverse,
  use x.reverse,
  split,
  {
    have rid₁ : r₀.input_L = r.input_R.reverse,
    {
      rw ←r_from_r₀,
      unfold reversal_grule,
      rw list.reverse_reverse,
    },
    have rid₂ : [symbol.nonterminal r₀.input_N] = [symbol.nonterminal r.input_N].reverse,
    {
      rw ←r_from_r₀,
      rw list.reverse_singleton,
      refl,
    },
    have rid₃ : r₀.input_R = r.input_L.reverse,
    {
      rw ←r_from_r₀,
      unfold reversal_grule,
      rw list.reverse_reverse,
    },
    rw [
      rid₁, rid₂, rid₃,
      ←list.reverse_append_append, ←list.reverse_append_append,
      ←list.append_assoc, ←list.append_assoc
    ],
    congr,
    exact bef,
  },
  {
    have snd_from_r : r₀.output_string = r.output_string.reverse,
    {
      rw ←r_from_r₀,
      unfold reversal_grule,
      rw list.reverse_reverse,
    },
    rw snd_from_r,
    rw ←list.reverse_append_append,
    exact congr_arg list.reverse aft,
  },
end

private lemma reversed_word_in_original_language {g : grammar T} {w : list T}
    (hyp : w ∈ grammar_language (reversal_grammar g)) :
  w.reverse ∈ grammar_language g :=
begin
  unfold grammar_language at *,
  have almost_done := derives_reversed g (list.map symbol.terminal w) hyp,
  rw ←list.map_reverse at almost_done,
  exact almost_done,
end

end auxiliary

/-- The class of resursively-enumerable languages is closed under reversal. -/
theorem RE_of_reverse_RE (L : language T) :
  is_RE L  →  is_RE (reverse_lang L)  :=
begin
  rintro ⟨g, hgL⟩,
  rw ←hgL,

  use reversal_grammar g,
  unfold reverse_lang,

  apply set.eq_of_subset_of_subset,
  {
    intros w hwL,
    change w.reverse ∈ grammar_language g,
    exact reversed_word_in_original_language hwL,
  },
  {
    intros w hwL,
    change w.reverse ∈ grammar_language g at hwL,
    obtain ⟨g₀, pre_reversal⟩ : ∃ g₀, g = reversal_grammar g₀,
    {
      use reversal_grammar g,
      rw dual_of_reversal_grammar,
    },
    rw pre_reversal at hwL ⊢,
    have finished_up_to_reverses := reversed_word_in_original_language hwL,
    rw dual_of_reversal_grammar,
    rw list.reverse_reverse at finished_up_to_reverses,
    exact finished_up_to_reverses,
  },
end


/-
Copyright (c) 2021 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/

import algebra.star.basic
import group_theory.subgroup.basic

/-!
# Self-adjoint elements of a star additive group

This file defines `self_adjoint R`, where `R` is a star additive monoid, as the additive subgroup
containing the elements that satisfy `star x = x`. This includes, for instance, Hermitian
operators on Hilbert spaces.

## Implementation notes

* When `R` is a `star_module R₂ R`, then `self_adjoint R` has a natural
  `module (self_adjoint R₂) (self_adjoint R)` structure. However, doing this literally would be
  undesirable since in the main case of interest (`R₂ = ℂ`) we want `module ℝ (self_adjoint R)`
  and not `module (self_adjoint ℂ) (self_adjoint R)`. We solve this issue by adding the typeclass
  `[has_trivial_star R₃]`, of which `ℝ` is an instance (registered in `data/real/basic`), and then
  add a `[module R₃ (self_adjoint R)]` instance whenever we have
  `[module R₃ R] [has_trivial_star R₃]`. (Another approach would have been to define
  `[star_invariant_scalars R₃ R]` to express the fact that `star (x • v) = x • star v`, but
  this typeclass would have the disadvantage of taking two type arguments.)

## TODO

* Define `λ z x, z * x * star z` (i.e. conjugation by `z`) as a monoid action of `R` on `R`
  (similar to the existing `conj_act` for groups), and then state the fact that `self_adjoint R` is
  invariant under it.

-/

variables (R : Type*)

/-- The self-adjoint elements of a star additive group, as an additive subgroup. -/
def self_adjoint [add_group R] [star_add_monoid R] : add_subgroup R :=
{ carrier := {x | star x = x},
  zero_mem' := star_zero R,
  add_mem' := λ x y (hx : star x = x) (hy : star y = y),
                show star (x + y) = x + y, by simp only [star_add x y, hx, hy],
  neg_mem' := λ x (hx : star x = x), show star (-x) = -x, by simp only [hx, star_neg] }
variables {R}

namespace self_adjoint

section add_group
variables [add_group R] [star_add_monoid R]

lemma mem_iff {x : R} : x ∈ self_adjoint R ↔ star x = x :=
by { rw [←add_subgroup.mem_carrier], exact iff.rfl }

@[simp, norm_cast] lemma star_coe_eq {x : self_adjoint R} : star (x : R) = x := x.prop

instance : inhabited (self_adjoint R) := ⟨0⟩

end add_group

instance [add_comm_group R] [star_add_monoid R] : add_comm_group (self_adjoint R) :=
{ add_comm := add_comm,
  ..add_subgroup.to_add_group (self_adjoint R) }

section ring
variables [ring R] [star_ring R]

instance : has_one (self_adjoint R) := ⟨⟨1, by rw [mem_iff, star_one]⟩⟩

@[simp, norm_cast] lemma coe_one : (coe : self_adjoint R → R) (1 : self_adjoint R) = (1 : R) := rfl

instance [nontrivial R] : nontrivial (self_adjoint R) := ⟨⟨0, 1, subtype.ne_of_val_ne zero_ne_one⟩⟩

lemma one_mem : (1 : R) ∈ self_adjoint R := by simp only [mem_iff, star_one]

lemma bit0_mem {x : R} (hx : x ∈ self_adjoint R) : bit0 x ∈ self_adjoint R :=
by simp only [mem_iff, star_bit0, mem_iff.mp hx]

lemma bit1_mem {x : R} (hx : x ∈ self_adjoint R) : bit1 x ∈ self_adjoint R :=
by simp only [mem_iff, star_bit1, mem_iff.mp hx]

lemma conjugate {x : R} (hx : x ∈ self_adjoint R) (z : R) : z * x * star z ∈ self_adjoint R :=
by simp only [mem_iff, star_mul, star_star, mem_iff.mp hx, mul_assoc]

lemma conjugate' {x : R} (hx : x ∈ self_adjoint R) (z : R) : star z * x * z ∈ self_adjoint R :=
by simp only [mem_iff, star_mul, star_star, mem_iff.mp hx, mul_assoc]

end ring

section comm_ring
variables [comm_ring R] [star_ring R]

instance : has_mul (self_adjoint R) :=
⟨λ x y, ⟨(x : R) * y, by simp only [mem_iff, star_mul', star_coe_eq]⟩⟩

@[simp, norm_cast] lemma coe_mul (x y : self_adjoint R) :
  (coe : self_adjoint R → R) (x * y) = (x : R) * y := rfl

instance : comm_ring (self_adjoint R) :=
{ mul_assoc := λ x y z, by { ext, exact mul_assoc _ _ _ },
  one_mul := λ x, by { ext, simp only [coe_mul, one_mul, coe_one] },
  mul_one := λ x, by { ext, simp only [mul_one, coe_mul, coe_one] },
  mul_comm := λ x y, by { ext, exact mul_comm _ _ },
  left_distrib := λ x y z, by { ext, exact left_distrib _ _ _ },
  right_distrib := λ x y z, by { ext, exact right_distrib _ _ _ },
  ..self_adjoint.add_comm_group,
  ..self_adjoint.has_one,
  ..self_adjoint.has_mul }

end comm_ring

section field

variables [field R] [star_ring R]

instance : field (self_adjoint R) :=
{ inv :=  λ x, ⟨(x.val)⁻¹, by simp only [mem_iff, star_inv', star_coe_eq, subtype.val_eq_coe]⟩,
  exists_pair_ne := ⟨0, 1, subtype.ne_of_val_ne zero_ne_one⟩,
  mul_inv_cancel := λ x hx, by { ext, exact mul_inv_cancel (λ H, hx $ subtype.eq H) },
  inv_zero := by { ext, exact inv_zero },
  ..self_adjoint.comm_ring }

@[simp, norm_cast] lemma coe_inv (x : self_adjoint R) :
  (coe : self_adjoint R → R) (x⁻¹) = (x : R)⁻¹ := rfl

end field

section module

variables {A : Type*} [semiring R] [has_star R] [has_trivial_star R] [add_comm_group A]
  [star_add_monoid A] [module R A] [star_module R A]

instance : has_scalar R (self_adjoint A) :=
⟨λ r x, ⟨r • x, by rw [mem_iff, star_smul, star_trivial, star_coe_eq]⟩⟩

@[simp, norm_cast] lemma coe_smul (r : R) (x : self_adjoint A) :
  (coe : self_adjoint A → A) (r • x) = r • x := rfl

instance : mul_action R (self_adjoint A) :=
{ one_smul := λ x, by { ext, rw [coe_smul, one_smul] },
  mul_smul := λ r s x, by { ext, simp only [mul_smul, coe_smul] } }

instance : distrib_mul_action R (self_adjoint A) :=
{ smul_add := λ r x y, by { ext, simp only [smul_add, add_subgroup.coe_add, coe_smul] },
  smul_zero := λ r, by { ext, simp only [smul_zero', coe_smul, add_subgroup.coe_zero] } }

instance : module R (self_adjoint A) :=
{ add_smul := λ r s x, by { ext, simp only [add_smul, add_subgroup.coe_add, coe_smul] },
  zero_smul := λ x, by { ext, simp only [coe_smul, zero_smul, add_subgroup.coe_zero] } }

end module

end self_adjoint


import tactic natree.pre

--natural trees are pre-trees quotiented by pre-tree equivalence
def natree := quotient natree.pre.equiv

namespace natree

  notation `𝕋` := natree

  def node : 𝕋 := ⟦▢⟧
  notation `△` := node

  def app' : 𝕋' → 𝕋' → 𝕋 := λ t₁ t₂, ⟦t₁ ◦ t₂⟧
  lemma app'_liftable {a₁ a₂ b₁ b₂} (h₁ : a₁ ≈ b₁) (h₂ : a₂ ≈ b₂) : app' a₁ a₂ = app' b₁ b₂ := begin
    repeat {rw wrapp},
    apply quotient.sound,
    apply pre.equiv.congr,
    repeat {assumption}
  end

  def app : 𝕋 → 𝕋 → 𝕋 := quotient.lift₂ app' @app'_liftable
  infixl `⬝`:60 := app

  def ref (c) := ⟦pre.ref c⟧
  prefix `&`:60 := ref

  theorem quot_dist_app {a b} : ⟦a ◦ b⟧ = ⟦a⟧ ⬝ ⟦b⟧ := rfl

  theorem kernel {y z} : △⬝△⬝y⬝z = y := begin
    have h₁ := quotient.exists_rep y, cases h₁ with y' h₁, rw ←h₁,
    have h₂ := quotient.exists_rep z, cases h₂ with z' h₂, rw ←h₂,
    rw node,
    repeat {rw ←quot_dist_app},
    apply quotient.sound,
    apply pre.equiv.kernel,
  end

  theorem stem {x y z} : △⬝(△⬝x)⬝y⬝z = y⬝z⬝(x⬝z) := begin
    have h₁ := quotient.exists_rep x, cases h₁ with x' h₁, rw ←h₁,
    have h₂ := quotient.exists_rep y, cases h₂ with y' h₂, rw ←h₂,
    have h₃ := quotient.exists_rep z, cases h₃ with z' h₃, rw ←h₃,
    rw node,
    repeat {rw ←quot_dist_app},
    apply quotient.sound,
    apply pre.equiv.stem,
  end

  theorem fork {w x y z} : △⬝(△⬝w⬝x)⬝y⬝z = z⬝w⬝x := begin
    have h₁ := quotient.exists_rep w, cases h₁ with w' h₁, rw ←h₁,
    have h₂ := quotient.exists_rep x, cases h₂ with x' h₂, rw ←h₂,
    have h₃ := quotient.exists_rep y, cases h₃ with y' h₃, rw ←h₃,
    have h₄ := quotient.exists_rep z, cases h₄ with z' h₄, rw ←h₄,
    rw node,
    repeat {rw ←quot_dist_app},
    apply quotient.sound,
    apply pre.equiv.fork,
  end

end natree


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.fintype.basic
import set_theory.cardinal.cofinality
import set_theory.game.birthday

/-!
# Short games

A combinatorial game is `short` [Conway, ch.9][conway2001] if it has only finitely many positions.
In particular, this means there is a finite set of moves at every point.

We prove that the order relations `≤` and `<`, and the equivalence relation `≈`, are decidable on
short games, although unfortunately in practice `dec_trivial` doesn't seem to be able to
prove anything using these instances.
-/
universes u

open_locale pgame

namespace pgame

/-- A short game is a game with a finite set of moves at every turn. -/
inductive short : pgame.{u} → Type (u+1)
| mk : Π {α β : Type u} {L : α → pgame.{u}} {R : β → pgame.{u}}
         (sL : ∀ i : α, short (L i)) (sR : ∀ j : β, short (R j))
         [fintype α] [fintype β],
       short ⟨α, β, L, R⟩

instance subsingleton_short : Π (x : pgame), subsingleton (short x)
| (mk xl xr xL xR) :=
⟨λ a b, begin
  cases a, cases b,
  congr,
  { funext,
    apply @subsingleton.elim _ (subsingleton_short (xL x)) },
  { funext,
    apply @subsingleton.elim _ (subsingleton_short (xR x)) },
end⟩
using_well_founded { dec_tac := pgame_wf_tac }

/-- A synonym for `short.mk` that specifies the pgame in an implicit argument. -/
def short.mk' {x : pgame} [fintype x.left_moves] [fintype x.right_moves]
  (sL : ∀ i : x.left_moves, short (x.move_left i))
  (sR : ∀ j : x.right_moves, short (x.move_right j)) :
  short x :=
by unfreezingI { cases x, dsimp at * }; exact short.mk sL sR

attribute [class] short

/--
Extracting the `fintype` instance for the indexing type for Left's moves in a short game.
This is an unindexed typeclass, so it can't be made a global instance.
-/
def fintype_left {α β : Type u} {L : α → pgame.{u}} {R : β → pgame.{u}} [S : short ⟨α, β, L, R⟩] :
  fintype α :=
by { casesI S with _ _ _ _ _ _ F _, exact F }
local attribute [instance] fintype_left
instance fintype_left_moves (x : pgame) [S : short x] : fintype (x.left_moves) :=
by { casesI x, dsimp, apply_instance }
/--
Extracting the `fintype` instance for the indexing type for Right's moves in a short game.
This is an unindexed typeclass, so it can't be made a global instance.
-/
def fintype_right {α β : Type u} {L : α → pgame.{u}} {R : β → pgame.{u}} [S : short ⟨α, β, L, R⟩] :
  fintype β :=
by { casesI S with _ _ _ _ _ _ _ F, exact F }
local attribute [instance] fintype_right
instance fintype_right_moves (x : pgame) [S : short x] : fintype (x.right_moves) :=
by { casesI x, dsimp, apply_instance }

instance move_left_short (x : pgame) [S : short x] (i : x.left_moves) : short (x.move_left i) :=
by { casesI S with _ _ _ _ L _ _ _, apply L }
/--
Extracting the `short` instance for a move by Left.
This would be a dangerous instance potentially introducing new metavariables
in typeclass search, so we only make it an instance locally.
-/
def move_left_short' {xl xr} (xL xR) [S : short (mk xl xr xL xR)] (i : xl) : short (xL i) :=
by { casesI S with _ _ _ _ L _ _ _, apply L }
local attribute [instance] move_left_short'
instance move_right_short (x : pgame) [S : short x] (j : x.right_moves) : short (x.move_right j) :=
by { casesI S with _ _ _ _ _ R _ _, apply R }
/--
Extracting the `short` instance for a move by Right.
This would be a dangerous instance potentially introducing new metavariables
in typeclass search, so we only make it an instance locally.
-/
def move_right_short' {xl xr} (xL xR) [S : short (mk xl xr xL xR)] (j : xr) : short (xR j) :=
by { casesI S with _ _ _ _ _ R _ _, apply R }
local attribute [instance] move_right_short'

theorem short_birthday : ∀ (x : pgame.{u}) [short x], x.birthday < ordinal.omega
| ⟨xl, xr, xL, xR⟩ hs :=
begin
  haveI := hs,
  unfreezingI { rcases hs with ⟨sL, sR⟩ },
  rw [birthday, max_lt_iff],
  split, all_goals
  { rw ←cardinal.ord_aleph_0,
    refine cardinal.lsub_lt_ord_of_is_regular.{u u} cardinal.is_regular_aleph_0
      (cardinal.lt_aleph_0_of_finite _) (λ i, _),
    rw cardinal.ord_aleph_0,
    apply short_birthday _ },
  { exact move_left_short' xL xR i },
  { exact move_right_short' xL xR i }
end

/-- This leads to infinite loops if made into an instance. -/
def short.of_is_empty {l r xL xR} [is_empty l] [is_empty r] : short (mk l r xL xR) :=
short.mk is_empty_elim is_empty_elim

instance short_0 : short 0 :=
short.of_is_empty

instance short_1 : short 1 :=
short.mk (λ i, begin cases i, apply_instance, end) (λ j, by cases j)

/-- Evidence that every `pgame` in a list is `short`. -/
inductive list_short : list pgame.{u} → Type (u+1)
| nil : list_short []
| cons : Π (hd : pgame.{u}) [short hd] (tl : list pgame.{u}) [list_short tl], list_short (hd :: tl)

attribute [class] list_short
attribute [instance] list_short.nil list_short.cons

instance list_short_nth_le : Π (L : list pgame.{u}) [list_short L] (i : fin (list.length L)),
  short (list.nth_le L i i.is_lt)
| [] _ n := begin exfalso, rcases n with ⟨_, ⟨⟩⟩, end
| (hd :: tl) (@list_short.cons _ S _ _) ⟨0, _⟩ := S
| (hd :: tl) (@list_short.cons _ _ _ S) ⟨n+1, h⟩ :=
  @list_short_nth_le tl S ⟨n, (add_lt_add_iff_right 1).mp h⟩

instance short_of_lists : Π (L R : list pgame) [list_short L] [list_short R],
  short (pgame.of_lists L R)
| L R _ _ := by { resetI, apply short.mk,
  { intros, apply_instance },
  { intros, apply pgame.list_short_nth_le /- where does the subtype.val come from? -/ } }

/-- If `x` is a short game, and `y` is a relabelling of `x`, then `y` is also short. -/
def short_of_relabelling : Π {x y : pgame.{u}} (R : relabelling x y) (S : short x), short y
| x y ⟨L, R, rL, rR⟩ S :=
begin
  resetI,
  haveI := fintype.of_equiv _ L,
  haveI := fintype.of_equiv _ R,
  exact short.mk'
    (λ i, by { rw ←(L.right_inv i), apply short_of_relabelling (rL (L.symm i)) infer_instance, })
    (λ j, by simpa using short_of_relabelling (rR (R.symm j)) infer_instance)
end

instance short_neg : Π (x : pgame.{u}) [short x], short (-x)
| (mk xl xr xL xR) _ :=
by { resetI, exact short.mk (λ i, short_neg _) (λ i, short_neg _) }
using_well_founded { dec_tac := pgame_wf_tac }

instance short_add : Π (x y : pgame.{u}) [short x] [short y], short (x + y)
| (mk xl xr xL xR) (mk yl yr yL yR) _ _ :=
begin
  resetI,
  apply short.mk, all_goals
  { rintro ⟨i⟩,
    { apply short_add },
    { change short (mk xl xr xL xR + _), apply short_add } }
end
using_well_founded { dec_tac := pgame_wf_tac }

instance short_nat : Π n : ℕ, short n
| 0 := pgame.short_0
| (n+1) := @pgame.short_add _ _ (short_nat n) pgame.short_1

instance short_bit0 (x : pgame.{u}) [short x] : short (bit0 x) :=
by { dsimp [bit0], apply_instance }
instance short_bit1 (x : pgame.{u}) [short x] : short (bit1 x) :=
by { dsimp [bit1], apply_instance }

/--
Auxiliary construction of decidability instances.
We build `decidable (x ≤ y)` and `decidable (x ⧏ y)` in a simultaneous induction.
Instances for the two projections separately are provided below.
-/
def le_lf_decidable : Π (x y : pgame.{u}) [short x] [short y],
  decidable (x ≤ y) × decidable (x ⧏ y)
| (mk xl xr xL xR) (mk yl yr yL yR) shortx shorty :=
begin
  resetI,
  split,
  { refine @decidable_of_iff' _ _ mk_le_mk (id _),
    apply @and.decidable _ _ _ _,
    { apply @fintype.decidable_forall_fintype xl _ _ (by apply_instance),
      intro i,
      apply (@le_lf_decidable _ _ _ _).2; apply_instance, },
    { apply @fintype.decidable_forall_fintype yr _ _ (by apply_instance),
      intro i,
      apply (@le_lf_decidable _ _ _ _).2; apply_instance, }, },
  { refine @decidable_of_iff' _ _ mk_lf_mk (id _),
    apply @or.decidable _ _ _ _,
    { apply @fintype.decidable_exists_fintype yl _ _ (by apply_instance),
      intro i,
      apply (@le_lf_decidable _ _ _ _).1; apply_instance, },
    { apply @fintype.decidable_exists_fintype xr _ _ (by apply_instance),
      intro i,
      apply (@le_lf_decidable _ _ _ _).1; apply_instance, }, },
end
using_well_founded { dec_tac := pgame_wf_tac }

instance le_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ≤ y) :=
(le_lf_decidable x y).1

instance lf_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ⧏ y) :=
(le_lf_decidable x y).2

instance lt_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x < y) :=
and.decidable

instance equiv_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ≈ y) :=
and.decidable

example : short 0 := by apply_instance
example : short 1 := by apply_instance
example : short 2 := by apply_instance
example : short (-2) := by apply_instance

example : short (of_lists [0] [1]) := by apply_instance
example : short (of_lists [-2, -1] [1]) := by apply_instance

example : short (0 + 0) := by apply_instance

example : decidable ((1 : pgame) ≤ 1) := by apply_instance

-- No longer works since definitional reduction of well-founded definitions has been restricted.
-- example : (0 : pgame) ≤ 0 := dec_trivial
-- example : (1 : pgame) ≤ 1 := dec_trivial

end pgame


/-
Copyright (c) 2022 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import data.real.ennreal
import topology.continuous_function.bounded

/-!
# Thickened indicators

This file is about thickened indicators of sets in (pseudo e)metric spaces. For a decreasing
sequence of thickening radii tending to 0, the thickened indicators of a closed set form a
decreasing pointwise converging approximation of the indicator function of the set, where the
members of the approximating sequence are nonnegative bounded continuous functions.

## Main definitions

 * `thickened_indicator_aux δ E`: The `δ`-thickened indicator of a set `E` as an
   unbundled `ℝ≥0∞`-valued function.
 * `thickened_indicator δ E`: The `δ`-thickened indicator of a set `E` as a bundled
   bounded continuous `ℝ≥0`-valued function.

## Main results

 * For a sequence of thickening radii tending to 0, the `δ`-thickened indicators of a set `E` tend
   pointwise to the indicator of `closure E`.
   - `thickened_indicator_aux_tendsto_indicator_closure`: The version is for the
     unbundled `ℝ≥0∞`-valued functions.
   - `thickened_indicator_tendsto_indicator_closure`: The version is for the bundled `ℝ≥0`-valued
     bounded continuous functions.

-/
noncomputable theory
open_locale classical nnreal ennreal topological_space bounded_continuous_function

open nnreal ennreal set metric emetric filter

section thickened_indicator

variables {α : Type*} [pseudo_emetric_space α]

/-- The `δ`-thickened indicator of a set `E` is the function that equals `1` on `E`
and `0` outside a `δ`-thickening of `E` and interpolates (continuously) between
these values using `inf_edist _ E`.

`thickened_indicator_aux` is the unbundled `ℝ≥0∞`-valued function. See `thickened_indicator`
for the (bundled) bounded continuous function with `ℝ≥0`-values. -/
def thickened_indicator_aux (δ : ℝ) (E : set α) : α → ℝ≥0∞ :=
λ (x : α), (1 : ℝ≥0∞) - (inf_edist x E) / (ennreal.of_real δ)

lemma continuous_thickened_indicator_aux {δ : ℝ} (δ_pos : 0 < δ) (E : set α) :
  continuous (thickened_indicator_aux δ E) :=
begin
  unfold thickened_indicator_aux,
  let f := λ (x : α), (⟨1, (inf_edist x E) / (ennreal.of_real δ)⟩ : ℝ≥0 × ℝ≥0∞),
  let sub := λ (p : ℝ≥0 × ℝ≥0∞), ((p.1 : ℝ≥0∞) - p.2),
  rw (show (λ (x : α), ((1 : ℝ≥0∞)) - (inf_edist x E) / (ennreal.of_real δ)) = sub ∘ f, by refl),
  apply (@ennreal.continuous_nnreal_sub 1).comp,
  apply (ennreal.continuous_div_const (ennreal.of_real δ) _).comp continuous_inf_edist,
  norm_num [δ_pos],
end

lemma thickened_indicator_aux_le_one (δ : ℝ) (E : set α) (x : α) :
  thickened_indicator_aux δ E x ≤ 1 :=
by apply @tsub_le_self _ _ _ _ (1 : ℝ≥0∞)

lemma thickened_indicator_aux_lt_top {δ : ℝ} {E : set α} {x : α} :
  thickened_indicator_aux δ E x < ∞ :=
lt_of_le_of_lt (thickened_indicator_aux_le_one _ _ _) one_lt_top

lemma thickened_indicator_aux_closure_eq (δ : ℝ) (E : set α) :
  thickened_indicator_aux δ (closure E) = thickened_indicator_aux δ E :=
by simp_rw [thickened_indicator_aux, inf_edist_closure]

lemma thickened_indicator_aux_one (δ : ℝ) (E : set α) {x : α} (x_in_E : x ∈ E) :
  thickened_indicator_aux δ E x = 1 :=
by simp [thickened_indicator_aux, inf_edist_zero_of_mem x_in_E, tsub_zero]

lemma thickened_indicator_aux_one_of_mem_closure
  (δ : ℝ) (E : set α) {x : α} (x_mem : x ∈ closure E) :
  thickened_indicator_aux δ E x = 1 :=
by rw [←thickened_indicator_aux_closure_eq, thickened_indicator_aux_one δ (closure E) x_mem]

lemma thickened_indicator_aux_zero
  {δ : ℝ} (δ_pos : 0 < δ) (E : set α) {x : α} (x_out : x ∉ thickening δ E) :
  thickened_indicator_aux δ E x = 0 :=
begin
  rw [thickening, mem_set_of_eq, not_lt] at x_out,
  unfold thickened_indicator_aux,
  apply le_antisymm _ bot_le,
  have key := tsub_le_tsub (@rfl _ (1 : ℝ≥0∞)).le (ennreal.div_le_div x_out rfl.le),
  rw [ennreal.div_self (ne_of_gt (ennreal.of_real_pos.mpr δ_pos)) of_real_ne_top] at key,
  simpa using key,
end

lemma thickened_indicator_aux_mono {δ₁ δ₂ : ℝ} (hle : δ₁ ≤ δ₂) (E : set α) :
  thickened_indicator_aux δ₁ E ≤ thickened_indicator_aux δ₂ E :=
λ _, tsub_le_tsub (@rfl ℝ≥0∞ 1).le (ennreal.div_le_div rfl.le (of_real_le_of_real hle))

lemma indicator_le_thickened_indicator_aux (δ : ℝ) (E : set α) :
  E.indicator (λ _, (1 : ℝ≥0∞)) ≤ thickened_indicator_aux δ E :=
begin
  intro a,
  by_cases a ∈ E,
  { simp only [h, indicator_of_mem, thickened_indicator_aux_one δ E h, le_refl], },
  { simp only [h, indicator_of_not_mem, not_false_iff, zero_le], },
end

lemma thickened_indicator_aux_subset (δ : ℝ) {E₁ E₂ : set α} (subset : E₁ ⊆ E₂) :
  thickened_indicator_aux δ E₁ ≤ thickened_indicator_aux δ E₂ :=
λ _, tsub_le_tsub (@rfl ℝ≥0∞ 1).le (ennreal.div_le_div (inf_edist_anti subset) rfl.le)

/-- As the thickening radius δ tends to 0, the δ-thickened indicator of a set E (in α) tends
pointwise (i.e., w.r.t. the product topology on `α → ℝ≥0∞`) to the indicator function of the
closure of E.

This statement is for the unbundled `ℝ≥0∞`-valued functions `thickened_indicator_aux δ E`, see
`thickened_indicator_tendsto_indicator_closure` for the version for bundled `ℝ≥0`-valued
bounded continuous functions. -/
lemma thickened_indicator_aux_tendsto_indicator_closure
  {δseq : ℕ → ℝ} (δseq_lim : tendsto δseq at_top (𝓝 0)) (E : set α) :
  tendsto (λ n, (thickened_indicator_aux (δseq n) E)) at_top
    (𝓝 (indicator (closure E) (λ x, (1 : ℝ≥0∞)))) :=
begin
  rw tendsto_pi_nhds,
  intro x,
  by_cases x_mem_closure : x ∈ closure E,
  { simp_rw [thickened_indicator_aux_one_of_mem_closure _ E x_mem_closure],
    rw (show (indicator (closure E) (λ _, (1 : ℝ≥0∞))) x = 1,
        by simp only [x_mem_closure, indicator_of_mem]),
    exact tendsto_const_nhds, },
  { rw (show (closure E).indicator (λ _, (1 : ℝ≥0∞)) x = 0,
        by simp only [x_mem_closure, indicator_of_not_mem, not_false_iff]),
    rw mem_closure_iff_inf_edist_zero at x_mem_closure,
    obtain ⟨ε, ⟨ε_pos, ε_le⟩⟩ : ∃ (ε : ℝ), 0 < ε ∧ ennreal.of_real ε ≤ inf_edist x E,
    { by_cases dist_infty : inf_edist x E = ∞,
      { rw dist_infty,
        use [1, zero_lt_one, le_top], },
      { use (inf_edist x E).to_real,
        exact ⟨(to_real_lt_to_real zero_ne_top dist_infty).mpr (pos_iff_ne_zero.mpr x_mem_closure),
                of_real_to_real_le⟩, }, },
    rw metric.tendsto_nhds at δseq_lim,
    specialize δseq_lim ε ε_pos,
    simp only [dist_zero_right, real.norm_eq_abs, eventually_at_top, ge_iff_le] at δseq_lim,
    rcases δseq_lim with ⟨N, hN⟩,
    apply @tendsto_at_top_of_eventually_const _ _ _ _ _ _ _ N,
    intros n n_large,
    have key : x ∉ thickening ε E, by rwa [thickening, mem_set_of_eq, not_lt],
    refine le_antisymm _ bot_le,
    apply (thickened_indicator_aux_mono (lt_of_abs_lt (hN n n_large)).le E x).trans,
    exact (thickened_indicator_aux_zero ε_pos E key).le, },
end

/-- The `δ`-thickened indicator of a set `E` is the function that equals `1` on `E`
and `0` outside a `δ`-thickening of `E` and interpolates (continuously) between
these values using `inf_edist _ E`.

`thickened_indicator` is the (bundled) bounded continuous function with `ℝ≥0`-values.
See `thickened_indicator_aux` for the unbundled `ℝ≥0∞`-valued function. -/
@[simps] def thickened_indicator {δ : ℝ} (δ_pos : 0 < δ) (E : set α) : α →ᵇ ℝ≥0 :=
{ to_fun := λ (x : α), (thickened_indicator_aux δ E x).to_nnreal,
  continuous_to_fun := begin
    apply continuous_on.comp_continuous
            continuous_on_to_nnreal (continuous_thickened_indicator_aux δ_pos E),
    intro x,
    exact (lt_of_le_of_lt (@thickened_indicator_aux_le_one _ _ δ E x) one_lt_top).ne,
  end,
  map_bounded' := begin
    use 2,
    intros x y,
    rw [nnreal.dist_eq],
    apply (abs_sub _ _).trans,
    rw [nnreal.abs_eq, nnreal.abs_eq, ←one_add_one_eq_two],
    have key := @thickened_indicator_aux_le_one _ _ δ E,
    apply add_le_add;
    { norm_cast,
      refine (to_nnreal_le_to_nnreal ((lt_of_le_of_lt (key _) one_lt_top).ne) one_ne_top).mpr
             (key _), },
  end, }

lemma thickened_indicator.coe_fn_eq_comp {δ : ℝ} (δ_pos : 0 < δ) (E : set α) :
  ⇑(thickened_indicator δ_pos E) = ennreal.to_nnreal ∘ thickened_indicator_aux δ E := rfl

lemma thickened_indicator_le_one {δ : ℝ} (δ_pos : 0 < δ) (E : set α) (x : α) :
  thickened_indicator δ_pos E x ≤ 1 :=
begin
  rw [thickened_indicator.coe_fn_eq_comp],
  simpa using (to_nnreal_le_to_nnreal thickened_indicator_aux_lt_top.ne one_ne_top).mpr
    (thickened_indicator_aux_le_one δ E x),
end

lemma thickened_indicator_one_of_mem_closure
  {δ : ℝ} (δ_pos : 0 < δ) (E : set α) {x : α} (x_mem : x ∈ closure E) :
  thickened_indicator δ_pos E x = 1 :=
by rw [thickened_indicator_apply,
       thickened_indicator_aux_one_of_mem_closure δ E x_mem, one_to_nnreal]

lemma thickened_indicator_one {δ : ℝ} (δ_pos : 0 < δ) (E : set α) {x : α} (x_in_E : x ∈ E) :
  thickened_indicator δ_pos E x = 1 :=
thickened_indicator_one_of_mem_closure _ _ (subset_closure x_in_E)

lemma thickened_indicator_zero
  {δ : ℝ} (δ_pos : 0 < δ) (E : set α) {x : α} (x_out : x ∉ thickening δ E) :
  thickened_indicator δ_pos E x = 0 :=
by rw [thickened_indicator_apply, thickened_indicator_aux_zero δ_pos E x_out, zero_to_nnreal]

lemma indicator_le_thickened_indicator {δ : ℝ} (δ_pos : 0 < δ) (E : set α) :
  E.indicator (λ _, (1 : ℝ≥0)) ≤ thickened_indicator δ_pos E :=
begin
  intro a,
  by_cases a ∈ E,
  { simp only [h, indicator_of_mem, thickened_indicator_one δ_pos E h, le_refl], },
  { simp only [h, indicator_of_not_mem, not_false_iff, zero_le], },
end

lemma thickened_indicator_mono {δ₁ δ₂ : ℝ}
  (δ₁_pos : 0 < δ₁) (δ₂_pos : 0 < δ₂) (hle : δ₁ ≤ δ₂) (E : set α) :
  ⇑(thickened_indicator δ₁_pos E) ≤ thickened_indicator δ₂_pos E :=
begin
  intro x,
  apply (to_nnreal_le_to_nnreal thickened_indicator_aux_lt_top.ne
         thickened_indicator_aux_lt_top.ne).mpr,
  apply thickened_indicator_aux_mono hle,
end

lemma thickened_indicator_subset {δ : ℝ} (δ_pos : 0 < δ) {E₁ E₂ : set α} (subset : E₁ ⊆ E₂) :
  ⇑(thickened_indicator δ_pos E₁) ≤ thickened_indicator δ_pos E₂ :=
λ x, (to_nnreal_le_to_nnreal thickened_indicator_aux_lt_top.ne
      thickened_indicator_aux_lt_top.ne).mpr (thickened_indicator_aux_subset δ subset x)

/-- As the thickening radius δ tends to 0, the δ-thickened indicator of a set E (in α) tends
pointwise to the indicator function of the closure of E.

Note: This version is for the bundled bounded continuous functions, but the topology is not
the topology on `α →ᵇ ℝ≥0`. Coercions to functions `α → ℝ≥0` are done first, so the topology
instance is the product topology (the topology of pointwise convergence). -/
lemma thickened_indicator_tendsto_indicator_closure
  {δseq : ℕ → ℝ} (δseq_pos : ∀ n, 0 < δseq n) (δseq_lim : tendsto δseq at_top (𝓝 0)) (E : set α) :
  tendsto (λ (n : ℕ), (coe_fn : (α →ᵇ ℝ≥0) → (α → ℝ≥0)) (thickened_indicator (δseq_pos n) E))
    at_top (𝓝 (indicator (closure E) (λ x, (1 : ℝ≥0)))) :=
begin
  have key := thickened_indicator_aux_tendsto_indicator_closure δseq_lim E,
  rw tendsto_pi_nhds at *,
  intro x,
  rw (show indicator (closure E) (λ x, (1 : ℝ≥0)) x
         = (indicator (closure E) (λ x, (1 : ℝ≥0∞)) x).to_nnreal,
      by refine (congr_fun (comp_indicator_const 1 ennreal.to_nnreal zero_to_nnreal) x).symm),
  refine tendsto.comp (tendsto_to_nnreal _) (key x),
  by_cases x_mem : x ∈ closure E; simp [x_mem],
end

end thickened_indicator -- section


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fintype.prod
import data.fintype.sum
import data.int.units

/-!
# fintype instances relating to units

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

variables {α : Type*}

instance units_int.fintype : fintype ℤˣ :=
⟨{1, -1}, λ x, by cases int.units_eq_one_or x; simp *⟩

@[simp] lemma units_int.univ : (finset.univ : finset ℤˣ) = {1, -1} := rfl

@[simp] theorem fintype.card_units_int : fintype.card ℤˣ = 2 := rfl

instance [monoid α] [fintype α] [decidable_eq α] : fintype αˣ :=
fintype.of_equiv _ (units_equiv_prod_subtype α).symm

instance [monoid α] [finite α] : finite αˣ := finite.of_injective _ units.ext

lemma fintype.card_units [group_with_zero α] [fintype α] [fintype αˣ] :
  fintype.card αˣ = fintype.card α - 1 :=
begin
  classical,
  rw [eq_comm, nat.sub_eq_iff_eq_add (fintype.card_pos_iff.2 ⟨(0 : α)⟩),
    fintype.card_congr (units_equiv_ne_zero α)],
  have := fintype.card_congr (equiv.sum_compl (= (0 : α))).symm,
  rwa [fintype.card_sum, add_comm, fintype.card_subtype_eq] at this,
end