/-
Copyright (c) 2015 Joe Hendrix. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Sebastian Ullrich
-/

import data.vector.basic
import data.nat.basic

/-!
# Basic operations on bitvectors

This is a work-in-progress, and contains additions to other theories.

This file was moved to mathlib from core Lean in the switch to Lean 3.20.0c.
It is not fully in compliance with mathlib style standards.
-/

/-- `bitvec n` is a `vector` of `bool` with length `n`. -/
@[reducible] def bitvec (n : ℕ) := vector bool n

namespace bitvec
open nat
open vector

local infix `++ₜ`:65 := vector.append

/-- Create a zero bitvector -/
@[reducible] protected def zero (n : ℕ) : bitvec n := repeat ff n

/-- Create a bitvector of length `n` whose `n-1`st entry is 1 and other entries are 0. -/
@[reducible] protected def one : Π (n : ℕ), bitvec n
| 0        := nil
| (succ n) := repeat ff n ++ₜ tt::ᵥnil

/-- Create a bitvector from another with a provably equal length. -/
protected def cong {a b : ℕ} (h : a = b) : bitvec a → bitvec b
| ⟨x, p⟩ := ⟨x, h ▸ p⟩

/-- `bitvec` specific version of `vector.append` -/
def append {m n} : bitvec m → bitvec n → bitvec (m + n) := vector.append

/-! ### Shift operations -/
section shift
variable {n : ℕ}

/-- `shl x i` is the bitvector obtained by left-shifting `x` `i` times and padding with `ff`.
If `x.length < i` then this will return the all-`ff`s bitvector. -/
def shl (x : bitvec n) (i : ℕ) : bitvec n :=
bitvec.cong (by simp) $
  drop i x ++ₜ repeat ff (min n i)

/-- `fill_shr x i fill` is the bitvector obtained by right-shifting `x` `i` times and then
padding with `fill : bool`. If `x.length < i` then this will return the constant `fill`
bitvector. -/
def fill_shr (x : bitvec n) (i : ℕ) (fill : bool) : bitvec n :=
bitvec.cong
  begin
    by_cases (i ≤ n),
    { have h₁ := nat.sub_le n i,
      rw [min_eq_right h],
      rw [min_eq_left h₁, ← add_tsub_assoc_of_le h, nat.add_comm, add_tsub_cancel_right] },
    { have h₁ := le_of_not_ge h,
      rw [min_eq_left h₁, tsub_eq_zero_iff_le.mpr h₁, zero_min, nat.add_zero] }
  end $
  repeat fill (min n i) ++ₜ take (n-i) x

/-- unsigned shift right -/
def ushr (x : bitvec n) (i : ℕ) : bitvec n :=
fill_shr x i ff

/-- signed shift right -/
def sshr : Π {m : ℕ}, bitvec m → ℕ → bitvec m
| 0        _ _ := nil
| (succ m) x i := head x ::ᵥ fill_shr (tail x) i (head x)

end shift

/-! ### Bitwise operations -/
section bitwise
variable {n : ℕ}

/-- bitwise not -/
def not : bitvec n → bitvec n := map bnot
/-- bitwise and -/
def and : bitvec n → bitvec n → bitvec n := map₂ band
/-- bitwise or -/
def or  : bitvec n → bitvec n → bitvec n := map₂ bor
/-- bitwise xor -/
def xor : bitvec n → bitvec n → bitvec n := map₂ bxor

end bitwise

/-! ### Arithmetic operators -/
section arith
variable {n : ℕ}

/-- `xor3 x y c` is `((x XOR y) XOR c)`. -/
protected def xor3 (x y c : bool) := bxor (bxor x y) c
/-- `carry x y c` is `x && y || x && c || y && c`. -/
protected def carry (x y c : bool) :=
x && y || x && c || y && c

/-- `neg x` is the two's complement of `x`. -/
protected def neg (x : bitvec n) : bitvec n :=
let f := λ y c, (y || c, bxor y c) in
prod.snd (map_accumr f x ff)

/-- Add with carry (no overflow) -/
def adc (x y : bitvec n) (c : bool) : bitvec (n+1) :=
let f := λ x y c, (bitvec.carry x y c, bitvec.xor3 x y c) in
let ⟨c, z⟩ := vector.map_accumr₂ f x y c in
c ::ᵥ z

/-- The sum of two bitvectors -/
protected def add (x y : bitvec n) : bitvec n := tail (adc x y ff)

/-- Subtract with borrow -/
def sbb (x y : bitvec n) (b : bool) : bool × bitvec n :=
let f := λ x y c, (bitvec.carry (bnot x) y c, bitvec.xor3 x y c) in
vector.map_accumr₂ f x y b

/-- The difference of two bitvectors -/
protected def sub (x y : bitvec n) : bitvec n := prod.snd (sbb x y ff)

instance : has_zero (bitvec n) := ⟨bitvec.zero n⟩
instance : has_one (bitvec n)  := ⟨bitvec.one n⟩
instance : has_add (bitvec n)  := ⟨bitvec.add⟩
instance : has_sub (bitvec n)  := ⟨bitvec.sub⟩
instance : has_neg (bitvec n)  := ⟨bitvec.neg⟩

/-- The product of two bitvectors -/
protected def mul (x y : bitvec n) : bitvec n :=
let f := λ r b, cond b (r + r + y) (r + r) in
(to_list x).foldl f 0

instance : has_mul (bitvec n)  := ⟨bitvec.mul⟩
end arith

/-! ### Comparison operators -/
section comparison
variable {n : ℕ}

/-- `uborrow x y` returns `tt` iff the "subtract with borrow" operation on `x`, `y` and `ff`
required a borrow. -/
def uborrow (x y : bitvec n) : bool := prod.fst (sbb x y ff)

/-- unsigned less-than proposition -/
def ult (x y : bitvec n) : Prop := uborrow x y
/-- unsigned greater-than proposition -/
def ugt (x y : bitvec n) : Prop := ult y x

/-- unsigned less-than-or-equal-to proposition -/
def ule (x y : bitvec n) : Prop := ¬ (ult y x)
/-- unsigned greater-than-or-equal-to proposition -/
def uge (x y : bitvec n) : Prop := ule y x

/-- `sborrow x y` returns `tt` iff `x < y` as two's complement integers -/
def sborrow : Π {n : ℕ}, bitvec n → bitvec n → bool
| 0        _ _ := ff
| (succ n) x y :=
  match (head x, head y) with
  | (tt, ff) := tt
  | (ff, tt) := ff
  | _        := uborrow (tail x) (tail y)
  end

/-- signed less-than proposition -/
def slt (x y : bitvec n) : Prop := sborrow x y
/-- signed greater-than proposition -/
def sgt (x y : bitvec n) : Prop := slt y x
/-- signed less-than-or-equal-to proposition -/
def sle (x y : bitvec n) : Prop := ¬ (slt y x)
/-- signed greater-than-or-equal-to proposition -/
def sge (x y : bitvec n) : Prop := sle y x

end comparison

/-! ### Conversion to `nat` and `int` -/
section conversion
variable {α : Type}

/-- Create a bitvector from a `nat` -/
protected def of_nat : Π (n : ℕ), nat → bitvec n
| 0        x := nil
| (succ n) x := of_nat n (x / 2) ++ₜ to_bool (x % 2 = 1) ::ᵥ nil

/-- Create a bitvector in the two's complement representation from an `int` -/
protected def of_int : Π (n : ℕ), int → bitvec (succ n)
| n (int.of_nat m)          := ff ::ᵥ bitvec.of_nat n m
| n (int.neg_succ_of_nat m) := tt ::ᵥ not (bitvec.of_nat n m)

/-- `add_lsb r b` is `r + r + 1` if `b` is `tt` and `r + r` otherwise. -/
def add_lsb (r : ℕ) (b : bool) := r + r + cond b 1 0

/-- Given a `list` of `bool`s, return the `nat` they represent as a list of binary digits. -/
def bits_to_nat (v : list bool) : nat :=
v.foldl add_lsb 0

/-- Return the natural number encoded by the input bitvector -/
protected def to_nat {n : nat} (v : bitvec n) : nat :=
bits_to_nat (to_list v)

