import Duper.MClause
import Duper.RuleM
import Duper.Simp
import Duper.Util.ProofReconstruction
import Duper.Util.Misc
import Duper.Util.AbstractMVars

namespace Duper
open Lean
open RuleM
open Meta
open SimpResult

initialize Lean.registerTraceClass `Rule.clausification

--TODO: move?
theorem not_of_eq_false (h: p = False) : ¬ p :=
  fun hp => h ▸ hp

--TODO: move?
theorem of_not_eq_false (h: (¬ p) = False) : p :=
  Classical.byContradiction fun hn => h ▸ hn

--TODO: move?
theorem eq_true_of_not_eq_false (h : (¬ p) = False) : p = True :=
  eq_true (of_not_eq_false h)

--TODO: move?
theorem eq_false_of_not_eq_true (h : (¬ p) = True) : p = False :=
  eq_false (of_eq_true h)

--TODO: move?
theorem clausify_and_left (h : (p ∧ q) = True) : p = True :=
  eq_true (of_eq_true h).left

--TODO: move?
theorem clausify_and_right (h : (p ∧ q) = True) : q = True :=
  eq_true (of_eq_true h).right

--TODO: move?
theorem clausify_and_false (h : (p ∧ q) = False) : p = False ∨ q = False := by
  apply @Classical.byCases p
  · intro hp
    apply @Classical.byCases q
    · intro hq
      exact False.elim $ not_of_eq_false h ⟨hp, hq⟩
    · intro hq
      exact Or.intro_right _ (eq_false hq)
  · intro hp
    exact Or.intro_left _ (eq_false hp)

--TODO: move?
theorem clausify_or (h : (p ∨ q) = True) : p = True ∨ q = True :=
  (of_eq_true h).elim
    (fun h => Or.intro_left _ (eq_true h))
    (fun h => Or.intro_right _ (eq_true h))

--TODO: move?
theorem clausify_or_false_left (h : (p ∨ q) = False) : p = False :=
  eq_false fun hp => not_of_eq_false h (Or.intro_left _ hp)

--TODO: move?
theorem clausify_or_false_right (h : (p ∨ q) = False) : q = False :=
  eq_false fun hp => not_of_eq_false h (Or.intro_right _ hp)

--TODO: move?
theorem clausify_not (h : (¬ p) = True) : p = False :=
eq_false fun hp => of_eq_true h hp

--TODO: move?
theorem clausify_not_false (h : (¬ p) = False) : p = True :=
eq_true (Classical.byContradiction fun hp => not_of_eq_false h hp)

--TODO: move?
theorem clausify_imp (h : (p → q) = True) : p = False ∨ q = True := by
  cases Classical.propComplete q with
  | inl q_eq_true => exact Or.intro_right _ q_eq_true
  | inr q_eq_false =>
    cases Classical.propComplete p with
    | inl p_eq_true =>
      rw [p_eq_true, q_eq_false] at h
      have t : True := ⟨⟩
      rw [← h] at t
      exact False.elim (t ⟨⟩)
    | inr p_eq_false => exact Or.intro_left _ p_eq_false

--TODO: move?
theorem clausify_imp_false_left (h : (p → q) = False) : p = True :=
  Classical.byContradiction fun hnp =>
    not_of_eq_false h fun hp =>
      False.elim (hnp $ eq_true hp)

--TODO: move?
theorem clausify_imp_false_right (h : (p → q) = False) : q = False :=
  eq_false fun hq => not_of_eq_false h fun _ => hq

--TODO: move?
theorem clausify_forall {p : α → Prop} (x : α) (h : (∀ x, p x) = True) : p x = True :=
  eq_true (of_eq_true h x)

--TODO: move?
theorem clausify_exists {p : α → Prop} (h : (∃ x, p x) = True) :
  p (Classical.choose (of_eq_true h)) = True :=
eq_true $ Classical.choose_spec _

theorem nonempty_of_exists {p : α → Prop} (h : (∃ x : α, p x) = True) : Nonempty α :=
  Nonempty.intro (Classical.choose (of_eq_true h))

--TODO: move?
theorem clausify_exists_false {p : α → Prop} (x : α) (h : (∃ x, p x) = False) : p x = False :=
  eq_false (fun hp => not_of_eq_false h ⟨x, hp⟩)

theorem nonempty_of_forall_eq_false {p : α → Prop} (h : (∀ x : α, p x) = False) : Nonempty α := by
  apply Classical.byContradiction
  intro h_nonempty
  apply not_of_eq_false h
  intro x
  exfalso
  exact h_nonempty (Nonempty.intro x)

--TODO: move
noncomputable def Skolem.some (p : α → Prop) (x : α) :=
  let _ : Decidable (∃ a, p a) := Classical.propDecidable _
  if hp: ∃ a, p a then Classical.choose hp else x

--TODO: move
theorem Skolem.spec {p : α → Prop} (x : α) (hp : ∃ a, p a) :
  p (Skolem.some p x) := by
  simp only [Skolem.some, hp]
  exact Classical.choose_spec _

theorem exists_of_forall_eq_false {p : α → Prop} (h : (∀ x, p x) = False) : ∃ x, ¬ p x := by
  apply Classical.byContradiction
  intro hnex
  apply not_of_eq_false h
  intro x
  apply Classical.byContradiction
  intro hp
  apply hnex
  exact Exists.intro x hp

theorem false_neq_true : False ≠ True := fun h => of_eq_true h

theorem true_neq_false : True ≠ False := fun h => of_eq_true h.symm

theorem clausify_iff (h : (p ↔ q) = True) : p = q := by
  apply propext
  rw [h]
  exact True.intro

theorem clausify_iff1 (h : (p ↔ q) = True) : p = True ∨ q = False := by
  cases Classical.propComplete p with
  | inl p_eq_true => exact Or.inl p_eq_true
  | inr p_eq_false =>
    rw [← clausify_iff h]
    exact Or.inr p_eq_false

theorem clausify_iff2 (h : (p ↔ q) = True) : p = False ∨ q = True := by
  cases Classical.propComplete p with
  | inl p_eq_true =>
    rw [← clausify_iff h]
    exact Or.inr p_eq_true
  | inr p_eq_false => exact Or.inl p_eq_false

theorem clausify_not_iff (h : (p ↔ q) = False) : p ≠ q := by
  intro p_eq_q
  rw [← h, p_eq_q]

theorem clausify_not_iff1 (h : (p ↔ q) = False) : p = False ∨ q = False := by
  cases Classical.propComplete p with
  | inl p_eq_true =>
    cases Classical.propComplete q with
    | inl q_eq_true =>
      rw [p_eq_true, q_eq_true] at h
      exact False.elim $ (clausify_not_iff h) rfl
    | inr q_eq_false => exact Or.intro_right _ q_eq_false
  | inr p_eq_false => exact Or.intro_left _ p_eq_false

theorem clausify_not_iff2 (h : (p ↔ q) = False) : p = True ∨ q = True := by
  cases Classical.propComplete p with
  | inl p_eq_true => exact Or.intro_left _ p_eq_true
  | inr p_eq_false =>
    cases Classical.propComplete q with
    | inl q_eq_true => exact Or.intro_right _ q_eq_true
    | inr q_eq_false =>
      rw [p_eq_false, q_eq_false] at h
      exact False.elim $ (clausify_not_iff h) rfl

theorem clausify_prop_inequality1 {p : Prop} {q : Prop} (h : p ≠ q) : p = False ∨ q = False := by
  cases Classical.propComplete p with
  | inl p_eq_true =>
    cases Classical.propComplete q with
    | inl q_eq_true =>
      rw [p_eq_true, q_eq_true] at h
      exact False.elim $ h rfl
    | inr q_eq_false => exact Or.intro_right _ q_eq_false
  | inr p_eq_false => exact Or.intro_left _ p_eq_false

theorem clausify_prop_inequality2 {p : Prop} {q : Prop} (h : p ≠ q) : p = True ∨ q = True := by
  cases Classical.propComplete p with
  | inl p_eq_true => exact Or.intro_left _ p_eq_true
  | inr p_eq_false =>
    cases Classical.propComplete q with
    | inl q_eq_true => exact Or.intro_right _ q_eq_true
    | inr q_eq_false =>
      rw [p_eq_false, q_eq_false] at h
      exact False.elim $ h rfl

structure ClausificationResult where
  resultLits        : Array Lit
  -- The `Array Expr` is the `freshVars`
  proof             : Expr → Array Expr → MetaM Expr
  transferExprs     : Array Expr

def clausificationStepE (e : Expr) (sign : Bool) : RuleM (Array ClausificationResult) :=
  match sign, e with
  | false, Expr.const ``True _ =>
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``true_neq_false #[premise]
    return #[⟨#[], pr, #[]⟩]
  | true, Expr.const ``False _ =>
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``false_neq_true #[premise]
    return #[⟨#[], pr, #[]⟩]
  | true, Expr.app (Expr.const ``Not _) e =>
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_not #[premise]
    return #[⟨#[Lit.fromSingleExpr e false], pr, #[]⟩]
  | false, Expr.app (Expr.const ``Not _) e =>
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_not_false #[premise]
    return #[⟨#[Lit.fromSingleExpr e true], pr, #[]⟩]
  | true, Expr.app (Expr.app (Expr.const ``And _) e₁) e₂ =>
    let pr₁ : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_and_left #[premise]
    let pr₂ : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_and_right #[premise]
    /- e₂ and pr₂ are placed first in the list because "∧" is right-associative. So if we decompose "a ∧ b ∧ c ∧ d... = True" we want
       "b ∧ c ∧ d... = True" to be the first clause (which will return to Saturate's simpLoop to receive further clausification) -/
    return #[⟨#[Lit.fromSingleExpr e₂], pr₂, #[]⟩, ⟨#[Lit.fromSingleExpr e₁], pr₁, #[]⟩]
  | true, Expr.app (Expr.app (Expr.const ``Or _) e₁) e₂ =>
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_or #[premise]
    return #[⟨#[Lit.fromSingleExpr e₁, Lit.fromSingleExpr e₂], pr, #[]⟩]
  | true, Expr.forallE _ ty b _ => do
    if (← inferType ty).isProp && !b.hasLooseBVars then
      let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_imp #[premise]
      return #[⟨#[Lit.fromSingleExpr ty false, Lit.fromSingleExpr b], pr, #[]⟩]
    else
      let pr : Expr → Array Expr → MetaM Expr := fun premise trs => do
        let #[tr] := trs
          | throwError "clausificationStepE :: Wrong number of transferExprs"
        Meta.mkAppM ``clausify_forall #[tr, premise]
      let mvar ← mkFreshExprMVar ty
      return #[⟨#[Lit.fromSingleExpr $ b.instantiate1 mvar], pr, #[mvar]⟩]
  | true, Expr.app (Expr.app (Expr.const ``Exists lvls) ty) tran@(Expr.lam _ _ b _) => do
    let (skTerm, newmvar) ← makeSkTerm ty b
    let pr1 : Expr → Array Expr → MetaM Expr := fun premise trs => do
      let #[tr, trp] := trs
          | throwError "clausificationStepE :: Wrong number of transferExprs"
      return ← Meta.mkAppM ``eq_true
        #[← Meta.mkAppOptM ``Skolem.spec #[none, trp, tr, ← Meta.mkAppM ``of_eq_true #[premise]]]
    let pr2 : Expr → Array Expr → MetaM Expr := fun premise _ => do
      let nonempty ← Meta.mkAppM ``nonempty_of_exists #[premise]
      Meta.mkAppM ``eq_true #[nonempty]
    let res1 : ClausificationResult := ⟨#[Lit.fromSingleExpr $ b.instantiate1 skTerm], pr1, #[newmvar, tran]⟩
    let res2 : ClausificationResult := ⟨#[Lit.fromSingleExpr $ ← mkAppM ``Nonempty #[ty]], pr2, #[]⟩
    if ← getInhabitationReasoningM then
      return #[res1, res2]
    else
      return #[res1]
  | false, Expr.app (Expr.app (Expr.const ``And _) e₁) e₂  =>
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_and_false #[premise]
    return #[⟨#[Lit.fromSingleExpr e₁ false, Lit.fromSingleExpr e₂ false], pr, #[]⟩]
  | false, Expr.app (Expr.app (Expr.const ``Or _) e₁) e₂ =>
    let pr₁ : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_or_false_left #[premise]
    let pr₂ : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_or_false_right #[premise]
    /- e₂ and pr₂ are placed first in the list because "∨" is right-associative. So if we decompose "a ∨ b ∨ c ∨ d... = False" we want
       "b ∨ c ∨ d... = False" to be the first clause (which will return to Saturate's simpLoop to receive further clausification) -/
    return #[⟨#[Lit.fromSingleExpr e₂ false], pr₂, #[]⟩, ⟨#[Lit.fromSingleExpr e₁ false], pr₁, #[]⟩]
  | false, Expr.forallE name ty b bi => do
    if (← inferType ty).isProp && !b.hasLooseBVars then
      let pr₁ : Expr → Array Expr → MetaM Expr := fun premise _ =>
        Meta.mkAppM ``clausify_imp_false_left #[premise]
      let pr₂ : Expr → Array Expr → MetaM Expr := fun premise _ =>
        Meta.mkAppM ``clausify_imp_false_right #[premise]
      return #[⟨#[Lit.fromSingleExpr ty], pr₁, #[]⟩, ⟨#[Lit.fromSingleExpr b false], pr₂, #[]⟩]
    let (skTerm, newmvar) ← makeSkTerm ty (mkNot b)
    let pr1 : Expr → Array Expr → MetaM Expr := fun premise trs => do
      let #[tr, trp] := trs
        | throwError "clausificationStepE :: Wrong number of transferExprs"
      Meta.mkAppM ``eq_true #[← Meta.mkAppOptM ``Skolem.spec #[none, trp, tr, ← Meta.mkAppM ``exists_of_forall_eq_false #[premise]]]
    let pr2 : Expr → Array Expr → MetaM Expr := fun premise _ => do
      let nonempty ← Meta.mkAppM ``nonempty_of_forall_eq_false #[premise]
      Meta.mkAppM ``eq_true #[nonempty]
    let res1 : ClausificationResult := ⟨#[Lit.fromSingleExpr $ mkNot (b.instantiate1 skTerm)], pr1, #[newmvar, Expr.lam name ty (mkNot b) bi]⟩
    let res2 : ClausificationResult := ⟨#[Lit.fromSingleExpr $ ← mkAppM ``Nonempty #[ty]], pr2, #[]⟩
    if ← getInhabitationReasoningM then
      return #[res1, res2]
    else
      return #[res1]
  | false, Expr.app (Expr.app (Expr.const ``Exists _) ty) (Expr.lam _ _ b _) => do
    let pr : Expr → Array Expr → MetaM Expr := fun premise trs => do
      let #[tr] := trs
        | throwError "clausificationStepE :: Wrong number of transferExprs"
      Meta.mkAppM ``clausify_exists_false #[tr, premise]
    let mvar ← mkFreshExprMVar ty
    return #[⟨#[Lit.fromSingleExpr (b.instantiate1 mvar) false], pr, #[mvar]⟩]
  | true, Expr.app (Expr.app (Expr.app (Expr.const ``Eq [lvl]) ty) e₁) e₂  =>
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``of_eq_true #[premise]
    return #[⟨#[{sign := true, lhs := e₁, rhs := e₂, lvl := lvl, ty := ty}], pr, #[]⟩]
  | false, Expr.app (Expr.app (Expr.app (Expr.const ``Eq [lvl]) ty) e₁) e₂  =>
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``not_of_eq_false #[premise]
    return #[⟨#[{sign := false, lhs := e₁, rhs := e₂, lvl := lvl, ty := ty}], pr, #[]⟩]
  | true, Expr.app (Expr.app (Expr.app (Expr.const ``Ne [lvl]) ty) e₁) e₂  =>
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``of_eq_true #[premise]
    return #[⟨#[{sign := false, lhs := e₁, rhs := e₂, lvl := lvl, ty := ty}], pr, #[]⟩]
  | false, Expr.app (Expr.app (Expr.app (Expr.const ``Ne [lvl]) ty) e₁) e₂  =>
    --This case is saying if the clause is (e_1 ≠ e_2) = False, then we can turn that into e_1 = e_2
    let pr : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``of_not_eq_false #[premise]
    return #[⟨#[{sign := true, lhs := e₁, rhs := e₂, lvl := lvl, ty := ty}], pr, #[]⟩]
  | true, Expr.app (Expr.app (Expr.const ``Iff _) e₁) e₂ =>
    let pr1 : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_iff1 #[premise]
    let pr2 : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_iff2 #[premise]
    return #[
        ⟨#[Lit.fromSingleExpr e₁ true, Lit.fromSingleExpr e₂ false], pr1, #[]⟩,
        ⟨#[Lit.fromSingleExpr e₁ false, Lit.fromSingleExpr e₂ true], pr2, #[]⟩
      ]
  | false, Expr.app (Expr.app (Expr.const ``Iff _) e₁) e₂ =>
    let pr1 : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_not_iff1 #[premise]
    let pr2 : Expr → Array Expr → MetaM Expr := fun premise _ => Meta.mkAppM ``clausify_not_iff2 #[premise]
    return #[
        ⟨#[Lit.fromSingleExpr e₁ false, Lit.fromSingleExpr e₂ false], pr1, #[]⟩,
        ⟨#[Lit.fromSingleExpr e₁ true, Lit.fromSingleExpr e₂ true], pr2, #[]⟩
      ]
  | _, _ => do
    trace[Rule.clausification] "### clausificationStepE is unapplicable with e = {e} and sign = {sign}"
    return #[]
where
  -- h : (∃ x : ty, p x)
  -- sk : (∃ x : ty, p x) → ty
  --     No! May contain metavariables
  -- sk : ∀ [metavars], ty → ty :=
  --   fun [metavars] => Skolem.some (fun x : ty => p x)
  -- sk_spec : ∀ [metavars] (x : ty), (∃ x : ty, p x) → p (sk [metavars] x) :=
  --   fun [metavars] (x : ty) (h : ∃ x, p x) => Skolem.spec x h
  -- We don't need to construct `sk_spec` explicitly. We
  --   can directly use `Skolem.spec` and leave the job of unification
  --   to Lean
  -- Note: Proof reconstruction of skolems is independent of proof reconstruction of clauses.
  makeSkTerm ty b : RuleM (Expr × Expr) := do
    let skMap ← getSkolemMap
    let cnt := skMap.size
    let p := mkLambda `x BinderInfo.default ty b
    let prf_pre ← mkAppM ``Skolem.some #[p]
    let (prf, mids, lnames, lvls) ← Duper.abstractMVarsLambdaWithIds prf_pre
    let isk : SkolemInfo := {expr := prf, params := lnames}
    setSkolemMap (skMap.insert cnt isk)
    let skTy ← inferType prf
    let skLvl := (← inferType skTy).sortLevel!
    let skolemSorryName ← getSkolemSorryName
    let wrapped ← wrapSort lnames
    let sLvl := (← Meta.inferType wrapped).sortLevel!
    let skExpr := Expr.app (.app (.app (.const skolemSorryName [sLvl, skLvl]) wrapped) (.lit (.natVal cnt))) skTy
    let skExpr := skExpr.instantiateLevelParamsArray lnames lvls
    let newmvar ← mkFreshExprMVar ty
    return (mkApp (mkAppN skExpr mids) newmvar, newmvar)

