Theory Restriction_Spaces.Restriction_Spaces_Induction

(***********************************************************************************
 * Copyright (c) 2025 Université Paris-Saclay
 *
 * Author: Benoît Ballenghien, Université Paris-Saclay,
           CNRS, ENS Paris-Saclay, LMF
 * Author: Benjamin Puyobro, Université Paris-Saclay,
           IRT SystemX, CNRS, ENS Paris-Saclay, LMF
 * Author: Burkhart Wolff, Université Paris-Saclay,
           CNRS, ENS Paris-Saclay, LMF
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 *
 * * Redistributions of source code must retain the above copyright notice, this
 *
 * * Redistributions in binary form must reproduce the above copyright notice,
 *   this list of conditions and the following disclaimer in the documentation
 *   and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * SPDX-License-Identifier: BSD-2-Clause
 ***********************************************************************************)


section ‹Induction in Restriction Space›

(*<*)
theory  Restriction_Spaces_Induction
  imports Restriction_Spaces_Topology
begin
  (*>*)

subsection ‹Admissibility›

named_theorems restriction_adm_simpset ― ‹For future automation.›

subsubsection ‹Definition›

text ‹We start by defining the notion of admissible predicate.
      The idea is that if this predicates holds for each value
      of a convergent sequence, it also holds for its limit.›

context restriction begin