theorem bits_to_nat_to_list {n : ℕ} (x : bitvec n) :
bitvec.to_nat x = bits_to_nat (vector.to_list x)  := rfl

local attribute [simp] nat.add_comm nat.add_assoc nat.add_left_comm nat.mul_comm nat.mul_assoc
local attribute [simp] nat.zero_add nat.add_zero nat.one_mul nat.mul_one nat.zero_mul nat.mul_zero
-- mul_left_comm

theorem to_nat_append {m : ℕ} (xs : bitvec m) (b : bool) :
bitvec.to_nat (xs ++ₜ b::ᵥnil) = bitvec.to_nat xs * 2 + bitvec.to_nat (b::ᵥnil) :=
begin
  cases xs with xs P,
  simp [bits_to_nat_to_list], clear P,
  unfold bits_to_nat list.foldl,
  -- generalize the accumulator of foldl
  generalize h : 0 = x, conv in (add_lsb x b) { rw ←h }, clear h,
  simp,
  induction xs with x xs generalizing x,
  { simp, unfold list.foldl add_lsb, simp [nat.mul_succ] },
  { simp, apply xs_ih }
end

theorem bits_to_nat_to_bool (n : ℕ)
: bitvec.to_nat (to_bool (n % 2 = 1) ::ᵥ nil) = n % 2 :=
begin
  simp [bits_to_nat_to_list],
  unfold bits_to_nat add_lsb list.foldl cond,
  simp [cond_to_bool_mod_two],
end

theorem of_nat_succ {k n : ℕ}
:  bitvec.of_nat (succ k) n = bitvec.of_nat k (n / 2) ++ₜ to_bool (n % 2 = 1) ::ᵥ nil :=
rfl

theorem to_nat_of_nat {k n : ℕ}
: bitvec.to_nat (bitvec.of_nat k n) = n % 2 ^ k :=
begin
  induction k with k ih generalizing n,
  { simp [nat.mod_one], refl },
  { have h : 0 < 2, { apply le_succ },
    rw [of_nat_succ, to_nat_append, ih, bits_to_nat_to_bool, mod_pow_succ h, nat.mul_comm] }
end

/-- Return the integer encoded by the input bitvector -/
protected def to_int : Π {n : nat}, bitvec n → int
| 0        _ := 0
| (succ n) v :=
  cond (head v)
    (int.neg_succ_of_nat $ bitvec.to_nat $ not $ tail v)
    (int.of_nat $ bitvec.to_nat $ tail v)

end conversion

/-! ### Miscellaneous instances -/
private def repr {n : nat} : bitvec n → string
| ⟨bs, p⟩ :=
  "0b" ++ (bs.map (λ b : bool, if b then '1' else '0')).as_string

instance (n : nat) : has_repr (bitvec n) :=
⟨repr⟩
end bitvec

instance {n} {x y : bitvec n} : decidable (bitvec.ult x y) := bool.decidable_eq _ _
instance {n} {x y : bitvec n} : decidable (bitvec.ugt x y) := bool.decidable_eq _ _


/-
Copyright (c) 2022 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky

! This file was ported from Lean 3 source module data.list.rdrop
! leanprover-community/mathlib commit be24ec5de6701447e5df5ca75400ffee19d65659
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Basic
import Mathbin.Data.List.Infix

/-!

# Dropping or taking from lists on the right

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

Taking or removing element from the tail end of a list

## Main defintions

- `rdrop n`: drop `n : ℕ` elements from the tail
- `rtake n`: take `n : ℕ` elements from the tail
- `drop_while p`: remove all the elements that satisfy a decidable `p : α → Prop` from the tail of
  a list until hitting the first non-satisfying element
- `take_while p`: take all the elements that satisfy a decidable `p : α → Prop` from the tail of
  a list until hitting the first non-satisfying element

## Implementation detail

The two predicate-based methods operate by performing the regular "from-left" operation on
`list.reverse`, followed by another `list.reverse`, so they are not the most performant.
The other two rely on `list.length l` so they still traverse the list twice. One could construct
another function that takes a `L : ℕ` and use `L - n`. Under a proof condition that
`L = l.length`, the function would do the right thing.

-/

variable {α : Type _} (p : α → Prop) [DecidablePred p] (l : List α) (n : ℕ)

namespace List

#print List.rdrop /-
/-- Drop `n` elements from the tail end of a list. -/
def rdrop : List α :=
  l.take (l.length - n)
#align list.rdrop List.rdrop
-/

#print List.rdrop_nil /-
@[simp]
theorem rdrop_nil : rdrop ([] : List α) n = [] := by simp [rdrop]
#align list.rdrop_nil List.rdrop_nil
-/

#print List.rdrop_zero /-
@[simp]
theorem rdrop_zero : rdrop l 0 = l := by simp [rdrop]
#align list.rdrop_zero List.rdrop_zero
-/

#print List.rdrop_eq_reverse_drop_reverse /-
theorem rdrop_eq_reverse_drop_reverse : l.rdrop n = reverse (l.reverse.drop n) :=
  by
  rw [rdrop]
  induction' l using List.reverseRecOn with xs x IH generalizing n
  · simp
  · cases n
    · simp [take_append]
    · simp [take_append_eq_append_take, IH]
#align list.rdrop_eq_reverse_drop_reverse List.rdrop_eq_reverse_drop_reverse
-/

#print List.rdrop_concat_succ /-
@[simp]
theorem rdrop_concat_succ (x : α) : rdrop (l ++ [x]) (n + 1) = rdrop l n := by
  simp [rdrop_eq_reverse_drop_reverse]
#align list.rdrop_concat_succ List.rdrop_concat_succ
-/

#print List.rtake /-
/-- Take `n` elements from the tail end of a list. -/
def rtake : List α :=
  l.drop (l.length - n)
#align list.rtake List.rtake
-/

#print List.rtake_nil /-
@[simp]
theorem rtake_nil : rtake ([] : List α) n = [] := by simp [rtake]
#align list.rtake_nil List.rtake_nil
-/

#print List.rtake_zero /-
@[simp]
theorem rtake_zero : rtake l 0 = [] := by simp [rtake]
#align list.rtake_zero List.rtake_zero
-/

#print List.rtake_eq_reverse_take_reverse /-
theorem rtake_eq_reverse_take_reverse : l.rtake n = reverse (l.reverse.take n) :=
  by
  rw [rtake]
  induction' l using List.reverseRecOn with xs x IH generalizing n
  · simp
  · cases n
    · simp
    · simp [drop_append_eq_append_drop, IH]
#align list.rtake_eq_reverse_take_reverse List.rtake_eq_reverse_take_reverse
-/

#print List.rtake_concat_succ /-
@[simp]
theorem rtake_concat_succ (x : α) : rtake (l ++ [x]) (n + 1) = rtake l n ++ [x] := by
  simp [rtake_eq_reverse_take_reverse]
#align list.rtake_concat_succ List.rtake_concat_succ
-/

/- warning: list.rdrop_while -> List.rdropWhile is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p], (List.{u1} α) -> (List.{u1} α)
but is expected to have type
  forall {α : Type.{u1}}, (α -> Bool) -> (List.{u1} α) -> (List.{u1} α)
Case conversion may be inaccurate. Consider using '#align list.rdrop_while List.rdropWhileₓ'. -/
/-- Drop elements from the tail end of a list that satisfy `p : α → Prop`.
Implemented naively via `list.reverse` -/
def rdropWhile : List α :=
  reverse (l.reverse.dropWhileₓ p)
#align list.rdrop_while List.rdropWhile

/- warning: list.rdrop_while_nil -> List.rdropWhile_nil is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p], Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) (List.nil.{u1} α)) (List.nil.{u1} α)
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool), Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (List.nil.{u1} α)) (List.nil.{u1} α)
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_nil List.rdropWhile_nilₓ'. -/
@[simp]
theorem rdropWhile_nil : rdropWhile p ([] : List α) = [] := by simp [rdrop_while, drop_while]
#align list.rdrop_while_nil List.rdropWhile_nil

