/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import logic.basic

/-!
# Nonempty types

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

This file proves a few extra facts about `nonempty`, which is defined in core Lean.

## Main declarations

* `nonempty.some`: Extracts a witness of nonemptiness using choice. Takes `nonempty α` explicitly.
* `classical.arbitrary`: Extracts a witness of nonemptiness using choice. Takes `nonempty α` as an
  instance.
-/

variables {α β : Type*} {γ : α → Type*}

attribute [simp] nonempty_of_inhabited

@[priority 20]
instance has_zero.nonempty [has_zero α] : nonempty α := ⟨0⟩
@[priority 20]
instance has_one.nonempty [has_one α] : nonempty α := ⟨1⟩

lemma exists_true_iff_nonempty {α : Sort*} : (∃a:α, true) ↔ nonempty α :=
iff.intro (λ⟨a, _⟩, ⟨a⟩) (λ⟨a⟩, ⟨a, trivial⟩)

@[simp] lemma nonempty_Prop {p : Prop} : nonempty p ↔ p :=
iff.intro (assume ⟨h⟩, h) (assume h, ⟨h⟩)

lemma not_nonempty_iff_imp_false {α : Sort*} : ¬ nonempty α ↔ α → false :=
⟨λ h a, h ⟨a⟩, λ h ⟨a⟩, h a⟩

@[simp] lemma nonempty_sigma : nonempty (Σa:α, γ a) ↔ (∃a:α, nonempty (γ a)) :=
iff.intro (assume ⟨⟨a, c⟩⟩, ⟨a, ⟨c⟩⟩) (assume ⟨a, ⟨c⟩⟩, ⟨⟨a, c⟩⟩)

@[simp] lemma nonempty_psigma {α} {β : α → Sort*} : nonempty (psigma β) ↔ (∃a:α, nonempty (β a)) :=
iff.intro (assume ⟨⟨a, c⟩⟩, ⟨a, ⟨c⟩⟩) (assume ⟨a, ⟨c⟩⟩, ⟨⟨a, c⟩⟩)

@[simp] lemma nonempty_subtype {α} {p : α → Prop} : nonempty (subtype p) ↔ (∃a:α, p a) :=
iff.intro (assume ⟨⟨a, h⟩⟩, ⟨a, h⟩) (assume ⟨a, h⟩, ⟨⟨a, h⟩⟩)

@[simp] lemma nonempty_prod : nonempty (α × β) ↔ (nonempty α ∧ nonempty β) :=
iff.intro (assume ⟨⟨a, b⟩⟩, ⟨⟨a⟩, ⟨b⟩⟩) (assume ⟨⟨a⟩, ⟨b⟩⟩, ⟨⟨a, b⟩⟩)

@[simp] lemma nonempty_pprod {α β} : nonempty (pprod α β) ↔ (nonempty α ∧ nonempty β) :=
iff.intro (assume ⟨⟨a, b⟩⟩, ⟨⟨a⟩, ⟨b⟩⟩) (assume ⟨⟨a⟩, ⟨b⟩⟩, ⟨⟨a, b⟩⟩)

@[simp] lemma nonempty_sum : nonempty (α ⊕ β) ↔ (nonempty α ∨ nonempty β) :=
iff.intro
  (assume ⟨h⟩, match h with sum.inl a := or.inl ⟨a⟩ | sum.inr b := or.inr ⟨b⟩ end)
  (assume h, match h with or.inl ⟨a⟩ := ⟨sum.inl a⟩ | or.inr ⟨b⟩ := ⟨sum.inr b⟩ end)

@[simp] lemma nonempty_psum {α β} : nonempty (psum α β) ↔ (nonempty α ∨ nonempty β) :=
iff.intro
  (assume ⟨h⟩, match h with psum.inl a := or.inl ⟨a⟩ | psum.inr b := or.inr ⟨b⟩ end)
  (assume h, match h with or.inl ⟨a⟩ := ⟨psum.inl a⟩ | or.inr ⟨b⟩ := ⟨psum.inr b⟩ end)

@[simp] lemma nonempty_empty : ¬ nonempty empty :=
assume ⟨h⟩, h.elim

@[simp] lemma nonempty_ulift : nonempty (ulift α) ↔ nonempty α :=
iff.intro (assume ⟨⟨a⟩⟩, ⟨a⟩) (assume ⟨a⟩, ⟨⟨a⟩⟩)

@[simp] lemma nonempty_plift {α} : nonempty (plift α) ↔ nonempty α :=
iff.intro (assume ⟨⟨a⟩⟩, ⟨a⟩) (assume ⟨a⟩, ⟨⟨a⟩⟩)

@[simp] lemma nonempty.forall {α} {p : nonempty α → Prop} : (∀h:nonempty α, p h) ↔ (∀a, p ⟨a⟩) :=
iff.intro (assume h a, h _) (assume h ⟨a⟩, h _)

@[simp] lemma nonempty.exists {α} {p : nonempty α → Prop} : (∃h:nonempty α, p h) ↔ (∃a, p ⟨a⟩) :=
iff.intro (assume ⟨⟨a⟩, h⟩, ⟨a, h⟩) (assume ⟨a, h⟩, ⟨⟨a⟩, h⟩)

/-- Using `classical.choice`, lifts a (`Prop`-valued) `nonempty` instance to a (`Type`-valued)
  `inhabited` instance. `classical.inhabited_of_nonempty` already exists, in
  `core/init/classical.lean`, but the assumption is not a type class argument,
  which makes it unsuitable for some applications. -/
noncomputable def classical.inhabited_of_nonempty' {α} [h : nonempty α] : inhabited α :=
⟨classical.choice h⟩

/-- Using `classical.choice`, extracts a term from a `nonempty` type. -/
@[reducible] protected noncomputable def nonempty.some {α} (h : nonempty α) : α :=
classical.choice h

/-- Using `classical.choice`, extracts a term from a `nonempty` type. -/
@[reducible] protected noncomputable def classical.arbitrary (α) [h : nonempty α] : α :=
classical.choice h

/-- Given `f : α → β`, if `α` is nonempty then `β` is also nonempty.
  `nonempty` cannot be a `functor`, because `functor` is restricted to `Type`. -/
lemma nonempty.map {α β} (f : α → β) : nonempty α → nonempty β
| ⟨h⟩ := ⟨f h⟩

protected lemma nonempty.map2 {α β γ : Sort*} (f : α → β → γ) : nonempty α → nonempty β → nonempty γ
| ⟨x⟩ ⟨y⟩ := ⟨f x y⟩

protected lemma nonempty.congr {α β} (f : α → β) (g : β → α) :
  nonempty α ↔ nonempty β :=
⟨nonempty.map f, nonempty.map g⟩

lemma nonempty.elim_to_inhabited {α : Sort*} [h : nonempty α] {p : Prop}
  (f : inhabited α → p) : p :=
h.elim $ f ∘ inhabited.mk

instance {α β} [h : nonempty α] [h2 : nonempty β] : nonempty (α × β) :=
h.elim $ λ g, h2.elim $ λ g2, ⟨⟨g, g2⟩⟩

instance {ι : Sort*} {α : ι → Sort*} [Π i, nonempty (α i)] : nonempty (Π i, α i) :=
⟨λ _, classical.arbitrary _⟩

lemma classical.nonempty_pi {ι} {α : ι → Sort*} : nonempty (Π i, α i) ↔ ∀ i, nonempty (α i) :=
⟨λ ⟨f⟩ a, ⟨f a⟩, @pi.nonempty _ _⟩

lemma subsingleton_of_not_nonempty {α : Sort*} (h : ¬ nonempty α) : subsingleton α :=
⟨λ x, false.elim $ not_nonempty_iff_imp_false.mp h x⟩

lemma function.surjective.nonempty {α β : Sort*} [h : nonempty β] {f : α → β}
  (hf : function.surjective f) :
  nonempty α :=
let ⟨y⟩ := h, ⟨x, hx⟩ := hf y in ⟨x⟩


/-
Copyright (c) 2019 Lucas Allen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lucas Allen, Scott Morrison
-/
import data.bool.basic
import data.mllist
import tactic.solve_by_elim

/-!
# `suggest` and `library_search`

`suggest` and `library_search` are a pair of tactics for applying lemmas from the library to the
current goal.

* `suggest` prints a list of `exact ...` or `refine ...` statements, which may produce new goals
* `library_search` prints a single `exact ...` which closes the goal, or fails
-/

namespace tactic

open native

namespace suggest

open solve_by_elim

