Theory RS_Tree

(***********************************************************************************
 * 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 ‹Binary Trees›

(*<*)
theory RS_Tree
  imports Restriction_Spaces
begin
  (*>*)


datatype 'a ex_tree = tip | node ‹'a ex_tree› 'a ‹'a ex_tree›


instantiation ex_tree :: (type) restriction
begin

fun restriction_ex_tree :: ‹'a ex_tree ⇒ nat ⇒ 'a ex_tree›
  where ‹tip ↓ n = tip›
  |     ‹(node l val r) ↓ 0 = tip›
  |     ‹(node l val r) ↓ Suc n = node (l ↓ n) val (r ↓ n)›


lemma restriction_ex_tree_0_is_tip [simp] : ‹T ↓ 0 = tip›
  using restriction_ex_tree.elims by blast

instance
proof intro_classes
  show ‹T ↓ n ↓ m = T ↓ min n m› for T :: ‹'a ex_tree› and n m
  proof (induct n arbitrary: T m)
    show ‹T ↓ 0 ↓ m = T ↓ min 0 m› for T :: ‹'a ex_tree› and m by simp
  next
    fix T :: ‹'a ex_tree› and m n assume hyp : ‹T ↓ n ↓ m = T ↓ min n m› for T :: ‹'a ex_tree› and m
    show ‹T ↓ Suc n ↓ m = T ↓ min (Suc n) m›
      by (cases T; cases m, simp_all add: hyp)
  qed
qed


end


lemma size_le_imp_restriction_ex_tree_eq_self :
  ‹size x ≤ n ⟹ x ↓ n = x› for x :: ‹'a ex_tree›
  by (induct rule: restriction_ex_tree.induct) simp_all

lemma restriction_ex_tree_eqI :
  ‹(⋀i. x ↓ i =  y ↓ i) ⟹ x = y› for x y :: ‹'a ex_tree›
  by (metis linorder_linear size_le_imp_restriction_ex_tree_eq_self)

lemma restriction_ex_tree_eqI_optimized :
  ‹(⋀i. i ≤ max (size x) (size y) ⟹ x ↓ i =  y ↓ i) ⟹ x = y› for x y :: ‹'a ex_tree›
  by (metis max.cobounded1 max.cobounded2 order_eq_refl size_le_imp_restriction_ex_tree_eq_self)


instance ex_tree :: (type) restriction_space
  by (intro_classes, simp)
    (use restriction_ex_tree_eqI_optimized in blast)


(*<*)
end
  (*>*)