-- Important: We return `Array ClausificationResult` instead of
--   `Option (Array ClausificationResult)` because whenever a literal
--   can be clausified, the result is always a non-empty list.
-- So, to check whether clausification succeeded, we only need
--   to check whether the returned list is empty.
def clausificationStepLit (c : MClause) (i : Nat) : RuleM (Array ClausificationResult) := do
  let l := c.lits[i]!
  if not l.ty.isProp then return #[]
  if l.sign then
    -- Clausify " = False" and "= True":
    match l.rhs with
    | Expr.const ``True _ => clausificationStepE l.lhs true
    | Expr.const ``False _ => clausificationStepE l.lhs false
    | _ =>
      -- Clausify "True = ..." and "False = ...":
      match l.lhs with
      | Expr.const ``True _ =>
        let clausifiedResList ← clausificationStepE l.rhs true
        let map_fn : ClausificationResult → ClausificationResult :=
          fun ⟨c, pr, tr⟩ => -- If pr is a proof that "A = B" implies c, then we want to return a proof that "B = A" implies c
              let symmProof : Expr → Array Expr → MetaM Expr := fun e fsf => do pr (← Meta.mkAppM ``Eq.symm #[e]) fsf
              ⟨c, symmProof, tr⟩
        return clausifiedResList.map map_fn
      | Expr.const ``False _ =>
        let clausifiedResList ← clausificationStepE l.rhs false
        let map_fn : ClausificationResult → ClausificationResult :=
          fun ⟨c, pr, tr⟩ => -- If pr is a proof that "A = B" implies c, then we want to return a proof that "B = A" implies c
              let symmProof : Expr → Array Expr → MetaM Expr := fun e fsf => do pr (← Meta.mkAppM ``Eq.symm #[e]) fsf
              ⟨c, symmProof, tr⟩
        return clausifiedResList.map map_fn
      | _ => return #[]
  else
    -- Clausify inequalities of type Prop:
    let pr1 : Expr → Array Expr → MetaM Expr := fun premise _ => do
      Meta.mkAppM ``clausify_prop_inequality1 #[premise]
    let pr2 : Expr → Array Expr → MetaM Expr := fun premise _ => do
      Meta.mkAppM ``clausify_prop_inequality2 #[premise]
    return #[⟨#[Lit.fromSingleExpr l.lhs false, Lit.fromSingleExpr l.rhs false], pr1, #[]⟩,
             ⟨#[Lit.fromSingleExpr l.lhs true, Lit.fromSingleExpr l.rhs true], pr2, #[]⟩]

-- TODO: generalize combination of `orCases` and `orIntro`?
def clausificationStep : MSimpRule := fun c => do
  let c ← loadClause c
  for i in [:c.lits.size] do
    let ds ← clausificationStepLit c i
    if ds.isEmpty then
      continue
    let mut resultClauses := #[]
    for ⟨d, dproof, tr⟩ in ds do
      let mkProof : ProofReconstructor :=
        fun (premises : List Expr) (parents : List ProofParent) (transferExprs : Array Expr) (res : Clause) => do
          Meta.forallTelescope res.toForallExpr fun xs body => do
            let resLits := res.lits.map (fun l => Lit.map (fun e => e.instantiateRev xs) l)
            let (parentLits, appliedPremise, transferExprs) ← instantiatePremises parents premises xs transferExprs
            let parentLits := parentLits[0]!
            let appliedPremise := appliedPremise[0]!

            let mut caseProofs := Array.mkEmpty parentLits.size
            for j in [:parentLits.size] do
              let lit := parentLits[j]!
              let pr ← Meta.withLocalDeclD `h lit.toExpr fun h => do
                if j == i then
                  let resLeft := resLits.toList.take (c.lits.size - 1)
                  let resRight := resLits.toList.drop (c.lits.size - 1)
                  -- Temporaryly use `Clause` to construct the expected type
                  -- So we don't need to supply universe parameters
                  let resRight' := (Clause.mk #[] #[] resRight.toArray).toForallExpr
                  let resLits' := (resLeft.map Lit.toExpr).toArray.push resRight'
                  let dproof ← dproof h transferExprs
                  if resRight.length == 0 then
                    Meta.mkLambdaFVars #[h] $ ← Meta.mkAppOptM ``False.elim #[body, dproof]
                  else
                    Meta.mkLambdaFVars #[h] $ ← orIntro resLits' (c.lits.size - 1) dproof
                else
                  let idx := if j ≥ i then j - 1 else j
                  Meta.mkLambdaFVars #[h] $ ← orIntro (resLits.map Lit.toExpr) idx h
              caseProofs := caseProofs.push $ pr

            let r ← orCases (parentLits.map Lit.toExpr) caseProofs
            let r ← Meta.mkLambdaFVars xs $ mkApp r appliedPremise
            return r
      let newClause := ⟨c.lits.eraseIdx i ++ d⟩
      trace[Rule.clausification] "Yielding newClause: {newClause.lits}"
      let newResult ← yieldClause newClause "clausification" mkProof tr
      resultClauses := resultClauses.push newResult
    return some resultClauses
  return none

end Duper


/-
Copyright (c) 2020 Thomas Browning and Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning and Patrick Lutz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.field_theory.normal
import Mathlib.field_theory.primitive_element
import Mathlib.field_theory.fixed
import Mathlib.ring_theory.power_basis
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Galois Extensions

In this file we define Galois extensions as extensions which are both separable and normal.

## Main definitions

- `is_galois F E` where `E` is an extension of `F`
- `fixed_field H` where `H : subgroup (E ≃ₐ[F] E)`
- `fixing_subgroup K` where `K : intermediate_field F E`
- `galois_correspondence` where `E/F` is finite dimensional and Galois

## Main results

- `fixing_subgroup_of_fixed_field` : If `E/F` is finite dimensional (but not necessarily Galois)
  then `fixing_subgroup (fixed_field H) = H`
- `fixed_field_of_fixing_subgroup`: If `E/F` is finite dimensional and Galois
  then `fixed_field (fixing_subgroup K) = K`
Together, these two result prove the Galois correspondence

- `is_galois.tfae` : Equivalent characterizations of a Galois extension of finite degree
-/

/-- A field extension E/F is galois if it is both separable and normal -/
def is_galois (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] :=
  is_separable F E ∧ normal F E

namespace is_galois

protected instance self (F : Type u_1) [field F] : is_galois F F :=
  { left := Mathlib.is_separable_self F, right := Mathlib.normal_self F }

protected instance to_is_separable (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] [h : is_galois F E] : is_separable F E :=
  and.left h

protected instance to_normal (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] [h : is_galois F E] : normal F E :=
  and.right h

theorem integral (F : Type u_1) [field F] {E : Type u_2} [field E] [algebra F E] [is_galois F E] (x : E) : is_integral F x :=
  normal.is_integral F x

theorem separable (F : Type u_1) [field F] {E : Type u_2} [field E] [algebra F E] [h : is_galois F E] (x : E) : polynomial.separable (minpoly F x) :=
  and.right (and.left h x)

-- TODO(Commelin, Browning): rename this to `splits`

theorem normal (F : Type u_1) [field F] {E : Type u_2} [field E] [algebra F E] [is_galois F E] (x : E) : polynomial.splits (algebra_map F E) (minpoly F x) :=
  normal.splits F x

protected instance of_fixed_field (E : Type u_2) [field E] (G : Type u_1) [group G] [fintype G] [mul_semiring_action G E] : is_galois (↥(mul_action.fixed_points G E)) E :=
  { left := fixed_points.separable G E, right := fixed_points.normal G E }

theorem intermediate_field.adjoin_simple.card_aut_eq_findim (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] [finite_dimensional F E] {α : E} (hα : is_integral F α) (h_sep : polynomial.separable (minpoly F α)) (h_splits : polynomial.splits (algebra_map F ↥(intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α))) (minpoly F α)) : fintype.card
    (alg_equiv F ↥(intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α))
      ↥(intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α))) =
  finite_dimensional.findim F ↥(intermediate_field.adjoin F (intermediate_field.insert.insert ∅ α)) := sorry

theorem card_aut_eq_findim (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] [finite_dimensional F E] [h : is_galois F E] : fintype.card (alg_equiv F E E) = finite_dimensional.findim F E := sorry

end is_galois

theorem is_galois.tower_top_of_is_galois (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] [is_galois F E] : is_galois K E :=
  { left := is_separable_tower_top_of_is_separable F K E, right := normal.tower_top_of_normal F K E }

protected instance is_galois.tower_top_intermediate_field {F : Type u_1} {E : Type u_3} [field F] [field E] [algebra F E] (K : intermediate_field F E) [h : is_galois F E] : is_galois (↥K) E :=
  is_galois.tower_top_of_is_galois F (↥K) E

theorem is_galois_iff_is_galois_bot {F : Type u_1} {E : Type u_3} [field F] [field E] [algebra F E] : is_galois (↥⊥) E ↔ is_galois F E :=
  { mp := fun (h : is_galois (↥⊥) E) => is_galois.tower_top_of_is_galois (↥⊥) F E,
    mpr := fun (h : is_galois F E) => is_galois.tower_top_intermediate_field ⊥ }

theorem is_galois.of_alg_equiv {F : Type u_1} {E : Type u_3} [field F] [field E] {E' : Type u_4} [field E'] [algebra F E'] [algebra F E] [h : is_galois F E] (f : alg_equiv F E E') : is_galois F E' :=
  { left := is_separable.of_alg_hom F E ↑(alg_equiv.symm f), right := normal.of_alg_equiv f }

theorem alg_equiv.transfer_galois {F : Type u_1} {E : Type u_3} [field F] [field E] {E' : Type u_4} [field E'] [algebra F E'] [algebra F E] (f : alg_equiv F E E') : is_galois F E ↔ is_galois F E' :=
  { mp := fun (h : is_galois F E) => is_galois.of_alg_equiv f,
    mpr := fun (h : is_galois F E') => is_galois.of_alg_equiv (alg_equiv.symm f) }

theorem is_galois_iff_is_galois_top {F : Type u_1} {E : Type u_3} [field F] [field E] [algebra F E] : is_galois F ↥⊤ ↔ is_galois F E :=
  alg_equiv.transfer_galois intermediate_field.top_equiv

protected instance is_galois_bot {F : Type u_1} {E : Type u_3} [field F] [field E] [algebra F E] : is_galois F ↥⊥ :=
  iff.mpr (alg_equiv.transfer_galois intermediate_field.bot_equiv) (is_galois.self F)

namespace intermediate_field

protected instance subgroup_action {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (H : subgroup (alg_equiv F E E)) : faithful_mul_semiring_action (↥H) E :=
  faithful_mul_semiring_action.mk sorry

/-- The intermediate_field fixed by a subgroup -/
def fixed_field {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (H : subgroup (alg_equiv F E E)) : intermediate_field F E :=
  mk (mul_action.fixed_points (↥H) E) sorry sorry sorry sorry sorry sorry sorry

theorem findim_fixed_field_eq_card {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (H : subgroup (alg_equiv F E E)) [finite_dimensional F E] : finite_dimensional.findim (↥(fixed_field H)) E = fintype.card ↥H :=
  fixed_points.findim_eq_card (↥H) E

/-- The subgroup fixing an intermediate_field -/
def fixing_subgroup {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (K : intermediate_field F E) : subgroup (alg_equiv F E E) :=
  subgroup.mk (fun (ϕ : alg_equiv F E E) => ∀ (x : ↥K), coe_fn ϕ ↑x = ↑x) sorry sorry sorry

theorem le_iff_le {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (H : subgroup (alg_equiv F E E)) (K : intermediate_field F E) : K ≤ fixed_field H ↔ H ≤ fixing_subgroup K := sorry

/-- The fixing_subgroup of `K : intermediate_field F E` is isomorphic to `E ≃ₐ[K] E` -/
def fixing_subgroup_equiv {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (K : intermediate_field F E) : ↥(fixing_subgroup K) ≃* alg_equiv (↥K) E E :=
  mul_equiv.mk
    (fun (ϕ : ↥(fixing_subgroup K)) => alg_equiv.of_bijective (alg_hom.mk ⇑ϕ sorry sorry sorry sorry sorry) sorry)
    (fun (ϕ : alg_equiv (↥K) E E) =>
      { val := alg_equiv.of_bijective (alg_hom.mk ⇑ϕ sorry sorry sorry sorry sorry) sorry, property := sorry })
    sorry sorry sorry

theorem fixing_subgroup_fixed_field {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (H : subgroup (alg_equiv F E E)) [finite_dimensional F E] : fixing_subgroup (fixed_field H) = H := sorry

protected instance fixed_field.algebra {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (K : intermediate_field F E) : algebra ↥K ↥(fixed_field (fixing_subgroup K)) :=
  algebra.mk (ring_hom.mk (fun (x : ↥K) => { val := ↑x, property := sorry }) sorry sorry sorry sorry) sorry sorry

protected instance fixed_field.is_scalar_tower {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (K : intermediate_field F E) : is_scalar_tower (↥K) (↥(fixed_field (fixing_subgroup K))) E :=
  is_scalar_tower.mk fun (_x : ↥K) (_x_1 : ↥(fixed_field (fixing_subgroup K))) (_x_2 : E) => mul_assoc (↑_x) (↑_x_1) _x_2

end intermediate_field

namespace is_galois

theorem fixed_field_fixing_subgroup {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (K : intermediate_field F E) [finite_dimensional F E] [h : is_galois F E] : intermediate_field.fixed_field (intermediate_field.fixing_subgroup K) = K := sorry

theorem card_fixing_subgroup_eq_findim {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] (K : intermediate_field F E) [finite_dimensional F E] [is_galois F E] : fintype.card ↥(intermediate_field.fixing_subgroup K) = finite_dimensional.findim (↥K) E := sorry

/-- The Galois correspondence from intermediate fields to subgroups -/
def intermediate_field_equiv_subgroup {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] [finite_dimensional F E] [is_galois F E] : intermediate_field F E ≃o order_dual (subgroup (alg_equiv F E E)) :=
  rel_iso.mk (equiv.mk intermediate_field.fixing_subgroup intermediate_field.fixed_field sorry sorry) sorry

/-- The Galois correspondence as a galois_insertion -/
def galois_insertion_intermediate_field_subgroup {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] [finite_dimensional F E] : galois_insertion (⇑order_dual.to_dual ∘ intermediate_field.fixing_subgroup)
  (intermediate_field.fixed_field ∘ ⇑order_dual.to_dual) :=
  galois_insertion.mk
    (fun (K : intermediate_field F E)
      (_x :
      function.comp intermediate_field.fixed_field (⇑order_dual.to_dual)
          (function.comp (⇑order_dual.to_dual) intermediate_field.fixing_subgroup K) ≤
        K) =>
      intermediate_field.fixing_subgroup K)
    sorry sorry sorry

/-- The Galois correspondence as a galois_coinsertion -/
def galois_coinsertion_intermediate_field_subgroup {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] [finite_dimensional F E] [is_galois F E] : galois_coinsertion (⇑order_dual.to_dual ∘ intermediate_field.fixing_subgroup)
  (intermediate_field.fixed_field ∘ ⇑order_dual.to_dual) :=
  galois_coinsertion.mk
    (fun (H : order_dual (subgroup (alg_equiv F E E)))
      (_x :
      H ≤
        function.comp (⇑order_dual.to_dual) intermediate_field.fixing_subgroup
          (function.comp intermediate_field.fixed_field (⇑order_dual.to_dual) H)) =>
      intermediate_field.fixed_field H)
    sorry sorry sorry

end is_galois

namespace is_galois

theorem is_separable_splitting_field (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] [finite_dimensional F E] [h : is_galois F E] : ∃ (p : polynomial F), polynomial.separable p ∧ polynomial.is_splitting_field F E p := sorry

theorem of_fixed_field_eq_bot (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] [finite_dimensional F E] (h : intermediate_field.fixed_field ⊤ = ⊥) : is_galois F E :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_galois F E)) (Eq.symm (propext is_galois_iff_is_galois_bot))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_galois (↥⊥) E)) (Eq.symm h))) (is_galois.of_fixed_field E ↥⊤))

theorem of_card_aut_eq_findim (F : Type u_1) [field F] (E : Type u_2) [field E] [algebra F E] [finite_dimensional F E] (h : fintype.card (alg_equiv F E E) = finite_dimensional.findim F E) : is_galois F E := sorry

theorem of_separable_splitting_field_aux {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] {p : polynomial F} [hFE : finite_dimensional F E] [sp : polynomial.is_splitting_field F E p] (hp : polynomial.separable p) (K : intermediate_field F E) {x : E} (hx : x ∈ polynomial.roots (polynomial.map (algebra_map F E) p)) : fintype.card (alg_hom F (↥↑(intermediate_field.adjoin (↥K) (intermediate_field.insert.insert ∅ x))) E) =
  fintype.card (alg_hom F (↥K) E) *
    finite_dimensional.findim ↥K ↥(intermediate_field.adjoin (↥K) (intermediate_field.insert.insert ∅ x)) := sorry

theorem of_separable_splitting_field {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] {p : polynomial F} [sp : polynomial.is_splitting_field F E p] (hp : polynomial.separable p) : is_galois F E := sorry

/--Equivalent characterizations of a Galois extension of finite degree-/
theorem tfae {F : Type u_1} [field F] {E : Type u_2} [field E] [algebra F E] [finite_dimensional F E] : tfae
  [is_galois F E, intermediate_field.fixed_field ⊤ = ⊥, fintype.card (alg_equiv F E E) = finite_dimensional.findim F E,
    ∃ (p : polynomial F), polynomial.separable p ∧ polynomial.is_splitting_field F E p] := sorry


/- Arguments to implicit binders are inserted automatically. It would be nice if *parameters* in the definition of a term of such a type would
   be inserted automatically as well.
   For a good overview over (and one solution to) this topic, see https://github.com/AndrasKovacs/elaboration-zoo/tree/master/experimental/poly-instantiation. -/

-- works
example {m σ} [Alternative m] [Monad m] : Alternative (StateT σ m) :=
{ failure := @StateT.failure _ _ _ _,
  orelse  := @StateT.orelse _ _ _ _,
  .. StateT.Monad }

-- works
example {m σ} [Alternative m] [Monad m] : Alternative (StateT σ m) :=
{ failure := fun α => StateT.failure,
  orelse  := fun α => StateT.orelse,
  .. StateT.Monad }

-- fails
example {m σ} [Alternative m] [Monad m] : Alternative (StateT σ m) :=
{ failure := StateT.failure,
  orelse  := StateT.orelse,
  .. StateT.Monad }

-- works
universes u v
example {m m' σ σ'} {n n' : Type u → Type v} [MonadFunctor m m' n n'] [MonadStateAdapter σ σ' m m'] : MonadStateAdapter σ σ' n n' :=
⟨fun σ'' α split join => monadMap (fun α => (adaptState split join : m α → m' α))⟩

-- fails
example {m m' σ σ'} {n n' : Type u → Type v} [MonadFunctor m m' n n'] [MonadStateAdapter σ σ' m m'] : MonadStateAdapter σ σ' n n' :=
⟨fun split join => monadMap (adaptState split join)⟩


/-
Copyright (c) 2018 Michael Jendrusch. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Jendrusch, Scott Morrison, Bhavik Mehta, Jakob von Raumer
-/
import category_theory.products.basic

/-!
# Monoidal categories

A monoidal category is a category equipped with a tensor product, unitors, and an associator.
In the definition, we provide the tensor product as a pair of functions
* `tensor_obj : C → C → C`
* `tensor_hom : (X₁ ⟶ Y₁) → (X₂ ⟶ Y₂) → ((X₁ ⊗ X₂) ⟶ (Y₁ ⊗ Y₂))`
and allow use of the overloaded notation `⊗` for both.
The unitors and associator are provided componentwise.

The tensor product can be expressed as a functor via `tensor : C × C ⥤ C`.
The unitors and associator are gathered together as natural
isomorphisms in `left_unitor_nat_iso`, `right_unitor_nat_iso` and `associator_nat_iso`.

Some consequences of the definition are proved in other files,
e.g. `(λ_ (𝟙_ C)).hom = (ρ_ (𝟙_ C)).hom` in `category_theory.monoidal.unitors_equal`.

## Implementation
Dealing with unitors and associators is painful, and at this stage we do not have a useful
implementation of coherence for monoidal categories.

In an effort to lessen the pain, we put some effort into choosing the right `simp` lemmas.
Generally, the rule is that the component index of a natural transformation "weighs more"
in considering the complexity of an expression than does a structural isomorphism (associator, etc).

As an example when we prove Proposition 2.2.4 of
<http://www-math.mit.edu/~etingof/egnobookfinal.pdf>
we state it as a `@[simp]` lemma as
```
(λ_ (X ⊗ Y)).hom = (α_ (𝟙_ C) X Y).inv ≫ (λ_ X).hom ⊗ (𝟙 Y)
```

This is far from completely effective, but seems to prove a useful principle.

## References
* Tensor categories, Etingof, Gelaki, Nikshych, Ostrik,
  http://www-math.mit.edu/~etingof/egnobookfinal.pdf
* <https://stacks.math.columbia.edu/tag/0FFK>.
-/

open category_theory

universes v u

open category_theory
open category_theory.category
open category_theory.iso

namespace category_theory

/--
In a monoidal category, we can take the tensor product of objects, `X ⊗ Y` and of morphisms `f ⊗ g`.
Tensor product does not need to be strictly associative on objects, but there is a
specified associator, `α_ X Y Z : (X ⊗ Y) ⊗ Z ≅ X ⊗ (Y ⊗ Z)`. There is a tensor unit `𝟙_ C`,
with specified left and right unitor isomorphisms `λ_ X : 𝟙_ C ⊗ X ≅ X` and `ρ_ X : X ⊗ 𝟙_ C ≅ X`.
These associators and unitors satisfy the pentagon and triangle equations.

See <https://stacks.math.columbia.edu/tag/0FFK>.
-/
class monoidal_category (C : Type u) [𝒞 : category.{v} C] :=
-- curried tensor product of objects:
(tensor_obj               : C → C → C)
(infixr ` ⊗ `:70          := tensor_obj) -- This notation is only temporary
-- curried tensor product of morphisms:
(tensor_hom               :
  Π {X₁ Y₁ X₂ Y₂ : C}, (X₁ ⟶ Y₁) → (X₂ ⟶ Y₂) → ((X₁ ⊗ X₂) ⟶ (Y₁ ⊗ Y₂)))
(infixr ` ⊗' `:69         := tensor_hom) -- This notation is only temporary
-- tensor product laws:
(tensor_id'               :
  ∀ (X₁ X₂ : C), (𝟙 X₁) ⊗' (𝟙 X₂) = 𝟙 (X₁ ⊗ X₂) . obviously)
(tensor_comp'             :
  ∀ {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂),
  (f₁ ≫ g₁) ⊗' (f₂ ≫ g₂) = (f₁ ⊗' f₂) ≫ (g₁ ⊗' g₂) . obviously)
-- tensor unit:
(tensor_unit []           : C)
(notation `𝟙_`            := tensor_unit)
-- associator:
(associator               :
  Π X Y Z : C, (X ⊗ Y) ⊗ Z ≅ X ⊗ (Y ⊗ Z))
(notation `α_`            := associator)
(associator_naturality'   :
  ∀ {X₁ X₂ X₃ Y₁ Y₂ Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃),
  ((f₁ ⊗' f₂) ⊗' f₃) ≫ (α_ Y₁ Y₂ Y₃).hom = (α_ X₁ X₂ X₃).hom ≫ (f₁ ⊗' (f₂ ⊗' f₃)) . obviously)
-- left unitor:
(left_unitor              : Π X : C, 𝟙_ ⊗ X ≅ X)
(notation `λ_`            := left_unitor)
(left_unitor_naturality'  :
  ∀ {X Y : C} (f : X ⟶ Y), ((𝟙 𝟙_) ⊗' f) ≫ (λ_ Y).hom = (λ_ X).hom ≫ f . obviously)
-- right unitor:
(right_unitor             : Π X : C, X ⊗ 𝟙_ ≅ X)
(notation `ρ_`            := right_unitor)
(right_unitor_naturality' :
  ∀ {X Y : C} (f : X ⟶ Y), (f ⊗' (𝟙 𝟙_)) ≫ (ρ_ Y).hom = (ρ_ X).hom ≫ f . obviously)
-- pentagon identity:
(pentagon'                : ∀ W X Y Z : C,
  ((α_ W X Y).hom ⊗' (𝟙 Z)) ≫ (α_ W (X ⊗ Y) Z).hom ≫ ((𝟙 W) ⊗' (α_ X Y Z).hom)
  = (α_ (W ⊗ X) Y Z).hom ≫ (α_ W X (Y ⊗ Z)).hom . obviously)
-- triangle identity:
(triangle'                :
  ∀ X Y : C, (α_ X 𝟙_ Y).hom ≫ ((𝟙 X) ⊗' (λ_ Y).hom) = (ρ_ X).hom ⊗' (𝟙 Y) . obviously)

restate_axiom monoidal_category.tensor_id'
attribute [simp] monoidal_category.tensor_id
restate_axiom monoidal_category.tensor_comp'
attribute [reassoc] monoidal_category.tensor_comp -- This would be redundant in the simp set.
attribute [simp] monoidal_category.tensor_comp
restate_axiom monoidal_category.associator_naturality'
attribute [reassoc] monoidal_category.associator_naturality
restate_axiom monoidal_category.left_unitor_naturality'
attribute [reassoc] monoidal_category.left_unitor_naturality
restate_axiom monoidal_category.right_unitor_naturality'
attribute [reassoc] monoidal_category.right_unitor_naturality
restate_axiom monoidal_category.pentagon'
restate_axiom monoidal_category.triangle'
attribute [reassoc] monoidal_category.pentagon
attribute [simp, reassoc] monoidal_category.triangle

open monoidal_category

infixr ` ⊗ `:70 := tensor_obj
infixr ` ⊗ `:70 := tensor_hom

notation `𝟙_` := tensor_unit
notation `α_` := associator
notation `λ_` := left_unitor
notation `ρ_` := right_unitor

/-- The tensor product of two isomorphisms is an isomorphism. -/
@[simps]
def tensor_iso {C : Type u} {X Y X' Y' : C} [category.{v} C] [monoidal_category.{v} C]
  (f : X ≅ Y) (g : X' ≅ Y') :
    X ⊗ X' ≅ Y ⊗ Y' :=
{ hom := f.hom ⊗ g.hom,
  inv := f.inv ⊗ g.inv,
  hom_inv_id' := by rw [←tensor_comp, iso.hom_inv_id, iso.hom_inv_id, ←tensor_id],
  inv_hom_id' := by rw [←tensor_comp, iso.inv_hom_id, iso.inv_hom_id, ←tensor_id] }

infixr ` ⊗ `:70 := tensor_iso

namespace monoidal_category

section

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

instance tensor_is_iso {W X Y Z : C} (f : W ⟶ X) [is_iso f] (g : Y ⟶ Z) [is_iso g] :
  is_iso (f ⊗ g) :=
is_iso.of_iso (as_iso f ⊗ as_iso g)

@[simp] lemma inv_tensor {W X Y Z : C} (f : W ⟶ X) [is_iso f] (g : Y ⟶ Z) [is_iso g] :
  inv (f ⊗ g) = inv f ⊗ inv g :=
by { ext, simp [←tensor_comp], }

variables {U V W X Y Z : C}

lemma tensor_dite {P : Prop} [decidable P]
  {W X Y Z : C} (f : W ⟶ X) (g : P → (Y ⟶ Z)) (g' : ¬P → (Y ⟶ Z)) :
  f ⊗ (if h : P then g h else g' h) = if h : P then f ⊗ g h else f ⊗ g' h :=
by { split_ifs; refl }

lemma dite_tensor {P : Prop} [decidable P]
  {W X Y Z : C} (f : W ⟶ X) (g : P → (Y ⟶ Z)) (g' : ¬P → (Y ⟶ Z)) :
  (if h : P then g h else g' h) ⊗ f  = if h : P then g h ⊗ f else g' h ⊗ f :=
by { split_ifs; refl }

@[reassoc, simp] lemma comp_tensor_id (f : W ⟶ X) (g : X ⟶ Y) :
  (f ≫ g) ⊗ (𝟙 Z) = (f ⊗ (𝟙 Z)) ≫ (g ⊗ (𝟙 Z)) :=
by { rw ←tensor_comp, simp }

@[reassoc, simp]

@[simp, reassoc] lemma id_tensor_comp_tensor_id (f : W ⟶ X) (g : Y ⟶ Z) :
  ((𝟙 Y) ⊗ f) ≫ (g ⊗ (𝟙 X)) = g ⊗ f :=
by { rw [←tensor_comp], simp }

@[simp, reassoc] lemma tensor_id_comp_id_tensor (f : W ⟶ X) (g : Y ⟶ Z) :
  (g ⊗ (𝟙 W)) ≫ ((𝟙 Z) ⊗ f) = g ⊗ f :=
by { rw [←tensor_comp], simp }

@[simp]
lemma right_unitor_conjugation {X Y : C} (f : X ⟶ Y) :
  (f ⊗ (𝟙 (𝟙_ C))) = (ρ_ X).hom ≫ f ≫ (ρ_ Y).inv :=
by rw [←right_unitor_naturality_assoc, iso.hom_inv_id, category.comp_id]

@[simp]
lemma left_unitor_conjugation {X Y : C} (f : X ⟶ Y) :
  ((𝟙 (𝟙_ C)) ⊗ f) = (λ_ X).hom ≫ f ≫ (λ_ Y).inv :=
by rw [←left_unitor_naturality_assoc, iso.hom_inv_id, category.comp_id]

@[reassoc]
lemma left_unitor_inv_naturality {X X' : C} (f : X ⟶ X') :
  f ≫ (λ_ X').inv = (λ_ X).inv ≫ (𝟙 _ ⊗ f) :=
by simp

@[reassoc]
lemma right_unitor_inv_naturality {X X' : C} (f : X ⟶ X') :
  f ≫ (ρ_ X').inv = (ρ_ X).inv ≫ (f ⊗ 𝟙 _) :=
by simp

lemma tensor_left_iff
  {X Y : C} (f g : X ⟶ Y) :
  ((𝟙 (𝟙_ C)) ⊗ f = (𝟙 (𝟙_ C)) ⊗ g) ↔ (f = g) :=
by simp

lemma tensor_right_iff
  {X Y : C} (f g : X ⟶ Y) :
  (f ⊗ (𝟙 (𝟙_ C)) = g ⊗ (𝟙 (𝟙_ C))) ↔ (f = g) :=
by simp

/-! The lemmas in the next section are true by coherence,
but we prove them directly as they are used in proving the coherence theorem. -/
section

@[reassoc]
lemma pentagon_inv (W X Y Z : C) :
  ((𝟙 W) ⊗ (α_ X Y Z).inv) ≫ (α_ W (X ⊗ Y) Z).inv ≫ ((α_ W X Y).inv ⊗ (𝟙 Z))
    = (α_ W X (Y ⊗ Z)).inv ≫ (α_ (W ⊗ X) Y Z).inv :=
category_theory.eq_of_inv_eq_inv (by simp [pentagon])

@[reassoc, simp]
lemma right_unitor_tensor (X Y : C) :
  (ρ_ (X ⊗ Y)).hom = (α_ X Y (𝟙_ C)).hom ≫ ((𝟙 X) ⊗ (ρ_ Y).hom) :=
by
  rw [←tensor_right_iff, comp_tensor_id, ←cancel_mono (α_ X Y (𝟙_ C)).hom, assoc,
      associator_naturality, ←triangle_assoc, ←triangle, id_tensor_comp, pentagon_assoc,
      ←associator_naturality, tensor_id]

@[reassoc, simp]
lemma right_unitor_tensor_inv (X Y : C) :
  ((ρ_ (X ⊗ Y)).inv) = ((𝟙 X) ⊗ (ρ_ Y).inv) ≫ (α_ X Y (𝟙_ C)).inv :=
eq_of_inv_eq_inv (by simp)

@[simp, reassoc] lemma triangle_assoc_comp_right (X Y : C) :
  (α_ X (𝟙_ C) Y).inv ≫ ((ρ_ X).hom ⊗ 𝟙 Y) = ((𝟙 X) ⊗ (λ_ Y).hom) :=
by rw [←triangle, iso.inv_hom_id_assoc]

@[simp, reassoc] lemma triangle_assoc_comp_left_inv (X Y : C) :
  ((𝟙 X) ⊗ (λ_ Y).inv) ≫ (α_ X (𝟙_ C) Y).inv = ((ρ_ X).inv ⊗ 𝟙 Y) :=
begin
  apply (cancel_mono ((ρ_ X).hom ⊗ 𝟙 Y)).1,
  simp only [triangle_assoc_comp_right, assoc],
  rw [←id_tensor_comp, iso.inv_hom_id, ←comp_tensor_id, iso.inv_hom_id]
end

end

@[reassoc]
lemma associator_inv_naturality {X Y Z X' Y' Z' : C} (f : X ⟶ X') (g : Y ⟶ Y') (h : Z ⟶ Z') :
  (f ⊗ (g ⊗ h)) ≫ (α_ X' Y' Z').inv = (α_ X Y Z).inv ≫ ((f ⊗ g) ⊗ h) :=
by { rw [comp_inv_eq, assoc, associator_naturality], simp }

@[reassoc, simp]
lemma associator_conjugation {X X' Y Y' Z Z' : C} (f : X ⟶ X') (g : Y ⟶ Y') (h : Z ⟶ Z') :
  (f ⊗ g) ⊗ h = (α_ X Y Z).hom ≫ (f ⊗ (g ⊗ h)) ≫ (α_ X' Y' Z').inv :=
by rw [associator_inv_naturality, hom_inv_id_assoc]

@[reassoc]
lemma associator_inv_conjugation {X X' Y Y' Z Z' : C} (f : X ⟶ X') (g : Y ⟶ Y') (h : Z ⟶ Z') :
  f ⊗ g ⊗ h = (α_ X Y Z).inv ≫ ((f ⊗ g) ⊗ h) ≫ (α_ X' Y' Z').hom :=
by rw [associator_naturality, inv_hom_id_assoc]

-- TODO these next two lemmas aren't so fundamental, and perhaps could be removed
-- (replacing their usages by their proofs).
@[reassoc]
lemma id_tensor_associator_naturality {X Y Z Z' : C} (h : Z ⟶ Z') :
  (𝟙 (X ⊗ Y) ⊗ h) ≫ (α_ X Y Z').hom = (α_ X Y Z).hom ≫ (𝟙 X ⊗ (𝟙 Y ⊗ h)) :=
by { rw [←tensor_id, associator_naturality], }

@[reassoc]
lemma id_tensor_associator_inv_naturality {X Y Z X' : C} (f : X ⟶ X')  :
  (f ⊗ 𝟙 (Y ⊗ Z)) ≫ (α_ X' Y Z).inv = (α_ X Y Z).inv ≫ ((f ⊗ 𝟙 Y) ⊗ 𝟙 Z) :=
by { rw [←tensor_id, associator_inv_naturality] }

@[simp, reassoc]
lemma hom_inv_id_tensor {V W X Y Z : C} (f : V ≅ W) (g : X ⟶ Y) (h : Y ⟶ Z) :
  (f.hom ⊗ g) ≫ (f.inv ⊗ h) = (𝟙 V ⊗ g) ≫ (𝟙 V ⊗ h) :=
by rw [←tensor_comp, f.hom_inv_id, id_tensor_comp]

@[simp, reassoc]
lemma inv_hom_id_tensor {V W X Y Z : C} (f : V ≅ W) (g : X ⟶ Y) (h : Y ⟶ Z) :
  (f.inv ⊗ g) ≫ (f.hom ⊗ h) = (𝟙 W ⊗ g) ≫ (𝟙 W ⊗ h) :=
by rw [←tensor_comp, f.inv_hom_id, id_tensor_comp]

@[simp, reassoc]
lemma tensor_hom_inv_id {V W X Y Z : C} (f : V ≅ W) (g : X ⟶ Y) (h : Y ⟶ Z) :
  (g ⊗ f.hom) ≫ (h ⊗ f.inv) = (g ⊗ 𝟙 V) ≫ (h ⊗ 𝟙 V) :=
by rw [←tensor_comp, f.hom_inv_id, comp_tensor_id]

@[simp, reassoc]
lemma tensor_inv_hom_id {V W X Y Z : C} (f : V ≅ W) (g : X ⟶ Y) (h : Y ⟶ Z) :
  (g ⊗ f.inv) ≫ (h ⊗ f.hom) = (g ⊗ 𝟙 W) ≫ (h ⊗ 𝟙 W) :=
by rw [←tensor_comp, f.inv_hom_id, comp_tensor_id]

@[simp, reassoc]
lemma hom_inv_id_tensor' {V W X Y Z : C} (f : V ⟶ W) [is_iso f] (g : X ⟶ Y) (h : Y ⟶ Z) :
  (f ⊗ g) ≫ (inv f ⊗ h) = (𝟙 V ⊗ g) ≫ (𝟙 V ⊗ h) :=
by rw [←tensor_comp, is_iso.hom_inv_id, id_tensor_comp]

@[simp, reassoc]
lemma inv_hom_id_tensor' {V W X Y Z : C} (f : V ⟶ W) [is_iso f] (g : X ⟶ Y) (h : Y ⟶ Z) :
  (inv f ⊗ g) ≫ (f ⊗ h) = (𝟙 W ⊗ g) ≫ (𝟙 W ⊗ h) :=
by rw [←tensor_comp, is_iso.inv_hom_id, id_tensor_comp]

@[simp, reassoc]
lemma tensor_hom_inv_id' {V W X Y Z : C} (f : V ⟶ W) [is_iso f] (g : X ⟶ Y) (h : Y ⟶ Z) :
  (g ⊗ f) ≫ (h ⊗ inv f) = (g ⊗ 𝟙 V) ≫ (h ⊗ 𝟙 V) :=
by rw [←tensor_comp, is_iso.hom_inv_id, comp_tensor_id]

@[simp, reassoc]
lemma tensor_inv_hom_id' {V W X Y Z : C} (f : V ⟶ W) [is_iso f] (g : X ⟶ Y) (h : Y ⟶ Z) :
  (g ⊗ inv f) ≫ (h ⊗ f) = (g ⊗ 𝟙 W) ≫ (h ⊗ 𝟙 W) :=
by rw [←tensor_comp, is_iso.inv_hom_id, comp_tensor_id]

end

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

/-- The tensor product expressed as a functor. -/
@[simps] def tensor : (C × C) ⥤ C :=
{ obj := λ X, X.1 ⊗ X.2,
  map := λ {X Y : C × C} (f : X ⟶ Y), f.1 ⊗ f.2 }

/-- The left-associated triple tensor product as a functor. -/
def left_assoc_tensor : (C × C × C) ⥤ C :=
{ obj := λ X, (X.1 ⊗ X.2.1) ⊗ X.2.2,
  map := λ {X Y : C × C × C} (f : X ⟶ Y), (f.1 ⊗ f.2.1) ⊗ f.2.2 }

@[simp] lemma left_assoc_tensor_obj (X) :
  (left_assoc_tensor C).obj X = (X.1 ⊗ X.2.1) ⊗ X.2.2 := rfl
@[simp] lemma left_assoc_tensor_map {X Y} (f : X ⟶ Y) :
  (left_assoc_tensor C).map f = (f.1 ⊗ f.2.1) ⊗ f.2.2 := rfl

/-- The right-associated triple tensor product as a functor. -/
def right_assoc_tensor : (C × C × C) ⥤ C :=
{ obj := λ X, X.1 ⊗ (X.2.1 ⊗ X.2.2),
  map := λ {X Y : C × C × C} (f : X ⟶ Y), f.1 ⊗ (f.2.1 ⊗ f.2.2) }

@[simp] lemma right_assoc_tensor_obj (X) :
  (right_assoc_tensor C).obj X = X.1 ⊗ (X.2.1 ⊗ X.2.2) := rfl
@[simp] lemma right_assoc_tensor_map {X Y} (f : X ⟶ Y) :
  (right_assoc_tensor C).map f = f.1 ⊗ (f.2.1 ⊗ f.2.2) := rfl

/-- The functor `λ X, 𝟙_ C ⊗ X`. -/
def tensor_unit_left : C ⥤ C :=
{ obj := λ X, 𝟙_ C ⊗ X,
  map := λ {X Y : C} (f : X ⟶ Y), (𝟙 (𝟙_ C)) ⊗ f }
/-- The functor `λ X, X ⊗ 𝟙_ C`. -/
def tensor_unit_right : C ⥤ C :=
{ obj := λ X, X ⊗ 𝟙_ C,
  map := λ {X Y : C} (f : X ⟶ Y), f ⊗ (𝟙 (𝟙_ C)) }

-- We can express the associator and the unitors, given componentwise above,
-- as natural isomorphisms.

/-- The associator as a natural isomorphism. -/
@[simps]
def associator_nat_iso :
  left_assoc_tensor C ≅ right_assoc_tensor C :=
nat_iso.of_components
  (by { intros, apply monoidal_category.associator })
  (by { intros, apply monoidal_category.associator_naturality })

/-- The left unitor as a natural isomorphism. -/
@[simps]
def left_unitor_nat_iso :
  tensor_unit_left C ≅ 𝟭 C :=
nat_iso.of_components
  (by { intros, apply monoidal_category.left_unitor })
  (by { intros, apply monoidal_category.left_unitor_naturality })

/-- The right unitor as a natural isomorphism. -/
@[simps]
def right_unitor_nat_iso :
  tensor_unit_right C ≅ 𝟭 C :=
nat_iso.of_components
  (by { intros, apply monoidal_category.right_unitor })
  (by { intros, apply monoidal_category.right_unitor_naturality })

section
variables {C}

/-- Tensoring on the left with a fixed object, as a functor. -/
@[simps]
def tensor_left (X : C) : C ⥤ C :=
{ obj := λ Y, X ⊗ Y,
  map := λ Y Y' f, (𝟙 X) ⊗ f, }

/--
Tensoring on the left with `X ⊗ Y` is naturally isomorphic to
tensoring on the left with `Y`, and then again with `X`.
-/
def tensor_left_tensor (X Y : C) : tensor_left (X ⊗ Y) ≅ tensor_left Y ⋙ tensor_left X :=
nat_iso.of_components
  (associator _ _)
  (λ Z Z' f, by { dsimp, rw[←tensor_id], apply associator_naturality })

@[simp] lemma tensor_left_tensor_hom_app (X Y Z : C) :
  (tensor_left_tensor X Y).hom.app Z = (associator X Y Z).hom :=
rfl
@[simp] lemma tensor_left_tensor_inv_app (X Y Z : C) :
  (tensor_left_tensor X Y).inv.app Z = (associator X Y Z).inv :=
by { simp [tensor_left_tensor], }

/-- Tensoring on the right with a fixed object, as a functor. -/
@[simps]
def tensor_right (X : C) : C ⥤ C :=
{ obj := λ Y, Y ⊗ X,
  map := λ Y Y' f, f ⊗ (𝟙 X), }

variables (C)

/--
Tensoring on the left, as a functor from `C` into endofunctors of `C`.

TODO: show this is a op-monoidal functor.
-/
@[simps]
def tensoring_left : C ⥤ C ⥤ C :=
{ obj := tensor_left,
  map := λ X Y f,
  { app := λ Z, f ⊗ (𝟙 Z) } }

instance : faithful (tensoring_left C) :=
{ map_injective' := λ X Y f g h,
  begin
    injections with h,
    replace h := congr_fun h (𝟙_ C),
    simpa using h,
  end }

/--
Tensoring on the right, as a functor from `C` into endofunctors of `C`.

We later show this is a monoidal functor.
-/
@[simps]
def tensoring_right : C ⥤ C ⥤ C :=
{ obj := tensor_right,
  map := λ X Y f,
  { app := λ Z, (𝟙 Z) ⊗ f } }

instance : faithful (tensoring_right C) :=
{ map_injective' := λ X Y f g h,
  begin
    injections with h,
    replace h := congr_fun h (𝟙_ C),
    simpa using h,
  end }

variables {C}

/--
Tensoring on the right with `X ⊗ Y` is naturally isomorphic to
tensoring on the right with `X`, and then again with `Y`.
-/
def tensor_right_tensor (X Y : C) : tensor_right (X ⊗ Y) ≅ tensor_right X ⋙ tensor_right Y :=
nat_iso.of_components
  (λ Z, (associator Z X Y).symm)
  (λ Z Z' f, by { dsimp, rw[←tensor_id], apply associator_inv_naturality })

@[simp] lemma tensor_right_tensor_hom_app (X Y Z : C) :
  (tensor_right_tensor X Y).hom.app Z = (associator Z X Y).inv :=
rfl
@[simp] lemma tensor_right_tensor_inv_app (X Y Z : C) :
  (tensor_right_tensor X Y).inv.app Z = (associator Z X Y).hom :=
by simp [tensor_right_tensor]

end

end

section

universes v₁ v₂ u₁ u₂

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

local attribute [simp]
associator_naturality left_unitor_naturality right_unitor_naturality pentagon

@[simps tensor_obj tensor_hom tensor_unit associator]
instance prod_monoidal : monoidal_category (C₁ × C₂) :=
{ tensor_obj := λ X Y, (X.1 ⊗ Y.1, X.2 ⊗ Y.2),
  tensor_hom := λ _ _ _ _ f g, (f.1 ⊗ g.1, f.2 ⊗ g.2),
  tensor_unit := (𝟙_ C₁, 𝟙_ C₂),
  associator := λ X Y Z, (α_ X.1 Y.1 Z.1).prod (α_ X.2 Y.2 Z.2),
  left_unitor := λ ⟨X₁, X₂⟩, (λ_ X₁).prod (λ_ X₂),
  right_unitor := λ ⟨X₁, X₂⟩, (ρ_ X₁).prod (ρ_ X₂) }

@[simp] lemma prod_monoidal_left_unitor_hom_fst (X : C₁ × C₂) :
  ((λ_ X).hom : (𝟙_ _) ⊗ X ⟶ X).1 = (λ_ X.1).hom := by { cases X, refl }

@[simp] lemma prod_monoidal_left_unitor_hom_snd (X : C₁ × C₂) :
  ((λ_ X).hom : (𝟙_ _) ⊗ X ⟶ X).2 = (λ_ X.2).hom := by { cases X, refl }

@[simp] lemma prod_monoidal_left_unitor_inv_fst (X : C₁ × C₂) :
  ((λ_ X).inv : X ⟶ (𝟙_ _) ⊗ X).1 = (λ_ X.1).inv := by { cases X, refl }

@[simp] lemma prod_monoidal_left_unitor_inv_snd (X : C₁ × C₂) :
  ((λ_ X).inv : X ⟶ (𝟙_ _) ⊗ X).2 = (λ_ X.2).inv := by { cases X, refl }

@[simp] lemma prod_monoidal_right_unitor_hom_fst (X : C₁ × C₂) :
  ((ρ_ X).hom : X ⊗ (𝟙_ _) ⟶ X).1 = (ρ_ X.1).hom := by { cases X, refl }

@[simp] lemma prod_monoidal_right_unitor_hom_snd (X : C₁ × C₂) :
  ((ρ_ X).hom : X ⊗ (𝟙_ _) ⟶ X).2 = (ρ_ X.2).hom := by { cases X, refl }

@[simp] lemma prod_monoidal_right_unitor_inv_fst (X : C₁ × C₂) :
  ((ρ_ X).inv : X ⟶ X ⊗ (𝟙_ _)).1 = (ρ_ X.1).inv := by { cases X, refl }

@[simp] lemma prod_monoidal_right_unitor_inv_snd (X : C₁ × C₂) :
  ((ρ_ X).inv : X ⟶ X ⊗ (𝟙_ _)).2 = (ρ_ X.2).inv := by { cases X, refl }

end

end monoidal_category

end category_theory


import .sokolevel

def soko_level_29 := sokolevel.from_string "
#####
#   ##
# $  #########
## # #       ######
## #   $#$#@  #   #
#  #      $ #   $ #
#  ### ######### ##
#  ## ..*..... # ##
## ## *.*..*.* # ##
# $########## ##$ #
#  $   $  $    $  #
#  #   #   #   #  #
###################
"

theorem solvable_level_29 : soko_level_29.solvable :=
begin
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_right,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_up,
  sokolevel.solve_left,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_up,
  sokolevel.solve_right,
  sokolevel.solve_right,
  sokolevel.solve_down,
  sokolevel.solve_down,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.solve_left,
  sokolevel.soko_simp,
  sokolevel.solve_up,
  sokolevel.soko_simp,
  sokolevel.solve_left,
  sokolevel.soko_simp,
  sokolevel.solve_down,
  sokolevel.soko_simp,
  sokolevel.solve_down,
  sokolevel.soko_simp,
  sokolevel.solve_finish
end


import category_theory.equivalence

open category_theory

variables {C : Type*} [category C]
variables {D : Type*} [category D]

lemma equiv_reflects_mono {X Y : C} (f : X ⟶ Y) (e : C ≌ D)
  (hef : mono (e.functor.map f)) : mono f :=
begin
  split,
  intros Z g h w,
  apply e.functor.map_injective,
  rw ← cancel_mono (e.functor.map f),
  apply e.inverse.map_injective,
  -- That's ugly! In fact, so ugly that surely `simp` can clean things up from here.
  sorry
end


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Keeley Hoek, Patrick Massot

! This file was ported from Lean 3 source module tactic.apply_fun
! leanprover-community/mathlib commit f3cd150bf23503db6a693f369c236da9590066aa
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Monotonicity.Default

namespace Tactic

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Apply the function `f` given by `e : pexpr` to the local hypothesis `hyp`, which must either be
      of the form `a = b` or `a ≤ b`, replacing the type of `hyp` with `f a = f b` or `f a ≤ f b`. If
      `hyp` names an inequality then a new goal `monotone f` is created, unless the name of a proof of
      this fact is passed as the optional argument `mono_lem`, or the `mono` tactic can prove it.
      -/
    unsafe
  def
    apply_fun_to_hyp
    ( e : pexpr ) ( mono_lem : Option pexpr ) ( hyp : expr ) : tactic Unit
    :=
      do
        let t ← infer_type hyp >>= instantiate_mvars
          let
            prf
              ←
              match
                t
                with
                |
                    q( $ ( l ) = $ ( r ) )
                    =>
                    do
                      let ltp ← infer_type l
                        let mv ← mk_mvar
                        to_expr ` `( congr_arg ( $ ( e ) : $ ( ltp ) → $ ( mv ) ) $ ( hyp ) )
                  |
                    q( $ ( l ) ≤ $ ( r ) )
                    =>
                    do
                      let
                          Hmono
                            ←
                            match
                              mono_lem
                              with
                              | some mono_lem => tactic.i_to_expr mono_lem
                                |
                                  none
                                  =>
                                  do
                                    let n ← get_unused_name `mono
                                      to_expr ` `( Monotone $ ( e ) ) >>= assert n
                                      swap
                                      let n ← get_local n
                                      to_expr ` `( $ ( n ) $ ( hyp ) )
                                      swap
                                      ( do intro_lst [ `x , `y , `h ] sorry ) <|> swap
                                      return n
                        to_expr ` `( $ ( Hmono ) $ ( hyp ) )
                  | _ => throwError "failed to apply { ( ← e ) } at { ← hyp }"
          clear hyp
          let hyp ← note hyp . local_pp_name none prf
          try <| tactic.dsimp_hyp hyp simp_lemmas.mk [ ] { eta := False beta := True }
#align tactic.apply_fun_to_hyp tactic.apply_fun_to_hyp

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Attempt to "apply" a function `f` represented by the argument `e : pexpr` to the goal.

      If the goal is of the form `a ≠ b`, we obtain the new goal `f a ≠ f b`.
      If the goal is of the form `a = b`, we obtain a new goal `f a = f b`, and a subsidiary goal
      `injective f`.
      (We attempt to discharge this subsidiary goal automatically, or using the optional argument.)
      If the goal is of the form `a ≤ b` (or similarly for `a < b`), and `f` is an `order_iso`,
      we obtain a new goal `f a ≤ f b`.
      -/
    unsafe
  def
    apply_fun_to_goal
    ( e : pexpr ) ( lem : Option pexpr ) : tactic Unit
    :=
      do
        let t ← target
          match
            t
            with
            | q( $ ( l ) ≠ $ ( r ) ) => ( to_expr ` `( ne_of_apply_ne $ ( e ) ) >>= apply ) >> skip
              |
                q( ¬ $ ( l ) = $ ( r ) )
                =>
                ( to_expr ` `( ne_of_apply_ne $ ( e ) ) >>= apply ) >> skip
              |
                q( $ ( l ) ≤ $ ( r ) )
                =>
                ( to_expr ` `( ( OrderIso.le_iff_le $ ( e ) ) . mp ) >>= apply ) >> skip
              |
                q( $ ( l ) < $ ( r ) )
                =>
                ( to_expr ` `( ( OrderIso.lt_iff_lt $ ( e ) ) . mp ) >>= apply ) >> skip
              |
                q( $ ( l ) = $ ( r ) )
                =>
                focus1
                  do
                    to_expr ` `( $ ( e ) $ ( l ) )
                      let n ← get_unused_name `inj
                      to_expr ` `( Function.Injective $ ( e ) ) >>= assert n
                      (
                          focus1
                            <|
                            assumption
                              <|>
                              ( to_expr ` `( Equiv.injective ) >>= apply ) >> done
                                <|>
                                ( lem fun l => to_expr l >>= apply ) >> done
                          )
                        <|>
                        swap
                      let n ← get_local n
                      apply n
                      clear n
              | _ => throwError "failed to apply { ← e } to the goal"
#align tactic.apply_fun_to_goal tactic.apply_fun_to_goal

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- Apply a function to an equality or inequality in either a local hypothesis or the goal.

* If we have `h : a = b`, then `apply_fun f at h` will replace this with `h : f a = f b`.
* If we have `h : a ≤ b`, then `apply_fun f at h` will replace this with `h : f a ≤ f b`,
  and create a subsidiary goal `monotone f`.
  `apply_fun` will automatically attempt to discharge this subsidiary goal using `mono`,
  or an explicit solution can be provided with `apply_fun f at h using P`, where `P : monotone f`.
* If the goal is `a ≠ b`, `apply_fun f` will replace this with `f a ≠ f b`.
* If the goal is `a = b`, `apply_fun f` will replace this with `f a = f b`,
  and create a subsidiary goal `injective f`.
  `apply_fun` will automatically attempt to discharge this subsidiary goal using local hypotheses,
  or if `f` is actually an `equiv`,
  or an explicit solution can be provided with `apply_fun f using P`, where `P : injective f`.
* If the goal is `a ≤ b` (or similarly for `a < b`), and `f` is actually an `order_iso`,
  `apply_fun f` will replace the goal with `f a ≤ f b`.
  If `f` is anything else (e.g. just a function, or an `equiv`), `apply_fun` will fail.

Typical usage is:
```lean
open function

example (X Y Z : Type) (f : X → Y) (g : Y → Z) (H : injective $ g ∘ f) :
  injective f :=
begin
  intros x x' h,
  apply_fun g at h,
  exact H h
end
```
 -/
unsafe def apply_fun (q : parse texpr) (locs : parse location)
    (lem : parse (tk "using" *> texpr)?) : tactic Unit :=
  locs.apply (apply_fun_to_hyp q lem) (apply_fun_to_goal q lem)
#align tactic.interactive.apply_fun tactic.interactive.apply_fun

add_tactic_doc
  { Name := "apply_fun"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.apply_fun]
    tags := ["context management"] }

end Interactive

end Tactic


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.functor
import Mathlib.category_theory.functorial
import Mathlib.PostPort

universes v₁ v₂ u₁ u₂ l

namespace Mathlib

/-!
# Unbundled lax monoidal functors

## Design considerations
The essential problem I've encountered that requires unbundled functors is
having an existing (non-monoidal) functor `F : C ⥤ D` between monoidal categories,
and wanting to assert that it has an extension to a lax monoidal functor.

The two options seem to be
1. Construct a separate `F' : lax_monoidal_functor C D`,
   and assert `F'.to_functor ≅ F`.
2. Introduce unbundled functors and unbundled lax monoidal functors,
   and construct `lax_monoidal F.obj`, then construct `F' := lax_monoidal_functor.of F.obj`.

Both have costs, but as for option 2. the cost is in library design,
while in option 1. the cost is users having to carry around additional isomorphisms forever,
I wanted to introduce unbundled functors.

TODO:
later, we may want to do this for strong monoidal functors as well,
but the immediate application, for enriched categories, only requires this notion.
-/

namespace category_theory

/-- An unbundled description of lax monoidal functors. -/
-- Perhaps in the future we'll redefine `lax_monoidal_functor` in terms of this,

-- but that isn't the immediate plan.

-- unit morphism

class lax_monoidal {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : C → D) [functorial F]
where
  ε : 𝟙_ ⟶ F 𝟙_
  μ : (X Y : C) → F X ⊗ F Y ⟶ F (X ⊗ Y)
  μ_natural' : autoParam (∀ {X Y X' Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y'), (map F f ⊗ map F g) ≫ μ Y Y' = μ X X' ≫ map F (f ⊗ g))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  associativity' : autoParam (∀ (X Y Z : C), (μ X Y ⊗ 𝟙) ≫ μ (X ⊗ Y) Z ≫ map F (iso.hom α_) = iso.hom α_ ≫ (𝟙 ⊗ μ Y Z) ≫ μ X (Y ⊗ Z))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  left_unitality' : autoParam (∀ (X : C), iso.hom λ_ = (ε ⊗ 𝟙) ≫ μ 𝟙_ X ≫ map F (iso.hom λ_))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  right_unitality' : autoParam (∀ (X : C), iso.hom ρ_ = (𝟙 ⊗ ε) ≫ μ X 𝟙_ ≫ map F (iso.hom ρ_))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

-- tensorator

-- associativity of the tensorator

-- unitality

@[simp] theorem lax_monoidal.μ_natural {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : C → D} [functorial F] [c : lax_monoidal F] {X : C} {Y : C} {X' : C} {Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y') : (map F f ⊗ map F g) ≫ lax_monoidal.μ F Y Y' = lax_monoidal.μ F X X' ≫ map F (f ⊗ g) := sorry

theorem lax_monoidal.left_unitality {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : C → D} [functorial F] [c : lax_monoidal F] (X : C) : iso.hom λ_ = (lax_monoidal.ε F ⊗ 𝟙) ≫ lax_monoidal.μ F 𝟙_ X ≫ map F (iso.hom λ_) := sorry

-- The unitality axioms cannot be used as simp lemmas because they require

theorem lax_monoidal.right_unitality {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : C → D} [functorial F] [c : lax_monoidal F] (X : C) : iso.hom ρ_ = (𝟙 ⊗ lax_monoidal.ε F) ≫ lax_monoidal.μ F X 𝟙_ ≫ map F (iso.hom ρ_) := sorry

-- higher-order matching to figure out the `F` and `X` from `F X`.

@[simp] theorem lax_monoidal.associativity {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : C → D} [functorial F] [c : lax_monoidal F] (X : C) (Y : C) (Z : C) : (lax_monoidal.μ F X Y ⊗ 𝟙) ≫ lax_monoidal.μ F (X ⊗ Y) Z ≫ map F (iso.hom α_) =
  iso.hom α_ ≫ (𝟙 ⊗ lax_monoidal.μ F Y Z) ≫ lax_monoidal.μ F X (Y ⊗ Z) := sorry

namespace lax_monoidal_functor

/--
Construct a bundled `lax_monoidal_functor` from the object level function
and `functorial` and `lax_monoidal` typeclasses.
-/
@[simp] theorem of_μ {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : C → D) [I₁ : functorial F] [I₂ : lax_monoidal F] (X : C) (Y : C) : μ (of F) X Y = lax_monoidal.μ F X Y :=
  Eq.refl (μ (of F) X Y)

end lax_monoidal_functor

protected instance lax_monoidal_functor.obj.lax_monoidal {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : lax_monoidal_functor C D) : lax_monoidal (functor.obj (lax_monoidal_functor.to_functor F)) :=
  lax_monoidal.mk (lax_monoidal_functor.ε F) (lax_monoidal_functor.μ F)

protected instance lax_monoidal_id {C : Type u₁} [category C] [monoidal_category C] : lax_monoidal id :=
  lax_monoidal.mk 𝟙 fun (X Y : C) => 𝟙