/-- Map a name (typically a head symbol) to a "canonical" definitional synonym.
Given a name `n`, we want a name `n'` such that a sufficiently applied
expression with head symbol `n` is always definitionally equal to an expression
with head symbol `n'`.
Thus, we can search through all lemmas with a result type of `n'`
to solve a goal with head symbol `n`.

For example, `>` is mapped to `<` because `a > b` is definitionally equal to `b < a`,
and `not` is mapped to `false` because `¬ a` is definitionally equal to `p → false`
The default is that the original argument is returned, so `<` is just mapped to `<`.

`normalize_synonym` is called for every lemma in the library, so it needs to be fast.
-/
-- TODO this is a hack; if you suspect more cases here would help, please report them
meta def normalize_synonym : name → name
| `gt := `has_lt.lt
| `ge := `has_le.le
| `monotone := `has_le.le
| `not := `false
| n   := n

/--
Compute the head symbol of an expression, then normalise synonyms.

This is only used when analysing the goal, so it is okay to do more expensive analysis here.
-/
-- We may want to tweak this further?
meta def allowed_head_symbols : expr → list name
-- We first have a various "customisations":
--   Because in `ℕ` `a.succ ≤ b` is definitionally `a < b`,
--   we add some special cases to allow looking for `<` lemmas even when the goal has a `≤`.
--   Note we only do this in the `ℕ` case, for performance.
| `(@has_le.le ℕ _ (nat.succ _) _) := [`has_le.le, `has_lt.lt]
| `(@ge ℕ _ _ (nat.succ _)) := [`has_le.le, `has_lt.lt]
| `(@has_le.le ℕ _ 1 _) := [`has_le.le, `has_lt.lt]
| `(@ge ℕ _ _ 1) := [`has_le.le, `has_lt.lt]

-- These allow `library_search` to search for lemmas of type `¬ a = b` when proving `a ≠ b`
--   and vice-versa.
| `(_ ≠ _) := [`false, `ne]
| `(¬ _ = _) := [`ne, `false]