/- warning: list.rdrop_while_concat -> List.rdropWhile_concat is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α) (x : α), Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α)))) (ite.{succ u1} (List.{u1} α) (p x) (_inst_1 x) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) l) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α))))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α) (l : α), Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) _inst_1 (List.cons.{u1} α l (List.nil.{u1} α)))) (ite.{succ u1} (List.{u1} α) (Eq.{1} Bool (p l) Bool.true) (instDecidableEqBool (p l) Bool.true) (List.rdropWhile.{u1} α p _inst_1) (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) _inst_1 (List.cons.{u1} α l (List.nil.{u1} α))))
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_concat List.rdropWhile_concatₓ'. -/
theorem rdropWhile_concat (x : α) :
    rdropWhile p (l ++ [x]) = if p x then rdropWhile p l else l ++ [x] :=
  by
  simp only [rdrop_while, drop_while, reverse_append, reverse_singleton, singleton_append]
  split_ifs with h h <;> simp [h]
#align list.rdrop_while_concat List.rdropWhile_concat

/- warning: list.rdrop_while_concat_pos -> List.rdropWhile_concat_pos is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α) (x : α), (p x) -> (Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α)))) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) l))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α) (l : α), (Eq.{1} Bool (p l) Bool.true) -> (Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) _inst_1 (List.cons.{u1} α l (List.nil.{u1} α)))) (List.rdropWhile.{u1} α p _inst_1))
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_concat_pos List.rdropWhile_concat_posₓ'. -/
@[simp]
theorem rdropWhile_concat_pos (x : α) (h : p x) : rdropWhile p (l ++ [x]) = rdropWhile p l := by
  rw [rdrop_while_concat, if_pos h]
#align list.rdrop_while_concat_pos List.rdropWhile_concat_pos

/- warning: list.rdrop_while_concat_neg -> List.rdropWhile_concat_neg is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α) (x : α), (Not (p x)) -> (Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α)))) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α))))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α) (l : α), (Not (Eq.{1} Bool (p l) Bool.true)) -> (Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) _inst_1 (List.cons.{u1} α l (List.nil.{u1} α)))) (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) _inst_1 (List.cons.{u1} α l (List.nil.{u1} α))))
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_concat_neg List.rdropWhile_concat_negₓ'. -/
@[simp]
theorem rdropWhile_concat_neg (x : α) (h : ¬p x) : rdropWhile p (l ++ [x]) = l ++ [x] := by
  rw [rdrop_while_concat, if_neg h]
#align list.rdrop_while_concat_neg List.rdropWhile_concat_neg

/- warning: list.rdrop_while_singleton -> List.rdropWhile_singleton is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (x : α), Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) (List.cons.{u1} α x (List.nil.{u1} α))) (ite.{succ u1} (List.{u1} α) (p x) (_inst_1 x) (List.nil.{u1} α) (List.cons.{u1} α x (List.nil.{u1} α)))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : α), Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (List.cons.{u1} α _inst_1 (List.nil.{u1} α))) (ite.{succ u1} (List.{u1} α) (Eq.{1} Bool (p _inst_1) Bool.true) (instDecidableEqBool (p _inst_1) Bool.true) (List.nil.{u1} α) (List.cons.{u1} α _inst_1 (List.nil.{u1} α)))
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_singleton List.rdropWhile_singletonₓ'. -/
theorem rdropWhile_singleton (x : α) : rdropWhile p [x] = if p x then [] else [x] := by
  rw [← nil_append [x], rdrop_while_concat, rdrop_while_nil]
#align list.rdrop_while_singleton List.rdropWhile_singleton

/- warning: list.rdrop_while_last_not -> List.rdropWhile_last_not is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α) (hl : Ne.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) l) (List.nil.{u1} α)), Not (p (List.getLast.{u1} α (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) l) hl))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α) (l : Ne.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p _inst_1) (List.nil.{u1} α)), Not (Eq.{1} Bool (p (List.getLast.{u1} α (List.rdropWhile.{u1} α p _inst_1) l)) Bool.true)
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_last_not List.rdropWhile_last_notₓ'. -/
theorem rdropWhile_last_not (hl : l.rdropWhile p ≠ []) : ¬p ((rdropWhile p l).getLast hl) :=
  by
  simp_rw [rdrop_while]
  rw [last_reverse]
  exact drop_while_nth_le_zero_not _ _ _
#align list.rdrop_while_last_not List.rdropWhile_last_not

/- warning: list.rdrop_while_prefix -> List.rdropWhile_prefix is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α), List.isPrefix.{u1} α (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) l) l
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α), List.isPrefix.{u1} α (List.rdropWhile.{u1} α p _inst_1) _inst_1
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_prefix List.rdropWhile_prefixₓ'. -/
theorem rdropWhile_prefix : l.rdropWhile p <+: l :=
  by
  rw [← reverse_suffix, rdrop_while, reverse_reverse]
  exact drop_while_suffix _
#align list.rdrop_while_prefix List.rdropWhile_prefix

variable {p} {l}

/- warning: list.rdrop_while_eq_nil_iff -> List.rdropWhile_eq_nil_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [_inst_1 : DecidablePred.{succ u1} α p] {l : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) l) (List.nil.{u1} α)) (forall (x : α), (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) -> (p x))
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} {_inst_1 : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p _inst_1) (List.nil.{u1} α)) (forall (x : α), (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x _inst_1) -> (Eq.{1} Bool (p x) Bool.true))
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_eq_nil_iff List.rdropWhile_eq_nil_iffₓ'. -/
@[simp]
theorem rdropWhile_eq_nil_iff : rdropWhile p l = [] ↔ ∀ x ∈ l, p x := by simp [rdrop_while]
#align list.rdrop_while_eq_nil_iff List.rdropWhile_eq_nil_iff

/- warning: list.drop_while_eq_self_iff -> List.dropWhile_eq_self_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [_inst_1 : DecidablePred.{succ u1} α p] {l : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.dropWhileₓ.{u1} α p (fun (a : α) => _inst_1 a) l) l) (forall (hl : LT.lt.{0} Nat Nat.hasLt (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) (List.length.{u1} α l)), Not (p (List.nthLe.{u1} α l (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) hl)))
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} {_inst_1 : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.dropWhile.{u1} α p _inst_1) _inst_1) (forall (hl : LT.lt.{0} Nat instLTNat (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) (List.length.{u1} α _inst_1)), Not (Eq.{1} Bool (p (List.nthLe.{u1} α _inst_1 (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) hl)) Bool.true))
Case conversion may be inaccurate. Consider using '#align list.drop_while_eq_self_iff List.dropWhile_eq_self_iffₓ'. -/
-- it is in this file because it requires `list.infix`
@[simp]
theorem dropWhile_eq_self_iff : dropWhile p l = l ↔ ∀ hl : 0 < l.length, ¬p (l.nthLe 0 hl) :=
  by
  induction' l with hd tl IH
  · simp
  · rw [drop_while]
    split_ifs
    · simp only [h, length, nth_le, Nat.succ_pos', not_true, forall_true_left, iff_false_iff]
      intro H
      refine' (cons_ne_self hd tl) (sublist.antisymm _ (sublist_cons _ _))
      rw [← H]
      exact (drop_while_suffix _).Sublist
    · simp [h]
#align list.drop_while_eq_self_iff List.dropWhile_eq_self_iff

/- warning: list.rdrop_while_eq_self_iff -> List.rdropWhile_eq_self_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [_inst_1 : DecidablePred.{succ u1} α p] {l : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) l) l) (forall (hl : Ne.{succ u1} (List.{u1} α) l (List.nil.{u1} α)), Not (p (List.getLast.{u1} α l hl)))
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} {_inst_1 : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p _inst_1) _inst_1) (forall (hl : Ne.{succ u1} (List.{u1} α) _inst_1 (List.nil.{u1} α)), Not (Eq.{1} Bool (p (List.getLast.{u1} α _inst_1 hl)) Bool.true))
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_eq_self_iff List.rdropWhile_eq_self_iffₓ'. -/
@[simp]
theorem rdropWhile_eq_self_iff : rdropWhile p l = l ↔ ∀ hl : l ≠ [], ¬p (l.getLast hl) :=
  by
  simp only [rdrop_while, reverse_eq_iff, length_reverse, Ne.def, drop_while_eq_self_iff,
    last_eq_nth_le, ← length_eq_zero, pos_iff_ne_zero]
  refine' forall_congr' _
  intro h
  rw [nth_le_reverse']
  · simp
  · rw [← Ne.def, ← pos_iff_ne_zero] at h
    simp [tsub_lt_iff_right (Nat.succ_le_of_lt h)]
#align list.rdrop_while_eq_self_iff List.rdropWhile_eq_self_iff

variable (p) (l)

/- warning: list.drop_while_idempotent -> List.dropWhile_idempotent is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α), Eq.{succ u1} (List.{u1} α) (List.dropWhileₓ.{u1} α p (fun (a : α) => _inst_1 a) (List.dropWhileₓ.{u1} α p (fun (a : α) => _inst_1 a) l)) (List.dropWhileₓ.{u1} α p (fun (a : α) => _inst_1 a) l)
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α), Eq.{succ u1} (List.{u1} α) (List.dropWhile.{u1} α p (List.dropWhile.{u1} α p _inst_1)) (List.dropWhile.{u1} α p _inst_1)
Case conversion may be inaccurate. Consider using '#align list.drop_while_idempotent List.dropWhile_idempotentₓ'. -/
theorem dropWhile_idempotent : dropWhile p (dropWhile p l) = dropWhile p l :=
  dropWhile_eq_self_iff.mpr (dropWhile_nthLe_zero_not _ _)
