/-
Copyright (c) 2022 Dhruv Bhatia. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Dhruv Bhatia, Eric Wieser
-/
import tactic.linear_combination
import data.buffer.parser.numeral
import data.json

/-!

# polyrith Tactic

In this file, the `polyrith` tactic is created.  This tactic, which
works over `field`s, attempts to prove a multivariate polynomial target over said
field by using multivariable polynomial hypotheses/proof terms over the same field.
Used as is, the tactic makes use of those hypotheses in the local context that are
over the same field as the target. However, the user can also specifiy which hypotheses
from the local context to use, along with proof terms that might not already be in the
local context. Note: since this tactic uses SageMath via an API call done in Python,
it can only be used with a working internet connection, and with a local installation of Python.

## Implementation Notes

The tactic `linear_combination` is often used to prove such goals by allowing the user to
specify a coefficient for each hypothesis. If the target polynomial can be written as a
linear combination of the hypotheses with the chosen coefficients, then the `linear_combination`
tactic succeeds. In other words, `linear_combination` is a certificate checker, and it is left
to the user to find a collection of good coefficients. The `polyrith` tactic automates this
process using the theory of Groebner bases.

Polyrith does this by first parsing the relevant hypotheses into a form that Python can understand.
It then calls a Python file that uses the SageMath API to compute the coefficients. These
coefficients are then sent back to Lean, which parses them into pexprs. The information is then
given to the `linear_combination` tactic, which completes the process by checking the certificate.

`polyrith` calls an external python script `scripts/polyrith_sage.py`. Because this is not a Lean
file, changes to this script may not be noticed during Lean compilation if you have already
generated olean files. If you are modifying this python script, you likely know what you're doing;
remember to force recompilation of any files that call `polyrith`.

## TODO

* Give Sage more information about the specific ring being used for the coefficients. For now,
  we always use ℚ (or `QQ` in Sage).
* Handle `•` terms.
* Support local Sage installations.

## References

* See the book [*Ideals, Varieties, and Algorithms*][coxlittleOshea1997] by David Cox, John Little,
  and Donal O'Shea for the background theory on Groebner bases
* This code was heavily inspired by the code for the tactic `linarith`, which was written by
  Robert Lewis, who advised me on this project as part of a Computer Science independant study
  at Brown University.

-/

open tactic native

namespace polyrith

/-! # Poly Datatype -/

/--
A datatype representing the semantics of multivariable polynomials.
Each `poly` can be converted into a string.
-/
@[derive decidable_eq]
inductive poly
| const : ℚ → poly
| var : ℕ → poly
| add : poly → poly → poly
| sub : poly → poly → poly
| mul : poly → poly → poly
| pow : poly → ℕ → poly
| neg : poly → poly

/--
This converts a poly object into a string representing it. The string
maintains the semantic structure of the poly object.

The output of this function must be valid Python syntax, and it assumes the variables `varN` from
`scripts/polyrith.py.`
-/
meta def poly.mk_string : poly → string
| (poly.const z) := to_string z
| (poly.var n) := "var" ++ to_string n
| (poly.add p q) := "(" ++ poly.mk_string p ++ " + " ++ poly.mk_string q ++ ")"
| (poly.sub p q) := "(" ++ poly.mk_string p ++ " - " ++ poly.mk_string q ++ ")"
| (poly.mul p q) := "(" ++ poly.mk_string p ++ " * " ++ poly.mk_string q ++ ")"
| (poly.pow p n) := to_string $ format!"({poly.mk_string p} ^ {n})"
| (poly.neg p) := ("-" ++ poly.mk_string p)

meta instance : has_add poly := ⟨poly.add⟩
meta instance : has_sub poly := ⟨poly.sub⟩
meta instance : has_mul poly := ⟨poly.mul⟩
meta instance : has_pow poly ℕ := ⟨poly.pow⟩
meta instance : has_neg poly := ⟨poly.neg⟩
meta instance : has_repr poly := ⟨poly.mk_string⟩
meta instance : has_to_format poly := ⟨to_fmt ∘ poly.mk_string⟩
meta instance : inhabited poly := ⟨poly.const 0⟩

/-!
# Parsing algorithms

The following section contains code that can convert an `expr` of type `Prop` into a `poly` object
(provided that it is an equality)
-/

/--
`(vars, p) ← poly_form_of_atom red vars e` is the atomic case for `poly_form_of_expr`.
If `e` appears with index `k` in `vars`, it returns the singleton sum `p = poly.var k`.
Otherwise it updates `vars`, adding `e` with index `n`, and returns the singleton `p = poly.var n`.
-/
meta def poly_form_of_atom (red : transparency) (vars : list expr) (e : expr) :
  tactic (list expr × poly) :=
do
  index_of_e ← vars.mfoldl_with_index
    (λ n last e', match last with
    | none := tactic.try_core $ tactic.is_def_eq e e' red >> return n
    | some k := return k
    end) none,
  return (match index_of_e with
  | some k := (vars, poly.var k)
  | none   := (vars.concat e, poly.var vars.length)
  end)

/--
`poly_form_of_expr red map e` computes the polynomial form of `e`.

`map` is a lookup map from atomic expressions to variable numbers.
If a new atomic expression is encountered, it is added to the map with a new number.
It matches atomic expressions up to reducibility given by `red`.