-- And then the generic cases:
| (expr.pi _ _ _ t) := allowed_head_symbols t
| (expr.app f _) := allowed_head_symbols f
| (expr.const n _) := [normalize_synonym n]
| _ := [`_]
.

/--
A declaration can match the head symbol of the current goal in four possible ways:
* `ex`  : an exact match
* `mp`  : the declaration returns an `iff`, and the right hand side matches the goal
* `mpr` : the declaration returns an `iff`, and the left hand side matches the goal
* `both`: the declaration returns an `iff`, and the both sides match the goal
-/
@[derive decidable_eq, derive inhabited]
inductive head_symbol_match
| ex | mp | mpr | both

open head_symbol_match

/-- a textual representation of a `head_symbol_match`, for trace debugging. -/
def head_symbol_match.to_string : head_symbol_match → string
| ex   := "exact"
| mp   := "iff.mp"
| mpr  := "iff.mpr"
| both := "iff.mp and iff.mpr"

/-- Determine if, and in which way, a given expression matches the specified head symbol. -/
meta def match_head_symbol (hs : name_set) : expr → option head_symbol_match
| (expr.pi _ _ _ t) := match_head_symbol t
| `(%%a ↔ %%b)      := if hs.contains `iff then some ex else
                       match (match_head_symbol a, match_head_symbol b) with
                       | (some ex, some ex) :=
                           some both
                       | (some ex, _) := some mpr
                       | (_, some ex) := some mp
                       | _ := none
                       end
| (expr.app f _)    := match_head_symbol f
| (expr.const n _)  := if hs.contains (normalize_synonym n) then some ex else none
| _ := if hs.contains `_ then some ex else none

/-- A package of `declaration` metadata, including the way in which its type matches the head symbol
which we are searching for. -/
meta structure decl_data :=
(d : declaration)
(n : name)
(m : head_symbol_match)
(l : ℕ) -- cached length of name

/--
Generate a `decl_data` from the given declaration if
it matches the head symbol `hs` for the current goal.
-/
-- We used to check here for private declarations, or declarations with certain suffixes.
-- It turns out `apply` is so fast, it's better to just try them all.
meta def process_declaration (hs : name_set) (d : declaration) : option decl_data :=
let n := d.to_name in
if !d.is_trusted || n.is_internal then
  none
else
  (λ m, ⟨d, n, m, n.length⟩) <$> match_head_symbol hs d.type

/-- Retrieve all library definitions with a given head symbol. -/
meta def library_defs (hs : name_set) : tactic (list decl_data) :=
do trace_if_enabled `suggest format!"Looking for lemmas with head symbols {hs}.",
   env ← get_env,
   let defs := env.decl_filter_map (process_declaration hs),
   -- Sort by length; people like short proofs
   let defs := defs.qsort(λ d₁ d₂, d₁.l ≤ d₂.l),
   trace_if_enabled `suggest format!"Found {defs.length} relevant lemmas:",
   trace_if_enabled `suggest $ defs.map (λ ⟨d, n, m, l⟩, (n, m.to_string)),
   return defs

/--
We unpack any element of a list of `decl_data` corresponding to an `↔` statement that could apply
in both directions into two separate elements.

This ensures that both directions can be independently returned by `suggest`,
and avoids a problem where the application of one direction prevents
the application of the other direction. (See `exp_le_exp` in the tests.)
-/
meta def unpack_iff_both : list decl_data → list decl_data
| []                     := []
| (⟨d, n, both, l⟩ :: L) := ⟨d, n, mp, l⟩ :: ⟨d, n, mpr, l⟩ :: unpack_iff_both L
| (⟨d, n, m, l⟩ :: L)    := ⟨d, n, m, l⟩ :: unpack_iff_both L

/-- An extension to the option structure for `solve_by_elim`.
* `compulsory_hyps` specifies a list of local hypotheses which must appear in any solution.
  These are useful for constraining the results from `library_search` and `suggest`.
* `try_this` is a flag (default: `tt`) that controls whether a "Try this:"-line should be traced.
-/
meta structure suggest_opt extends opt :=
(compulsory_hyps : list expr := [])
(try_this : bool := tt)

/--
Convert a `suggest_opt` structure to a `opt` structure suitable for `solve_by_elim`,
by setting the `accept` parameter to require that all complete solutions
use everything in `compulsory_hyps`.
-/
meta def suggest_opt.mk_accept (o : suggest_opt) : opt :=
{ accept := λ gs, o.accept gs >>
    (guard $ o.compulsory_hyps.all (λ h, gs.any (λ g, g.contains_expr_or_mvar h))),
  ..o }

/--
Apply the lemma `e`, then attempt to close all goals using
`solve_by_elim opt`, failing if `close_goals = tt`
and there are any goals remaining.

Returns the number of subgoals which were closed using `solve_by_elim`.
-/
-- Implementation note: as this is used by both `library_search` and `suggest`,
-- we first run `solve_by_elim` separately on the independent goals,
-- whether or not `close_goals` is set,
-- and then run `solve_by_elim { all_goals := tt }`,
-- requiring that it succeeds if `close_goals = tt`.
meta def apply_and_solve (close_goals : bool) (opt : suggest_opt := { }) (e : expr) : tactic ℕ :=
do
  trace_if_enabled `suggest format!"Trying to apply lemma: {e}",
  apply e opt.to_apply_cfg,
  trace_if_enabled `suggest format!"Applied lemma: {e}",
  ng ← num_goals,
  -- Phase 1
  -- Run `solve_by_elim` on each "safe" goal separately, not worrying about failures.
  -- (We only attempt the "safe" goals in this way in Phase 1.
  -- In Phase 2 we will do backtracking search across all goals,
  -- allowing us to guess solutions that involve data or unify metavariables,
  -- but only as long as we can finish all goals.)
  -- If `compulsory_hyps` is non-empty, we skip this phase and defer to phase 2.
  try (guard (opt.compulsory_hyps = []) >>
    any_goals (independent_goal >> solve_by_elim opt.to_opt)),
  -- Phase 2
  (done >> return ng) <|> (do
    -- If there were any goals that we did not attempt solving in the first phase
    -- (because they weren't propositional, or contained a metavariable)
    -- as a second phase we attempt to solve all remaining goals at once
    -- (with backtracking across goals).
    ((guard (opt.compulsory_hyps ≠ []) <|> any_goals (success_if_fail independent_goal) >> skip) >>
      solve_by_elim { backtrack_all_goals := tt, ..opt.mk_accept }) <|>
    -- and fail unless `close_goals = ff`
    guard ¬ close_goals,
    ng' ← num_goals,
    return (ng - ng'))

/--
Apply the declaration `d` (or the forward and backward implications separately, if it is an `iff`),
and then attempt to solve the subgoal using `apply_and_solve`.

Returns the number of subgoals successfully closed.
-/
meta def apply_declaration (close_goals : bool) (opt : suggest_opt := { }) (d : decl_data) :
  tactic ℕ :=
let tac := apply_and_solve close_goals opt in
do (e, t) ← decl_mk_const d.d,
   match d.m with
   | ex   := tac e
   | mp   := do l ← iff_mp_core e t, tac l
   | mpr  := do l ← iff_mpr_core e t, tac l
   | both := undefined -- we use `unpack_iff_both` to ensure this isn't reachable
   end

/-- An `application` records the result of a successful application of a library lemma. -/
meta structure application :=
(state     : tactic_state)
(script    : string)
(decl      : option declaration)
(num_goals : ℕ)
(hyps_used : list expr)

end suggest

open solve_by_elim
open suggest

declare_trace suggest         -- Trace a list of all relevant lemmas

-- Call `apply_declaration`, then prepare the tactic script and
-- count the number of local hypotheses used.
private meta def apply_declaration_script
  (g : expr) (hyps : list expr)
  (opt : suggest_opt := { })
  (d : decl_data) :
  tactic application :=
-- (This tactic block is only executed when we evaluate the mllist,
-- so we need to do the `focus1` here.)
retrieve $ focus1 $ do
  apply_declaration ff opt d,
  -- This `instantiate_mvars` is necessary so that we count used hypotheses correctly.
  g ← instantiate_mvars g,
  guard $ (opt.compulsory_hyps.all (λ h, h.occurs g)),
  ng ← num_goals,
  s ← read,
  m ← tactic_statement g,
  return
  { application .
    state := s,
    decl := d.d,
    script := m,
    num_goals := ng,
    hyps_used := hyps.filter (λ h, h.occurs g) }

-- implementation note: we produce a `tactic (mllist tactic application)` first,
-- because it's easier to work in the tactic monad, but in a moment we squash this
-- down to an `mllist tactic application`.
private meta def suggest_core' (opt : suggest_opt := { }) :
  tactic (mllist tactic application) :=
do g :: _ ← get_goals,
   hyps ← local_context,

   -- Check if `solve_by_elim` can solve the goal immediately:
   (retrieve (do
     focus1 $ solve_by_elim opt.mk_accept,
     s ← read,
     m ← tactic_statement g,
     -- This `instantiate_mvars` is necessary so that we count used hypotheses correctly.
     g ← instantiate_mvars g,
     guard (opt.compulsory_hyps.all (λ h, h.occurs g)),
     return $ mllist.of_list [⟨s, m, none, 0, hyps.filter (λ h, h.occurs g)⟩])) <|>
   -- Otherwise, let's actually try applying library lemmas.
   (do
   -- Collect all definitions with the correct head symbol
   t ← infer_type g,
   defs ← unpack_iff_both <$> library_defs (name_set.of_list $ allowed_head_symbols t),

   let defs : mllist tactic _ := mllist.of_list defs,

   -- Try applying each lemma against the goal,
   -- recording the tactic script as a string,
   -- the number of remaining goals,
   -- and number of local hypotheses used.
   let results := defs.mfilter_map (apply_declaration_script g hyps opt),
   -- Now call `symmetry` and try again.
   -- (Because we are using `mllist`, this is essentially free if we've already found a lemma.)
   symm_state ← retrieve $ try_core $ symmetry >> read,
   let results_symm := match symm_state with
   | (some s) :=
     defs.mfilter_map (λ d, retrieve $ set_state s >> apply_declaration_script g hyps opt d)
   | none := mllist.nil
   end,
  return (results.append results_symm))

/--
The core `suggest` tactic.
It attempts to apply a declaration from the library,
then solve new goals using `solve_by_elim`.

It returns a list of `application`s consisting of fields:
* `state`, a tactic state resulting from the successful application of a declaration from
  the library,
* `script`, a string of the form `Try this: refine ...` or `Try this: exact ...` which will
  reproduce that tactic state,
* `decl`, an `option declaration` indicating the declaration that was applied
  (or none, if `solve_by_elim` succeeded),
* `num_goals`, the number of remaining goals, and
* `hyps_used`, the number of local hypotheses used in the solution.
-/
meta def suggest_core (opt : suggest_opt := { }) : mllist tactic application :=
(mllist.monad_lift (suggest_core' opt)).join

/--
See `suggest_core`.

Returns a list of at most `limit` `application`s,
sorted by number of goals, and then (reverse) number of hypotheses used.
-/
meta def suggest (limit : option ℕ := none) (opt : suggest_opt := { }) :
  tactic (list application) :=
do let results := suggest_core opt,
   -- Get the first n elements of the successful lemmas
   L ← if h : limit.is_some then results.take (option.get h) else results.force,
   -- Sort by number of remaining goals, then by number of hypotheses used.
   return $ L.qsort (λ d₁ d₂, d₁.num_goals < d₂.num_goals ∨
    (d₁.num_goals = d₂.num_goals ∧ d₁.hyps_used.length ≥ d₂.hyps_used.length))

/--
Returns a list of at most `limit` strings, of the form `Try this: exact ...` or
`Try this: refine ...`, which make progress on the current goal using a declaration
from the library.
-/
meta def suggest_scripts
  (limit : option ℕ := none) (opt : suggest_opt := { }) :
  tactic (list string) :=
do L ← suggest limit opt,
   return $ L.map application.script

/--
Returns a string of the form `Try this: exact ...`, which closes the current goal.
-/
meta def library_search (opt : suggest_opt := { }) : tactic string :=
(suggest_core opt).mfirst (λ a, do
  guard (a.num_goals = 0),
  write a.state,
  return a.script)

namespace interactive
setup_tactic_parser

open solve_by_elim

declare_trace silence_suggest -- Turn off `Try this: exact/refine ...` trace messages for `suggest`

/--
`suggest` tries to apply suitable theorems/defs from the library, and generates
a list of `exact ...` or `refine ...` scripts that could be used at this step.
It leaves the tactic state unchanged. It is intended as a complement of the search
function in your editor, the `#find` tactic, and `library_search`.

`suggest` takes an optional natural number `num` as input and returns the first `num`
(or less, if all possibilities are exhausted) possibilities ordered by length of lemma names.
The default for `num` is `50`.
For performance reasons `suggest` uses monadic lazy lists (`mllist`). This means that
`suggest` might miss some results if `num` is not large enough. However, because
`suggest` uses monadic lazy lists, smaller values of `num` run faster than larger values.

You can add additional lemmas to be used along with local hypotheses
after the application of a library lemma,
using the same syntax as for `solve_by_elim`, e.g.
```
example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  suggest [add_lt_add], -- Says: `Try this: exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end
```
You can also use `suggest with attr` to include all lemmas with the attribute `attr`.
-/
meta def suggest (n : parse (with_desc "n" small_nat)?)
  (hs : parse simp_arg_list) (attr_names : parse with_ident_list)
  (use : parse $ (tk "using" *> many ident_) <|> return []) (opt : suggest_opt := { }) :
  tactic unit :=
do (lemma_thunks, ctx_thunk) ← mk_assumption_set ff hs attr_names,
   use ← use.mmap get_local,
   L ← tactic.suggest_scripts (n.get_or_else 50)
     { compulsory_hyps := use,
       lemma_thunks := some lemma_thunks,
       ctx_thunk := ctx_thunk, ..opt },
  if !opt.try_this || is_trace_enabled_for `silence_suggest then
    skip
  else
    if L.length = 0 then
      fail "There are no applicable declarations"
    else
      L.mmap trace >> skip

/--
`suggest` lists possible usages of the `refine` tactic and leaves the tactic state unchanged.
It is intended as a complement of the search function in your editor, the `#find` tactic, and
`library_search`.

`suggest` takes an optional natural number `num` as input and returns the first `num` (or less, if
all possibilities are exhausted) possibilities ordered by length of lemma names.
The default for `num` is `50`.

`suggest using h₁ h₂` will only show solutions that make use of the local hypotheses `h₁` and `h₂`.

For performance reasons `suggest` uses monadic lazy lists (`mllist`). This means that `suggest`
might miss some results if `num` is not large enough. However, because `suggest` uses monadic
lazy lists, smaller values of `num` run faster than larger values.

An example of `suggest` in action,

```lean
example (n : nat) : n < n + 1 :=
begin suggest, sorry end
```

prints the list,

```lean
Try this: exact nat.lt.base n
Try this: exact nat.lt_succ_self n
Try this: refine not_le.mp _
Try this: refine gt_iff_lt.mp _
Try this: refine nat.lt.step _
Try this: refine lt_of_not_ge _
...
```
-/
add_tactic_doc
{ name        := "suggest",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.suggest],
  tags        := ["search", "Try this"] }