#align list.drop_while_idempotent List.dropWhile_idempotent

/- warning: list.rdrop_while_idempotent -> List.rdropWhile_idempotent is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α), Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) l)) (List.rdropWhile.{u1} α p (fun (a : α) => _inst_1 a) l)
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α), Eq.{succ u1} (List.{u1} α) (List.rdropWhile.{u1} α p (List.rdropWhile.{u1} α p _inst_1)) (List.rdropWhile.{u1} α p _inst_1)
Case conversion may be inaccurate. Consider using '#align list.rdrop_while_idempotent List.rdropWhile_idempotentₓ'. -/
theorem rdropWhile_idempotent : rdropWhile p (rdropWhile p l) = rdropWhile p l :=
  rdropWhile_eq_self_iff.mpr (rdropWhile_last_not _ _)
#align list.rdrop_while_idempotent List.rdropWhile_idempotent

/- warning: list.rtake_while -> List.rtakeWhile is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p], (List.{u1} α) -> (List.{u1} α)
but is expected to have type
  forall {α : Type.{u1}}, (α -> Bool) -> (List.{u1} α) -> (List.{u1} α)
Case conversion may be inaccurate. Consider using '#align list.rtake_while List.rtakeWhileₓ'. -/
/-- Take elements from the tail end of a list that satisfy `p : α → Prop`.
Implemented naively via `list.reverse` -/
def rtakeWhile : List α :=
  reverse (l.reverse.takeWhile p)
#align list.rtake_while List.rtakeWhile

/- warning: list.rtake_while_nil -> List.rtakeWhile_nil is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p], Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) (List.nil.{u1} α)) (List.nil.{u1} α)
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool), Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (List.nil.{u1} α)) (List.nil.{u1} α)
Case conversion may be inaccurate. Consider using '#align list.rtake_while_nil List.rtakeWhile_nilₓ'. -/
@[simp]
theorem rtakeWhile_nil : rtakeWhile p ([] : List α) = [] := by simp [rtake_while, take_while]
#align list.rtake_while_nil List.rtakeWhile_nil

/- warning: list.rtake_while_concat -> List.rtakeWhile_concat is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α) (x : α), Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α)))) (ite.{succ u1} (List.{u1} α) (p x) (_inst_1 x) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) l) (List.cons.{u1} α x (List.nil.{u1} α))) (List.nil.{u1} α))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α) (l : α), Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) _inst_1 (List.cons.{u1} α l (List.nil.{u1} α)))) (ite.{succ u1} (List.{u1} α) (Eq.{1} Bool (p l) Bool.true) (instDecidableEqBool (p l) Bool.true) (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) (List.rtakeWhile.{u1} α p _inst_1) (List.cons.{u1} α l (List.nil.{u1} α))) (List.nil.{u1} α))
Case conversion may be inaccurate. Consider using '#align list.rtake_while_concat List.rtakeWhile_concatₓ'. -/
theorem rtakeWhile_concat (x : α) :
    rtakeWhile p (l ++ [x]) = if p x then rtakeWhile p l ++ [x] else [] :=
  by
  simp only [rtake_while, take_while, reverse_append, reverse_singleton, singleton_append]
  split_ifs with h h <;> simp [h]
#align list.rtake_while_concat List.rtakeWhile_concat

/- warning: list.rtake_while_concat_pos -> List.rtakeWhile_concat_pos is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α) (x : α), (p x) -> (Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α)))) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) l) (List.cons.{u1} α x (List.nil.{u1} α))))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α) (l : α), (Eq.{1} Bool (p l) Bool.true) -> (Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) _inst_1 (List.cons.{u1} α l (List.nil.{u1} α)))) (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) (List.rtakeWhile.{u1} α p _inst_1) (List.cons.{u1} α l (List.nil.{u1} α))))
Case conversion may be inaccurate. Consider using '#align list.rtake_while_concat_pos List.rtakeWhile_concat_posₓ'. -/
@[simp]
theorem rtakeWhile_concat_pos (x : α) (h : p x) : rtakeWhile p (l ++ [x]) = rtakeWhile p l ++ [x] :=
  by rw [rtake_while_concat, if_pos h]
#align list.rtake_while_concat_pos List.rtakeWhile_concat_pos

/- warning: list.rtake_while_concat_neg -> List.rtakeWhile_concat_neg is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α) (x : α), (Not (p x)) -> (Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) (Append.append.{u1} (List.{u1} α) (List.hasAppend.{u1} α) l (List.cons.{u1} α x (List.nil.{u1} α)))) (List.nil.{u1} α))
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α) (l : α), (Not (Eq.{1} Bool (p l) Bool.true)) -> (Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (HAppend.hAppend.{u1, u1, u1} (List.{u1} α) (List.{u1} α) (List.{u1} α) (instHAppend.{u1} (List.{u1} α) (List.instAppendList.{u1} α)) _inst_1 (List.cons.{u1} α l (List.nil.{u1} α)))) (List.nil.{u1} α))
Case conversion may be inaccurate. Consider using '#align list.rtake_while_concat_neg List.rtakeWhile_concat_negₓ'. -/
@[simp]
theorem rtakeWhile_concat_neg (x : α) (h : ¬p x) : rtakeWhile p (l ++ [x]) = [] := by
  rw [rtake_while_concat, if_neg h]
#align list.rtake_while_concat_neg List.rtakeWhile_concat_neg

/- warning: list.rtake_while_suffix -> List.rtakeWhile_suffix is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α), List.isSuffix.{u1} α (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) l) l
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α), List.isSuffix.{u1} α (List.rtakeWhile.{u1} α p _inst_1) _inst_1
Case conversion may be inaccurate. Consider using '#align list.rtake_while_suffix List.rtakeWhile_suffixₓ'. -/
theorem rtakeWhile_suffix : l.rtakeWhile p <:+ l :=
  by
  rw [← reverse_prefix, rtake_while, reverse_reverse]
  exact take_while_prefix _
#align list.rtake_while_suffix List.rtakeWhile_suffix

variable {p} {l}

/- warning: list.rtake_while_eq_self_iff -> List.rtakeWhile_eq_self_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [_inst_1 : DecidablePred.{succ u1} α p] {l : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) l) l) (forall (x : α), (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x l) -> (p x))
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} {_inst_1 : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p _inst_1) _inst_1) (forall (x : α), (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) x _inst_1) -> (Eq.{1} Bool (p x) Bool.true))
Case conversion may be inaccurate. Consider using '#align list.rtake_while_eq_self_iff List.rtakeWhile_eq_self_iffₓ'. -/
@[simp]
theorem rtakeWhile_eq_self_iff : rtakeWhile p l = l ↔ ∀ x ∈ l, p x := by
  simp [rtake_while, reverse_eq_iff]
#align list.rtake_while_eq_self_iff List.rtakeWhile_eq_self_iff

