open Nat

structure Vector (n : Nat) (α : Type u) where
  val  : Array α
  hasLen : val.size = n

@[specialize] def Vector.get {α : Type u} : (as : Vector n α) → Fin n → α
  | xs, {val := i, isLt} =>
    -- length xs.val = n, n <= n → n <= length xs.val
    Array.get xs.val {val := i, isLt := Nat.le_trans isLt (Eq.subst (Eq.symm xs.hasLen) Nat.le.refl)}

@[specialize] def Vector.fromArray {α : Type u} : (as : Array α) → Vector as.size α
  | xs => {val := xs, hasLen := rfl}

@[specialize] def Vector.enumeration {α : Type u} : Vector n α → (Fin n → α)
  | as => λ i => Vector.get as i

namespace PRF
inductive PRF : Nat → Type where
  | zero    : PRF 0
  | succ    : PRF 1
  | proj    : {n : Nat} → Fin n → PRF n -- projection
  -- composition: f(x) = g(h₁(x*),...,hₘ(x*)), where arity(f) = k, arity(g) = m, arity(hᵢ) = k
  | comp    : {m k : Nat} → PRF m → (Fin m → PRF k) → PRF k
  -- primitive recursion: f(0, x*) = g(x*); f(n + 1, x*) = h(f(n, x*), n, x*)
  | primrec : {n : Nat} → PRF n → PRF (n + 2) → PRF (n + 1) -- primitive recursion

def PRF.ToString : PRF n → String
  | PRF.zero => "zero"
  | PRF.succ => "succ"
  | PRF.proj {val := n, isLt := _} => s!"proj_{n}"
  | PRF.comp g _h => s!"{ToString g}∘"
  | PRF.primrec b c => s!"primrec({ToString b}, {ToString c})"

instance : ToString (PRF n) :=
  ⟨PRF.ToString⟩

def evaluate (f : PRF a) (arg : Fin a → Nat) : Nat :=
  match f with
  | PRF.zero => 0
  | PRF.succ => arg 0 + 1
  | PRF.proj i => arg i
  | PRF.comp g hs => evaluate g (λ i => evaluate (hs i) arg)
  | PRF.primrec g h =>
    let evalG := evaluate g
    let evalH := evaluate h
    let rec primrec : Nat → Nat
    | 0 =>
      evalG
        (λ {val := i, isLt := i_lt_n} =>
          arg {val := i + 1, isLt := Nat.succ_le_succ i_lt_n})
    | n + 1 =>
      evalH
        (λ fini =>
          match fini with
          | {val := 0, isLt := _} => primrec n
          | {val := 1, isLt := _} => n
          | {val := i + 2, isLt} => arg {val := i + 1, isLt := Nat.pred_le_pred isLt})
    primrec (arg 0)

def eval (f : PRF n) (args : Vector n Nat) : Nat :=
  evaluate f (Vector.enumeration args)

def PRF.comp1 : PRF 1 → PRF k → PRF k
  | g, h => PRF.comp g (λ _ => h)

def PRF.comp2 : PRF 2 → PRF k → PRF k → PRF k
  | g, h, i =>
    PRF.comp
      g
      (λ n =>
        match n with
        | {val := 0, isLt := _} => h
        | {val := 1, isLt := _} => i
        | {val := n + 2, isLt} => by contradiction)

def PRF.comp3 : PRF 3 → PRF k → PRF k → PRF k → PRF k
  | g, h, i, j =>
    PRF.comp
      g
      (λ n =>
        match n with
        | {val := 0, isLt := _} => h
        | {val := 1, isLt := _} => i
        | {val := 2, isLt := _} => j
        | {val := n + 3, isLt} => by contradiction)

def PRF.comp4 : PRF 4 → PRF k → PRF k → PRF k → PRF k → PRF k
  | g, h, i, j, l =>
    PRF.comp
      g
      (λ n =>
        match n with
        | {val := 0, isLt := _} => h
        | {val := 1, isLt := _} => i
        | {val := 2, isLt := _} => j
        | {val := 3, isLt := _} => l
        | {val := n + 4, isLt} => by contradiction)

def PRF.identity : PRF 1 := PRF.proj 0