-- Turn off `Try this: exact ...` trace message for `library_search`
declare_trace silence_library_search

/--
`library_search` is a tactic to identify existing lemmas in the library. It tries to close the
current goal by applying a lemma from the library, then discharging any new goals using
`solve_by_elim`.

If it succeeds, it prints a trace message `exact ...` which can replace the invocation
of `library_search`.

Typical usage is:
```lean
example (n m k : ℕ) : n * (m - k) = n * m - n * k :=
by library_search -- Try this: exact mul_tsub n m k
```

`library_search using h₁ h₂` will only show solutions
that make use of the local hypotheses `h₁` and `h₂`.

By default `library_search` only unfolds `reducible` definitions
when attempting to match lemmas against the goal.
Previously, it would unfold most definitions, sometimes giving surprising answers, or slow answers.
The old behaviour is still available via `library_search!`.

You can add additional lemmas to be used along with local hypotheses
after the application of a library lemma,
using the same syntax as for `solve_by_elim`, e.g.
```
example {a b c d: nat} (h₁ : a < c) (h₂ : b < d) : max (c + d) (a + b) = (c + d) :=
begin
  library_search [add_lt_add], -- Says: `Try this: exact max_eq_left_of_lt (add_lt_add h₁ h₂)`
end
```
You can also use `library_search with attr` to include all lemmas with the attribute `attr`.
-/
meta def library_search (semireducible : parse $ optional (tk "!"))
  (hs : parse simp_arg_list) (attr_names : parse with_ident_list)
  (use : parse $ (tk "using" *> many ident_) <|> return [])
  (opt : suggest_opt := { }) : tactic unit :=
do (lemma_thunks, ctx_thunk) ← mk_assumption_set ff hs attr_names,
   use ← use.mmap get_local,
   (tactic.library_search
     { compulsory_hyps := use,
       backtrack_all_goals := tt,
       lemma_thunks := some lemma_thunks,
       ctx_thunk := ctx_thunk,
       md := if semireducible.is_some then
         tactic.transparency.semireducible else tactic.transparency.reducible,
       ..opt } >>=
   if !opt.try_this || is_trace_enabled_for `silence_library_search then
     (λ _, skip)
   else
     trace) <|>
   fail
"`library_search` failed.
If you aren't sure what to do next, you can also
try `library_search!`, `suggest`, or `hint`.

Possible reasons why `library_search` failed:
* `library_search` will only apply a single lemma from the library,
  and then try to fill in its hypotheses from local hypotheses.
* If you haven't already, try stating the theorem you want in its own lemma.
* Sometimes the library has one version of a lemma
  but not a very similar version obtained by permuting arguments.
  Try replacing `a + b` with `b + a`, or `a - b < c` with `a < b + c`,
  to see if maybe the lemma exists but isn't stated quite the way you would like.
* Make sure that you have all the side conditions for your theorem to be true.
  For example you won't find `a - b + b = a` for natural numbers in the library because it's false!
  Search for `b ≤ a → a - b + b = a` instead.
* If a definition you made is in the goal,
  you won't find any theorems about it in the library.
  Try unfolding the definition using `unfold my_definition`.
* If all else fails, ask on https://leanprover.zulipchat.com/,
  and maybe we can improve the library and/or `library_search` for next time."

add_tactic_doc
{ name        := "library_search",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.library_search],
  tags        := ["search", "Try this"] }

end interactive

/-- Invoking the hole command `library_search` ("Use `library_search` to complete the goal") calls
the tactic `library_search` to produce a proof term with the type of the hole.

Running it on

```lean
example : 0 < 1 :=
{!!}
```

produces

```lean
example : 0 < 1 :=
nat.one_pos
```
-/
@[hole_command] meta def library_search_hole_cmd : hole_command :=
{ name := "library_search",
  descr := "Use `library_search` to complete the goal.",
  action := λ _, do
    script ← library_search,
    -- Is there a better API for dropping the 'Try this: exact ' prefix on this string?
    return [((script.get_rest "Try this: exact ").get_or_else script, "by library_search")] }

add_tactic_doc
{ name        := "library_search",
  category    := doc_category.hole_cmd,
  decl_names  := [`tactic.library_search_hole_cmd],
  tags        := ["search", "Try this"] }

end tactic


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.equiv.basic

/-!
# Functions functorial with respect to equivalences

An `equiv_functor` is a function from `Type → Type` equipped with the additional data of
coherently mapping equivalences to equivalences.

In categorical language, it is an endofunctor of the "core" of the category `Type`.
-/

universes u₀ u₁ u₂ v₀ v₁ v₂

open function

/--
An `equiv_functor` is only functorial with respect to equivalences.