/- warning: list.rtake_while_eq_nil_iff -> List.rtakeWhile_eq_nil_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [_inst_1 : DecidablePred.{succ u1} α p] {l : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) l) (List.nil.{u1} α)) (forall (hl : Ne.{succ u1} (List.{u1} α) l (List.nil.{u1} α)), Not (p (List.getLast.{u1} α l hl)))
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} {_inst_1 : List.{u1} α}, Iff (Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p _inst_1) (List.nil.{u1} α)) (forall (hl : Ne.{succ u1} (List.{u1} α) _inst_1 (List.nil.{u1} α)), Not (Eq.{1} Bool (p (List.getLast.{u1} α _inst_1 hl)) Bool.true))
Case conversion may be inaccurate. Consider using '#align list.rtake_while_eq_nil_iff List.rtakeWhile_eq_nil_iffₓ'. -/
@[simp]
theorem rtakeWhile_eq_nil_iff : rtakeWhile p l = [] ↔ ∀ hl : l ≠ [], ¬p (l.getLast hl) := by
  induction l using List.reverseRecOn <;> simp [rtake_while]
#align list.rtake_while_eq_nil_iff List.rtakeWhile_eq_nil_iff

/- warning: list.mem_rtake_while_imp -> List.mem_rtakeWhile_imp is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {p : α -> Prop} [_inst_1 : DecidablePred.{succ u1} α p] {l : List.{u1} α} {x : α}, (Membership.Mem.{u1, u1} α (List.{u1} α) (List.hasMem.{u1} α) x (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) l)) -> (p x)
but is expected to have type
  forall {α : Type.{u1}} {p : α -> Bool} {_inst_1 : List.{u1} α} {l : α}, (Membership.mem.{u1, u1} α (List.{u1} α) (List.instMembershipList.{u1} α) l (List.rtakeWhile.{u1} α p _inst_1)) -> (Eq.{1} Bool (p l) Bool.true)
Case conversion may be inaccurate. Consider using '#align list.mem_rtake_while_imp List.mem_rtakeWhile_impₓ'. -/
theorem mem_rtakeWhile_imp {x : α} (hx : x ∈ rtakeWhile p l) : p x :=
  by
  suffices x ∈ take_while p l.reverse by exact mem_take_while_imp this
  rwa [← mem_reverse, ← rtake_while]
#align list.mem_rtake_while_imp List.mem_rtakeWhile_imp

variable (p) (l)

/- warning: list.rtake_while_idempotent -> List.rtakeWhile_idempotent is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (p : α -> Prop) [_inst_1 : DecidablePred.{succ u1} α p] (l : List.{u1} α), Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) l)) (List.rtakeWhile.{u1} α p (fun (a : α) => _inst_1 a) l)
but is expected to have type
  forall {α : Type.{u1}} (p : α -> Bool) (_inst_1 : List.{u1} α), Eq.{succ u1} (List.{u1} α) (List.rtakeWhile.{u1} α p (List.rtakeWhile.{u1} α p _inst_1)) (List.rtakeWhile.{u1} α p _inst_1)
Case conversion may be inaccurate. Consider using '#align list.rtake_while_idempotent List.rtakeWhile_idempotentₓ'. -/
theorem rtakeWhile_idempotent : rtakeWhile p (rtakeWhile p l) = rtakeWhile p l :=
  rtakeWhile_eq_self_iff.mpr fun _ => mem_rtakeWhile_imp
#align list.rtake_while_idempotent List.rtakeWhile_idempotent

end List


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

import data.mv_polynomial.comm_ring
import ring_theory.mv_polynomial.basic

/-!
# Multivariate polynomials over fields

This file contains basic facts about multivariate polynomials over fields, for example that the
dimension of the space of multivariate polynomials over a field is equal to the cardinality of
finitely supported functions from the indexing set to `ℕ`.
-/

noncomputable theory

open_locale classical

open set linear_map submodule
open_locale big_operators

namespace mv_polynomial
universes u v
variables {σ : Type u} {K : Type v}
variables (σ K) [field K]

lemma quotient_mk_comp_C_injective (I : ideal (mv_polynomial σ K)) (hI : I ≠ ⊤) :
  function.injective ((ideal.quotient.mk I).comp mv_polynomial.C) :=
begin
  refine (injective_iff_map_eq_zero _).2 (λ x hx, _),
  rw [ring_hom.comp_apply, ideal.quotient.eq_zero_iff_mem] at hx,
  refine classical.by_contradiction (λ hx0, absurd (I.eq_top_iff_one.2 _) hI),
  have := I.mul_mem_left (mv_polynomial.C x⁻¹) hx,
  rwa [← mv_polynomial.C.map_mul, inv_mul_cancel hx0, mv_polynomial.C_1] at this,
end

end mv_polynomial

namespace mv_polynomial

universe u
variables {σ : Type u} {K : Type u} [field K]

open_locale classical

lemma dim_mv_polynomial : module.rank K (mv_polynomial σ K) = cardinal.mk (σ →₀ ℕ) :=
by rw [← cardinal.lift_inj, ← (basis_monomials σ K).mk_eq_dim]

end mv_polynomial


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

! This file was ported from Lean 3 source module algebra.hom.iterate
! leanprover-community/mathlib commit 792a2a264169d64986541c6f8f7e3bbb6acb6295
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupPower.Lemmas
import Mathlib.GroupTheory.GroupAction.Opposite

/-!
# Iterates of monoid and ring homomorphisms

Iterate of a monoid/ring homomorphism is a monoid/ring homomorphism but it has a wrong type, so Lean
can't apply lemmas like `MonoidHom.map_one` to `f^[n] 1`. Though it is possible to define
a monoid structure on the endomorphisms, quite often we do not want to convert from
`M →* M` to `Monoid.End M` and from `f^[n]` to `f^n` just to apply a simple lemma.

So, we restate standard `*Hom.map_*` lemmas under names `*Hom.iterate_map_*`.

We also prove formulas for iterates of add/mul left/right.

## Tags

homomorphism, iterate
-/

open Function

variable {M : Type _} {N : Type _} {G : Type _} {H : Type _}