Because it matches up to definitional equality, this function must be in the `tactic` monad,
and forces some functions that call it into `tactic` as well.
-/
meta def poly_form_of_expr (red : transparency) : list expr → expr → tactic (list expr × poly)
| m `(%%e1 * %%e2) :=
   do (m', comp1) ← poly_form_of_expr m e1,
      (m', comp2) ← poly_form_of_expr m' e2,
      return (m', comp1 * comp2)
| m `(%%e1 + %%e2) :=
   do (m', comp1) ← poly_form_of_expr m e1,
      (m', comp2) ← poly_form_of_expr m' e2,
      return (m', comp1 + comp2)
| m `(%%e1 - %%e2) :=
   do (m', comp1) ← poly_form_of_expr m e1,
      (m', comp2) ← poly_form_of_expr m' e2,
      return (m',  comp1 - comp2)
| m `(-%%e) :=
  do (m', comp) ← poly_form_of_expr m e,
     return (m', - comp)
| m p@`(@has_pow.pow _ ℕ _ %%e %%n) :=
  match n.to_nat with
  | some k :=
    do (m', comp) ← poly_form_of_expr m e,
    return (m', comp^k)
  | none := poly_form_of_atom red m p
  end
| m e :=
  match e.to_rat with
  | some z := return ⟨m, poly.const z⟩
  | none := poly_form_of_atom red m e
  end

/-!
# Un-Parsing algorithms

The following section contains code that can convert an a `poly` object into a `pexpr`.
-/

/--
This can convert a `poly` into a `pexpr` that would evaluate to a polynomial.
To do so, it uses a list `m` of expressions, the atomic expressions that appear in the `poly`.
The index of an expression in this list corresponds to its `poly.var` argument: that is,
if `e` is the `k`th element of `m`, then it is represented as `poly.var k`.

`poly` objects only contain coefficients from `ℚ`. However, the `poly` object might
be referring to a polynomial over some other field. As such, the resulting `pexpr` contains
no typing information.
-/
meta def poly.to_pexpr : list expr → poly → tactic pexpr
| _ (poly.const z) := return z.to_pexpr
| m (poly.var n) :=
  do
    some (e) ← return $ m.nth n | fail! "unknown variable poly.var {n}",
    return ``(%%e)
| m (poly.add p q) :=
  do
    p_pexpr ← poly.to_pexpr m p,
    q_pexpr ← poly.to_pexpr m q,
    return ``(%%p_pexpr + %%q_pexpr)
| m (poly.sub p q) :=
  do
    p_pexpr ← poly.to_pexpr m p,
    q_pexpr ← poly.to_pexpr m q,
    if p_pexpr = ``(0) then return ``(- %%q_pexpr) else
    return ``(%%p_pexpr - %%q_pexpr)
| m (poly.mul p q) :=
  do
    p_pexpr ← poly.to_pexpr m p,
    q_pexpr ← poly.to_pexpr m q,
    return ``(%%p_pexpr * %%q_pexpr)
| m (poly.pow p n) :=
  do
    p_pexpr ← poly.to_pexpr m p,
    return ``(%%p_pexpr ^ %%n.to_pexpr)
| m (poly.neg p) :=
  do
    p_pexpr ← poly.to_pexpr m p,
    return ``(- %%p_pexpr)

/-!
# Parsing SageMath output into a poly

The following section contains code that can convert a string of appropriate format into
a `poly` object. This is used later on to convert the coefficients given by Sage into
`poly` objects.
-/

open parser

/--
A parser object that parses `string`s of the form `"poly.var n"`
to the appropriate `poly` object representing a variable.
Here, `n` is a natural number
-/
meta def var_parser : parser poly := do
str "poly.var " >> poly.var <$> parser.nat

/--
A parser object that parses `string`s of the form `"poly.const r"`
to the appropriate `poly` object representing a rational coefficient.
Here, `r` is a rational number
-/
meta def const_fraction_parser : parser poly :=
str "poly.const " >> poly.const <$> parser.rat

/--
A parser object that parses `string`s of the form `"poly.add p q"`
to the appropriate `poly` object representing the sum of two `poly`s.
Here, `p` and `q` are themselves string forms of `poly`s.
-/
meta def add_parser (cont : parser poly) : parser poly :=
str "poly.add " >> poly.add <$> cont <*> (ch ' ' >> cont)

/--
A parser object that parses `string`s of the form `"poly.sub p q"`
to the appropriate `poly` object representing the subtraction of two `poly`s.
Here, `p` and `q` are themselves string forms of `poly`s.
-/
meta def sub_parser (cont : parser poly) : parser poly :=
str "poly.sub " >> poly.sub <$> cont <*> (ch ' ' >> cont)

/--
A parser object that parses `string`s of the form `"poly.mul p q"`
to the appropriate `poly` object representing the product of two `poly`s.
Here, `p` and `q` are themselves string forms of `poly`s.
-/
meta def mul_parser (cont : parser poly) : parser poly :=
str "poly.mul " >> poly.mul <$> cont <*> (ch ' ' >> cont)

/--
A parser object that parses `string`s of the form `"poly.pow p n"`
to the appropriate `poly` object representing a `poly` raised to the
power of a natural number. Here, `p` is the string form of a `poly`
and `n` is a natural number.
-/
meta def pow_parser (cont : parser poly) : parser poly :=
str "poly.pow " >> poly.pow <$> cont <*> (ch ' ' >> nat)

/--
A parser object that parses `string`s of the form `"poly.neg p"`
to the appropriate `poly` object representing the negation of a `poly`.
Here, `p` is the string form of a `poly`.
-/
meta def neg_parser (cont : parser poly) : parser poly :=
str "poly.neg " >> poly.neg <$> cont

/-- A parser for `poly` that uses an s-essresion style formats such as
`(poly.add (poly.var 0) (poly.const 1)`. -/
meta def poly_parser : parser poly :=
ch '('
  *> (var_parser <|> const_fraction_parser <|> add_parser poly_parser
    <|> sub_parser poly_parser <|> mul_parser poly_parser <|> pow_parser poly_parser
    <|> neg_parser poly_parser)
  <* ch ')'

meta instance : non_null_json_serializable poly :=
{ to_json := λ p, json.null,  -- we don't actually need this, but the typeclass asks for it
  of_json := λ j, do
    s ← of_json string j,
    match poly_parser.run_string s with
    | sum.inl s := exceptional.fail format!"unable to parse polynomial from.\n\n{s}"
    | sum.inr p := pure p
    end}

/-- A schema for success messages from the python script -/
@[derive [non_null_json_serializable, inhabited]]
structure sage_json_success :=
(success : {b : bool // b = tt})
(trace : option string := none)
(data : option (list poly) := none)

/-- A schema for failure messages from the python script -/
@[derive [non_null_json_serializable, inhabited]]
structure sage_json_failure :=
(success : {b : bool // b = ff})
(error_name : string)
(error_value : string)

/-- Parse the json output from `scripts/polyrith.py` into either an error message, a list of `poly`
objects, or `none` if only trace output was requested. -/
meta def convert_sage_output (j : json) : tactic (option (list poly)) :=
do
  r : sage_json_success ⊕ sage_json_failure ← decorate_ex "internal json error: "
    -- try the error format first, so that if both fail we get the message from the success parser
    (sum.inr <$> of_json sage_json_failure j <|> sum.inl <$> of_json sage_json_success j),
  match r with
  | sum.inr f :=
      fail!"polyrith failed to retrieve a solution from Sage! {f.error_name}: {f.error_value}"
  | sum.inl s := do
      s.trace.mmap trace,
      pure s.data
  end

/-!
# Parsing context into poly

The following section contains code that collects hypotheses of the appropriate type
from the context (and from the list of hypotheses and proof terms specified by the user)
and converts them into `poly` objects.
-/

/-- Convert an expression of the form `lhs = rhs` into the form `lhs - rhs` -/
meta def equality_to_left_side : expr → tactic expr
| `(%%lhs = %%rhs) := to_expr ``(%%lhs - %%rhs)
| e := fail "expression is not an equality"

/-- `(vars, poly, typ) ← parse_target_to_poly` interprets the current target (an equality over
some field) into a `poly`. The result is a list of the atomic expressions in the target,
the `poly` itself, and an `expr` representing the type of the field. -/
meta def parse_target_to_poly : tactic (list expr × poly × expr) :=
do
  e@`(@eq %%R _ _) ← target,
  left_side ← equality_to_left_side e,
  (m, p) ← poly_form_of_expr transparency.reducible [] left_side,
  return (m, p, R)

/-- Filter `l` to the elements which are equalities of type `expt`. -/
meta def get_equalities_of_type (expt : expr) (l : list expr) : tactic (list expr) :=
l.mfilter $ λ h_eq, succeeds $ do
  `(@eq %%R _ _) ← infer_type h_eq,
  unify expt R

/--
The purpose of this tactic is to collect all the hypotheses
and proof terms (specified by the user) that are equalities
of the same type as the target. It takes in an `expr` representing
the type, a list of expressions representing the atoms
(typically this starts as only containing
information about the target), a `bool` representing whether the
user used the key word "only", and a `list pexpr` of all the
hypotheses and proof terms selected by the user.

If the key word "only" is used, it collects together only those
hypotheses/proof terms selected by the user. If not, they are
combined with hypotheses from the local context. We throw out
those hypotheses that are not equalities of the given type,
and then modify each equality such that everything has been
moved to the left of the "=" sign.

The tactic returns the names of these hypotheses (as `expr`s),
a list of atoms updated with information from all these hypotheses,
and a list of these hypotheses converted into `poly` objects.
-/
meta def parse_ctx_to_polys (expt : expr) (m : list expr) (only_on : bool) (hyps : list pexpr) :
  tactic (list expr × list expr × list poly) :=
do
  hyps ← hyps.mmap i_to_expr,
  hyps ← if only_on then return hyps else (++ hyps) <$> local_context,
  eq_names ← get_equalities_of_type expt hyps,
  eqs ← eq_names.mmap infer_type,
  eqs_to_left ← eqs.mmap equality_to_left_side,
  -- convert the expressions to polynomials, tracking the variables in `m`
  (m, poly_list) ← eqs_to_left.mfoldl (λ (s : _ × list poly) new_exp, do
    { let (m, poly_list) := s,
      (m', new_poly) ← poly_form_of_expr transparency.reducible m new_exp,
      return (m', poly_list ++ [new_poly]) })
    (m, []),
  return (eq_names, m, poly_list)

/-!
# Connecting with Python

The following section contains code that allows lean to communicate with a python script.
-/

/--
This tactic calls python from the command line with the args in `arg_list`.
The output printed to the console is returned as a `string`.
It assumes that `python3` is available on the path.
-/
meta def sage_output (arg_list : list string := []) : tactic json :=
do
  path ← get_mathlib_dir,
  let args := [path ++ "../scripts/polyrith_sage.py"] ++ arg_list,
  s ← unsafe_run_io $ io.cmd { cmd := "python3", args := args},
  some j ← pure (json.parse s) | fail!"Invalid json: {s}",
  pure j

/--
Adds parentheses around additions and subtractions, for printing at
precedence 65.
-/
meta def add_parens : expr → tactic format
| e@`(_ + _) := pformat!"({e})"
| e@`(_ - _) := pformat!"({e})"
| e := pformat!"{e}"

/--
Given a pair of `expr`s, where one represents the hypothesis/proof term,
and the other representes the coefficient attached to it, this tactic
creates a string combining the two in the appropriate format for
`linear_combination`.

The boolean value returned is `tt` if the format needs to be negated
to accurately reflect the input expressions.
The negation is not applied in the format output by this function,
because it may appear as a negation (if this is the first component)
or a subtraction.
-/
meta def component_to_lc_format : expr × expr → tactic (bool × format)
| (ex, `(@has_one.one _ _))  := prod.mk ff <$> pformat!"{ex}"
| (ex, `(@has_one.one _ _ / %%cf))  := do f ← add_parens cf, prod.mk ff <$> pformat!"{ex} / {f}"
| (ex, `(-%%cf)) := do (neg, fmt) ← component_to_lc_format (ex, cf), return (!neg, fmt)
| (ex, cf) := do f ← add_parens cf, prod.mk ff <$> pformat!"{f} * {ex}"

private meta def intersperse_ops_aux : list (bool × format) → format
| [] := ""
| ((ff, fmt) :: t) := " +" ++ format.soft_break ++ fmt ++ intersperse_ops_aux t
| ((tt, fmt) :: t) := " -" ++ format.soft_break ++ fmt ++ intersperse_ops_aux t

/--
Given a `list (bool × format)`, this function uses `+` and `-` to conjoin the
`format`s in the list. A `format` is negated if its corresponding `bool` is `tt`.
-/
meta def intersperse_ops : list (bool × format) → format
| [] := ""
| ((ff, fmt)::t) := fmt ++ intersperse_ops_aux t
| ((tt, fmt)::t) := "-" ++ fmt ++ intersperse_ops_aux t

/-- This tactic repeats the process above for a `list` of pairs of `expr`s.-/
meta def components_to_lc_format (components : list (expr × expr)) : tactic format :=
intersperse_ops <$> components.mmap component_to_lc_format

/-!
# Connecting with Python

The following section contains code that allows lean to communicate with a python script.
-/

declare_trace polyrith

/--
The first half of `tactic.polyrith` produces a list of arguments to be sent to Sage.
-/
meta def create_args (only_on : bool) (hyps : list pexpr) :
  tactic (list expr × list expr × expr × list string) := do
  (m, p, R) ← parse_target_to_poly,
  (eq_names, m, polys) ← parse_ctx_to_polys R m only_on hyps,
  let args := [to_string R, to_string m.length,
    (polys.map poly.mk_string).to_string, p.mk_string],
  return $ (eq_names, m, R, to_string (is_trace_enabled_for `polyrith) :: args)

/--
The second half of `tactic.polyrith` processes the output from Sage into
a call to `linear_combination`.
-/
meta def process_output (eq_names : list expr) (m : list expr) (R : expr) (sage_out : json) :
  tactic format := focus1 $ do
  some coeffs_as_poly ← convert_sage_output sage_out | fail!"internal error: No output available",
  coeffs_as_pexpr ← coeffs_as_poly.mmap (poly.to_pexpr m),
  let eq_names_pexpr := eq_names.map to_pexpr,
  coeffs_as_expr ← coeffs_as_pexpr.mmap $ λ e, to_expr ``(%%e : %%R),
  linear_combo.linear_combination eq_names_pexpr coeffs_as_pexpr,
  let components := (eq_names.zip coeffs_as_expr).filter
    $ λ pr, bnot $ pr.2.is_app_of `has_zero.zero,
  expr_string ← components_to_lc_format components,
  let lc_fmt : format := "linear_combination " ++ format.nest 2 (format.group expr_string),
  done <|>
    fail!"polyrith found the following certificate, but it failed to close the goal:\n{lc_fmt}",
  return $ "linear_combination " ++ format.nest 2 (format.group expr_string)

/-- Tactic for the special case when no hypotheses are available. -/
meta def no_hypotheses_case : tactic (option format) :=
(do `[ring], return $ some "ring") <|>
  fail "polyrith did not find any relevant hypotheses and the goal is not provable by ring"

/-- Tactic for the special case when there are no variables. -/
meta def no_variables_case : tactic (option format) :=
(do `[ring], return $ some "ring") <|>
  fail "polyrith did not find any variables and the goal is not provable by ring"

/--
This is the main body of the `polyrith` tactic. It takes in the following inputs:
* `(only_on : bool)` - This represents whether the user used the key word "only"
* `(hyps : list pexpr)` - the hypotheses/proof terms selecteed by the user

First, the tactic converts the target into a `poly`, and finds out what type it
is an equality of. (It also fills up a list of `expr`s with its atoms). Then, it
collects all the relevant hypotheses/proof terms from the context, and from those
selected by the user, taking into account whether `only_on` is true. (The list of atoms is
updated accordingly as well).

This information is used to create a list of args that get used in a call to
the appropriate python file that executes a grobner basis computation. The
output of this computation is a `string` representing the certificate. This
string is parsed into a list of `poly` objects that are then converted into
`pexpr`s (using the updated list of atoms).

the names of the hypotheses, along with the corresponding coefficients are
given to `linear_combination`. If that tactic succeeds, the user is prompted
to replace the call to `polyrith` with the appropriate call to
`linear_combination`.

This returns `none` if this was a "dry run" attempt that does not actually invoke sage.
-/
meta def _root_.tactic.polyrith (only_on : bool) (hyps : list pexpr) : tactic (option format) :=
do
  sleep 10, -- otherwise can lead to weird errors when actively editing code with polyrith calls
  (eq_names, m, R, args) ← create_args only_on hyps,
  if eq_names.length = 0 then no_hypotheses_case else
  if m.length = 0 then no_variables_case else do
  sage_out ← sage_output args,
  if is_trace_enabled_for `polyrith then do
    convert_sage_output sage_out,
    return none
  else some <$> process_output eq_names m R sage_out

/-! # Interactivity -/
setup_tactic_parser

/--
Attempts to prove polynomial equality goals through polynomial arithmetic
on the hypotheses (and additional proof terms if the user specifies them).
It proves the goal by generating an appropriate call to the tactic
`linear_combination`. If this call succeeds, the call to `linear_combination`
is suggested to the user.

* `polyrith` will use all relevant hypotheses in the local context.
* `polyrith [t1, t2, t3]` will add proof terms t1, t2, t3 to the local context.
* `polyrith only [h1, h2, h3, t1, t2, t3]` will use only local hypotheses
  `h1`, `h2`, `h3`, and proofs `t1`, `t2`, `t3`. It will ignore the rest of the local context.

Notes:
* This tactic only works with a working internet connection, since it calls Sage
  using the SageCell web API at <https://sagecell.sagemath.org/>.
  Many thanks to the Sage team and organization for allowing this use.
* This tactic assumes that the user has `python3` installed and available on the path.
  (Test by opening a terminal and executing `python3 --version`.)
  It also assumes that the `requests` library is installed: `python3 -m pip install requests`.

Examples:

```lean
example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by polyrith
-- Try this: linear_combination h1 - 2 * h2

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

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

example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0) : a + b + c + d = 0 :=
by polyrith only [scary c d, h]
-- Try this: linear_combination scary c d + h
```
-/
meta def _root_.tactic.interactive.polyrith (restr : parse (tk "only")?)
  (hyps : parse pexpr_list?) : tactic unit :=
do
  some f ← tactic.polyrith restr.is_some (hyps.get_or_else []) | skip,
  trace!"Try this: {f}"

add_tactic_doc
{ name := "polyrith",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.polyrith],
  tags := ["arithmetic", "finishing", "decision procedure"] }

end polyrith


import data.num.lemmas data.list.basic .tactics .int

open tactic

def nat.to_num (n : nat) : num := n
def int.to_znum (z : int) : znum := z
def nat.to_znum : nat → znum := int.to_znum ∘ nat.to_int
def num.to_nat (n : num) : nat := n
def znum.to_int (z : znum) : int := z
def znum.to_nat : znum → nat := int.to_nat ∘ znum.to_int

lemma int.bijective_to_znum : function.bijective int.to_znum :=
begin
  rw [function.bijective_iff_has_inverse],
  existsi (λ (z : znum), (z : int)), constructor,
  { simp [function.left_inverse, int.to_znum] },
  { simp [function.left_inverse,
    function.right_inverse, int.to_znum] }
end

lemma int.to_znum_to_int {z : int} : z.to_znum.to_int = z :=
begin simp [int.to_znum, znum.to_int] end

lemma int.map_to_znum_to_int {zs : list int} :
list.map znum.to_int (list.map int.to_znum zs) = zs :=
begin
  simp [list.map, int.to_znum, znum.to_int, function.comp],
  have h : (λ (x : ℤ), x) = id, refl, rw h, apply list.map_id
end

lemma nat.to_znum_to_nat {n : nat} : n.to_znum.to_nat = n :=
begin
  simp [znum.to_nat, nat.to_znum],
  rw int.to_znum_to_int, rw nat.to_int_to_nat
end

lemma nat.to_int_nonneg {n : nat} : 0 ≤ n.to_int :=
begin exact_dec_trivial end

namespace num

open list

instance inhabited : inhabited num := ⟨0⟩

lemma le_of_nat {m n : nat} : m.to_num ≤ n.to_num ↔ m ≤ n :=
begin rw ← le_to_nat, simp [nat.to_num] end

lemma add_of_nat' {m n : nat} : (m + n).to_num = m.to_num + n.to_num :=
begin simp [nat.to_num] end

lemma mul_of_nat' {m n : nat} : (m * n).to_num = m.to_num * n.to_num :=
begin simp [nat.to_num] end

lemma mul_to_znum' : ∀ {m n : num}, (m * n).to_znum = m.to_znum * n.to_znum
| 0       0       := rfl
| 0       (pos q) := (zero_mul _).symm
| (pos p) 0       := rfl
| (pos p) (pos q) :=
  begin simp [has_mul.mul, num.mul, to_znum, znum.mul] end

meta instance has_to_format : has_to_format num :=
⟨λ z, to_fmt (z : nat)⟩

def range (n : num) : list num :=
list.map nat.to_num (list.range (n : nat))

def lcm (m n : num) : num := m * n / (gcd m n)

lemma gcd_one_right (m : num) : gcd m 1 = 1 :=
begin
  rw [cast_inj.symm, gcd_to_nat],
  apply nat.gcd_one_right
end

lemma div_one (n : num) : n / 1 = n :=
begin
  rw [cast_inj.symm, div_to_nat],
  apply nat.div_one
end

lemma cast_inj' {α : Type} [linear_ordered_semiring α] {m n : num} :
(m : α) ≠ (n : α) ↔ m ≠ n :=
begin
  constructor; intros h hc;
  [ {rw cast_inj.symm at hc}, {rw cast_inj at hc} ];
  apply h hc,
end

lemma lcm_to_nat {m n : num} :
 ((lcm m n).to_nat) = nat.lcm m.to_nat n.to_nat :=
begin simp [lcm, nat.lcm, to_nat] end

lemma to_znum_nonneg : ∀ (n : num), 0 ≤ n.to_znum :=
begin intro n, cases n; exact_dec_trivial end

lemma lt_to_znum : ∀ {m n : num}, m.to_znum < n.to_znum ↔ m < n
| 0 0 := begin simp [to_znum], refl end
| 0 (pos n) := begin constructor; intro h; exact_dec_trivial end
| (pos m) 0 := begin constructor; intro h; cases h end
| (pos m) (pos n) :=
  begin simp [to_znum, has_lt.lt, znum.cmp, cmp] end

lemma mem_range {m n : num} : m ∈ range n ↔ m < n :=
begin
  constructor; intro h,
  { simp [range, mem_map] at h,
    cases h with k hk, cases hk with h1 h2, subst h2,
    rw [← lt_to_nat, nat.to_num, to_of_nat], apply h1 },
  { simp [range], existsi (m : nat),
    constructor, simp [le_to_nat], apply h,
    apply of_to_nat }
end

lemma pos_iff_nonzero :
∀ {m : num}, m > 0 ↔ m ≠ 0
| 0 := begin simp, exact_dec_trivial end
| (pos m) := begin simp, exact_dec_trivial end

lemma to_znum_pos_iff {m : num} :
  m.to_znum > 0 ↔ m > 0 :=
begin simp [gt], rw ← lt_to_znum, refl end

def comp_sub' : ∀ (as1 as2 : list num), list znum
| [] [] := []
| [] (n::ns) := (to_znum_neg n)::(comp_sub' [] ns)
| (n::ns) [] := (to_znum n)::(comp_sub' ns [])
| (n1::ns1) (n2::ns2) := (sub' n1 n2)::(comp_sub' ns1 ns2)

lemma to_znum_to_int_eq' :
∀ {m : num}, m.to_znum.to_int = m.to_nat.to_int :=
  begin
    intro n, have h1 := (@num.cast_to_znum int _ _ _ _ n),
    simp [znum.to_int, num.to_nat, nat.to_int],
  end

lemma to_znum_to_int_eq :
∀ {m : num}, ((m.to_znum) : int) = m.to_nat.to_int :=
begin
  intro m, rw ← to_znum_to_int_eq',
  dsimp [znum.to_int], refl,
end

def lcms : list num → num
| [] := 1
| (z::zs) := lcm z (lcms zs)

end num

namespace znum

open list

meta instance has_to_format : has_to_format znum :=
⟨λ z, to_fmt (z : int)⟩

instance inhabited : inhabited znum := ⟨0⟩

lemma to_int_to_znum {z : znum} : z.to_int.to_znum = z :=
begin rw ← @cast_inj int _, apply int.to_znum_to_int end

lemma to_nat_to_znum {z : znum} :
0 ≤ z → z.to_nat.to_znum = z :=
begin
  intro h, cases z, refl, simp [to_nat, nat.to_znum],
  rw int.to_nat_to_int, apply to_int_to_znum,
  rw ← le_to_int at h, apply h, exfalso, apply h, exact_dec_trivial
end

lemma mod_def : ∀ (a b : znum), a % b = a - b * (a / b) :=
begin
  intros a b, rw to_int_inj.symm,
  simp [mod_to_int, mul_to_int, int.mod_def]
end

lemma add_le_iff_le_sub {a b c : znum} : a + b ≤ c ↔ a ≤ c - b :=
iff.intro (le_sub_right_of_add_le) (add_le_of_le_sub_right)

lemma lt_of_le_sub_one {a b : znum} (h : a ≤ b - 1) : a < b :=
begin
  rw lt_to_int.symm,
  simp [le_to_int.symm] at h,
  rw add_comm at h,
  apply int.lt_of_le_sub_one h,
end

lemma le_sub_one_of_lt : ∀ {a b : znum}, a < b → a ≤ b - 1 :=
begin
  intros a b h, simp [le_to_int.symm],
  rw lt_to_int.symm at h,
  rw add_comm,
  apply int.le_sub_one_of_lt h,
end

def sign : znum → znum
| (pos _) := 1
| zero    := 0
| (neg _) := -1

def lcm (x y : znum) : znum :=
  (num.lcm (abs x) (abs y)).to_znum

def lcms : list znum → znum
| [] := 1
| (z::zs) := lcm z (lcms zs)

lemma lcm_to_int {x y} : to_int (lcm x y) = int.lcm (to_int x) (to_int y) :=
begin
  simp [lcm, int.lcm], repeat {rw ← abs_to_nat},
  have heq1 : int.nat_abs (to_int x) = (abs x).to_nat,
  { simp [to_int], rw (abs_to_nat x).symm,
    simp [num.to_nat] },
  have heq2 : int.nat_abs (to_int y) = (abs y).to_nat,
  { simp [to_int], rw (abs_to_nat y).symm,
    simp [num.to_nat] },
  rw [heq1, heq2], rw (num.lcm_to_nat).symm,
  apply num.to_znum_to_int_eq',
end

lemma lcm_to_int' {x y} : ↑(lcm x y) = int.lcm (to_int x) (to_int y) := lcm_to_int

lemma lcms_to_int :
  ∀ {zs}, (to_int (lcms zs)) = int.lcms (map to_int zs)
| [] := begin refl end
| (z::zs) := begin simp [lcms, int.lcms, lcm_to_int, lcms_to_int] end

lemma lcms_to_int' :
  ∀ {zs}, ↑(lcms zs) = int.lcms (map to_int zs) := @lcms_to_int

def range (z : znum) : list znum :=
list.map num.to_znum (num.range (abs z))

lemma neg_one_mul_eq_neg {z : znum} : (-1) * z = -z :=
begin cases z; simp end

lemma mul_le_mul_iff_le_of_neg_left (x y z : znum) :
z < 0 → (z * x ≤ z * y ↔ y ≤ x) :=
begin
  rw [← le_to_int, ← le_to_int, ← lt_to_int, mul_to_int, mul_to_int],
  apply int.mul_le_mul_iff_le_of_neg_left,
end

lemma le_of_lt_add_one {a b : znum} : a < b + 1 → a ≤ b :=
begin
  rw [← lt_to_int, ← le_to_int, cast_add],
  apply int.le_of_lt_add_one
end

lemma add_one_le_of_lt {a b : znum} : a < b → a + 1 ≤ b :=
begin rw [← lt_to_int, ← le_to_int, cast_add], apply int.add_one_le_of_lt end

lemma nonneg_iff_exists (z : znum) :
  0 ≤ z ↔ ∃ (n : num), z = n.to_znum :=
begin
  cases z with m m; constructor; intro h,
  { existsi (0 : num), refl },
  exact_dec_trivial,
  { existsi (num.pos m), refl},
  exact_dec_trivial,
  { exfalso, apply h, exact_dec_trivial },
  { cases h with n hn, cases n; cases hn }
end

lemma to_znum_abs : ∀ {a : znum}, a ≥ 0 → (abs a).to_znum = a
| (neg n) h := begin exfalso, apply h, exact_dec_trivial end
| 0       h := rfl
| (pos n) h := rfl

lemma mul_nonzero {z y : znum} : z ≠ 0 → y ≠ 0 → z * y ≠ 0 :=
begin
  intros h1 h2 hc,
  apply @int.mul_nonzero (z : int) (y : int),
  { intro hc, apply h1, rw cast_inj.symm, apply hc },
  { intro hc, apply h2, rw cast_inj.symm, apply hc },
  { rw [cast_inj.symm, mul_to_int] at hc, apply hc,}
end

lemma div_one (a : znum) : a / 1 = a :=
begin rw [← @cast_inj int, div_to_int], apply int.div_one end

lemma div_nonzero (z y : znum) : z ≠ 0 → has_dvd.dvd y z → (z / y) ≠ 0 :=
begin
  intros hz hy hc, apply @int.div_nonzero (z : int) (y : int),
  { intro hc, apply hz, rw cast_inj.symm, apply hc },
  { rw dvd_to_int, apply hy },
  { rw [cast_inj.symm, div_to_int] at hc, apply hc }
end

lemma nonzero_of_pos {z : znum} : z > 0 → z ≠ 0 :=
begin
  intro h, cases z, cases h,
  intro hc, cases hc, intro hc, cases hc,
end

lemma abs_pos_of_nonzero {z : znum} :
z ≠ 0 → abs z > 0 :=
begin
  intro h, cases z, exfalso,
  { apply h, refl },
  exact_dec_trivial, exact_dec_trivial
end

lemma lcms_pos {zs : list znum} : (∀ (z : znum), z ∈ zs → z ≠ 0) → lcms zs > 0 :=
begin
  intro h, simp [gt, lt_to_int.symm],
  have hrw := @lcms_to_int zs, simp [to_int] at hrw,
  rw hrw, apply int.lcms_pos, intros z hz hc,
  rw mem_map at hz, cases hz with x hx, cases hx with hx1 hx2,
  subst hx2, apply h _ hx1 _, --simp [to_int] at hc,
  rw cast_inj.symm, apply hc
end

lemma dvd_lcms : ∀ {x : znum} {zs : list znum}, x ∈ zs → x ∣ lcms zs :=
begin
  intros z zs h, rw (dvd_to_int _ _).symm,
  have hrw := @lcms_to_int zs, simp [to_int] at hrw, rw hrw,
  apply int.dvd_lcms, rw mem_map, existsi z,
  apply and.intro h rfl

end

lemma eq_zero_of_abs_eq_zero {z : znum} : abs z = 0 → z = 0 :=
begin intro h, cases z, refl, cases h, cases h end

lemma abs_one : abs 1 = 1 := rfl

lemma exists_lt_and_lt (x y : znum) : ∃ (z : znum), z < x ∧ z < y :=
begin
  cases (int.exists_lt_and_lt x y) with z hz,
  rw [← to_of_int z, lt_to_int, lt_to_int] at hz,
  existsi z.to_znum, apply hz,
end

lemma neg_to_int {z : znum} :
(-z).to_int = -(z.to_int) :=
begin cases z; simp [to_int] end

lemma neg_to_int' {z : znum} :
↑(-z) = -(z.to_int) := neg_to_int

lemma abs_to_int {z : znum} :
(_root_.abs z).to_int = _root_.abs z.to_int :=
begin
  simp [_root_.abs, abs, to_int, max],
  by_cases (z ≤ -z),
  { rw [if_pos h], rw (if_pos _), apply neg_to_int,
    have hrw := @neg_to_int z, dsimp [to_int] at hrw, rw ← hrw,
    rw le_to_int, assumption },
  { rw [if_neg h], rw (if_neg _), intro hc, apply h,
    have hrw := @neg_to_int z, dsimp [to_int] at hrw,
    rw ← le_to_int, rw hrw, assumption }
end

lemma abs_to_int' {z : znum} : ↑(_root_.abs z) = _root_.abs z.to_int := abs_to_int

lemma abs_eq_abs_to_znum (z : znum) :
_root_.abs z = (abs z).to_znum :=
begin
  rw [← (@znum.cast_inj int _)], have hrw := @abs_to_int z,
  simp [to_int] at hrw, rw hrw,
  have hrw2 := @num.to_znum_to_int_eq' (abs z),
  dsimp [to_int] at hrw2, rw hrw2,
  rw (int.abs_eq_nat_abs), simp [nat.to_int],
  simp [num.to_nat]
end

lemma lcms_distrib (xs ys zs : list znum) :
  (zs ≃ xs ∪ ys) → lcms zs = lcm (lcms xs) (lcms ys) :=
begin
  intro h1, rw ← (@cast_inj int _),
  simp [lcms_to_int, lcms_to_int', lcm_to_int'],
  apply int.lcms_distrib, apply equiv.trans,
  { apply list.map_equiv_map_of_equiv h1, },
  { apply list.map_union_equiv }
end

lemma abs_dvd (x y : znum) : _root_.abs x ∣ y ↔ x ∣ y :=
begin rw [← dvd_to_int, ← dvd_to_int, abs_to_int'], apply int.abs_dvd end

lemma dvd_lcm_left (x y : znum) : x ∣ lcm x y :=
begin rw [← dvd_to_int, lcm_to_int'], apply int.dvd_lcm_left end

lemma dvd_lcm_right (x y : znum) : y ∣ lcm x y :=
begin rw [← dvd_to_int, lcm_to_int'], apply int.dvd_lcm_right end

lemma le_mul_of_pos_left {x y : znum} : y ≥ 0 → x > 0 → y ≤ x * y :=
begin
  simp [ge, gt], rw [← le_to_int, ← le_to_int, ← lt_to_int, mul_to_int],
  apply int.le_mul_of_pos_left
end

lemma add_mul_mod_self {a b c : znum} : (a + b * c) % c = a % c :=
begin rw ← @cast_inj int _, simp [mod_to_int] end

lemma exists_min_of_exists_lb {P : znum → Prop} {w : znum} {lb : znum} :
P w → (∀ (x : znum), x < lb → ¬P x) → ∃ (y : znum), P y ∧ ∀ (x : znum), x < y → ¬P x :=
begin
  intros hw hlb,
  have h := @int.exists_min_of_exists_lb
    (λ (z : int), P z.to_znum) w.to_int lb.to_int _ _,
  { cases h with k hk, cases hk with hk1 hk2, existsi k.to_znum,
    constructor, apply hk1, intros m hm1 hm2, apply (hk2 m.to_int _ _),
    { rw ← lt_to_int at hm1, simp [int.to_znum] at hm1, apply hm1 },
    { simp [int.to_znum, to_int], apply hm2 } },
    { simp [int.to_znum, to_int], apply hw } ,
  { intros k hk1 hk2, apply hlb k.to_znum _ hk2,
    rw ← lt_to_int, simp [int.to_znum], apply hk1 }
end

lemma mod_nonneg (a : znum) {b : znum} : b ≠ 0 → a % b ≥ 0 :=
begin
  simp [ne, ge], rw [← @cast_inj int _, ← le_to_int, mod_to_int],
  apply int.mod_nonneg,
end

lemma mod_lt (a : znum) {b : znum} : b ≠ 0 → a % b < _root_.abs b :=
begin
  simp [ne], rw [← @cast_inj int _, ← lt_to_int,
    mod_to_int, abs_to_int'], apply int.mod_lt,
end

lemma lt_irrefl (a : znum) : ¬ a < a :=
begin rw ← lt_to_int, apply int.lt_irrefl end

lemma div_mul_cancel {a b : znum} (h : b ∣ a) : a / b * b = a :=
begin
  rw [← (@cast_inj int _), mul_to_int, div_to_int],
  apply int.div_mul_cancel, rw dvd_to_int, apply h
end

lemma div_mul_comm (x y z : znum) :
has_dvd.dvd y x → (x / y) * z = x * z / y :=
begin
  rw [ ← dvd_to_int, ← @cast_inj int _, mul_to_int, div_to_int,
       div_to_int, mul_to_int], apply int.div_mul_comm
end

lemma sign_to_int' {z : znum} :
to_int (sign z) = int.sign z.to_int :=
begin
  cases z, refl,
  { rw (int.sign_eq_one_of_pos _), refl,
    have hgt : 0 < pos z, exact_dec_trivial,
    rw ← lt_to_int at hgt, apply hgt },
  { rw (int.sign_eq_neg_one_of_neg _), refl,
    have hlt : neg z < 0, exact_dec_trivial,
    rw ← lt_to_int at hlt, apply hlt }
end

lemma sign_to_int {z : znum} :
↑(sign z) = int.sign z.to_int := sign_to_int'

theorem sign_eq_one_of_pos {a : znum} (h : 0 < a) : sign a = 1 :=
begin
  rw [ ← @cast_inj int _, sign_to_int],
  apply int.sign_eq_one_of_pos, rw ← lt_to_int at h, apply h
end

theorem sign_eq_zero_iff_zero (a : znum) : sign a = 0 ↔ a = 0 :=
begin
  rw [ ← @cast_inj int _, ← @cast_inj int _, sign_to_int],
  apply int.sign_eq_zero_iff_zero
end

lemma sign_eq_neg_one_of_neg {a : znum} (h : a < 0) : sign a = -1 :=
begin
  rw [ ← @cast_inj int _, neg_to_int', sign_to_int],
  apply int.sign_eq_neg_one_of_neg, rw ← lt_to_int at h, apply h
end

lemma sign_eq_div_abs (a : znum) : sign a = a / (_root_.abs a) :=
begin
  rw [ ← @cast_inj int _, sign_to_int, div_to_int, abs_to_int'],
  apply int.sign_eq_div_abs
end

lemma mul_div_assoc (a b c : znum) : c ∣ b → (a * b) / c = a * (b / c) :=
begin
  rw [← dvd_to_int, ← @cast_inj int, mul_to_int],
  rw [div_to_int, div_to_int, mul_to_int], apply int.mul_div_assoc
end

lemma mul_le_mul_iff_le_of_pos_left (x y z : znum) :
  z > 0 → (z * x ≤ z * y ↔ x ≤ y) :=
begin
  simp [gt], rw [← lt_to_int, ← le_to_int, ← le_to_int,
    mul_to_int, mul_to_int], apply int.mul_le_mul_iff_le_of_pos_left,
end

lemma div_pos_of_pos_of_dvd {a b : znum} :
a > 0 → b ≥ 0 → b ∣ a → a / b > 0 :=
begin
  simp [ge, gt],
  rw [← lt_to_int, ← lt_to_int, ← le_to_int, ← dvd_to_int, div_to_int],
  apply int.div_pos_of_pos_of_dvd,
end

lemma eq_to_int {x y : znum} :
x.to_int = y.to_int ↔ x = y :=
begin rw ← @cast_inj int, refl end

lemma mul_to_int' {x y : znum} :
(x * y).to_int = x.to_int * y.to_int :=
begin simp [to_int] end

lemma add_to_int {x y : znum} :
(x + y).to_int = x.to_int + y.to_int :=
begin simp [to_int] end

lemma div_to_int' {x y : znum} :
(x / y).to_int = x.to_int / y.to_int :=
begin simp [to_int] end

lemma ne_to_int {x y : znum} :
x.to_int ≠ y.to_int ↔ x ≠ y :=
begin simp [to_int] end

lemma mul_div_cancel_left {a : znum} (b : znum) (h : a ≠ 0) : a * b / a = b :=
begin
  rw [← eq_to_int, div_to_int', mul_to_int'],
  apply int.mul_div_cancel_left, rw ← ne_to_int at h, apply h
end

lemma dvd_to_int' {m n : znum} :
has_dvd.dvd m.to_int n.to_int ↔ has_dvd.dvd m n :=
begin simp [to_int] end

lemma dvd_iff_exists (x y) :
  has_dvd.dvd x y ↔ ∃ (z : znum), z * x = y :=
begin
  constructor; intro h,
  { rw [← dvd_to_int, int.dvd_iff_exists] at h,
    cases h with z hz, existsi z.to_znum,
    rw [← eq_to_int, mul_to_int', int.to_znum_to_int],
    apply hz },
  { cases h with z hz,
    rw [← eq_to_int, mul_to_int'] at hz,
    rw [← dvd_to_int', int.dvd_iff_exists],
    existsi z.to_int, apply hz }
end

lemma sign_trichotomy (z : znum) :
  sign z = -1 ∨ sign z = 0 ∨ sign z = 1 :=
begin
  repeat {rw [← eq_to_int]},
  repeat {rw [sign_to_int']},
  apply int.sign_trichotomy
end

lemma le_to_int' {m n : znum} : m.to_int ≤ n.to_int ↔ m ≤ n :=
begin simp [to_int] end

lemma lt_to_int' {m n : znum} : m.to_int < n.to_int ↔ m < n :=
begin simp [to_int] end

lemma add_one_le_iff {a b : znum} : a + 1 ≤ b ↔ a < b :=
begin
  rw [← le_to_int, ← lt_to_int, cast_add],
  apply int.add_one_le_iff,
end

lemma eq_one_or_eq_neg_one_of_mul_eq_one_left {a b : znum} (h : a * b = 1) : b = 1 ∨ b = -1 :=
begin
  rw [← @cast_inj int, ← @cast_inj int, neg_to_int'],
  simp [to_int], rw [← @cast_inj int, mul_to_int] at h,
  apply int.eq_one_or_eq_neg_one_of_mul_eq_one_left h
end

lemma eq_one_or_eq_neg_one_of_mul_eq_neg_one_left {a b : znum} (h : a * b = -1) : b = 1 ∨ b = -1 :=
begin
  rw [← @cast_inj int, ← @cast_inj int, neg_to_int'],
  simp [to_int], rw [← @cast_inj int, mul_to_int, neg_to_int'] at h,
  simp [to_int] at h, apply int.eq_one_or_eq_neg_one_of_mul_eq_neg_one_left h
end

end znum

lemma int.le_to_znum {x y : int} :
x.to_znum ≤ y.to_znum ↔ x ≤ y :=
begin rw [← znum.le_to_int', int.to_znum_to_int, int.to_znum_to_int] end

lemma nat.to_znum_nonneg {n : nat} : 0 ≤ n.to_znum :=
begin
  simp [nat.to_znum], rw [← znum.le_to_int', int.to_znum_to_int],
  apply nat.to_int_nonneg
end

namespace num

lemma le_to_nat' {m n : num} : m.to_nat ≤ n.to_nat ↔ m ≤ n :=
begin simp [to_nat] end

lemma le_to_znum' {m n : num} : m.to_znum ≤ n.to_znum ↔ m ≤ n :=
begin
  rw [← znum.le_to_int', to_znum_to_int_eq',
    to_znum_to_int_eq', ← le_to_nat'], apply nat.le_to_int',
end

lemma add_to_nat' : ∀ {m n : num}, (m + n).to_nat = m.to_nat + n.to_nat :=
begin simp [to_nat] end

lemma add_to_znum' : ∀ {m n : num}, (m + n).to_znum = m.to_znum + n.to_znum :=
begin
  intros m n, rw [← @znum.cast_inj int _, znum.cast_add],
  repeat {rw to_znum_to_int_eq}, rw [add_to_nat', nat.add_to_int']
end

end num


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek
-/

/-
Definition of linear constrain clauses.
-/

import data.list.basic
import tactic.omega.term

namespace omega

/-- (([t₁,...tₘ],[s₁,...,sₙ]) : clause) encodes the constraints
0 = ⟦t₁⟧ ∧ ... ∧ 0 = ⟦tₘ⟧ ∧ 0 ≤ ⟦s₁⟧ ∧ ... ∧ 0 ≤ ⟦sₙ⟧, where
⟦t⟧ is the value of (t : term). -/
@[reducible] def clause := (list term) × (list term)

namespace clause

/-- holds v c := clause c holds under valuation v -/
def holds (v : nat → int) : clause → Prop
| (eqs,les) :=
  ( (∀ t : term, t ∈ eqs → 0 = term.val v t)
    ∧ (∀ t : term, t ∈ les → 0 ≤ term.val v t) )

/-- sat c := there exists a valuation v under which c holds -/
def sat (c : clause) : Prop :=
  ∃ v : nat → int, holds v c

/-- unsat c := there is no valuation v under which c holds -/
def unsat (c : clause) : Prop := ¬ c.sat

/-- append two clauses by elementwise appending -/
def append (c1 c2 : clause) : clause :=
(c1.fst ++ c2.fst, c1.snd ++ c2.snd)

lemma holds_append {v : nat → int} {c1 c2 : clause} :
holds v c1 → holds v c2 → holds v (append c1 c2) :=
begin
  intros h1 h2,
  cases c1 with eqs1 les1,
  cases c2 with eqs2 les2,
  cases h1, cases h2,
  constructor; rw list.forall_mem_append;
  constructor; assumption,
end

end clause

/-- There exists a satisfiable clause c in argument -/
def clauses.sat (cs : list clause) : Prop :=
∃ c ∈ cs, clause.sat c

/-- There is no satisfiable clause c in argument -/
def clauses.unsat (cs : list clause) : Prop := ¬ clauses.sat cs

lemma clauses.unsat_nil : clauses.unsat [] :=
begin intro h1, rcases h1 with ⟨c,h1,h2⟩, cases h1 end

lemma clauses.unsat_cons (c : clause) (cs : list clause) :
  clause.unsat c → clauses.unsat cs →
  clauses.unsat (c::cs) | h1 h2 h3 :=
begin
  unfold clauses.sat at h3,
  rw list.exists_mem_cons_iff at h3,
  cases h3; contradiction,
end

end omega


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Gabriel Ebner
-/
import data.nat.cast.defs

/-!
# Cast of integers

This file defines the *canonical* homomorphism from the integers into an
additive group with a one (typically a `ring`).  In additive groups with a one
element, there exists a unique such homomorphism and we store it in the
`int_cast : ℤ → R` field.

Preferentially, the homomorphism is written as a coercion.

## Main declarations

* `int.cast`: Canonical homomorphism `ℤ → R`.
* `add_group_with_one`: Type class for `int.cast`.
-/

universes u
set_option old_structure_cmd true

attribute [simp] int.of_nat_eq_coe

/-- Default value for `add_group_with_one.int_cast`. -/
protected def int.cast_def {R : Type u} [has_nat_cast R] [has_neg R] : ℤ → R
| (n : ℕ) := n
| -[1+ n] := -(n+1 : ℕ)

/--
Type class for the canonical homomorphism `ℤ → R`.
-/
class has_int_cast (R : Type u) :=
(int_cast : ℤ → R)

/--
An `add_group_with_one` is an `add_group` with a `1`.
It also contains data for the unique homomorphisms `ℕ → R` and `ℤ → R`.
-/
@[protect_proj]
class add_group_with_one (R : Type u)
  extends has_int_cast R, add_group R, add_monoid_with_one R :=
(int_cast := int.cast_def)
(int_cast_of_nat : ∀ n : ℕ, int_cast n = (n : R) . control_laws_tac)
(int_cast_neg_succ_of_nat : ∀ n : ℕ, int_cast (-(n+1 : ℕ)) = -((n+1 : ℕ) : R) . control_laws_tac)

/-- An `add_comm_group_with_one` is an `add_group_with_one` satisfying `a + b = b + a`. -/
@[protect_proj]
class add_comm_group_with_one (R : Type u) extends add_comm_group R, add_group_with_one R

/-- Canonical homomorphism from the integers to any ring(-like) structure `R` -/
protected def int.cast {R : Type u} [has_int_cast R] (i : ℤ) : R := has_int_cast.int_cast i

namespace nat
variables {R : Type u} [add_group_with_one R]

@[simp, norm_cast] theorem cast_sub {m n} (h : m ≤ n) : ((n - m : ℕ) : R) = n - m :=
eq_sub_of_add_eq $ by rw [← cast_add, nat.sub_add_cancel h]

@[simp, norm_cast] theorem cast_pred : ∀ {n}, 0 < n → ((n - 1 : ℕ) : R) = n - 1
| 0 h := by cases h
| (n+1) h := by rw [cast_succ, add_sub_cancel]; refl

end nat

open nat

namespace int
variables {R : Type u} [add_group_with_one R]

-- see Note [coercion into rings]
@[priority 900] instance cast_coe {R} [has_int_cast R] : has_coe_t ℤ R := ⟨int.cast⟩

theorem cast_of_nat (n : ℕ) : (of_nat n : R) = n := add_group_with_one.int_cast_of_nat n
@[simp] theorem cast_neg_succ_of_nat (n : ℕ) : (-[1+ n] : R) = -(n + 1 : ℕ) :=
add_group_with_one.int_cast_neg_succ_of_nat n

@[simp, norm_cast] theorem cast_zero : ((0 : ℤ) : R) = 0 := (cast_of_nat 0).trans nat.cast_zero

@[simp, norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℤ) : R) = n := cast_of_nat _

@[simp, norm_cast] theorem cast_one : ((1 : ℤ) : R) = 1 :=
show (((1 : ℕ) : ℤ) : R) = 1, by simp

@[simp, norm_cast] theorem cast_neg : ∀ n, ((-n : ℤ) : R) = -n
| (0 : ℕ) := by erw [cast_zero, neg_zero]
| (n + 1 : ℕ) := by erw [cast_of_nat, cast_neg_succ_of_nat]; refl
| -[1+ n] := by erw [cast_of_nat, cast_neg_succ_of_nat, neg_neg]

@[simp] theorem cast_sub_nat_nat (m n) :
  ((int.sub_nat_nat m n : ℤ) : R) = m - n :=
begin
  unfold sub_nat_nat, cases e : n - m,
  { simp only [sub_nat_nat, cast_of_nat], simp [e, nat.le_of_sub_eq_zero e] },
  { rw [sub_nat_nat, cast_neg_succ_of_nat, nat.add_one, ← e,
        nat.cast_sub $ _root_.le_of_lt $ nat.lt_of_sub_eq_succ e, neg_sub] },
end

lemma neg_of_nat_eq (n : ℕ) : neg_of_nat n = -(n : ℤ) := by cases n; refl

@[simp] theorem cast_neg_of_nat (n : ℕ) : ((neg_of_nat n : ℤ) : R) = -n :=
by simp [neg_of_nat_eq]

@[simp, norm_cast] theorem cast_add : ∀ m n, ((m + n : ℤ) : R) = m + n
| (m : ℕ) (n : ℕ) := by simp [← int.coe_nat_add]
| (m : ℕ) -[1+ n] := by erw [cast_sub_nat_nat, cast_coe_nat, cast_neg_succ_of_nat, sub_eq_add_neg]
| -[1+ m] (n : ℕ) := by erw [cast_sub_nat_nat, cast_coe_nat, cast_neg_succ_of_nat,
  sub_eq_iff_eq_add, add_assoc, eq_neg_add_iff_add_eq, ← nat.cast_add, ← nat.cast_add, nat.add_comm]
| -[1+ m] -[1+ n] := show (-[1+ m + n + 1] : R) = _,
  by rw [cast_neg_succ_of_nat, cast_neg_succ_of_nat, cast_neg_succ_of_nat, ← neg_add_rev,
    ← nat.cast_add, nat.add_right_comm m n 1, nat.add_assoc, nat.add_comm]

@[simp, norm_cast] theorem cast_sub (m n) : ((m - n : ℤ) : R) = m - n :=
by simp [int.sub_eq_add_neg, sub_eq_add_neg]

@[simp, norm_cast]
theorem coe_nat_bit0 (n : ℕ) : (↑(bit0 n) : ℤ) = bit0 ↑n := rfl

@[simp, norm_cast]
theorem coe_nat_bit1 (n : ℕ) : (↑(bit1 n) : ℤ) = bit1 ↑n := rfl

@[simp, norm_cast] theorem cast_bit0 (n : ℤ) : ((bit0 n : ℤ) : R) = bit0 n :=
cast_add _ _

@[simp, norm_cast] theorem cast_bit1 (n : ℤ) : ((bit1 n : ℤ) : R) = bit1 n :=
by rw [bit1, cast_add, cast_one, cast_bit0]; refl

lemma cast_two : ((2 : ℤ) : R) = 2 := by simp

lemma cast_three : ((3 : ℤ) : R) = 3 := by simp

lemma cast_four : ((4 : ℤ) : R) = 4 := by simp

end int


/-
Copyright (c) 2019 Calle Sönne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Calle Sönne
-/
import analysis.special_functions.trigonometric.basic

/-!
# The type of angles

In this file we define `real.angle` to be the quotient group `ℝ/2πℤ` and prove a few simple lemmas
about trigonometric functions and angles.
-/

open_locale real

noncomputable theory

namespace real

/-- The type of angles -/
def angle : Type :=
ℝ ⧸ (add_subgroup.zmultiples (2 * π))

namespace angle

instance angle.add_comm_group : add_comm_group angle :=
quotient_add_group.add_comm_group _

instance : inhabited angle := ⟨0⟩

instance : has_coe ℝ angle := ⟨quotient_add_group.mk' _⟩

/-- Coercion `ℝ → angle` as an additive homomorphism. -/
def coe_hom : ℝ →+ angle := quotient_add_group.mk' _

@[simp] lemma coe_coe_hom : (coe_hom : ℝ → angle) = coe := rfl

@[simp] lemma coe_zero : ↑(0 : ℝ) = (0 : angle) := rfl
@[simp] lemma coe_add (x y : ℝ) : ↑(x + y : ℝ) = (↑x + ↑y : angle) := rfl
@[simp] lemma coe_neg (x : ℝ) : ↑(-x : ℝ) = -(↑x : angle) := rfl
@[simp] lemma coe_sub (x y : ℝ) : ↑(x - y : ℝ) = (↑x - ↑y : angle) := rfl

@[simp, norm_cast] lemma coe_nat_mul_eq_nsmul (x : ℝ) (n : ℕ) :
  ↑((n : ℝ) * x) = n • (↑x : angle) :=
by simpa only [nsmul_eq_mul] using coe_hom.map_nsmul x n

@[simp, norm_cast] lemma coe_int_mul_eq_zsmul (x : ℝ) (n : ℤ) :
  ↑((n : ℝ) * x : ℝ) = n • (↑x : angle) :=
by simpa only [zsmul_eq_mul] using coe_hom.map_zsmul x n

lemma angle_eq_iff_two_pi_dvd_sub {ψ θ : ℝ} : (θ : angle) = ψ ↔ ∃ k : ℤ, θ - ψ = 2 * π * k :=
by simp only [quotient_add_group.eq, add_subgroup.zmultiples_eq_closure,
  add_subgroup.mem_closure_singleton, zsmul_eq_mul', (sub_eq_neg_add _ _).symm, eq_comm]

@[simp] lemma coe_two_pi : ↑(2 * π : ℝ) = (0 : angle) :=
angle_eq_iff_two_pi_dvd_sub.2 ⟨1, by rw [sub_zero, int.cast_one, mul_one]⟩

@[simp] lemma neg_coe_pi : -(π : angle) = π :=
begin
  rw [←coe_neg, angle_eq_iff_two_pi_dvd_sub],
  use -1,
  simp [two_mul, sub_eq_add_neg]
end

lemma sub_coe_pi_eq_add_coe_pi (θ : angle) : θ - π = θ + π :=
by rw [sub_eq_add_neg, neg_coe_pi]

@[simp] lemma two_nsmul_coe_pi : (2 : ℕ) • (π : angle) = 0 :=
by simp [←coe_nat_mul_eq_nsmul]

@[simp] lemma two_zsmul_coe_pi : (2 : ℤ) • (π : angle) = 0 :=
by simp [←coe_int_mul_eq_zsmul]

theorem cos_eq_iff_eq_or_eq_neg {θ ψ : ℝ} : cos θ = cos ψ ↔ (θ : angle) = ψ ∨ (θ : angle) = -ψ :=
begin
  split,
  { intro Hcos,
    rw [← sub_eq_zero, cos_sub_cos, mul_eq_zero, mul_eq_zero, neg_eq_zero,
        eq_false_intro two_ne_zero, false_or, sin_eq_zero_iff, sin_eq_zero_iff] at Hcos,
    rcases Hcos with ⟨n, hn⟩ | ⟨n, hn⟩,
    { right,
      rw [eq_div_iff_mul_eq (@two_ne_zero ℝ _ _), ← sub_eq_iff_eq_add] at hn,
      rw [← hn, coe_sub, eq_neg_iff_add_eq_zero, sub_add_cancel, mul_assoc,
          coe_int_mul_eq_zsmul, mul_comm, coe_two_pi, zsmul_zero] },
    { left,
      rw [eq_div_iff_mul_eq (@two_ne_zero ℝ _ _), eq_sub_iff_add_eq] at hn,
      rw [← hn, coe_add, mul_assoc,
          coe_int_mul_eq_zsmul, mul_comm, coe_two_pi, zsmul_zero, zero_add] },
    apply_instance, },
  { rw [angle_eq_iff_two_pi_dvd_sub, ← coe_neg, angle_eq_iff_two_pi_dvd_sub],
    rintro (⟨k, H⟩ | ⟨k, H⟩),
    rw [← sub_eq_zero, cos_sub_cos, H, mul_assoc 2 π k,
        mul_div_cancel_left _ (@two_ne_zero ℝ _ _), mul_comm π _, sin_int_mul_pi, mul_zero],
    rw [← sub_eq_zero, cos_sub_cos, ← sub_neg_eq_add, H, mul_assoc 2 π k,
        mul_div_cancel_left _ (@two_ne_zero ℝ _ _), mul_comm π _, sin_int_mul_pi, mul_zero,
        zero_mul] }
end

theorem sin_eq_iff_eq_or_add_eq_pi {θ ψ : ℝ} :
  sin θ = sin ψ ↔ (θ : angle) = ψ ∨ (θ : angle) + ψ = π :=
begin
  split,
  { intro Hsin, rw [← cos_pi_div_two_sub, ← cos_pi_div_two_sub] at Hsin,
    cases cos_eq_iff_eq_or_eq_neg.mp Hsin with h h,
    { left, rw [coe_sub, coe_sub] at h, exact sub_right_inj.1 h },
      right, rw [coe_sub, coe_sub, eq_neg_iff_add_eq_zero, add_sub,
      sub_add_eq_add_sub, ← coe_add, add_halves, sub_sub, sub_eq_zero] at h,
    exact h.symm },
  { rw [angle_eq_iff_two_pi_dvd_sub, ←eq_sub_iff_add_eq, ←coe_sub, angle_eq_iff_two_pi_dvd_sub],
    rintro (⟨k, H⟩ | ⟨k, H⟩),
    rw [← sub_eq_zero, sin_sub_sin, H, mul_assoc 2 π k,
         mul_div_cancel_left _ (@two_ne_zero ℝ _ _), mul_comm π _, sin_int_mul_pi, mul_zero,
         zero_mul],
    have H' : θ + ψ = (2 * k) * π + π := by rwa [←sub_add, sub_add_eq_add_sub, sub_eq_iff_eq_add,
      mul_assoc, mul_comm π _, ←mul_assoc] at H,
    rw [← sub_eq_zero, sin_sub_sin, H', add_div, mul_assoc 2 _ π,
        mul_div_cancel_left _ (@two_ne_zero ℝ _ _), cos_add_pi_div_two, sin_int_mul_pi, neg_zero,
        mul_zero] }
end

theorem cos_sin_inj {θ ψ : ℝ} (Hcos : cos θ = cos ψ) (Hsin : sin θ = sin ψ) : (θ : angle) = ψ :=
begin
  cases cos_eq_iff_eq_or_eq_neg.mp Hcos with hc hc, { exact hc },
  cases sin_eq_iff_eq_or_add_eq_pi.mp Hsin with hs hs, { exact hs },
  rw [eq_neg_iff_add_eq_zero, hs] at hc,
  cases quotient.exact' hc with n hn, change n • _ = _ at hn,
  rw [← neg_one_mul, add_zero, ← sub_eq_zero, zsmul_eq_mul, ← mul_assoc, ← sub_mul,
      mul_eq_zero, eq_false_intro (ne_of_gt pi_pos), or_false, sub_neg_eq_add,
      ← int.cast_zero, ← int.cast_one, ← int.cast_bit0, ← int.cast_mul, ← int.cast_add,
      int.cast_inj] at hn,
  have : (n * 2 + 1) % (2:ℤ) = 0 % (2:ℤ) := congr_arg (%(2:ℤ)) hn,
  rw [add_comm, int.add_mul_mod_self] at this,
  exact absurd this one_ne_zero
end

end angle

end real


/-
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 order.omega_complete_partial_order
! leanprover-community/mathlib commit 92ca63f0fb391a9ca5f22d2409a6080e786d99f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Control.Monad.Basic
import Mathlib.Data.Part
import Mathlib.Order.Hom.Order
import Mathlib.Data.Nat.Order.Basic

/-!
# Omega Complete Partial Orders

An omega-complete partial order is a partial order with a supremum
operation on increasing sequences indexed by natural numbers (which we
call `ωSup`). In this sense, it is strictly weaker than join complete
semi-lattices as only ω-sized totally ordered sets have a supremum.

The concept of an omega-complete partial order (ωCPO) is useful for the
formalization of the semantics of programming languages. Its notion of
supremum helps define the meaning of recursive procedures.

## Main definitions

 * class `OmegaCompletePartialOrder`
 * `ite`, `map`, `bind`, `seq` as continuous morphisms

## Instances of `OmegaCompletePartialOrder`

 * `Part`
 * every `CompleteLattice`
 * pi-types
 * product types
 * `OrderHom`
 * `ContinuousHom` (with notation →𝒄)
   * an instance of `OmegaCompletePartialOrder (α →𝒄 β)`
 * `ContinuousHom.ofFun`
 * `ContinuousHom.ofMono`
 * continuous functions:
   * `id`
   * `ite`
   * `const`
   * `Part.bind`
   * `Part.map`
   * `Part.seq`

## References

 * [Chain-complete posets and directed sets with applications][markowsky1976]
 * [Recursive definitions of partial functions and their computations][cadiou1972]
 * [Semantics of Programming Languages: Structures and Techniques][gunter1992]
-/

universe u v

-- porting note: can this really be a good idea?
attribute [-simp] Part.bind_eq_bind Part.map_eq_map

open Classical

namespace OrderHom

variable {α : Type _} {β : Type _} {γ : Type _}
variable [Preorder α] [Preorder β] [Preorder γ]

/-- `Part.bind` as a monotone function -/
@[simps]
def bind {β γ} (f : α →o Part β) (g : α →o β → Part γ) : α →o Part γ where
  toFun x := f x >>= g x
  monotone' := by
    intro x y h a
    simp only [and_imp, exists_prop, Part.bind_eq_bind, Part.mem_bind_iff, exists_imp]
    intro b hb ha
    refine' ⟨b, f.monotone h _ hb, g.monotone h _ _ ha⟩
#align order_hom.bind OrderHom.bind
#align order_hom.bind_coe OrderHom.bind_coe

end OrderHom

namespace OmegaCompletePartialOrder

/-- A chain is a monotone sequence.

See the definition on page 114 of [gunter1992]. -/
def Chain (α : Type u) [Preorder α] :=
  ℕ →o α
#align omega_complete_partial_order.chain OmegaCompletePartialOrder.Chain

namespace Chain

variable {α : Type u} {β : Type v} {γ : Type _}
variable [Preorder α] [Preorder β] [Preorder γ]

instance : CoeFun (Chain α) fun _ => ℕ → α := ⟨OrderHom.toFun⟩

instance [Inhabited α] : Inhabited (Chain α) :=
  ⟨⟨default, fun _ _ _ => le_rfl⟩⟩

instance : Membership α (Chain α) :=
  ⟨fun a (c : ℕ →o α) => ∃ i, a = c i⟩

variable (c c' : Chain α)
variable (f : α →o β)
variable (g : β →o γ)

instance : LE (Chain α) where le x y := ∀ i, ∃ j, x i ≤ y j

/-- `map` function for `Chain` -/
@[simps! (config := { fullyApplied := false })]
def map : Chain β :=
  f.comp c
#align omega_complete_partial_order.chain.map OmegaCompletePartialOrder.Chain.map
#align omega_complete_partial_order.chain.map_coe OmegaCompletePartialOrder.Chain.map_coe

variable {f}

theorem mem_map (x : α) : x ∈ c → f x ∈ Chain.map c f :=
  fun ⟨i, h⟩ => ⟨i, h.symm ▸ rfl⟩
#align omega_complete_partial_order.chain.mem_map OmegaCompletePartialOrder.Chain.mem_map

theorem exists_of_mem_map {b : β} : b ∈ c.map f → ∃ a, a ∈ c ∧ f a = b :=
  fun ⟨i, h⟩ => ⟨c i, ⟨i, rfl⟩, h.symm⟩
#align
  omega_complete_partial_order.chain.exists_of_mem_map
  OmegaCompletePartialOrder.Chain.exists_of_mem_map

theorem mem_map_iff {b : β} : b ∈ c.map f ↔ ∃ a, a ∈ c ∧ f a = b :=
  ⟨exists_of_mem_map _, fun h => by
    rcases h with ⟨w, h, h'⟩
    subst b
    apply mem_map c _ h⟩
#align omega_complete_partial_order.chain.mem_map_iff OmegaCompletePartialOrder.Chain.mem_map_iff

@[simp]
theorem map_id : c.map OrderHom.id = c :=
  OrderHom.comp_id _
#align omega_complete_partial_order.chain.map_id OmegaCompletePartialOrder.Chain.map_id

theorem map_comp : (c.map f).map g = c.map (g.comp f) :=
  rfl
#align omega_complete_partial_order.chain.map_comp OmegaCompletePartialOrder.Chain.map_comp

@[mono]
theorem map_le_map {g : α →o β} (h : f ≤ g) : c.map f ≤ c.map g :=
  fun i => by simp [mem_map_iff]; intros; exists i; apply h
#align omega_complete_partial_order.chain.map_le_map OmegaCompletePartialOrder.Chain.map_le_map

/-- `chain.zip` pairs up the elements of two chains that have the same index -/
@[simps!]
def zip (c₀ : Chain α) (c₁ : Chain β) : Chain (α × β) :=
  OrderHom.prod c₀ c₁
#align omega_complete_partial_order.chain.zip OmegaCompletePartialOrder.Chain.zip
#align omega_complete_partial_order.chain.zip_coe OmegaCompletePartialOrder.Chain.zip_coe

end Chain

end OmegaCompletePartialOrder

open OmegaCompletePartialOrder

-- porting note: removed "set_option extends_priority 50"

/-- An omega-complete partial order is a partial order with a supremum
operation on increasing sequences indexed by natural numbers (which we
call `ωSup`). In this sense, it is strictly weaker than join complete
semi-lattices as only ω-sized totally ordered sets have a supremum.

See the definition on page 114 of [gunter1992]. -/
class OmegaCompletePartialOrder (α : Type _) extends PartialOrder α where
  /-- The supremum of an increasing sequence -/
  ωSup : Chain α → α
  /-- `ωSup` is an upper bound of the increasing sequence -/
  le_ωSup : ∀ c : Chain α, ∀ i, c i ≤ ωSup c
  /-- `ωSup` is a lower bound of the set of upper bounds of the increasing sequence -/
  ωSup_le : ∀ (c : Chain α) (x), (∀ i, c i ≤ x) → ωSup c ≤ x
#align omega_complete_partial_order OmegaCompletePartialOrder

namespace OmegaCompletePartialOrder

variable {α : Type u} {β : Type v} {γ : Type _}

variable [OmegaCompletePartialOrder α]

/-- Transfer a `OmegaCompletePartialOrder` on `β` to a `OmegaCompletePartialOrder` on `α`
using a strictly monotone function `f : β →o α`, a definition of ωSup and a proof that `f` is
continuous with regard to the provided `ωSup` and the ωCPO on `α`. -/
@[reducible]
protected def lift [PartialOrder β] (f : β →o α) (ωSup₀ : Chain β → β)
    (h : ∀ x y, f x ≤ f y → x ≤ y) (h' : ∀ c, f (ωSup₀ c) = ωSup (c.map f)) :
    OmegaCompletePartialOrder β where
  ωSup := ωSup₀
  ωSup_le c x hx := h _ _ (by rw [h']; apply ωSup_le; intro i; apply f.monotone (hx i))
  le_ωSup c i := h _ _ (by rw [h']; apply le_ωSup (c.map f))
#align omega_complete_partial_order.lift OmegaCompletePartialOrder.lift

theorem le_ωSup_of_le {c : Chain α} {x : α} (i : ℕ) (h : x ≤ c i) : x ≤ ωSup c :=
  le_trans h (le_ωSup c _)
#align omega_complete_partial_order.le_ωSup_of_le OmegaCompletePartialOrder.le_ωSup_of_le

theorem ωSup_total {c : Chain α} {x : α} (h : ∀ i, c i ≤ x ∨ x ≤ c i) : ωSup c ≤ x ∨ x ≤ ωSup c :=
  by_cases
    (fun (this : ∀ i, c i ≤ x) => Or.inl (ωSup_le _ _ this))
    (fun (this : ¬∀ i, c i ≤ x) =>
      have : ∃ i, ¬c i ≤ x := by simp only [not_forall] at this ⊢; assumption
      let ⟨i, hx⟩ := this
      have : x ≤ c i := (h i).resolve_left hx
      Or.inr <| le_ωSup_of_le _ this)
#align omega_complete_partial_order.ωSup_total OmegaCompletePartialOrder.ωSup_total

@[mono]
theorem ωSup_le_ωSup_of_le {c₀ c₁ : Chain α} (h : c₀ ≤ c₁) : ωSup c₀ ≤ ωSup c₁ :=
  (ωSup_le _ _) fun i => by
    obtain ⟨_, h⟩ := h i
    exact le_trans h (le_ωSup _ _)
#align omega_complete_partial_order.ωSup_le_ωSup_of_le OmegaCompletePartialOrder.ωSup_le_ωSup_of_le

theorem ωSup_le_iff (c : Chain α) (x : α) : ωSup c ≤ x ↔ ∀ i, c i ≤ x := by
  constructor <;> intros
  · trans ωSup c
    exact le_ωSup _ _
    assumption
  exact ωSup_le _ _ ‹_›
#align omega_complete_partial_order.ωSup_le_iff OmegaCompletePartialOrder.ωSup_le_iff

/-- A subset `p : α → Prop` of the type closed under `ωSup` induces an
`OmegaCompletePartialOrder` on the subtype `{a : α // p a}`. -/
def subtype {α : Type _} [OmegaCompletePartialOrder α] (p : α → Prop)
    (hp : ∀ c : Chain α, (∀ i ∈ c, p i) → p (ωSup c)) : OmegaCompletePartialOrder (Subtype p) :=
  OmegaCompletePartialOrder.lift (OrderHom.Subtype.val p)
    (fun c => ⟨ωSup _, hp (c.map (OrderHom.Subtype.val p)) fun _ ⟨n, q⟩ => q.symm ▸ (c n).2⟩)
    (fun _ _ h => h) (fun _ => rfl)
#align omega_complete_partial_order.subtype OmegaCompletePartialOrder.subtype

section Continuity

open Chain

variable [OmegaCompletePartialOrder β]
variable [OmegaCompletePartialOrder γ]

/-- A monotone function `f : α →o β` is continuous if it distributes over ωSup.

In order to distinguish it from the (more commonly used) continuity from topology
(see topology/basic.lean), the present definition is often referred to as
"Scott-continuity" (referring to Dana Scott). It corresponds to continuity
in Scott topological spaces (not defined here). -/
def Continuous (f : α →o β) : Prop :=
  ∀ c : Chain α, f (ωSup c) = ωSup (c.map f)
#align omega_complete_partial_order.continuous OmegaCompletePartialOrder.Continuous

/-- `Continuous' f` asserts that `f` is both monotone and continuous. -/
def Continuous' (f : α → β) : Prop :=
  ∃ hf : Monotone f, Continuous ⟨f, hf⟩
#align omega_complete_partial_order.continuous' OmegaCompletePartialOrder.Continuous'

theorem Continuous'.to_monotone {f : α → β} (hf : Continuous' f) : Monotone f :=
  hf.fst
#align
  omega_complete_partial_order.continuous'.to_monotone
  OmegaCompletePartialOrder.Continuous'.to_monotone

theorem Continuous.of_bundled (f : α → β) (hf : Monotone f) (hf' : Continuous ⟨f, hf⟩) :
    Continuous' f :=
  ⟨hf, hf'⟩
#align
  omega_complete_partial_order.continuous.of_bundled
  OmegaCompletePartialOrder.Continuous.of_bundled

theorem Continuous.of_bundled' (f : α →o β) (hf' : Continuous f) : Continuous' f :=
  ⟨f.mono, hf'⟩
#align
  omega_complete_partial_order.continuous.of_bundled'
  OmegaCompletePartialOrder.Continuous.of_bundled'

theorem Continuous'.to_bundled (f : α → β) (hf : Continuous' f) : Continuous ⟨f, hf.to_monotone⟩ :=
  hf.snd
#align
  omega_complete_partial_order.continuous'.to_bundled
  OmegaCompletePartialOrder.Continuous'.to_bundled

@[simp, norm_cast]
theorem continuous'_coe : ∀ {f : α →o β}, Continuous' f ↔ Continuous f
  | ⟨_, hf⟩ => ⟨fun ⟨_, hc⟩ => hc, fun hc => ⟨hf, hc⟩⟩
#align omega_complete_partial_order.continuous'_coe OmegaCompletePartialOrder.continuous'_coe

variable (f : α →o β) (g : β →o γ)

theorem continuous_id : Continuous (@OrderHom.id α _) := by intro c; rw [c.map_id]; rfl
#align omega_complete_partial_order.continuous_id OmegaCompletePartialOrder.continuous_id

theorem continuous_comp (hfc : Continuous f) (hgc : Continuous g) : Continuous (g.comp f) := by
  dsimp [Continuous] at *; intro;
  rw [hfc, hgc, Chain.map_comp]
#align omega_complete_partial_order.continuous_comp OmegaCompletePartialOrder.continuous_comp

theorem id_continuous' : Continuous' (@id α) :=
  continuous_id.of_bundled' _
#align omega_complete_partial_order.id_continuous' OmegaCompletePartialOrder.id_continuous'

theorem continuous_const (x : β) : Continuous (OrderHom.const α x) := fun c =>
  eq_of_forall_ge_iff fun z => by rw [ωSup_le_iff, Chain.map_coe, OrderHom.const_coe_coe]; simp
#align omega_complete_partial_order.continuous_const OmegaCompletePartialOrder.continuous_const

theorem const_continuous' (x : β) : Continuous' (Function.const α x) :=
  Continuous.of_bundled' (OrderHom.const α x) (continuous_const x)
#align omega_complete_partial_order.const_continuous' OmegaCompletePartialOrder.const_continuous'

end Continuity

end OmegaCompletePartialOrder

namespace Part

variable {α : Type u} {β : Type v} {γ : Type _}

open OmegaCompletePartialOrder

theorem eq_of_chain {c : Chain (Part α)} {a b : α} (ha : some a ∈ c) (hb : some b ∈ c) : a = b := by
  cases' ha with i ha; replace ha := ha.symm
  cases' hb with j hb; replace hb := hb.symm
  rw [eq_some_iff] at ha hb
  cases' le_total i j with hij hji
  . have := c.monotone hij _ ha; apply mem_unique this hb
  . have := c.monotone hji _ hb; apply Eq.symm; apply mem_unique this ha
  --Porting note: Old proof
  -- wlog h : i ≤ j := le_total i j using a b i j, b a j i
  -- rw [eq_some_iff] at ha hb
  -- have := c.monotone h _ ha; apply mem_unique this hb
#align part.eq_of_chain Part.eq_of_chain

/-- The (noncomputable) `ωSup` definition for the `ω`-CPO structure on `part α`. -/
protected noncomputable def ωSup (c : Chain (Part α)) : Part α :=
  if h : ∃ a, some a ∈ c then some (Classical.choose h) else none
#align part.ωSup Part.ωSup

theorem ωSup_eq_some {c : Chain (Part α)} {a : α} (h : some a ∈ c) : Part.ωSup c = some a :=
  have : ∃ a, some a ∈ c := ⟨a, h⟩
  have a' : some (Classical.choose this) ∈ c := Classical.choose_spec this
  calc
    Part.ωSup c = some (Classical.choose this) := dif_pos this
    _ = some a := congr_arg _ (eq_of_chain a' h)
#align part.ωSup_eq_some Part.ωSup_eq_some

theorem ωSup_eq_none {c : Chain (Part α)} (h : ¬∃ a, some a ∈ c) : Part.ωSup c = none :=
  dif_neg h
#align part.ωSup_eq_none Part.ωSup_eq_none

noncomputable instance omegaCompletePartialOrder :
    OmegaCompletePartialOrder (Part α) where
  ωSup := Part.ωSup
  le_ωSup c i := by
    intro x hx
    rw [← eq_some_iff] at hx⊢
    rw [ωSup_eq_some, ← hx]
    rw [← hx]
    exact ⟨i, rfl⟩
  ωSup_le := by
    rintro c x hx a ha
    replace ha := mem_chain_of_mem_ωSup ha
    cases' ha with i ha
    apply hx i
    rw [← ha]
    apply mem_some
#align part.omega_complete_partial_order Part.omegaCompletePartialOrder

section Inst

theorem mem_ωSup (x : α) (c : Chain (Part α)) : x ∈ ωSup c ↔ some x ∈ c := by
  simp [OmegaCompletePartialOrder.ωSup, Part.ωSup]
  constructor
  · split_ifs with h
    swap
    rintro ⟨⟨⟩⟩
    intro h'
    have hh := Classical.choose_spec h
    simp at h'
    subst x
    exact hh
  · intro h
    have h' : ∃ a : α, some a ∈ c := ⟨_, h⟩
    rw [dif_pos h']
    have hh := Classical.choose_spec h'
    rw [eq_of_chain hh h]
    simp
#align part.mem_ωSup Part.mem_ωSup

end Inst

end Part

namespace Pi

variable {α : Type _} {β : α → Type _} {γ : Type _}

open OmegaCompletePartialOrder OmegaCompletePartialOrder.Chain

instance [∀ a, OmegaCompletePartialOrder (β a)] :
    OmegaCompletePartialOrder (∀ a, β a) where
  ωSup c a := ωSup (c.map (Pi.evalOrderHom a))
  ωSup_le c f hf a :=
    ωSup_le _ _ <| by
      rintro i
      apply hf
  le_ωSup c i x := le_ωSup_of_le _ <| le_rfl

namespace OmegaCompletePartialOrder

variable [∀ x, OmegaCompletePartialOrder <| β x]
variable [OmegaCompletePartialOrder γ]

theorem flip₁_continuous' (f : ∀ x : α, γ → β x) (a : α) (hf : Continuous' fun x y => f y x) :
    Continuous' (f a) :=
  Continuous.of_bundled _ (fun _ _ h => hf.to_monotone h a) fun c => congr_fun (hf.to_bundled _ c) a
#align
  pi.omega_complete_partial_order.flip₁_continuous' Pi.OmegaCompletePartialOrder.flip₁_continuous'

theorem flip₂_continuous' (f : γ → ∀ x, β x) (hf : ∀ x, Continuous' fun g => f g x) :
    Continuous' f :=
  Continuous.of_bundled _ (fun x y h a => (hf a).to_monotone h)
    (by intro c; ext a; apply (hf a).to_bundled _ c)
#align
  pi.omega_complete_partial_order.flip₂_continuous' Pi.OmegaCompletePartialOrder.flip₂_continuous'

end OmegaCompletePartialOrder

end Pi

namespace Prod

open OmegaCompletePartialOrder

variable {α : Type _} {β : Type _} {γ : Type _}
variable [OmegaCompletePartialOrder α]
variable [OmegaCompletePartialOrder β]
variable [OmegaCompletePartialOrder γ]

/-- The supremum of a chain in the product `ω`-CPO. -/
@[simps]
protected def ωSup (c : Chain (α × β)) : α × β :=
  (ωSup (c.map OrderHom.fst), ωSup (c.map OrderHom.snd))
#align prod.ωSup Prod.ωSup
#align prod.ωSup_snd Prod.ωSup_snd
#align prod.ωSup_fst Prod.ωSup_fst

@[simps! ωSup_fst ωSup_snd]
instance : OmegaCompletePartialOrder (α × β) where
  ωSup := Prod.ωSup
  ωSup_le := fun _ _ h => ⟨ωSup_le _ _ fun i => (h i).1, ωSup_le _ _ fun i => (h i).2⟩
  le_ωSup c i := ⟨le_ωSup (c.map OrderHom.fst) i, le_ωSup (c.map OrderHom.snd) i⟩

theorem ωSup_zip (c₀ : Chain α) (c₁ : Chain β) : ωSup (c₀.zip c₁) = (ωSup c₀, ωSup c₁) := by
  apply eq_of_forall_ge_iff; rintro ⟨z₁, z₂⟩
  simp [ωSup_le_iff, forall_and]
#align prod.ωSup_zip Prod.ωSup_zip

end Prod

open OmegaCompletePartialOrder

namespace CompleteLattice

variable (α : Type u)

-- see Note [lower instance priority]
/-- Any complete lattice has an `ω`-CPO structure where the countable supremum is a special case
of arbitrary suprema. -/
instance (priority := 100) [CompleteLattice α] : OmegaCompletePartialOrder α where
  ωSup c := ⨆ i, c i
  ωSup_le := fun ⟨c, _⟩ s hs => by
    simp only [supᵢ_le_iff, OrderHom.coe_fun_mk] at hs ⊢; intro i; apply hs i
  le_ωSup := fun ⟨c, _⟩ i => by simp only [OrderHom.coe_fun_mk]; apply le_supᵢ_of_le i; rfl

variable {α} {β : Type v} [OmegaCompletePartialOrder α] [CompleteLattice β]

theorem supₛ_continuous (s : Set <| α →o β) (hs : ∀ f ∈ s, Continuous f) : Continuous (supₛ s) := by
  intro c
  apply eq_of_forall_ge_iff
  intro z
  suffices (∀ f ∈ s, ∀ (n), (f : _) (c n) ≤ z) ↔ ∀ (n), ∀ f ∈ s, (f : _) (c n) ≤ z by
    simpa (config := { contextual := true }) [ωSup_le_iff, hs _ _ _] using this
  exact ⟨fun H n f hf => H f hf n, fun H f hf n => H n f hf⟩
#align complete_lattice.Sup_continuous CompleteLattice.supₛ_continuous

theorem supᵢ_continuous {ι : Sort _} {f : ι → α →o β} (h : ∀ i, Continuous (f i)) :
    Continuous (⨆ i, f i) :=
  supₛ_continuous _ <| Set.forall_range_iff.2 h
#align complete_lattice.supr_continuous CompleteLattice.supᵢ_continuous

theorem supₛ_continuous' (s : Set (α → β)) (hc : ∀ f ∈ s, Continuous' f) :
    Continuous' (supₛ s) := by
  lift s to Set (α →o β) using fun f hf => (hc f hf).to_monotone
  simp only [Set.ball_image_iff, continuous'_coe] at hc
  rw [supₛ_image]
  norm_cast
  exact supᵢ_continuous fun f => supᵢ_continuous fun hf => hc f hf
#align complete_lattice.Sup_continuous' CompleteLattice.supₛ_continuous'

theorem sup_continuous {f g : α →o β} (hf : Continuous f) (hg : Continuous g) :
    Continuous (f ⊔ g) := by
  rw [← supₛ_pair]; apply supₛ_continuous
  rintro f (rfl | rfl | _) <;> assumption
#align complete_lattice.sup_continuous CompleteLattice.sup_continuous

theorem top_continuous : Continuous (⊤ : α →o β) := by
  intro c; apply eq_of_forall_ge_iff; intro z
  simp only [OrderHom.instTopOrderHom_top, OrderHom.const_coe_coe, Function.const, top_le_iff,
    ωSup_le_iff, Chain.map_coe, Function.comp, forall_const]
#align complete_lattice.top_continuous CompleteLattice.top_continuous

theorem bot_continuous : Continuous (⊥ : α →o β) := by
  rw [← supₛ_empty]
  exact supₛ_continuous _ fun f hf => hf.elim
#align complete_lattice.bot_continuous CompleteLattice.bot_continuous

end CompleteLattice

namespace CompleteLattice

variable {α β : Type _} [OmegaCompletePartialOrder α] [CompleteLinearOrder β]

theorem inf_continuous (f g : α →o β) (hf : Continuous f) (hg : Continuous g) :
    Continuous (f ⊓ g) := by
  refine' fun c => eq_of_forall_ge_iff fun z => _
  simp only [inf_le_iff, hf c, hg c, ωSup_le_iff, ←forall_or_left, ←forall_or_right,
             Chain.map_coe, OrderHom.coe_inf, ge_iff_le, Pi.inf_apply, Function.comp]
  exact ⟨λ h _ => h _ _, λ h i j => (h (max j i)).imp (le_trans $ f.mono $ c.mono $ le_max_left _ _)
    (le_trans $ g.mono $ c.mono $ le_max_right _ _)⟩
#align complete_lattice.inf_continuous CompleteLattice.inf_continuous

theorem inf_continuous' {f g : α → β} (hf : Continuous' f) (hg : Continuous' g) :
    Continuous' (f ⊓ g) :=
  ⟨_, inf_continuous _ _ hf.snd hg.snd⟩
#align complete_lattice.inf_continuous' CompleteLattice.inf_continuous'

end CompleteLattice

namespace OmegaCompletePartialOrder

variable {α : Type u} {α' : Type _} {β : Type v} {β' : Type _} {γ : Type _} {φ : Type _}

variable [OmegaCompletePartialOrder α] [OmegaCompletePartialOrder β]
variable [OmegaCompletePartialOrder γ] [OmegaCompletePartialOrder φ]
variable [OmegaCompletePartialOrder α'] [OmegaCompletePartialOrder β']

namespace OrderHom

/-- The `ωSup` operator for monotone functions. -/
@[simps]
protected def ωSup (c : Chain (α →o β)) : α →o β where
  toFun a := ωSup (c.map (OrderHom.apply a))
  monotone' _ _ h := ωSup_le_ωSup_of_le ((Chain.map_le_map _) fun a => a.monotone h)
#align omega_complete_partial_order.order_hom.ωSup OmegaCompletePartialOrder.OrderHom.ωSup
#align omega_complete_partial_order.order_hom.ωSup_coe OmegaCompletePartialOrder.OrderHom.ωSup_coe

@[simps! ωSup_coe]
instance omegaCompletePartialOrder : OmegaCompletePartialOrder (α →o β) :=
  OmegaCompletePartialOrder.lift OrderHom.coeFnHom OrderHom.ωSup (fun _ _ h => h) fun _ => rfl
#align
  omega_complete_partial_order.order_hom.omega_complete_partial_order
  OmegaCompletePartialOrder.OrderHom.omegaCompletePartialOrder
#align omega_complete_partial_order.order_hom.omega_complete_partial_order_ωSup_coe OmegaCompletePartialOrder.OrderHom.omegaCompletePartialOrder_ωSup_coe

end OrderHom

section

variable (α β)

/-- A monotone function on `ω`-continuous partial orders is said to be continuous
if for every chain `c : chain α`, `f (⊔ i, c i) = ⊔ i, f (c i)`.
This is just the bundled version of `OrderHom.continuous`. -/
structure ContinuousHom extends OrderHom α β where
  /-- The underlying function of a `ContinuousHom` is continuous, i.e. it preserves `ωSup` -/
  cont : Continuous (OrderHom.mk toFun Monotone')
#align omega_complete_partial_order.continuous_hom OmegaCompletePartialOrder.ContinuousHom

attribute [nolint docBlame] ContinuousHom.toOrderHom

@[inherit_doc]
infixr:25 " →𝒄 " => ContinuousHom
-- Input: \r\MIc

/-! todo: should we make this a OrderHomClass instead of a CoeFun? -/
instance : CoeFun (α →𝒄 β) fun _ => α → β :=
  ⟨fun f => f.toOrderHom.toFun⟩

instance : Coe (α →𝒄 β) (α →o β) where coe := ContinuousHom.toOrderHom

instance : PartialOrder (α →𝒄 β) :=
  (PartialOrder.lift fun f => f.toOrderHom.toFun) <| by rintro ⟨⟨⟩⟩ ⟨⟨⟩⟩ h; congr

end

namespace ContinuousHom

/-- See Note [custom simps projection]. We specify this explicitly because we don't have a FunLike
instance.
-/
def Simps.apply (h : α →𝒄 β) : α → β :=
  h

initialize_simps_projections ContinuousHom (toFun → apply)

theorem congr_fun {f g : α →𝒄 β} (h : f = g) (x : α) : f x = g x :=
  congr_arg (fun h : α →𝒄 β => h x) h
#align
  omega_complete_partial_order.continuous_hom.congr_fun
  OmegaCompletePartialOrder.ContinuousHom.congr_fun

theorem congr_arg (f : α →𝒄 β) {x y : α} (h : x = y) : f x = f y :=
  _root_.congr_arg f h
#align
  omega_complete_partial_order.continuous_hom.congr_arg
  OmegaCompletePartialOrder.ContinuousHom.congr_arg

protected theorem monotone (f : α →𝒄 β) : Monotone f :=
  f.monotone'
#align
  omega_complete_partial_order.continuous_hom.monotone
  OmegaCompletePartialOrder.ContinuousHom.monotone

@[mono]
theorem apply_mono {f g : α →𝒄 β} {x y : α} (h₁ : f ≤ g) (h₂ : x ≤ y) : f x ≤ g y :=
  OrderHom.apply_mono (show (f : α →o β) ≤ g from h₁) h₂
#align
  omega_complete_partial_order.continuous_hom.apply_mono
  OmegaCompletePartialOrder.ContinuousHom.apply_mono

theorem ite_continuous' {p : Prop} [hp : Decidable p] (f g : α → β) (hf : Continuous' f)
    (hg : Continuous' g) : Continuous' fun x => if p then f x else g x := by
  split_ifs <;> simp [*]
#align
  omega_complete_partial_order.continuous_hom.ite_continuous'
  OmegaCompletePartialOrder.ContinuousHom.ite_continuous'

theorem ωSup_bind {β γ : Type v} (c : Chain α) (f : α →o Part β) (g : α →o β → Part γ) :
    ωSup (c.map (f.bind g)) = ωSup (c.map f) >>= ωSup (c.map g) := by
  apply eq_of_forall_ge_iff; intro x
  simp only [ωSup_le_iff, Part.bind_le, Chain.mem_map_iff, and_imp, OrderHom.bind_coe, exists_imp]
  constructor <;> intro h'''
  · intro b hb
    apply ωSup_le _ _ _
    rintro i y hy
    simp only [Part.mem_ωSup] at hb
    rcases hb with ⟨j, hb⟩
    replace hb := hb.symm
    simp only [Part.eq_some_iff, Chain.map_coe, Function.comp_apply, OrderHom.apply_coe] at hy hb
    replace hb : b ∈ f (c (max i j)) := f.mono (c.mono (le_max_right i j)) _ hb
    replace hy : y ∈ g (c (max i j)) b := g.mono (c.mono (le_max_left i j)) _ _ hy
    apply h''' (max i j)
    simp only [exists_prop, Part.bind_eq_bind, Part.mem_bind_iff, Chain.map_coe,
      Function.comp_apply, OrderHom.bind_coe]
    exact ⟨_, hb, hy⟩
  · intro i
    intro y hy
    simp only [exists_prop, Part.bind_eq_bind, Part.mem_bind_iff, Chain.map_coe,
      Function.comp_apply, OrderHom.bind_coe] at hy
    rcases hy with ⟨b, hb₀, hb₁⟩
    apply h''' b _
    · apply le_ωSup (c.map g) _ _ _ hb₁
    · apply le_ωSup (c.map f) i _ hb₀
#align
  omega_complete_partial_order.continuous_hom.ωSup_bind
  OmegaCompletePartialOrder.ContinuousHom.ωSup_bind

theorem bind_continuous' {β γ : Type v} (f : α → Part β) (g : α → β → Part γ) :
    Continuous' f → Continuous' g → Continuous' fun x => f x >>= g x
  | ⟨hf, hf'⟩, ⟨hg, hg'⟩ =>
    Continuous.of_bundled' (OrderHom.bind ⟨f, hf⟩ ⟨g, hg⟩)
      (by intro c; rw [ωSup_bind, ← hf', ← hg']; rfl)
#align
  omega_complete_partial_order.continuous_hom.bind_continuous'
  OmegaCompletePartialOrder.ContinuousHom.bind_continuous'

theorem map_continuous' {β γ : Type v} (f : β → γ) (g : α → Part β) (hg : Continuous' g) :
    Continuous' fun x => f <$> g x := by
  simp only [map_eq_bind_pure_comp]; apply bind_continuous' _ _ hg; apply const_continuous'
#align
  omega_complete_partial_order.continuous_hom.map_continuous'
  OmegaCompletePartialOrder.ContinuousHom.map_continuous'

theorem seq_continuous' {β γ : Type v} (f : α → Part (β → γ)) (g : α → Part β) (hf : Continuous' f)
    (hg : Continuous' g) : Continuous' fun x => f x <*> g x := by
  simp only [seq_eq_bind_map]; apply bind_continuous' _ _ hf;
        apply Pi.OmegaCompletePartialOrder.flip₂_continuous';
      intro;
    apply map_continuous' _ _ hg
#align
  omega_complete_partial_order.continuous_hom.seq_continuous'
  OmegaCompletePartialOrder.ContinuousHom.seq_continuous'

theorem continuous (F : α →𝒄 β) (C : Chain α) : F (ωSup C) = ωSup (C.map F) :=
  ContinuousHom.cont _ _
#align
  omega_complete_partial_order.continuous_hom.continuous
  OmegaCompletePartialOrder.ContinuousHom.continuous

/-- Construct a continuous function from a bare function, a continuous function, and a proof that
they are equal. -/
@[reducible] --Porting note: removes `simps` because it generated a bad lemma with variable as
--head symbol
def ofFun (f : α → β) (g : α →𝒄 β) (h : f = g) : α →𝒄 β := by
  refine' { toOrderHom := { toFun := f.. }.. } <;> subst h <;> rcases g with ⟨⟨⟩⟩ <;> assumption
#align
  omega_complete_partial_order.continuous_hom.of_fun OmegaCompletePartialOrder.ContinuousHom.ofFun

/-- Construct a continuous function from a monotone function with a proof of continuity. -/
-- Porting note: we now generate a `toOrderHom` lemma instead of an `apply` lemma with `simps`
@[reducible, simps toOrderHom]
def ofMono (f : α →o β) (h : ∀ c : Chain α, f (ωSup c) = ωSup (c.map f)) :
    α →𝒄 β where
  toFun := f
  monotone' := f.monotone
  cont := h
#align
  omega_complete_partial_order.continuous_hom.of_mono
  OmegaCompletePartialOrder.ContinuousHom.ofMono

/-- The identity as a continuous function. -/
@[simps!]
def id : α →𝒄 α :=
  ofMono OrderHom.id continuous_id
#align omega_complete_partial_order.continuous_hom.id OmegaCompletePartialOrder.ContinuousHom.id
#align omega_complete_partial_order.continuous_hom.id_apply OmegaCompletePartialOrder.ContinuousHom.id_apply

/-- The composition of continuous functions. -/
@[simps!]
def comp (f : β →𝒄 γ) (g : α →𝒄 β) : α →𝒄 γ :=
  ofMono (OrderHom.comp ↑f ↑g) (continuous_comp _ _ g.cont f.cont)
#align omega_complete_partial_order.continuous_hom.comp OmegaCompletePartialOrder.ContinuousHom.comp
#align omega_complete_partial_order.continuous_hom.comp_apply OmegaCompletePartialOrder.ContinuousHom.comp_apply

@[ext]
protected theorem ext (f g : α →𝒄 β) (h : ∀ x, f x = g x) : f = g := by
  cases f; cases g; congr; ext; apply h
#align omega_complete_partial_order.continuous_hom.ext OmegaCompletePartialOrder.ContinuousHom.ext

protected theorem coe_inj (f g : α →𝒄 β) (h : (f : α → β) = g) : f = g :=
  ContinuousHom.ext _ _ <| _root_.congr_fun h
#align
  omega_complete_partial_order.continuous_hom.coe_inj
  OmegaCompletePartialOrder.ContinuousHom.coe_inj

@[simp]
theorem comp_id (f : β →𝒄 γ) : f.comp id = f := by ext; rfl
#align
  omega_complete_partial_order.continuous_hom.comp_id
  OmegaCompletePartialOrder.ContinuousHom.comp_id

@[simp]
theorem id_comp (f : β →𝒄 γ) : id.comp f = f := by ext; rfl
#align
  omega_complete_partial_order.continuous_hom.id_comp
  OmegaCompletePartialOrder.ContinuousHom.id_comp

@[simp]
theorem comp_assoc (f : γ →𝒄 φ) (g : β →𝒄 γ) (h : α →𝒄 β) : f.comp (g.comp h) = (f.comp g).comp h :=
  by ext; rfl
#align
  omega_complete_partial_order.continuous_hom.comp_assoc
  OmegaCompletePartialOrder.ContinuousHom.comp_assoc

--Porting note: removed because it is a syntactic tautology. May want it later if we use `FunLike`
-- @[simp]
-- theorem coe_apply (a : α) (f : α →𝒄 β) : (f : α →o β) a = (f : α → β) a :=
--   rfl
-- #align
--   omega_complete_partial_order.continuous_hom.coe_apply
--   OmegaCompletePartialOrder.ContinuousHom.coe_apply

/-- `Function.const` is a continuous function. -/
def const (x : β) : α →𝒄 β :=
  ofMono (OrderHom.const _ x) (continuous_const x)
#align
  omega_complete_partial_order.continuous_hom.const
  OmegaCompletePartialOrder.ContinuousHom.const

@[simp]
theorem const_apply (f : β) (a : α) : const f a = f :=
  rfl
#align
  omega_complete_partial_order.continuous_hom.const_apply
  OmegaCompletePartialOrder.ContinuousHom.const_apply

instance [Inhabited β] : Inhabited (α →𝒄 β) :=
  ⟨const default⟩

/-- The map from continuous functions to monotone functions is itself a monotone function. -/
@[simps]
def toMono : (α →𝒄 β) →o α →o β where
  toFun f := f
  monotone' _ _ h := h
#align
  omega_complete_partial_order.continuous_hom.to_mono
  OmegaCompletePartialOrder.ContinuousHom.toMono
#align omega_complete_partial_order.continuous_hom.to_mono_coe OmegaCompletePartialOrder.ContinuousHom.toMono_coe

/-- When proving that a chain of applications is below a bound `z`, it suffices to consider the
functions and values being selected from the same index in the chains.

This lemma is more specific than necessary, i.e. `c₀` only needs to be a
chain of monotone functions, but it is only used with continuous functions. -/
@[simp]
theorem forall_forall_merge (c₀ : Chain (α →𝒄 β)) (c₁ : Chain α) (z : β) :
    (∀ i j : ℕ, (c₀ i) (c₁ j) ≤ z) ↔ ∀ i : ℕ, (c₀ i) (c₁ i) ≤ z := by
  constructor <;> introv h
  · apply h
  · apply le_trans _ (h (max i j))
    trans c₀ i (c₁ (max i j))
    · apply (c₀ i).monotone
      apply c₁.monotone
      apply le_max_right
    · apply c₀.monotone
      apply le_max_left
#align
  omega_complete_partial_order.continuous_hom.forall_forall_merge
  OmegaCompletePartialOrder.ContinuousHom.forall_forall_merge

@[simp]
theorem forall_forall_merge' (c₀ : Chain (α →𝒄 β)) (c₁ : Chain α) (z : β) :
    (∀ j i : ℕ, (c₀ i) (c₁ j) ≤ z) ↔ ∀ i : ℕ, (c₀ i) (c₁ i) ≤ z := by
  rw [forall_swap, forall_forall_merge]
#align
  omega_complete_partial_order.continuous_hom.forall_forall_merge'
  OmegaCompletePartialOrder.ContinuousHom.forall_forall_merge'

/-- The `ωSup` operator for continuous functions, which takes the pointwise countable supremum
of the functions in the `ω`-chain. -/
@[simps!]
protected def ωSup (c : Chain (α →𝒄 β)) : α →𝒄 β :=
  ContinuousHom.ofMono (ωSup <| c.map toMono)
    (by
      intro c'
      apply eq_of_forall_ge_iff; intro z
      simp only [ωSup_le_iff, (c _).continuous, Chain.map_coe, OrderHom.apply_coe, toMono_coe,
        OrderHom.omegaCompletePartialOrder_ωSup_coe, forall_forall_merge,
        forall_forall_merge', (· ∘ ·), Function.eval])
#align omega_complete_partial_order.continuous_hom.ωSup OmegaCompletePartialOrder.ContinuousHom.ωSup
#align omega_complete_partial_order.continuous_hom.ωSup_apply OmegaCompletePartialOrder.ContinuousHom.ωSup_apply

@[simps ωSup]
instance : OmegaCompletePartialOrder (α →𝒄 β) :=
  OmegaCompletePartialOrder.lift ContinuousHom.toMono ContinuousHom.ωSup
    (fun _ _ h => h) (fun _ => rfl)

namespace Prod

/-- The application of continuous functions as a continuous function.  -/
@[simps]
def apply : (α →𝒄 β) × α →𝒄 β where
  toFun f := f.1 f.2
  monotone' x y h := by
    dsimp
    trans y.fst x.snd <;> [apply h.1, apply y.1.monotone h.2]
  cont := by
    intro _ c
    apply le_antisymm
    · apply ωSup_le
      intro i
      dsimp
      rw [(c _).fst.continuous]
      apply ωSup_le
      intro j
      apply le_ωSup_of_le (max i j)
      apply apply_mono
      exact monotone_fst (OrderHom.mono _ (le_max_left _ _))
      exact monotone_snd (OrderHom.mono _ (le_max_right _ _))
    · apply ωSup_le
      intro i
      apply le_ωSup_of_le i
      dsimp
      apply OrderHom.mono _
      apply le_ωSup_of_le i
      rfl
#align
  omega_complete_partial_order.continuous_hom.prod.apply
  OmegaCompletePartialOrder.ContinuousHom.Prod.apply
#align omega_complete_partial_order.continuous_hom.prod.apply_apply OmegaCompletePartialOrder.ContinuousHom.Prod.apply_apply

end Prod

theorem ωSup_def (c : Chain (α →𝒄 β)) (x : α) : ωSup c x = ContinuousHom.ωSup c x :=
  rfl
#align
  omega_complete_partial_order.continuous_hom.ωSup_def
  OmegaCompletePartialOrder.ContinuousHom.ωSup_def

theorem ωSup_apply_ωSup (c₀ : Chain (α →𝒄 β)) (c₁ : Chain α) :
    ωSup c₀ (ωSup c₁) = Prod.apply (ωSup (c₀.zip c₁)) := by simp [Prod.apply_apply, Prod.ωSup_zip]
#align
  omega_complete_partial_order.continuous_hom.ωSup_apply_ωSup
  OmegaCompletePartialOrder.ContinuousHom.ωSup_apply_ωSup

/-- A family of continuous functions yields a continuous family of functions. -/
@[simps]
def flip {α : Type _} (f : α → β →𝒄 γ) :
    β →𝒄 α → γ where
  toFun x y := f y x
  monotone' x y h a := (f a).monotone h
  cont := by intro _ _; ext x; change f _ _ = _; rw [(f _).continuous]; rfl
#align omega_complete_partial_order.continuous_hom.flip OmegaCompletePartialOrder.ContinuousHom.flip
#align omega_complete_partial_order.continuous_hom.flip_apply OmegaCompletePartialOrder.ContinuousHom.flip_apply

/-- `Part.bind` as a continuous function. -/
@[simps!] --Porting note: removed `(config := { rhsMd := reducible })`
noncomputable def bind {β γ : Type v} (f : α →𝒄 Part β) (g : α →𝒄 β → Part γ) : α →𝒄 Part γ :=
  ofMono (OrderHom.bind f g.toOrderHom) fun c => by
    rw [OrderHom.bind, ← OrderHom.bind, ωSup_bind, ← f.continuous, ← g.continuous]
    rfl
#align omega_complete_partial_order.continuous_hom.bind OmegaCompletePartialOrder.ContinuousHom.bind

/-- `Part.map` as a continuous function. -/
@[simps] --Porting note: removed `(config := { rhsMd := reducible })`
noncomputable def map {β γ : Type v} (f : β → γ) (g : α →𝒄 Part β) : α →𝒄 Part γ :=
  ofFun (fun x => f <$> g x) (bind g (const (pure ∘ f))) <| by
    ext
    simp only [map_eq_bind_pure_comp, bind, OrderHom.bind_coe, const_apply,
      OrderHom.const_coe_coe]
#align omega_complete_partial_order.continuous_hom.map OmegaCompletePartialOrder.ContinuousHom.map
#align omega_complete_partial_order.continuous_hom.map_apply OmegaCompletePartialOrder.ContinuousHom.map_apply

/-- `Part.seq` as a continuous function. -/
@[simps] --Porting note: removed `(config := { rhsMd := reducible })`
noncomputable def seq {β γ : Type v} (f : α →𝒄 Part (β → γ)) (g : α →𝒄 Part β) : α →𝒄 Part γ :=
  ofFun (fun x => f x <*> g x) (bind f <| flip <| _root_.flip map g) <| by
      ext
      simp only [seq_eq_bind_map, flip, Part.bind_eq_bind, map_apply, Part.mem_bind_iff,
        bind, OrderHom.bind_coe, flip_apply]
      rfl
#align omega_complete_partial_order.continuous_hom.seq OmegaCompletePartialOrder.ContinuousHom.seq
#align omega_complete_partial_order.continuous_hom.seq_apply OmegaCompletePartialOrder.ContinuousHom.seq_apply

end ContinuousHom

end OmegaCompletePartialOrder