To construct an `equiv_functor`, it suffices to supply just the function `f α → f β` from
an equivalence `α ≃ β`, and then prove the functor laws. It's then a consequence that
this function is part of an equivalence, provided by `equiv_functor.map_equiv`.
-/
class equiv_functor (f : Type u₀ → Type u₁) :=
(map : Π {α β}, (α ≃ β) → (f α → f β))
(map_refl' : Π α, map (equiv.refl α) = @id (f α) . obviously)
(map_trans' : Π {α β γ} (k : α ≃ β) (h : β ≃ γ),
  map (k.trans h) = (map h) ∘ (map k) . obviously)

restate_axiom equiv_functor.map_refl'
restate_axiom equiv_functor.map_trans'
attribute [simp] equiv_functor.map_refl

namespace equiv_functor

section
variables (f : Type u₀ → Type u₁) [equiv_functor f] {α β : Type u₀} (e : α ≃ β)

/-- An `equiv_functor` in fact takes every equiv to an equiv. -/
def map_equiv :
  f α ≃ f β :=
{ to_fun := equiv_functor.map e,
  inv_fun := equiv_functor.map e.symm,
  left_inv := λ x, by { convert (congr_fun (equiv_functor.map_trans e e.symm) x).symm, simp, },
  right_inv := λ y, by { convert (congr_fun (equiv_functor.map_trans e.symm e) y).symm, simp, }, }

@[simp] lemma map_equiv_apply (x : f α) :
  map_equiv f e x = equiv_functor.map e x := rfl

lemma map_equiv_symm_apply (y : f β) :
  (map_equiv f e).symm y = equiv_functor.map e.symm y := rfl

@[simp] lemma map_equiv_refl (α) :
  map_equiv f (equiv.refl α) = equiv.refl (f α) :=
by simpa [equiv_functor.map_equiv]

@[simp] lemma map_equiv_symm :
  (map_equiv f e).symm = map_equiv f e.symm :=
equiv.ext $ map_equiv_symm_apply f e

/--
The composition of `map_equiv`s is carried over the `equiv_functor`.
For plain `functor`s, this lemma is named `map_map` when applied
or `map_comp_map` when not applied.
-/
@[simp] lemma map_equiv_trans {γ : Type u₀} (ab : α ≃ β) (bc : β ≃ γ) :
  (map_equiv f ab).trans (map_equiv f bc) = map_equiv f (ab.trans bc) :=
equiv.ext $ λ x, by simp [map_equiv, map_trans']

end

@[priority 100]
instance of_is_lawful_functor
  (f : Type u₀ → Type u₁) [functor f] [is_lawful_functor f] : equiv_functor f :=
{ map := λ α β e, functor.map e,
  map_refl' := λ α, by { ext, apply is_lawful_functor.id_map, },
  map_trans' := λ α β γ k h, by { ext x, apply (is_lawful_functor.comp_map k h x), } }

lemma map_equiv.injective
  (f : Type u₀ → Type u₁) [applicative f] [is_lawful_applicative f] {α β : Type u₀}
  (h : ∀ γ, function.injective (pure : γ → f γ)) :
  function.injective (@equiv_functor.map_equiv f _ α β) :=
λ e₁ e₂ H, equiv.ext $ λ x, h β (by simpa [equiv_functor.map] using equiv.congr_fun H (pure x))

end equiv_functor


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.polynomial.big_operators
import Mathlib.field_theory.minpoly
import Mathlib.field_theory.splitting_field
import Mathlib.field_theory.tower
import Mathlib.algebra.squarefree
import Mathlib.PostPort

universes u u_1 v u_2 u_3

namespace Mathlib

/-!

# Separable polynomials

We define a polynomial to be separable if it is coprime with its derivative. We prove basic
properties about separable polynomials here.

## Main definitions

* `polynomial.separable f`: a polynomial `f` is separable iff it is coprime with its derivative.
* `polynomial.expand R p f`: expand the polynomial `f` with coefficients in a
  commutative semiring `R` by a factor of p, so `expand R p (∑ aₙ xⁿ)` is `∑ aₙ xⁿᵖ`.
* `polynomial.contract p f`: the opposite of `expand`, so it sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`.

-/

namespace polynomial

/-- A polynomial is separable iff it is coprime with its derivative. -/
def separable {R : Type u} [comm_semiring R] (f : polynomial R) :=
  is_coprime f (coe_fn derivative f)

theorem separable_def {R : Type u} [comm_semiring R] (f : polynomial R) :
    separable f ↔ is_coprime f (coe_fn derivative f) :=
  iff.rfl

theorem separable_def' {R : Type u} [comm_semiring R] (f : polynomial R) :
    separable f ↔ ∃ (a : polynomial R), ∃ (b : polynomial R), a * f + b * coe_fn derivative f = 1 :=
  iff.rfl

theorem separable_one {R : Type u} [comm_semiring R] : separable 1 := is_coprime_one_left

theorem separable_X_add_C {R : Type u} [comm_semiring R] (a : R) : separable (X + coe_fn C a) :=
  sorry

theorem separable_X {R : Type u} [comm_semiring R] : separable X :=
  eq.mpr (id (Eq._oldrec (Eq.refl (separable X)) (propext (separable_def X))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime X (coe_fn derivative X))) derivative_X))
      is_coprime_one_right)

theorem separable_C {R : Type u} [comm_semiring R] (r : R) : separable (coe_fn C r) ↔ is_unit r :=
  sorry

theorem separable.of_mul_left {R : Type u} [comm_semiring R] {f : polynomial R} {g : polynomial R}
    (h : separable (f * g)) : separable f :=
  sorry

theorem separable.of_mul_right {R : Type u} [comm_semiring R] {f : polynomial R} {g : polynomial R}
    (h : separable (f * g)) : separable g :=
  separable.of_mul_left (eq.mp (Eq._oldrec (Eq.refl (separable (f * g))) (mul_comm f g)) h)

theorem separable.of_dvd {R : Type u} [comm_semiring R] {f : polynomial R} {g : polynomial R}
    (hf : separable f) (hfg : g ∣ f) : separable g :=
  Exists.dcases_on hfg
    fun (f' : polynomial R) (hfg_h : f = g * f') =>
      Eq._oldrec (fun (hf : separable (g * f')) => separable.of_mul_left hf) (Eq.symm hfg_h) hf

theorem separable_gcd_left {F : Type u_1} [field F] {f : polynomial F} (hf : separable f)
    (g : polynomial F) : separable (euclidean_domain.gcd f g) :=
  separable.of_dvd hf (euclidean_domain.gcd_dvd_left f g)

theorem separable_gcd_right {F : Type u_1} [field F] {g : polynomial F} (f : polynomial F)
    (hg : separable g) : separable (euclidean_domain.gcd f g) :=
  separable.of_dvd hg (euclidean_domain.gcd_dvd_right f g)

theorem separable.is_coprime {R : Type u} [comm_semiring R] {f : polynomial R} {g : polynomial R}
    (h : separable (f * g)) : is_coprime f g :=
  sorry

theorem separable.of_pow' {R : Type u} [comm_semiring R] {f : polynomial R} {n : ℕ}
    (h : separable (f ^ n)) : is_unit f ∨ separable f ∧ n = 1 ∨ n = 0 :=
  sorry

theorem separable.of_pow {R : Type u} [comm_semiring R] {f : polynomial R} (hf : ¬is_unit f) {n : ℕ}
    (hn : n ≠ 0) (hfs : separable (f ^ n)) : separable f ∧ n = 1 :=
  or.resolve_right (or.resolve_left (separable.of_pow' hfs) hf) hn

theorem separable.map {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S]
    {p : polynomial R} (h : separable p) {f : R →+* S} : separable (map f p) :=
  sorry

/-- Expand the polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`. -/
def expand (R : Type u) [comm_semiring R] (p : ℕ) : alg_hom R (polynomial R) (polynomial R) :=
  alg_hom.mk (ring_hom.to_fun (eval₂_ring_hom C (X ^ p))) sorry sorry sorry sorry sorry

theorem coe_expand (R : Type u) [comm_semiring R] (p : ℕ) : ⇑(expand R p) = eval₂ C (X ^ p) := rfl

theorem expand_eq_sum {R : Type u} [comm_semiring R] (p : ℕ) {f : polynomial R} :
    coe_fn (expand R p) f = finsupp.sum f fun (e : ℕ) (a : R) => coe_fn C a * (X ^ p) ^ e :=
  id (Eq.refl (finsupp.sum f fun (e : ℕ) (a : R) => coe_fn C a * (X ^ p) ^ e))

@[simp] theorem expand_C {R : Type u} [comm_semiring R] (p : ℕ) (r : R) :
    coe_fn (expand R p) (coe_fn C r) = coe_fn C r :=
  eval₂_C C (X ^ p)

@[simp] theorem expand_X {R : Type u} [comm_semiring R] (p : ℕ) : coe_fn (expand R p) X = X ^ p :=
  eval₂_X C (X ^ p)

@[simp] theorem expand_monomial {R : Type u} [comm_semiring R] (p : ℕ) (q : ℕ) (r : R) :
    coe_fn (expand R p) (coe_fn (monomial q) r) = coe_fn (monomial (q * p)) r :=
  sorry

theorem expand_expand {R : Type u} [comm_semiring R] (p : ℕ) (q : ℕ) (f : polynomial R) :
    coe_fn (expand R p) (coe_fn (expand R q) f) = coe_fn (expand R (p * q)) f :=
  sorry

theorem expand_mul {R : Type u} [comm_semiring R] (p : ℕ) (q : ℕ) (f : polynomial R) :
    coe_fn (expand R (p * q)) f = coe_fn (expand R p) (coe_fn (expand R q) f) :=
  Eq.symm (expand_expand p q f)

@[simp] theorem expand_one {R : Type u} [comm_semiring R] (f : polynomial R) :
    coe_fn (expand R 1) f = f :=
  sorry

theorem expand_pow {R : Type u} [comm_semiring R] (p : ℕ) (q : ℕ) (f : polynomial R) :
    coe_fn (expand R (p ^ q)) f = nat.iterate (⇑(expand R p)) q f :=
  sorry

theorem derivative_expand {R : Type u} [comm_semiring R] (p : ℕ) (f : polynomial R) :
    coe_fn derivative (coe_fn (expand R p) f) =
        coe_fn (expand R p) (coe_fn derivative f) * (↑p * X ^ (p - 1)) :=
  sorry

theorem coeff_expand {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) (f : polynomial R)
    (n : ℕ) : coeff (coe_fn (expand R p) f) n = ite (p ∣ n) (coeff f (n / p)) 0 :=
  sorry

@[simp] theorem coeff_expand_mul {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p)
    (f : polynomial R) (n : ℕ) : coeff (coe_fn (expand R p) f) (n * p) = coeff f n :=
  sorry

@[simp] theorem coeff_expand_mul' {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p)
    (f : polynomial R) (n : ℕ) : coeff (coe_fn (expand R p) f) (p * n) = coeff f n :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (coeff (coe_fn (expand R p) f) (p * n) = coeff f n)) (mul_comm p n)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (coeff (coe_fn (expand R p) f) (n * p) = coeff f n))
          (coeff_expand_mul hp f n)))
      (Eq.refl (coeff f n)))

theorem expand_eq_map_domain {R : Type u} [comm_semiring R] (p : ℕ) (f : polynomial R) :
    coe_fn (expand R p) f = finsupp.map_domain (fun (_x : ℕ) => _x * p) f :=
  sorry

theorem expand_inj {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) {f : polynomial R}
    {g : polynomial R} : coe_fn (expand R p) f = coe_fn (expand R p) g ↔ f = g :=
  sorry

theorem expand_eq_zero {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) {f : polynomial R} :
    coe_fn (expand R p) f = 0 ↔ f = 0 :=
  sorry

theorem expand_eq_C {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) {f : polynomial R} {r : R} :
    coe_fn (expand R p) f = coe_fn C r ↔ f = coe_fn C r :=
  sorry