/-- An auxiliary lemma that can be used to prove `⇑(f ^ n) = (⇑f^[n])`. -/
theorem hom_coe_pow {F : Type _} [Monoid F] (c : F → M → M) (h1 : c 1 = id)
    (hmul : ∀ f g, c (f * g) = c f ∘ c g) (f : F) : ∀ n, c (f ^ n) = c f^[n]
  | 0 => by
    rw [pow_zero, h1]
    rfl
  | n + 1 => by rw [pow_succ, iterate_succ', hmul, hom_coe_pow c h1 hmul f n]
#align hom_coe_pow hom_coe_pow

namespace MonoidHom

section

variable [MulOneClass M] [MulOneClass N]

@[to_additive (attr := simp)]
theorem iterate_map_one (f : M →* M) (n : ℕ) : (f^[n]) 1 = 1 :=
  iterate_fixed f.map_one n
#align monoid_hom.iterate_map_one MonoidHom.iterate_map_one
#align add_monoid_hom.iterate_map_zero AddMonoidHom.iterate_map_zero

@[to_additive (attr := simp)]
theorem iterate_map_mul (f : M →* M) (n : ℕ) (x y) : (f^[n]) (x * y) = (f^[n]) x * (f^[n]) y :=
  Semiconj₂.iterate f.map_mul n x y
#align monoid_hom.iterate_map_mul MonoidHom.iterate_map_mul
#align add_monoid_hom.iterate_map_add AddMonoidHom.iterate_map_add

end

variable [Monoid M] [Monoid N] [Group G] [Group H]

@[to_additive (attr := simp)]
theorem iterate_map_inv (f : G →* G) (n : ℕ) (x) : (f^[n]) x⁻¹ = ((f^[n]) x)⁻¹ :=
  Commute.iterate_left f.map_inv n x
#align monoid_hom.iterate_map_inv MonoidHom.iterate_map_inv
#align add_monoid_hom.iterate_map_neg AddMonoidHom.iterate_map_neg

@[to_additive (attr := simp)]
theorem iterate_map_div (f : G →* G) (n : ℕ) (x y) : (f^[n]) (x / y) = (f^[n]) x / (f^[n]) y :=
  Semiconj₂.iterate f.map_div n x y
#align monoid_hom.iterate_map_div MonoidHom.iterate_map_div
#align add_monoid_hom.iterate_map_sub AddMonoidHom.iterate_map_sub

theorem iterate_map_pow (f : M →* M) (n : ℕ) (a) (m : ℕ) : (f^[n]) (a ^ m) = (f^[n]) a ^ m :=
  Commute.iterate_left (fun x => f.map_pow x m) n a
#align monoid_hom.iterate_map_pow MonoidHom.iterate_map_pow

theorem iterate_map_zpow (f : G →* G) (n : ℕ) (a) (m : ℤ) : (f^[n]) (a ^ m) = (f^[n]) a ^ m :=
  Commute.iterate_left (fun x => f.map_zpow x m) n a
#align monoid_hom.iterate_map_zpow MonoidHom.iterate_map_zpow

end MonoidHom

theorem Monoid.End.coe_pow {M} [Monoid M] (f : Monoid.End M) (n : ℕ) : ⇑(f ^ n) = f^[n] :=
  hom_coe_pow _ rfl (fun _ _ => rfl) _ _
#align monoid.End.coe_pow Monoid.End.coe_pow

-- we define these manually so that we can pick a better argument order
namespace AddMonoidHom

variable [AddMonoid M] [AddGroup G]

theorem iterate_map_smul (f : M →+ M) (n m : ℕ) (x : M) : (f^[n]) (m • x) = m • (f^[n]) x :=
  f.toMultiplicative.iterate_map_pow n x m
#align add_monoid_hom.iterate_map_smul AddMonoidHom.iterate_map_smul

attribute [to_additive (reorder := 5)] MonoidHom.iterate_map_pow
#align add_monoid_hom.iterate_map_nsmul AddMonoidHom.iterate_map_nsmul

theorem iterate_map_zsmul (f : G →+ G) (n : ℕ) (m : ℤ) (x : G) : (f^[n]) (m • x) = m • (f^[n]) x :=
  f.toMultiplicative.iterate_map_zpow n x m
#align add_monoid_hom.iterate_map_zsmul AddMonoidHom.iterate_map_zsmul

attribute [to_additive existing (reorder := 5)] MonoidHom.iterate_map_zpow

end AddMonoidHom

theorem AddMonoid.End.coe_pow {A} [AddMonoid A] (f : AddMonoid.End A) (n : ℕ) : ⇑(f ^ n) = f^[n] :=
  hom_coe_pow _ rfl (fun _ _ => rfl) _ _
#align add_monoid.End.coe_pow AddMonoid.End.coe_pow

namespace RingHom

section Semiring

variable {R : Type _} [Semiring R] (f : R →+* R) (n : ℕ) (x y : R)

theorem coe_pow (n : ℕ) : ⇑(f ^ n) = f^[n] :=
  hom_coe_pow _ rfl (fun _ _ => rfl) f n
#align ring_hom.coe_pow RingHom.coe_pow

theorem iterate_map_one : (f^[n]) 1 = 1 :=
  f.toMonoidHom.iterate_map_one n
#align ring_hom.iterate_map_one RingHom.iterate_map_one

theorem iterate_map_zero : (f^[n]) 0 = 0 :=
  f.toAddMonoidHom.iterate_map_zero n
#align ring_hom.iterate_map_zero RingHom.iterate_map_zero

theorem iterate_map_add : (f^[n]) (x + y) = (f^[n]) x + (f^[n]) y :=
  f.toAddMonoidHom.iterate_map_add n x y
#align ring_hom.iterate_map_add RingHom.iterate_map_add

theorem iterate_map_mul : (f^[n]) (x * y) = (f^[n]) x * (f^[n]) y :=
  f.toMonoidHom.iterate_map_mul n x y
#align ring_hom.iterate_map_mul RingHom.iterate_map_mul

theorem iterate_map_pow (a) (n m : ℕ) : (f^[n]) (a ^ m) = (f^[n]) a ^ m :=
  f.toMonoidHom.iterate_map_pow n a m
#align ring_hom.iterate_map_pow RingHom.iterate_map_pow

theorem iterate_map_smul (n m : ℕ) (x : R) : (f^[n]) (m • x) = m • (f^[n]) x :=
  f.toAddMonoidHom.iterate_map_smul n m x
#align ring_hom.iterate_map_smul RingHom.iterate_map_smul

end Semiring

variable {R : Type _} [Ring R] (f : R →+* R) (n : ℕ) (x y : R)

theorem iterate_map_sub : (f^[n]) (x - y) = (f^[n]) x - (f^[n]) y :=
  f.toAddMonoidHom.iterate_map_sub n x y
#align ring_hom.iterate_map_sub RingHom.iterate_map_sub

theorem iterate_map_neg : (f^[n]) (-x) = -(f^[n]) x :=
  f.toAddMonoidHom.iterate_map_neg n x
#align ring_hom.iterate_map_neg RingHom.iterate_map_neg

theorem iterate_map_zsmul (n : ℕ) (m : ℤ) (x : R) : (f^[n]) (m • x) = m • (f^[n]) x :=
  f.toAddMonoidHom.iterate_map_zsmul n m x
#align ring_hom.iterate_map_zsmul RingHom.iterate_map_zsmul

end RingHom

--what should be the namespace for this section?
section Monoid

variable [Monoid G] (a : G) (n : ℕ)

@[to_additive (attr := simp)]
theorem smul_iterate [MulAction G H] : (a • · : H → H)^[n] = (a ^ n • ·) :=
  funext fun b =>
    Nat.recOn n (by rw [iterate_zero, id.def, pow_zero, one_smul])
    fun n ih => by rw [iterate_succ', comp_apply, ih, pow_succ, mul_smul]
#align smul_iterate smul_iterate
#align vadd_iterate vadd_iterate

@[to_additive (attr := simp)]
theorem mul_left_iterate : (a * ·)^[n] = (a ^ n * ·) :=
  smul_iterate a n
#align mul_left_iterate mul_left_iterate
#align add_left_iterate add_left_iterate

@[to_additive (attr := simp)]
theorem mul_right_iterate : (· * a)^[n] = (· * a ^ n) :=
  smul_iterate (MulOpposite.op a) n
#align mul_right_iterate mul_right_iterate
#align add_right_iterate add_right_iterate

@[to_additive]
theorem mul_right_iterate_apply_one : ((· * a)^[n]) 1 = a ^ n := by simp [mul_right_iterate]
#align mul_right_iterate_apply_one mul_right_iterate_apply_one
#align add_right_iterate_apply_zero add_right_iterate_apply_zero

@[to_additive (attr := simp)]
theorem pow_iterate (n : ℕ) (j : ℕ) : (fun x : G => x ^ n)^[j] = fun x : G => x ^ n ^ j :=
  letI : MulAction ℕ G :=
    { smul := fun n g => g ^ n
      one_smul := pow_one
      mul_smul := fun m n g => pow_mul' g m n }
  smul_iterate n j
#align pow_iterate pow_iterate
#align nsmul_iterate nsmul_iterate

end Monoid

section Group

variable [Group G]

@[to_additive (attr := simp)]
theorem zpow_iterate (n : ℤ) (j : ℕ) : (fun x : G => x ^ n)^[j] = fun x => x ^ n ^ j :=
  letI : MulAction ℤ G :=
    { smul := fun n g => g ^ n
      one_smul := zpow_one
      mul_smul := fun m n g => zpow_mul' g m n }
  smul_iterate n j
#align zpow_iterate zpow_iterate
#align zsmul_iterate zsmul_iterate

end Group

section Semigroup

variable [Semigroup G] {a b c : G}

-- Porting note: need `dsimp only`, see https://leanprover.zulipchat.com/#narrow/stream/
-- 287929-mathlib4/topic/dsimp.20before.20rw/near/317063489
@[to_additive]
theorem SemiconjBy.function_semiconj_mul_left (h : SemiconjBy a b c) :
    Function.Semiconj (a * ·) (b * ·) (c * ·) := fun j => by
  dsimp only; rw [← mul_assoc, h.eq, mul_assoc]
#align semiconj_by.function_semiconj_mul_left SemiconjBy.function_semiconj_mul_left
#align add_semiconj_by.function_semiconj_add_left AddSemiconjBy.function_semiconj_add_left

@[to_additive]
theorem Commute.function_commute_mul_left (h : _root_.Commute a b) :
    Function.Commute (a * ·) (b * ·) :=
  SemiconjBy.function_semiconj_mul_left h
#align commute.function_commute_mul_left Commute.function_commute_mul_left
#align add_commute.function_commute_add_left AddCommute.function_commute_add_left

@[to_additive]
theorem SemiconjBy.function_semiconj_mul_right_swap (h : SemiconjBy a b c) :
    Function.Semiconj (· * a) (· * c) (· * b) := fun j => by simp_rw [mul_assoc, ← h.eq]
#align semiconj_by.function_semiconj_mul_right_swap SemiconjBy.function_semiconj_mul_right_swap
#align add_semiconj_by.function_semiconj_add_right_swap  SemiconjBy.function_semiconj_mul_right_swap

@[to_additive]
theorem Commute.function_commute_mul_right (h : _root_.Commute a b) :
  Function.Commute (· * a) (· * b) :=
  SemiconjBy.function_semiconj_mul_right_swap h
#align commute.function_commute_mul_right Commute.function_commute_mul_right
#align add_commute.function_commute_add_right  AddCommute.function_commute_add_right

end Semigroup


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.limits.shapes.strict_initial
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.Terminal
import Mathlib.CategoryTheory.Limits.Shapes.BinaryProducts

/-!
# Strict initial objects

This file sets up the basic theory of strict initial objects: initial objects where every morphism
to it is an isomorphism. This generalises a property of the empty set in the category of sets:
namely that the only function to the empty set is from itself.

We say `C` has strict initial objects if every initial object is strict, ie given any morphism
`f : A ⟶ I` where `I` is initial, then `f` is an isomorphism.
Strictly speaking, this says that *any* initial object must be strict, rather than that strict
initial objects exist, which turns out to be a more useful notion to formalise.

If the binary product of `X` with a strict initial object exists, it is also initial.

To show a category `C` with an initial object has strict initial objects, the most convenient way
is to show any morphism to the (chosen) initial object is an isomorphism and use
`has_strict_initial_objects_of_initial_is_strict`.

The dual notion (strict terminal objects) occurs much less frequently in practice so is ignored.

## TODO

* Construct examples of this: `Type*`, `Top`, `Groupoid`, simplicial types, posets.
* Construct the bottom element of the subobject lattice given strict initials.
* Show cartesian closed categories have strict initials

## References
* https://ncatlab.org/nlab/show/strict+initial+object
-/

universe v u

namespace CategoryTheory

namespace Limits

open Category

variable (C : Type u) [Category.{v} C]

section StrictInitial

/-- We say `C` has strict initial objects if every initial object is strict, ie given any morphism
`f : A ⟶ I` where `I` is initial, then `f` is an isomorphism.

Strictly speaking, this says that *any* initial object must be strict, rather than that strict
initial objects exist.
-/
class HasStrictInitialObjects : Prop where
  out : ∀ {I A : C} (f : A ⟶ I), IsInitial I → IsIso f
#align category_theory.limits.has_strict_initial_objects CategoryTheory.Limits.HasStrictInitialObjects

variable {C}

section

variable [HasStrictInitialObjects C] {I : C}

theorem IsInitial.isIso_to (hI : IsInitial I) {A : C} (f : A ⟶ I) : IsIso f :=
  HasStrictInitialObjects.out f hI
#align category_theory.limits.is_initial.is_iso_to CategoryTheory.Limits.IsInitial.isIso_to

theorem IsInitial.strict_hom_ext (hI : IsInitial I) {A : C} (f g : A ⟶ I) : f = g := by
  haveI := hI.isIso_to f
  haveI := hI.isIso_to g
  exact eq_of_inv_eq_inv (hI.hom_ext (inv f) (inv g))
#align category_theory.limits.is_initial.strict_hom_ext CategoryTheory.Limits.IsInitial.strict_hom_ext

theorem IsInitial.subsingleton_to (hI : IsInitial I) {A : C} : Subsingleton (A ⟶ I) :=
  ⟨hI.strict_hom_ext⟩
#align category_theory.limits.is_initial.subsingleton_to CategoryTheory.Limits.IsInitial.subsingleton_to

instance (priority := 100) initial_mono_of_strict_initial_objects : InitialMonoClass C
    where isInitial_mono_from := fun _ hI =>
    { right_cancellation := fun _ _ _ => hI.strict_hom_ext _ _ }
#align category_theory.limits.initial_mono_of_strict_initial_objects CategoryTheory.Limits.initial_mono_of_strict_initial_objects

/-- If `I` is initial, then `X ⨯ I` is isomorphic to it. -/
@[simps! hom]
noncomputable def mulIsInitial (X : C) [HasBinaryProduct X I] (hI : IsInitial I) : X ⨯ I ≅ I := by
   have := hI.isIso_to (prod.snd : X ⨯ I ⟶ I)
   exact asIso prod.snd
#align category_theory.limits.mul_is_initial CategoryTheory.Limits.mulIsInitial

@[simp]
theorem mulIsInitial_inv (X : C) [HasBinaryProduct X I] (hI : IsInitial I) :
    (mulIsInitial X hI).inv = hI.to _ :=
  hI.hom_ext _ _
#align category_theory.limits.mul_is_initial_inv CategoryTheory.Limits.mulIsInitial_inv

/-- If `I` is initial, then `I ⨯ X` is isomorphic to it. -/
@[simps! hom]
noncomputable def isInitialMul (X : C) [HasBinaryProduct I X] (hI : IsInitial I) : I ⨯ X ≅ I := by
   have := hI.isIso_to (prod.fst : I ⨯ X ⟶ I)
   exact asIso prod.fst
#align category_theory.limits.is_initial_mul CategoryTheory.Limits.isInitialMul

@[simp]
theorem isInitialMul_inv (X : C) [HasBinaryProduct I X] (hI : IsInitial I) :
    (isInitialMul X hI).inv = hI.to _ :=
  hI.hom_ext _ _
#align category_theory.limits.is_initial_mul_inv CategoryTheory.Limits.isInitialMul_inv

variable [HasInitial C]

instance initial_isIso_to {A : C} (f : A ⟶ ⊥_ C) : IsIso f :=
  initialIsInitial.isIso_to _
#align category_theory.limits.initial_is_iso_to CategoryTheory.Limits.initial_isIso_to

@[ext]
theorem initial.hom_ext {A : C} (f g : A ⟶ ⊥_ C) : f = g :=
  initialIsInitial.strict_hom_ext _ _
#align category_theory.limits.initial.hom_ext CategoryTheory.Limits.initial.hom_ext

theorem initial.subsingleton_to {A : C} : Subsingleton (A ⟶ ⊥_ C) :=
  initialIsInitial.subsingleton_to
#align category_theory.limits.initial.subsingleton_to CategoryTheory.Limits.initial.subsingleton_to

/-- The product of `X` with an initial object in a category with strict initial objects is itself
initial.
This is the generalisation of the fact that `X × empty ≃ empty` for types (or `n * 0 = 0`).
-/
@[simps! hom]
noncomputable def mulInitial (X : C) [HasBinaryProduct X (⊥_ C)] : X ⨯ ⊥_ C ≅ ⊥_ C :=
  mulIsInitial _ initialIsInitial
#align category_theory.limits.mul_initial CategoryTheory.Limits.mulInitial

@[simp]
theorem mulInitial_inv (X : C) [HasBinaryProduct X (⊥_ C)] : (mulInitial X).inv = initial.to _ :=
  Subsingleton.elim _ _
#align category_theory.limits.mul_initial_inv CategoryTheory.Limits.mulInitial_inv

/-- The product of `X` with an initial object in a category with strict initial objects is itself
initial.
This is the generalisation of the fact that `empty × X ≃ empty` for types (or `0 * n = 0`).
-/
@[simps! hom]
noncomputable def initialMul (X : C) [HasBinaryProduct (⊥_ C) X] : (⊥_ C) ⨯ X ≅ ⊥_ C :=
  isInitialMul _ initialIsInitial
#align category_theory.limits.initial_mul CategoryTheory.Limits.initialMul

@[simp]
theorem initialMul_inv (X : C) [HasBinaryProduct (⊥_ C) X] : (initialMul X).inv = initial.to _ :=
  Subsingleton.elim _ _
#align category_theory.limits.initial_mul_inv CategoryTheory.Limits.initialMul_inv

end

/-- If `C` has an initial object such that every morphism *to* it is an isomorphism, then `C`
has strict initial objects. -/
theorem hasStrictInitialObjects_of_initial_is_strict [HasInitial C]
    (h : ∀ (A) (f : A ⟶ ⊥_ C), IsIso f) : HasStrictInitialObjects C :=
  { out := @fun I A f hI =>
      haveI := h A (f ≫ hI.to _)
      ⟨⟨hI.to _ ≫ inv (f ≫ hI.to (⊥_ C)), by rw [← assoc, IsIso.hom_inv_id], hI.hom_ext _ _⟩⟩ }
#align category_theory.limits.has_strict_initial_objects_of_initial_is_strict CategoryTheory.Limits.hasStrictInitialObjects_of_initial_is_strict

end StrictInitial

section StrictTerminal

/-- We say `C` has strict terminal objects if every terminal object is strict, ie given any morphism
`f : I ⟶ A` where `I` is terminal, then `f` is an isomorphism.

Strictly speaking, this says that *any* terminal object must be strict, rather than that strict
terminal objects exist.
-/
class HasStrictTerminalObjects : Prop where
  out : ∀ {I A : C} (f : I ⟶ A), IsTerminal I → IsIso f
#align category_theory.limits.has_strict_terminal_objects CategoryTheory.Limits.HasStrictTerminalObjects

variable {C}

section

variable [HasStrictTerminalObjects C] {I : C}

theorem IsTerminal.isIso_from (hI : IsTerminal I) {A : C} (f : I ⟶ A) : IsIso f :=
  HasStrictTerminalObjects.out f hI
#align category_theory.limits.is_terminal.is_iso_from CategoryTheory.Limits.IsTerminal.isIso_from

theorem IsTerminal.strict_hom_ext (hI : IsTerminal I) {A : C} (f g : I ⟶ A) : f = g := by
  haveI := hI.isIso_from f
  haveI := hI.isIso_from g
  exact eq_of_inv_eq_inv (hI.hom_ext (inv f) (inv g))
#align category_theory.limits.is_terminal.strict_hom_ext CategoryTheory.Limits.IsTerminal.strict_hom_ext

theorem IsTerminal.subsingleton_to (hI : IsTerminal I) {A : C} : Subsingleton (I ⟶ A) :=
  ⟨hI.strict_hom_ext⟩
#align category_theory.limits.is_terminal.subsingleton_to CategoryTheory.Limits.IsTerminal.subsingleton_to

variable {J : Type v} [SmallCategory J]

/-- If all but one object in a diagram is strict terminal, the the limit is isomorphic to the
said object via `limit.π`. -/
theorem limit_π_isIso_of_is_strict_terminal (F : J ⥤ C) [HasLimit F] (i : J)
    (H : ∀ (j) (_ : j ≠ i), IsTerminal (F.obj j)) [Subsingleton (i ⟶ i)] : IsIso (limit.π F i) := by
  classical
    refine' ⟨⟨limit.lift _ ⟨_, ⟨_, _⟩⟩, _, _⟩⟩
    ·
      exact fun j =>
        dite (j = i)
          (fun h =>
            eqToHom
              (by
                cases h
                rfl))
          fun h => (H _ h).from _
    · intro j k f
      split_ifs with h h_1 h_1
      · cases h
        cases h_1
        obtain rfl : f = 𝟙 _ := Subsingleton.elim _ _
        simp
      · cases h
        erw [Category.comp_id]
        haveI : IsIso (F.map f) := (H _ h_1).isIso_from _
        rw [← IsIso.comp_inv_eq]
        apply (H _ h_1).hom_ext
      · cases h_1
        apply (H _ h).hom_ext
      · apply (H _ h).hom_ext
    · ext
      rw [assoc, limit.lift_π]
      dsimp only
      split_ifs with h
      · cases h
        rw [id_comp, eqToHom_refl]
        exact comp_id _
      · apply (H _ h).hom_ext
    · rw [limit.lift_π]
      simp
#align category_theory.limits.limit_π_is_iso_of_is_strict_terminal CategoryTheory.Limits.limit_π_isIso_of_is_strict_terminal

variable [HasTerminal C]

instance terminal_isIso_from {A : C} (f : ⊤_ C ⟶ A) : IsIso f :=
  terminalIsTerminal.isIso_from _
#align category_theory.limits.terminal_is_iso_from CategoryTheory.Limits.terminal_isIso_from

@[ext]
theorem terminal.hom_ext {A : C} (f g : ⊤_ C ⟶ A) : f = g :=
  terminalIsTerminal.strict_hom_ext _ _
#align category_theory.limits.terminal.hom_ext CategoryTheory.Limits.terminal.hom_ext

theorem terminal.subsingleton_to {A : C} : Subsingleton (⊤_ C ⟶ A) :=
  terminalIsTerminal.subsingleton_to
#align category_theory.limits.terminal.subsingleton_to CategoryTheory.Limits.terminal.subsingleton_to

end

/-- If `C` has an object such that every morphism *from* it is an isomorphism, then `C`
has strict terminal objects. -/
theorem hasStrictTerminalObjects_of_terminal_is_strict (I : C) (h : ∀ (A) (f : I ⟶ A), IsIso f) :
    HasStrictTerminalObjects C :=
  { out := @fun I' A f hI' =>
      haveI := h A (hI'.from _ ≫ f)
      ⟨⟨inv (hI'.from I ≫ f) ≫ hI'.from I, hI'.hom_ext _ _, by rw [assoc, IsIso.inv_hom_id]⟩⟩ }
#align category_theory.limits.has_strict_terminal_objects_of_terminal_is_strict CategoryTheory.Limits.hasStrictTerminalObjects_of_terminal_is_strict

end StrictTerminal

end Limits

end CategoryTheory


import analysis.topology.topological_space
import analysis.topology.continuity
import analysis.topology.topological_structures
import ex3

open tactic expr function has_add
variables {X : Type*} {Y : Type*} {Z : Type*} {W : Type*}
          {f f₁ f₂ : X → Y} {g : Y → Z} {h : Z → W}
variables [topological_space X] [topological_space Y]
          [topological_space Z] [topological_space W]

/- A tactic that splits a goal of the form continuous λ x, ⟨f₁ x, f₂ x⟩
 - into two subgoals of the form continuous λ x, f₁ x and continuous λ x, f₂ x.
 -/
meta def contprod : tactic unit :=
do `(continuous %%e) ← target <|>  fail "The goal must be of the form 'continuous _'.",
   `(_ → _ × _) ← infer_type e <|> fail "The function must be to a cartesian product.",

   -- create a goal showing that the first factor is continuous
   fst_continuous ← match e with
     | `(λ x, prod.mk (%%left) (%%right)) := to_expr ``(continuous (λ x, %%left))
     | _ := to_expr ``(continuous $ prod.fst ∘ %%e)
   end,
   h_fst_continuous ← assert "h_lhs_is_cont" fst_continuous,
   rotate 1,

   -- create a goal showing that the second factor is continuous
   snd_continuous ← match e with
     | `(λ x, prod.mk (%%left) (%%right)) := to_expr ``(continuous (λ x, %%right))
     | _ := to_expr ``(continuous $ prod.fst ∘ %%e)
   end,
   h_snd_continuous ← assert "h_rhs_is_cont" snd_continuous,
   rotate 1,

   -- the function goes to a product, it suffices to show that each factor is continuous
   cont_prod ← to_expr ``(continuous.prod_mk %%h_fst_continuous %%h_snd_continuous),
   exact cont_prod,
   return ()

example [add_monoid X] [topological_add_monoid X] : (continuous (λ x : X, (x, x))) :=
begin
  contprod,
  exact continuous_id,
  exact continuous_id,
end

example [add_monoid X] [topological_add_monoid X] : (continuous (λ x : X, x + x)) :=
begin
  contcomp3,
  exact topological_add_monoid.continuous_add X,
  contprod,
  exact continuous_id,
  exact continuous_id
end