definition restriction_adm :: ('a  bool)  bool (adm)
  where restriction_adm P  σ Σ. σ ─↓→ Σ  (n. P (σ n))  P Σ

lemma restriction_admI :
  (σ Σ. σ ─↓→ Σ  (n. P (σ n))  P Σ)  restriction_adm P
  by (simp add: restriction_adm_def)

lemma restriction_admD :
  restriction_adm P; σ ─↓→ Σ; n. P (σ n)  P Σ
  by (simp add: restriction_adm_def)


subsubsection ‹Properties›

lemma restriction_adm_const [restriction_adm_simpset] :
  adm (λx. t)
  by (simp add: restriction_admI)

lemma restriction_adm_conj [restriction_adm_simpset] :
  adm (λx. P x)  adm (λx. Q x)  adm (λx. P x  Q x)
  by (fast intro: restriction_admI elim: restriction_admD)

lemma restriction_adm_all [restriction_adm_simpset] :
  (y. adm (λx. P x y))  adm (λx. y. P x y)
  by (fast intro: restriction_admI elim: restriction_admD)

lemma restriction_adm_ball [restriction_adm_simpset] :
  (y. y  A  adm (λx. P x y))  adm (λx. yA. P x y)
  by (fast intro: restriction_admI elim: restriction_admD)

lemma restriction_adm_disj [restriction_adm_simpset] :
  adm (λx. P x  Q x) if adm (λx. P x) adm (λx. Q x)
proof (rule restriction_admI)
  fix σ Σ
  assume * : σ ─↓→ Σ n. P (σ n)  Q (σ n)
  from "*"(2) have ** : (i. ji. P (σ j))  (i. ji. Q (σ j))
    by (meson nat_le_linear)

  { fix P assume $ : adm (λx. P x) i. ji. P (σ j)
    define f where f i = (LEAST j. i  j  P (σ j)) for i 
    have f1: i. i  f i and f2: i. P (σ (f i))
      using LeastI_ex [OF "$"(2)[rule_format]] by (simp_all add: f_def)
    have f3 : (λn. σ (f n)) ─↓→ Σ
    proof (rule restriction_tendstoI)
      fix n
      from σ ─↓→ Σ restriction_tendstoD obtain n0 where kn0. Σ  n = σ k  n by blast
      hence kmax n0 n. Σ  n = σ (f k)  n by (meson f1 le_trans max.boundedE)
      thus n0. kn0. Σ  n = σ (f k)  n by blast
    qed
    have P Σ by (fact restriction_admD[OF "$"(1) f3 f2])
  }

  with "**" adm (λx. P x) adm (λx. Q x) show P Σ  Q Σ by blast
qed

lemma restriction_adm_imp [restriction_adm_simpset] :
  adm (λx. ¬ P x)  adm (λx. Q x)  adm (λx. P x  Q x)
  by (subst imp_conv_disj) (rule restriction_adm_disj)


lemma restriction_adm_iff [restriction_adm_simpset] :
  adm (λx. P x  Q x)  adm (λx. Q x  P x)  adm (λx. P x  Q x)
  by (subst iff_conv_conj_imp) (rule restriction_adm_conj)

lemma restriction_adm_if_then_else [restriction_adm_simpset]:
  P  adm (λx. Q x); ¬ P  adm (λx. R x) 
   adm (λx. if P then Q x else R x)
  by (simp add: restriction_adm_def)

end



text ‹The notion of continuity is of course strongly related to the notion of admissibility.›

lemma restriction_adm_eq [restriction_adm_simpset] :
  adm (λx. f x = g x) if cont f and cont g
for f g :: 'a :: restriction  'b :: restriction_space
proof (rule restriction_admI)
  fix σ Σ assume σ ─↓→ Σ and n. f (σ n) = g (σ n)
  from restriction_contD[OF cont f σ ─↓→ Σ] have (λn. f (σ n)) ─↓→ f Σ .
  hence (λn. g (σ n)) ─↓→ f Σ by (unfold n. f (σ n) = g (σ n))
  moreover from restriction_contD[OF cont g σ ─↓→ Σ] have (λn. g (σ n)) ─↓→ g Σ .
  ultimately show f Σ = g Σ by (fact restriction_tendsto_unique)
qed

lemma restriction_adm_subst [restriction_adm_simpset] :
  adm (λx. P (t x)) if cont (λx. t x) and adm P
proof (rule restriction_admI)
  fix σ Σ assume σ ─↓→ Σ n. P (t (σ n))
  from restriction_contD[OF cont (λx. t x) σ ─↓→ Σ]
  have (λn. t (σ n)) ─↓→ t Σ .
  from restriction_admD[OF restriction_adm P (λn. t (σ n)) ─↓→ t Σ n. P (t (σ n))]
  show P (t Σ) .
qed



lemma restriction_adm_prod_domainD [restriction_adm_simpset] :
  adm (λx. P (x, y)) and adm (λy. P (x, y)) if adm P
proof -
  show adm (λx. P (x, y))
  proof (rule restriction_admI)
    show P (Σ, y) if σ ─↓→ Σ n. P (σ n, y) for σ Σ
    proof (rule restriction_admD[OF adm P _ n. P (σ n, y)])
      show (λn. (σ n, y)) ─↓→ (Σ, y)
        by (simp add: restriction_tendsto_prod_iff restriction_tendsto_const σ ─↓→ Σ)
    qed
  qed
next
  show adm (λy. P (x, y))
  proof (rule restriction_admI)
    show P (x, Σ) if σ ─↓→ Σ n. P (x, σ n) for σ Σ
    proof (rule restriction_admD[OF adm P _ n. P (x, σ n)])
      show (λn. (x, σ n)) ─↓→ (x, Σ)
        by (simp add: restriction_tendsto_prod_iff restriction_tendsto_const σ ─↓→ Σ)
    qed
  qed
qed



lemma restriction_adm_restriction_shift_on [restriction_adm_simpset] :
  adm (λf. restriction_shift_on f k A)
proof (rule restriction_admI)
  fix σ :: nat  'a  'b and Σ :: 'a  'b
  assume σ ─↓→ Σ and hyp : restriction_shift_on (σ n) k A for n
  show restriction_shift_on Σ k A
  proof (rule restriction_shift_onI)
    fix x y n assume x  A y  A x  n = y  n
    from hyp[THEN restriction_shift_onD, OF this]
    have * : σ m x  nat (int n + k) = σ m y  nat (int n + k) for m .
    show Σ x  nat (int n + k) = Σ y  nat (int n + k)
    proof (rule restriction_tendsto_unique)
      show (λm. σ m x  nat (int n + k)) ─↓→ Σ x  nat (int n + k)
        by (simp add: σ ─↓→ Σ restriction_tendsto_const_restricted restriction_tendsto_fun_imp)
    next
      show (λm. σ m x  nat (int n + k)) ─↓→ Σ y  nat (int n + k)
        by (simp add: "*" σ ─↓→ Σ restriction_tendsto_const_restricted restriction_tendsto_fun_imp)
    qed
  qed
qed

lemma restriction_adm_constructive_on [restriction_adm_simpset] :
  adm (λf. constructive_on f A)
  by (simp add: constructive_on_def restriction_adm_restriction_shift_on)

lemma restriction_adm_non_destructive_on [restriction_adm_simpset] :
  adm (λf. non_destructive_on f A)
  by (simp add: non_destructive_on_def restriction_adm_restriction_shift_on)


lemma restriction_adm_restriction_cont_at [restriction_adm_simpset] :
  adm (λf. cont f at a)
proof (rule restriction_admI)
  fix σ :: nat  'a  'b and Σ :: 'a  'b
  assume σ ─↓→ Σ and hyp : cont (σ n) at a for n
  show cont Σ at a
  proof (rule restriction_cont_atI)
    fix γ assume γ ─↓→ a
    from hyp[THEN restriction_cont_atD, OF this, THEN restriction_tendstoD]
    have n0. kn0. σ m a  n = σ m (γ k)  n for m n .
    moreover from σ ─↓→ Σ[THEN restriction_tendstoD]
    have n0. kn0. Σ  n = σ k  n for n .
    ultimately show (λn. Σ (γ n)) ─↓→ Σ a
      by (intro restriction_tendstoI) (metis restriction_fun_def)
  qed
qed

lemma restriction_adm_restriction_cont_on [restriction_adm_simpset] :
  adm (λf. cont f on A)
  unfolding restriction_cont_on_def
  by (intro restriction_adm_ball restriction_adm_restriction_cont_at)



corollary restriction_adm_restriction_shift [restriction_adm_simpset] :
  adm (λf. restriction_shift f k)
  and    restriction_adm_constructive [restriction_adm_simpset] :
  adm (λf. constructive f)
  and    restriction_adm_non_destructive [restriction_adm_simpset] :
  adm (λf. non_destructive f)
  and    restriction_adm_restriction_cont [restriction_adm_simpset] :
  adm (λf. cont f)
  by (simp_all add: restriction_adm_simpset restriction_shift_def
      constructive_def non_destructive_def)



lemma (in restriction) restriction_adm_mem_restriction_closed [restriction_adm_simpset] :
  closed K  adm (λx. x  K)
  by (auto intro!: restriction_admI dest: restriction_closed_sequentialD)

lemma (in restriction_space) restriction_adm_mem_restriction_compact [restriction_adm_simpset] :
  compact K  adm (λx. x  K)
  by (simp add: restriction_adm_mem_restriction_closed restriction_compact_imp_restriction_closed)

lemma (in restriction_space) restriction_adm_mem_finite [restriction_adm_simpset] :
  finite S  adm (λx. x  S)
  by (simp add: finite_imp_restriction_compact restriction_adm_mem_restriction_compact)


lemma restriction_adm_restriction_tendsto [restriction_adm_simpset] :
  adm (λσ. σ ─↓→ Σ)
  by (intro restriction_admI restriction_tendstoI)
    (metis (no_types, opaque_lifting) restriction_fun_def restriction_tendsto_def)

lemma restriction_adm_lim [restriction_adm_simpset] :
  adm (λΣ. σ ─↓→ Σ)
  by (metis restriction_admI restriction_openD restriction_open_restriction_cball
      restriction_tendsto_iff_restriction_cball_characterization)


lemma restriction_restriction_cont_on [restriction_cont_simpset] :
  cont f on A  cont (λx. f x  n) on A
  by (rule restriction_cont_onI)
    (simp add: restriction_cont_onD restriction_tendsto_const_restricted)

lemma restriction_cont_on_id [restriction_cont_simpset] : cont (λx. x) on A
  by (simp add: restriction_cont_onI)

lemma restriction_cont_on_const [restriction_cont_simpset] : cont (λx. c) on A
  by (simp add: restriction_cont_onI restriction_tendstoI)

lemma restriction_cont_on_fun [restriction_cont_simpset] : cont (λf. f x) on A
  by (rule restriction_cont_onI) (simp add: restriction_tendsto_fun_imp)

lemma restriction_cont2cont_on_fun [restriction_cont_simpset] :
  cont f on A  cont (λx. f x y) on A
  by (rule restriction_cont_onI)
    (metis restriction_cont_onD restriction_tendsto_fun_imp)







subsection ‹Induction›

text ‹Now that we have the concept of admissibility,
      we can formalize an induction rule for fixed points.
      Considering a constconstructive function termf of type typ'a  'a
      (where typ'a is instance of the class classcomplete_restriction_space)
      and a predicate termP which is admissible, and assuming that :
       termP holds for a certain element termx
       for any element termx, if termP holds for termx then it still holds for termf x
      
      we can have that termP holds for the fixed point termυ x. P x.›

lemma restriction_fix_ind' [case_names constructive adm steps] :
  constructive f  adm P  (n. P ((f ^^ n) x))  P (υ x. f x)
  using restriction_admD funpow_restriction_tendsto_restriction_fix by blast

lemma restriction_fix_ind [case_names constructive adm base step] :
  P (υ x. f x) if constructive f adm P P x x. P x  P (f x)
proof (induct rule: restriction_fix_ind')
  show constructive f by (fact constructive f)
next
  show restriction_adm P by (fact restriction_adm P)
next
  show P ((f ^^ n) x) for n
    by (induct n) (simp_all add: P x x. P x  P (f x))
qed

lemma restriction_fix_ind2 [case_names constructive adm base0 base1 step] :
  P (υ x. f x) if constructive f adm P P x P (f x)
  x. P x; P (f x)  P (f (f x))
proof (induct rule: restriction_fix_ind')
  show constructive f by (fact constructive f)
next
  show restriction_adm P by (fact restriction_adm P)
next
  show P ((f ^^ n) x) for n
    by (induct n rule: induct_nat_012) (simp_all add: that(3-5))
qed


text ‹We can rewrite the fixed point over a product to
      obtain this parallel fixed point induction rule. ›

lemma parallel_restriction_fix_ind [case_names constructiveL constructiveR adm base step] :
  fixes f :: 'a :: complete_restriction_space  'a
    and g :: 'b :: complete_restriction_space  'b
  assumes constructive : constructive f constructive g
    and adm  : restriction_adm (λp. P (fst p) (snd p))
    and base : P x y and step : x y. P x y  P (f x) (g y)
  shows P (υ x. f x) (υ y. g y)
proof -
  define F where F  λ(x, y). (f x, g y)
  define Q where Q  λ(x, y). P x y

  have P (υ x. f x) (υ y. g y) = Q (υ p. F p)
    by (simp add: F_def Q_def constructive restriction_fix_indep_prod_is)
  also have Q (υ p. F p) 
  proof (induct F rule : restriction_fix_ind)
    show constructive F
      by (simp add: F_def constructive_prod_codomain_iff constructive_prod_domain_iff constructive constructive_const)
  next
    show restriction_adm Q
      by (unfold Q_def) (metis (mono_tags, lifting) adm case_prod_beta restriction_adm_def)
  next
    show Q (x, y) by (simp add: Q_def base)
  next
    show Q p  Q (F p) for p by (simp add: Q_def F_def step split_beta)
  qed
  finally show P (υ x. f x) (υ y. g y) .
qed


text ‹k-steps induction›

lemma restriction_fix_ind_k_steps [case_names constructive adm base_k_steps step] :
  assumes constructive f
    and adm P
    and i < k. P ((f ^^ i) x)
    and x. i < k. P ((f ^^ i) x)  P ((f ^^ k) x)
  shows P (υ x. f x)
proof (rule restriction_fix_ind')
  show constructive f by (fact constructive f)
next
  show adm P by (fact adm P)
next
  have nat_k_induct :
    P n if i<k. P i and n0. (i<k. P (n0 + i))  P (n0 + k) for k n :: nat and P
  proof (induct rule: nat_less_induct)
    fix n assume m<n. P m
    show P n
    proof (cases n < k)
      from that(1) show n < k  P n by blast
    next
      from m<n. P m that(2)[rule_format, of n - k]
      show ¬ n < k  P n by auto
    qed
  qed
  show P ((f ^^ i) x) for i
  proof (induct rule: nat_k_induct)
    show i<k. P ((f ^^ i) x) by (simp add: assms(3))
  next
    show n0. (i<k. P ((f ^^ (n0 + i)) x))  P ((f ^^ (n0 + k)) x)
      by (smt (verit, del_insts) add.commute assms(4) funpow_add o_apply)
  qed
qed



(*<*)
end
  (*>*)