theorem nat_degree_expand {R : Type u} [comm_semiring R] (p : ℕ) (f : polynomial R) :
    nat_degree (coe_fn (expand R p) f) = nat_degree f * p :=
  sorry

theorem map_expand {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] {p : ℕ}
    (hp : 0 < p) {f : R →+* S} {q : polynomial R} :
    map f (coe_fn (expand R p) q) = coe_fn (expand S p) (map f q) :=
  sorry

theorem separable_X_sub_C {R : Type u} [comm_ring R] {x : R} : separable (X - coe_fn C x) := sorry

theorem separable.mul {R : Type u} [comm_ring R] {f : polynomial R} {g : polynomial R}
    (hf : separable f) (hg : separable g) (h : is_coprime f g) : separable (f * g) :=
  sorry

theorem separable_prod' {R : Type u} [comm_ring R] {ι : Type u_1} {f : ι → polynomial R}
    {s : finset ι} :
    (∀ (x : ι), x ∈ s → ∀ (y : ι), y ∈ s → x ≠ y → is_coprime (f x) (f y)) →
        (∀ (x : ι), x ∈ s → separable (f x)) → separable (finset.prod s fun (x : ι) => f x) :=
  sorry

theorem separable_prod {R : Type u} [comm_ring R] {ι : Type u_1} [fintype ι] {f : ι → polynomial R}
    (h1 : pairwise (is_coprime on f)) (h2 : ∀ (x : ι), separable (f x)) :
    separable (finset.prod finset.univ fun (x : ι) => f x) :=
  separable_prod'
    (fun (x : ι) (hx : x ∈ finset.univ) (y : ι) (hy : y ∈ finset.univ) (hxy : x ≠ y) => h1 x y hxy)
    fun (x : ι) (hx : x ∈ finset.univ) => h2 x

theorem separable.inj_of_prod_X_sub_C {R : Type u} [comm_ring R] [nontrivial R] {ι : Type u_1}
    {f : ι → R} {s : finset ι} (hfs : separable (finset.prod s fun (i : ι) => X - coe_fn C (f i)))
    {x : ι} {y : ι} (hx : x ∈ s) (hy : y ∈ s) (hfxy : f x = f y) : x = y :=
  sorry

theorem separable.injective_of_prod_X_sub_C {R : Type u} [comm_ring R] [nontrivial R] {ι : Type u_1}
    [fintype ι] {f : ι → R}
    (hfs : separable (finset.prod finset.univ fun (i : ι) => X - coe_fn C (f i))) :
    function.injective f :=
  fun (x y : ι) (hfxy : f x = f y) =>
    separable.inj_of_prod_X_sub_C hfs (finset.mem_univ x) (finset.mem_univ y) hfxy

theorem is_unit_of_self_mul_dvd_separable {R : Type u} [comm_ring R] {p : polynomial R}
    {q : polynomial R} (hp : separable p) (hq : q * q ∣ p) : is_unit q :=
  sorry

theorem is_local_ring_hom_expand (R : Type u) [integral_domain R] {p : ℕ} (hp : 0 < p) :
    is_local_ring_hom ↑(expand R p) :=
  sorry

theorem separable_iff_derivative_ne_zero {F : Type u} [field F] {f : polynomial F}
    (hf : irreducible f) : separable f ↔ coe_fn derivative f ≠ 0 :=
  sorry

theorem separable_map {F : Type u} [field F] {K : Type v} [field K] (f : F →+* K)
    {p : polynomial F} : separable (map f p) ↔ separable p :=
  sorry