theorem comp1id :
  eval f m =
    eval
      (PRF.comp1 f PRF.identity)
      (Vector.fromArray #[n]) :=
  sorry

def PRF.first : PRF (n + 1) := PRF.proj 0

def PRF.second : PRF (n + 2) := PRF.proj 1

def PRF.third : PRF (n + 3) := PRF.proj 2

def PRF.fourth : PRF (n + 4) := PRF.proj 3

def PRF.const {k : Nat} : Nat → PRF k
  | 0 =>
      PRF.comp PRF.zero (λ {isLt := zeroltzero} =>
                           by contradiction)
  | n+1 =>
      PRF.comp1 PRF.succ (@PRF.const k n)

--#eval eval (PRF.const 4) (Vector.fromArray #[23,4])

def PRF.add : PRF 2 :=
  PRF.primrec
    PRF.identity
    (PRF.comp1 PRF.succ PRF.first)

--#eval eval PRF.add (Vector.fromArray #[3, 2])

def PRF.mul : PRF 2 :=
  PRF.primrec
    (PRF.const 0)
    (PRF.comp2 PRF.add (PRF.proj 0) (PRF.proj 2))

--#eval eval PRF.mul (Vector.fromArray #[3, 0])
--#eval eval PRF.mul (Vector.fromArray #[3, 4])

def PRF.exp : PRF 2 :=
  PRF.comp2
    (PRF.primrec
      (PRF.const 1)
      (PRF.comp2 PRF.mul PRF.first (PRF.proj 2)))
    PRF.second
    PRF.first

-- #eval eval PRF.exp (Vector.fromArray #[0, 0])
-- #eval eval PRF.exp (Vector.fromArray #[0, 1])
-- #eval eval PRF.exp (Vector.fromArray #[10, 0])
--#eval eval PRF.exp (Vector.fromArray #[10, 2])

def PRF.pred : PRF 1 :=
  PRF.primrec (PRF.const 0) PRF.second

--#eval eval PRF.pred (Vector.fromArray #[2])

def PRF.signal : PRF 1 :=
  PRF.primrec
    (PRF.const 0)
    (PRF.const 1)

--#eval eval PRF.signal (Vector.fromArray #[0])
--#eval eval PRF.signal (Vector.fromArray #[1])
-- #eval eval PRF.signal (Vector.fromArray #[20])

def PRF.le : PRF 2 :=
  PRF.comp1 PRF.signal
    (PRF.primrec
      (PRF.comp1 PRF.succ PRF.first)
      (PRF.comp1 PRF.pred PRF.first))

-- #eval eval PRF.le (Vector.fromArray #[9, 10])
-- #eval eval PRF.le (Vector.fromArray #[10, 10])
-- #eval eval PRF.le (Vector.fromArray #[2, 1])

def PRF.lt : PRF 2 :=
  PRF.comp2 PRF.le (PRF.comp1 PRF.succ PRF.first) PRF.second

--#eval eval PRF.lt (Vector.fromArray #[9, 10])
--#eval eval PRF.lt (Vector.fromArray #[10, 10])
--#eval eval PRF.lt (Vector.fromArray #[2, 1])

def PRF.not : PRF 1 :=
  PRF.primrec
    (PRF.const 1)
    (PRF.const 0)

def PRF.if : PRF k → PRF k → PRF k → PRF k
  | t, f, g =>
    PRF.comp2
      PRF.add
      (PRF.comp2 PRF.mul (PRF.comp1 PRF.signal t) f)
      (PRF.comp2 PRF.mul (PRF.comp1 PRF.not t) g)

--#eval eval (PRF.if PRF.first PRF.first PRF.not) (Vector.fromArray #[0])

def PRF.or : PRF 2 :=
  PRF.comp1 PRF.signal (PRF.comp2 PRF.add PRF.first PRF.second)

def PRF.and : PRF 2 :=
  PRF.comp2 PRF.mul (PRF.comp1 PRF.signal PRF.first) (PRF.comp1 PRF.signal PRF.second)

-- #eval eval PRF.and (Vector.fromArray #[2, 0])

def PRF.eq : PRF 2 :=
  PRF.comp2
    PRF.and
    PRF.le
    (PRF.comp2 PRF.le PRF.second PRF.first)

--#eval eval PRF.eq (Vector.fromArray #[0, 1])
--#eval eval PRF.eq (Vector.fromArray #[11, 11])
--#eval eval PRF.eq (Vector.fromArray #[2, 1])

def PRF.fixFirst : PRF k → PRF (k + 1) → PRF k
  | z, f =>
    PRF.comp
      f
      (λ {val := n, isLt := nLt} =>
        match n with
        | 0 => z
        | n + 1 => PRF.proj {val := n, isLt := Nat.le_of_succ_le_succ nLt
        })

def PRF.dropFirst : PRF k → PRF (k + 1)
  | f =>
    PRF.comp
      f
      (λ {val := i, isLt := iLt} =>
        PRF.proj { val := i + 1
                 , isLt := Nat.succ_le_succ iLt
                 })

def PRF.dropNth : Nat → PRF k → PRF (k + 1)
  | n, f =>
    PRF.comp
      f
      (λ {val := i, isLt := iLt} =>
        if i < n
        then
        PRF.proj { val := i, isLt := Nat.le.step iLt }
        else
        PRF.proj { val := i + 1
                 , isLt := Nat.succ_le_succ iLt
                 })

--#eval eval (PRF.dropNth 0 PRF.le) (Vector.fromArray #[4, 5 , 3])

def PRF.mapNth : Nat → PRF k → PRF k → PRF k
  | i, g, f =>
    PRF.comp
      f
      (λ {val := n, isLt := nLt} =>
        if n = i
        then g
        else PRF.proj {val := n, isLt := nLt})

def PRF.firstLEsat : PRF (k + 1) → PRF k → PRF k
-- finds first number less or equal than first input argument that
-- satisfies predicate p
  | p, g =>
    -- we recurse on the first argument, when an index i has p(i,
    -- x₂, …, xₙ) > 0 we return i + 1; at the top-level we take
    -- pred, so we have 0 for failure and i + 1 for success with
    -- index i
    PRF.comp1
      PRF.pred
      (PRF.fixFirst g
      (PRF.primrec
        (PRF.comp1
          PRF.signal
          (PRF.fixFirst
            (PRF.const 0)
            p))
        (PRF.if
          PRF.first
          PRF.first
          (PRF.if
            (PRF.dropFirst (PRF.mapNth 0 (PRF.comp1 PRF.succ PRF.first) p))
            (PRF.comp1 PRF.succ <| PRF.comp1 PRF.succ PRF.second)
            (PRF.const 0)))))

--#eval eval (@PRF.firstLEsat 0 (PRF.comp2 PRF.le (PRF.const 5) PRF.first) (PRF.const 10)) (Vector.fromArray #[1])

def PRF.disjunction : PRF (k + 1) → PRF (k + 1)
-- disjunction(p, n, x₁, ..., xₙ) = { 1 if p(i, n, x₁, ..., xₙ) for some i <= n; 0 otherwise}
  | p =>
    PRF.comp2
      PRF.or
      (PRF.primrec
        (PRF.const 0)
        (PRF.if
          PRF.first
          PRF.first
          (PRF.comp1 PRF.signal
            (PRF.dropNth 0 p))))
      p

--#eval eval (@PRF.disjunction 0 (PRF.comp2 PRF.le (PRF.const 13) PRF.first)) (Vector.fromArray #[0])

def PRF.limMin : PRF (k + 1) → PRF k → PRF k
  -- (μ z ≤ g(x₁, ..., xₙ))[h(z, x₁, ..., xₙ) > 0]
  | h, g => PRF.firstLEsat h g

-- #eval eval
--         (PRF.limMin
--           (PRF.comp2 PRF.le (PRF.const 3) PRF.first)
--           (@PRF.comp2 1 PRF.add PRF.first (PRF.const 1)))
--         (Vector.fromArray #[2])

namespace TM

inductive Move where
  | left : Move
  | right : Move
  | stop : Move

structure Transition where
  sttState : Nat
  sttSymbol : Nat
  endState : Nat
  endSymbol : Nat
  move : Move

structure TuringMachine where
  rules  : List Transition
  finalState : Nat

def k : Nat
  -- number of symbols in the alphabet
  := 10

def symbolMark : Nat
  -- mark before a symbol starts
  := 2

def stateMark : Nat
  -- mark before a state starts
  := 3

def movementMark : Nat
  -- mark before a movement
  := 4

def leftMark : Nat
  -- indicates left movement
  := 5

def rightMark : Nat
  -- indicates right movement
  := 6

def stopMark : Nat
  -- indicates stop (non-)movement
  := 7

def stepMark : Nat
  -- separates a TM step from another
  := 8

def emptyMark : Nat
  -- denotes the empty cell
  := 9

def TM.encode : TuringMachine → Nat
  -- encoding as {finalState}{transitions}
  --- state is Q{bitstring}, symbol is S{bitstring}
  -- transition is {begin state}{begin symbol}{end state}{end
  --- symbol}{movement separator}{movement}{rule separator}
  -- current state goes in the tape instead
  | tm =>
    String.toNat! <|
    encodeState tm.finalState
    ++ String.intercalate
         (toString stepMark)
         (List.map encodeStep tm.rules)

  where
    encodeUnary : Nat → String
    | n => String.join (List.replicate n "1")
    encodeState : Nat → String
    | st => toString stateMark ++ encodeUnary st
    encodeSymbol : Nat → String
    | sy => toString symbolMark ++ encodeUnary sy
    encodeMove : Move → String
    | m => toString
        <| match m with
           | Move.left => leftMark
           | Move.right => rightMark
           | Move.stop => stopMark
    encodeStep : Transition → String
    | tr =>
      String.join
        [ encodeState tr.sttState
        , encodeSymbol tr.sttSymbol
        , encodeState tr.endState
        , encodeSymbol tr.endSymbol
        , toString movementMark
        , encodeMove tr.move
        ]

def TM.unarySucc : TuringMachine :=
  { rules :=
    [ { sttState := 0
      , sttSymbol := 1
      , endState := 0
      , endSymbol := 1
      , move := Move.right
      }
    , { sttState := 0
      , sttSymbol := emptyMark
      , endState := 1
      , endSymbol := 1
      , move := Move.stop
      }
    ]
  , finalState := 1
  }

#eval TM.encode TM.unarySucc

def TM.binarySucc : TuringMachine :=
  { rules :=
    [ { sttState := 0
      , sttSymbol := 1
      , endState := 0
      , endSymbol := 1
      , move := Move.right
      }
    , { sttState := 0
      , sttSymbol := emptyMark
      , endState := 1
      , endSymbol := emptyMark
      , move := Move.left
      }
    , { sttState := 1
      , sttSymbol := 1
      , endState := 1
      , endSymbol := 1
      , move := Move.left
      }
    , { sttState := 0
      , sttSymbol := 0
      , endState := 0
      , endSymbol := 0
      , move := Move.right
      }
    , { sttState := 1
      , sttSymbol := 0
      , endState := 10
      , endSymbol := 1
      , move := Move.stop
      }
    , { sttState := 1
      , sttSymbol := emptyMark
      , endState := 10
      , endSymbol := 1
      , move := Move.stop
      }
    ]
  , finalState := 10
  }

def TM.len : PRF 1 :=
  -- lenₖ(w) = z such that k^z > w and ∀n, k^n > w → n > z
  PRF.limMin
    (PRF.comp2 PRF.lt PRF.second (PRF.comp2 PRF.exp (PRF.const k) PRF.first))
    PRF.identity

--#eval eval TM.len (Vector.fromArray #[10])

def TM.concat : PRF 2 :=
  -- w₁.w₂ = w₁*k^len(w₂) + w₂
  PRF.comp2
    PRF.add
    (PRF.comp2
      PRF.mul
      PRF.first
      (PRF.comp2
        PRF.exp
        (PRF.const k)
        (PRF.comp1 len PRF.second)))
    PRF.second

--#eval eval TM.concat (Vector.fromArray #[1, 1])

def TM.pre : PRF 2 :=
  -- pre(w₁, w) = z s.t. ∃z,∃i, z.w₁.i = w
  PRF.limMin
    (PRF.comp4
      (PRF.disjunction
        (PRF.comp2
          PRF.eq
          PRF.fourth /- w -/
          (PRF.comp2 concat PRF.second (PRF.comp2 concat PRF.third PRF.first))))
      PRF.third /- w -/
      PRF.first /- z -/
      PRF.second /- w₁ -/
      PRF.third /- w again -/)
    PRF.second

--#eval eval TM.pre (Vector.fromArray #[2, 12])

def TM.preFromRight : PRF 2 :=
  -- preᵣ(w₁, w) = z s.t. ∃z,∃i, i.w₁.z = w
  PRF.limMin
    (PRF.comp4
      (PRF.disjunction
        (PRF.comp2
          PRF.eq
          PRF.fourth /- w -/
          (PRF.comp2 concat PRF.first (PRF.comp2 concat PRF.third PRF.second))))
      PRF.third /- w -/
      PRF.first /- z -/
      PRF.second /- w₁ -/
      PRF.third /- w again -/)
    PRF.second

def TM.isPrefix : PRF 2 :=
  PRF.limMin
    (PRF.comp2
      PRF.eq
        PRF.third
        (PRF.comp2
          TM.concat
          PRF.second
          PRF.first))
    PRF.second

--#eval eval TM.isPrefix (Vector.fromArray #[1, 11])

def TM.substring : PRF 2 :=
  PRF.if
    TM.pre
    TM.isPrefix
    (PRF.const 1)

--#eval eval TM.substring (Vector.fromArray #[1, 12])

def TM.post : PRF 2 :=
  -- post(w₁, w) = z s.t. ∃z,∃i, i.w₁.z = w
  PRF.if
    TM.substring
    (PRF.limMin
      (PRF.comp2
        PRF.eq
          (PRF.comp2 concat (PRF.comp2 concat (PRF.comp2 pre PRF.second PRF.third) PRF.second) PRF.first)
          PRF.third)
      PRF.second)
    (PRF.const 0)

theorem pre_post_concat_eq :
  m =
    eval
      (PRF.comp2 TM.concat TM.pre (PRF.comp2 TM.concat PRF.first TM.post))
      (Vector.fromArray #[n, m]) :=
  sorry

--#eval eval TM.pre (Vector.fromArray #[2, 11])

def TM.subst : PRF 3 :=
  -- subst(w₁, w₂, w) = if substring(w₁, w) then w[w₁ ← w₂] else w
  PRF.if
    (PRF.comp2 TM.substring PRF.first PRF.third)
    (PRF.comp2
      concat
      (PRF.comp2 pre PRF.first PRF.third)
      (PRF.comp2 concat PRF.second (PRF.comp2 post PRF.first PRF.third)))
    PRF.third

--#eval eval (TM.subst 10) (Vector.fromArray #[2, 1, 121])

def TM.state : PRF 1 :=
  -- get current TM state
  PRF.comp2
    TM.concat
    (PRF.const stateMark)
    (PRF.comp2
      pre
      (PRF.const symbolMark)
      (PRF.comp2
        post
        (PRF.const stateMark)
        PRF.first))

def TM.currentSymbol : PRF 1 :=
  PRF.comp2
    TM.concat
    (PRF.const symbolMark)
    (PRF.comp2
      pre
      (PRF.const symbolMark)
      (PRF.comp2
        post
        (PRF.const symbolMark)
        (PRF.comp2
          post
          (PRF.const stateMark)
          PRF.first)))

def TM.leftSymbol : PRF 1 :=
  PRF.comp2
    TM.concat
    (PRF.const symbolMark)
    (PRF.comp2
      TM.preFromRight
      (PRF.const symbolMark)
      (PRF.comp2
        pre
        (PRF.const stateMark)
        PRF.first))

def TM.nextSymbol : PRF 3 :=
  PRF.comp2
    concat
    (PRF.const symbolMark)
    (PRF.comp2
      pre
      (PRF.const movementMark)
      (PRF.comp2
        post
        (PRF.const symbolMark)
        (PRF.comp2
          post
          (PRF.comp2
            concat
            PRF.second
            PRF.third)
          PRF.first)))

def TM.nextState : PRF 3 :=
  PRF.comp2
    concat
    (PRF.const stateMark)
    (PRF.comp2
      pre
      (PRF.const symbolMark)
      (PRF.comp2
        post
        (PRF.comp2
          concat
          PRF.second
          PRF.third)
        PRF.first))

def TM.movement : PRF 3 :=
  PRF.comp2
    post
    (PRF.const movementMark)
    (PRF.comp2
      pre
      (PRF.const stepMark)
      (PRF.comp2
        post
        (PRF.comp2
          concat
          PRF.second
          PRF.third)
        PRF.first))

def TM.step : PRF 2 :=
  let machine := PRF.first
  let tape := PRF.second
  let currState := PRF.comp1 TM.state PRF.second
  let currSymbol := PRF.comp1 TM.currentSymbol PRF.second
  let currentMove :=
    PRF.comp3
      TM.movement
      PRF.first
      currState
      currSymbol
  let equals := λ a1 a2 => PRF.comp2 PRF.eq a1 a2
  let concat := λ a1 a2 => PRF.comp2 TM.concat a1 a2
  let subst := λ a1 a2 a3 => PRF.comp3 TM.subst a1 a2 a3
  let nextState := PRF.comp3 TM.nextState machine currState currSymbol
  let nextSymbol := PRF.comp3 TM.nextSymbol machine currState currSymbol
  let leftSymbol := PRF.comp1 TM.leftSymbol tape
  PRF.if
    (equals currentMove (PRF.const rightMark))
    -- next move is to the right
    (subst
      (concat currState currSymbol)
      (concat nextSymbol nextState)
      tape)
    (PRF.if
      (equals currentMove (PRF.const leftMark))
      -- next move is to the left (to the left, to the left)
      (subst
        (concat leftSymbol (concat currState currSymbol))
        (concat nextState (concat leftSymbol nextSymbol))
        tape)
      -- we stop here
      (subst
        (concat currState currSymbol)
        (concat nextState nextSymbol)
        tape))

def TM.steps : PRF 3 :=
  PRF.primrec
    PRF.second
    (PRF.comp2 TM.step PRF.third PRF.first)

end TM
end PRF

open PRF.TM
def main : IO Unit :=
  IO.println s!"{PRF.eval TM.len (Vector.fromArray #[10])}"


import tactic
import linear_algebra
import linear_algebra.dimension
import ..linear_algebra.lincomb
import ..pregeom.basic
import ..pregeom.geometrize
import ..helpers

/--!
# What is going on here?

In this file, we define the pregeometry instance on a vector space V.
Since the vectorspace structure on V depends on the field (a priori V is just an abelian group), this was made a definition and not an instance.
See `vector_space.pregeom_instance`.

We then define the projective geometry associated to the k-vectorspace V as the geometry associated to this pregeomety.
Explicitly, `projectivization k V` is the projectivization of V as a k-vectorspace.
It is a geometry in the sense of the definition in `pregeom.basic`.
-/

variables (k : Type*) [field k]
variables (V : Type*) [add_comm_group V] [module k V]

set_option default_priority 100
open_locale classical

namespace vector_space

open submodule

include k
/--
A has_cl instance for a k-vectorspace V.
Used to define the associated projective geometry.
-/
def has_cl_instance : has_cl V := ⟨ λ S, span k S ⟩
local attribute [instance] has_cl_instance

/--
A pregeom instance for a k-vectorspace V.
Used to define the associated projective geometry.
-/
def pregeom_instance : pregeom V :=
begin
  split; intros,
  { exact subset_span },
  { exact span_mono a },
  { unfold has_cl.cl, rwa span_span, },
  { replace a : x ∈ span k (insert y S), by exact a,
    rw mem_span_insert at a,
    rcases a with ⟨a,v,w,h⟩,
    have : a ≠ 0,
    { intro contra, rw contra at h,
      replace h : x = v, by rwa [zero_smul,zero_add] at h,
      rw h at *,
      contradiction, },
    have : a⁻¹ • x + a⁻¹ • -v = y, by
    calc a⁻¹ • x + a⁻¹ • -v = a⁻¹ • a • y + a⁻¹ • v + a⁻¹ • -v : by rw [h, smul_add]
    ... = (1 : k) • y + a⁻¹ • v + a⁻¹ • -v : by rw [←mul_smul, inv_mul_cancel this]
    ... = y : by rw [add_assoc, ←smul_add, one_smul]; simp,
    rw ←this,
    set H := span k (insert x S),
    apply add_mem' H,
    { apply smul_mem' H, apply subset_span, simp, },
    { apply smul_mem' H, apply neg_mem H,
      have : S ⊆ insert x S, by simp,
      apply span_mono this, assumption, } },
  { unfold has_cl.cl at *,
    rw ←lcspan.lcspan_eq_span at a,
    rcases a with ⟨L,hL1,hL2⟩,
    refine ⟨(lincomb.vects L).to_finset, _ , _⟩,
    { intros x hx,
      replace hx : x ∈ (lincomb.vects L).to_finset, by exact hx,
      rw list.mem_to_finset at hx,
      exact hL2 hx, },
    { rw ←hL1,
      apply lincomb.mem_span, } }
end
local attribute [instance] pregeom_instance

@[simp]
lemma cl_empty : cl (∅ : set V) = {0} := by simp [has_cl.cl]

end vector_space

open vector_space

include k

/--
`projectivization k V` is the projectivization of the k-vectorspace V.
-/
abbreviation projectivization := @pregeom.geom V (has_cl_instance k V)

namespace projectivization

instance : geometry (projectivization k V) := @pregeom.geom.geom_instance V (pregeom_instance k V)

variable {V}
def homogenize {v : V} : v ≠ 0 → projectivization k V := λ hv,
  @pregeom.geom.to_geom V (vector_space.has_cl_instance k V) ⟨v, by simpa [pregeom.reg_set]⟩

theorem homogenize_eq_iff {v w : V} {hv : v ≠ 0} {hw : w ≠ 0} : homogenize k hv = homogenize k hw ↔
  submodule.span k ({v} : set V) = submodule.span k {w} :=
begin
  set regs := @pregeom.reg V (vector_space.has_cl_instance k V),
  change pregeom.geom.to_geom _ = pregeom.geom.to_geom _ ↔ _,
  rw pregeom.geom.eq_iff,
  change pregeom.pullback.pcl _ _ = pregeom.pullback.pcl _ _ ↔ _,
  split; intro h,
  { replace h := congr_arg (λ A, subtype.val '' A) h,
    change _ '' _ = _ '' _ at h,
    conv at h {
      congr,
      rw [pregeom.pullback.image_pcl, set.image_singleton],
      dsimp,
      skip,
      rw [pregeom.pullback.image_pcl, set.image_singleton],
      dsimp, },
    change _ ∩ ↑(submodule.span _ _) = _ ∩ ↑(submodule.span _ _) at h,
    have : v ∈ set.range (subtype.val : regs → V) ∩ ↑(submodule.span k ({v} : set V)),
    { split,
      { use v, change v ∉ cl _, rw cl_empty, assumption, },
      { apply submodule.subset_span, tauto, } },
    rw h at this,
    cases this with h1 h2,
    replace h2 : v ∈ submodule.span k ({w} : set V), by exact h2,
    rw submodule.mem_span_singleton at h2,
    symmetry,
    rw submodule.span_singleton_eq_iff,
    assumption' },
  { change _ ⁻¹' ↑(submodule.span _ _) = _ ⁻¹' ↑(submodule.span _ _),
    repeat {rw set.image_singleton},
    rw h }
end

theorem homogenize_eq_iff' {v w : V} {hv : v ≠ 0} {hw : w ≠ 0} :
  homogenize k hv = homogenize k hw ↔ ∃ x : k, x • v = w :=
begin
  rw homogenize_eq_iff,
  apply submodule.span_singleton_eq_iff,
  assumption'
end

end projectivization


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

/-!
# Finitely supported product of finsets

This file defines the finitely supported product of finsets as a `finset (ι →₀ α)`.

## Main declarations

* `finset.finsupp`: Finitely supported product of finsets. `s.finset t` is the product of the `t i`
  over all `i ∈ s`.
* `finsupp.pi`: `f.pi` is the finset of `finsupp`s whose `i`-th value lies in `f i`. This is the
  special case of `finset.finsupp` where we take the product of the `f i` over the support of `f`.

## Implementation notes

We make heavy use of the fact that `0 : finset α` is `{0}`. This scalar actions convention turns out
to be precisely what we want here too.
-/

noncomputable theory

open finsupp
open_locale big_operators classical pointwise

variables {ι α : Type*} [has_zero α] {s : finset ι} {f : ι →₀ α}

namespace finset

/-- Finitely supported product of finsets. -/
protected def finsupp (s : finset ι) (t : ι → finset α) : finset (ι →₀ α) :=
(s.pi t).map ⟨indicator s, indicator_injective s⟩

lemma mem_finsupp_iff {t : ι → finset α} : f ∈ s.finsupp t ↔ f.support ⊆ s ∧ ∀ i ∈ s, f i ∈ t i :=
begin
  refine mem_map.trans ⟨_, _⟩,
  { rintro ⟨f, hf, rfl⟩,
    refine ⟨support_indicator_subset _ _, λ i hi, _⟩,
    convert mem_pi.1 hf i hi,
    exact indicator_of_mem hi _ },
  { refine λ h, ⟨λ i _, f i, mem_pi.2 h.2, _⟩,
    ext i,
    exact ite_eq_left_iff.2 (λ hi, (not_mem_support_iff.1 $ λ H, hi $ h.1 H).symm) }
end

/-- When `t` is supported on `s`, `f ∈ s.finsupp t` precisely means that `f` is pointwise in `t`. -/
@[simp] lemma mem_finsupp_iff_of_support_subset {t : ι →₀ finset α} (ht : t.support ⊆ s) :
  f ∈ s.finsupp t ↔ ∀ i, f i ∈ t i :=
begin
  refine mem_finsupp_iff.trans (forall_and_distrib.symm.trans $ forall_congr $ λ i, ⟨λ h, _,
    λ h, ⟨λ hi, ht $ mem_support_iff.2 $ λ H, mem_support_iff.1 hi _, λ _, h⟩⟩),
  { by_cases hi : i ∈ s,
    { exact h.2 hi },
    { rw [not_mem_support_iff.1 (mt h.1 hi), not_mem_support_iff.1 (λ H, hi $ ht H)],
      exact zero_mem_zero } },
  { rwa [H, mem_zero] at h }
end

@[simp] lemma card_finsupp (s : finset ι) (t : ι → finset α) :
  (s.finsupp t).card = ∏ i in s, (t i).card :=
(card_map _).trans $ card_pi _ _

end finset

open finset

namespace finsupp

/-- Given a finitely supported function `f : ι →₀ finset α`, one can define the finset
`f.pi` of all finitely supported functions whose value at `i` is in `f i` for all `i`. -/
def pi (f : ι →₀ finset α) : finset (ι →₀ α) := f.support.finsupp f

@[simp] lemma mem_pi {f : ι →₀ finset α} {g : ι →₀ α} : g ∈ f.pi ↔ ∀ i, g i ∈ f i :=
mem_finsupp_iff_of_support_subset $ subset.refl _

@[simp] lemma card_pi (f : ι →₀ finset α) : f.pi.card = f.prod (λ i, (f i).card) :=
begin
  rw [pi, card_finsupp],
  exact finset.prod_congr rfl (λ i _, by simp only [pi.nat_apply, nat.cast_id]),
end

end finsupp


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import ring_theory.finiteness
import linear_algebra.dimension

/-!
# A module over a division ring is noetherian if and only if it is finite.

-/

universes u v

open_locale classical cardinal
open cardinal submodule module function

namespace is_noetherian

variables {K : Type u} {V : Type v} [division_ring K] [add_comm_group V] [module K V]

/--
A module over a division ring is noetherian if and only if
its dimension (as a cardinal) is strictly less than the first infinite cardinal `ℵ₀`.
-/
lemma iff_dim_lt_aleph_0 : is_noetherian K V ↔ module.rank K V < ℵ₀ :=
begin
  let b := basis.of_vector_space K V,
  rw [← b.mk_eq_dim'', lt_aleph_0_iff_finite],
  split,
  { introI,
    exact finite_of_linear_independent (basis.of_vector_space_index.linear_independent K V) },
  { assume hbfinite,
    refine @is_noetherian_of_linear_equiv K (⊤ : submodule K V) V _
      _ _ _ _ (linear_equiv.of_top _ rfl) (id _),
    refine is_noetherian_of_fg_of_noetherian _ ⟨set.finite.to_finset hbfinite, _⟩,
    rw [set.finite.coe_to_finset, ← b.span_eq, basis.coe_of_vector_space, subtype.range_coe] }
end

variables (K V)

/-- The dimension of a noetherian module over a division ring, as a cardinal,
is strictly less than the first infinite cardinal `ℵ₀`. -/
lemma dim_lt_aleph_0 : ∀ [is_noetherian K V], module.rank K V < ℵ₀ :=
is_noetherian.iff_dim_lt_aleph_0.1

variables {K V}

/-- In a noetherian module over a division ring, all bases are indexed by a finite type. -/
noncomputable def fintype_basis_index {ι : Type*} [is_noetherian K V] (b : basis ι K V) :
  fintype ι :=
b.fintype_index_of_dim_lt_aleph_0 (dim_lt_aleph_0 K V)

/-- In a noetherian module over a division ring,
`basis.of_vector_space` is indexed by a finite type. -/
noncomputable instance [is_noetherian K V] : fintype (basis.of_vector_space_index K V) :=
fintype_basis_index (basis.of_vector_space K V)

/-- In a noetherian module over a division ring,
if a basis is indexed by a set, that set is finite. -/
lemma finite_basis_index {ι : Type*} {s : set ι} [is_noetherian K V] (b : basis s K V) :
  s.finite :=
b.finite_index_of_dim_lt_aleph_0 (dim_lt_aleph_0 K V)

variables (K V)

/-- In a noetherian module over a division ring,
there exists a finite basis. This is the indexing `finset`. -/
noncomputable def finset_basis_index [is_noetherian K V] :
  finset V :=
(finite_basis_index (basis.of_vector_space K V)).to_finset

@[simp] lemma coe_finset_basis_index [is_noetherian K V] :
  (↑(finset_basis_index K V) : set V) = basis.of_vector_space_index K V :=
set.finite.coe_to_finset _

@[simp] lemma coe_sort_finset_basis_index [is_noetherian K V] :
  ((finset_basis_index K V) : Type*) = basis.of_vector_space_index K V :=
set.finite.coe_sort_to_finset _

/--
In a noetherian module over a division ring, there exists a finite basis.
This is indexed by the `finset` `finite_dimensional.finset_basis_index`.
This is in contrast to the result `finite_basis_index (basis.of_vector_space K V)`,
which provides a set and a `set.finite`.
-/
noncomputable def finset_basis [is_noetherian K V] :
  basis (finset_basis_index K V) K V :=
(basis.of_vector_space K V).reindex (by simp)

@[simp] lemma range_finset_basis [is_noetherian K V] :
  set.range (finset_basis K V) = basis.of_vector_space_index K V :=
by rw [finset_basis, basis.range_reindex, basis.range_of_vector_space]

variables {K V}

/-- A module over a division ring is noetherian if and only if it is finitely generated. -/
lemma iff_fg :
  is_noetherian K V ↔ module.finite K V :=
begin
  split,
  { introI h,
    exact ⟨⟨finset_basis_index K V, by { convert (finset_basis K V).span_eq, simp }⟩⟩ },
  { rintros ⟨s, hs⟩,
    rw [is_noetherian.iff_dim_lt_aleph_0, ← dim_top, ← hs],
    exact lt_of_le_of_lt (dim_span_le _) (lt_aleph_0_iff_finite.2 (set.finite_mem_finset s)) }
end

end is_noetherian


-- Equivalencia de definiciones de creciente
-- =========================================

import data.real.basic
variable (f : ℝ → ℝ)

example :
  (∀ x y, x < y → f x < f y) ↔ (∀ x y, (x ≤ y ↔ f x ≤ f y)) :=
begin
  split,
  { intros hf x y,
    split,
    { intros hxy,
      cases eq_or_lt_of_le hxy with hxy hxy,
      { rw hxy },
      { linarith [hf x y hxy]} },
    { contrapose!,
      apply hf } },
  { intros hf x y,
    contrapose!,
    intro h,
    rwa hf, }
end


import ..lectures.love08_operational_semantics_demo

/-! # LoVe Exercise 8: Operational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Guarded Command Language

In 1976, E. W. Dijkstra introduced the guarded command language (GCL), a
minimalistic imperative language with built-in nondeterminism. A grammar for one
of its variants is given below:

    S  ::=  x := e       -- assignment
         |  assert b     -- assertion
         |  S ; S        -- sequential composition
         |  S | ⋯ | S    -- nondeterministic choice
         |  loop S       -- nondeterministic iteration

Assignment and sequential composition are as in the WHILE language. The other
statements have the following semantics:

* `assert b` aborts if `b` evaluates to false; otherwise, the command is a
  no-op.

* `S | ⋯ | S` chooses any of the branches and executes it, ignoring the other
  branches.

* `loop S` executes `S` any number of times.

In Lean, GCL is captured by the following inductive type: -/

namespace gcl

inductive stmt (σ : Type) : Type
| assign : string → (σ → ℕ) → stmt
| assert : (σ → Prop) → stmt
| seq    : stmt → stmt → stmt
| choice : list stmt → stmt
| loop   : stmt → stmt

infixr ` ;; ` : 90 := stmt.seq

/-! The parameter `σ` abstracts over the state type. It is necessary as a work
around for a Lean bug. Below we will take `σ := state`.

1.1. Complete the following big-step semantics, based on the informal
specification of GCL above. -/

inductive big_step : (stmt state × state) → state → Prop
-- enter the missing `assign` rule here
| assert {b : state → Prop} {s} (hcond : b s) :
  big_step (stmt.assert b, s) s
-- enter the missing `seq` rule here
| choice {Ss s t} (i) (hless : i < list.length Ss)
    (hbody : big_step (list.nth_le Ss i hless, s) t) :
  big_step (stmt.choice Ss, s) t
-- enter the missing `loop` rules here

infix ` ⟹ ` : 110 := big_step

/-! 1.2. Prove the following inversion rules, as we did in the lecture for the
WHILE language. -/

@[simp] lemma big_step_assign_iff {x a s t} :
  (stmt.assign x a, s) ⟹ t ↔ t = s{x ↦ a s} :=
sorry

@[simp] lemma big_step_assert {b s t} :
  (stmt.assert b, s) ⟹ t ↔ t = s ∧ b s :=
sorry

@[simp] lemma big_step_seq_iff {S₁ S₂ s t} :
  (stmt.seq S₁ S₂, s) ⟹ t ↔ (∃u, (S₁, s) ⟹ u ∧ (S₂, u) ⟹ t) :=
sorry

lemma big_step_loop {S s u} :
  (stmt.loop S, s) ⟹ u ↔
  (s = u ∨ (∃t, (S, s) ⟹ t ∧ (stmt.loop S, t) ⟹ u)) :=
sorry

@[simp] lemma big_step_choice {Ss s t} :
  (stmt.choice Ss, s) ⟹ t ↔
  (∃(i : ℕ) (hless : i < list.length Ss),
     (list.nth_le Ss i hless, s) ⟹ t) :=
sorry

end gcl

/-! 1.3. Complete the translation below of a deterministic program to a GCL
program, by filling in the `sorry` placeholders below. -/

def gcl_of : stmt → gcl.stmt state
| stmt.skip         := gcl.stmt.assert (λ_, true)
| (stmt.assign x a) :=
  sorry
| (S ;; T)          :=
  sorry
| (stmt.ite b S T)  :=
  sorry
| (stmt.while b S)  :=
  sorry

/-! 1.4. In the definition of `gcl_of` above, `skip` is translated to
`assert (λ_, true)`. Looking at the big-step semantics of both constructs, we
can convince ourselves that it makes sense. Can you think of other correct ways
to define the `skip` case? -/

-- enter your answer here

/-! ## Question 2: Program Equivalence

For this question, we introduce the notion of program equivalence: `S₁ ≈ S₂`. -/

def big_step_equiv (S₁ S₂ : stmt) : Prop :=
∀s t, (S₁, s) ⟹ t ↔ (S₂, s) ⟹ t

infix ` ≈ ` := big_step_equiv

/-! Program equivalence is a equivalence relation, i.e., it is reflexive,
symmetric, and transitive. -/

@[refl] lemma big_step_equiv.refl {S : stmt} :
  S ≈ S :=
fix s t,
show (S, s) ⟹ t ↔ (S, s) ⟹ t, from
  by refl

@[symm] lemma big_step_equiv.symm {S₁ S₂ : stmt}:
  S₁ ≈ S₂ → S₂ ≈ S₁ :=
assume h : S₁ ≈ S₂,
fix s t,
show (S₂, s) ⟹ t ↔ (S₁, s) ⟹ t, from
  iff.symm (h s t)

@[trans] lemma big_step_equiv.trans {S₁ S₂ S₃ : stmt} (h₁₂ : S₁ ≈ S₂)
    (h₂₃ : S₂ ≈ S₃) :
  S₁ ≈ S₃ :=
fix s t,
show (S₁, s) ⟹ t ↔ (S₃, s) ⟹ t, from
  iff.trans (h₁₂ s t) (h₂₃ s t)

/-! 2.1. Prove the following program equivalences. -/

lemma big_step_equiv.skip_assign_id {x} :
  stmt.assign x (λs, s x) ≈ stmt.skip :=
sorry

lemma big_step_equiv.seq_skip_left {S : stmt} :
  stmt.skip ;; S ≈ S :=
sorry

lemma big_step_equiv.seq_skip_right {S : stmt} :
  S ;; stmt.skip ≈ S :=
sorry

lemma big_step_equiv.ite_seq_while {b} {S : stmt} :
  stmt.ite b (S ;; stmt.while b S) stmt.skip ≈ stmt.while b S :=
sorry

/-! 2.2 (**optional**). Program equivalence can be used to replace subprograms
by other subprograms with the same semantics. Prove the following so-called
congruence rules: -/

lemma big_step_equiv.seq_congr {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  S₁ ;; T₁ ≈ S₂ ;; T₂ :=
sorry

lemma big_step_equiv.ite_congr {b} {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  stmt.ite b S₁ T₁ ≈ stmt.ite b S₂ T₂ :=
sorry

lemma denote_equiv.while_congr {b} {S₁ S₂ : stmt} (hS : S₁ ≈ S₂) :
  stmt.while b S₁ ≈ stmt.while b S₂ :=
sorry

end LoVe


/-
Defines the properties of assignments on polymorphic variables,
including equisatisfiability and equivalence on domains.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import data.finset.basic
import cnf.literal

universe u

-- Represents the type of the variable stored in the literal
variables {V : Type*}

namespace assignment

open literal
open finset

/-! # Properties -/

instance : inhabited (assignment V) := ⟨(λ _, tt)⟩

/-! # Equivalence on domain -/
section eqod

/- Two assignments are equivalent on a domain of variables if they agree
   on the truth value of that variable for all variables in the set.

   We choose finsets as our objects of interest because the domain of any
   formula is finite, so equivalences that extend beyond those domains are
   essentially irrelevant.
-/
def eqod (τ₁ τ₂ : assignment V) (s : finset V) : Prop := ∀ v ∈ s, τ₁ v = τ₂ v

-- TODO how to properly set up this notation so that () are not required
notation τ₁ ` ≡`:50 s `≡ `:40 τ₂ := eqod τ₁ τ₂ s

variables {τ₁ τ₂ τ₃ : assignment V} {s s₁ s₂ : finset V} {v : V} {l : literal V}

@[refl] theorem eqod.refl (τ : assignment V) (s : finset V) : eqod τ τ s :=
by tautology

@[symm] theorem eqod.symm : (eqod τ₁ τ₂ s) → (eqod τ₂ τ₁ s) :=
assume h v hv, (h v hv).symm

theorem eqod_comm : (eqod τ₁ τ₂ s) ↔ (eqod τ₂ τ₁ s) :=
⟨eqod.symm, eqod.symm⟩

@[trans] theorem eqod.trans : (eqod τ₁ τ₂ s) → (eqod τ₂ τ₃ s) → (eqod τ₁ τ₃ s) :=
assume h₁ h₂ v hv, eq.trans (h₁ v hv) (h₂ v hv)

@[simp] theorem eqod_nil (τ₁ τ₂ : assignment V) : eqod τ₁ τ₂ ∅ :=
assume v hv, absurd hv (not_mem_empty v)

theorem eqod_subset : s₁ ⊆ s₂ → (eqod τ₁ τ₂ s₂) → (eqod τ₁ τ₂ s₁) :=
assume h hs₂ v hv, hs₂ v (h hv)

section -- Need decidable_eq

variable [decidable_eq V]

theorem eqod_union_of_eqod_of_eq : (eqod τ₁ τ₂ s) → τ₁ v = τ₂ v → (eqod τ₁ τ₂ ({v} ∪ s)) :=
assume heqod heq u hu, or.elim (mem_union.mp hu)
  (λ h, (mem_singleton.mp h).symm ▸ heq)
  (λ h, heqod u h)

theorem eqod_union : (eqod τ₁ τ₂ s₁) → (eqod τ₁ τ₂ s₂) → (eqod τ₁ τ₂ (s₁ ∪ s₂)) :=
assume h₁ h₂ v hv, or.elim (mem_union.mp hv) (λ h, h₁ v h) (λ h, h₂ v h)

theorem eqod_inter : (eqod τ₁ τ₂ s₁) → (eqod τ₁ τ₂ s₂) → (eqod τ₁ τ₂ (s₁ ∩ s₂)) :=
assume h₁ _ v hv, h₁ v (mem_inter.mp hv).1

theorem eqod_union_left : (eqod τ₁ τ₂ (s₁ ∪ s₂)) → (eqod τ₁ τ₂ s₁) :=
assume h v hv, h v (mem_union_left s₂ hv)

theorem eqod_union_right : (eqod τ₁ τ₂ (s₁ ∪ s₂)) → (eqod τ₁ τ₂ s₂) :=
assume h v hv, h v (mem_union_right s₁ hv)

end /- section -/

/-! # Evaluation with eqod -/

theorem eval_eq_of_eqod_of_var_mem : (eqod τ₁ τ₂ s) → l.var ∈ s → l.eval τ₁ = l.eval τ₂ :=
assume h₁ h₂, by { cases l, exact h₁ l h₂, exact congr_arg bnot (h₁ l h₂) }

-- We can extend eqod's by setting the truth value of a new variable
theorem exists_eqod_and_eq_of_not_mem [decidable_eq V] (τ₁ : assignment V) (b) :
  v ∉ s → ∃ τ₂, (eqod τ₁ τ₂ s) ∧ τ₂ v = b :=
begin
  intro hv,
  use (λ x, if x = v then b else τ₁ x),
  simp [eqod],
  intros x hx,
  simp [ne_of_mem_of_not_mem hx hv]
end

-- The domain can be extended by whole finsets, too
theorem exists_eqod_and_eq_of_disjoint [decidable_eq V] (f : V → bool) :
  disjoint s₁ s₂ → ∃ τ₂, (eqod τ₁ τ₂ s₁) ∧ (∀ v ∈ s₂, τ₂ v = f v) :=
begin
  intro h,
  use (λ x, if x ∈ s₂ then f x else τ₁ x),
  simp [eqod],
  split,
  { intros v hv,
    simp [disjoint_left.mp h hv] },
  { intros v hv₁ hv₂,
    contradiction }
end

end eqod

/-! # ite -/
section ite

variable [decidable_eq V]

-- When a variable is in the set, use the first assignment. Else, the second.
protected def ite (s : finset V) (τ₁ τ₂ : assignment V) : assignment V :=
  λ v, if v ∈ s then τ₁ v else τ₂ v

@[simp] theorem ite_nil : ∀ (τ₁ τ₂ : assignment V), (assignment.ite ∅ τ₁ τ₂) = τ₂ :=
by simp [assignment.ite]

theorem ite_pos {s : finset V} {v : V} : v ∈ s → ∀ (τ₁ τ₂), (assignment.ite s τ₁ τ₂) v = τ₁ v :=
assume h, by simp [assignment.ite, h]

theorem ite_neg {s : finset V} {v : V} : v ∉ s → ∀ (τ₁ τ₂), (assignment.ite s τ₁ τ₂) v = τ₂ v :=
assume h, by simp [assignment.ite, h]

theorem ite_pos_lit {s : finset V} {l : literal V} :
  l.var ∈ s → ∀ (τ₁ τ₂), l.eval (assignment.ite s τ₁ τ₂) = l.eval τ₁ :=
by { cases l,
     { simp [literal.var, literal.eval], exact ite_pos },
     { simp [literal.var, literal.eval], intros h _ _, rw ite_pos h } }

theorem ite_neg_lit {s : finset V} {l : literal V} :
  l.var ∉ s → ∀ (τ₁ τ₂), l.eval (assignment.ite s τ₁ τ₂) = l.eval τ₂ :=
by { cases l,
     { simp [literal.var, literal.eval], exact ite_neg },
     { simp [literal.var, literal.eval], intros h _ _, rw ite_neg h } }

theorem ite_eqod (s : finset V) (τ₁ τ₂ : assignment V) : eqod (assignment.ite s τ₁ τ₂) τ₁ s :=
assume v hv, ite_pos hv _ _

theorem ite_eqod_of_disjoint (τ₁ τ₂ : assignment V) {s₁ s₂ : finset V} :
  disjoint s₁ s₂ → (eqod τ₂ (assignment.ite s₁ τ₁ τ₂) s₂) :=
assume h v hv, by simp [assignment.ite, disjoint_right.mp h hv]

theorem ite_eqod_of_subset (τ₁ τ₂ : assignment V) {s₁ s₂ : finset V} :
  s₂ ⊆ s₁ → (eqod τ₁ (assignment.ite s₁ τ₁ τ₂) s₂) :=
assume h v hv, by simp [assignment.ite, h hv]

theorem ite_eq_second_of_eqod {τ₁ τ₂ : assignment V} {s : finset V} :
  (eqod τ₁ τ₂ s) → assignment.ite s τ₁ τ₂ = τ₂ :=
begin
  intro h,
  apply function.funext_iff.mpr,
  intro v,
  by_cases hv : v ∈ s,
  { rw ite_pos hv _ _, exact h v hv },
  { rw ite_neg hv _ _ }
end

end ite

/-! # Constant assignments -/

-- Constant function assignments
def all_tt : assignment V := (λ _, tt)
def all_ff : assignment V := (λ _, ff)

theorem all_tt_eval_tt : ∀ (v : V), all_tt v = tt := by simp [all_tt]
theorem all_ff_eval_ff : ∀ (v : V), all_ff v = ff := by simp [all_ff]

end assignment


/-
Copyright (c) 2021 Martin Zinkevich. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Martin Zinkevich
-/
import logic.encodable.lattice
import measure_theory.measurable_space_def

/-!
# Induction principles for measurable sets, related to π-systems and λ-systems.

## Main statements

* The main theorem of this file is Dynkin's π-λ theorem, which appears
  here as an induction principle `induction_on_inter`. Suppose `s` is a
  collection of subsets of `α` such that the intersection of two members
  of `s` belongs to `s` whenever it is nonempty. Let `m` be the σ-algebra
  generated by `s`. In order to check that a predicate `C` holds on every
  member of `m`, it suffices to check that `C` holds on the members of `s` and
  that `C` is preserved by complementation and *disjoint* countable
  unions.

* The proof of this theorem relies on the notion of `is_pi_system`, i.e., a collection of sets
  which is closed under binary non-empty intersections. Note that this is a small variation around
  the usual notion in the literature, which often requires that a π-system is non-empty, and closed
  also under disjoint intersections. This variation turns out to be convenient for the
  formalization.

* The proof of Dynkin's π-λ theorem also requires the notion of `dynkin_system`, i.e., a collection
  of sets which contains the empty set, is closed under complementation and under countable union
  of pairwise disjoint sets. The disjointness condition is the only difference with `σ`-algebras.

* `generate_pi_system g` gives the minimal π-system containing `g`.
  This can be considered a Galois insertion into both measurable spaces and sets.

* `generate_from_generate_pi_system_eq` proves that if you start from a collection of sets `g`,
  take the generated π-system, and then the generated σ-algebra, you get the same result as
  the σ-algebra generated from `g`. This is useful because there are connections between
  independent sets that are π-systems and the generated independent spaces.

* `mem_generate_pi_system_Union_elim` and `mem_generate_pi_system_Union_elim'` show that any
  element of the π-system generated from the union of a set of π-systems can be
  represented as the intersection of a finite number of elements from these sets.

## Implementation details

* `is_pi_system` is a predicate, not a type. Thus, we don't explicitly define the galois
  insertion, nor do we define a complete lattice. In theory, we could define a complete
  lattice and galois insertion on the subtype corresponding to `is_pi_system`.
-/

open measurable_space set
open_locale classical

/-- A π-system is a collection of subsets of `α` that is closed under binary intersection of
  non-disjoint sets. Usually it is also required that the collection is nonempty, but we don't do
  that here. -/
def is_pi_system {α} (C : set (set α)) : Prop :=
∀ s t ∈ C, (s ∩ t : set α).nonempty → s ∩ t ∈ C

namespace measurable_space

lemma is_pi_system_measurable_set {α:Type*} [measurable_space α] :
  is_pi_system {s : set α | measurable_set s} :=
λ s hs t ht _, hs.inter ht

end measurable_space

lemma is_pi_system.singleton {α} (S : set α) : is_pi_system ({S} : set (set α)) :=
begin
  intros s h_s t h_t h_ne,
  rw [set.mem_singleton_iff.1 h_s, set.mem_singleton_iff.1 h_t, set.inter_self,
      set.mem_singleton_iff],
end

section order

variables {α : Type*} {ι ι' : Sort*} [linear_order α]

lemma is_pi_system_image_Iio (s : set α) : is_pi_system (Iio '' s) :=
begin
  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ -,
  exact ⟨a ⊓ b, inf_ind a b ha hb, Iio_inter_Iio.symm⟩
end

lemma is_pi_system_Iio : is_pi_system (range Iio : set (set α)) :=
@image_univ α _ Iio ▸ is_pi_system_image_Iio univ

lemma is_pi_system_image_Ioi (s : set α) : is_pi_system (Ioi '' s) :=
@is_pi_system_image_Iio (order_dual α) _ s

lemma is_pi_system_Ioi : is_pi_system (range Ioi : set (set α)) :=
@image_univ α _ Ioi ▸ is_pi_system_image_Ioi univ

lemma is_pi_system_Ixx_mem {Ixx : α → α → set α} {p : α → α → Prop}
  (Hne : ∀ {a b}, (Ixx a b).nonempty → p a b)
  (Hi : ∀ {a₁ b₁ a₂ b₂}, Ixx a₁ b₁ ∩ Ixx a₂ b₂ = Ixx (max a₁ a₂) (min b₁ b₂)) (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (hlu : p l u), Ixx l u = S} :=
begin
  rintro _ ⟨l₁, hls₁, u₁, hut₁, hlu₁, rfl⟩ _ ⟨l₂, hls₂, u₂, hut₂, hlu₂, rfl⟩,
  simp only [Hi, ← sup_eq_max, ← inf_eq_min],
  exact λ H, ⟨l₁ ⊔ l₂, sup_ind l₁ l₂ hls₁ hls₂, u₁ ⊓ u₂, inf_ind u₁ u₂ hut₁ hut₂, Hne H, rfl⟩
end

lemma is_pi_system_Ixx {Ixx : α → α → set α} {p : α → α → Prop}
  (Hne : ∀ {a b}, (Ixx a b).nonempty → p a b)
  (Hi : ∀ {a₁ b₁ a₂ b₂}, Ixx a₁ b₁ ∩ Ixx a₂ b₂ = Ixx (max a₁ a₂) (min b₁ b₂))
  (f : ι → α) (g : ι' → α) :
  @is_pi_system α ({S | ∃ i j (h : p (f i) (g j)), Ixx (f i) (g j) = S}) :=
by simpa only [exists_range_iff] using is_pi_system_Ixx_mem @Hne @Hi (range f) (range g)

lemma is_pi_system_Ioo_mem (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (h : l < u), Ioo l u = S} :=
is_pi_system_Ixx_mem (λ a b ⟨x, hax, hxb⟩, hax.trans hxb) (λ _ _ _ _, Ioo_inter_Ioo) s t

lemma is_pi_system_Ioo (f : ι → α) (g : ι' → α) :
  @is_pi_system α {S | ∃ l u (h : f l < g u), Ioo (f l) (g u) = S} :=
is_pi_system_Ixx (λ a b ⟨x, hax, hxb⟩, hax.trans hxb) (λ _ _ _ _, Ioo_inter_Ioo) f g

lemma is_pi_system_Ioc_mem (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (h : l < u), Ioc l u = S} :=
is_pi_system_Ixx_mem (λ a b ⟨x, hax, hxb⟩, hax.trans_le hxb) (λ _ _ _ _, Ioc_inter_Ioc) s t

lemma is_pi_system_Ioc (f : ι → α) (g : ι' → α) :
  @is_pi_system α {S | ∃ i j (h : f i < g j), Ioc (f i) (g j) = S} :=
is_pi_system_Ixx (λ a b ⟨x, hax, hxb⟩, hax.trans_le hxb) (λ _ _ _ _, Ioc_inter_Ioc) f g

lemma is_pi_system_Ico_mem (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (h : l < u), Ico l u = S} :=
is_pi_system_Ixx_mem (λ a b ⟨x, hax, hxb⟩, hax.trans_lt hxb) (λ _ _ _ _, Ico_inter_Ico) s t

lemma is_pi_system_Ico (f : ι → α) (g : ι' → α) :
  @is_pi_system α {S | ∃ i j (h : f i < g j), Ico (f i) (g j) = S} :=
is_pi_system_Ixx (λ a b ⟨x, hax, hxb⟩, hax.trans_lt hxb) (λ _ _ _ _, Ico_inter_Ico) f g

lemma is_pi_system_Icc_mem (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (h : l ≤ u), Icc l u = S} :=
is_pi_system_Ixx_mem (λ a b, nonempty_Icc.1) (λ _ _ _ _, Icc_inter_Icc) s t

lemma is_pi_system_Icc (f : ι → α) (g : ι' → α) :
  @is_pi_system α {S | ∃ i j (h : f i ≤ g j), Icc (f i) (g j) = S} :=
is_pi_system_Ixx (λ a b, nonempty_Icc.1) (λ _ _ _ _, Icc_inter_Icc) f g

end order

/-- Given a collection `S` of subsets of `α`, then `generate_pi_system S` is the smallest
π-system containing `S`. -/
inductive generate_pi_system {α} (S : set (set α)) : set (set α)
| base {s : set α} (h_s : s ∈ S) : generate_pi_system s
| inter {s t : set α} (h_s : generate_pi_system s) (h_t : generate_pi_system t)
  (h_nonempty : (s ∩ t).nonempty) : generate_pi_system (s ∩ t)

lemma is_pi_system_generate_pi_system {α} (S : set (set α)) :
  is_pi_system (generate_pi_system S) :=
λ s h_s t h_t h_nonempty, generate_pi_system.inter h_s h_t h_nonempty

lemma subset_generate_pi_system_self {α} (S : set (set α)) : S ⊆ generate_pi_system S :=
λ s, generate_pi_system.base

lemma generate_pi_system_subset_self {α} {S : set (set α)} (h_S : is_pi_system S) :
  generate_pi_system S ⊆ S :=
begin
  intros x h,
  induction h with s h_s s u h_gen_s h_gen_u h_nonempty h_s h_u,
  { exact h_s, },
  { exact h_S _ h_s _ h_u h_nonempty, },
end

lemma generate_pi_system_eq {α} {S : set (set α)} (h_pi : is_pi_system S) :
  generate_pi_system S = S :=
set.subset.antisymm (generate_pi_system_subset_self h_pi) (subset_generate_pi_system_self S)

lemma generate_pi_system_mono {α} {S T : set (set α)} (hST : S ⊆ T) :
  generate_pi_system S ⊆ generate_pi_system T :=
begin
  intros t ht,
  induction ht with s h_s s u h_gen_s h_gen_u h_nonempty h_s h_u,
  { exact generate_pi_system.base (set.mem_of_subset_of_mem hST h_s),},
  { exact is_pi_system_generate_pi_system T _ h_s _ h_u h_nonempty, },
end

lemma generate_pi_system_measurable_set {α} [M : measurable_space α] {S : set (set α)}
  (h_meas_S : ∀ s ∈ S, measurable_set s) (t : set α)
  (h_in_pi : t ∈ generate_pi_system S) : measurable_set t :=
begin
  induction h_in_pi with s h_s s u h_gen_s h_gen_u h_nonempty h_s h_u,
  { apply h_meas_S _ h_s, },
  { apply measurable_set.inter h_s h_u, },
end

lemma generate_from_measurable_set_of_generate_pi_system {α} {g : set (set α)} (t : set α)
  (ht : t ∈ generate_pi_system g) :
  (generate_from g).measurable_set' t :=
@generate_pi_system_measurable_set α (generate_from g) g
  (λ s h_s_in_g, measurable_set_generate_from h_s_in_g) t ht

lemma generate_from_generate_pi_system_eq {α} {g : set (set α)} :
  generate_from (generate_pi_system g) = generate_from g :=
begin
  apply le_antisymm; apply generate_from_le,
  { exact λ t h_t, generate_from_measurable_set_of_generate_pi_system t h_t, },
  { exact λ t h_t, measurable_set_generate_from (generate_pi_system.base h_t), },
end

/- Every element of the π-system generated by the union of a family of π-systems
is a finite intersection of elements from the π-systems.
For an indexed union version, see `mem_generate_pi_system_Union_elim'`. -/
lemma mem_generate_pi_system_Union_elim {α β} {g : β → set (set α)}
  (h_pi : ∀ b, is_pi_system (g b)) (t : set α) (h_t : t ∈ generate_pi_system (⋃ b, g b)) :
  ∃ (T : finset β) (f : β → set α), (t = ⋂ b ∈ T, f b) ∧ (∀ b ∈ T, f b ∈ g b) :=
begin
  induction h_t with s h_s s t' h_gen_s h_gen_t' h_nonempty h_s h_t',
  { rcases h_s with ⟨t', ⟨⟨b, rfl⟩, h_s_in_t'⟩⟩,
    refine ⟨{b}, (λ _, s), _⟩,
    simpa using h_s_in_t', },
  { rcases h_t' with ⟨T_t', ⟨f_t', ⟨rfl, h_t'⟩⟩⟩,
    rcases h_s with ⟨T_s, ⟨f_s, ⟨rfl, h_s⟩ ⟩ ⟩,
    use [(T_s ∪ T_t'), (λ (b:β),
      if (b ∈ T_s) then (if (b ∈ T_t') then (f_s b ∩ (f_t' b)) else (f_s b))
      else (if (b ∈ T_t') then (f_t' b) else (∅ : set α)))],
    split,
    { ext a,
      simp_rw [set.mem_inter_iff, set.mem_Inter, finset.mem_union, or_imp_distrib],
      rw ← forall_and_distrib,
      split; intros h1 b; by_cases hbs : b ∈ T_s; by_cases hbt : b ∈ T_t'; specialize h1 b;
        simp only [hbs, hbt, if_true, if_false, true_implies_iff, and_self, false_implies_iff,
          and_true, true_and] at h1 ⊢,
      all_goals { exact h1, }, },
    intros b h_b,
    split_ifs with hbs hbt hbt,
    { refine h_pi b (f_s b) (h_s b hbs) (f_t' b) (h_t' b hbt) (set.nonempty.mono _ h_nonempty),
      exact set.inter_subset_inter (set.bInter_subset_of_mem hbs) (set.bInter_subset_of_mem hbt), },
    { exact h_s b hbs, },
    { exact h_t' b hbt, },
    { rw finset.mem_union at h_b,
      apply false.elim (h_b.elim hbs hbt), }, },
end

/- Every element of the π-system generated by an indexed union of a family of π-systems
is a finite intersection of elements from the π-systems.
For a total union version, see `mem_generate_pi_system_Union_elim`. -/
lemma mem_generate_pi_system_Union_elim' {α β} {g : β → set (set α)} {s: set β}
  (h_pi : ∀ b ∈ s, is_pi_system (g b)) (t : set α) (h_t : t ∈ generate_pi_system (⋃ b ∈ s, g b)) :
  ∃ (T : finset β) (f : β → set α), (↑T ⊆ s) ∧ (t = ⋂ b ∈ T, f b) ∧ (∀ b ∈ T, f b ∈ g b) :=
begin
  have : t ∈ generate_pi_system (⋃ (b : subtype s), (g ∘ subtype.val) b),
  { suffices h1 : (⋃ (b : subtype s), (g ∘ subtype.val) b) = (⋃ b (H : b ∈ s), g b), by rwa h1,
    ext x,
    simp only [exists_prop, set.mem_Union, function.comp_app, subtype.exists, subtype.coe_mk],
    refl },
  rcases @mem_generate_pi_system_Union_elim α (subtype s) (g ∘ subtype.val)
    (λ b, h_pi b.val b.property) t this with ⟨T, ⟨f,⟨ rfl, h_t'⟩⟩⟩,
  refine ⟨T.image subtype.val, function.extend subtype.val f (λ (b:β), (∅ : set α)), by simp, _, _⟩,
  { ext a, split;
    { simp only [set.mem_Inter, subtype.forall, finset.set_bInter_finset_image],
      intros h1 b h_b h_b_in_T,
      have h2 := h1 b h_b h_b_in_T,
      revert h2,
      rw function.extend_apply subtype.val_injective,
      apply id } },
  { intros b h_b,
    simp_rw [finset.mem_image, exists_prop, subtype.exists,
             exists_and_distrib_right, exists_eq_right] at h_b,
    cases h_b,
    have h_b_alt : b = (subtype.mk b h_b_w).val := rfl,
    rw [h_b_alt, function.extend_apply subtype.val_injective],
    apply h_t',
    apply h_b_h },
end

namespace measurable_space
variable {α : Type*}

/-- A Dynkin system is a collection of subsets of a type `α` that contains the empty set,
  is closed under complementation and under countable union of pairwise disjoint sets.
  The disjointness condition is the only difference with `σ`-algebras.

  The main purpose of Dynkin systems is to provide a powerful induction rule for σ-algebras
  generated by a collection of sets which is stable under intersection.

  A Dynkin system is also known as a "λ-system" or a "d-system".
-/
structure dynkin_system (α : Type*) :=
(has : set α → Prop)
(has_empty : has ∅)
(has_compl : ∀ {a}, has a → has aᶜ)
(has_Union_nat : ∀ {f : ℕ → set α}, pairwise (disjoint on f) → (∀ i, has (f i)) → has (⋃ i, f i))

namespace dynkin_system

@[ext] lemma ext : ∀ {d₁ d₂ : dynkin_system α}, (∀ s : set α, d₁.has s ↔ d₂.has s) → d₁ = d₂
| ⟨s₁, _, _, _⟩ ⟨s₂, _, _, _⟩ h := have s₁ = s₂, from funext $ assume x, propext $ h x,
  by subst this

variable (d : dynkin_system α)

lemma has_compl_iff {a} : d.has aᶜ ↔ d.has a :=
⟨λ h, by simpa using d.has_compl h, λ h, d.has_compl h⟩

lemma has_univ : d.has univ :=
by simpa using d.has_compl d.has_empty

theorem has_Union {β} [encodable β] {f : β → set α}
  (hd : pairwise (disjoint on f)) (h : ∀ i, d.has (f i)) : d.has (⋃ i, f i) :=
by { rw ← encodable.Union_decode₂, exact
  d.has_Union_nat (encodable.Union_decode₂_disjoint_on hd)
    (λ n, encodable.Union_decode₂_cases d.has_empty h) }

theorem has_union {s₁ s₂ : set α}
  (h₁ : d.has s₁) (h₂ : d.has s₂) (h : s₁ ∩ s₂ ⊆ ∅) : d.has (s₁ ∪ s₂) :=
by { rw union_eq_Union, exact
  d.has_Union (pairwise_disjoint_on_bool.2 h) (bool.forall_bool.2 ⟨h₂, h₁⟩) }

lemma has_diff {s₁ s₂ : set α} (h₁ : d.has s₁) (h₂ : d.has s₂) (h : s₂ ⊆ s₁) : d.has (s₁ \ s₂) :=
begin
  apply d.has_compl_iff.1,
  simp [diff_eq, compl_inter],
  exact d.has_union (d.has_compl h₁) h₂ (λ x ⟨h₁, h₂⟩, h₁ (h h₂)),
end

instance : has_le (dynkin_system α) :=
{ le          := λ m₁ m₂, m₁.has ≤ m₂.has }

lemma le_def {α} {a b : dynkin_system α} : a ≤ b ↔ a.has ≤ b.has := iff.rfl

instance : partial_order (dynkin_system α) :=
{ le_refl     := assume a b, le_rfl,
  le_trans    := assume a b c hab hbc, le_def.mpr (le_trans hab hbc),
  le_antisymm := assume a b h₁ h₂, ext $ assume s, ⟨h₁ s, h₂ s⟩,
  ..dynkin_system.has_le }

/-- Every measurable space (σ-algebra) forms a Dynkin system -/
def of_measurable_space (m : measurable_space α) : dynkin_system α :=
{ has       := m.measurable_set',
  has_empty := m.measurable_set_empty,
  has_compl := m.measurable_set_compl,
  has_Union_nat := assume f _ hf, m.measurable_set_Union f hf }

lemma of_measurable_space_le_of_measurable_space_iff {m₁ m₂ : measurable_space α} :
  of_measurable_space m₁ ≤ of_measurable_space m₂ ↔ m₁ ≤ m₂ :=
iff.rfl

/-- The least Dynkin system containing a collection of basic sets.
  This inductive type gives the underlying collection of sets. -/
inductive generate_has (s : set (set α)) : set α → Prop
| basic : ∀ t ∈ s, generate_has t
| empty : generate_has ∅
| compl : ∀ {a}, generate_has a → generate_has aᶜ
| Union : ∀ {f : ℕ → set α}, pairwise (disjoint on f) →
    (∀ i, generate_has (f i)) → generate_has (⋃ i, f i)

lemma generate_has_compl {C : set (set α)} {s : set α} : generate_has C sᶜ ↔ generate_has C s :=
by { refine ⟨_, generate_has.compl⟩, intro h, convert generate_has.compl h, simp }

/-- The least Dynkin system containing a collection of basic sets. -/
def generate (s : set (set α)) : dynkin_system α :=
{ has := generate_has s,
  has_empty := generate_has.empty,
  has_compl := assume a, generate_has.compl,
  has_Union_nat := assume f, generate_has.Union }

lemma generate_has_def {C : set (set α)} : (generate C).has = generate_has C := rfl

instance : inhabited (dynkin_system α) := ⟨generate univ⟩

/-- If a Dynkin system is closed under binary intersection, then it forms a `σ`-algebra. -/
def to_measurable_space (h_inter : ∀ s₁ s₂, d.has s₁ → d.has s₂ → d.has (s₁ ∩ s₂)) :=
{ measurable_space .
  measurable_set'      := d.has,
  measurable_set_empty := d.has_empty,
  measurable_set_compl := assume s h, d.has_compl h,
  measurable_set_Union := λ f hf,
    begin
      rw ←Union_disjointed,
      exact d.has_Union (disjoint_disjointed _)
        (λ n, disjointed_rec (λ t i h, h_inter _ _ h $ d.has_compl $ hf i) (hf n)),
    end }

lemma of_measurable_space_to_measurable_space
  (h_inter : ∀ s₁ s₂, d.has s₁ → d.has s₂ → d.has (s₁ ∩ s₂)) :
  of_measurable_space (d.to_measurable_space h_inter) = d :=
ext $ assume s, iff.rfl

/-- If `s` is in a Dynkin system `d`, we can form the new Dynkin system `{s ∩ t | t ∈ d}`. -/
def restrict_on {s : set α} (h : d.has s) : dynkin_system α :=
{ has       := λ t, d.has (t ∩ s),
  has_empty := by simp [d.has_empty],
  has_compl := assume t hts,
    have tᶜ ∩ s = ((t ∩ s)ᶜ) \ sᶜ,
      from set.ext $ assume x, by { by_cases x ∈ s; simp [h] },
    by { rw [this], exact d.has_diff (d.has_compl hts) (d.has_compl h)
      (compl_subset_compl.mpr $ inter_subset_right _ _) },
  has_Union_nat := assume f hd hf,
    begin
      rw [inter_comm, inter_Union],
      apply d.has_Union_nat,
      { exact λ i j h x ⟨⟨_, h₁⟩, _, h₂⟩, hd i j h ⟨h₁, h₂⟩ },
      { simpa [inter_comm] using hf },
    end }

lemma generate_le {s : set (set α)} (h : ∀ t ∈ s, d.has t) : generate s ≤ d :=
λ t ht, ht.rec_on h d.has_empty
  (assume a _ h, d.has_compl h)
  (assume f hd _ hf, d.has_Union hd hf)

lemma generate_has_subset_generate_measurable {C : set (set α)} {s : set α}
  (hs : (generate C).has s) : (generate_from C).measurable_set' s :=
generate_le (of_measurable_space (generate_from C)) (λ t, measurable_set_generate_from) s hs

lemma generate_inter {s : set (set α)}
  (hs : is_pi_system s) {t₁ t₂ : set α}
  (ht₁ : (generate s).has t₁) (ht₂ : (generate s).has t₂) : (generate s).has (t₁ ∩ t₂) :=
have generate s ≤ (generate s).restrict_on ht₂,
  from generate_le _ $ assume s₁ hs₁,
  have (generate s).has s₁, from generate_has.basic s₁ hs₁,
  have generate s ≤ (generate s).restrict_on this,
    from generate_le _ $ assume s₂ hs₂,
      show (generate s).has (s₂ ∩ s₁), from
        (s₂ ∩ s₁).eq_empty_or_nonempty.elim
        (λ h,  h.symm ▸ generate_has.empty)
        (λ h, generate_has.basic _ $ hs _ hs₂ _ hs₁ h),
  have (generate s).has (t₂ ∩ s₁), from this _ ht₂,
  show (generate s).has (s₁ ∩ t₂), by rwa [inter_comm],
this _ ht₁

/--
  **Dynkin's π-λ theorem**:
  Given a collection of sets closed under binary intersections, then the Dynkin system it
  generates is equal to the σ-algebra it generates.
  This result is known as the π-λ theorem.
  A collection of sets closed under binary intersection is called a π-system (often requiring
  additionnally that is is non-empty, but we drop this condition in the formalization).
-/
lemma generate_from_eq {s : set (set α)} (hs : is_pi_system s) :
  generate_from s = (generate s).to_measurable_space (λ t₁ t₂, generate_inter hs) :=
le_antisymm
  (generate_from_le $ assume t ht, generate_has.basic t ht)
  (of_measurable_space_le_of_measurable_space_iff.mp $
    by { rw [of_measurable_space_to_measurable_space],
    exact (generate_le _ $ assume t ht, measurable_set_generate_from ht) })

end dynkin_system

theorem induction_on_inter {C : set α → Prop} {s : set (set α)} [m : measurable_space α]
  (h_eq : m = generate_from s) (h_inter : is_pi_system s)
  (h_empty : C ∅) (h_basic : ∀ t ∈ s, C t) (h_compl : ∀ t, measurable_set t → C t → C tᶜ)
  (h_union : ∀ f : ℕ → set α, pairwise (disjoint on f) →
    (∀ i, measurable_set (f i)) → (∀ i, C (f i)) → C (⋃ i, f i)) :
  ∀ ⦃t⦄, measurable_set t → C t :=
have eq : measurable_set = dynkin_system.generate_has s,
  by { rw [h_eq, dynkin_system.generate_from_eq h_inter], refl },
assume t ht,
have dynkin_system.generate_has s t, by rwa [eq] at ht,
this.rec_on h_basic h_empty
  (assume t ht, h_compl t $ by { rw [eq], exact ht })
  (assume f hf ht, h_union f hf $ assume i, by { rw [eq], exact ht _ })

end measurable_space


import data.finset algebra.big_operators tactic.ring

namespace maths_challenges

-- the n'th odd number (we start counting at zero)
def odd (n : ℕ) := 2 * n + 1

-- finset.range n is the finite set {0,1,2,...,n-1}
theorem challenge05 (n : ℕ) : (finset.range n).sum (odd) = n ^ 2 :=
begin
  sorry
end

end maths_challenges


import .myRing
import .set_1
import tactic.basic
import init.default
import logic.basic
-- import data.list
-- import tactic
open myRing
variables {R : Type} [myRing R]
variables {O : Type} [ordered_ring O ]
variables {ZZ : Type} [Integers ZZ ]
theorem sub_both_lt: ∀(a b x: O), ((a -x <  b-x)) ↔ ( a < b):=
begin
intros a b x,
rw subtr,
rw subtr,
exact add_lt_add (a) (b) (-x),
end
theorem WOP_Contradiction:
  ∀ (proposition: ZZ → Prop),
  ( ∀(minimal: ZZ), ∃(smaller: ZZ),
  (¬proposition(minimal))∧ (is_positive minimal)  → ¬proposition(smaller)
  ∧ smaller < minimal ) → (∀ (x : ZZ),
  proposition(x))
  := begin
  intros prop holds_for_smaller all,
  by_contradiction,
  have  wop := WOP (λ x, ¬ prop(x)),
  have wopsome: ∃ (some : ZZ), (λ (x : ZZ), ¬prop x) some := begin
  use all,
  end,
  have wop_holds := wop wopsome,
  rcases wop_holds with ⟨ minimal,not_prop_minimal,positive_minimal,others_smaller⟩,
  -- cases wop_holds with minimal rest,
  -- cases rest with nminimal other,

  have smaller := holds_for_smaller minimal,
  rcases smaller with ⟨ smaller,smaller_eq⟩ ,
  -- cases smaller with smaller smallereq,

  -- cases smallereq with a _,
  have contra := smaller_eq ⟨ not_prop_minimal, positive_minimal ⟩ ,
  cases contra with not_smaller smaller_lt_minimal,
  -- cases smallereq with _ smaller_lt_minimal,
  have min_le_smaller := others_smaller smaller not_smaller,
  rw less_eq at min_le_smaller,
  cases min_le_smaller, {
    have tr := trans_lt smaller_lt_minimal min_le_smaller,
    apply no_lt_self smaller,
    exact tr,
  },
  rw min_le_smaller at smaller_lt_minimal,
      apply no_lt_self smaller,
exact smaller_lt_minimal,
end
theorem not_le_ge: ∀{a b : O}, (¬ (a < b)) ↔ ( b ≤ a):=
begin
  intros a b,
  split,
  {
    intro ab,
    cases trichotomy_lt a b,
    {
      exfalso,
      apply ab,
      exact h.1,
    },
    cases h,
    {
      rw h.2.1,
      rw less_eq,
      right,
      refl,
    },
    {
      rw less_eq,
      left,
      exact h.2.2,
    }
  },
  {
    intros ba h,
    --rw less_than at h,
    rw less_eq at ba,
    cases ba,
    {
      have := trans_lt h ba,
      apply no_lt_self a,
      exact this,
    },
    {
      rw
      ba at h,
      apply no_lt_self a,
      exact h,
    },
  }
end
theorem pos_is_g0: ∀ (x:O), is_positive x ↔ 0< x := begin
intros a,
split, {
intros pa,
rw less_than,
split,{
split, {
exact pa,
},
rw zero_add,
},
},
intros la,
rw less_than at la,
cases la, {
cases la_h, {
rw zero_add at la_h_right,
rw  la_h_right at la_h_left,
exact la_h_left,
},
},
end
theorem zlt1: (0:ZZ) < (1:ZZ) := begin
rw less_than,
-- left,
-- rw less_than,
use 1,
split,
exact one_pos,
rw zero_add,
end

theorem ge1pos: ∀ (x:ZZ), 1 ≤ x → is_positive x := begin
intros x olex,
rw pos_is_g0,
rw less_eq at olex,
cases olex,{
have g : (0:ZZ) < 1, {
  exact zlt1,
},
have := trans_lt g olex,
exact this,
},
rw ← olex,
exact zlt1,
end

theorem gcd_pos: ∀ (a b : ZZ), is_positive (gcd a b) := begin
intros a b,
let d :ZZ := gcd a b,
-- rw d,
have := gcd_def a b d ,
have thing : gcd a b =d := begin
refl,
end,
rw this at thing,
rcases thing with ⟨diva,divb, biggest⟩,
have big : 1 ≤ d := begin
have biggerthan1:= biggest 1,
have divboth: 1 ∣ a ∧ 1 ∣ b, {
exact ⟨ div_one a,div_one b⟩
},
have bruh := biggerthan1 divboth,
exact bruh,
end,
have thing2 : gcd a b =d := begin
refl,
end,
rw thing2,
exact ge1pos d big,
end

theorem Euclidean_Algorithm_Exists: ∀ (a b: ZZ), ∃ (q r :ZZ), a=b*q+r := begin
intros a b,
split, {
  split, {
    have : a = b*0 + a := begin
    rw mul_zero,
    rw zero_add,
    end,
    exact this,
  },
},
end

def nibzo : ZZ → Prop := λ x, 0<x ∧ x < 1

theorem squares_pos: ∀ (a: O), 0 <a → 0 < a*a := begin
intros a ag0,
rw less_than at ag0,
cases ag0 with p pos,
cases pos with ppos pea,
rw less_than,
have pspos := pos_times_pos ppos ppos,

split, {
split, {
exact pspos,
},
rw zero_add,
rw zero_add at pea,
rw pea,
},

end

theorem NIBZO: ¬ (∃ (x:ZZ), nibzo(x)) := begin
  -- apply WOP to NIBZO
  have wop_on_nibzo := explicit_WOP  nibzo , {
   --Proof by contradiction, assume NIBZO doesn't hold
  intros contradict,
  -- then there exists a minimum element on which NIBZO doesn't hold
  have has_min := wop_on_nibzo contradict,
  -- call the minimum element min
  cases has_min with  min others,
  -- we have that min satisfies ¬nibzo
  have x : 0 < min ∧ min < 1,{
    cases others with nibzo_min,
    change (0 < min ∧ min < 1) at nibzo_min,
    exact nibzo_min,
  },
  cases x with x1 x2,
  -- since  0 < min, then 0 < min*min
  have x : 0 < min*min := begin
    exact squares_pos min x1,
  end,
  -- since 0 < min*min, then min*min is positive
  have minpos: is_positive min := begin
    rw ← pos_is_g0 at x1,
    exact x1,
  end,
  -- since min < 1, then min ≤ 1
  have xle1 : min ≤ 1 := begin
    rw less_eq,
    left,
    exact x2,
  end,
  -- since min < 1, then min*min < 1
  have minmin_lt_1 :  min*min < 1 := begin
    have mmin_le_1 :=  mul_lt_mul (minpos) (minpos) (x2) (x2) ,
    rw mul_one at mmin_le_1,
    exact mmin_le_1,
  end,
  -- since min < 1, then min*min < min
  have smaller: min*min < min := begin
    have minthing := mul_le min 1 min minpos x2 ,
    simp at minthing,
    exact minthing,
  end,
  cases others,
  -- min*min satisfies nibzo
  have nibzominmin : nibzo (min*min) := begin
    change (0 < min*min ∧ min*min < 1),
    split, {
      exact x,
    },
    exact minmin_lt_1
  end,
  cases others_right with others_left others_right,
  -- finally, this is a contradiction because we assumed min was the smallest element
  have min_le_minmin := others_right (min*min) nibzominmin,
  rw less_eq at min_le_minmin,
  cases min_le_minmin, {
    have less_self := trans_lt min_le_minmin smaller,
    apply no_lt_self min,
    exact less_self,
  },
  rw ←  min_le_minmin at smaller,
  apply no_lt_self min,
  exact smaller,
  },
end
theorem posge1: ∀ (x:ZZ),  is_positive x → 1 ≤ x := begin
intros x posx,
-- rw less_eq,
have :=pos_is_g0 x,
cases this,
have := this_mp posx,
by_contradiction,
have t: x < 1 := begin
rw ←  not_le_ge at h,
push_neg at h,
exact h,
end,
-- apply NIBZO,
have nib := NIBZO,
apply nib,
use x,

split,{
  exact this,
-- sorry,
},
exact t,
-- sorry,
-- have := not_le_ge,
-- have := ne_ge
-- sorry,
-- sorry,
end

theorem pos_iff_le_one: ∀(a :ZZ), is_positive a ↔ 1 ≤ a := begin
intro a,
split,{
intro pa,
rw less_eq,
have := pos_is_g0 a,
 have z_le_a : 0 < a,{
   rw less_than,
   use a,
   rw zero_add,
   split,
   exact pa,
   refl,
 },
 have nibzo := NIBZO,
 have trich := trichotomy_lt a 1,
 rcases trich with ⟨one,two,three⟩, {
   exfalso,
   apply nibzo,
   use a,
   change (0<a ∧ a < 1),
   split,
   exact z_le_a,
   exact one,
 },
 rcases trich with ⟨one,two,three⟩, {
   right,
   symmetry,
   exact two,
 },
 rcases trich with ⟨one,two,three⟩, {
   left,
   exact three,
 },
},
intro a_le_one,
rw less_eq at a_le_one,
-- rw
cases a_le_one with l r,{
rw less_than at l,
rcases l with ⟨g,h,j⟩ ,
have pp := pos_plus_pos one_pos h,
rw ← j,
exact pp,
},
rw ← r,
exact one_pos,
end

theorem divs_le: ∀ (a b: ZZ ), is_positive a  → is_positive b → a ∣ b → a ≤ b := begin
  intros a b a_pos b_pos a_div_b,
  rw divs at a_div_b,
  cases a_div_b with p eq,{
 have p_pos  := pos_div_pos a b p a_pos b_pos eq,

  have eq : p*(a-1) +p = b,{
    rw subtr,
    rw mul_add ,
    rw mul_comm p (-1),
    rw mul_neg_one,
    rw add_assoc,
    rw add_comm (-p) (p),
    rw add_neg,
    rw add_zero,
    rw mul_comm,
    exact eq,
  },
have := pos_is_g0 a,
-- rw this at a_pos,
have g := posge1 a a_pos,
rw less_eq at g,
cases g, {
  rw less_than at g,

  cases g,{
rw less_eq,
left,
rw less_than,

-- use p,

sorry,
  },

-- sorry,
},

    sorry,
  },

end
theorem le_le_eq: ∀( a b: O), a ≤ b → b ≤ a → a = b := begin
  intros d min d_le_min min_le_d,
  rw less_eq at d_le_min,
    rw less_eq at  min_le_d,
    cases d_le_min, {
      cases min_le_d, {
        have tr := trans_lt d_le_min min_le_d,
        exfalso,
        apply no_lt_self d,
        exact tr,
      },
      rw ← min_le_d at d_le_min,
       exfalso,
        apply no_lt_self min,
        exact d_le_min,
    },
    exact d_le_min,
end
theorem push_not_exists: ∀{x : Type}, ∀{p: x→ Prop}, (¬ (∃(q : x), p(q))) ↔ (∀ (q : x), ¬ p(q)):=
begin
  intros x p,
  split,
  {
    intros h q pq,
    apply h,
    split,
    exact pq,
  },
  {
    intros h pq,
    cases pq with q pq,
    apply h q,
    exact pq,
  }
end
theorem push_and: ∀{p q : Prop}, (¬ (p ∧ q)) ↔ (¬ p ∨ ¬ q):=
begin
  intros p q,
  split,
  {
    intro hpq,
    by_cases q,
    {
      left,
      intro j,
      apply hpq,
      exact ⟨j, h⟩,
    },
    {
      right,
      exact h,
    }
  },
  {
    intro pq,
    intro paq,
    cases pq,
    apply pq,
    exact paq.1,
    apply pq,
    exact paq.2,
  }
end

lemma refl_le : ∀(a: O), a ≤ a :=
begin
  intro a,
  rw less_eq,
  right,
  refl,
end

theorem min_1_lt_self: ∀ (x: O), x-1 < x := begin
intro x,
rw less_than,
use 1,
split,
exact one_pos,
rw subtr,
rw add_assoc,
rw add_comm (-1:O),
rw add_neg,
rw add_zero,
end
theorem sub_both_le: ∀(a b x: O), ((a ≤  b)) ↔ ( a-x ≤ b-x):=
begin
  intros a b x,
  split,
  {
    intro ab,
    have := add_le_add ab (refl_le (-x)),
    rw subtr,
    rw subtr,
    exact this,
  },
  {
    intro axb,
    have := add_le_add axb (refl_le x),
    rw subtr at this,
    rw subtr at this,
    rw add_assoc at this,
    rw add_assoc at this,
    rw add_comm (-x) at this,
    rw add_neg at this,
    rw add_zero at this,
    rw add_zero at this,
    exact this,
  }
end
theorem dist_neg_add: ∀(a b: O), -(a+b)  = -a + -b:=
begin
intros a b,
rw ← mul_neg_one (a+b),
rw mul_add,
rw mul_neg_one,
rw mul_neg_one,
end

@[simp]
theorem lt_cancel: ∀(a b c: O), c+a < c+b ↔ a < b:=
begin
  intros a b c,
  split,
  {
    intro h,
    rw less_than at h,
    cases h with P q,
    cases q with Ppos s,
    rw add_assoc at s,
    have := left_cancel s,
    rw less_than,
    split,
    split,
    exact Ppos,
    exact this,
  },
  {
    intro ab,
    rw less_than at ab,
    cases ab with P,
    cases ab_h with Ppos h,
    rw less_than,
    split, split,
    exact Ppos,
    rw ← h,
    rw add_assoc,
  }
end
@[simp]
theorem neg_comp: ∀(a b: O), -a < -b ↔ b < a:=
begin
intros a b,
split, {
intros na_le_nb,
rw less_than at na_le_nb,
cases na_le_nb with p na_le_nb,
cases na_le_nb with p_pos na_le_nb,
rw add_comm at na_le_nb,
have move := move na_le_nb,
rw less_than,
use p,
split,{
  exact p_pos,
},
rw move,
rw ←  add_assoc,
rw add_neg,
rw zero_add,
rw neg_neg_a,
},
intros b_lt_a,
rw less_than at b_lt_a,
rcases b_lt_a with ⟨w,x,y,z⟩,
rw less_than,
use w,
split,
exact x,
rw dist_neg_add,
rw add_assoc,
rw add_comm (-w) w,
rw add_neg,
rw add_zero,
end
theorem demorgan: ∀(p q :Prop), ¬(p ∨ q ) → (¬ p ∧ ¬ q) := begin
intros p q n_p_or_q,
split, {

by_contradiction,
apply n_p_or_q,
left,
exact h,
},
by_contradiction,
apply n_p_or_q,
right,
exact h,
end
theorem not_le_iff_ge: ∀(a b: O), a < b ↔ ¬ (b ≤  a):=
begin
intros a b,
split, {
  intros a_le_b,
  by_contradiction,
  rw less_eq at h,
  cases h, {
    have tr := trans_lt a_le_b h,
    apply no_lt_self a,
    exact tr,
  },
  rw h at a_le_b,
   apply no_lt_self a,
    exact a_le_b,
},
intro n_b_le_a,
rw less_eq at n_b_le_a,
have dm := demorgan (b<a) (b=a) n_b_le_a,
cases dm with n_b_le_a n_b_eq_a,
-- rw demorgan at n_b_le_a,
have trich := trichotomy_lt a b,
rcases trich with ⟨s,d,f⟩, {
exact s,
},
rcases trich with ⟨s,d,f⟩, {
exfalso,
apply  n_b_eq_a,
symmetry,
exact d,
},
rcases trich with ⟨s,d,f⟩, {
  exfalso,
  apply n_b_le_a,
  exact f,
},
end

theorem Euclidean_Algorithm_One_Step_two: ∀ (a b: ZZ),  is_positive a → is_positive b → ∃ (q r :ZZ), a=b*q+r ∧ r < b ∧ 0 ≤ r :=
begin
  --introduce variable a b,
  intros a b a_pos b_pos,
  -- defined the set
  let WOP_prop : ZZ → Prop := λ s, ∃ (q : ZZ), s = a-b*q ∧  0 ≤ a-b*q,
  -- perform WOP on the set
  have WOP := explicit_WOP WOP_prop,
  -- WOP holds on a
  have a_WOP_Prop : WOP_prop a := begin
  change (∃ (q : ZZ), a = a-b*q ∧ 0 ≤  a-b*q),
  split, {
    split, {
        have zero_work :a = a - b * 0 := begin
        rw mul_zero,
        rw sub_zero,
        end,
        exact zero_work,
    },
  rw mul_zero,
  rw sub_zero,
  -- 0 < a
  have a_ge_0 : 0 < a := begin
    have a_pos_iff := pos_is_g0 a,
    cases a_pos_iff with forward backward,
    exact forward a_pos,
  end,
  rw less_eq,
  left,
  exact a_ge_0
  },
end,
-- there exists an integer for which the proposition holds
have WOP_some :  (∃ (some : ZZ), WOP_prop some) := begin
split,{
exact a_WOP_Prop,
},
end,
-- the set has a minimal element
have WOP_min := WOP WOP_some,
-- call the minimal element min
cases WOP_min with min min_smallest,
cases min_smallest with WOP_Prop_min min_smaller_other,
change  (∃ (q : ZZ), min = a-b*q ∧ 0 ≤  a-b*q) at WOP_Prop_min,
cases WOP_Prop_min with q q_eq,
cases q_eq with q_eq q_small,
split, {
split, {
split, {
  have thing :a = b * q + min := begin
  rw q_eq,
  rw subtr,
  rw ← add_assoc,
rw add_comm,
rw ←  add_assoc,
rw add_comm (-(b * q)) ((b * q)),
rw add_neg,
rw zero_add,
  end,
  exact thing,
},
-- proof by contradiction, assum min ≥ b
by_contradiction contradict,
rw push_and at contradict,
cases contradict,{
rw not_le_ge at contradict,
rw sub_both_le (b) (min) (b) at contradict,
simp at contradict,
-- 0 ≤ a  - b *  (q +1)
have smallerthing : 0 ≤ a  - b *  (q +1) := begin
rw subtr,
rw mul_add,
rw mul_one,
rw dist_neg_add,
rw ← add_assoc,
rw ← subtr,
rw ← subtr,
rw ←  q_eq,
exact contradict,
end,
-- 0 ≤ a  - b *  (q +1) ∈ S
have prop_smaller: WOP_prop (a  - b *  (q +1)) := begin
change  (∃ (x : ZZ), a  - b *  (q +1) = a-b*x ∧ 0 ≤  a-b*x),

split, {
split, {
  have reflx : a - b * (q + 1) = a - b * (q+1), {
refl,
  },
  exact reflx,
},
exact smallerthing,
},
end,
-- a - b * (q + 1) < a-b*q
 have even_smaller :  a - b * (q + 1) < a-b*q := begin
rw subtr,
rw subtr,
rw mul_add,
rw dist_neg_add,
rw lt_cancel,
rw ← add_zero (-(b * q)),
rw  add_assoc,
rw lt_cancel,
rw zero_add,
rw mul_one,
have b_posit : 0 < b, {
  rw ← pos_is_g0 b,
  exact b_pos,
},
rw  ← neg_zero,
rw neg_comp,
exact b_posit,
 end,
 cases min_smaller_other with x min_smaller_other,
 have min_contra := min_smaller_other (a - b * (q + 1)),
 have app_min  := min_contra prop_smaller,
 rw q_eq at app_min,
  have contra_candidate : ¬ (a - b * q ≤ a - b * (q + 1) ), {
    rw ←  not_le_iff_ge,
    exact even_smaller,
  },
  apply contra_candidate,
  exact app_min,
},
cases min_smaller_other with min_pos garbage,
have thing := pos_is_g0 min,
rw thing at min_pos,
apply contradict,
rw less_eq,
left,
exact min_pos

-- sorry,

},

},
-- exact q,
end
/-

Fix $a$ and $b$.
Consider the set
$$S= \{ax+by \mid ax+by \ge 0, x,y \in \ZZ \}.$$
$S$ is non-empty because $a \in S$.
All elements  of $S$ are positive by construction. This means $S$ has a minimal element, call it $m$ by WOP.  By the construction of $m$, let
$$m=ax'+by'$$
for some integers $x',y'$.
By lemma \ref{l:ES}, there exists integers
$q,r$ such that $a=mq+r$ and $0 \le r < m$.
Since $r < m$ and $m$ is the minimal element
of $S$, it follows that $r \not\in S$.
By algebraic manipulation, we have
$$r=a-mq=a-(ax'+by')q=a-ax'-by'q = a(1-x')+b(-y'a).$$

We find that $r$ is expressible as $ax+by$ (with $x=1-x'$ and $y=-y'a$), so the only
way that $r\not\in S$ is that $r \le 0$.
By construction, we know $r \ge 0$, so this
means $r=0$. This gives us that
$0=a-mq \implies a=mq$, which gives that
$m \mid a$ by Definition \ref{def:divs}.
By similar reasoning, we can deduce $m \mid b$.
Let $d=gcd(a,b)$.
% Since
% $m \mid a$ and $m \mid b$, therefore $m \mid d$ by Theorem \ref{thm:divsgcd}.
 By the definition of GCD,
we have $d \mid a$ and $d \mid b$. This means
by Theorem \ref{thm:lincombdivs} that $d \mid (ax'+by')$. But $ax'+by'=m$, so $d\mid m$.
% By Theorem \ref{thm:divsequal},
By Lemma \ref{lem:div_lt}, we have $d \le m$.
But $m$ is a common divisor of both
$a$ and $b$, so by Definition \ref{def:gcd}, $d \ge m$.
The only possibility is that $d=m$.
We have $m=d$.
This means that there exists $x,y$ such that
$ax+by = gcd(a,b)$, and in addition, $gcd(a,b)$
is the smallest positive combination of $a,b$.

-/
theorem BezoutsLemma: ∀ (a b : ZZ), is_positive a → is_positive b → ∃ (x y : ZZ), a*x+b*y = gcd a b := begin
intros a b a_positive b_positive,
  let WOP_prop : ZZ → Prop := λ s, ∃ (x y : ZZ), a*x + b*y = s ∧ is_positive s,
  have WOP := explicit_WOP WOP_prop,
  have WOP_a :  WOP_prop a, {
    change (∃ (x y : ZZ), a*x + b*y = a ∧ is_positive a),
    split, {
      split, {
        have a_works: a * 1 + b * 0 = a , {
          simp,
          rw mul_one,
          rw add_zero,
        },
        split,
        exact a_works,
        exact a_positive,
      },
    },
  },
  have Wop_Some: ∃(some: ZZ), WOP_prop some, {
    split, {
      exact WOP_a
    },
  },
  have WOP_exists := WOP Wop_Some,
  cases WOP_exists with min min_smallest,
  cases min_smallest with WOP_Min others_smaller,
  change (∃ (x' y' : ZZ), a*x' + b*y' = min ∧ is_positive min) at WOP_Min,
  cases WOP_Min with x' rest,
    cases rest with y' rest,

  -- have mo
  cases others_smaller with min_pos stuff,
  have euclidean_min := Euclidean_Algorithm_One_Step_two a min a_positive min_pos,
  cases euclidean_min with q rest,
  cases rest with r eq,
  cases eq with eq ineq,
  cases rest with rest axas,
  have thing:  r= a-min*q, {
    have rev : min * q + r = a, {symmetry,exact eq},
    rw add_comm at rev,
    have m:= move rev,
    rw subtr,
    exact m,
  },
  have thing2:  r = a - (a*x' + b*y')*q, {
    rw ← rest at thing,
    exact thing,
  },
  rw mul_comm at thing2,
  rw mul_add at thing2,
  have thing3 : r = a*(1-q*x')  +  (b *(-q* y')), {
    rw subtr,
    rw mul_add,
    rw mul_one,
    rw ← dist_neg_left,
    rw ← mul_assoc,
    rw mul_comm a (-q),
    rw mul_assoc,
    rw ← mul_assoc b (-q) y',
    rw mul_comm b (-q),
    rw mul_assoc,
    rw add_assoc,
    rw ← mul_add,
    rw dist_neg_left,
    rw ← subtr,
    rw mul_add,
    exact thing2,
  },
  have rnotpos: ¬ (is_positive r), {
    intro h,
    -- rw pos_is_g0 r at h,
    have wop_prop_r : WOP_prop r,
    {
      split,
      split,
      split,
      symmetry,
      exact thing3,
      exact h,
    },
    have rlemin := stuff r wop_prop_r,
    rw less_eq at rlemin,
    cases rlemin,
    have := trans_lt ineq.1 rlemin,
    apply no_lt_self r,
    exact this,
    cases ineq,
    rw rlemin at ineq_left,
    apply no_lt_self r,
    exact ineq_left,
  },
  have r_is_0: r=0, {
    cases ineq with r_lt_min zero_le_r,
    rw less_eq at zero_le_r,
    cases zero_le_r,{
      rw pos_is_g0 at rnotpos,
      rw not_le_ge at rnotpos,
      rw less_eq at rnotpos,
      cases rnotpos with zer les,{
        have t := trans_lt zer zero_le_r,
        exfalso,
        apply no_lt_self r,
        exact t,
      },
      exact les,
    },
    symmetry,
    exact zero_le_r,
  },
  let d:ZZ  := gcd a b,
  have min_div_a : min ∣ a,{
    rw r_is_0 at eq,
    rw add_zero at eq,
    rw divs,
    split,
    symmetry,
    exact eq,
  },
  have euclidean_min2 := Euclidean_Algorithm_One_Step_two b min b_positive min_pos,
  cases euclidean_min2 with q2 rest2,
  cases rest2 with r2 eq2,
  cases eq2 with eq2 ineq2,
  have iter:  r2 = b - min*q2, {
    have rev : min * q2 + r2 = b, {symmetry,exact eq2},
    rw add_comm at rev,
    have m:= move rev,
    rw subtr,
    exact m,
  },
  have iter2:  r2 = b - (a*x' + b*y')*q2, {
    rw ← rest at iter,
    exact iter,
  },
  rw mul_comm at iter2,
  rw mul_add at iter2,
  have iter3 : r2 = a*(-q2 * x')  +  (b *(1 - q2* y')), {
    rw subtr,
    rw mul_add,
    rw mul_one,
    rw ← dist_neg_left,
    rw ← mul_assoc,
    rw mul_comm a (-q2),
    rw ← add_assoc,
    rw add_comm ((-q2) * a * x') b,
    rw ← mul_assoc b,
    rw mul_comm b,
    rw add_assoc,
    rw mul_assoc,
    rw mul_assoc,
    rw ← mul_add,
    rw dist_neg_left,
    rw ← subtr,
    rw mul_add,
    exact iter2,
  },
  have r2notpos: ¬ (is_positive r2), {
    intro h,
    -- rw pos_is_g0 r at h,
    have wop_prop_r2 : WOP_prop r2,
    {
      split,
      split,
      split,
      symmetry,
      exact iter3,
      exact h,
    },
    have r2lemin := stuff r2 wop_prop_r2,
    rw less_eq at r2lemin,
    cases r2lemin,
    have := trans_lt ineq2.1 r2lemin,
    apply no_lt_self r2,
    exact this,
    cases ineq2,
    rw r2lemin at ineq2_left,
    apply no_lt_self r2,
    exact ineq2_left,
  },
  have r2_is_0: r2=0, {
    cases ineq2 with r2_lt_min zero_le_r2,
    rw less_eq at zero_le_r2,
    cases zero_le_r2,{
      rw pos_is_g0 at r2notpos,
      rw not_le_ge at r2notpos,
      rw less_eq at r2notpos,
      cases r2notpos with zer les,{
        have t := trans_lt zer zero_le_r2,
        exfalso,
        apply no_lt_self r2,
        exact t,
      },
      exact les,
    },
    symmetry,
    exact zero_le_r2,
  },
   have min_div_b : min ∣ b,{
    rw r2_is_0 at eq2,
    rw add_zero at eq2,
    rw divs,
    split,
    symmetry,
    exact eq2,
  },
  have d_div: d ∣ (a*x'+b*y'),{
    have dcons := gcd_def a b d,
    cases dcons with useful junk,
    have keyd : gcd a b = d := by refl,
    cases useful keyd,
    cases right with r junk2,
    exact divs_linear_combination x' y' left r,
  },
  have d_div_min: d ∣ min, {
    rw ← rest,
    exact d_div,
  },
  have d_pos: is_positive d := begin
    change (is_positive (gcd a b)),
    exact gcd_pos a b,
    -- sorry,
  end,
  have d_le_min: d ≤ min, {

     exact divs_le d min d_pos axas  d_div_min,
    -- sorry,
  },
  have min_le_d: min ≤ d, {
    have dcons := gcd_def a b d,
    have keyd : gcd a b = d := by refl,
    cases dcons with useful junk,
    cases useful keyd,
    cases right with junk2 u,
    have fin := u min,
    apply fin,
    exact ⟨min_div_a, min_div_b⟩,
  },
  have min_eq_d: min = d, {
      exact le_le_eq min d  min_le_d d_le_min,
  },
  split, {
    split, {
        have final:a * x' + b * y' = d  := begin
       rw ← min_eq_d,
       exact rest,
        end,
        have same: gcd a b =d, {refl},
        rw same,
        exact final,
    },
  },
end

theorem Fundamental_Lemma: ∀ (a b c:ZZ), a ∣ (b*c) → gcd a b = 1 → is_positive a → is_positive b → a ∣ c := begin
intros a b  c a_div_bc gcd_a_b a_pos b_pos,
have bezout := BezoutsLemma a b a_pos b_pos,
rcases bezout with ⟨x,y,equation ⟩,
rw gcd_a_b at equation,
rw divs at a_div_bc,
rcases a_div_bc with ⟨p, eq ⟩,
have mulled : a * x *c + a * p * y = c, {
rw eq,
-- rw mul_assoc a p y,
rw mul_comm (a*x) c,
rw mul_assoc b c y,

rw mul_comm (b) (c*y),
rw  mul_assoc c y b,
rw ← mul_add,
have mulled_equation := mul_left c equation,
rw mul_one at mulled_equation,
rw mul_comm y b,
exact mulled_equation,
},
rw mul_assoc at mulled,
rw mul_assoc at mulled,
rw ←  mul_add at mulled,
rw divs,
use (x * c + p * y),
exact mulled,
end
axiom pi: ZZ → ZZ → (ZZ → ZZ) →ZZ

axiom pi_same: ∀{x :ZZ}, ∀{f : ZZ → ZZ}, pi x x f = f x
axiom pi_diff: ∀{x y :ZZ}, ∀{f : ZZ → ZZ}, pi x y f = (f y) * (pi x (y -1) f)

axiom is_prime:  ZZ → Prop
axiom prime:
  ∀ (n:ZZ),
    is_prime n
    ↔ is_positive n ∧
    (∀(d:ZZ),
      is_positive d →
      d ∣ n →  (d=1 ∨ d=n))

theorem twoPositive: is_positive (2:ZZ) := begin
exact pos_plus_pos one_pos one_pos,
end
theorem zle1: (0:ZZ) ≤ (1:ZZ) := begin
rw less_eq,
left,
rw less_than,
use 1,
split,
exact one_pos,
rw zero_add,
end

theorem npos_le_0: ∀(x:ZZ), ¬(is_positive x) ↔ x ≤ 0 := begin
intro x,

split,{
  intro np,
  have := not_le_ge ,
  cases this,
  apply this_mp,
  have p := pos_is_g0 x,
  by_contradiction,
  cases p,
  have := p_mpr h,
  apply np,
  exact this,
},
intro zlex,
rw less_eq at zlex,
cases zlex,{
    have p := pos_is_g0 x,
cases p,
by_contradiction,
--
have := p_mp h,
have := trans_lt zlex this,
apply no_lt_self x,
exact this,
},
rw zlex,
exact nontriviality,
end
theorem prime_gcd: ∀ (p a : ZZ),is_positive a →  is_prime p → ¬ (p ∣ a) → gcd p a = 1 := begin
  intros  p a  a_pos pprime ndiv,
  have gcdax := gcd_def p a 1,
  have primedef := prime p,
  rw primedef at pprime,
  rw gcdax,
  split,
  exact div_one p,
  split,
  exact div_one a,
  intros d ddiv,
  cases ddiv with dlp dla,
  cases pprime with ppos pprime,
  have dprime := pprime d,
  by_cases (is_positive d),{
  have x:= dprime h dlp,
  cases x with deq1 deqp,{
    rw deq1,
    exact refl_le 1,
  },
  exfalso,
  apply ndiv,
  rw ← deqp,
  exact dla,
  },
  have := npos_le_0 d,
  rw this at h,
  have zle := zle1,
{
  have lt := trans_le h zle,
  exact lt,
},
end
theorem prime_divs: ∀(p a b:ZZ), is_prime p → is_positive a → p ∣ (a*b) → (p ∣ a ∨ p ∣ b) := begin
intros p a b p_prime a_pos p_divs_ab,
  by_cases (p ∣ a),{
    left,
    exact h,
  },

  have  gcd1 := prime_gcd p a a_pos p_prime h,
   rw prime at p_prime,
  cases p_prime,
  have p_divides_b := Fundamental_Lemma p a b p_divs_ab gcd1 p_prime_left a_pos,
  right,
  exact p_divides_b,
end

theorem IHateLogic: ∀ {p q :Prop}, ¬ (p → q) → p → (¬ q) := begin
intros p q npq p,
by_contradiction,
apply npq,
intro a,
exact h,
end

def x : list ZZ := [2,2]
-- def product_of_list

theorem EuclidsLemma: ∀ (f : ZZ → ZZ), ∀(p n:ZZ), is_prime p → (∀ (x:ZZ), is_positive (f x)) →  p ∣ (pi 0 n f) → (∃(k:ZZ), p ∣ (f k)) := begin
intros f p n prime_p always_pos p_div_pi,
  let WOP_prop : ZZ → Prop := λ n, p ∣ (pi 0 n f) →   (∃ (k : ZZ), (p ∣ f k)),
  have wop_contra := WOP_Contradiction WOP_prop,

  have wop_inside: (∀ (minimal : ZZ), ∃ (smaller : ZZ), ¬WOP_prop minimal∧ is_positive minimal → ¬WOP_prop smaller ∧ smaller < minimal) := begin
  -- assume there is some minimal m for which Euclid's Lemma Doesn't Hold
  intros minimal,
  -- we are going to show that Euclid's Lemma doesn't hold for m-1
  use (minimal-1),
  -- introduce the proposition that Euclid's Lemma doesn't hold on m
    intros nminimal,
cases nminimal with nminimal _,
     have x := IHateLogic nminimal,
     rw push_not_exists at x,
     rw pi_diff at x,
     have pos_f:is_positive (f minimal) :=begin
  exact always_pos minimal,
     end,
     have zjhchas := prime_divs p (f minimal) (pi 0 (minimal - 1) f) prime_p pos_f ,
     split,{
intro prop_mminimal,
change ( p ∣ (pi 0  (minimal-1 ) f) →   (∃ (k : ZZ), (p ∣ f k))) at  prop_mminimal,
apply nminimal,
{
change ( p ∣ (pi 0  (minimal ) f) →   (∃ (k : ZZ), (p ∣ f k))),
intro holds_min,
rw ← pi_diff at zjhchas ,
rw ← pi_diff at x ,

have holder := zjhchas holds_min,
have holderx := x holds_min,
cases holder, {
  have contrdict_thing := holderx minimal,
  exfalso,
  apply contrdict_thing,
  exact holder,
},
have thing := prop_mminimal holder,
exact thing,

},
     },
    exact min_1_lt_self minimal,
  end,
  have w := wop_contra wop_inside n p_div_pi,
exact w,
end

theorem composite_has_fact: ∀(x:ZZ), is_positive x →  ¬ (is_prime x) → (∃(d:ZZ), d ∣ x ∧ d ≠ 1 ∧ d ≠ x) := begin
intros  x pos not_prime,
by_contradiction,
rw push_not_exists at h,
-- rw push_and at h,
apply not_prime,
rw prime x,
-- intros pos
split,
{
  exact pos,
},
intros d dpos ddivx,
have := h d,
by_contradiction f,
have dm := demorgan (d = 1) (d=x) f,
apply this,
split,
exact ddivx,
exact dm,
end
-- theorem negprime: ∀ (x:ZZ), is_prime x → is_prime (-x) := begin
-- intros x p,
-- rw prime,

-- sorry,
-- end
theorem composite_has_fact2: ∀(x:ZZ),  ¬ (is_prime x) → (∃(d:ZZ), d ∣ x ∧ d ≠ 1 ∧ d ≠ x) := begin
intros x np,
have trich := trichotomy x,
rcases trich with  ⟨a ,b,c   ⟩  ,{

sorry,
},
rcases trich with  ⟨a,b,c   ⟩  ,{
  sorry,
},
rcases trich with  ⟨a,b,c   ⟩  ,{

  sorry,
},
-- sorry,
end

theorem prime_ge_1  : ∀ (p:ZZ), is_prime p → 1 < p :=
begin
intros p pprime,
rw prime at pprime,
rcases pprime with ⟨ ppos,pdivs⟩ ,
rw pos_iff_le_one at ppos,
rw less_eq at ppos,
cases ppos,
exact ppos,
by_contradiction,
rw not_le_ge at h,

-- have := pdivs 1 one_pos (div_one p),
sorry,
end
theorem All_Integers_Have_Prime_Factor: ∀(x:ZZ), ∃ (p:ZZ), (is_prime p ∧  p ∣ x) := begin
  intros x,
    let WOP_prop : ZZ → Prop := λ x, ∃(p:ZZ), is_prime p ∧  p ∣ x,
  have wop_contra := WOP_Contradiction WOP_prop,
  have wop_inside: (∀ (minimal : ZZ), ∃ (smaller : ZZ), ¬WOP_prop minimal ∧ is_positive minimal → ¬WOP_prop smaller ∧ smaller < minimal) := begin
  intros minimal,

split,{
  intro not_min,
  cases not_min with not_min mins_pos,
  change (¬  (∃(p:ZZ), is_prime p ∧ p ∣ minimal)) at not_min,
  rw push_not_exists at not_min,
  have nminimal := not_min minimal,
  push_neg at nminimal,
  have cp_nminimal: minimal ∣ minimal → ¬ is_prime minimal := begin
  contrapose!,
  exact nminimal,
  end,
  have thing := cp_nminimal (div_self minimal),
  have pos_min: is_positive minimal := mins_pos,

  have bruh := composite_has_fact minimal pos_min thing,
cases bruh with d deq,{

  rcases deq with ⟨ a,b,c⟩,
  rw divs at a,
  rcases a with  ⟨ divisor, divides⟩ ,

split,{
  have br : ¬WOP_prop divisor := begin

sorry,
  end,
-- use divisor,
  -- exact br,

sorry,
},
have x: divisor < minimal,{
sorry,
},
-- exact x,
sorry,
},

-- change ()
  -- contrapose nminimal,
-- exfalso,
-- apply nminimal,
-- exact (div_self minimal),
-- have x :=not_min minimal,
-- sorry,

-- sorry,
--   cases nminimal, {
-- exfalso,
-- apply nminimal_right,
-- exact div_self minimal,
--   },
-- sorry,

-- sorry,
},
sorry,
-- exact minimal,
end,
  have w := wop_contra wop_inside  x,
exact w,
end
def product: list ZZ → ZZ
  | [] :=1
  | (x :: xs) := x * (product xs)
def all_prime_list: list ZZ → Prop
  | [] := true
  | (x :: xs) := is_prime x ∧ all_prime_list xs.
theorem All_Integers_Have_Prime_Repr' : ∀(x:ZZ), ∃(l: list ZZ), (all_prime_list l) ∧   product l = x:=
 begin
     let WOP_prop : ZZ → Prop := λ x,  ∃(l: list ZZ), (all_prime_list l) ∧  product l  = x,
have wc := WOP_Contradiction WOP_prop,
have inside: (∀ (minimal : ZZ), ∃ (smaller : ZZ), ¬WOP_prop minimal ∧ (is_positive minimal) → ¬WOP_prop smaller ∧ smaller < minimal) :=
begin
intros minimal,
  have prime_fac_min := All_Integers_Have_Prime_Factor minimal,
     cases prime_fac_min with p pdivs,

  cases pdivs with p_is_prime p_divides_minimal,
    rw divs at p_divides_minimal,
cases p_divides_minimal with c cp_eq_min,
use c,
intro npmin,
split, {
  intros nc,
  cases npmin with npmin min_positive,
  apply npmin,
  cases nc with clist cprod,
  cases cprod with allprimec cprod,
  use (p :: clist),
split,{
rw all_prime_list,
exact ⟨ p_is_prime,allprimec⟩,
},
rw product,
rw cprod,
exact cp_eq_min,

},
have ppos : is_positive p, {
  rw prime at p_is_prime,
  cases p_is_prime,
  exact p_is_prime_left,
},
cases npmin with npmin minpos,

have cpos: is_positive c, {
exact pos_div_pos p minimal c ppos minpos cp_eq_min,

},
have c_div_min: c ∣  minimal, {
rw divs,
use p,
rw ←  cp_eq_min,
rw mul_comm,
},
have smaller := divs_le c minimal cpos minpos c_div_min,

sorry,

end,
intros x,
exact wc inside x,

  end


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

! This file was ported from Lean 3 source module topology.omega_complete_partial_order
! leanprover-community/mathlib commit 2705404e701abc6b3127da906f40bae062a169c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Basic
import Mathlib.Order.OmegaCompletePartialOrder

/-!
# Scott Topological Spaces

A type of topological spaces whose notion
of continuity is equivalent to continuity in ωCPOs.

## Reference

 * https://ncatlab.org/nlab/show/Scott+topology

-/

open Set OmegaCompletePartialOrder

open Classical

universe u

-- "Scott", "ωSup"
set_option linter.uppercaseLean3 false

namespace Scott

/-- `x` is an `ω`-Sup of a chain `c` if it is the least upper bound of the range of `c`. -/
def IsωSup {α : Type u} [Preorder α] (c : Chain α) (x : α) : Prop :=
  (∀ i, c i ≤ x) ∧ ∀ y, (∀ i, c i ≤ y) → x ≤ y
#align Scott.is_ωSup Scott.IsωSup

theorem isωSup_iff_isLUB {α : Type u} [Preorder α] {c : Chain α} {x : α} :
    IsωSup c x ↔ IsLUB (range c) x := by
  simp [IsωSup, IsLUB, IsLeast, upperBounds, lowerBounds]
#align Scott.is_ωSup_iff_is_lub Scott.isωSup_iff_isLUB

variable (α : Type u) [OmegaCompletePartialOrder α]

/-- The characteristic function of open sets is monotone and preserves
the limits of chains. -/
def IsOpen (s : Set α) : Prop :=
  Continuous' fun x ↦ x ∈ s
#align Scott.is_open Scott.IsOpen

theorem isOpen_univ : IsOpen α univ :=
  ⟨fun _ _ _ _ ↦ mem_univ _, @CompleteLattice.top_continuous α Prop _ _⟩
#align Scott.is_open_univ Scott.isOpen_univ

theorem isOpen_unionₛ (s : Set (Set α)) (hs : ∀ t ∈ s, IsOpen α t) : IsOpen α (⋃₀ s) := by
  simp only [IsOpen] at hs⊢
  convert CompleteLattice.supₛ_continuous' (setOf ⁻¹' s) hs
  simp only [supₛ_apply, setOf_bijective.surjective.exists, exists_prop, mem_preimage,
    SetCoe.exists, supᵢ_Prop_eq, mem_setOf_eq, mem_unionₛ]
#align Scott.is_open_sUnion Scott.isOpen_unionₛ

end Scott

/-- A Scott topological space is defined on preorders
such that their open sets, seen as a function `α → Prop`,
preserves the joins of ω-chains  -/
@[reducible]
def Scott (α : Type u) := α
#align Scott Scott

instance Scott.topologicalSpace (α : Type u) [OmegaCompletePartialOrder α] :
    TopologicalSpace (Scott α) where
  IsOpen := Scott.IsOpen α
  isOpen_univ := Scott.isOpen_univ α
  isOpen_inter := Scott.IsOpen.inter α
  isOpen_unionₛ := Scott.isOpen_unionₛ α
#align Scott.topological_space Scott.topologicalSpace

section notBelow

variable {α : Type _} [OmegaCompletePartialOrder α] (y : Scott α)

/-- `notBelow` is an open set in `Scott α` used
to prove the monotonicity of continuous functions -/
def notBelow :=
  { x | ¬x ≤ y }
#align not_below notBelow

theorem notBelow_isOpen : IsOpen (notBelow y) := by
  have h : Monotone (notBelow y) := by
    intro x y' h
    simp only [notBelow, setOf, le_Prop_eq]
    intro h₀ h₁
    apply h₀ (le_trans h h₁)
  exists h
  rintro c
  apply eq_of_forall_ge_iff
  intro z
  rw [ωSup_le_iff]
  simp only [ωSup_le_iff, notBelow, mem_setOf_eq, le_Prop_eq, OrderHom.coe_fun_mk, Chain.map_coe,
    Function.comp_apply, exists_imp, not_forall]
#align not_below_is_open notBelow_isOpen

end notBelow

open Scott hiding IsOpen

open OmegaCompletePartialOrder

theorem isωSup_ωSup {α} [OmegaCompletePartialOrder α] (c : Chain α) : IsωSup c (ωSup c) := by
  constructor
  · apply le_ωSup
  · apply ωSup_le
#align is_ωSup_ωSup isωSup_ωSup

theorem scottContinuous_of_continuous {α β} [OmegaCompletePartialOrder α]
    [OmegaCompletePartialOrder β] (f : Scott α → Scott β) (hf : Continuous f) :
    OmegaCompletePartialOrder.Continuous' f := by
  simp only [continuous_def, (· ⁻¹' ·)] at hf
  have h : Monotone f := by
    intro x y h
    cases' hf { x | ¬x ≤ f y } (notBelow_isOpen _) with hf hf'
    clear hf'
    specialize hf h
    simp only [preimage, mem_setOf_eq, le_Prop_eq] at hf
    by_contra H
    apply hf H le_rfl
  exists h
  intro c
  apply eq_of_forall_ge_iff
  intro z
  specialize hf _ (notBelow_isOpen z)
  cases' hf with _ hf_h
  specialize hf_h c
  simp only [notBelow, eq_iff_iff, mem_setOf_eq] at hf_h
  rw [← not_iff_not]
  simp only [ωSup_le_iff, hf_h, ωSup, supᵢ, supₛ, mem_range, Chain.map_coe, Function.comp_apply,
    eq_iff_iff, not_forall]
  tauto
#align Scott_continuous_of_continuous scottContinuous_of_continuous

theorem continuous_of_scottContinuous {α β} [OmegaCompletePartialOrder α]
    [OmegaCompletePartialOrder β] (f : Scott α → Scott β)
    (hf : OmegaCompletePartialOrder.Continuous' f) : Continuous f := by
  rw [continuous_def]
  intro s hs
  change Continuous' (s ∘ f)
  cases' hs with hs hs'
  cases' hf with hf hf'
  apply Continuous.of_bundled
  apply continuous_comp _ _ hf' hs'
#align continuous_of_Scott_continuous continuous_of_scottContinuous


namespace prop_19

variables A B : Prop

theorem prop_19 : (¬ ¬ A ∧ ¬ ¬ (A → B)) → ¬ ¬ B :=
assume h1: ¬ ¬ A ∧ ¬ ¬ (A → B),
have h2: ¬ ¬ A, from and.left h1,
have h3: A, from (classical.by_contradiction
  (assume h4: ¬ A,
   h2 h4)),
have h5: ¬ ¬ (A → B), from and.right h1,
have h6: A → B, from (classical.by_contradiction
  (assume h7: ¬(A → B),
   h5 h7)),
assume h8: ¬ B,
show false, from h8 (h6 h3)

-- end namespace
end prop_19