/-- The opposite of `expand`: sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`. -/
def contract {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] (f : polynomial F) :
    polynomial F :=
  finsupp.mk (finset.preimage (finsupp.support f) (fun (_x : ℕ) => _x * p) sorry)
    (fun (n : ℕ) => coeff f (n * p)) sorry

theorem coeff_contract {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] (f : polynomial F)
    (n : ℕ) : coeff (contract p f) n = coeff f (n * p) :=
  rfl

theorem of_irreducible_expand {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)]
    {f : polynomial F} (hf : irreducible (coe_fn (expand F p) f)) : irreducible f :=
  of_irreducible_map (↑(expand F p)) hf

theorem of_irreducible_expand_pow {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)]
    {f : polynomial F} {n : ℕ} : irreducible (coe_fn (expand F (p ^ n)) f) → irreducible f :=
  sorry

theorem expand_char {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p]
    (f : polynomial F) : map (frobenius F p) (coe_fn (expand F p) f) = f ^ p :=
  sorry

theorem map_expand_pow_char {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)]
    [HF : char_p F p] (f : polynomial F) (n : ℕ) :
    map (frobenius F p ^ n) (coe_fn (expand F (p ^ n)) f) = f ^ p ^ n :=
  sorry

theorem expand_contract {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p]
    {f : polynomial F} (hf : coe_fn derivative f = 0) : coe_fn (expand F p) (contract p f) = f :=
  sorry

theorem separable_or {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p]
    {f : polynomial F} (hf : irreducible f) :
    separable f ∨ ¬separable f ∧ ∃ (g : polynomial F), irreducible g ∧ coe_fn (expand F p) g = f :=
  sorry

theorem exists_separable_of_irreducible {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)]
    [HF : char_p F p] {f : polynomial F} (hf : irreducible f) (hf0 : f ≠ 0) :
    ∃ (n : ℕ), ∃ (g : polynomial F), separable g ∧ coe_fn (expand F (p ^ n)) g = f :=
  sorry

theorem is_unit_or_eq_zero_of_separable_expand {F : Type u} [field F] (p : ℕ)
    [hp : fact (nat.prime p)] [HF : char_p F p] {f : polynomial F} (n : ℕ)
    (hf : separable (coe_fn (expand F (p ^ n)) f)) : is_unit f ∨ n = 0 :=
  sorry

theorem unique_separable_of_irreducible {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)]
    [HF : char_p F p] {f : polynomial F} (hf : irreducible f) (hf0 : f ≠ 0) (n₁ : ℕ)
    (g₁ : polynomial F) (hg₁ : separable g₁) (hgf₁ : coe_fn (expand F (p ^ n₁)) g₁ = f) (n₂ : ℕ)
    (g₂ : polynomial F) (hg₂ : separable g₂) (hgf₂ : coe_fn (expand F (p ^ n₂)) g₂ = f) :
    n₁ = n₂ ∧ g₁ = g₂ :=
  sorry

theorem separable_prod_X_sub_C_iff' {F : Type u} [field F] {ι : Type u_1} {f : ι → F}
    {s : finset ι} :
    separable (finset.prod s fun (i : ι) => X - coe_fn C (f i)) ↔
        ∀ (x : ι), x ∈ s → ∀ (y : ι), y ∈ s → f x = f y → x = y :=
  sorry

theorem separable_prod_X_sub_C_iff {F : Type u} [field F] {ι : Type u_1} [fintype ι] {f : ι → F} :
    separable (finset.prod finset.univ fun (i : ι) => X - coe_fn C (f i)) ↔ function.injective f :=
  sorry

theorem not_unit_X_sub_C {F : Type u} [field F] (a : F) : ¬is_unit (X - coe_fn C a) := sorry

theorem nodup_of_separable_prod {F : Type u} [field F] {s : multiset F}
    (hs : separable (multiset.prod (multiset.map (fun (a : F) => X - coe_fn C a) s))) :
    multiset.nodup s :=
  sorry

theorem multiplicity_le_one_of_separable {F : Type u} [field F] {p : polynomial F}
    {q : polynomial F} (hq : ¬is_unit q) (hsep : separable p) : multiplicity q p ≤ 1 :=
  sorry

theorem separable.squarefree {F : Type u} [field F] {p : polynomial F} (hsep : separable p) :
    squarefree p :=
  sorry

/--If `n ≠ 0` in `F`, then ` X ^ n - a` is separable for any `a ≠ 0`. -/
theorem separable_X_pow_sub_C {F : Type u} [field F] {n : ℕ} (a : F) (hn : ↑n ≠ 0) (ha : a ≠ 0) :
    separable (X ^ n - coe_fn C a) :=
  sorry

/--If `n ≠ 0` in `F`, then ` X ^ n - a` is squarefree for any `a ≠ 0`. -/
theorem squarefree_X_pow_sub_C {F : Type u} [field F] {n : ℕ} (a : F) (hn : ↑n ≠ 0) (ha : a ≠ 0) :
    squarefree (X ^ n - coe_fn C a) :=
  separable.squarefree (separable_X_pow_sub_C a hn ha)

theorem root_multiplicity_le_one_of_separable {F : Type u} [field F] {p : polynomial F} (hp : p ≠ 0)
    (hsep : separable p) (x : F) : root_multiplicity x p ≤ 1 :=
  sorry

theorem count_roots_le_one {F : Type u} [field F] {p : polynomial F} (hsep : separable p) (x : F) :
    multiset.count x (roots p) ≤ 1 :=
  sorry

theorem nodup_roots {F : Type u} [field F] {p : polynomial F} (hsep : separable p) :
    multiset.nodup (roots p) :=
  iff.mpr multiset.nodup_iff_count_le_one (count_roots_le_one hsep)

theorem eq_X_sub_C_of_separable_of_root_eq {F : Type u} [field F] {K : Type v} [field K]
    {i : F →+* K} {x : F} {h : polynomial F} (h_ne_zero : h ≠ 0) (h_sep : separable h)
    (h_root : eval x h = 0) (h_splits : splits i h)
    (h_roots : ∀ (y : K), y ∈ roots (map i h) → y = coe_fn i x) :
    h = coe_fn C (leading_coeff h) * (X - coe_fn C x) :=
  sorry

end polynomial

theorem irreducible.separable {F : Type u} [field F] [char_zero F] {f : polynomial F}
    (hf : irreducible f) : polynomial.separable f :=
  sorry

-- TODO: refactor to allow transcendental extensions?

-- See: https://en.wikipedia.org/wiki/Separable_extension#Separability_of_transcendental_extensions

/-- Typeclass for separable field extension: `K` is a separable field extension of `F` iff
the minimal polynomial of every `x : K` is separable. -/
def is_separable (F : Type u_1) (K : Type u_2) [field F] [field K] [algebra F K] :=
  ∀ (x : K), is_integral F x ∧ polynomial.separable (minpoly F x)

protected instance is_separable_self (F : Type u_1) [field F] : is_separable F F :=
  fun (x : F) =>
    { left := is_integral_algebra_map,
      right :=
        eq.mpr
          (id (Eq._oldrec (Eq.refl (polynomial.separable (minpoly F x))) (minpoly.eq_X_sub_C' x)))
          polynomial.separable_X_sub_C }

theorem is_separable_tower_top_of_is_separable (F : Type u_1) (K : Type u_2) (E : Type u_3)
    [field F] [field K] [field E] [algebra F K] [algebra F E] [algebra K E] [is_scalar_tower F K E]
    [h : is_separable F E] : is_separable K E :=
  sorry

theorem is_separable_tower_bot_of_is_separable (F : Type u_1) (K : Type u_2) (E : Type u_3)
    [field F] [field K] [field E] [algebra F K] [algebra F E] [algebra K E] [is_scalar_tower F K E]
    [h : is_separable F E] : is_separable F K :=
  sorry

theorem is_separable.of_alg_hom (F : Type u_1) {E : Type u_3} [field F] [field E] [algebra F E]
    (E' : Type u_2) [field E'] [algebra F E'] (f : alg_hom F E E') [is_separable F E'] :
    is_separable F E :=
  let _inst : algebra E E' := ring_hom.to_algebra (alg_hom.to_ring_hom f);
  is_separable_tower_bot_of_is_separable F E E'

end Mathlib


import util.logic
import util.category
import util.meta.tactic.basic
import util.meta.tactic.monotonicity

run_cmd do
mk_simp_attr `predicate,
mk_simp_attr `lifted_fn

namespace predicate

universe variables u u' u₀ u₁ u₂

variables {α : Sort u₀}
variables {β : Sort u₁}
variables {γ : Sort u₂}
variables {σ : Sort u'}

structure var (α : Sort u₀) (β : Sort u₁) : Sort (max u₀ u₁+1) :=
  (apply : α → β)

attribute [pp_using_anonymous_constructor] var

@[simp, predicate]
def fun_app_to_var (f : α → β) : var σ α → var σ β
 | ⟨ g ⟩ := ⟨ f ∘ g ⟩

@[simp, predicate]
def combine_var : var σ (α → β) → var σ α → var σ β
 | ⟨ f ⟩ ⟨ x ⟩ := ⟨ λ s, f s (x s) ⟩

@[reducible]
def pred' (α : Sort u) : Type (max u 1) :=
var.{u 1} α Prop

def pred'.mk := @var.mk

notation x ` ⊨ `:53 y:52 := (var.apply y x)

structure judgement (h y : pred' α) : Prop :=
(apply : ∀ σ, σ ⊨ h → σ ⊨ y)

infix ` ⊢ `:53 := judgement

def lifted₀ (p : β) : var α β := ⟨ λ _, p ⟩
def lifted₁ (op : β → γ) (p : var α β) : var α γ :=
⟨ λ i, op (i ⊨ p) ⟩
def lifted₂ (op : α → β → γ) (p : var σ α) (q : var σ β) : var σ γ :=
⟨ λ i, op (i ⊨ p) (i ⊨ q) ⟩

attribute [simp, predicate] lifted₀ lifted₁ lifted₂
attribute [predicate] var.apply var.mk pred'.mk

-- def ew (p : pred' α) : Prop :=
-- ∀ i, i ⊨ p
@[predicate]
def False {α} : pred' α := lifted₀ false
@[predicate]
def True {α} : pred' α := lifted₀ true
@[reducible]
def holds (x : pred' α) := ∀ Γ, judgement Γ x

prefix `⊩ `:53  := holds

def p_or (p₀ p₁ : pred' α) : pred' α :=
lifted₂ or p₀ p₁

@[simp, predicate]
lemma p_or_to_fun (p₀ p₁ : pred' α) (x : α)
: x ⊨ p_or p₀ p₁ ↔ x ⊨ p₀ ∨ x ⊨ p₁ := by refl

def p_and (p₀ p₁ : pred' α) : pred' α :=
lifted₂ and p₀ p₁

def p_impl (p₀ p₁ : pred' α) : pred' α :=
lifted₂ implies p₀ p₁

@[lifted_fn, reducible]
def v_eq : var α β → var α β → pred' α :=
lifted₂ eq

@[lifted_fn, reducible]
def p_equiv : pred' α → pred' α → pred' α :=
v_eq

def p_entails (p₀ p₁ : pred' α) : Prop :=
⊩ p_impl p₀ p₁

def p_not (p : pred' α) : pred' α :=
lifted₁ not p

def p_exists {β : Sort u'} {t : Sort u} (P : t → pred' β) : pred' β :=
⟨λ x, ∃ y, x ⊨ P y⟩

def p_forall {t : Sort u} {β : Sort u'} (P : t → pred' β) : pred' β :=
⟨ λ x, ∀ y, x ⊨ P y ⟩

notation `∃∃` binders `, ` r:(scoped P, p_exists P) := r
notation `∀∀` binders `, ` r:(scoped P, p_forall P) := r

infixl ` ⋁ `:65 := p_or
infixl ` ⋀ `:70 := p_and
infixr ` ⟶ `:60 := p_impl
precedence ≡:55
infixr ` ≡ ` := p_equiv
infix ` ⟹ `:60 := p_entails
-- notation `⦃ `:max act ` ⦄`:0 := ew act
-- Γ ⊢ p
-- ∀ σ, σ ⊨ Γ → σ ⊨ p
instance : has_neg (pred' α) := has_neg.mk p_not

def ctx_impl (Γ p q : pred' α) : Prop :=
Γ ⊢ p ⟶ q

instance var_functor {γ : Type _} : functor (var γ) :=
{ map := λ α β f x, ⟨ λ y, f $ x.apply y ⟩ }
instance var_has_seq {γ : Type _} : has_seq (var γ) :=
{ seq := λ α β f x, ⟨ λ s, f.apply s (x.apply s) ⟩ }
instance var_has_pure {γ : Type _} : has_pure (var γ) :=
{ pure := λ α x, ⟨ λ _, x ⟩ }
instance var_applicative {α : Type u} : applicative (var α) :=
{ ..predicate.var_functor
, ..predicate.var_has_seq
, ..predicate.var_has_pure }
instance var_has_bind {γ : Type _} : has_bind (var γ) :=
{ bind := λ α x ⟨ m ⟩ f, ⟨ λ i, (f $ m i).apply i ⟩ }
instance var_monad {γ : Type _} : monad (var γ) :=
{ ..predicate.var_applicative
, ..predicate.var_has_bind }

@[lifted_fn, reducible]
def v_lt {β : Type _} [has_lt β] : var α β → var α β → pred' α :=
lifted₂ (<)

@[lifted_fn, reducible]
def v_wf_r [has_well_founded β] : var α β → var α β → pred' α :=
lifted₂ has_well_founded.r

@[lifted_fn, reducible]
def v_le {β : Type _} [has_le β] : var α β → var α β → pred' α :=
lifted₂ (≤)

@[lifted_fn, reducible]
def v_mem {β : Type _} {γ : Type _} [has_mem β γ] : var α β → var α γ → pred' α :=
lifted₂ (∈)

infix ` ≃ `:75 := v_eq
infix ` ∊ `:75 := v_mem
infix ` ≺ `:75 := v_lt
infix ` ≼ `:75 := v_le
infix ` ≺≺ `:75 := v_wf_r
infix ` << `:50 := has_well_founded.r

def var_seq : var σ (α → β) → var σ α → var σ β
 | ⟨ f ⟩ ⟨ x ⟩ := ⟨ λ i, f i (x i) ⟩

instance val_to_var_coe : has_coe β (var α β) :=
{ coe := λ x, ⟨ λ _, x ⟩ }
instance option_val_to_var_coe {β} : has_coe β (var α (option β)) :=
{ coe := λ x, ↑(some x) }
instance var_coe_to_fun : has_coe_to_fun (var σ $ α → β) :=
{ F := λ _, var σ α → var σ β
, coe := var_seq }
def var_coe_to_fun₂ : has_coe_to_fun (var σ $ α → β → γ) :=
{ F := λ _, var σ α → var σ β → var σ γ
, coe := λ f x₀ x₁, f x₀ x₁ }
def var_coe_to_fun₃ {α₀ α₁ α₂} : has_coe_to_fun (var σ $ α₀ → α₁ → α₂ → β) :=
{ F := λ _, var σ α₀ → var σ α₁ → var σ α₂ → var σ β
, coe := λ f x₀ x₁ x₂, f x₀ x₁ x₂ }
def var_coe_to_fun₄ {α₀ α₁ α₂ α₃} : has_coe_to_fun (var σ $ α₀ → α₁ → α₂ → α₃ → β) :=
{ F := λ _, var σ α₀ → var σ α₁ → var σ α₂ → var σ α₃ → var σ β
, coe := λ f x₀ x₁ x₂ x₃, f x₀ x₁ x₂ x₃ }

abbreviation val_to_var : β → var α β :=
coe

notation `⟪ ` x ` ⟫` := (⟨ x ⟩ : var _ _)
notation `⟪ ` t, x ` ⟫` := (@val_to_var t _ x)

def proj : var β γ → var α β → var α γ
 | ⟨p⟩ ⟨f⟩ := ⟨p∘f⟩

infix ` ! `:90 := proj

@[simp, predicate, reducible]
def contramap (p : pred' α) (f : β → α) : pred' β :=
p ! ⟨ f ⟩

infixr ` '∘ `:90 := contramap

def whole : var α α := ⟨ @id α ⟩

end predicate


import analysis.inner_product_space.adjoint
import analysis.inner_product_space.basic
import analysis.inner_product_space.pi_L2
import analysis.inner_product_space.spectrum
import analysis.normed_space.pi_Lp

variable {n : ℕ}
def C : Type := euclidean_space ℂ (fin n)

notation `C` n := euclidean_space ℂ (fin n)
notation `ℂ^` n := euclidean_space ℂ (fin n)
notation `Lℂ^` n := module.End ℂ ℂ^n

notation `is_sa` := inner_product_space.is_self_adjoint
notation `I` := complex.I

localized "postfix `†`:1000 := linear_map.adjoint" in src

variable {T : module.End ℂ ℂ^n}

example (v : ℂ^n) : v = v :=
begin
  exact rfl,
end

lemma inner_with_all_eq_zero_eq_zero (v : ℂ^ n) : (∀ u : ℂ^n, ⟪u, v⟫_ℂ = 0) → v = 0 :=
begin
  intro h,
  by_contra',
  specialize h v,
  rw inner_self_eq_zero at h,
  exact this h,
end

lemma comp_eq_mul (A B : Lℂ^n) (v : ℂ^n) : A (B v) = (A * B) v := by {simp}
lemma comp_eq_mul' (A B : Lℂ^n) (v : ℂ^n) : (A.comp B) v = A (B v) := by {simp}
lemma comp_eq_mul'' (A B : Lℂ^n) : (A.comp B) = A * B := by {ext, rw ← comp_eq_mul, rw comp_eq_mul', rw ← comp_eq_mul, rw comp_eq_mul'}

lemma adjoint_prod (A B : Lℂ^n) : (A * B)† = B† * A† :=
begin
  rw ← comp_eq_mul'',
  rw linear_map.adjoint_comp,
  rw comp_eq_mul'',
end

lemma mul_adjoint (A B : Lℂ^n) : (A * B)† = B† * A† := adjoint_prod A B

lemma sub_adjoint (A B : Lℂ^n) : (A - B)† = A† - B† := by {simp}

lemma norm_sq_eq_zero (v : ℂ^n) : ∥ v ∥^2 = 0 ↔ v = 0 :=
begin
  split,
  rw ← real.sqrt_eq_zero,
  rw real.sqrt_sq,
  rw norm_eq_zero,
  intro h,
  exact h,
  exact norm_nonneg v,
  exact sq_nonneg (∥ v ∥),
  intro h,
  rw h,
  simp,
end

lemma adjoint_prod_sa : is_sa (T† * T) :=
begin
  intros x y,
  rw ← linear_map.adjoint_inner_right,
  rw mul_adjoint,
  rw linear_map.adjoint_adjoint,
end

lemma sa_means_dag_eq_no_dag : (is_sa T) → T† = T :=
begin
  intro h,
  ext1,
  have : T† x - T x = 0 :=
  begin
    apply inner_with_all_eq_zero_eq_zero,
    intro u,

    calc ⟪ u , (T† x) - (T x) ⟫_ℂ = ⟪ u, T† x ⟫_ℂ - ⟪ u , T x ⟫_ℂ : by {rw inner_sub_right}
    ...                      = ⟪ T u, x ⟫_ℂ - ⟪ u , T x ⟫_ℂ : by {rw linear_map.adjoint_inner_right}
    ...                      = ⟪ u, T x ⟫_ℂ - ⟪ u, T x ⟫_ℂ : by {rw (h u x)}
    ...                      = 0 : by {ring},
  end,
  rw sub_eq_zero at this,
  exact this,
end

noncomputable lemma quot_by_same_is_eq {M₁ M₂ : submodule ℂ ℂ^n} (h : M₁ = M₂) : ((ℂ^n) ⧸ M₁) ≃ₗ[ℂ] ((ℂ^n) ⧸ M₂) :=
begin
  rw h,
end

lemma norm_sq_one_norm_eq_one (v : ℂ^n) : ∥ v ∥^2 = 1 → ∥ v ∥ = 1 :=
begin
  intro h,
  rw ← real.sqrt_eq_iff_sq_eq at h,
  rw ← h,
  exact real.sqrt_one,
  exact zero_le_one,
  exact norm_nonneg v,
end

lemma lin_iso_preserves_on {ι : Type} {S : submodule ℂ ℂ^n} (b : ι → S ) (h : orthonormal ℂ b) (L : S →ₗᵢ[ℂ] ℂ^n) : orthonormal ℂ (L ∘ b) :=
begin
  unfold orthonormal,
  split,
  intro i,
  apply norm_sq_one_norm_eq_one,
  apply complex.of_real_injective,

  calc ↑(∥(L ∘ b) i∥ ^ 2) = (∥ (L ∘ b) i ∥ : ℂ )^2 : by {simp only [complex.of_real_pow, linear_isometry_equiv.coe_to_linear_isometry, eq_self_iff_true, function.comp_app, linear_isometry_equiv.norm_map]}
    ...              = ↑∥ L (b i) ∥^2 : by {simp only [linear_isometry_equiv.coe_to_linear_isometry, eq_self_iff_true, function.comp_app, linear_isometry_equiv.norm_map]}
    ...              = ⟪ L (b i), L (b i) ⟫_ℂ : by {rw inner_self_eq_norm_sq_to_K}
    ...              = ⟪ b i , b i ⟫_ℂ : by {rw linear_isometry.inner_map_map}
    ...              = (∥ b i ∥^2 : ℂ) : by {rw inner_self_eq_norm_sq_to_K}
    ...              = ((1 : ℝ) : ℂ) : by {rw h.1 i, simp only [one_pow, complex.of_real_one, eq_self_iff_true]},
  intros i j hij,
  rw linear_isometry.inner_map_map,
  exact h.2 hij,
end